Skip to content

Commit

Permalink
Remove assertByDeadlineMCustom function
Browse files Browse the repository at this point in the history
  • Loading branch information
newhoggy committed Nov 30, 2022
1 parent fdc57f5 commit df58013
Show file tree
Hide file tree
Showing 4 changed files with 20 additions and 35 deletions.
2 changes: 1 addition & 1 deletion cardano-testnet/src/Testnet/Babbage.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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"
Expand Down
17 changes: 0 additions & 17 deletions cardano-testnet/src/Util/Process.hs
Original file line number Diff line number Diff line change
@@ -1,6 +1,5 @@
module Util.Process
( assertByDeadlineIOCustom
, assertByDeadlineMCustom
, bashPath
, execCli
, execCli_
Expand Down Expand Up @@ -132,26 +131,10 @@ 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
assertByDeadlineIOCustom str deadline f
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
17 changes: 9 additions & 8 deletions cardano-testnet/test/Test/Cli/Alonzo/LeadershipSchedule.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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"
Expand Down Expand Up @@ -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)

Expand Down
19 changes: 10 additions & 9 deletions cardano-testnet/test/Test/Cli/Babbage/LeadershipSchedule.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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)

Expand Down Expand Up @@ -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)

Expand Down

0 comments on commit df58013

Please sign in to comment.