Skip to content

Commit ca8bcd8

Browse files
carbolymercarbolymer
committed
Change watchEpochStateUpdate callback type
1 parent 9ed9aca commit ca8bcd8

File tree

8 files changed

+68
-55
lines changed

8 files changed

+68
-55
lines changed

‎cardano-testnet/src/Testnet/Components/Query.hs

+22-24
Original file line numberDiff line numberDiff line change
@@ -112,7 +112,7 @@ waitForEpochs
112112
-> EpochInterval -- ^ Number of epochs to wait
113113
-> m EpochNo -- ^ The epoch number reached
114114
waitForEpochs epochStateView interval = withFrozenCallStack $ do
115-
void $ watchEpochStateUpdate epochStateView interval $ \_ -> pure Nothing
115+
void $ watchEpochStateUpdate epochStateView interval $ \_ -> pure (ConditionNotMet, ())
116116
getCurrentEpochNo epochStateView
117117

118118
-- | Wait for the requested number of blocks
@@ -129,12 +129,12 @@ waitForBlocks epochStateView numberOfBlocks = withFrozenCallStack $ do
129129
BlockNo startingBlockNumber <- getBlockNumber epochStateView
130130
H.note_ $ "Current block number: " <> show startingBlockNumber <> ". "
131131
<> "Waiting for " <> show numberOfBlocks <> " blocks"
132-
H.noteShowM . H.nothingFailM . fmap (fmap BlockNo) $
132+
H.noteShowM . fmap (BlockNo . snd) $
133133
watchEpochStateUpdate epochStateView (EpochInterval maxBound) $ \(_, _, BlockNo blockNumber) ->
134134
pure $
135135
if blockNumber >= startingBlockNumber + numberOfBlocks
136-
then Just blockNumber
137-
else Nothing
136+
then (ConditionMet, blockNumber)
137+
else (ConditionNotMet, blockNumber)
138138

