Merge pull request #512 from input-output-hk/fix/flaky_faucet_spec

fix(cluster): flaky faucet spec
input-output-hk · Sep 28, 2022 · f3b881a · f3b881a
2 parents 9b96323 + 002c85f
commit f3b881a
Show file tree

Hide file tree

Showing 8 changed files with 83 additions and 48 deletions.
diff --git a/hydra-cluster/bench/Bench/EndToEnd.hs b/hydra-cluster/bench/Bench/EndToEnd.hs
@@ -30,15 +30,15 @@ import qualified Data.Set as Set
 import Data.Time (UTCTime (UTCTime), nominalDiffTimeToSeconds, utctDayTime)
 import Hydra.Cardano.Api (Tx, TxId, UTxO, getVerificationKey)
 import Hydra.Chain.CardanoClient (awaitTransaction, submitTransaction)
-import Hydra.Cluster.Faucet (Marked (Fuel), publishHydraScriptsAs, seedFromFaucet)
+import Hydra.Cluster.Faucet (FaucetLog, Marked (Fuel), publishHydraScriptsAs, seedFromFaucet)
 import Hydra.Cluster.Fixture (Actor (Faucet), defaultNetworkId)
 import Hydra.Crypto (generateSigningKey)
 import Hydra.Generator (ClientDataset (..), Dataset (..))
 import Hydra.Ledger (txId)
