From 281103970e04c8e1a376062cee11d843d354df84 Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Wed, 27 Mar 2024 14:34:49 +0100 Subject: [PATCH 1/7] Commit some TADA on full head life-cycle scenario This enhances our smoke tests as the explorer now reflects an increase in TVL. --- hydra-cluster/src/Hydra/Cluster/Fixture.hs | 2 + hydra-cluster/src/Hydra/Cluster/Scenarios.hs | 70 +++++++++++--------- 2 files changed, 42 insertions(+), 30 deletions(-) diff --git a/hydra-cluster/src/Hydra/Cluster/Fixture.hs b/hydra-cluster/src/Hydra/Cluster/Fixture.hs index 3e6edb132b4..7437c829f10 100644 --- a/hydra-cluster/src/Hydra/Cluster/Fixture.hs +++ b/hydra-cluster/src/Hydra/Cluster/Fixture.hs @@ -45,6 +45,7 @@ availableInitialFunds = 900_000_000_000 -- | Enumeration of known actors for which we can get the 'keysFor' and 'writeKeysFor'. data Actor = Alice + | AliceFunds | Bob | Carol | Faucet @@ -53,6 +54,7 @@ data Actor actorName :: Actor -> String actorName = \case Alice -> "alice" + AliceFunds -> "alice-funds" Bob -> "bob" Carol -> "carol" Faucet -> "faucet" diff --git a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs index 7c4cb6ed40f..d24990bf0a6 100644 --- a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs +++ b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs @@ -78,7 +78,7 @@ import Network.HTTP.Req ( import PlutusLedgerApi.Test.Examples qualified as Plutus import System.Directory (removeDirectoryRecursive) import System.FilePath (()) -import Test.QuickCheck (generate) +import Test.QuickCheck (choose, generate) data EndToEndLog = ClusterOptions {options :: Options} @@ -210,35 +210,45 @@ singlePartyHeadFullLifeCycle :: TxId -> IO () singlePartyHeadFullLifeCycle 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 - contestationPeriod <- fromNominalDiffTime $ 10 * blockTime - aliceChainConfig <- - chainConfigFor Alice workDir nodeSocket hydraScriptsTxId [] contestationPeriod - <&> modifyConfig (\config -> config{networkId, startChainFrom = Just tip}) - withHydraNode hydraTracer aliceChainConfig workDir 1 aliceSk [] [1] $ \n1 -> do - -- Initialize & open head - send n1 $ input "Init" [] - headId <- waitMatch (10 * blockTime) n1 $ headIsInitializingWith (Set.fromList [alice]) - -- Commit nothing for now - requestCommitTx n1 mempty >>= submitTx node - waitFor hydraTracer (10 * blockTime) [n1] $ - output "HeadIsOpen" ["utxo" .= object mempty, "headId" .= headId] - -- Close head - send n1 $ input "Close" [] - deadline <- waitMatch (10 * blockTime) n1 $ \v -> do - guard $ v ^? key "tag" == Just "HeadIsClosed" - guard $ v ^? key "headId" == Just (toJSON headId) - v ^? key "contestationDeadline" . _JSON - remainingTime <- diffUTCTime deadline <$> getCurrentTime - waitFor hydraTracer (remainingTime + 3 * blockTime) [n1] $ - output "ReadyToFanout" ["headId" .= headId] - send n1 $ input "Fanout" [] - waitFor hydraTracer (10 * blockTime) [n1] $ - output "HeadIsFinalized" ["utxo" .= object mempty, "headId" .= headId] - traceRemainingFunds Alice + ( `finally` + ( returnFundsToFaucet tracer node Alice + >> returnFundsToFaucet tracer node AliceFunds + ) + ) + $ do + refuelIfNeeded tracer node Alice 25_000_000 + -- Start hydra-node on chain tip + tip <- queryTip networkId nodeSocket + contestationPeriod <- fromNominalDiffTime $ 10 * blockTime + aliceChainConfig <- + chainConfigFor Alice workDir nodeSocket hydraScriptsTxId [] contestationPeriod + <&> modifyConfig (\config -> config{networkId, startChainFrom = Just tip}) + withHydraNode hydraTracer aliceChainConfig workDir 1 aliceSk [] [1] $ \n1 -> do + -- Initialize & open head + send n1 $ input "Init" [] + headId <- waitMatch (10 * blockTime) n1 $ headIsInitializingWith (Set.fromList [alice]) + + -- Commit something from external key + (walletVk, walletSk) <- keysFor AliceFunds + amount <- Coin <$> generate (choose (10_000_000, 50_000_000)) + utxoToCommit <- seedFromFaucet node walletVk amount (contramap FromFaucet tracer) + requestCommitTx n1 utxoToCommit <&> signTx walletSk >>= submitTx node + + waitFor hydraTracer (10 * blockTime) [n1] $ + output "HeadIsOpen" ["utxo" .= toJSON utxoToCommit, "headId" .= headId] + -- Close head + send n1 $ input "Close" [] + deadline <- waitMatch (10 * blockTime) n1 $ \v -> do + guard $ v ^? key "tag" == Just "HeadIsClosed" + guard $ v ^? key "headId" == Just (toJSON headId) + v ^? key "contestationDeadline" . _JSON + remainingTime <- diffUTCTime deadline <$> getCurrentTime + waitFor hydraTracer (remainingTime + 3 * blockTime) [n1] $ + output "ReadyToFanout" ["headId" .= headId] + send n1 $ input "Fanout" [] + waitFor hydraTracer (10 * blockTime) [n1] $ + output "HeadIsFinalized" ["utxo" .= toJSON utxoToCommit, "headId" .= headId] + traceRemainingFunds Alice where hydraTracer = contramap FromHydraNode tracer From 33ca6d311765ed2af141138e9a40b8633f48b22a Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Wed, 27 Mar 2024 15:57:10 +0100 Subject: [PATCH 2/7] Refactor finally expr to use do syntax --- hydra-cluster/src/Hydra/Cluster/Scenarios.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs index d24990bf0a6..f09349361cd 100644 --- a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs +++ b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs @@ -211,9 +211,9 @@ singlePartyHeadFullLifeCycle :: IO () singlePartyHeadFullLifeCycle tracer workDir node hydraScriptsTxId = ( `finally` - ( returnFundsToFaucet tracer node Alice - >> returnFundsToFaucet tracer node AliceFunds - ) + do + returnFundsToFaucet tracer node Alice + returnFundsToFaucet tracer node AliceFunds ) $ do refuelIfNeeded tracer node Alice 25_000_000 From ea0c24d108262fb0058cec0e3531bf280b675bae Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Wed, 27 Mar 2024 15:57:29 +0100 Subject: [PATCH 3/7] Include alice-funds to hydra-cluster.cabal --- hydra-cluster/hydra-cluster.cabal | 2 ++ 1 file changed, 2 insertions(+) diff --git a/hydra-cluster/hydra-cluster.cabal b/hydra-cluster/hydra-cluster.cabal index 6a482f252a0..5eea9556103 100644 --- a/hydra-cluster/hydra-cluster.cabal +++ b/hydra-cluster/hydra-cluster.cabal @@ -13,6 +13,8 @@ license-files: extra-source-files: README.md data-files: + config/credentials/alice-funds.sk + config/credentials/alice-funds.vk config/credentials/alice.sk config/credentials/alice.vk config/credentials/bob.sk From c8314f2c78b7d7a0521ce044ec45a5b6a676c07a Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Wed, 27 Mar 2024 16:44:00 +0100 Subject: [PATCH 4/7] Move external commit funds key to working dir --- hydra-cluster/src/Hydra/Cluster/Fixture.hs | 14 ++++++++++++++ hydra-cluster/src/Hydra/Cluster/Util.hs | 17 +++++++++++++---- 2 files changed, 27 insertions(+), 4 deletions(-) diff --git a/hydra-cluster/src/Hydra/Cluster/Fixture.hs b/hydra-cluster/src/Hydra/Cluster/Fixture.hs index 7437c829f10..f093212c68b 100644 --- a/hydra-cluster/src/Hydra/Cluster/Fixture.hs +++ b/hydra-cluster/src/Hydra/Cluster/Fixture.hs @@ -47,7 +47,9 @@ data Actor = Alice | AliceFunds | Bob + | BobFunds | Carol + | CarolFunds | Faucet deriving stock (Eq, Show) @@ -56,9 +58,21 @@ actorName = \case Alice -> "alice" AliceFunds -> "alice-funds" Bob -> "bob" + BobFunds -> "bob-funds" Carol -> "carol" + CarolFunds -> "carol-funds" Faucet -> "faucet" +toExternalCommitActor :: Actor -> Actor +toExternalCommitActor = \case + Alice -> AliceFunds + AliceFunds -> AliceFunds + Bob -> BobFunds + BobFunds -> BobFunds + Carol -> CarolFunds + CarolFunds -> CarolFunds + Faucet -> Faucet + -- | A network known to the hydra-cluster. That means we have configuration -- files to connect to at least these networks. data KnownNetwork diff --git a/hydra-cluster/src/Hydra/Cluster/Util.hs b/hydra-cluster/src/Hydra/Cluster/Util.hs index f1c62770d4f..88ccbee8154 100644 --- a/hydra-cluster/src/Hydra/Cluster/Util.hs +++ b/hydra-cluster/src/Hydra/Cluster/Util.hs @@ -18,7 +18,7 @@ import Hydra.Cardano.Api ( deserialiseFromTextEnvelope, textEnvelopeToJSON, ) -import Hydra.Cluster.Fixture (Actor, actorName) +import Hydra.Cluster.Fixture (Actor, actorName, toExternalCommitActor) import Hydra.ContestationPeriod (ContestationPeriod) import Hydra.Ledger.Cardano (genSigningKey) import Hydra.Options (ChainConfig (..), DirectChainConfig (..), defaultDirectChainConfig) @@ -75,10 +75,14 @@ chainConfigFor me targetDir nodeSocket hydraScriptsTxId them contestationPeriod when (me `elem` them) $ failure $ show me <> " must not be in " <> show them - readConfigFile ("credentials" skName me) >>= writeFileBS (skTarget me) - readConfigFile ("credentials" vkName me) >>= writeFileBS (vkTarget me) + + moveFile me "vk" + moveFile me "sk" + moveFile (toExternalCommitActor me) "vk" + moveFile (toExternalCommitActor me) "sk" + forM_ them $ \actor -> - readConfigFile ("credentials" vkName actor) >>= writeFileBS (vkTarget actor) + moveFile actor "vk" pure $ Direct defaultDirectChainConfig @@ -89,6 +93,11 @@ chainConfigFor me targetDir nodeSocket hydraScriptsTxId them contestationPeriod , contestationPeriod } where + moveFile actor fileType = do + let actorFileName = actorName actor <.> fileType + actorFilePath = targetDir actorFileName + readConfigFile ("credentials" actorFileName) >>= writeFileBS actorFilePath + skTarget x = targetDir skName x vkTarget x = targetDir vkName x skName x = actorName x <.> ".sk" From 3ff881a27d99fe62c4ac03d5149e642a4be24dfb Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Wed, 27 Mar 2024 16:49:57 +0100 Subject: [PATCH 5/7] Minor refactor --- hydra-cluster/src/Hydra/Cluster/Util.hs | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) diff --git a/hydra-cluster/src/Hydra/Cluster/Util.hs b/hydra-cluster/src/Hydra/Cluster/Util.hs index 88ccbee8154..b99406b8503 100644 --- a/hydra-cluster/src/Hydra/Cluster/Util.hs +++ b/hydra-cluster/src/Hydra/Cluster/Util.hs @@ -88,20 +88,18 @@ chainConfigFor me targetDir nodeSocket hydraScriptsTxId them contestationPeriod defaultDirectChainConfig { nodeSocket , hydraScriptsTxId - , cardanoSigningKey = skTarget me - , cardanoVerificationKeys = [vkTarget himOrHer | himOrHer <- them] + , cardanoSigningKey = actorFilePath me "sk" + , cardanoVerificationKeys = [actorFilePath himOrHer "vk" | himOrHer <- them] , contestationPeriod } where - moveFile actor fileType = do - let actorFileName = actorName actor <.> fileType - actorFilePath = targetDir actorFileName - readConfigFile ("credentials" actorFileName) >>= writeFileBS actorFilePath + actorFilePath actor fileType = targetDir actorFileName actor fileType + actorFileName actor fileType = actorName actor <.> fileType - skTarget x = targetDir skName x - vkTarget x = targetDir vkName x - skName x = actorName x <.> ".sk" - vkName x = actorName x <.> ".vk" + moveFile actor fileType = do + let fileName = actorFileName actor fileType + filePath = actorFilePath actor fileType + readConfigFile ("credentials" fileName) >>= writeFileBS filePath modifyConfig :: (DirectChainConfig -> DirectChainConfig) -> ChainConfig -> ChainConfig modifyConfig fn = \case From f25493f439c15469123645da1aee91056f7ebe97 Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Wed, 27 Mar 2024 17:22:47 +0100 Subject: [PATCH 6/7] Include bob and carol fund keys to hydra-cluster.cabal --- hydra-cluster/hydra-cluster.cabal | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/hydra-cluster/hydra-cluster.cabal b/hydra-cluster/hydra-cluster.cabal index 5eea9556103..bad73a9b9ba 100644 --- a/hydra-cluster/hydra-cluster.cabal +++ b/hydra-cluster/hydra-cluster.cabal @@ -17,8 +17,12 @@ data-files: config/credentials/alice-funds.vk config/credentials/alice.sk config/credentials/alice.vk + config/credentials/bob-funds.sk + config/credentials/bob-funds.vk config/credentials/bob.sk config/credentials/bob.vk + config/credentials/carol-funds.sk + config/credentials/carol-funds.vk config/credentials/carol.sk config/credentials/carol.vk config/credentials/faucet.sk From 62656e521412f16b2b862686840e48a55ea5f035 Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Thu, 28 Mar 2024 10:06:09 +0100 Subject: [PATCH 7/7] Enhance function names --- hydra-cluster/src/Hydra/Cluster/Fixture.hs | 4 ++-- hydra-cluster/src/Hydra/Cluster/Util.hs | 14 +++++++------- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/hydra-cluster/src/Hydra/Cluster/Fixture.hs b/hydra-cluster/src/Hydra/Cluster/Fixture.hs index f093212c68b..3973f4543ae 100644 --- a/hydra-cluster/src/Hydra/Cluster/Fixture.hs +++ b/hydra-cluster/src/Hydra/Cluster/Fixture.hs @@ -63,8 +63,8 @@ actorName = \case CarolFunds -> "carol-funds" Faucet -> "faucet" -toExternalCommitActor :: Actor -> Actor -toExternalCommitActor = \case +fundsOf :: Actor -> Actor +fundsOf = \case Alice -> AliceFunds AliceFunds -> AliceFunds Bob -> BobFunds diff --git a/hydra-cluster/src/Hydra/Cluster/Util.hs b/hydra-cluster/src/Hydra/Cluster/Util.hs index b99406b8503..a55c69a4467 100644 --- a/hydra-cluster/src/Hydra/Cluster/Util.hs +++ b/hydra-cluster/src/Hydra/Cluster/Util.hs @@ -18,7 +18,7 @@ import Hydra.Cardano.Api ( deserialiseFromTextEnvelope, textEnvelopeToJSON, ) -import Hydra.Cluster.Fixture (Actor, actorName, toExternalCommitActor) +import Hydra.Cluster.Fixture (Actor, actorName, fundsOf) import Hydra.ContestationPeriod (ContestationPeriod) import Hydra.Ledger.Cardano (genSigningKey) import Hydra.Options (ChainConfig (..), DirectChainConfig (..), defaultDirectChainConfig) @@ -76,13 +76,13 @@ chainConfigFor me targetDir nodeSocket hydraScriptsTxId them contestationPeriod failure $ show me <> " must not be in " <> show them - moveFile me "vk" - moveFile me "sk" - moveFile (toExternalCommitActor me) "vk" - moveFile (toExternalCommitActor me) "sk" + copyFile me "vk" + copyFile me "sk" + copyFile (fundsOf me) "vk" + copyFile (fundsOf me) "sk" forM_ them $ \actor -> - moveFile actor "vk" + copyFile actor "vk" pure $ Direct defaultDirectChainConfig @@ -96,7 +96,7 @@ chainConfigFor me targetDir nodeSocket hydraScriptsTxId them contestationPeriod actorFilePath actor fileType = targetDir actorFileName actor fileType actorFileName actor fileType = actorName actor <.> fileType - moveFile actor fileType = do + copyFile actor fileType = do let fileName = actorFileName actor fileType filePath = actorFilePath actor fileType readConfigFile ("credentials" fileName) >>= writeFileBS filePath