Refactor out and generalize waitAndCheck function

IntersectMBO · May 3, 2024 · 2def194 · 2def194
1 parent 9bf8450
commit 2def194
Show file tree

Hide file tree

Showing 2 changed files with 49 additions and 45 deletions.
diff --git a/cardano-testnet/src/Testnet/Components/Query.hs b/cardano-testnet/src/Testnet/Components/Query.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Testnet.Components.Query
@@ -20,23 +21,26 @@ module Testnet.Components.Query
   , findLargestUtxoWithAddress
   , findLargestUtxoForPaymentKey
   , startLedgerNewEpochStateLogging
+  , waitAndCheckNewEpochState
   ) where
 
 import           Cardano.Api as Api
-import           Cardano.Api.Ledger (Credential, DRepState, KeyRole (DRepRole), StandardCrypto)
+import           Cardano.Api.Ledger (Credential, DRepState, EpochInterval, KeyRole (DRepRole),
+                   StandardCrypto)
 import           Cardano.Api.Shelley (ShelleyLedgerEra, fromShelleyTxIn, fromShelleyTxOut)
 
 import qualified Cardano.Ledger.Api as L
-import           Cardano.Ledger.BaseTypes (EpochInterval, addEpochInterval)
+import           Cardano.Ledger.BaseTypes (addEpochInterval)
 import qualified Cardano.Ledger.Coin as L
 import qualified Cardano.Ledger.Conway.Governance as L
 import qualified Cardano.Ledger.Conway.PParams as L
 import qualified Cardano.Ledger.Shelley.LedgerState as L
 import qualified Cardano.Ledger.UTxO as L
 
 import           Control.Exception.Safe (MonadCatch)
+import           Control.Monad (void)
 import           Control.Monad.Trans.Resource
-import           Control.Monad.Trans.State.Strict (put)
+import           Control.Monad.Trans.State.Strict (StateT, put)
 import           Data.Bifunctor (bimap)
 import           Data.IORef
 import           Data.List (sortOn)
@@ -48,9 +52,10 @@ import           Data.Ord (Down (..))
 import           Data.Text (Text)
 import qualified Data.Text as T
 import           Data.Type.Equality
+import           Data.Word (Word64)
 import           GHC.Exts (IsList (..))
 import           GHC.Stack
-import           Lens.Micro (to, (^.))
+import           Lens.Micro (Lens', to, (^.))
 
 import           Testnet.Property.Assert
 import           Testnet.Property.Utils (runInBackground)
@@ -337,3 +342,40 @@ getCurrentEpochNo
 getCurrentEpochNo epochStateView = withFrozenCallStack $ do
   AnyNewEpochState _ newEpochState <- getEpochState epochStateView
   pure $ newEpochState ^. L.nesELL
+
+waitAndCheckNewEpochState :: forall m era value. (MonadAssertion m, MonadTest m, MonadIO m, Eq value)
+                          => EpochStateView -> FilePath -> FilePath -> ShelleyBasedEra era -> Word64 -> Maybe value -> Word64
+                          -> Lens' (L.NewEpochState (ShelleyLedgerEra era)) value -> m ()
+waitAndCheckNewEpochState epochStateView configurationFile socketPath sbe minWait mExpected maxWait lens = do
+  (EpochNo curEpoch) <- getCurrentEpochNo epochStateView
+  eProposalResult
+    <- H.evalIO . runExceptT $ foldEpochState
+                                (File configurationFile)
+                                (File socketPath)
+                                FullValidation
+                                (EpochNo (curEpoch + maxWait))
+                                ()
+                                (\epochState _ _ -> filterEpochState (isSuccess curEpoch) epochState)
+  void $ H.evalEither eProposalResult
+  where
+    filterEpochState :: (EpochNo -> value -> Bool) -> AnyNewEpochState -> StateT () IO LedgerStateCondition
+    filterEpochState f (AnyNewEpochState actualEra newEpochState) =
+        caseShelleyToBabbageOrConwayEraOnwards
+          (const $ error "waitAndCheck: Only conway era onwards supported")
+          (const $ do
+            Refl <- either error pure $ assertErasEqual sbe actualEra
+            let val = newEpochState ^. lens
+                currEpoch = L.nesEL newEpochState
+            return (if f currEpoch val
+                    then ConditionMet
+                    else ConditionNotMet)
+          )
+          sbe
+
+    isSuccess :: Word64 -> EpochNo -> value -> Bool
+    isSuccess epochAfterProp (EpochNo epochNo) value =
+      (epochAfterProp + minWait <= epochNo) &&
+      (case mExpected of
+        Nothing -> True
+        Just expected -> value == expected) &&
+      (epochNo <= epochAfterProp + maxWait)
diff --git a/...o-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/DRepActivity.hs b/...o-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/DRepActivity.hs
@@ -15,29 +15,26 @@ import           Cardano.Api.Ledger (EpochInterval (EpochInterval), drepExpiry)
 
 import           Cardano.Ledger.Conway.Core (curPParamsGovStateL)
 import           Cardano.Ledger.Conway.PParams (ppDRepActivityL)
-import           Cardano.Ledger.Shelley.API (NewEpochState (..))
 import           Cardano.Ledger.Shelley.LedgerState (epochStateGovStateL, nesEpochStateL)
 import           Cardano.Testnet
 
 import           Prelude
 
 import           Control.Monad
 import           Control.Monad.Catch (MonadCatch)
-import           Control.Monad.Trans.State.Strict (StateT)
 import qualified Data.Map as Map
 import           Data.String
 import qualified Data.Text as Text
 import           Data.Word (Word32, Word64)
 import           GHC.Stack (HasCallStack, callStack)
-import           Lens.Micro ((^.))
 import           System.FilePath ((</>))
 
 import           Testnet.Components.DReps (createVotingTxBody, delegateToDRep, generateVoteFiles,
                    getLastPParamUpdateActionId, registerDRep, retrieveTransactionId, signTx,
                    submitTx)
 import           Testnet.Components.Query (EpochStateView, checkDRepState,
                    findLargestUtxoForPaymentKey, getCurrentEpochNo, getEpochStateView,
-                   getMinDRepDeposit)
+                   getMinDRepDeposit, waitAndCheckNewEpochState)
 import           Testnet.Components.TestWatchdog
 import           Testnet.Defaults
 import qualified Testnet.Process.Cli as P