-import Hydra.Logging (withTracerOutputTo)
+import Hydra.Logging (Tracer, withTracerOutputTo)
 import Hydra.Party (deriveParty)
 import HydraNode (
-  EndToEndLog (FromCardanoNode),
+  EndToEndLog (FromCardanoNode, FromFaucet),
   HydraClient,
   hydraNodeId,
   input,
@@ -83,7 +83,7 @@ bench timeoutSeconds workDir dataset@Dataset{clientDatasets} clusterSize =
           withOSStats workDir $
             withCardanoNodeDevnet (contramap FromCardanoNode tracer) workDir $ \node@RunningNode{nodeSocket} -> do
               putTextLn "Seeding network"
-              hydraScriptsTxId <- seedNetwork node dataset
+              hydraScriptsTxId <- seedNetwork node dataset (contramap FromFaucet tracer)
               withHydraCluster tracer workDir nodeSocket 0 cardanoKeys hydraKeys hydraScriptsTxId $ \(leader :| followers) -> do
                 let clients = leader : followers
                 waitForNodesConnected tracer clients
@@ -217,8 +217,8 @@ movingAverage confirmations =
 -- | Distribute 100 ADA fuel, starting funds from faucet for each client in the
 -- dataset, and also publish the hydra scripts. The 'TxId' of the publishing
 -- transaction is returned.
-seedNetwork :: RunningNode -> Dataset -> IO TxId
-seedNetwork node@RunningNode{nodeSocket} Dataset{fundingTransaction, clientDatasets} = do
+seedNetwork :: RunningNode -> Dataset -> Tracer IO FaucetLog -> IO TxId
+seedNetwork node@RunningNode{nodeSocket} Dataset{fundingTransaction, clientDatasets} tracer = do
   fundClients
   forM_ clientDatasets fuelWith100Ada
   publishHydraScriptsAs node Faucet
@@ -229,7 +229,7 @@ seedNetwork node@RunningNode{nodeSocket} Dataset{fundingTransaction, clientDatas
 
   fuelWith100Ada ClientDataset{signingKey} = do
     let vk = getVerificationKey signingKey
-    seedFromFaucet node vk 100_000_000 Fuel
+    seedFromFaucet node vk 100_000_000 Fuel tracer
 
 -- | Commit all (expected to exit) 'initialUTxO' from the dataset using the
 -- (asumed same sequence) of clients.

diff --git a/hydra-cluster/src/Hydra/Cluster/Faucet.hs b/hydra-cluster/src/Hydra/Cluster/Faucet.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DerivingStrategies #-}
 
 module Hydra.Cluster.Faucet where
@@ -14,7 +15,11 @@ import CardanoClient (
   waitForPayment,
  )
 import CardanoNode (RunningNode (..))
+import Control.Exception (IOException)
+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,
@@ -24,7 +29,7 @@ import Hydra.Chain.CardanoClient (
 import Hydra.Chain.Direct.ScriptRegistry (
   publishHydraScripts,
  )
-import Hydra.Chain.Direct.Util (isMarkedOutput, markerDatumHash, retry)
+import Hydra.Chain.Direct.Util (isMarkedOutput, markerDatumHash)
 import Hydra.Cluster.Fixture (Actor (Faucet))
 import Hydra.Cluster.Util (keysFor)
 import Hydra.Ledger.Cardano ()
@@ -38,6 +43,11 @@ data FaucetException
 
 instance Exception FaucetException
 
+newtype FaucetLog
+  = TraceResourceExhaustedHandled Text
+  deriving stock (Eq, Show, Generic)
+  deriving anyclass (ToJSON, FromJSON)
+
 -- | Create a specially marked "seed" UTXO containing requested 'Lovelace' by
 -- redeeming funds available to the well-known faucet.
 seedFromFaucet ::
@@ -48,12 +58,32 @@ seedFromFaucet ::
   Lovelace ->
   -- | Marked as fuel or normal output?
   Marked ->
+  Tracer IO FaucetLog ->
   IO UTxO
-seedFromFaucet RunningNode{networkId, nodeSocket} receivingVerificationKey lovelace marked = do
+seedFromFaucet RunningNode{networkId, nodeSocket} receivingVerificationKey lovelace marked tracer = do
   (faucetVk, faucetSk) <- keysFor Faucet
-  retry isSubmitTransactionException $ submitSeedTx faucetVk faucetSk
+  retryOnExceptions $ 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)
@@ -82,9 +112,6 @@ seedFromFaucet RunningNode{networkId, nodeSocket} receivingVerificationKey lovel
     Fuel -> TxOutDatumHash markerDatumHash
     Normal -> TxOutDatumNone
 
-  isSubmitTransactionException :: SubmitTransactionException -> Bool
-  isSubmitTransactionException = const True
-
 -- | Like 'seedFromFaucet', but without returning the seeded 'UTxO'.
 seedFromFaucet_ ::
   RunningNode ->
@@ -94,9 +121,10 @@ seedFromFaucet_ ::
   Lovelace ->
   -- | Marked as fuel or normal output?
   Marked ->
+  Tracer IO FaucetLog ->
   IO ()
-seedFromFaucet_ node vk ll marked =
-  void $ seedFromFaucet node vk ll marked
+seedFromFaucet_ node vk ll marked tracer =
+  void $ seedFromFaucet node vk ll marked tracer
 
 -- | Publish current Hydra scripts as scripts outputs for later referencing them.
 --

diff --git a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs
@@ -78,5 +78,5 @@ refuelIfNeeded tracer node actor amount = do
   traceWith tracer $ StartingFunds{actor = actorName actor, fuelUTxO, otherUTxO}
   let fuelBalance = selectLovelace $ balance @Tx fuelUTxO
   when (fuelBalance < amount) $ do
-    utxo <- seedFromFaucet node actorVk amount Fuel
+    utxo <- seedFromFaucet node actorVk amount Fuel (contramap FromFaucet tracer)
     traceWith tracer $ RefueledFunds{actor = actorName actor, refuelingAmount = amount, fuelUTxO = utxo}
diff --git a/hydra-cluster/src/HydraNode.hs b/hydra-cluster/src/HydraNode.hs
@@ -35,6 +35,7 @@ import Data.Aeson.Types (Pair)
 import qualified Data.ByteString as BS
 import qualified Data.List as List
 import qualified Data.Text as T
+import Hydra.Cluster.Faucet (FaucetLog)
 import Hydra.Cluster.Util (readConfigFile)
 import Hydra.Crypto (HydraKey)
 import Hydra.Ledger.Cardano ()
@@ -185,6 +186,7 @@ data EndToEndLog
   | ReceivedMessage Int Aeson.Value
   | EndWaiting Int
   | FromCardanoNode NodeLog
+  | FromFaucet FaucetLog
   | StartingFunds {actor :: String, fuelUTxO :: UTxO, otherUTxO :: UTxO}
   | RefueledFunds {actor :: String, refuelingAmount :: Lovelace, fuelUTxO :: UTxO}
   | RemainingFunds {actor :: String, fuelUTxO :: UTxO, otherUTxO :: UTxO}

diff --git a/hydra-cluster/test/Test/DirectChainSpec.hs b/hydra-cluster/test/Test/DirectChainSpec.hs
@@ -40,6 +40,7 @@ import Hydra.Chain.Direct (
 import Hydra.Chain.Direct.Handlers (DirectChainLog)
 import Hydra.Chain.Direct.ScriptRegistry (queryScriptRegistry)
 import Hydra.Cluster.Faucet (
+  FaucetLog,
   Marked (Fuel, Normal),
   publishHydraScriptsAs,
   seedFromFaucet,
@@ -78,7 +79,7 @@ spec = around showLogsOnFailure $ do
         bobKeys <- keysFor Bob
         cardanoKeys <- fmap fst <$> mapM keysFor [Alice, Bob, Carol]
         withIOManager $ \iocp -> do
-          seedFromFaucet_ node aliceCardanoVk 100_000_000 Fuel
+          seedFromFaucet_ node aliceCardanoVk 100_000_000 Fuel (contramap FromFaucet tracer)
           hydraScriptsTxId <- publishHydraScriptsAs node Faucet
           withDirectChain (contramap (FromDirectChain "alice") tracer) defaultNetworkId iocp nodeSocket aliceKeys alice cardanoKeys Nothing hydraScriptsTxId (putMVar alicesCallback) $ \Chain{postTx} -> do
             withDirectChain nullTracer defaultNetworkId iocp nodeSocket bobKeys bob cardanoKeys Nothing hydraScriptsTxId (putMVar bobsCallback) $ \_ -> do
@@ -100,7 +101,7 @@ spec = around showLogsOnFailure $ do
         bobKeys <- keysFor Bob
         cardanoKeys <- fmap fst <$> mapM keysFor [Alice, Bob, Carol]
         withIOManager $ \iocp -> do
-          seedFromFaucet_ node aliceCardanoVk 100_000_000 Fuel
+          seedFromFaucet_ node aliceCardanoVk 100_000_000 Fuel (contramap FromFaucet tracer)
           hydraScriptsTxId <- publishHydraScriptsAs node Faucet
           withDirectChain (contramap (FromDirectChain "alice") tracer) defaultNetworkId iocp nodeSocket aliceKeys alice cardanoKeys Nothing hydraScriptsTxId (putMVar alicesCallback) $ \Chain{postTx} -> do
             withDirectChain nullTracer defaultNetworkId iocp nodeSocket bobKeys bob cardanoKeys Nothing hydraScriptsTxId (putMVar bobsCallback) $ \_ -> do
@@ -109,7 +110,7 @@ spec = around showLogsOnFailure $ do
               bobsCallback `observesInTime` OnInitTx cperiod [alice, bob, carol]
 
               let aliceCommitment = 66_000_000
-              aliceUTxO <- seedFromFaucet node aliceCardanoVk aliceCommitment Normal
+              aliceUTxO <- seedFromFaucet node aliceCardanoVk aliceCommitment Normal (contramap FromFaucet tracer)
               postTx $ CommitTx alice aliceUTxO
 
               alicesCallback `observesInTime` OnCommitTx alice aliceUTxO
@@ -137,7 +138,7 @@ spec = around showLogsOnFailure $ do
         bobKeys <- keysFor Bob
         let cardanoKeys = [aliceCardanoVk, carolCardanoVk]
         withIOManager $ \iocp -> do
-          seedFromFaucet_ node aliceCardanoVk 100_000_000 Fuel
+          seedFromFaucet_ node aliceCardanoVk 100_000_000 Fuel (contramap FromFaucet tracer)
           hydraScriptsTxId <- publishHydraScriptsAs node Faucet
           withDirectChain (contramap (FromDirectChain "alice") tracer) defaultNetworkId iocp nodeSocket aliceKeys alice cardanoKeys Nothing hydraScriptsTxId (putMVar alicesCallback) $ \Chain{postTx = alicePostTx} -> do
             withDirectChain nullTracer defaultNetworkId iocp nodeSocket bobKeys bob cardanoKeys Nothing hydraScriptsTxId (putMVar bobsCallback) $ \Chain{postTx = bobPostTx} -> do
@@ -154,7 +155,7 @@ spec = around showLogsOnFailure $ do
       withCardanoNodeDevnet (contramap FromNode tracer) tmp $ \node@RunningNode{nodeSocket} -> do
         let cardanoKeys = [aliceCardanoVk]
         withIOManager $ \iocp -> do
-          seedFromFaucet_ node aliceCardanoVk 100_000_000 Fuel
+          seedFromFaucet_ node aliceCardanoVk 100_000_000 Fuel (contramap FromFaucet tracer)
           hydraScriptsTxId <- publishHydraScriptsAs node Faucet
           withDirectChain (contramap (FromDirectChain "alice") tracer) defaultNetworkId iocp nodeSocket aliceKeys alice cardanoKeys Nothing hydraScriptsTxId (putMVar alicesCallback) $ \Chain{postTx} -> do
             postTx $ InitTx $ HeadParameters cperiod [alice]
@@ -171,7 +172,7 @@ spec = around showLogsOnFailure $ do
                 (CannotSpendInput{} :: PostTxError Tx) -> True
                 _ -> False
 
-            aliceUTxO <- seedFromFaucet node aliceCardanoVk 1_000_000 Normal
+            aliceUTxO <- seedFromFaucet node aliceCardanoVk 1_000_000 Normal (contramap FromFaucet tracer)
             postTx $ CommitTx alice aliceUTxO
             alicesCallback `observesInTime` OnCommitTx alice aliceUTxO
 
@@ -182,7 +183,7 @@ spec = around showLogsOnFailure $ do
       withCardanoNodeDevnet (contramap FromNode tracer) tmp $ \node@RunningNode{nodeSocket} -> do
         let cardanoKeys = [aliceCardanoVk]
         withIOManager $ \iocp -> do
-          seedFromFaucet_ node aliceCardanoVk 100_000_000 Fuel
+          seedFromFaucet_ node aliceCardanoVk 100_000_000 Fuel (contramap FromFaucet tracer)
           hydraScriptsTxId <- publishHydraScriptsAs node Faucet
           withDirectChain (contramap (FromDirectChain "alice") tracer) defaultNetworkId iocp nodeSocket aliceKeys alice cardanoKeys Nothing hydraScriptsTxId (putMVar alicesCallback) $ \Chain{postTx} -> do
             postTx $ InitTx $ HeadParameters cperiod [alice]
@@ -198,13 +199,13 @@ spec = around showLogsOnFailure $ do
       withCardanoNodeDevnet (contramap FromNode tracer) tmp $ \node@RunningNode{nodeSocket} -> do
         let cardanoKeys = [aliceCardanoVk]
         withIOManager $ \iocp -> do
-          seedFromFaucet_ node aliceCardanoVk 100_000_000 Fuel
+          seedFromFaucet_ node aliceCardanoVk 100_000_000 Fuel (contramap FromFaucet tracer)
           hydraScriptsTxId <- publishHydraScriptsAs node Faucet
           withDirectChain (contramap (FromDirectChain "alice") tracer) defaultNetworkId iocp nodeSocket aliceKeys alice cardanoKeys Nothing hydraScriptsTxId (putMVar alicesCallback) $ \Chain{postTx} -> do
             postTx $ InitTx $ HeadParameters cperiod [alice]
             alicesCallback `observesInTime` OnInitTx cperiod [alice]
 
-            someUTxO <- seedFromFaucet node aliceCardanoVk 1_000_000 Normal
+            someUTxO <- seedFromFaucet node aliceCardanoVk 1_000_000 Normal (contramap FromFaucet tracer)
             postTx $ CommitTx alice someUTxO
             alicesCallback `observesInTime` OnCommitTx alice someUTxO
 
@@ -253,7 +254,7 @@ spec = around showLogsOnFailure $ do
       withCardanoNodeDevnet (contramap FromNode tracer) tmp $ \node@RunningNode{nodeSocket} -> do
         let cardanoKeys = [aliceCardanoVk]
         withIOManager $ \iocp -> do
-          seedFromFaucet_ node aliceCardanoVk 100_000_000 Fuel
+          seedFromFaucet_ node aliceCardanoVk 100_000_000 Fuel (contramap FromFaucet tracer)
           hydraScriptsTxId <- publishHydraScriptsAs node Faucet
           tip <- withDirectChain (contramap (FromDirectChain "alice") tracer) defaultNetworkId iocp nodeSocket aliceKeys alice cardanoKeys Nothing hydraScriptsTxId (putMVar alicesCallback) $ \Chain{postTx = alicePostTx} -> do
             tip <- queryTip defaultNetworkId nodeSocket
@@ -272,7 +273,7 @@ spec = around showLogsOnFailure $ do
         let aliceTrace = contramap (FromDirectChain "alice") tracer
         let cardanoKeys = [aliceCardanoVk]
         withIOManager $ \iocp -> do
-          seedFromFaucet_ node aliceCardanoVk 100_000_000 Fuel
+          seedFromFaucet_ node aliceCardanoVk 100_000_000 Fuel (contramap FromFaucet tracer)
           hydraScriptsTxId <- publishHydraScriptsAs node Faucet
 
           let headerHash = unsafeDeserialiseFromRawBytesBase16 (B8.replicate 64 '0')
@@ -307,6 +308,7 @@ spec = around showLogsOnFailure $ do
 data TestClusterLog
   = FromNode NodeLog
   | FromDirectChain Text DirectChainLog
+  | FromFaucet FaucetLog
   deriving (Show, Generic, ToJSON)
 
 observesInTime :: IsTx tx => MVar (ChainEvent tx) -> OnChainTx tx -> Expectation