From 78d7cd956bc430447da6da070001c525c0654a7f Mon Sep 17 00:00:00 2001 From: Sasha Bogicevic Date: Tue, 3 Dec 2024 16:01:17 +0100 Subject: [PATCH] Improve on e2e but no luck reproducing --- hydra-cluster/src/Hydra/Cluster/Scenarios.hs | 118 ++++++++++++------- 1 file changed, 73 insertions(+), 45 deletions(-) diff --git a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs index 38df894d449..210d5d6c238 100644 --- a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs +++ b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs @@ -733,66 +733,94 @@ initWithWrongKeys workDir tracer node@RunningNode{nodeSocket} hydraScriptsTxId = participants `shouldMatchList` expectedParticipants --- | Open a a single participant head and incrementally commit to it. +-- | Open a a two participant head and incrementally commit to it. canCommit :: Tracer IO EndToEndLog -> FilePath -> RunningNode -> [TxId] -> IO () canCommit tracer workDir node hydraScriptsTxId = (`finally` returnFundsToFaucet tracer node Alice) $ do - refuelIfNeeded tracer node Alice 30_000_000 - -- NOTE: it is important to provide _large_ enough contestation period so that - -- increment tx can be submitted before the deadline - let contestationPeriod = UnsafeContestationPeriod 5 - aliceChainConfig <- - chainConfigFor Alice workDir nodeSocket hydraScriptsTxId [] contestationPeriod - <&> setNetworkId networkId - withHydraNode hydraTracer aliceChainConfig workDir 1 aliceSk [] [1] $ \n1 -> do - send n1 $ input "Init" [] - headId <- waitMatch 10 n1 $ headIsInitializingWith (Set.fromList [alice]) + (`finally` returnFundsToFaucet tracer node Bob) $ do + refuelIfNeeded tracer node Alice 30_000_000 + refuelIfNeeded tracer node Bob 30_000_000 + -- NOTE: it is important to provide _large_ enough contestation period so that + -- increment tx can be submitted before the deadline + let contestationPeriod = UnsafeContestationPeriod 20 + aliceChainConfig <- + chainConfigFor Alice workDir nodeSocket hydraScriptsTxId [Bob] contestationPeriod + <&> setNetworkId networkId + bobChainConfig <- + chainConfigFor Bob workDir nodeSocket hydraScriptsTxId [Alice] contestationPeriod + <&> setNetworkId networkId + withHydraNode hydraTracer aliceChainConfig workDir 1 aliceSk [bobVk] [2] $ \n1 -> do + withHydraNode hydraTracer bobChainConfig workDir 2 bobSk [aliceVk] [1] $ \n2 -> do + send n1 $ input "Init" [] + -- _ <- waitMatch 10 n1 $ headIsInitializingWith (Set.fromList [bob]) + headId <- waitMatch 20 n2 $ headIsInitializingWith (Set.fromList [alice, bob]) - -- Commit nothing - requestCommitTx n1 mempty >>= submitTx node - waitFor hydraTracer (10 * blockTime) [n1] $ - output "HeadIsOpen" ["utxo" .= object mempty, "headId" .= headId] + -- Commit nothing + requestCommitTx n1 mempty >>= submitTx node + requestCommitTx n2 mempty >>= submitTx node + waitFor hydraTracer (20 * blockTime) [n1, n2] $ + output "HeadIsOpen" ["utxo" .= object mempty, "headId" .= headId] - -- Get some L1 funds - (walletVk, walletSk) <- generate genKeyPair - commitUTxO <- seedFromFaucet node walletVk 5_000_000 (contramap FromFaucet tracer) + -- Get some L1 funds + (walletVk, walletSk) <- generate genKeyPair + commitUTxO <- seedFromFaucet node walletVk 5_000_000 (contramap FromFaucet tracer) + commitUTxO2 <- seedFromFaucet node walletVk 5_000_000 (contramap FromFaucet tracer) - resp <- - parseUrlThrow ("POST " <> hydraNodeBaseUrl n1 <> "/commit") - <&> setRequestBodyJSON commitUTxO - >>= httpJSON + resp <- + parseUrlThrow ("POST " <> hydraNodeBaseUrl n2 <> "/commit") + <&> setRequestBodyJSON commitUTxO + >>= httpJSON - let depositTransaction = getResponseBody resp :: Tx - let tx = signTx walletSk depositTransaction + let depositTransaction = getResponseBody resp :: Tx + let tx = signTx walletSk depositTransaction - submitTx node tx + submitTx node tx - waitFor hydraTracer 10 [n1] $ - output "CommitApproved" ["headId" .= headId, "utxoToCommit" .= commitUTxO] - waitFor hydraTracer 10 [n1] $ - output "CommitFinalized" ["headId" .= headId, "theDeposit" .= getTxId (getTxBody tx)] + waitFor hydraTracer 20 [n1, n2] $ + output "CommitApproved" ["headId" .= headId, "utxoToCommit" .= commitUTxO] + waitFor hydraTracer 20 [n1, n2] $ + output "CommitFinalized" ["headId" .= headId, "theDeposit" .= getTxId (getTxBody tx)] - send n1 $ input "GetUTxO" [] + send n2 $ input "GetUTxO" [] - waitFor hydraTracer 10 [n1] $ - output "GetUTxOResponse" ["headId" .= headId, "utxo" .= commitUTxO] + waitFor hydraTracer 20 [n2] $ + output "GetUTxOResponse" ["headId" .= headId, "utxo" .= commitUTxO] + resp2 <- + parseUrlThrow ("POST " <> hydraNodeBaseUrl n1 <> "/commit") + <&> setRequestBodyJSON commitUTxO2 + >>= httpJSON - send n1 $ input "Close" [] + let depositTransaction' = getResponseBody resp2 :: Tx + let tx' = signTx walletSk depositTransaction' - deadline <- waitMatch (10 * blockTime) n1 $ \v -> do - guard $ v ^? key "tag" == Just "HeadIsClosed" - v ^? key "contestationDeadline" . _JSON + submitTx node tx' - remainingTime <- diffUTCTime deadline <$> getCurrentTime - waitFor hydraTracer (remainingTime + 3 * blockTime) [n1] $ - output "ReadyToFanout" ["headId" .= headId] - send n1 $ input "Fanout" [] - waitMatch (20 * blockTime) n1 $ \v -> - guard $ v ^? key "tag" == Just "HeadIsFinalized" + waitFor hydraTracer 20 [n1, n2] $ + output "CommitApproved" ["headId" .= headId, "utxoToCommit" .= commitUTxO2] + waitFor hydraTracer 20 [n1, n2] $ + output "CommitFinalized" ["headId" .= headId, "theDeposit" .= getTxId (getTxBody tx')] - -- Assert final wallet balance - (balance <$> queryUTxOFor networkId nodeSocket QueryTip walletVk) - `shouldReturn` balance commitUTxO + send n1 $ input "GetUTxO" [] + + waitFor hydraTracer 20 [n1] $ + output "GetUTxOResponse" ["headId" .= headId, "utxo" .= (commitUTxO <> commitUTxO2)] + + send n2 $ input "Close" [] + + deadline <- waitMatch (20 * 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 (20 * blockTime) n2 $ \v -> + guard $ v ^? key "tag" == Just "HeadIsFinalized" + + -- Assert final wallet balance + (balance <$> queryUTxOFor networkId nodeSocket QueryTip walletVk) + `shouldReturn` balance (commitUTxO <> commitUTxO2) where RunningNode{networkId, nodeSocket, blockTime} = node