From 0de8881d94d05361ab46f5106864d7eee1d18801 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Wed, 15 Mar 2023 10:36:17 +0100 Subject: [PATCH 1/7] Draft a returnFundsToFaucet function and test case --- hydra-cluster/src/Hydra/Cluster/Faucet.hs | 8 ++ hydra-cluster/src/Hydra/Cluster/Scenarios.hs | 73 +++++++++++-------- .../test/Test/Hydra/Cluster/FaucetSpec.hs | 26 ++++++- 3 files changed, 72 insertions(+), 35 deletions(-) diff --git a/hydra-cluster/src/Hydra/Cluster/Faucet.hs b/hydra-cluster/src/Hydra/Cluster/Faucet.hs index 94750060b52..aa04b52a389 100644 --- a/hydra-cluster/src/Hydra/Cluster/Faucet.hs +++ b/hydra-cluster/src/Hydra/Cluster/Faucet.hs @@ -126,6 +126,14 @@ seedFromFaucet_ :: seedFromFaucet_ node vk ll marked tracer = void $ seedFromFaucet node vk ll marked tracer +-- | Return the remaining funds to the faucet +returnFundsToFaucet :: + Tracer IO FaucetLog -> + RunningNode -> + Actor -> + IO () +returnFundsToFaucet _tracer _node _actor = pure () + -- | Publish current Hydra scripts as scripts outputs for later referencing them. -- -- The key of the given Actor is used to pay for fees in required transactions, diff --git a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs index cb50c51df66..1a61246be0a 100644 --- a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs +++ b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs @@ -15,6 +15,7 @@ import qualified Data.Set as Set import Hydra.Cardano.Api (Lovelace, TxId, selectLovelace) import Hydra.Chain (HeadId) import Hydra.Cluster.Faucet (Marked (Fuel), queryMarkedUTxO, seedFromFaucet, seedFromFaucet_) +import qualified Hydra.Cluster.Faucet as Faucet import Hydra.Cluster.Fixture (Actor (..), actorName, alice, aliceSk, aliceVk, bob, bobSk, bobVk) import Hydra.Cluster.Util (chainConfigFor, keysFor) import Hydra.ContestationPeriod (ContestationPeriod (UnsafeContestationPeriod)) @@ -94,37 +95,38 @@ singlePartyHeadFullLifeCycle :: RunningNode -> TxId -> IO () -singlePartyHeadFullLifeCycle tracer workDir node@RunningNode{networkId} hydraScriptsTxId = do - refuelIfNeeded tracer node Alice 100_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 tracer aliceChainConfig workDir 1 aliceSk [] [1] hydraScriptsTxId $ \n1 -> do - -- Initialize & open head - send n1 $ input "Init" [] - headId <- waitMatch 600 n1 $ headIsInitializingWith (Set.fromList [alice]) - -- Commit nothing for now - send n1 $ input "Commit" ["utxo" .= object mempty] - waitFor tracer 600 [n1] $ - output "HeadIsOpen" ["utxo" .= object mempty, "headId" .= headId] - -- Close head - send n1 $ input "Close" [] - deadline <- waitMatch 600 n1 $ \v -> do - guard $ v ^? key "tag" == Just "HeadIsClosed" - guard $ v ^? key "headId" == Just (toJSON headId) - v ^? key "contestationDeadline" . _JSON - -- Expect to see ReadyToFanout within 600 seconds after deadline. - -- XXX: We still would like to have a network-specific time here - remainingTime <- diffUTCTime deadline <$> getCurrentTime - waitFor tracer (truncate $ remainingTime + 60) [n1] $ - output "ReadyToFanout" ["headId" .= headId] - send n1 $ input "Fanout" [] - waitFor tracer 600 [n1] $ - output "HeadIsFinalized" ["utxo" .= object mempty, "headId" .= headId] - traceRemainingFunds Alice +singlePartyHeadFullLifeCycle tracer workDir node@RunningNode{networkId} hydraScriptsTxId = + (`finally` returnFundsToFaucet tracer node Alice) $ do + refuelIfNeeded tracer node Alice 100_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 tracer aliceChainConfig workDir 1 aliceSk [] [1] hydraScriptsTxId $ \n1 -> do + -- Initialize & open head + send n1 $ input "Init" [] + headId <- waitMatch 600 n1 $ headIsInitializingWith (Set.fromList [alice]) + -- Commit nothing for now + send n1 $ input "Commit" ["utxo" .= object mempty] + waitFor tracer 600 [n1] $ + output "HeadIsOpen" ["utxo" .= object mempty, "headId" .= headId] + -- Close head + send n1 $ input "Close" [] + deadline <- waitMatch 600 n1 $ \v -> do + guard $ v ^? key "tag" == Just "HeadIsClosed" + guard $ v ^? key "headId" == Just (toJSON headId) + v ^? key "contestationDeadline" . _JSON + -- Expect to see ReadyToFanout within 600 seconds after deadline. + -- XXX: We still would like to have a network-specific time here + remainingTime <- diffUTCTime deadline <$> getCurrentTime + waitFor tracer (truncate $ remainingTime + 60) [n1] $ + output "ReadyToFanout" ["headId" .= headId] + send n1 $ input "Fanout" [] + waitFor tracer 600 [n1] $ + output "HeadIsFinalized" ["utxo" .= object mempty, "headId" .= headId] + traceRemainingFunds Alice where RunningNode{nodeSocket} = node @@ -188,6 +190,15 @@ refuelIfNeeded tracer node actor amount = do utxo <- seedFromFaucet node actorVk amount Fuel (contramap FromFaucet tracer) traceWith tracer $ RefueledFunds{actor = actorName actor, refuelingAmount = amount, fuelUTxO = utxo} +-- | Return the remaining funds to the faucet +returnFundsToFaucet :: + Tracer IO EndToEndLog -> + RunningNode -> + Actor -> + IO () +returnFundsToFaucet tracer = + Faucet.returnFundsToFaucet (contramap FromFaucet tracer) + headIsInitializingWith :: Set Party -> Value -> Maybe HeadId headIsInitializingWith expectedParties v = do guard $ v ^? key "tag" == Just "HeadIsInitializing" diff --git a/hydra-cluster/test/Test/Hydra/Cluster/FaucetSpec.hs b/hydra-cluster/test/Test/Hydra/Cluster/FaucetSpec.hs index 4b2f1c8dfa4..c267bae179b 100644 --- a/hydra-cluster/test/Test/Hydra/Cluster/FaucetSpec.hs +++ b/hydra-cluster/test/Test/Hydra/Cluster/FaucetSpec.hs @@ -3,16 +3,20 @@ module Test.Hydra.Cluster.FaucetSpec where import Hydra.Prelude import Test.Hydra.Prelude -import CardanoNode (withCardanoNodeDevnet) +import CardanoNode (RunningNode (..), withCardanoNodeDevnet) import Control.Concurrent.Async (replicateConcurrently_) -import Hydra.Cluster.Faucet (Marked (Normal), seedFromFaucet_) +import Hydra.Cardano.Api (txOutValue) +import Hydra.Chain.CardanoClient (QueryPoint (..), queryUTxOFor) +import Hydra.Cluster.Faucet (Marked (Normal), returnFundsToFaucet, seedFromFaucet, seedFromFaucet_) +import Hydra.Cluster.Fixture (Actor (..)) +import Hydra.Cluster.Util (keysFor) import Hydra.Ledger.Cardano (genVerificationKey) import Hydra.Logging (showLogsOnFailure) import HydraNode (EndToEndLog (FromCardanoNode, FromFaucet)) -import Test.QuickCheck (generate) +import Test.QuickCheck (elements, generate) spec :: Spec -spec = +spec = do describe "seedFromFaucet" $ it "should work concurrently" $ showLogsOnFailure $ \tracer -> @@ -22,3 +26,17 @@ spec = replicateConcurrently_ 10 $ do vk <- generate genVerificationKey seedFromFaucet_ node vk 1_000_000 Normal (contramap FromFaucet tracer) + + describe "returnFundsToFaucet" $ + it "seedFromFaucet and returnFundsToFaucet work together" $ do + showLogsOnFailure $ \tracer -> + withTempDir "end-to-end-cardano-node" $ \tmpDir -> + withCardanoNodeDevnet (contramap FromCardanoNode tracer) tmpDir $ \node@RunningNode{networkId, nodeSocket} -> do + let faucetTracer = contramap FromFaucet tracer + actor <- generate $ elements [Alice, Bob, Carol] + (vk, _) <- keysFor actor + _seeded <- seedFromFaucet node vk 100_000_000 Normal faucetTracer + returnFundsToFaucet faucetTracer node actor + remaining <- queryUTxOFor networkId nodeSocket QueryTip vk + -- TODO: check remaining funds for actor and faucet + foldMap txOutValue remaining `shouldBe` mempty From 7788faf7a71cbbc142db5689adc52653ab3a5f42 Mon Sep 17 00:00:00 2001 From: Sasha Bogicevic Date: Wed, 15 Mar 2023 10:53:37 +0100 Subject: [PATCH 2/7] Implement of returnFundsToFaucet This is using a previously drafted prototype of this logic. --- hydra-cluster/src/Hydra/Cluster/Faucet.hs | 86 +++++++++++++++++------ 1 file changed, 65 insertions(+), 21 deletions(-) diff --git a/hydra-cluster/src/Hydra/Cluster/Faucet.hs b/hydra-cluster/src/Hydra/Cluster/Faucet.hs index aa04b52a389..74d24415ed4 100644 --- a/hydra-cluster/src/Hydra/Cluster/Faucet.hs +++ b/hydra-cluster/src/Hydra/Cluster/Faucet.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE TypeApplications #-} module Hydra.Cluster.Faucet where @@ -32,6 +33,7 @@ import Hydra.Chain.Direct.ScriptRegistry ( import Hydra.Chain.Direct.Util (isMarkedOutput, markerDatumHash) import Hydra.Cluster.Fixture (Actor (Faucet)) import Hydra.Cluster.Util (keysFor) +import Hydra.Ledger (balance) import Hydra.Ledger.Cardano () data Marked = Fuel | Normal @@ -62,28 +64,9 @@ seedFromFaucet :: IO UTxO seedFromFaucet RunningNode{networkId, nodeSocket} receivingVerificationKey lovelace marked tracer = do (faucetVk, faucetSk) <- keysFor Faucet - retryOnExceptions $ submitSeedTx faucetVk faucetSk + retryOnExceptions tracer $ submitSeedTx faucetVk faucetSk waitForPayment networkId nodeSocket lovelace receivingAddress where - isResourceExhausted ex = case ioe_type ex of - ResourceExhausted -> True - _ -> False - - retryOnExceptions action = - action - `catches` [ Handler $ \(_ :: SubmitTransactionException) -> do - threadDelay 1 - retryOnExceptions action - , Handler $ \(ex :: IOException) -> do - unless (isResourceExhausted ex) $ - throwIO ex - traceWith tracer $ - TraceResourceExhaustedHandled $ - "Expected exception raised from seedFromFaucet: " <> show ex - threadDelay 1 - retryOnExceptions action - ] - submitSeedTx faucetVk faucetSk = do faucetUTxO <- findUTxO faucetVk let changeAddress = ShelleyAddressInEra (buildAddress faucetVk networkId) @@ -132,7 +115,68 @@ returnFundsToFaucet :: RunningNode -> Actor -> IO () -returnFundsToFaucet _tracer _node _actor = pure () +returnFundsToFaucet tracer node@RunningNode{networkId, nodeSocket} sender = do + (faucetVk, _) <- keysFor Faucet + let faucetAddress = buildAddress faucetVk networkId + + (senderVk, senderSk) <- keysFor sender + utxo <- queryUTxOFor networkId nodeSocket QueryTip senderVk + + -- Bit ugly bit we need to subtract the fees manually here. + -- TODO: Implement the fee calculation for our smoke-tests + let returnBalance = (selectLovelace $ balance @Tx utxo) - 1_500_000 + + -- TODO: re-add? traceWith tracer $ ReturningFunds{actor = actorName sender, returnAmount = returnBalance} + retryOnExceptions tracer $ + buildAndSubmitTx node returnBalance faucetAddress senderVk senderSk + void $ waitForPayment networkId nodeSocket returnBalance faucetAddress + +buildAndSubmitTx :: + RunningNode -> + -- | Amount of lovelace to send to the reciver + Lovelace -> + -- | Receiving address + Address ShelleyAddr -> + -- | Sender verification key + VerificationKey PaymentKey -> + -- | Sender signing key + SigningKey PaymentKey -> + IO () +buildAndSubmitTx RunningNode{networkId, nodeSocket} lovelace receivingAddress senderVk senderSk = do + utxo <- queryUTxOFor networkId nodeSocket QueryTip senderVk + let changeAddress = ShelleyAddressInEra (buildAddress senderVk networkId) + buildTransaction networkId nodeSocket changeAddress utxo [] [theOutput] >>= \case + Left e -> throwIO $ FaucetFailedToBuildTx{reason = e} + Right body -> do + submitTransaction networkId nodeSocket (sign senderSk body) + where + theOutput = + TxOut + (shelleyAddressInEra receivingAddress) + (lovelaceToValue lovelace) + TxOutDatumNone + ReferenceScriptNone + +-- | Try to submit tx and retry when some caught exception/s take place. +retryOnExceptions :: (MonadCatch m, MonadDelay m) => Tracer m FaucetLog -> m () -> m () +retryOnExceptions tracer action = + action + `catches` [ Handler $ \(_ :: SubmitTransactionException) -> do + threadDelay 1 + retryOnExceptions tracer action + , Handler $ \(ex :: IOException) -> do + unless (isResourceExhausted ex) $ + throwIO ex + traceWith tracer $ + TraceResourceExhaustedHandled $ + "Expected exception raised from seedFromFaucet: " <> show ex + threadDelay 1 + retryOnExceptions tracer action + ] + where + isResourceExhausted ex = case ioe_type ex of + ResourceExhausted -> True + _other -> False -- | Publish current Hydra scripts as scripts outputs for later referencing them. -- From 0459541664cfcae9ec8d7067907d2c0b0777eff4 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Wed, 15 Mar 2023 11:23:08 +0100 Subject: [PATCH 3/7] Use faucet address as change address This way, the faucet will have all the funds. --- hydra-cluster/src/Hydra/Cluster/Faucet.hs | 58 ++++++++--------------- 1 file changed, 21 insertions(+), 37 deletions(-) diff --git a/hydra-cluster/src/Hydra/Cluster/Faucet.hs b/hydra-cluster/src/Hydra/Cluster/Faucet.hs index 74d24415ed4..fc928f5403f 100644 --- a/hydra-cluster/src/Hydra/Cluster/Faucet.hs +++ b/hydra-cluster/src/Hydra/Cluster/Faucet.hs @@ -10,9 +10,14 @@ import Hydra.Prelude import qualified Cardano.Api.UTxO as UTxO import CardanoClient ( QueryPoint (QueryTip), + SubmitTransactionException, + awaitTransaction, buildAddress, + buildTransaction, queryUTxO, + queryUTxOFor, sign, + submitTransaction, waitForPayment, ) import CardanoNode (RunningNode (..)) @@ -21,12 +26,6 @@ import Control.Monad.Class.MonadThrow (Handler (Handler), catches) import Control.Tracer (Tracer, traceWith) import qualified Data.Map as Map import GHC.IO.Exception (IOErrorType (ResourceExhausted), IOException (ioe_type)) -import Hydra.Chain.CardanoClient ( - SubmitTransactionException, - buildTransaction, - queryUTxOFor, - submitTransaction, - ) import Hydra.Chain.Direct.ScriptRegistry ( publishHydraScripts, ) @@ -115,9 +114,9 @@ returnFundsToFaucet :: RunningNode -> Actor -> IO () -returnFundsToFaucet tracer node@RunningNode{networkId, nodeSocket} sender = do +returnFundsToFaucet tracer RunningNode{networkId, nodeSocket} sender = do (faucetVk, _) <- keysFor Faucet - let faucetAddress = buildAddress faucetVk networkId + let faucetAddress = mkVkAddress networkId faucetVk (senderVk, senderSk) <- keysFor sender utxo <- queryUTxOFor networkId nodeSocket QueryTip senderVk @@ -127,35 +126,20 @@ returnFundsToFaucet tracer node@RunningNode{networkId, nodeSocket} sender = do let returnBalance = (selectLovelace $ balance @Tx utxo) - 1_500_000 -- TODO: re-add? traceWith tracer $ ReturningFunds{actor = actorName sender, returnAmount = returnBalance} - retryOnExceptions tracer $ - buildAndSubmitTx node returnBalance faucetAddress senderVk senderSk - void $ waitForPayment networkId nodeSocket returnBalance faucetAddress - -buildAndSubmitTx :: - RunningNode -> - -- | Amount of lovelace to send to the reciver - Lovelace -> - -- | Receiving address - Address ShelleyAddr -> - -- | Sender verification key - VerificationKey PaymentKey -> - -- | Sender signing key - SigningKey PaymentKey -> - IO () -buildAndSubmitTx RunningNode{networkId, nodeSocket} lovelace receivingAddress senderVk senderSk = do - utxo <- queryUTxOFor networkId nodeSocket QueryTip senderVk - let changeAddress = ShelleyAddressInEra (buildAddress senderVk networkId) - buildTransaction networkId nodeSocket changeAddress utxo [] [theOutput] >>= \case - Left e -> throwIO $ FaucetFailedToBuildTx{reason = e} - Right body -> do - submitTransaction networkId nodeSocket (sign senderSk body) - where - theOutput = - TxOut - (shelleyAddressInEra receivingAddress) - (lovelaceToValue lovelace) - TxOutDatumNone - ReferenceScriptNone + retryOnExceptions tracer $ do + -- NOTE: We use the receiving address as the change + let theOutput = + TxOut + faucetAddress + (lovelaceToValue returnBalance) + TxOutDatumNone + ReferenceScriptNone + buildTransaction networkId nodeSocket faucetAddress utxo [] [theOutput] >>= \case + Left e -> throwIO $ FaucetFailedToBuildTx{reason = e} + Right body -> do + let tx = sign senderSk body + submitTransaction networkId nodeSocket tx + void $ awaitTransaction networkId nodeSocket tx -- | Try to submit tx and retry when some caught exception/s take place. retryOnExceptions :: (MonadCatch m, MonadDelay m) => Tracer m FaucetLog -> m () -> m () From ed0c3a1657bb91d91e3c8a73add5277a4985cca7 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Wed, 15 Mar 2023 11:37:39 +0100 Subject: [PATCH 4/7] Also use the exact fee to send back to the faucet This means a minimal as possible UTxO is created for the faucet. --- hydra-cluster/src/Hydra/Cluster/Faucet.hs | 31 +++++++++---------- .../test/Test/Hydra/Cluster/FaucetSpec.hs | 2 ++ 2 files changed, 16 insertions(+), 17 deletions(-) diff --git a/hydra-cluster/src/Hydra/Cluster/Faucet.hs b/hydra-cluster/src/Hydra/Cluster/Faucet.hs index fc928f5403f..8c53ad6bb3a 100644 --- a/hydra-cluster/src/Hydra/Cluster/Faucet.hs +++ b/hydra-cluster/src/Hydra/Cluster/Faucet.hs @@ -121,25 +121,22 @@ returnFundsToFaucet tracer RunningNode{networkId, nodeSocket} sender = do (senderVk, senderSk) <- keysFor sender utxo <- queryUTxOFor networkId nodeSocket QueryTip senderVk - -- Bit ugly bit we need to subtract the fees manually here. - -- TODO: Implement the fee calculation for our smoke-tests - let returnBalance = (selectLovelace $ balance @Tx utxo) - 1_500_000 - -- TODO: re-add? traceWith tracer $ ReturningFunds{actor = actorName sender, returnAmount = returnBalance} retryOnExceptions tracer $ do - -- NOTE: We use the receiving address as the change - let theOutput = - TxOut - faucetAddress - (lovelaceToValue returnBalance) - TxOutDatumNone - ReferenceScriptNone - buildTransaction networkId nodeSocket faucetAddress utxo [] [theOutput] >>= \case - Left e -> throwIO $ FaucetFailedToBuildTx{reason = e} - Right body -> do - let tx = sign senderSk body - submitTransaction networkId nodeSocket tx - void $ awaitTransaction networkId nodeSocket tx + let allLovelace = selectLovelace $ balance @Tx utxo + -- XXX: Using a hard-coded high-enough value to satisfy the min utxo value. + -- NOTE: We use the faucet address as the change deliberately here. + tx <- sign senderSk <$> buildTxBody utxo faucetAddress 1_000_000 + let fee = txFee' tx + tx' <- sign senderSk <$> buildTxBody utxo faucetAddress (allLovelace - fee) + submitTransaction networkId nodeSocket tx' + void $ awaitTransaction networkId nodeSocket tx' + where + buildTxBody utxo faucetAddress lovelace = + let theOutput = TxOut faucetAddress (lovelaceToValue lovelace) TxOutDatumNone ReferenceScriptNone + in buildTransaction networkId nodeSocket faucetAddress utxo [] [theOutput] >>= \case + Left e -> throwIO $ FaucetFailedToBuildTx{reason = e} + Right body -> pure body -- | Try to submit tx and retry when some caught exception/s take place. retryOnExceptions :: (MonadCatch m, MonadDelay m) => Tracer m FaucetLog -> m () -> m () diff --git a/hydra-cluster/test/Test/Hydra/Cluster/FaucetSpec.hs b/hydra-cluster/test/Test/Hydra/Cluster/FaucetSpec.hs index c267bae179b..f6a60b34d19 100644 --- a/hydra-cluster/test/Test/Hydra/Cluster/FaucetSpec.hs +++ b/hydra-cluster/test/Test/Hydra/Cluster/FaucetSpec.hs @@ -40,3 +40,5 @@ spec = do remaining <- queryUTxOFor networkId nodeSocket QueryTip vk -- TODO: check remaining funds for actor and faucet foldMap txOutValue remaining `shouldBe` mempty + -- TODO: could ensure only one UTxO is added to the faucet. + pure () From 0cfc4e0db9b2dd3ed0113af7c3274f4fb2166bec Mon Sep 17 00:00:00 2001 From: Sasha Bogicevic Date: Wed, 15 Mar 2023 14:47:51 +0100 Subject: [PATCH 5/7] Add more to the returnFundsToFaucet test - Check that faucet owns one utxo more after the test run - Check if initial vs. final faucet funds are just what we paid for the fees in the test --- .../test/Test/Hydra/Cluster/FaucetSpec.hs | 24 +++++++++++++++---- 1 file changed, 19 insertions(+), 5 deletions(-) diff --git a/hydra-cluster/test/Test/Hydra/Cluster/FaucetSpec.hs b/hydra-cluster/test/Test/Hydra/Cluster/FaucetSpec.hs index f6a60b34d19..ff022b4be85 100644 --- a/hydra-cluster/test/Test/Hydra/Cluster/FaucetSpec.hs +++ b/hydra-cluster/test/Test/Hydra/Cluster/FaucetSpec.hs @@ -3,9 +3,11 @@ module Test.Hydra.Cluster.FaucetSpec where import Hydra.Prelude import Test.Hydra.Prelude +import Cardano.Api.UTxO (pairs) import CardanoNode (RunningNode (..), withCardanoNodeDevnet) import Control.Concurrent.Async (replicateConcurrently_) -import Hydra.Cardano.Api (txOutValue) +import Hydra.Cardano.Api (AssetId (AdaAssetId), txOutValue) +import Hydra.Cardano.Api.Prelude (selectAsset) import Hydra.Chain.CardanoClient (QueryPoint (..), queryUTxOFor) import Hydra.Cluster.Faucet (Marked (Normal), returnFundsToFaucet, seedFromFaucet, seedFromFaucet_) import Hydra.Cluster.Fixture (Actor (..)) @@ -35,10 +37,22 @@ spec = do let faucetTracer = contramap FromFaucet tracer actor <- generate $ elements [Alice, Bob, Carol] (vk, _) <- keysFor actor - _seeded <- seedFromFaucet node vk 100_000_000 Normal faucetTracer + (faucetVk, _) <- keysFor Faucet + initialFaucetFunds <- queryUTxOFor networkId nodeSocket QueryTip faucetVk + seeded <- seedFromFaucet node vk 100_000_000 Normal faucetTracer returnFundsToFaucet faucetTracer node actor remaining <- queryUTxOFor networkId nodeSocket QueryTip vk - -- TODO: check remaining funds for actor and faucet + finalFaucetFunds <- queryUTxOFor networkId nodeSocket QueryTip faucetVk foldMap txOutValue remaining `shouldBe` mempty - -- TODO: could ensure only one UTxO is added to the faucet. - pure () + + let seededUTxOLength = length (pairs seeded) + let remainingUTxOLength = length (pairs remaining) + -- check the faucet has one utxo extra in the end + seededUTxOLength `shouldBe` remainingUTxOLength + 1 + + let initialFaucetValue = selectAsset (foldMap txOutValue initialFaucetFunds) AdaAssetId + let finalFaucetValue = selectAsset (foldMap txOutValue finalFaucetFunds) AdaAssetId + let difference = initialFaucetValue - finalFaucetValue + -- difference between starting faucet amount and final one should + -- just be the amount of paid fees + difference `shouldSatisfy` (< 340_000) From f164cff66fbcf97f35c7e0bfa63f0fe9e42cbaa1 Mon Sep 17 00:00:00 2001 From: Sasha Bogicevic Date: Wed, 15 Mar 2023 14:56:08 +0100 Subject: [PATCH 6/7] Trace returned funds to the faucet --- hydra-cluster/src/Hydra/Cluster/Faucet.hs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/hydra-cluster/src/Hydra/Cluster/Faucet.hs b/hydra-cluster/src/Hydra/Cluster/Faucet.hs index 8c53ad6bb3a..0ce82b1e697 100644 --- a/hydra-cluster/src/Hydra/Cluster/Faucet.hs +++ b/hydra-cluster/src/Hydra/Cluster/Faucet.hs @@ -30,7 +30,7 @@ import Hydra.Chain.Direct.ScriptRegistry ( publishHydraScripts, ) import Hydra.Chain.Direct.Util (isMarkedOutput, markerDatumHash) -import Hydra.Cluster.Fixture (Actor (Faucet)) +import Hydra.Cluster.Fixture (Actor (Faucet), actorName) import Hydra.Cluster.Util (keysFor) import Hydra.Ledger (balance) import Hydra.Ledger.Cardano () @@ -44,8 +44,9 @@ data FaucetException instance Exception FaucetException -newtype FaucetLog +data FaucetLog = TraceResourceExhaustedHandled Text + | ReturnedFunds {actor :: String, returnAmount :: Lovelace} deriving stock (Eq, Show, Generic) deriving anyclass (ToJSON, FromJSON) @@ -121,16 +122,17 @@ returnFundsToFaucet tracer RunningNode{networkId, nodeSocket} sender = do (senderVk, senderSk) <- keysFor sender utxo <- queryUTxOFor networkId nodeSocket QueryTip senderVk - -- TODO: re-add? traceWith tracer $ ReturningFunds{actor = actorName sender, returnAmount = returnBalance} retryOnExceptions tracer $ do let allLovelace = selectLovelace $ balance @Tx utxo -- XXX: Using a hard-coded high-enough value to satisfy the min utxo value. -- NOTE: We use the faucet address as the change deliberately here. tx <- sign senderSk <$> buildTxBody utxo faucetAddress 1_000_000 let fee = txFee' tx - tx' <- sign senderSk <$> buildTxBody utxo faucetAddress (allLovelace - fee) + let returnBalance = allLovelace - fee + tx' <- sign senderSk <$> buildTxBody utxo faucetAddress returnBalance submitTransaction networkId nodeSocket tx' void $ awaitTransaction networkId nodeSocket tx' + traceWith tracer $ ReturnedFunds{actor = actorName sender, returnAmount = returnBalance} where buildTxBody utxo faucetAddress lovelace = let theOutput = TxOut faucetAddress (lovelaceToValue lovelace) TxOutDatumNone ReferenceScriptNone From ba0b9173b1c64861c70fe7b593f5fd677fadb633 Mon Sep 17 00:00:00 2001 From: Sasha Bogicevic Date: Thu, 16 Mar 2023 22:33:40 +0100 Subject: [PATCH 7/7] PR review changes --- hydra-cluster/src/Hydra/Cluster/Faucet.hs | 27 ++++++++++++++----- .../test/Test/Hydra/Cluster/FaucetSpec.hs | 5 +--- 2 files changed, 22 insertions(+), 10 deletions(-) diff --git a/hydra-cluster/src/Hydra/Cluster/Faucet.hs b/hydra-cluster/src/Hydra/Cluster/Faucet.hs index 0ce82b1e697..f2dc5959b0c 100644 --- a/hydra-cluster/src/Hydra/Cluster/Faucet.hs +++ b/hydra-cluster/src/Hydra/Cluster/Faucet.hs @@ -115,7 +115,7 @@ returnFundsToFaucet :: RunningNode -> Actor -> IO () -returnFundsToFaucet tracer RunningNode{networkId, nodeSocket} sender = do +returnFundsToFaucet tracer node@RunningNode{networkId, nodeSocket} sender = do (faucetVk, _) <- keysFor Faucet let faucetAddress = mkVkAddress networkId faucetVk @@ -126,12 +126,11 @@ returnFundsToFaucet tracer RunningNode{networkId, nodeSocket} sender = do let allLovelace = selectLovelace $ balance @Tx utxo -- XXX: Using a hard-coded high-enough value to satisfy the min utxo value. -- NOTE: We use the faucet address as the change deliberately here. - tx <- sign senderSk <$> buildTxBody utxo faucetAddress 1_000_000 - let fee = txFee' tx + fee <- calculateTxFee node senderSk utxo faucetAddress 1_000_000 let returnBalance = allLovelace - fee - tx' <- sign senderSk <$> buildTxBody utxo faucetAddress returnBalance - submitTransaction networkId nodeSocket tx' - void $ awaitTransaction networkId nodeSocket tx' + tx <- sign senderSk <$> buildTxBody utxo faucetAddress returnBalance + submitTransaction networkId nodeSocket tx + void $ awaitTransaction networkId nodeSocket tx traceWith tracer $ ReturnedFunds{actor = actorName sender, returnAmount = returnBalance} where buildTxBody utxo faucetAddress lovelace = @@ -140,6 +139,22 @@ returnFundsToFaucet tracer RunningNode{networkId, nodeSocket} sender = do Left e -> throwIO $ FaucetFailedToBuildTx{reason = e} Right body -> pure body +-- | Build and sign tx and return the calculated fee. +-- - Signing key should be the key of a sender +-- - Address is used as a change address. +calculateTxFee + :: RunningNode + -> SigningKey PaymentKey + -> UTxO + -> AddressInEra + -> Lovelace + -> IO Lovelace +calculateTxFee RunningNode{networkId, nodeSocket} secretKey utxo addr lovelace = + let theOutput = TxOut addr (lovelaceToValue lovelace) TxOutDatumNone ReferenceScriptNone + in buildTransaction networkId nodeSocket addr utxo [] [theOutput] >>= \case + Left e -> throwIO $ FaucetFailedToBuildTx{reason = e} + Right body -> pure $ txFee' (sign secretKey body) + -- | Try to submit tx and retry when some caught exception/s take place. retryOnExceptions :: (MonadCatch m, MonadDelay m) => Tracer m FaucetLog -> m () -> m () retryOnExceptions tracer action = diff --git a/hydra-cluster/test/Test/Hydra/Cluster/FaucetSpec.hs b/hydra-cluster/test/Test/Hydra/Cluster/FaucetSpec.hs index ff022b4be85..e814c3cd5ae 100644 --- a/hydra-cluster/test/Test/Hydra/Cluster/FaucetSpec.hs +++ b/hydra-cluster/test/Test/Hydra/Cluster/FaucetSpec.hs @@ -3,7 +3,6 @@ module Test.Hydra.Cluster.FaucetSpec where import Hydra.Prelude import Test.Hydra.Prelude -import Cardano.Api.UTxO (pairs) import CardanoNode (RunningNode (..), withCardanoNodeDevnet) import Control.Concurrent.Async (replicateConcurrently_) import Hydra.Cardano.Api (AssetId (AdaAssetId), txOutValue) @@ -45,10 +44,8 @@ spec = do finalFaucetFunds <- queryUTxOFor networkId nodeSocket QueryTip faucetVk foldMap txOutValue remaining `shouldBe` mempty - let seededUTxOLength = length (pairs seeded) - let remainingUTxOLength = length (pairs remaining) -- check the faucet has one utxo extra in the end - seededUTxOLength `shouldBe` remainingUTxOLength + 1 + length seeded `shouldBe` length remaining + 1 let initialFaucetValue = selectAsset (foldMap txOutValue initialFaucetFunds) AdaAssetId let finalFaucetValue = selectAsset (foldMap txOutValue finalFaucetFunds) AdaAssetId