diff --git a/hydra-cluster/src/Hydra/Cluster/Faucet.hs b/hydra-cluster/src/Hydra/Cluster/Faucet.hs index 94750060b52..22887481cca 100644 --- a/hydra-cluster/src/Hydra/Cluster/Faucet.hs +++ b/hydra-cluster/src/Hydra/Cluster/Faucet.hs @@ -37,8 +37,8 @@ import Hydra.Ledger.Cardano () data Marked = Fuel | Normal data FaucetException - = FaucetHasNotEnoughFunds {faucetUTxO :: UTxO} - | FaucetFailedToBuildTx {reason :: TxBodyErrorAutoBalance} + = NotEnoughFunds {utxos :: UTxO, requestedAmount :: Lovelace} + | FailedToBuildTx {reason :: TxBodyErrorAutoBalance} deriving (Show) instance Exception FaucetException @@ -48,6 +48,27 @@ newtype FaucetLog deriving stock (Eq, Show, Generic) deriving anyclass (ToJSON, FromJSON) +sendFundsTo :: + RunningNode -> + -- | Sender keys + (VerificationKey PaymentKey, SigningKey PaymentKey) -> + -- | Receiving verification key + VerificationKey PaymentKey -> + -- | Amount to return to faucet + Lovelace -> + -- | Marked as fuel or normal output? + Marked -> + Tracer IO FaucetLog -> + -- | Should we filter utxo to find the one containing more lovelace than we want to send? + Bool -> + IO UTxO +sendFundsTo cardanoNode@RunningNode{networkId, nodeSocket} (senderVk, senderSk) receivingVerificationKey lovelace marked tracer shouldFilter = do + retryOnExceptions tracer $ + buildAndSubmitTx cardanoNode lovelace marked receivingAddress senderVk senderSk shouldFilter + waitForPayment networkId nodeSocket lovelace receivingAddress + where + receivingAddress = buildAddress receivingVerificationKey networkId + -- | Create a specially marked "seed" UTXO containing requested 'Lovelace' by -- redeeming funds available to the well-known faucet. seedFromFaucet :: @@ -60,47 +81,37 @@ seedFromFaucet :: Marked -> Tracer IO FaucetLog -> IO UTxO -seedFromFaucet RunningNode{networkId, nodeSocket} receivingVerificationKey lovelace marked tracer = do +seedFromFaucet cardanoNode@RunningNode{networkId, nodeSocket} receivingVerificationKey lovelace marked tracer = do (faucetVk, faucetSk) <- keysFor Faucet - retryOnExceptions $ submitSeedTx faucetVk faucetSk + retryOnExceptions tracer $ + buildAndSubmitTx cardanoNode lovelace marked receivingAddress faucetVk faucetSk True 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) - buildTransaction networkId nodeSocket changeAddress faucetUTxO [] [theOutput] >>= \case - Left e -> throwIO $ FaucetFailedToBuildTx{reason = e} - Right body -> do - submitTransaction networkId nodeSocket (sign faucetSk body) - - findUTxO faucetVk = do - faucetUTxO <- queryUTxO networkId nodeSocket QueryTip [buildAddress faucetVk networkId] - let foundUTxO = UTxO.filter (\o -> txOutLovelace o >= lovelace) faucetUTxO - when (null foundUTxO) $ - throwIO $ FaucetHasNotEnoughFunds{faucetUTxO} - pure foundUTxO - receivingAddress = buildAddress receivingVerificationKey networkId +buildAndSubmitTx :: + RunningNode -> + -- | Amount of lovelace to send to the reciver + Lovelace -> + -- | Marked as fuel or normal output? + Marked -> + -- | Receiving address + Address ShelleyAddr -> + -- | Sender verification key + VerificationKey PaymentKey -> + -- | Sender signing key + SigningKey PaymentKey -> + -- | Should we filter utxo to find the one containing more lovelace than we want to send? + Bool -> + IO () +buildAndSubmitTx cardanoNode@RunningNode{networkId, nodeSocket} lovelace marked receivingAddress senderVk senderSk shouldFilter = do + utxo <- findUTxO cardanoNode lovelace senderVk shouldFilter + let changeAddress = ShelleyAddressInEra (buildAddress senderVk networkId) + buildTransaction networkId nodeSocket changeAddress utxo [] [theOutput] >>= \case + Left e -> throwIO $ FailedToBuildTx{reason = e} + Right body -> do + submitTransaction networkId nodeSocket (sign senderSk body) + where theOutput = TxOut (shelleyAddressInEra receivingAddress) @@ -112,6 +123,40 @@ seedFromFaucet RunningNode{networkId, nodeSocket} receivingVerificationKey lovel Fuel -> TxOutDatumHash markerDatumHash Normal -> TxOutDatumNone +-- | 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 + +-- | Find the utxo for the corresponding verification key +-- We expect proper utxo to have more 'Lovelace' than the @lovelace@ argument +findUTxO :: RunningNode -> Lovelace -> VerificationKey PaymentKey -> Bool -> IO UTxO +findUTxO RunningNode{networkId, nodeSocket} lovelace faucetVk shouldFilter = do + utxos <- queryUTxO networkId nodeSocket QueryTip [buildAddress faucetVk networkId] + let foundUTxO = + if shouldFilter + then UTxO.filter (\o -> txOutLovelace o >= lovelace) utxos + else utxos + when (null foundUTxO) $ + throwIO $ NotEnoughFunds{utxos, requestedAmount = lovelace} + pure foundUTxO + -- | Like 'seedFromFaucet', but without returning the seeded 'UTxO'. seedFromFaucet_ :: RunningNode -> diff --git a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs index cb50c51df66..3f04465cbf9 100644 --- a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs +++ b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs @@ -5,16 +5,16 @@ module Hydra.Cluster.Scenarios where import Hydra.Prelude -import CardanoClient (queryTip) +import CardanoClient (QueryPoint (..), queryTip, queryUTxOFor) import CardanoNode (RunningNode (..)) import Control.Lens ((^?)) import Data.Aeson (Value, object, (.=)) import Data.Aeson.Lens (key, _JSON) import Data.Aeson.Types (parseMaybe) import qualified Data.Set as Set -import Hydra.Cardano.Api (Lovelace, TxId, selectLovelace) +import Hydra.Cardano.Api (Lovelace, NetworkId (..), TxId, selectLovelace) import Hydra.Chain (HeadId) -import Hydra.Cluster.Faucet (Marked (Fuel), queryMarkedUTxO, seedFromFaucet, seedFromFaucet_) +import Hydra.Cluster.Faucet (Marked (Fuel, Normal), queryMarkedUTxO, seedFromFaucet_, sendFundsTo) import Hydra.Cluster.Fixture (Actor (..), actorName, alice, aliceSk, aliceVk, bob, bobSk, bobVk) import Hydra.Cluster.Util (chainConfigFor, keysFor) import Hydra.ContestationPeriod (ContestationPeriod (UnsafeContestationPeriod)) @@ -26,12 +26,18 @@ import Hydra.Party (Party) import HydraNode (EndToEndLog (..), input, output, send, waitFor, waitForAllMatch, waitMatch, withHydraNode) import Test.Hspec.Expectations (shouldBe) +-- | Determine the amount we want to grab from the faucet based on network +seedFromFaucetAmount :: NetworkId -> Lovelace +seedFromFaucetAmount Mainnet = 100_000_000 +seedFromFaucetAmount _ = 100_000_000 + restartedNodeCanObserveCommitTx :: Tracer IO EndToEndLog -> FilePath -> RunningNode -> TxId -> IO () restartedNodeCanObserveCommitTx tracer workDir cardanoNode hydraScriptsTxId = do let clients = [Alice, Bob] [(aliceCardanoVk, _), (bobCardanoVk, _)] <- forM clients keysFor - seedFromFaucet_ cardanoNode aliceCardanoVk 100_000_000 Fuel (contramap FromFaucet tracer) - seedFromFaucet_ cardanoNode bobCardanoVk 100_000_000 Fuel (contramap FromFaucet tracer) + let seedAmount = seedFromFaucetAmount networkId + seedFromFaucet_ cardanoNode aliceCardanoVk seedAmount Fuel (contramap FromFaucet tracer) + seedFromFaucet_ cardanoNode bobCardanoVk seedAmount Fuel (contramap FromFaucet tracer) let contestationPeriod = UnsafeContestationPeriod 1 aliceChainConfig <- @@ -62,7 +68,8 @@ restartedNodeCanObserveCommitTx tracer workDir cardanoNode hydraScriptsTxId = do restartedNodeCanAbort :: Tracer IO EndToEndLog -> FilePath -> RunningNode -> TxId -> IO () restartedNodeCanAbort tracer workDir cardanoNode hydraScriptsTxId = do - refuelIfNeeded tracer cardanoNode Alice 100_000_000 + let seedAmount = seedFromFaucetAmount networkId + refuelIfNeeded tracer cardanoNode Alice seedAmount let contestationPeriod = UnsafeContestationPeriod 2 aliceChainConfig <- chainConfigFor Alice workDir nodeSocket [] contestationPeriod @@ -95,7 +102,8 @@ singlePartyHeadFullLifeCycle :: TxId -> IO () singlePartyHeadFullLifeCycle tracer workDir node@RunningNode{networkId} hydraScriptsTxId = do - refuelIfNeeded tracer node Alice 100_000_000 + let seedAmount = seedFromFaucetAmount networkId + refuelIfNeeded tracer node Alice seedAmount -- Start hydra-node on chain tip tip <- queryTip networkId nodeSocket let contestationPeriod = UnsafeContestationPeriod 100 @@ -125,6 +133,7 @@ singlePartyHeadFullLifeCycle tracer workDir node@RunningNode{networkId} hydraScr waitFor tracer 600 [n1] $ output "HeadIsFinalized" ["utxo" .= object mempty, "headId" .= headId] traceRemainingFunds Alice + `finally` returnAssetsToFaucet tracer node Alice where RunningNode{nodeSocket} = node @@ -143,7 +152,8 @@ canCloseWithLongContestationPeriod :: TxId -> IO () canCloseWithLongContestationPeriod tracer workDir node@RunningNode{networkId} hydraScriptsTxId = do - refuelIfNeeded tracer node Alice 100_000_000 + let seedAmount = seedFromFaucetAmount networkId + refuelIfNeeded tracer node Alice seedAmount -- Start hydra-node on chain tip tip <- queryTip networkId nodeSocket let oneWeek = UnsafeContestationPeriod (60 * 60 * 24 * 7) @@ -179,14 +189,31 @@ refuelIfNeeded :: Actor -> Lovelace -> IO () -refuelIfNeeded tracer node actor amount = do - (actorVk, _) <- keysFor actor - (fuelUTxO, otherUTxO) <- queryMarkedUTxO node actorVk - traceWith tracer $ StartingFunds{actor = actorName actor, fuelUTxO, otherUTxO} +refuelIfNeeded tracer node receiver amount = do + (receivingVk, _) <- keysFor receiver + (senderVk, senderSk) <- keysFor Faucet + (fuelUTxO, otherUTxO) <- queryMarkedUTxO node receivingVk + traceWith tracer $ StartingFunds{actor = actorName receiver, fuelUTxO, otherUTxO} let fuelBalance = selectLovelace $ balance @Tx fuelUTxO when (fuelBalance < amount) $ do - utxo <- seedFromFaucet node actorVk amount Fuel (contramap FromFaucet tracer) - traceWith tracer $ RefueledFunds{actor = actorName actor, refuelingAmount = amount, fuelUTxO = utxo} + utxo <- sendFundsTo node (senderVk, senderSk) receivingVk amount Fuel (contramap FromFaucet tracer) True + traceWith tracer $ RefueledFunds{actor = actorName receiver, refuelingAmount = amount, fuelUTxO = utxo} + +-- | Return the remaining funds to the faucet +returnAssetsToFaucet :: + Tracer IO EndToEndLog -> + RunningNode -> + Actor -> + IO () +returnAssetsToFaucet tracer node@RunningNode{networkId, nodeSocket} sender = do + (receivingVk, _) <- keysFor Faucet + (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_200_000 + void $ sendFundsTo node (senderVk, senderSk) receivingVk returnBalance Normal (contramap FromFaucet tracer) False + traceWith tracer $ ReturningToFaucet{actor = actorName sender, returnAmount = returnBalance} headIsInitializingWith :: Set Party -> Value -> Maybe HeadId headIsInitializingWith expectedParties v = do diff --git a/hydra-cluster/src/HydraNode.hs b/hydra-cluster/src/HydraNode.hs index 994b57bb175..582e6984e4b 100644 --- a/hydra-cluster/src/HydraNode.hs +++ b/hydra-cluster/src/HydraNode.hs @@ -189,6 +189,7 @@ data EndToEndLog | StartingFunds {actor :: String, fuelUTxO :: UTxO, otherUTxO :: UTxO} | RefueledFunds {actor :: String, refuelingAmount :: Lovelace, fuelUTxO :: UTxO} | RemainingFunds {actor :: String, fuelUTxO :: UTxO, otherUTxO :: UTxO} + | ReturningToFaucet {actor :: String, returnAmount :: Lovelace} | PublishedHydraScriptsAt {hydraScriptsTxId :: TxId} | UsingHydraScriptsAt {hydraScriptsTxId :: TxId} deriving (Eq, Show, Generic, ToJSON, FromJSON, ToObject)