From ec0c35aad5e0235ba0b7b8e005e366ead28692d0 Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Tue, 13 Aug 2024 11:56:45 +0200 Subject: [PATCH] Return funds to faucet when it finishes --- hydra-cluster/bench/Bench/EndToEnd.hs | 56 +++++++++++++++-------- hydra-cluster/bench/Main.hs | 18 +++----- hydra-cluster/src/Hydra/Cluster/Faucet.hs | 31 +++++++++---- 3 files changed, 64 insertions(+), 41 deletions(-) diff --git a/hydra-cluster/bench/Bench/EndToEnd.hs b/hydra-cluster/bench/Bench/EndToEnd.hs index 2a020a5a9e0..af0a64544ff 100644 --- a/hydra-cluster/bench/Bench/EndToEnd.hs +++ b/hydra-cluster/bench/Bench/EndToEnd.hs @@ -28,9 +28,9 @@ import Data.Scientific (Scientific) import Data.Set ((\\)) import Data.Set qualified as Set import Data.Time (UTCTime (UTCTime), utctDayTime) -import Hydra.Cardano.Api (NetworkId, SocketPath, Tx, TxId, UTxO, getVerificationKey, signTx) -import Hydra.Cluster.Faucet (FaucetLog, publishHydraScriptsAs, seedFromFaucet) -import Hydra.Cluster.Fixture (Actor (Faucet)) +import Hydra.Cardano.Api (NetworkId, PaymentKey, SocketPath, Tx, TxId, UTxO, VerificationKey, getVerificationKey, signTx) +import Hydra.Cluster.Faucet (FaucetLog (..), publishHydraScriptsAs, returnFundsToFaucet', seedFromFaucet) +import Hydra.Cluster.Fixture (Actor (..)) import Hydra.Cluster.Scenarios ( EndToEndLog (..), headIsInitializingWith, @@ -39,7 +39,7 @@ import Hydra.ContestationPeriod (ContestationPeriod (UnsafeContestationPeriod)) import Hydra.Crypto (HydraKey, SigningKey, generateSigningKey) import Hydra.Generator (ClientDataset (..), ClientKeys (..), Dataset (..)) import Hydra.Ledger (txId) -import Hydra.Logging (Tracer, withTracerOutputTo) +import Hydra.Logging (Tracer, traceWith, withTracerOutputTo) import Hydra.Party (Party, deriveParty) import HydraNode ( HydraClient, @@ -102,31 +102,47 @@ benchDemo :: NetworkId -> SocketPath -> NominalDiffTime -> + VerificationKey PaymentKey -> [SigningKey HydraKey] -> FilePath -> Dataset -> IO Summary -benchDemo networkId nodeSocket timeoutSeconds hydraKeys workDir dataset@Dataset{clientDatasets, fundingTransaction} = do +benchDemo networkId nodeSocket timeoutSeconds faucetVk hydraKeys workDir dataset@Dataset{clientDatasets, fundingTransaction} = do putStrLn $ "Test logs available in: " <> (workDir "test.log") withFile (workDir "test.log") ReadWriteMode $ \hdl -> withTracerOutputTo hdl "Test" $ \tracer -> failAfter timeoutSeconds $ do putTextLn "Starting benchmark" - findRunningCardanoNode' (contramap FromCardanoNode tracer) networkId nodeSocket >>= \case + let cardanoTracer = contramap FromCardanoNode tracer + findRunningCardanoNode' cardanoTracer networkId nodeSocket >>= \case Nothing -> error ("Not found running node at socket: " <> show nodeSocket <> ", and network: " <> show networkId) Just node -> do - putTextLn "Seeding network" - fundClients networkId nodeSocket fundingTransaction - forM_ clientDatasets (fuelWith100Ada (contramap FromFaucet tracer) node) - putStrLn $ "Connecting to hydra cluster in " <> workDir - let hydraTracer = contramap FromHydraNode tracer - let parties = Set.fromList (deriveParty <$> hydraKeys) - withConnectionToNode hydraTracer 1 $ \leader -> - withConnectionToNode hydraTracer 2 $ \node2 -> - withConnectionToNode hydraTracer 3 $ \node3 -> do - let followers = [node2, node3] - scenario hydraTracer node workDir dataset parties leader followers + let clientSks = clientKeys <$> clientDatasets + (`finally` returnFaucetFunds tracer node clientSks) $ do + putTextLn "Seeding network" + fundClients networkId nodeSocket fundingTransaction + forM_ clientSks (fuelWith100Ada (contramap FromFaucet tracer) node) + putStrLn $ "Connecting to hydra cluster in " <> workDir + let hydraTracer = contramap FromHydraNode tracer + let parties = Set.fromList (deriveParty <$> hydraKeys) + withConnectionToNode hydraTracer 1 $ \leader -> + withConnectionToNode hydraTracer 2 $ \node2 -> + withConnectionToNode hydraTracer 3 $ \node3 -> do + let followers = [node2, node3] + scenario hydraTracer node workDir dataset parties leader followers + where + returnFaucetFunds tracer node cKeys = do + putTextLn "Returning funds to faucet" + let faucetTracer = contramap FromFaucet tracer + let toSenders (ClientKeys sk esk) = [(getVerificationKey sk, sk), (getVerificationKey esk, esk)] + let senders = concatMap @[] toSenders cKeys + mapM_ + ( \sender -> do + returnAmount <- returnFundsToFaucet' faucetTracer node faucetVk sender + traceWith faucetTracer $ ReturnedFunds{actor = show sender, returnAmount} + ) + senders scenario :: Tracer IO HydraNodeLog -> @@ -283,7 +299,7 @@ movingAverage confirmations = seedNetwork :: RunningNode -> Dataset -> Tracer IO FaucetLog -> IO TxId seedNetwork node@RunningNode{nodeSocket, networkId} Dataset{fundingTransaction, clientDatasets} tracer = do fundClients networkId nodeSocket fundingTransaction - forM_ clientDatasets (fuelWith100Ada tracer node) + forM_ (clientKeys <$> clientDatasets) (fuelWith100Ada tracer node) putTextLn "Publishing hydra scripts" publishHydraScriptsAs node Faucet @@ -293,8 +309,8 @@ fundClients networkId nodeSocket fundingTransaction = do submitTransaction networkId nodeSocket fundingTransaction void $ awaitTransaction networkId nodeSocket fundingTransaction -fuelWith100Ada :: Tracer IO FaucetLog -> RunningNode -> ClientDataset -> IO UTxO -fuelWith100Ada tracer node ClientDataset{clientKeys = ClientKeys{signingKey}} = do +fuelWith100Ada :: Tracer IO FaucetLog -> RunningNode -> ClientKeys -> IO UTxO +fuelWith100Ada tracer node ClientKeys{signingKey} = do let vk = getVerificationKey signingKey putTextLn $ "Seed client " <> show vk seedFromFaucet node vk 100_000_000 tracer diff --git a/hydra-cluster/bench/Main.hs b/hydra-cluster/bench/Main.hs index dc71a4a9f5e..448a24b2202 100644 --- a/hydra-cluster/bench/Main.hs +++ b/hydra-cluster/bench/Main.hs @@ -42,16 +42,12 @@ main = DemoOptions{outputDirectory, scalingFactor, timeoutSeconds, networkId, nodeSocket, hydraSigningKeys} -> do workDir <- createSystemTempDirectory "demo-bench" clientKeys <- do - aliceSk <- snd <$> keysFor Alice - aliceFundsSk <- snd <$> keysFor AliceFunds - bobSk <- snd <$> keysFor Bob - bobFundsSk <- snd <$> keysFor BobFunds - carolSk <- snd <$> keysFor Carol - carolFundsSk <- snd <$> keysFor CarolFunds - let alice = ClientKeys aliceSk aliceFundsSk - bob = ClientKeys bobSk bobFundsSk - carol = ClientKeys carolSk carolFundsSk - pure [alice, bob, carol] + let actors = [(Alice, AliceFunds), (Bob, BobFunds), (Carol, CarolFunds)] + let toClientKeys (actor, actorFunds) = do + sk <- snd <$> keysFor actor + fundsSk <- snd <$> keysFor actorFunds + pure $ ClientKeys sk fundsSk + forM actors toClientKeys hydraKeys <- mapM (readFileTextEnvelopeThrow (AsSigningKey AsHydraKey)) hydraSigningKeys playDemo outputDirectory timeoutSeconds scalingFactor clientKeys workDir networkId nodeSocket hydraKeys where @@ -62,7 +58,7 @@ main = dataset <- genDatasetConstantUTxODemo (faucetVk, faucetSk) clientKeys numberOfTxs networkId nodeSocket let datasetPath = workDir "dataset.json" saveDataset datasetPath dataset - let action = benchDemo networkId nodeSocket timeoutSeconds hydraKeys + let action = benchDemo networkId nodeSocket timeoutSeconds faucetVk hydraKeys run outputDirectory [datasetPath] action play outputDirectory timeoutSeconds scalingFactor clusterSize startingNodeId workDir = do diff --git a/hydra-cluster/src/Hydra/Cluster/Faucet.hs b/hydra-cluster/src/Hydra/Cluster/Faucet.hs index 4d62dee0e4e..cc4b10ebd8a 100644 --- a/hydra-cluster/src/Hydra/Cluster/Faucet.hs +++ b/hydra-cluster/src/Hydra/Cluster/Faucet.hs @@ -106,19 +106,30 @@ returnFundsToFaucet :: RunningNode -> Actor -> IO () -returnFundsToFaucet tracer RunningNode{networkId, nodeSocket} sender = do +returnFundsToFaucet tracer node sender = do (faucetVk, _) <- keysFor Faucet - let faucetAddress = mkVkAddress networkId faucetVk + senderKeys <- keysFor sender + returnAmount <- returnFundsToFaucet' tracer node faucetVk senderKeys + traceWith tracer $ ReturnedFunds{actor = actorName sender, returnAmount} - (senderVk, senderSk) <- keysFor sender +returnFundsToFaucet' :: + Tracer IO FaucetLog -> + RunningNode -> + VerificationKey PaymentKey -> + (VerificationKey PaymentKey, SigningKey PaymentKey) -> + IO Coin +returnFundsToFaucet' tracer RunningNode{networkId, nodeSocket} faucetVk (senderVk, senderSk) = do + let faucetAddress = mkVkAddress networkId faucetVk utxo <- queryUTxOFor networkId nodeSocket QueryTip senderVk - unless (null utxo) . retryOnExceptions tracer $ do - let utxoValue = balance @Tx utxo - let allLovelace = selectLovelace utxoValue - tx <- sign senderSk <$> buildTxBody utxo faucetAddress - submitTransaction networkId nodeSocket tx - void $ awaitTransaction networkId nodeSocket tx - traceWith tracer $ ReturnedFunds{actor = actorName sender, returnAmount = allLovelace} + if null utxo + then pure 0 + else retryOnExceptions tracer $ do + let utxoValue = balance @Tx utxo + let allLovelace = selectLovelace utxoValue + tx <- sign senderSk <$> buildTxBody utxo faucetAddress + submitTransaction networkId nodeSocket tx + void $ awaitTransaction networkId nodeSocket tx + pure allLovelace where buildTxBody utxo faucetAddress = -- Here we specify no outputs in the transaction so that a change output with the