Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Pay back funds to faucet after smoke-test run #770

Closed
wants to merge 7 commits into from
Closed

Pay back funds to faucet after smoke-test run #770

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
7 commits
Select commit Hold shift + click to select a range
de84c59
Introduce network dependent seed lovelace amount
v0d1ch Mar 9, 2023
5552be3
Refactor Faucet code so we can re-use it
v0d1ch Mar 9, 2023
e11ad77
Refactor code to generalize Faucet functions a bit
v0d1ch Mar 9, 2023
0db777c
Rename FaucetException constructors
v0d1ch Mar 10, 2023
af22d7a
Introduce a requestedAmount field to NotEnoughFunds to observe errors…
v0d1ch Mar 10, 2023
44dc719
Add flag to decide if utxos should be filtered
v0d1ch Mar 10, 2023
5011714
Hardcode the fee for faucet tx
v0d1ch Mar 14, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
121 changes: 83 additions & 38 deletions hydra-cluster/src/Hydra/Cluster/Faucet.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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}
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Could: use utxo for a name as it's more often used in the code base.

| FailedToBuildTx {reason :: TxBodyErrorAutoBalance}
deriving (Show)

instance Exception FaucetException
Expand All @@ -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 ::
Expand All @@ -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 ->
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Should: not compose functions this way.

This Bool is a smell to me. It indicates that you are using only a part of the code below in some cases. Why not structure it differently to assemble what you need and don't need better?

I'll point out more comments at the usage sites.

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)
Expand All @@ -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
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Should: not compose functions this way.

This is seedFromFaucet specific functionality and the Bool flag is smelly. Keep this functionality in seedFromFaucet, and not change it .. or change it with the enhancement of selecting multiple UTxo to meet the requested lovelace. (This is what this PR should be about).

If you want to reduce boiler plate of the queryUTxO networkId nodeSocket QueryTip [buildAddress faucetVk networkId], that would be a good function to have a separate queryFaucetUTxO or so if you want (but not do refactor too early).


-- | Like 'seedFromFaucet', but without returning the seeded 'UTxO'.
seedFromFaucet_ ::
RunningNode ->
Expand Down
55 changes: 41 additions & 14 deletions hydra-cluster/src/Hydra/Cluster/Scenarios.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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))
Expand All @@ -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
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Could: not do this, but just find a common denominator between networks.

I see why you want to do this, but I think it's not important how much we seed things with. It just needs to meet the minimum UTxO requirements. We don't expect these tests don't behave different with big or small amounts (if we would, we also should test NFTs). These are only E2E or even smoke tests - their scope is limited.

This parameter can stay uniform for all networks as we do not change valuation or minima in the parameters.


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 <-
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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

Expand All @@ -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)
Expand Down Expand Up @@ -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
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Should: use the better named and higher-level API (using the actor type) seedFromFaucet here.

It's not clear to me why the lower-level sendFundsTo was used here. The whole refuelIfNeeded should stay as it was.

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
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Should: do what sendFundsTo ... Normal ... False means directly here.

This is the only usage of sendFundsTo with this parameterization, so there is no point in creating a function, which even contains optional semantics (smelly).

traceWith tracer $ ReturningToFaucet{actor = actorName sender, returnAmount = returnBalance}

headIsInitializingWith :: Set Party -> Value -> Maybe HeadId
headIsInitializingWith expectedParties v = do
Expand Down
1 change: 1 addition & 0 deletions hydra-cluster/src/HydraNode.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down