diff --git a/cardano-testnet/src/Testnet/Babbage.hs b/cardano-testnet/src/Testnet/Babbage.hs index 4690bff025a..7cba7be3fdb 100644 --- a/cardano-testnet/src/Testnet/Babbage.hs +++ b/cardano-testnet/src/Testnet/Babbage.hs @@ -335,7 +335,7 @@ babbageTestnet testnetOptions H.Conf {..} = do return $ PoolNode runtime key now <- H.noteShowIO DTC.getCurrentTime - deadline <- H.noteShow $ DTC.addUTCTime 110 now + deadline <- H.noteShow $ DTC.addUTCTime 90 now forM_ spoNodes $ \node -> do nodeStdoutFile <- H.noteTempFile logDir $ node <> ".stdout.log" diff --git a/cardano-testnet/src/Util/Process.hs b/cardano-testnet/src/Util/Process.hs index 0ea34259a45..d14548eecc8 100644 --- a/cardano-testnet/src/Util/Process.hs +++ b/cardano-testnet/src/Util/Process.hs @@ -1,6 +1,5 @@ module Util.Process ( assertByDeadlineIOCustom - , assertByDeadlineMCustom , bashPath , execCli , execCli_ @@ -132,7 +131,6 @@ assertByDeadlineIOCustom str deadline f = GHC.withFrozenCallStack $ do success <- liftIO f unless success $ do currentTime <- liftIO DTC.getCurrentTime - note_ $ "Current time: " <> show currentTime if currentTime < deadline then do liftIO $ IO.threadDelay 1000000 @@ -140,18 +138,3 @@ assertByDeadlineIOCustom str deadline f = GHC.withFrozenCallStack $ do else do H.annotateShow currentTime failMessage GHC.callStack $ "Condition not met by deadline: " <> str - -assertByDeadlineMCustom - :: (MonadTest m, MonadIO m, HasCallStack) - => String -> UTCTime -> m Bool -> m () -assertByDeadlineMCustom str deadline f = GHC.withFrozenCallStack $ do - success <- f - unless success $ do - currentTime <- liftIO DTC.getCurrentTime - if currentTime < deadline - then do - liftIO $ IO.threadDelay 1000000 - assertByDeadlineMCustom str deadline f - else do - H.annotateShow currentTime - failMessage GHC.callStack $ "Condition not met by deadline: " <> str diff --git a/cardano-testnet/test/Test/Cli/Alonzo/LeadershipSchedule.hs b/cardano-testnet/test/Test/Cli/Alonzo/LeadershipSchedule.hs index cc6a928aa8b..91af069e606 100644 --- a/cardano-testnet/test/Test/Cli/Alonzo/LeadershipSchedule.hs +++ b/cardano-testnet/test/Test/Cli/Alonzo/LeadershipSchedule.hs @@ -42,15 +42,15 @@ import qualified System.Directory as IO import System.Environment (getEnvironment) import System.FilePath (()) import qualified System.Info as SYS -import Testnet ( TestnetOptions (CardanoOnlyTestnetOptions), testnet) +import Testnet (TestnetOptions (CardanoOnlyTestnetOptions), testnet) import Testnet.Cardano as TC (CardanoTestnetOptions (..), defaultTestnetOptions) import qualified Testnet.Conf as H import Testnet.Utils (waitUntilEpoch) import qualified Util.Assert as H import qualified Util.Base as H import qualified Util.Process as H -import Util.Runtime (LeadershipSlot (..)) import qualified Util.Runtime as TR +import Util.Runtime (LeadershipSlot (..)) hprop_leadershipSchedule :: Property hprop_leadershipSchedule = H.integration . H.runFinallies . H.workspace "alonzo" $ \tempAbsBasePath' -> do @@ -454,8 +454,7 @@ hprop_leadershipSchedule = H.integration . H.runFinallies . H.workspace "alonzo" now <- H.noteShowIO DTC.getCurrentTime deadline <- H.noteShow $ DTC.addUTCTime 90 now - H.assertByDeadlineMCustom "stdout does not contain \"until genesis start time\"" deadline $ do - H.threadDelay 1000000 + H.byDeadlineM 10 deadline $ do void $ H.execCli' execConfig [ "query", "tip" , "--testnet-magic", show @Int testnetMagic @@ -470,7 +469,7 @@ hprop_leadershipSchedule = H.integration . H.runFinallies . H.workspace "alonzo" Just currEpoch3 -> return currEpoch3 H.note_ $ "Current Epoch: " <> show currEpoch3 - return (currEpoch3 > currEpoch2 + 1) + H.assert $ currEpoch3 > currEpoch2 + 1 ledgerStateJson <- H.execCli' execConfig [ "query", "ledger-state" @@ -499,15 +498,17 @@ hprop_leadershipSchedule = H.integration . H.runFinallies . H.workspace "alonzo" expectedLeadershipSlotNumbers <- H.noteShowM $ fmap (fmap slotNumber) $ H.leftFail $ J.parseEither (J.parseJSON @[LeadershipSlot]) scheduleJson + maxSlotExpected <- H.noteShow $ maximum expectedLeadershipSlotNumbers + H.assert $ not (L.null expectedLeadershipSlotNumbers) leadershipDeadline <- H.noteShowM $ DTC.addUTCTime 90 <$> H.noteShowIO DTC.getCurrentTime - H.assertByDeadlineMCustom "Leader schedule is correct" leadershipDeadline $ do + -- Leader schedule is correct + H.byDeadlineM 10 leadershipDeadline $ do leaderSlots <- H.getRelevantLeaderSlots (TR.nodeStdout $ TR.poolRuntime poolNode1) (minimum expectedLeadershipSlotNumbers) - maxSlotExpected <- H.noteShow $ maximum expectedLeadershipSlotNumbers maxActualSlot <- H.noteShow $ maximum leaderSlots - return $ maxActualSlot >= maxSlotExpected + H.assert $ maxActualSlot >= maxSlotExpected leaderSlots <- H.getRelevantLeaderSlots (TR.poolNodeStdout poolNode1) (minimum expectedLeadershipSlotNumbers) diff --git a/cardano-testnet/test/Test/Cli/Babbage/LeadershipSchedule.hs b/cardano-testnet/test/Test/Cli/Babbage/LeadershipSchedule.hs index 9c39a44e560..01a699da6bf 100644 --- a/cardano-testnet/test/Test/Cli/Babbage/LeadershipSchedule.hs +++ b/cardano-testnet/test/Test/Cli/Babbage/LeadershipSchedule.hs @@ -33,7 +33,6 @@ import qualified Data.Time.Clock as DTC import qualified Hedgehog as H import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.Concurrent as H import qualified Hedgehog.Extras.Test.File as H import qualified Hedgehog.Extras.Test.Process as H import qualified System.Directory as IO @@ -90,7 +89,6 @@ hprop_leadershipSchedule = H.integration . H.runFinallies . H.workspace "alonzo" -- stdout must contain \"until genesis start time\"" H.byDeadlineM 10 tipDeadline $ do - H.threadDelay 5000000 void $ H.execCli' execConfig [ "query", "tip" , "--testnet-magic", show @Int testnetMagic @@ -134,18 +132,20 @@ hprop_leadershipSchedule = H.integration . H.runFinallies . H.workspace "alonzo" expectedLeadershipSlotNumbers <- H.noteShowM $ fmap (fmap slotNumber) $ H.leftFail $ J.parseEither (J.parseJSON @[LeadershipSlot]) scheduleJson + maxSlotExpected <- H.noteShow $ maximum expectedLeadershipSlotNumbers + H.assert $ not (L.null expectedLeadershipSlotNumbers) leadershipDeadline <- H.noteShowM $ DTC.addUTCTime 90 <$> H.noteShowIO DTC.getCurrentTime - H.assertByDeadlineMCustom "Retrieve actual slots" leadershipDeadline $ do + -- Retrieve actual slots + H.byDeadlineM 10 leadershipDeadline $ do leaderSlots <- H.getRelevantLeaderSlots (TR.poolNodeStdout poolNode1) (minimum expectedLeadershipSlotNumbers) - maxSlotExpected <- H.noteShow $ maximum expectedLeadershipSlotNumbers if L.null leaderSlots - then return False + then H.failure else do maxActualSlot <- H.noteShow $ maximum leaderSlots - return $ maxActualSlot >= maxSlotExpected + H.assert $ maxActualSlot >= maxSlotExpected leaderSlots <- H.getRelevantLeaderSlots (TR.poolNodeStdout poolNode1) (minimum expectedLeadershipSlotNumbers) @@ -180,13 +180,14 @@ hprop_leadershipSchedule = H.integration . H.runFinallies . H.workspace "alonzo" leadershipDeadline <- H.noteShowM $ DTC.addUTCTime 90 <$> H.noteShowIO DTC.getCurrentTime - H.assertByDeadlineMCustom "Retrieve actual slots" leadershipDeadline $ do + -- Retrieve actual slots + H.byDeadlineM 10 leadershipDeadline $ do leaderSlots <- H.getRelevantLeaderSlots (TR.poolNodeStdout poolNode1) (minimum expectedLeadershipSlotNumbers) if L.null leaderSlots - then return False + then H.failure else do maxActualSlot <- H.noteShow $ maximum leaderSlots - return $ maxActualSlot >= maxSlotExpected + H.assert $ maxActualSlot >= maxSlotExpected leaderSlots <- H.getRelevantLeaderSlots (TR.poolNodeStdout poolNode1) (minimum expectedLeadershipSlotNumbers)