139139
data TestnetWaitPeriod
140140
= WaitForEpochs EpochInterval
@@ -268,21 +268,23 @@ watchEpochStateUpdate
268268
:: forall m a. (HasCallStack, MonadIO m, MonadTest m, MonadAssertion m)
269269
=> EpochStateView -- ^ The info to access the epoch state
270270
-> EpochInterval -- ^ The maximum number of epochs to wait
271-
-> ((AnyNewEpochState, SlotNo, BlockNo) -> m (Maybe a)) -- ^ The guard function (@Just@ if the condition is met, @Nothing@ otherwise)
272-
-> m (Maybe a)
271+
-> ((AnyNewEpochState, SlotNo, BlockNo) -> m (LedgerStateCondition, a))
272+
-- ^ The callback executed on every new epoch state, stops the execution when 'ConditionMet' is returned as
273+
-- a first argument of a tuple
274+
-> m (LedgerStateCondition, a)
273275
watchEpochStateUpdate epochStateView (EpochInterval maxWait) f = withFrozenCallStack $ do
274276
AnyNewEpochState _ newEpochState <- getEpochState epochStateView
275277
let EpochNo currentEpoch = L.nesEL newEpochState
276278
go $ currentEpoch + fromIntegral maxWait
277279
where
278-
go :: Word64 -> m (Maybe a)
280+
go :: Word64 -> m (LedgerStateCondition, a)
279281
go timeout = do
280282
newEpochStateDetails@(AnyNewEpochState _ newEpochState', _, _) <- getEpochStateDetails epochStateView pure
281283
let EpochNo currentEpoch = L.nesEL newEpochState'
282284
f newEpochStateDetails >>= \case
283-
Just result -> pure (Just result)
284-
Nothing
285-
| currentEpoch > timeout -> pure Nothing
285+
r@(ConditionMet, _) -> pure r
286+
r@(ConditionNotMet, _)
287+
| currentEpoch > timeout -> pure r
286288
| otherwise -> do
287289
H.threadDelay 300_000
288290
go timeout
@@ -523,25 +525,21 @@ assertNewEpochState
523525
-> value -- ^ The expected value to check in the epoch state.
524526
-> m ()
525527
assertNewEpochState epochStateView sbe maxWait lens expected = withFrozenCallStack $ do
526-
mStateView <- watchEpochStateUpdate epochStateView maxWait (const checkEpochState)
527-
when (isNothing mStateView) $ do
528-
val <- getFromEpochStateForEra
529-
-- there's a tiny tiny chance that the value has changed since 'watchEpochStateUpdate'
530-
-- so check it again
531-
if val == expected
532-
then pure ()
533-
else H.failMessage callStack $ unlines
534-
[ "assertNewEpochState: expected value not reached within the time frame."
535-
, "Expected value: " <> show expected
536-
, "Actual value: " <> show val
537-
]
528+
(cond, val) <- watchEpochStateUpdate epochStateView maxWait (const checkEpochState)
529+
when (cond == ConditionNotMet) $ do
530+
H.failMessage callStack $ unlines
531+
[ "assertNewEpochState: expected value not reached within the time frame."
532+
, "Expected value: " <> show expected
533+
, "Actual value: " <> show val
534+
]
538535
where
539536
checkEpochState
540537
:: HasCallStack
541-
=> m (Maybe ())
538+
=> m (LedgerStateCondition, value)
542539
checkEpochState = withFrozenCallStack $ do
543540
val <- getFromEpochStateForEra
544-
pure $ if val == expected then Just () else Nothing
541+
let cond = if val == expected then ConditionMet else ConditionNotMet
542+
pure (cond, val)
545543

546544
getFromEpochStateForEra
547545
:: HasCallStack

‎cardano-testnet/src/Testnet/EpochStateProcessing.hs

+6-7
Original file line numberDiff line numberDiff line change
@@ -20,7 +20,6 @@ import Prelude
2020

2121
import Control.Monad
2222
import qualified Data.Map as Map
23-
import Data.Maybe
2423
import Data.Word (Word32)
2524
import GHC.Exts (IsList (toList), toList)
2625
import GHC.Stack
@@ -60,29 +59,29 @@ waitForGovActionVotes
6059
-> EpochInterval -- ^ The maximum wait time in epochs.
6160
-> m ()
6261
waitForGovActionVotes epochStateView maxWait = withFrozenCallStack $ do
63-
mResult <- watchEpochStateUpdate epochStateView maxWait checkForVotes
64-
when (isNothing mResult) $
62+
(cond, ()) <- watchEpochStateUpdate epochStateView maxWait checkForVotes
63+
when (cond == ConditionNotMet) $
6564
H.failMessage callStack "waitForGovActionVotes: No votes appeared before timeout."
6665
where
6766
checkForVotes
6867
:: HasCallStack
6968
=> (AnyNewEpochState, SlotNo, BlockNo)
70-
-> m (Maybe ())
69+
-> m (LedgerStateCondition, ())
7170
checkForVotes (AnyNewEpochState actualEra newEpochState, _, _) = withFrozenCallStack $ do
7271
caseShelleyToBabbageOrConwayEraOnwards
7372
(const $ H.note_ "Only Conway era onwards is supported" >> failure)
7473
(\ceo -> do
7574
let govState = conwayEraOnwardsConstraints ceo $ newEpochState ^. newEpochStateGovStateL
7675
proposals = govState ^. L.cgsProposalsL . L.pPropsL . to toList
7776
if null proposals
78-
then pure Nothing
77+
then pure (ConditionNotMet, ())
7978
else do
8079
let lastProposal = last proposals
8180
gaDRepVotes = lastProposal ^. L.gasDRepVotesL . to toList
8281
gaSpoVotes = lastProposal ^. L.gasStakePoolVotesL . to toList
8382
if null gaDRepVotes && null gaSpoVotes
84-
then pure Nothing
85-
else pure $ Just ()
83+
then pure (ConditionNotMet, ())
84+
else pure (ConditionMet, ())
8685
)
8786
actualEra
8887

‎cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs

+11-6
Original file line numberDiff line numberDiff line change
@@ -24,6 +24,7 @@ import Prelude
2424
import Control.Monad
2525
import qualified Data.Char as C
2626
import qualified Data.Map as Map
27+
import Data.Maybe
2728
import Data.Maybe.Strict
2829
import Data.Set (Set)
2930
import Data.String
@@ -177,8 +178,9 @@ hprop_constitutional_committee_add_new = integrationWorkspace "constitutional-co
177178
governanceActionTxId <- H.noteM $ retrieveTransactionId execConfig signedProposalTx
178179

179180
governanceActionIx <-
180-
H.nothingFailM . watchEpochStateUpdate epochStateView (L.EpochInterval 1) $ \(anyNewEpochState, _, _) ->
181-
pure $ maybeExtractGovernanceActionIndex (fromString governanceActionTxId) anyNewEpochState
181+
H.nothingFailM . fmap snd . watchEpochStateUpdate epochStateView (L.EpochInterval 1) $ \(anyNewEpochState, _, _) -> do
182+
let r = maybeExtractGovernanceActionIndex (fromString governanceActionTxId) anyNewEpochState
183+
pure (if isJust r then ConditionMet else ConditionNotMet, r)
182184

183185
dRepVoteFiles <-
184186
DRep.generateVoteFiles
@@ -222,7 +224,8 @@ hprop_constitutional_committee_add_new = integrationWorkspace "constitutional-co
222224
length (filter ((== L.VoteYes) . snd) gaSpoVotes) === 1
223225
length spoVotes === length gaSpoVotes
224226

225-
H.nothingFailM $ watchEpochStateUpdate epochStateView (L.EpochInterval 1) (return . committeeIsPresent)
227+
(cond, ()) <- watchEpochStateUpdate epochStateView (L.EpochInterval 1) (return . committeeIsPresent)
228+
cond === ConditionMet
226229

227230
-- show proposed committe meembers
228231
H.noteShow_ ccCredentials
@@ -252,7 +255,7 @@ getCommitteeMembers epochStateView ceo = withFrozenCallStack $ do
252255
govState <- getGovState epochStateView ceo
253256
fmap (Map.keys . L.committeeMembers) . H.nothingFail $ strictMaybeToMaybe $ govState ^. L.cgsCommitteeL
254257

255-
committeeIsPresent :: (AnyNewEpochState, SlotNo, BlockNo) -> Maybe ()
258+
committeeIsPresent :: (AnyNewEpochState, SlotNo, BlockNo) -> (LedgerStateCondition, ())
256259
committeeIsPresent (AnyNewEpochState sbe newEpochState, _, _) =
257260
caseShelleyToBabbageOrConwayEraOnwards
258261
(const $ error "Constitutional committee does not exist pre-Conway era")
@@ -263,7 +266,9 @@ committeeIsPresent (AnyNewEpochState sbe newEpochState, _, _) =
263266
. L.lsUTxOStateL
264267
. L.utxosGovStateL
265268
. L.cgsCommitteeL
266-
members <- L.committeeMembers <$> strictMaybeToMaybe mCommittee
267-
when (Map.null members) Nothing
269+
isCommitteePresent = Map.null . L.committeeMembers <$> strictMaybeToMaybe mCommittee
270+
if isCommitteePresent == Just True
271+
then (ConditionMet, ())
272+
else (ConditionNotMet, ())
268273
)
269274
sbe

