Remove flaky calls to by byDeadlineM in cardano-testnet (IntersectMBO#5707)

* Use waitUntilEpoch in hprop_leadershipSchedule

* Remove byDeadlineM when querying the leadership schedule in
hprop_leadershipSchedule

* Replace with byDeadlineM with waitUntilEpoch in hprop_stakeSnapshot

Author: Jimbo4350

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/LeadershipSchedule.hs

@@ -15,8 +15,8 @@ module Cardano.Testnet.Test.Cli.Babbage.LeadershipSchedule
   ) where
 
 import           Cardano.Api
+import qualified Cardano.Api as Api
 
-import           Cardano.CLI.Types.Output (QueryTipLocalStateOutput (..))
 import           Cardano.Node.Configuration.Topology
 import           Cardano.Testnet
 
@@ -32,7 +32,6 @@ import qualified Data.Map.Strict as Map
 import           Data.Text (Text)
 import qualified Data.Text as Text
 import qualified Data.Time.Clock as DTC
-import           GHC.Stack (callStack)
 import qualified GHC.Stack as GHC
 import           System.FilePath ((</>))
 import qualified System.Info as SYS
@@ -49,6 +48,7 @@ import           Testnet.Runtime
 import           Hedgehog (Property, (===))
 import qualified Hedgehog as H
 import           Hedgehog.Extras (threadDelay)
+import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO
 import qualified Hedgehog.Extras.Test.Base as H
 import qualified Hedgehog.Extras.Test.File as H
 
@@ -193,6 +193,7 @@ hprop_leadershipSchedule = H.integrationRetryWorkspace 2 "babbage-leadership-sch
            , "--tx-file", delegRegTestDelegatorTxFp
            ]
 
+  -- TODO: Can be removed if checkStakeKeyRegistered uses foldEpochState
   threadDelay 15_000000
 
   -------------------------------------------------------------------
@@ -253,74 +254,56 @@ hprop_leadershipSchedule = H.integrationRetryWorkspace 2 "babbage-leadership-sch
   testPoolStdOutFp <- case eRuntime of
                        Left e -> H.failMessage GHC.callStack $ "Failed to start node: " <> show e
                        Right runtime -> return $ nodeStdout runtime
-  threadDelay 5_000000
 
+  -- Wait for 2 epochs to pass
+  void $ waitUntilEpoch (Api.File configurationFile)
+                        (Api.File $ IO.sprocketSystemName node1sprocket) (EpochNo 3)
 
-  tipDeadline <- H.noteShowM $ DTC.addUTCTime 210 <$> H.noteShowIO DTC.getCurrentTime
+  currentLeaderShipScheduleFile <- H.noteTempFile work "current-schedule.log"
 
-  H.byDeadlineM 10 tipDeadline "Wait for two epochs" $ do
-    void $ execCli' execConfig
-      [ "query", "tip"
-      , "--out-file", work </> "current-tip.json"
-      ]
-
-    tipJson <- H.leftFailM . H.readJsonFile $ work </> "current-tip.json"
-    tip <- H.noteShowM $ H.jsonErrorFail $ J.fromJSON @QueryTipLocalStateOutput tipJson
-
-    currEpoch <- case mEpoch tip of
-      Nothing -> H.failMessage callStack "cardano-cli query tip returned Nothing for EpochNo"
-      Just currEpoch -> return currEpoch
-
-    H.note_ $ "Current Epoch: " <> show currEpoch
-    H.assert $ currEpoch > 2
-
-  id do
-    currentLeaderShipScheduleFile <- H.noteTempFile work "current-schedule.log"
-
-    leadershipScheduleDeadline <- H.noteShowM $ DTC.addUTCTime 180 <$> H.noteShowIO DTC.getCurrentTime
-
-    H.byDeadlineM 5 leadershipScheduleDeadline "Failed to query for leadership schedule" $ do
-      void $ execCli' execConfig
-        [ "query", "leadership-schedule"
-        , "--genesis", shelleyGenesisFile tr
-        , "--stake-pool-id", stakePoolIdNewSpo
-        , "--vrf-signing-key-file", vrfSkey
-        , "--out-file", currentLeaderShipScheduleFile
-        , "--current"
-        ]
+  void $ execCli' execConfig
+    [ "query", "leadership-schedule"
+    , "--genesis", shelleyGenesisFile tr
+    , "--stake-pool-id", stakePoolIdNewSpo
+    , "--vrf-signing-key-file", vrfSkey
+    , "--out-file", currentLeaderShipScheduleFile
+    , "--current"
+    ]
 
