Incremental decommit e2e scenario

hydra-cluster/src/CardanoClient.hs

@@ -101,14 +101,17 @@ waitForPayment networkId socket amount addr =
   selectPayment (UTxO utxo) =
     Map.filter ((== amount) . selectLovelace . txOutValue) utxo
 
+-- | Wait for transaction outputs with matching lovelace value and addresses of
+-- the whole given UTxO
 waitForUTxO ::
-  NetworkId ->
-  SocketPath ->
+  RunningNode ->
   UTxO ->
   IO ()
-waitForUTxO networkId nodeSocket utxo =
+waitForUTxO node utxo =
   forM_ (snd <$> UTxO.pairs utxo) forEachUTxO
  where
+  RunningNode{networkId, nodeSocket} = node
+
   forEachUTxO :: TxOut CtxUTxO -> IO ()
   forEachUTxO = \case
     TxOut (ShelleyAddressInEra addr@ShelleyAddress{}) value _ _ -> do

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

@@ -14,6 +14,7 @@ import CardanoClient (
   queryTip,
   queryUTxOFor,
   submitTx,
+  waitForUTxO,
  )
 import CardanoNode (NodeLog, RunningNode (..))
 import Control.Concurrent.Async (mapConcurrently_)
@@ -81,6 +82,8 @@ import HydraNode (
   withHydraCluster,
   withHydraNode,
  )
+import Network.HTTP.Client.Conduit (Request (requestBody))
+import Network.HTTP.Conduit (RequestBody (RequestBodyLBS), parseUrlThrow)
 import Network.HTTP.Conduit qualified as L
 import Network.HTTP.Req (
   HttpException (VanillaHttpException),
@@ -95,6 +98,7 @@ import Network.HTTP.Req (
   runReq,
   (/:),
  )
+import Network.HTTP.Simple (httpLbs)
 import PlutusLedgerApi.Test.Examples qualified as Plutus
 import System.Directory (removeDirectoryRecursive)
 import System.FilePath ((</>))
@@ -624,6 +628,45 @@ initWithWrongKeys workDir tracer node@RunningNode{nodeSocket} hydraScriptsTxId =
 
       participants `shouldMatchList` expectedParticipants
 
+-- | Open a a single participant head with some UTxO and decommit parts of it.
+canDecommit :: Tracer IO EndToEndLog -> FilePath -> RunningNode -> TxId -> IO ()
+canDecommit tracer workDir node hydraScriptsTxId =
+  (`finally` returnFundsToFaucet tracer node Alice) $ do
+    refuelIfNeeded tracer node Alice 25_000_000
+    -- Start hydra-node on chain tip
+    tip <- queryTip networkId nodeSocket
+    let contestationPeriod = UnsafeContestationPeriod 100
+    aliceChainConfig <-
+      chainConfigFor Alice workDir nodeSocket [] contestationPeriod
+        <&> \config -> config{networkId, startChainFrom = Just tip}
+    withHydraNode hydraTracer aliceChainConfig workDir 1 aliceSk [] [1] hydraScriptsTxId $ \n1@HydraClient{hydraNodeId} -> do
+      -- Initialize & open head
+      send n1 $ input "Init" []
+      headId <- waitMatch 10 n1 $ headIsInitializingWith (Set.fromList [alice])
+
+      (walletVk, walletSk) <- generate genKeyPair
+
+      firstUTxO <- seedFromFaucet node walletVk 2_000_000 (contramap FromFaucet tracer)
+      decommitUTxO <- seedFromFaucet node walletVk 1_000_000 (contramap FromFaucet tracer)
+
+      let commitUTxO = firstUTxO <> decommitUTxO
+
+      requestCommitTx n1 commitUTxO <&> signTx walletSk >>= submitTx node
+
+      waitFor hydraTracer 10 [n1] $
+        output "HeadIsOpen" ["utxo" .= commitUTxO, "headId" .= headId]
+
+      request <- parseUrlThrow ("POST http://localhost:" <> show (4000 + hydraNodeId) <> "/decommit")
+      let decommitRequest = request{requestBody = RequestBodyLBS $ Aeson.encode decommitUTxO}
+      -- TODO: check that we get the expected response
+      res <- httpLbs decommitRequest
+
+      failAfter 10 $ waitForUTxO node decommitUTxO
+ where
+  hydraTracer = contramap FromHydraNode tracer
+
+  RunningNode{networkId, nodeSocket} = node
+
 -- * Utilities
 
 -- | Refuel given 'Actor' with given 'Lovelace' if current marked UTxO is below that amount.

hydra-cluster/test/Test/DirectChainSpec.hs

@@ -310,7 +310,7 @@ spec = around (showLogsOnFailure "DirectChainSpec") $ do
                 }
             aliceChain `observesInTime` OnFanoutTx headId
             failAfter 5 $
