Skip to content

Commit

Permalink
Add flag to decide if utxos should be filtered
Browse files Browse the repository at this point in the history
- When we _seed from faucet_ we expect one faucet utxo to contain more
lovelace than expected. BUT when we want to return the funds to the
faucet we actually don't care about filtering.

- Added a todo on how to handle fees when returning funds?
  • Loading branch information
v0d1ch committed Mar 10, 2023
1 parent f86c30e commit 260090f
Show file tree
Hide file tree
Showing 2 changed files with 20 additions and 11 deletions.
23 changes: 15 additions & 8 deletions hydra-cluster/src/Hydra/Cluster/Faucet.hs
Original file line number Diff line number Diff line change
Expand Up @@ -59,10 +59,12 @@ sendFundsTo ::
-- | 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 = do
sendFundsTo cardanoNode@RunningNode{networkId, nodeSocket} (senderVk, senderSk) receivingVerificationKey lovelace marked tracer shouldFilter = do
retryOnExceptions tracer $
buildAndSubmitTx cardanoNode lovelace marked receivingAddress senderVk senderSk
buildAndSubmitTx cardanoNode lovelace marked receivingAddress senderVk senderSk shouldFilter
waitForPayment networkId nodeSocket lovelace receivingAddress
where
receivingAddress = buildAddress receivingVerificationKey networkId
Expand All @@ -82,7 +84,7 @@ seedFromFaucet ::
seedFromFaucet cardanoNode@RunningNode{networkId, nodeSocket} receivingVerificationKey lovelace marked tracer = do
(faucetVk, faucetSk) <- keysFor Faucet
retryOnExceptions tracer $
buildAndSubmitTx cardanoNode lovelace marked receivingAddress faucetVk faucetSk
buildAndSubmitTx cardanoNode lovelace marked receivingAddress faucetVk faucetSk True
waitForPayment networkId nodeSocket lovelace receivingAddress
where
receivingAddress = buildAddress receivingVerificationKey networkId
Expand All @@ -99,9 +101,11 @@ buildAndSubmitTx ::
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 = do
utxo <- findUTxO cardanoNode lovelace senderVk
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}
Expand Down Expand Up @@ -142,10 +146,13 @@ retryOnExceptions tracer action =

-- | 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 -> IO UTxO
findUTxO RunningNode{networkId, nodeSocket} lovelace faucetVk = do
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 = UTxO.filter (\o -> txOutLovelace o >= lovelace) utxos
let foundUTxO =
if shouldFilter
then UTxO.filter (\o -> txOutLovelace o >= lovelace) utxos
else utxos
when (null foundUTxO) $
throwIO $ NotEnoughFunds{utxos, requestedAmount = lovelace}
pure foundUTxO
Expand Down
8 changes: 5 additions & 3 deletions hydra-cluster/src/Hydra/Cluster/Scenarios.hs
Original file line number Diff line number Diff line change
Expand Up @@ -196,7 +196,7 @@ refuelIfNeeded tracer node receiver amount = do
traceWith tracer $ StartingFunds{actor = actorName receiver, fuelUTxO, otherUTxO}
let fuelBalance = selectLovelace $ balance @Tx fuelUTxO
when (fuelBalance < amount) $ do
utxo <- sendFundsTo node (senderVk, senderSk) receivingVk amount Fuel (contramap FromFaucet tracer)
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
Expand All @@ -209,8 +209,10 @@ returnAssetsToFaucet tracer node@RunningNode{networkId, nodeSocket} sender = do
(receivingVk, _) <- keysFor Faucet
(senderVk, senderSk) <- keysFor sender
utxo <- queryUTxOFor networkId nodeSocket QueryTip senderVk
let returnBalance = selectLovelace $ balance @Tx utxo
void $ sendFundsTo node (senderVk, senderSk) receivingVk returnBalance Normal (contramap FromFaucet tracer)
-- TODO: 'balance' here is just `foldMap txOutValue` so it doesn't actually ballance anything.
-- How to exclude the fees from the amount? This hardcoded subtraction needs to go away
let returnBalance = (selectLovelace $ balance @Tx utxo) - 2_000_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
Expand Down

0 comments on commit 260090f

Please sign in to comment.