Allow partial ada commit (#2160)

fix #2140 

Allow users to specify _amount_ of lovelace to deposit which is very
convenient since that way users don't need to assemble the UTxO with the
exact amount they want to deposit to a Head.

- NOTE: This workflow is only enabled on `SimpleCommitRequest` since the
full one contains a blueprint tx that specifies how to spend utxo into a
head which could conflict with these changes.
---

<!-- Consider each and tick it off one way or the other -->
* [x] CHANGELOG updated or not needed
* [x] Documentation updated or not needed
* [x] Haddocks updated or not needed
* [x] No new TODOs introduced or explained herafter

Author: v0d1ch

CHANGELOG.md

@@ -10,6 +10,8 @@ changes.
 
 ## [0.23.0] - UNRELEASED
 
+- Accept additional field `amount` when depositing to specify the amount of Lovelace that should be depositted to a Head returning any leftover to the user.
+
 - Don't keep around invalid transactions as they could lead to stuck Head.
 
 - Hydra API server responds with the correct `Content-Type` header `application-json`.

docs/docs/how-to/incremental-commit.md

@@ -49,6 +49,11 @@ cardano-cli query utxo \
   --out-file commit-utxo.json
 ```
 
+:::info
+You can also specify `amount` of lovelace you want to commit together with the `UTxO` and hydra-node would
+commit only the specified amount and return any leftover to the user address.
+:::
+
 Then a request to the `/commit` endpoint provides us with a transaction:
 
 ```shell

hydra-cardano-api/src/Hydra/Cardano/Api.hs

@@ -85,6 +85,9 @@ import Cardano.Api as X hiding (
 import Cardano.Api.Ledger as X (
   PParams,
  )
+import Cardano.Api.Ledger.Lens as X (
+  mkAdaValue,
+ )
 import Cardano.Api.Shelley as X (
   AcquiringFailure (..),
   Hash (HeaderHash),

hydra-cluster/src/Hydra/Cluster/Scenarios.hs

@@ -109,6 +109,7 @@ import Hydra.Node.DepositPeriod (DepositPeriod (..))
 import Hydra.Options (CardanoChainConfig (..), ChainBackendOptions (..), DirectOptions (..), RunOptions (..), startChainFrom)
 import Hydra.Tx (HeadId, IsTx (balance), Party, txId)
 import Hydra.Tx.ContestationPeriod qualified as CP
+import Hydra.Tx.Deposit (capUTxO)
 import Hydra.Tx.Utils (dummyValidatorScript, verificationKeyToOnChainId)
 import HydraNode (
   HydraClient (..),
@@ -122,6 +123,7 @@ import HydraNode (
   postDecommit,
   prepareHydraNode,
   requestCommitTx,
+  requestCommitTx',
   send,
   waitFor,
   waitForAllMatch,
@@ -563,6 +565,7 @@ singlePartyCommitsFromExternal tracer workDir backend hydraScriptsTxId =
 
         (walletVk, walletSk) <- keysFor AliceFunds
         utxoToCommit <- seedFromFaucet backend walletVk 5_000_000 (contramap FromFaucet tracer)
+
         res <-
           runReq defaultHttpConfig $
             req
@@ -1297,6 +1300,78 @@ canCommit tracer workDir blockTime backend hydraScriptsTxId =
  where
   hydraTracer = contramap FromHydraNode tracer
 
+-- | Open a a two participant head and incrementally commit part of the UTxO.
+canDepositPartially :: ChainBackend backend => Tracer IO EndToEndLog -> FilePath -> NominalDiffTime -> backend -> [TxId] -> IO ()
+canDepositPartially tracer workDir blockTime backend hydraScriptsTxId =
+  (`finally` returnFundsToFaucet tracer backend Alice) $ do
+    (`finally` returnFundsToFaucet tracer backend Bob) $ do
+      refuelIfNeeded tracer backend Alice 30_000_000
+      refuelIfNeeded tracer backend Bob 30_000_000
+      -- NOTE: Adapt periods to block times
+      let contestationPeriod = truncate $ 10 * blockTime
+          depositPeriod = truncate $ 100 * blockTime
+      networkId <- Backend.queryNetworkId backend
+      aliceChainConfig <-
+        chainConfigFor Alice workDir backend hydraScriptsTxId [Bob] contestationPeriod
+          <&> setNetworkId networkId . modifyConfig (\c -> c{depositPeriod})
+      bobChainConfig <-
+        chainConfigFor Bob workDir backend hydraScriptsTxId [Alice] contestationPeriod
+          <&> setNetworkId networkId . modifyConfig (\c -> c{depositPeriod})
+      withHydraNode hydraTracer aliceChainConfig workDir 1 aliceSk [bobVk] [2] $ \n1 -> do
+        withHydraNode hydraTracer bobChainConfig workDir 2 bobSk [aliceVk] [1] $ \n2 -> do
+          send n1 $ input "Init" []
+          headId <- waitMatch (10 * blockTime) n2 $ headIsInitializingWith (Set.fromList [alice, bob])
+
+          -- Commit nothing
+          requestCommitTx n1 mempty >>= Backend.submitTransaction backend
+          requestCommitTx n2 mempty >>= Backend.submitTransaction backend
+          waitFor hydraTracer (20 * blockTime) [n1, n2] $
+            output "HeadIsOpen" ["utxo" .= object mempty, "headId" .= headId]
+
+          -- Get some L1 funds
+          (walletVk, walletSk) <- generate genKeyPair
+          commitUTxO <- seedFromFaucet backend walletVk 5_000_000 (contramap FromFaucet tracer)
+          -- This one is expected to fail since there is 5 ADA at the wallet address but we specified 6 ADA to commit
+          (requestCommitTx' n1 commitUTxO (Just 6_000_000) <&> toJSON)
+            `shouldThrow` expectErrorStatus 400 (Just "AmountTooLow")
+
+          let expectedCommit = fst $ capUTxO commitUTxO 2_000_000
+
+          depositTransaction <- requestCommitTx' n2 commitUTxO (Just 2_000_000)
+
+          let tx = signTx walletSk depositTransaction
+
+          Backend.submitTransaction backend tx
+
+          waitFor hydraTracer (2 * realToFrac depositPeriod) [n1, n2] $
+            output "CommitApproved" ["headId" .= headId, "utxoToCommit" .= expectedCommit]
+          waitFor hydraTracer (20 * blockTime) [n1, n2] $
+            output "CommitFinalized" ["headId" .= headId, "depositTxId" .= getTxId (getTxBody tx)]
+
+          getSnapshotUTxO n1 `shouldReturn` expectedCommit
+          -- check that user balance balance contains the change from the commit tx
+          (balance <$> Backend.queryUTxOFor backend QueryTip walletVk)
+            `shouldReturn` lovelaceToValue 3_000_000
+
+          send n2 $ input "Close" []
+
+          deadline <- waitMatch (10 * blockTime) n2 $ \v -> do
+            guard $ v ^? key "tag" == Just "HeadIsClosed"
+            v ^? key "contestationDeadline" . _JSON
+
+          remainingTime <- diffUTCTime deadline <$> getCurrentTime
+          waitFor hydraTracer (remainingTime + 3 * blockTime) [n1, n2] $
+            output "ReadyToFanout" ["headId" .= headId]
+          send n2 $ input "Fanout" []
+          waitMatch (10 * blockTime) n2 $ \v ->
+            guard $ v ^? key "tag" == Just "HeadIsFinalized"
+
+          -- Assert final wallet balance
+          (balance <$> Backend.queryUTxOFor backend QueryTip walletVk)
+            `shouldReturn` balance commitUTxO
+ where
+  hydraTracer = contramap FromHydraNode tracer
+
 rejectCommit :: ChainBackend backend => Tracer IO EndToEndLog -> FilePath -> NominalDiffTime -> backend -> [TxId] -> IO ()
 rejectCommit tracer workDir blockTime backend hydraScriptsTxId =
   (`finally` returnFundsToFaucet tracer backend Alice) $ do

hydra-cluster/src/HydraNode.hs

@@ -189,14 +189,20 @@ waitForAll tracer delay nodes expected = do
 -- | Helper to make it easy to obtain a commit tx using some wallet utxo.
 -- Create a commit tx using the hydra-node for later submission.
 requestCommitTx :: HydraClient -> UTxO -> IO Tx
-requestCommitTx HydraClient{apiHost = Host{hostname, port}} utxos =
+requestCommitTx client utxos =
+  requestCommitTx' client utxos Nothing
+
+-- | Helper to make it easy to obtain a commit tx using some wallet utxo and optional amount.
+-- Create a commit tx using the hydra-node for later submission.
+requestCommitTx' :: HydraClient -> UTxO -> Maybe Coin -> IO Tx
+requestCommitTx' HydraClient{apiHost = Host{hostname, port}} utxos amount =
   runReq defaultHttpConfig request <&> commitTx . responseBody
  where
   request =
     Req.req
       POST
       (Req.http hostname /: "commit")
-      (ReqBodyJson $ SimpleCommitRequest @Tx utxos)
+      (ReqBodyJson $ SimpleCommitRequest @Tx utxos amount)
       (Proxy :: Proxy (JsonResponse (DraftCommitTxResponse Tx)))
       (Req.port (fromInteger . toInteger $ port))
 

hydra-cluster/test/Test/BlockfrostChainSpec.hs

@@ -175,7 +175,7 @@ withBlockfrostChainTest tracer config party action = do
         { postTx
         , waitCallback = atomically $ takeTMVar eventMVar
         , draftCommitTx = \headId utxo blueprintTx -> do
-            eTx <- draftCommitTx headId $ CommitBlueprintTx{lookupUTxO = utxo, blueprintTx}
+            eTx <- draftCommitTx headId CommitBlueprintTx{lookupUTxO = utxo, blueprintTx}
             case eTx of
               Left e -> throwIO e
               Right tx -> pure tx

hydra-cluster/test/Test/DirectChainSpec.hs

@@ -559,7 +559,7 @@ withDirectChainTest tracer config party action = do
         { postTx
         , waitCallback = atomically $ takeTMVar eventMVar
         , draftCommitTx = \headId utxo blueprintTx -> do
-            eTx <- draftCommitTx headId $ CommitBlueprintTx{lookupUTxO = utxo, blueprintTx}
+            eTx <- draftCommitTx headId CommitBlueprintTx{lookupUTxO = utxo, blueprintTx}
             case eTx of
               Left e -> throwIO e
               Right tx -> pure tx

hydra-cluster/test/Test/EndToEndSpec.hs

@@ -52,6 +52,7 @@ import Hydra.Cluster.Scenarios (
   canCloseWithLongContestationPeriod,
   canCommit,
   canDecommit,
+  canDepositPartially,
   canRecoverDeposit,
   canResumeOnMemberAlreadyBootstrapped,
   canSeePendingDeposits,
@@ -320,6 +321,11 @@ spec = around (showLogsOnFailure "EndToEndSpec") $ do
           withBackend (contramap FromCardanoNode tracer) tmpDir $ \_ backend ->
             publishHydraScriptsAs backend Faucet
               >>= singlePartyCommitsScriptBlueprint tracer tmpDir backend
+      it "can deposit partial UTxO" $ \tracer -> do
+        withClusterTempDir $ \tmpDir -> do
+          withBackend (contramap FromCardanoNode tracer) tmpDir $ \blockTime backend ->
+            publishHydraScriptsAs backend Faucet
+              >>= canDepositPartially tracer tmpDir blockTime backend
       it "persistence can load with empty commit" $ \tracer -> do
         withClusterTempDir $ \tmpDir -> do
           withBackend (contramap FromCardanoNode tracer) tmpDir $ \_ backend ->