-    currentScheduleJson <- H.leftFailM $ H.readJsonFile currentLeaderShipScheduleFile
+  currentScheduleJson <- H.leftFailM $ H.readJsonFile currentLeaderShipScheduleFile
 
-    expectedLeadershipSlotNumbers <- H.noteShowM $ fmap (fmap slotNumber) $ H.leftFail $ J.parseEither (J.parseJSON @[LeadershipSlot]) currentScheduleJson
+  expectedLeadershipSlotNumbers <- H.noteShowM $ fmap (fmap slotNumber) $ H.leftFail $ J.parseEither (J.parseJSON @[LeadershipSlot]) currentScheduleJson
 
-    maxSlotExpected <- H.noteShow $ maximum expectedLeadershipSlotNumbers
+  maxSlotExpected <- H.noteShow $ maximum expectedLeadershipSlotNumbers
 
-    H.assert $ not (L.null expectedLeadershipSlotNumbers)
+  H.assert $ not (L.null expectedLeadershipSlotNumbers)
 
-    leadershipDeadline <- H.noteShowM $ DTC.addUTCTime 90 <$> H.noteShowIO DTC.getCurrentTime
+  leadershipDeadline <- H.noteShowM $ DTC.addUTCTime 90 <$> H.noteShowIO DTC.getCurrentTime
 
     -- We need enough time to pass such that the expected leadership slots generated by the
     -- leadership-schedule command have actually occurred.
-    (leaderSlots, notLeaderSlots) <- H.byDeadlineM 10 leadershipDeadline "Wait for chain to surpass all expected leadership slots" $ do
-      (someLeaderSlots, someNotLeaderSlots) <- getRelevantSlots testPoolStdOutFp (minimum expectedLeadershipSlotNumbers)
-      if L.null someLeaderSlots
-        then H.failure
-        else do
-          maxActualSlot <- H.noteShow $ maximum someLeaderSlots
-          H.assert $ maxActualSlot >= maxSlotExpected
-          pure (someLeaderSlots, someNotLeaderSlots)
-
-    H.noteShow_ expectedLeadershipSlotNumbers
-    H.noteShow_ leaderSlots
-    H.noteShow_ notLeaderSlots
+    -- TODO: We can further improve this if parameterize foldEpochState's callback on
+    -- the current slot and current block number.
+  (leaderSlots, notLeaderSlots) <- H.byDeadlineM 10 leadershipDeadline "Wait for chain to surpass all expected leadership slots" $ do
+    (someLeaderSlots, someNotLeaderSlots) <- getRelevantSlots testPoolStdOutFp (minimum expectedLeadershipSlotNumbers)
+    if L.null someLeaderSlots
+      then H.failure
+      else do
+        maxActualSlot <- H.noteShow $ maximum someLeaderSlots
+        H.assert $ maxActualSlot >= maxSlotExpected
+        pure (someLeaderSlots, someNotLeaderSlots)
+
+  H.noteShow_ expectedLeadershipSlotNumbers
+  H.noteShow_ leaderSlots
+  H.noteShow_ notLeaderSlots
 
     -- Double check that we've seen all slots
-    H.noteShow_ ("Slots not seen as TraceNodeIsLeader nor TraceNodeNotLeader" :: Text)
-    ([minimum expectedLeadershipSlotNumbers .. maxSlotExpected] \\ leaderSlots) \\ notLeaderSlots === []
+  H.noteShow_ ("Slots not seen as TraceNodeIsLeader nor TraceNodeNotLeader" :: Text)
+  ([minimum expectedLeadershipSlotNumbers .. maxSlotExpected] \\ leaderSlots) \\ notLeaderSlots === []
 
     -- As there are no BFT nodes, the next leadership schedule should match slots assigned exactly
-    H.noteShow_ (expectedLeadershipSlotNumbers \\ leaderSlots)
-    H.assert $ L.null (expectedLeadershipSlotNumbers \\ leaderSlots)
+  H.noteShow_ (expectedLeadershipSlotNumbers \\ leaderSlots)
+  H.assert $ L.null (expectedLeadershipSlotNumbers \\ leaderSlots)
     -- TODO: Re-enable --next leadership schedule test
     {-
 

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/StakeSnapshot.hs

@@ -10,16 +10,15 @@ module Cardano.Testnet.Test.Cli.Babbage.StakeSnapshot
   ) where
 
 import           Cardano.Api
+import qualified Cardano.Api as Api
 