-              waitForUTxO networkId nodeSocket someUTxO
+              waitForUTxO node someUTxO
 
   it "can restart head to point in the past and replay on-chain events" $ \tracer -> do
     withTempDir "direct-chain" $ \tmp -> do

hydra-cluster/test/Test/EndToEndSpec.hs

@@ -54,22 +54,7 @@ import Hydra.Cluster.Fixture (
   carolSk,
   carolVk,
  )
-import Hydra.Cluster.Scenarios (
-  EndToEndLog (..),
-  canCloseWithLongContestationPeriod,
-  canSubmitTransactionThroughAPI,
-  headIsInitializingWith,
-  initWithWrongKeys,
-  refuelIfNeeded,
-  restartedNodeCanAbort,
-  restartedNodeCanObserveCommitTx,
-  singlePartyCannotCommitExternallyWalletUtxo,
-  singlePartyCommitsExternalScriptWithInlineDatum,
-  singlePartyCommitsFromExternalScript,
-  singlePartyHeadFullLifeCycle,
-  testPreventResumeReconfiguredPeer,
-  threeNodesNoErrorsOnOpen,
- )
+import Hydra.Cluster.Scenarios (EndToEndLog (..), canCloseWithLongContestationPeriod, canDecommit, canSubmitTransactionThroughAPI, headIsInitializingWith, initWithWrongKeys, refuelIfNeeded, restartedNodeCanAbort, restartedNodeCanObserveCommitTx, singlePartyCannotCommitExternallyWalletUtxo, singlePartyCommitsExternalScriptWithInlineDatum, singlePartyCommitsFromExternalScript, singlePartyHeadFullLifeCycle, testPreventResumeReconfiguredPeer, threeNodesNoErrorsOnOpen)
 import Hydra.Cluster.Util (chainConfigFor, keysFor)
 import Hydra.ContestationPeriod (ContestationPeriod (UnsafeContestationPeriod))
 import Hydra.Crypto (generateSigningKey)
@@ -150,6 +135,11 @@ spec = around (showLogsOnFailure "EndToEndSpec") $
           withCardanoNodeDevnet (contramap FromCardanoNode tracer) tmpDir $ \node ->
             publishHydraScriptsAs node Faucet
               >>= canSubmitTransactionThroughAPI tracer tmpDir node
+      it "can decommit utxo" $ \tracer -> do
+        withClusterTempDir "can-decommit-utxo" $ \tmpDir -> do
+          withCardanoNodeDevnet (contramap FromCardanoNode tracer) tmpDir $ \node ->
+            publishHydraScriptsAs node Faucet
+              >>= canDecommit tracer tmpDir node
 
     describe "three hydra nodes scenario" $ do
       it "does not error when all nodes open the head concurrently" $ \tracer ->
@@ -557,7 +547,7 @@ timedTx tmpDir tracer node@RunningNode{networkId, nodeSocket} hydraScriptsTxId =
     confirmedTransactions ^.. values `shouldBe` [toJSON $ txId tx]
 
 initAndClose :: FilePath -> Tracer IO EndToEndLog -> Int -> TxId -> RunningNode -> IO ()
-initAndClose tmpDir tracer clusterIx hydraScriptsTxId node@RunningNode{nodeSocket, networkId} = do
+initAndClose tmpDir tracer clusterIx hydraScriptsTxId node@RunningNode{nodeSocket} = do
   aliceKeys@(aliceCardanoVk, _) <- generate genKeyPair
   bobKeys@(bobCardanoVk, _) <- generate genKeyPair
   carolKeys@(carolCardanoVk, _) <- generate genKeyPair
@@ -675,7 +665,7 @@ initAndClose tmpDir tracer clusterIx hydraScriptsTxId node@RunningNode{nodeSocke
       Error err ->
         failure $ "newUTxO isn't valid JSON?: " <> err
       Data.Aeson.Success u ->
-        failAfter 5 $ waitForUTxO networkId nodeSocket u
+        failAfter 5 $ waitForUTxO node u
 
 --
 -- Fixtures