Change watchEpochStateUpdate callback type

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,21 @@ 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 guard function (@Just@ if the condition is met, @Nothing@ otherwise)
+ -> 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 +523,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

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,29 +59,29 @@ 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)
  (\ceo -> 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
 

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

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

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

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
 

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)
 

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"