diff --git a/cardano-testnet/src/Testnet/Components/Query.hs b/cardano-testnet/src/Testnet/Components/Query.hs index a15cad08234..7eb810b60d2 100644 --- a/cardano-testnet/src/Testnet/Components/Query.hs +++ b/cardano-testnet/src/Testnet/Components/Query.hs @@ -112,7 +112,7 @@ waitForEpochs -> EpochInterval -- ^ Number of epochs to wait -> m EpochNo -- ^ The epoch number reached waitForEpochs epochStateView interval = withFrozenCallStack $ do - void $ watchEpochStateUpdate epochStateView interval $ \_ -> pure Nothing + void $ watchEpochStateUpdate epochStateView interval $ \_ -> pure (ConditionNotMet, ()) getCurrentEpochNo epochStateView -- | Wait for the requested number of blocks @@ -129,12 +129,12 @@ waitForBlocks epochStateView numberOfBlocks = withFrozenCallStack $ do BlockNo startingBlockNumber <- getBlockNumber epochStateView H.note_ $ "Current block number: " <> show startingBlockNumber <> ". " <> "Waiting for " <> show numberOfBlocks <> " blocks" - H.noteShowM . H.nothingFailM . fmap (fmap BlockNo) $ + H.noteShowM . fmap (BlockNo . snd) $ watchEpochStateUpdate epochStateView (EpochInterval maxBound) $ \(_, _, BlockNo blockNumber) -> pure $ if blockNumber >= startingBlockNumber + numberOfBlocks - then Just blockNumber - else Nothing + then (ConditionMet, blockNumber) + else (ConditionNotMet, blockNumber) data TestnetWaitPeriod = WaitForEpochs EpochInterval @@ -268,21 +268,23 @@ watchEpochStateUpdate :: forall m a. (HasCallStack, MonadIO m, MonadTest m, MonadAssertion m) => EpochStateView -- ^ The info to access the epoch state -> EpochInterval -- ^ The maximum number of epochs to wait - -> ((AnyNewEpochState, SlotNo, BlockNo) -> m (Maybe a)) -- ^ The guard function (@Just@ if the condition is met, @Nothing@ otherwise) - -> m (Maybe a) + -> ((AnyNewEpochState, SlotNo, BlockNo) -> m (LedgerStateCondition, a)) + -- ^ The callback executed on every new epoch state, stops the execution when 'ConditionMet' is returned as + -- a first argument of a tuple + -> m (LedgerStateCondition, a) watchEpochStateUpdate epochStateView (EpochInterval maxWait) f = withFrozenCallStack $ do AnyNewEpochState _ newEpochState <- getEpochState epochStateView let EpochNo currentEpoch = L.nesEL newEpochState go $ currentEpoch + fromIntegral maxWait where - go :: Word64 -> m (Maybe a) + go :: Word64 -> m (LedgerStateCondition, a) go timeout = do newEpochStateDetails@(AnyNewEpochState _ newEpochState', _, _) <- getEpochStateDetails epochStateView pure let EpochNo currentEpoch = L.nesEL newEpochState' f newEpochStateDetails >>= \case - Just result -> pure (Just result) - Nothing - | currentEpoch > timeout -> pure Nothing + r@(ConditionMet, _) -> pure r + r@(ConditionNotMet, _) + | currentEpoch > timeout -> pure r | otherwise -> do H.threadDelay 300_000 go timeout @@ -523,25 +525,21 @@ assertNewEpochState -> value -- ^ The expected value to check in the epoch state. -> m () assertNewEpochState epochStateView sbe maxWait lens expected = withFrozenCallStack $ do - mStateView <- watchEpochStateUpdate epochStateView maxWait (const checkEpochState) - when (isNothing mStateView) $ do - val <- getFromEpochStateForEra - -- there's a tiny tiny chance that the value has changed since 'watchEpochStateUpdate' - -- so check it again - if val == expected - then pure () - else H.failMessage callStack $ unlines - [ "assertNewEpochState: expected value not reached within the time frame." - , "Expected value: " <> show expected - , "Actual value: " <> show val - ] + (cond, val) <- watchEpochStateUpdate epochStateView maxWait (const checkEpochState) + when (cond == ConditionNotMet) $ do + H.failMessage callStack $ unlines + [ "assertNewEpochState: expected value not reached within the time frame." + , "Expected value: " <> show expected + , "Actual value: " <> show val + ] where checkEpochState :: HasCallStack - => m (Maybe ()) + => m (LedgerStateCondition, value) checkEpochState = withFrozenCallStack $ do val <- getFromEpochStateForEra - pure $ if val == expected then Just () else Nothing + let cond = if val == expected then ConditionMet else ConditionNotMet + pure (cond, val) getFromEpochStateForEra :: HasCallStack diff --git a/cardano-testnet/src/Testnet/EpochStateProcessing.hs b/cardano-testnet/src/Testnet/EpochStateProcessing.hs index 8ed6a0c6caa..fff99461017 100644 --- a/cardano-testnet/src/Testnet/EpochStateProcessing.hs +++ b/cardano-testnet/src/Testnet/EpochStateProcessing.hs @@ -20,7 +20,6 @@ import Prelude import Control.Monad import qualified Data.Map as Map -import Data.Maybe import Data.Word (Word32) import GHC.Exts (IsList (toList), toList) import GHC.Stack @@ -60,14 +59,14 @@ waitForGovActionVotes -> EpochInterval -- ^ The maximum wait time in epochs. -> m () waitForGovActionVotes epochStateView maxWait = withFrozenCallStack $ do - mResult <- watchEpochStateUpdate epochStateView maxWait checkForVotes - when (isNothing mResult) $ + (cond, ()) <- watchEpochStateUpdate epochStateView maxWait checkForVotes + when (cond == ConditionNotMet) $ H.failMessage callStack "waitForGovActionVotes: No votes appeared before timeout." where checkForVotes :: HasCallStack => (AnyNewEpochState, SlotNo, BlockNo) - -> m (Maybe ()) + -> m (LedgerStateCondition, ()) checkForVotes (AnyNewEpochState actualEra newEpochState, _, _) = withFrozenCallStack $ do caseShelleyToBabbageOrConwayEraOnwards (const $ H.note_ "Only Conway era onwards is supported" >> failure) @@ -75,14 +74,14 @@ waitForGovActionVotes epochStateView maxWait = withFrozenCallStack $ do let govState = conwayEraOnwardsConstraints ceo $ newEpochState ^. newEpochStateGovStateL proposals = govState ^. L.cgsProposalsL . L.pPropsL . to toList if null proposals - then pure Nothing + then pure (ConditionNotMet, ()) else do let lastProposal = last proposals gaDRepVotes = lastProposal ^. L.gasDRepVotesL . to toList gaSpoVotes = lastProposal ^. L.gasStakePoolVotesL . to toList if null gaDRepVotes && null gaSpoVotes - then pure Nothing - else pure $ Just () + then pure (ConditionNotMet, ()) + else pure (ConditionMet, ()) ) actualEra diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs index 1ee19188a05..a023d61fc4a 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs @@ -24,6 +24,7 @@ import Prelude import Control.Monad import qualified Data.Char as C import qualified Data.Map as Map +import Data.Maybe import Data.Maybe.Strict import Data.Set (Set) import Data.String @@ -177,8 +178,9 @@ hprop_constitutional_committee_add_new = integrationWorkspace "constitutional-co governanceActionTxId <- H.noteM $ retrieveTransactionId execConfig signedProposalTx governanceActionIx <- - H.nothingFailM . watchEpochStateUpdate epochStateView (L.EpochInterval 1) $ \(anyNewEpochState, _, _) -> - pure $ maybeExtractGovernanceActionIndex (fromString governanceActionTxId) anyNewEpochState + H.nothingFailM . fmap snd . watchEpochStateUpdate epochStateView (L.EpochInterval 1) $ \(anyNewEpochState, _, _) -> do + let r = maybeExtractGovernanceActionIndex (fromString governanceActionTxId) anyNewEpochState + pure (if isJust r then ConditionMet else ConditionNotMet, r) dRepVoteFiles <- DRep.generateVoteFiles @@ -222,7 +224,8 @@ hprop_constitutional_committee_add_new = integrationWorkspace "constitutional-co length (filter ((== L.VoteYes) . snd) gaSpoVotes) === 1 length spoVotes === length gaSpoVotes - H.nothingFailM $ watchEpochStateUpdate epochStateView (L.EpochInterval 1) (return . committeeIsPresent) + (cond, ()) <- watchEpochStateUpdate epochStateView (L.EpochInterval 1) (return . committeeIsPresent) + cond === ConditionMet -- show proposed committe meembers H.noteShow_ ccCredentials @@ -252,7 +255,7 @@ getCommitteeMembers epochStateView ceo = withFrozenCallStack $ do govState <- getGovState epochStateView ceo fmap (Map.keys . L.committeeMembers) . H.nothingFail $ strictMaybeToMaybe $ govState ^. L.cgsCommitteeL -committeeIsPresent :: (AnyNewEpochState, SlotNo, BlockNo) -> Maybe () +committeeIsPresent :: (AnyNewEpochState, SlotNo, BlockNo) -> (LedgerStateCondition, ()) committeeIsPresent (AnyNewEpochState sbe newEpochState, _, _) = caseShelleyToBabbageOrConwayEraOnwards (const $ error "Constitutional committee does not exist pre-Conway era") @@ -263,7 +266,9 @@ committeeIsPresent (AnyNewEpochState sbe newEpochState, _, _) = . L.lsUTxOStateL . L.utxosGovStateL . L.cgsCommitteeL - members <- L.committeeMembers <$> strictMaybeToMaybe mCommittee - when (Map.null members) Nothing + isCommitteePresent = Map.null . L.committeeMembers <$> strictMaybeToMaybe mCommittee + if isCommitteePresent == Just True + then (ConditionMet, ()) + else (ConditionNotMet, ()) ) sbe diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepActivity.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepActivity.hs index 5d9737a2d2b..009a153f502 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepActivity.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepActivity.hs @@ -24,6 +24,7 @@ import Control.Monad import Control.Monad.Catch (MonadCatch) import Data.Data (Typeable) import qualified Data.Map as Map +import Data.Maybe import Data.String import qualified Data.Text as Text import Data.Word (Word32) @@ -287,10 +288,11 @@ makeActivityChangeProposal execConfig epochStateView ceo work prefix governanceActionTxId <- retrieveTransactionId execConfig signedProposalTx governanceActionIndex <- - H.nothingFailM $ watchEpochStateUpdate epochStateView timeout $ \(anyNewEpochState, _, _) -> - return $ maybeExtractGovernanceActionIndex (fromString governanceActionTxId) anyNewEpochState + H.nothingFailM . fmap snd $ watchEpochStateUpdate epochStateView timeout $ \(anyNewEpochState, _, _) -> do + let r = maybeExtractGovernanceActionIndex (fromString governanceActionTxId) anyNewEpochState + pure (if isJust r then ConditionMet else ConditionNotMet, r) - return (governanceActionTxId, governanceActionIndex) + pure (governanceActionTxId, governanceActionIndex) -- | Cast votes for a governance action. voteChangeProposal diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/InfoAction.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/InfoAction.hs index 0fe08b762f0..c91f8b2c10a 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/InfoAction.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/InfoAction.hs @@ -26,6 +26,7 @@ import Control.Monad import Data.Bifunctor (first) import Data.Foldable import qualified Data.Map.Strict as Map +import Data.Maybe import Data.String import qualified Data.Text as Text import Data.Word @@ -146,8 +147,9 @@ hprop_ledger_events_info_action = integrationRetryWorkspace 0 "info-hash" $ \tem ] governanceActionIndex <- - H.nothingFailM $ watchEpochStateUpdate epochStateView (EpochInterval 1) $ \(anyNewEpochState, _, _) -> - pure $ maybeExtractGovernanceActionIndex (fromString txidString) anyNewEpochState + H.nothingFailM . fmap snd $ watchEpochStateUpdate epochStateView (EpochInterval 1) $ \(anyNewEpochState, _, _) -> do + let r = maybeExtractGovernanceActionIndex (fromString txidString) anyNewEpochState + pure (if isJust r then ConditionMet else ConditionNotMet, r) let voteFp :: Int -> FilePath voteFp n = work gov "vote-" <> show n diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/NoConfidence.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/NoConfidence.hs index 0fe251dedcd..a095c403b08 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/NoConfidence.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/NoConfidence.hs @@ -24,6 +24,7 @@ import Control.Monad import Data.Bifunctor import qualified Data.ByteString.Char8 as BSC import qualified Data.Map.Strict as Map +import Data.Maybe import Data.Maybe.Strict import Data.String import qualified Data.Text as Text @@ -131,8 +132,9 @@ hprop_gov_no_confidence = integrationWorkspace "no-confidence" $ \tempAbsBasePat epochStateView <- getEpochStateView configurationFile (File socketPath) - H.nothingFailM $ watchEpochStateUpdate epochStateView (EpochInterval 3) $ \(anyNewEpochState, _, _) -> + (cond, ()) <- watchEpochStateUpdate epochStateView (EpochInterval 3) $ \(anyNewEpochState, _, _) -> pure $ committeeIsPresent True anyNewEpochState + cond === ConditionMet -- Step 2. Propose motion of no confidence. DRep and SPO voting thresholds must be met. @@ -191,8 +193,9 @@ hprop_gov_no_confidence = integrationWorkspace "no-confidence" $ \tempAbsBasePat governanceActionTxId <- retrieveTransactionId execConfig signedProposalTx governanceActionIndex <- - H.nothingFailM $ watchEpochStateUpdate epochStateView (EpochInterval 10) $ \(anyNewEpochState, _, _) -> - pure $ maybeExtractGovernanceActionIndex (fromString governanceActionTxId) anyNewEpochState + H.nothingFailM . fmap snd $ watchEpochStateUpdate epochStateView (EpochInterval 10) $ \(anyNewEpochState, _, _) -> do + let r = maybeExtractGovernanceActionIndex (fromString governanceActionTxId) anyNewEpochState + pure (if isJust r then ConditionMet else ConditionNotMet, r) let spoVotes :: [(String, Int)] spoVotes = [("yes", 1), ("yes", 2), ("yes", 3)] @@ -224,11 +227,12 @@ hprop_gov_no_confidence = integrationWorkspace "no-confidence" $ \tempAbsBasePat -- Step 4. We confirm the no confidence motion has been ratified by checking -- for an empty constitutional committee. - H.nothingFailM $ watchEpochStateUpdate epochStateView (EpochInterval 10) $ \(anyNewEpochState, _, _) -> + (cond2, ()) <- watchEpochStateUpdate epochStateView (EpochInterval 10) $ \(anyNewEpochState, _, _) -> pure $ committeeIsPresent False anyNewEpochState + cond2 === ConditionMet -- | Checks if the committee is empty or not. -committeeIsPresent :: Bool -> AnyNewEpochState -> Maybe () +committeeIsPresent :: Bool -> AnyNewEpochState -> (LedgerStateCondition, ()) committeeIsPresent committeeExists (AnyNewEpochState sbe newEpochState) = caseShelleyToBabbageOrConwayEraOnwards (const $ error "Constitutional committee does not exist pre-Conway era") @@ -240,11 +244,11 @@ committeeIsPresent committeeExists (AnyNewEpochState sbe newEpochState) = . L.cgsCommitteeL in if committeeExists then if isSJust mCommittee - then Just () -- The committee is non empty and we terminate. - else Nothing + then (ConditionMet, ()) -- The committee is non empty and we terminate. + else (ConditionNotMet, ()) else if mCommittee == SNothing - then Just () -- The committee is empty and we terminate. - else Nothing + then (ConditionMet, ()) -- The committee is empty and we terminate. + else (ConditionNotMet, ()) ) sbe diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PredefinedAbstainDRep.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PredefinedAbstainDRep.hs index 8ceeefa211d..729f01f4b4c 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PredefinedAbstainDRep.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PredefinedAbstainDRep.hs @@ -24,6 +24,7 @@ import Prelude import Control.Monad import Control.Monad.Catch (MonadCatch) import Data.Data (Typeable) +import Data.Maybe import Data.String (fromString) import qualified Data.Text as Text import Data.Word (Word32) @@ -291,8 +292,9 @@ makeDesiredPoolNumberChangeProposal execConfig epochStateView ceo work prefix governanceActionTxId <- retrieveTransactionId execConfig signedProposalTx governanceActionIndex <- - H.nothingFailM $ watchEpochStateUpdate epochStateView (EpochInterval 1) $ \(anyNewEpochState, _, _) -> - pure $ maybeExtractGovernanceActionIndex (fromString governanceActionTxId) anyNewEpochState + H.nothingFailM . fmap snd $ watchEpochStateUpdate epochStateView (EpochInterval 1) $ \(anyNewEpochState, _, _) -> do + let r = maybeExtractGovernanceActionIndex (fromString governanceActionTxId) anyNewEpochState + pure (if isJust r then ConditionMet else ConditionNotMet, r) pure (governanceActionTxId, governanceActionIndex) diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitution.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitution.hs index dbaf00ab8cc..8bfc7c05a39 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitution.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitution.hs @@ -168,8 +168,9 @@ hprop_ledger_events_propose_new_constitution = integrationWorkspace "propose-new governanceActionTxId <- retrieveTransactionId execConfig signedProposalTx governanceActionIndex <- - H.nothingFailM . watchEpochStateUpdate epochStateView (EpochInterval 1) $ \(anyNewEpochState, _, _) -> - pure $ maybeExtractGovernanceActionIndex (fromString governanceActionTxId) anyNewEpochState + H.nothingFailM . fmap snd . watchEpochStateUpdate epochStateView (EpochInterval 1) $ \(anyNewEpochState, _, _) -> do + let r = maybeExtractGovernanceActionIndex (fromString governanceActionTxId) anyNewEpochState + pure (if isJust r then ConditionMet else ConditionNotMet, r) -- Proposal was successfully submitted, now we vote on the proposal and confirm it was ratified voteFiles <- generateVoteFiles execConfig work "vote-files"