From 260090faee234b07f196641e28ab7e31e1fe090f Mon Sep 17 00:00:00 2001
From: Sasha Bogicevic <sasha.bogicevic@iohk.io>
Date: Fri, 10 Mar 2023 16:01:02 +0100
Subject: [PATCH] Add flag to decide if utxos should be filtered

- 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?
---
 hydra-cluster/src/Hydra/Cluster/Faucet.hs    | 23 +++++++++++++-------
 hydra-cluster/src/Hydra/Cluster/Scenarios.hs |  8 ++++---
 2 files changed, 20 insertions(+), 11 deletions(-)

diff --git a/hydra-cluster/src/Hydra/Cluster/Faucet.hs b/hydra-cluster/src/Hydra/Cluster/Faucet.hs
index 0256db341d5..22887481cca 100644
--- a/hydra-cluster/src/Hydra/Cluster/Faucet.hs
+++ b/hydra-cluster/src/Hydra/Cluster/Faucet.hs
@@ -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
@@ -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
@@ -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}
@@ -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
diff --git a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs
index ac0a52af648..6c70cf8dfe3 100644
--- a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs
+++ b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs
@@ -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
@@ -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