Fix issue with vote counting

IntersectMBO · May 15, 2024 · a2537b8 · a2537b8
1 parent 48cb398
commit a2537b8
Show file tree

Hide file tree

Showing 3 changed files with 48 additions and 4 deletions.
diff --git 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
@@ -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
@@ -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.