‎cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepActivity.hs

+5-3
Original file line numberDiff line numberDiff line change
@@ -24,6 +24,7 @@ import Control.Monad
2424
import Control.Monad.Catch (MonadCatch)
2525
import Data.Data (Typeable)
2626
import qualified Data.Map as Map
27+
import Data.Maybe
2728
import Data.String
2829
import qualified Data.Text as Text
2930
import Data.Word (Word32)
@@ -287,10 +288,11 @@ makeActivityChangeProposal execConfig epochStateView ceo work prefix
287288
governanceActionTxId <- retrieveTransactionId execConfig signedProposalTx
288289

289290
governanceActionIndex <-
290-
H.nothingFailM $ watchEpochStateUpdate epochStateView timeout $ \(anyNewEpochState, _, _) ->
291-
return $ maybeExtractGovernanceActionIndex (fromString governanceActionTxId) anyNewEpochState
291+
H.nothingFailM . fmap snd $ watchEpochStateUpdate epochStateView timeout $ \(anyNewEpochState, _, _) -> do
292+
let r = maybeExtractGovernanceActionIndex (fromString governanceActionTxId) anyNewEpochState
293+
pure (if isJust r then ConditionMet else ConditionNotMet, r)
292294

293-
return (governanceActionTxId, governanceActionIndex)
295+
pure (governanceActionTxId, governanceActionIndex)
294296

