Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Change watchEpochStateUpdate callback type #5855

Draft
wants to merge 1 commit into
base: master
Choose a base branch
from
Draft
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
46 changes: 22 additions & 24 deletions cardano-testnet/src/Testnet/Components/Query.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
13 changes: 6 additions & 7 deletions cardano-testnet/src/Testnet/EpochStateProcessing.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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) $
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I'm not a big fan of those == on a union type, for long term maintenance; but in this specific case I think it's fine. It's unlikely we'll add a third case to LedgerStateCondition.

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

Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)
Copy link
Contributor Author

@carbolymer carbolymer May 28, 2024

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Writing ifs by hand is error-prone. This will be simplified in a follow-up pr to API. We need Bool <-> LedgerStateCondition conversion functions


dRepVoteFiles <-
DRep.generateVoteFiles
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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")
Expand All @@ -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, ())
Comment on lines +270 to +272
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Suggested change
if isCommitteePresent == Just True
then (ConditionMet, ())
else (ConditionNotMet, ())
case isCommitteePresent of
Just True -> (ConditionMet, ())
_ -> (ConditionNotMet, ())

Too bad Haskell doesn't have arm sharing here 🙃

)
sbe
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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.

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

Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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)

Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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"
Expand Down
Loading