diff --git a/cardano-testnet/src/Testnet/EpochStateProcessing.hs b/cardano-testnet/src/Testnet/EpochStateProcessing.hs index 4ce83236576..568c624207e 100644 --- a/cardano-testnet/src/Testnet/EpochStateProcessing.hs +++ b/cardano-testnet/src/Testnet/EpochStateProcessing.hs @@ -1,27 +1,39 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} module Testnet.EpochStateProcessing ( maybeExtractGovernanceActionIndex + , waitForGovActionVotes ) where import Cardano.Api -import Cardano.Api.Ledger (GovActionId (..)) +import Cardano.Api.Ledger (EpochInterval, GovActionId (..)) import qualified Cardano.Api.Ledger as L +import Cardano.Api.Shelley (ShelleyLedgerEra) import qualified Cardano.Ledger.Conway.Governance as L import qualified Cardano.Ledger.Shelley.API as L +import Cardano.Ledger.Shelley.LedgerState (newEpochStateGovStateL) import qualified Cardano.Ledger.Shelley.LedgerState as L import Prelude +import Data.Data ((:~:) (..)) import qualified Data.Map as Map import Data.Word (Word32) +import GHC.Exts (IsList (toList), toList) import GHC.Stack -import Lens.Micro ((^.)) +import Lens.Micro (to, (^.)) +import Testnet.Components.Query (EpochStateView, watchEpochStateView) +import Testnet.Property.Assert (assertErasEqual) +import Hedgehog (MonadTest) +import Hedgehog.Extras (MonadAssertion) +import qualified Hedgehog.Extras as H maybeExtractGovernanceActionIndex :: HasCallStack @@ -41,3 +53,33 @@ maybeExtractGovernanceActionIndex txid (AnyNewEpochState sbe newEpochState) = | ti1 == L.extractHash ti2 = Just gai compareWithTxId _ x _ _ = x +-- | Wait for the last gov action proposal in the list to have DRep or SPO votes. +waitForGovActionVotes + :: forall m era. + (MonadAssertion m, MonadTest m, MonadIO m, HasCallStack) + => EpochStateView -- ^ Current epoch state view. It can be obtained using the 'getEpochStateView' function. + -> ConwayEraOnwards era -- ^ The ConwayEraOnwards witness for current era. + -> EpochInterval -- ^ The maximum wait time in epochs. + -> m () +waitForGovActionVotes epochStateView ceo maxWait = withFrozenCallStack $ do + mResult <- watchEpochStateView epochStateView getFromEpochState maxWait + case mResult of + Just () -> pure () + Nothing -> H.failMessage callStack "waitForGovActionVotes: No votes appeared before timeout." + where + getFromEpochState :: HasCallStack + => AnyNewEpochState -> m (Maybe ()) + getFromEpochState (AnyNewEpochState actualEra newEpochState) = do + let sbe = conwayEraOnwardsToShelleyBasedEra ceo + Refl <- H.leftFail $ assertErasEqual sbe actualEra + let govState :: L.ConwayGovState (ShelleyLedgerEra era) = conwayEraOnwardsConstraints ceo $ newEpochState ^. newEpochStateGovStateL + proposals = govState ^. L.cgsProposalsL . L.pPropsL . to toList + if null proposals + then pure Nothing + 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 () 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 7f01535d27e..b6a3d683da9 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 @@ -37,6 +37,7 @@ import Testnet.Components.Configuration import Testnet.Components.Query import Testnet.Components.TestWatchdog import Testnet.Defaults +import Testnet.EpochStateProcessing (waitForGovActionVotes) import qualified Testnet.Process.Cli.DRep as DRep import Testnet.Process.Cli.Keys import qualified Testnet.Process.Cli.SPO as SPO @@ -205,7 +206,7 @@ hprop_constitutional_committee_add_new = integrationWorkspace "constitutional-co submitTx execConfig cEra voteTxFp - _ <- waitForEpochs epochStateView (L.EpochInterval 1) + waitForGovActionVotes epochStateView ceo (L.EpochInterval 1) govState <- getGovState epochStateView ceo govActionState <- H.headM $ govState ^. L.cgsProposalsL . L.pPropsL . to toList 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 9d805e4c0da..d73f47dd581 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 @@ -34,6 +34,7 @@ import Testnet.Components.Configuration import Testnet.Components.Query import Testnet.Components.TestWatchdog import Testnet.Defaults +import Testnet.EpochStateProcessing (waitForGovActionVotes) import Testnet.Process.Cli.DRep import Testnet.Process.Cli.Keys import Testnet.Process.Cli.Transaction @@ -182,7 +183,7 @@ hprop_ledger_events_propose_new_constitution = integrationWorkspace "propose-new submitTx execConfig cEra voteTxFp - _ <- waitForEpochs epochStateView (EpochInterval 1) + waitForGovActionVotes epochStateView ceo (EpochInterval 1) -- Count votes before checking for ratification. It may happen that the proposal gets removed after -- ratification because of a long waiting time, so we won't be able to access votes.