295297
-- | Cast votes for a governance action.
296298
voteChangeProposal

‎cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/InfoAction.hs

+4-2
Original file line numberDiff line numberDiff line change
@@ -26,6 +26,7 @@ import Control.Monad
2626
import Data.Bifunctor (first)
2727
import Data.Foldable
2828
import qualified Data.Map.Strict as Map
29+
import Data.Maybe
2930
import Data.String
3031
import qualified Data.Text as Text
3132
import Data.Word
@@ -146,8 +147,9 @@ hprop_ledger_events_info_action = integrationRetryWorkspace 0 "info-hash" $ \tem
146147
]
147148

148149
governanceActionIndex <-
149-
H.nothingFailM $ watchEpochStateUpdate epochStateView (EpochInterval 1) $ \(anyNewEpochState, _, _) ->
150-
pure $ maybeExtractGovernanceActionIndex (fromString txidString) anyNewEpochState
150+
H.nothingFailM . fmap snd $ watchEpochStateUpdate epochStateView (EpochInterval 1) $ \(anyNewEpochState, _, _) -> do
151+
let r = maybeExtractGovernanceActionIndex (fromString txidString) anyNewEpochState
152+
pure (if isJust r then ConditionMet else ConditionNotMet, r)
151153

152154
let voteFp :: Int -> FilePath
153155
voteFp n = work </> gov </> "vote-" <> show n

‎cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/NoConfidence.hs

+13-9
Original file line numberDiff line numberDiff line change
@@ -24,6 +24,7 @@ import Control.Monad
2424
import Data.Bifunctor
2525
import qualified Data.ByteString.Char8 as BSC
2626
import qualified Data.Map.Strict as Map
27+
import Data.Maybe
2728
import Data.Maybe.Strict
2829
import Data.String
2930
import qualified Data.Text as Text
@@ -131,8 +132,9 @@ hprop_gov_no_confidence = integrationWorkspace "no-confidence" $ \tempAbsBasePat
131132

132133
epochStateView <- getEpochStateView configurationFile (File socketPath)
133134

134-
H.nothingFailM $ watchEpochStateUpdate epochStateView (EpochInterval 3) $ \(anyNewEpochState, _, _) ->
135+
(cond, ()) <- watchEpochStateUpdate epochStateView (EpochInterval 3) $ \(anyNewEpochState, _, _) ->
135136
pure $ committeeIsPresent True anyNewEpochState
137+
cond === ConditionMet
136138

137139
-- Step 2. Propose motion of no confidence. DRep and SPO voting thresholds must be met.
138140

@@ -191,8 +193,9 @@ hprop_gov_no_confidence = integrationWorkspace "no-confidence" $ \tempAbsBasePat
191193
governanceActionTxId <- retrieveTransactionId execConfig signedProposalTx
192194

193195
governanceActionIndex <-
194-
H.nothingFailM $ watchEpochStateUpdate epochStateView (EpochInterval 10) $ \(anyNewEpochState, _, _) ->
195-
pure $ maybeExtractGovernanceActionIndex (fromString governanceActionTxId) anyNewEpochState
196+
H.nothingFailM . fmap snd $ watchEpochStateUpdate epochStateView (EpochInterval 10) $ \(anyNewEpochState, _, _) -> do
197+
let r = maybeExtractGovernanceActionIndex (fromString governanceActionTxId) anyNewEpochState
198+
pure (if isJust r then ConditionMet else ConditionNotMet, r)
196199

197200
let spoVotes :: [(String, Int)]
198201
spoVotes = [("yes", 1), ("yes", 2), ("yes", 3)]
@@ -224,11 +227,12 @@ hprop_gov_no_confidence = integrationWorkspace "no-confidence" $ \tempAbsBasePat
224227
-- Step 4. We confirm the no confidence motion has been ratified by checking
225228
-- for an empty constitutional committee.
226229