-import           Cardano.CLI.Types.Output (QueryTipLocalStateOutput (..))
 import           Cardano.Testnet
 
 import           Prelude
 
+import           Control.Monad
 import qualified Data.Aeson as Aeson
 import qualified Data.Aeson.KeyMap as KM
-import qualified Data.Time.Clock as DTC
-import           GHC.Stack (callStack)
 import qualified System.Info as SYS
 
 import           Testnet.Process.Cli (execCliStdoutToJson)
@@ -29,6 +28,7 @@ import           Testnet.Runtime
 
 import           Hedgehog (Property, (===))
 import qualified Hedgehog as H
+import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO
 import qualified Hedgehog.Extras.Test.Base as H
 
 hprop_stakeSnapshot :: Property
@@ -49,22 +49,15 @@ hprop_stakeSnapshot = H.integrationRetryWorkspace 2 "babbage-stake-snapshot" $ \
   TestnetRuntime
     { testnetMagic
     , poolNodes
+    , configurationFile
     } <- cardanoTestnetDefault options conf
 
   poolNode1 <- H.headM poolNodes
   poolSprocket1 <- H.noteShow $ nodeSprocket $ poolRuntime poolNode1
   execConfig <- H.mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic
-  tipDeadline <- H.noteShowM $ DTC.addUTCTime 210 <$> H.noteShowIO DTC.getCurrentTime
 
-  H.byDeadlineM 10 tipDeadline "Wait for two epochs" $ do
-    tip <- execCliStdoutToJson execConfig [ "query", "tip" ]
-
-    currEpoch <- case mEpoch tip of
-      Nothing -> H.failMessage callStack "cardano-cli query tip returned Nothing for EpochNo"
-      Just currEpoch -> return currEpoch
-
-    H.note_ $ "Current Epoch: " <> show currEpoch
-    H.assert $ currEpoch > 2
+  void $ waitUntilEpoch (Api.File configurationFile)
+                        (Api.File $ IO.sprocketSystemName poolSprocket1) (EpochNo 3)
 
   json <- execCliStdoutToJson execConfig [ "query", "stake-snapshot", "--all-stake-pools" ]
 

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/StakeSnapshot.hs

@@ -9,17 +9,15 @@ module Cardano.Testnet.Test.Cli.Conway.StakeSnapshot
   ( hprop_stakeSnapshot
   ) where
 
-import           Cardano.Api
+import           Cardano.Api as Api
 
-import           Cardano.CLI.Types.Output (QueryTipLocalStateOutput (..))
 import           Cardano.Testnet
 
 import           Prelude
 
+import           Control.Monad
 import qualified Data.Aeson as Aeson
 import qualified Data.Aeson.KeyMap as KM
-import qualified Data.Time.Clock as DTC
-import           GHC.Stack (callStack)
 import qualified System.Info as SYS
 
 import           Testnet.Process.Cli (execCliStdoutToJson)
@@ -29,6 +27,7 @@ import           Testnet.Runtime
 
 import           Hedgehog (Property, (===))
 import qualified Hedgehog as H
+import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO
 import qualified Hedgehog.Extras.Test.Base as H
 
 hprop_stakeSnapshot :: Property
@@ -48,23 +47,16 @@ hprop_stakeSnapshot = H.integrationRetryWorkspace 2 "conway-stake-snapshot" $ \t
   TestnetRuntime
     { testnetMagic
     , poolNodes
+    , configurationFile
     } <- cardanoTestnetDefault options conf
 
   poolNode1 <- H.headM poolNodes
   poolSprocket1 <- H.noteShow $ nodeSprocket $ poolRuntime poolNode1
   execConfig <- H.mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic
 
-  tipDeadline <- H.noteShowM $ DTC.addUTCTime 210 <$> H.noteShowIO DTC.getCurrentTime
+  void $ waitUntilEpoch (Api.File configurationFile)
+                        (Api.File $ IO.sprocketSystemName poolSprocket1) (EpochNo 3)
 
-  H.byDeadlineM 10 tipDeadline "Wait for two epochs" $ do
-    tip <- execCliStdoutToJson execConfig [ "query", "tip" ]
-
-    currEpoch <- case mEpoch tip of
-      Nothing -> H.failMessage callStack "cardano-cli query tip returned Nothing for EpochNo"
-      Just currEpoch -> return currEpoch
-
-    H.note_ $ "Current Epoch: " <> show currEpoch
-    H.assert $ currEpoch > 2
 
   json <- execCliStdoutToJson execConfig [ "query", "stake-snapshot", "--all-stake-pools" ]