@@ -192,46 +189,11 @@ activityChangeProposalTest execConfig epochStateView configurationFile socketPat
   (EpochNo epochAfterProp) <- getCurrentEpochNo epochStateView
   H.note_ $ "Epoch after \"" <> prefix <> "\" prop: " <> show epochAfterProp
 
-  waitAndCheck epochAfterProp
+  waitAndCheckNewEpochState epochStateView configurationFile socketPath sbe minWait (EpochInterval <$> mExpected) maxWait
+                            (nesEpochStateL . epochStateGovStateL . curPParamsGovStateL . ppDRepActivityL)
 
   return thisProposal
 
-  where
-    waitAndCheck :: (MonadTest m, MonadIO m)
-                 => Word64 -> m ()
-    waitAndCheck epochAfterProp = do
-      !eProposalResult
-        <- evalIO . runExceptT $ foldEpochState
-                                    (File configurationFile)
-                                    (File socketPath)
-                                    FullValidation
-                                    (EpochNo (epochAfterProp + maxWait))
-                                    ()
-                                    (\epochState _ _ -> filterEpochState (isSuccess epochAfterProp) epochState)
-      void $ evalEither eProposalResult
-
-    filterEpochState :: (EpochNo -> EpochInterval -> Bool) -> AnyNewEpochState -> StateT () IO LedgerStateCondition
-    filterEpochState f (AnyNewEpochState sbe newEpochState) =
-        caseShelleyToBabbageOrConwayEraOnwards
-          (const $ error "activityChangeProposalTest: Only conway era onwards supported")
-          (const $ do
-            let pParams = newEpochState ^. nesEpochStateL . epochStateGovStateL . curPParamsGovStateL . ppDRepActivityL
-                currEpoch = nesEL newEpochState
-            return (if f currEpoch pParams
-                    then ConditionMet
-                    else ConditionNotMet)
-          )
-          sbe
-
-    isSuccess :: Word64 -> EpochNo -> EpochInterval -> Bool
-    isSuccess epochAfterProp (EpochNo epochNo) (EpochInterval epochInterval) =
-      (epochAfterProp + minWait <= epochNo) &&
-      (case mExpected of
-        Nothing -> True
-        Just expected -> epochInterval == expected) &&
-      (epochNo <= epochAfterProp + maxWait)
-
-
 makeActivityChangeProposal
   :: (HasCallStack, H.MonadAssertion m, MonadTest m, MonadCatch m, MonadIO m)
   => H.ExecConfig