227-
H.nothingFailM $ watchEpochStateUpdate epochStateView (EpochInterval 10) $ \(anyNewEpochState, _, _) ->
230+
(cond2, ()) <- watchEpochStateUpdate epochStateView (EpochInterval 10) $ \(anyNewEpochState, _, _) ->
228231
pure $ committeeIsPresent False anyNewEpochState
232+
cond2 === ConditionMet
229233

230234
-- | Checks if the committee is empty or not.
231-
committeeIsPresent :: Bool -> AnyNewEpochState -> Maybe ()
235+
committeeIsPresent :: Bool -> AnyNewEpochState -> (LedgerStateCondition, ())
232236
committeeIsPresent committeeExists (AnyNewEpochState sbe newEpochState) =
233237
caseShelleyToBabbageOrConwayEraOnwards
234238
(const $ error "Constitutional committee does not exist pre-Conway era")
@@ -240,11 +244,11 @@ committeeIsPresent committeeExists (AnyNewEpochState sbe newEpochState) =
240244
. L.cgsCommitteeL
241245
in if committeeExists
242246
then if isSJust mCommittee
243-
then Just () -- The committee is non empty and we terminate.
244-
else Nothing
247+
then (ConditionMet, ()) -- The committee is non empty and we terminate.
248+
else (ConditionNotMet, ())
245249
else if mCommittee == SNothing
246-
then Just () -- The committee is empty and we terminate.
247-
else Nothing
250+
then (ConditionMet, ()) -- The committee is empty and we terminate.
251+
else (ConditionNotMet, ())
248252
)
249253
sbe
250254

‎cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PredefinedAbstainDRep.hs

+4-2
Original file line numberDiff line numberDiff line change
@@ -24,6 +24,7 @@ import Prelude
2424
import Control.Monad
2525
import Control.Monad.Catch (MonadCatch)
2626
import Data.Data (Typeable)
27+
import Data.Maybe
2728
import Data.String (fromString)
2829
import qualified Data.Text as Text
2930
import Data.Word (Word32)
@@ -291,8 +292,9 @@ makeDesiredPoolNumberChangeProposal execConfig epochStateView ceo work prefix
291292
governanceActionTxId <- retrieveTransactionId execConfig signedProposalTx
292293

293294
governanceActionIndex <-
294-
H.nothingFailM $ watchEpochStateUpdate epochStateView (EpochInterval 1) $ \(anyNewEpochState, _, _) ->
295-
pure $ maybeExtractGovernanceActionIndex (fromString governanceActionTxId) anyNewEpochState
295+
H.nothingFailM . fmap snd $ watchEpochStateUpdate epochStateView (EpochInterval 1) $ \(anyNewEpochState, _, _) -> do
296+
let r = maybeExtractGovernanceActionIndex (fromString governanceActionTxId) anyNewEpochState
297+
pure (if isJust r then ConditionMet else ConditionNotMet, r)
296298

297299
pure (governanceActionTxId, governanceActionIndex)
298300

‎cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitution.hs

+3-2
Original file line numberDiff line numberDiff line change
@@ -168,8 +168,9 @@ hprop_ledger_events_propose_new_constitution = integrationWorkspace "propose-new
168168
governanceActionTxId <- retrieveTransactionId execConfig signedProposalTx
169169

170170
governanceActionIndex <-
171-
H.nothingFailM . watchEpochStateUpdate epochStateView (EpochInterval 1) $ \(anyNewEpochState, _, _) ->
172-
pure $ maybeExtractGovernanceActionIndex (fromString governanceActionTxId) anyNewEpochState
171+
H.nothingFailM . fmap snd . watchEpochStateUpdate epochStateView (EpochInterval 1) $ \(anyNewEpochState, _, _) -> do
172+
let r = maybeExtractGovernanceActionIndex (fromString governanceActionTxId) anyNewEpochState
173+
pure (if isJust r then ConditionMet else ConditionNotMet, r)
173174

174175
-- Proposal was successfully submitted, now we vote on the proposal and confirm it was ratified
175176
voteFiles <- generateVoteFiles execConfig work "vote-files"

0 commit comments

Comments
 (0)