Improved delayEpoch so it waits until it reaches the target epoch

Added queryEpochNo to cardano-node client to support this operation.
cardano-scaling · Dec 22, 2023 · 2b3c271 · 2b3c271
1 parent ed41f2d
commit 2b3c271
Show file tree

Hide file tree

Showing 2 changed files with 48 additions and 25 deletions.
diff --git a/hydra-cluster/test/Test/EndToEndSpec.hs b/hydra-cluster/test/Test/EndToEndSpec.hs
@@ -7,7 +7,7 @@ import Hydra.Prelude
 import Test.Hydra.Prelude
 
 import Cardano.Api.UTxO qualified as UTxO
-import CardanoClient (QueryPoint (..), queryGenesisParameters, queryTip, queryTipSlotNo, submitTx, waitForUTxO)
+import CardanoClient (QueryPoint (..), queryEpochNo, queryGenesisParameters, queryTip, queryTipSlotNo, submitTx, waitForUTxO)
 import CardanoNode (
   CardanoNodeArgs (..),
   RunningNode (..),
@@ -42,6 +42,7 @@ import Hydra.Cardano.Api (
   mkVkAddress,
   serialiseAddress,
   signTx,
+  unEpochNo,
   pattern TxOut,
   pattern TxValidityLowerBound,
  )
@@ -513,48 +514,52 @@ spec = around (showLogsOnFailure "EndToEndSpec") $ do
         withClusterTempDir "unsupported-era" $ \tmpDir -> do
           args <- setupCardanoDevnet tmpDir
           forkIntoConwayInEpoch tmpDir args 1
-          withCardanoNode (contramap FromCardanoNode tracer) defaultNetworkId tmpDir args $ \node@RunningNode{nodeSocket} -> do
-            hydraScriptsTxId <- publishHydraScriptsAs node Faucet
-            chainConfig <- chainConfigFor Alice tmpDir nodeSocket [] cperiod
-            withHydraNode' chainConfig tmpDir 1 aliceSk [] [1] hydraScriptsTxId Nothing $ \out err ph -> do
-              -- Assert nominal startup
-              waitForLog 5 out "missing NodeOptions" (Text.isInfixOf "NodeOptions")
+          withCardanoNode (contramap FromCardanoNode tracer) defaultNetworkId tmpDir args $
+            \node@RunningNode{nodeSocket} -> do
+              hydraScriptsTxId <- publishHydraScriptsAs node Faucet
+              chainConfig <- chainConfigFor Alice tmpDir nodeSocket [] cperiod
+              withHydraNode' chainConfig tmpDir 1 aliceSk [] [1] hydraScriptsTxId Nothing $ \out err ph -> do
+                -- Assert nominal startup
+                waitForLog 5 out "missing NodeOptions" (Text.isInfixOf "NodeOptions")
 
-              delayEpoch tmpDir args 1
+                delayEpoch tmpDir args node 1
 
-              waitForProcess ph `shouldReturn` ExitFailure 1
-              errorOutputs <- hGetContents err
-              errorOutputs `shouldContain` "Received blocks in unsupported era"
-              errorOutputs `shouldContain` "upgrade your hydra-node"
+                waitForProcess ph `shouldReturn` ExitFailure 1
+                errorOutputs <- hGetContents err
+                errorOutputs `shouldContain` "Received blocks in unsupported era"
+                errorOutputs `shouldContain` "upgrade your hydra-node"
 
       it "does report on unsupported era on startup" $ \tracer -> do
         withClusterTempDir "unsupported-era-startup" $ \tmpDir -> do
           args <- setupCardanoDevnet tmpDir
           forkIntoConwayInEpoch tmpDir args 1
-          withCardanoNode (contramap FromCardanoNode tracer) defaultNetworkId tmpDir args $ \node@RunningNode{nodeSocket} -> do
-            hydraScriptsTxId <- publishHydraScriptsAs node Faucet
-            chainConfig <- chainConfigFor Alice tmpDir nodeSocket [] cperiod
+          withCardanoNode (contramap FromCardanoNode tracer) defaultNetworkId tmpDir args $
+            \node@RunningNode{nodeSocket} -> do
+              hydraScriptsTxId <- publishHydraScriptsAs node Faucet
+              chainConfig <- chainConfigFor Alice tmpDir nodeSocket [] cperiod
 
-            delayEpoch tmpDir args 2
+              delayEpoch tmpDir args node 2
 
-            withHydraNode' chainConfig tmpDir 1 aliceSk [] [1] hydraScriptsTxId Nothing $ \_out err ph -> do
-              waitForProcess ph `shouldReturn` ExitFailure 1
-              errorOutputs <- hGetContents err
-              errorOutputs `shouldContain` "Connected to cardano-node in unsupported era"
-              errorOutputs `shouldContain` "upgrade your hydra-node"
+              withHydraNode' chainConfig tmpDir 1 aliceSk [] [1] hydraScriptsTxId Nothing $ \_out err ph -> do
+                waitForProcess ph `shouldReturn` ExitFailure 1
+                errorOutputs <- hGetContents err
+                errorOutputs `shouldContain` "Connected to cardano-node in unsupported era"
+                errorOutputs `shouldContain` "upgrade your hydra-node"
 
--- | Wait for given number of epochs. This uses the epoch and slot lengths from
+-- | Wait until given number of epoch. This uses the epoch and slot lengths from
 -- the 'ShelleyGenesisFile' of the node args passed in.
-delayEpoch :: FilePath -> CardanoNodeArgs -> Natural -> IO ()
-delayEpoch stateDirectory args epochs = do
+delayEpoch :: FilePath -> CardanoNodeArgs -> RunningNode -> Natural -> IO ()
+delayEpoch stateDirectory args RunningNode{networkId, nodeSocket} toEpochNo = do
+  fromEpochNo :: Natural <- fromIntegral . unEpochNo <$> queryEpochNo networkId nodeSocket QueryTip
+  toEpochNo `shouldSatisfy` (> fromEpochNo)
   shellyGenesisFile :: Aeson.Value <- unsafeDecodeJsonFile (stateDirectory </> nodeShelleyGenesisFile args)
   let slotLength =
         fromMaybe (error "Field epochLength not found") $
           shellyGenesisFile ^? key "slotLength" . _Double
       epochLength =
         fromMaybe (error "Field epochLength not found") $
           shellyGenesisFile ^? key "epochLength" . _Double
-  threadDelay . realToFrac $ fromIntegral epochs * epochLength * slotLength
+  threadDelay . realToFrac $ fromIntegral (toEpochNo - fromEpochNo) * epochLength * slotLength
 
 -- getValueFromKey :: Value -> Text -> Double
 -- getValueFromKey jsonValue k =

diff --git a/hydra-node/src/Hydra/Chain/CardanoClient.hs b/hydra-node/src/Hydra/Chain/CardanoClient.hs
@@ -228,6 +228,24 @@ queryEraHistory :: NetworkId -> SocketPath -> QueryPoint -> IO (EraHistory Carda
 queryEraHistory networkId socket queryPoint =
   runQuery networkId socket queryPoint $ QueryEraHistory CardanoModeIsMultiEra
 
+-- | Query the current epoch number.
+--
+-- Throws at least 'QueryException' if query fails.
+queryEpochNo ::
+  NetworkId ->
+  SocketPath ->
+  QueryPoint ->
+  IO EpochNo
+queryEpochNo networkId socket queryPoint = do
+  let query =
+        QueryInEra
+          BabbageEraInCardanoMode
+          ( QueryInShelleyBasedEra
+              ShelleyBasedEraBabbage
+              QueryEpoch
+          )
+  runQuery networkId socket queryPoint query >>= throwOnEraMismatch
+
 -- | Query the protocol parameters at given point.
 --
 -- Throws at least 'QueryException' if query fails.