Implement function watchEpochStateView

cardano-testnet/src/Testnet/EpochStateProcessing.hs

@@ -1,11 +1,15 @@
+{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
 
 module Testnet.EpochStateProcessing
   ( maybeExtractGovernanceActionIndex
   , findCondition
+  , watchEpochStateView
   ) where
 
-import           Cardano.Api (AnyNewEpochState (..), ConwayEra, EpochNo, File (File),
+import           Cardano.Api (AnyNewEpochState (..), ConwayEra, EpochNo (EpochNo), File (File),
                    FoldBlocksError, LedgerStateCondition (..), MonadIO, ShelleyBasedEra,
                    ValidationMode (FullValidation), foldEpochState, runExceptT,
                    shelleyBasedEraConstraints)
@@ -23,11 +27,15 @@ import           Control.Monad.State.Strict (MonadState (put), StateT)
 import           Data.Data ((:~:) (..))
 import qualified Data.Map as Map
 import           Data.Type.Equality (TestEquality (..))
-import           Data.Word (Word32)
+import           Data.Word (Word32, Word64)
 import           GHC.Stack
 import           Lens.Micro ((^.))
 
+import           Testnet.Components.Query (EpochStateView, getEpochState)
+
 import           Hedgehog
+import           Hedgehog.Extras (MonadAssertion)
+import qualified Hedgehog.Extras as H
 
 findCondition
   :: HasCallStack
@@ -75,3 +83,35 @@ maybeExtractGovernanceActionIndex sbe txid (AnyNewEpochState actualEra newEpochS
     compareWithTxId (Api.TxId ti1) Nothing (GovActionId (TxId ti2) (L.GovActionIx gai)) _
       | ti1 == L.extractHash ti2 = Just gai
     compareWithTxId _ x _ _ = x
+
+-- | Watch the epoch state view until the guard function returns @Just@ or the timeout is reached.
+-- | Wait for at least `minWait` epochs and at most `maxWait` epochs.
+-- | The function will return the result of the guard function if it is met, otherwise it will return @Nothing@.
+watchEpochStateView
+  :: forall m a. (MonadIO m, MonadTest m, MonadAssertion m)
+  => EpochStateView -- ^ The info to access the epoch state
+  -> (AnyNewEpochState -> m (Maybe a)) -- ^ The guard function (@Just@ if the condition is met, @Nothing@ otherwise)
+  -> Word64 -- ^ The minimum number of epochs to wait
+  -> Word64 -- ^ The maximum number of epochs to wait
+  -> m (Maybe a)
+watchEpochStateView epochStateView f minWait maxWait = do
+  AnyNewEpochState _ newEpochState <- getEpochState epochStateView
+  let (EpochNo currentEpoch) = L.nesEL newEpochState
+  go (EpochNo $ currentEpoch + minWait) (EpochNo $ currentEpoch + maxWait)
+    where
+      go :: EpochNo -> EpochNo -> m (Maybe a)
+      go (EpochNo startEpoch) (EpochNo timeout) = do
+        epochState@(AnyNewEpochState _ newEpochState') <- getEpochState epochStateView
+        let (EpochNo currentEpoch) = L.nesEL newEpochState'
+        if currentEpoch < startEpoch
+        then do H.threadDelay 100_000
+                go (EpochNo startEpoch) (EpochNo timeout)
+        else do condition <- f epochState
+                case condition of
+                  Just result -> pure (Just result)
+                  Nothing ->
+                    if currentEpoch > timeout
+                    then pure Nothing
+                    else do H.threadDelay 100_000
+                            go (EpochNo startEpoch) (EpochNo timeout)
+

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

@@ -15,15 +15,13 @@ 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
@@ -40,12 +38,14 @@ import           Testnet.Components.Query (EpochStateView, checkDRepState,
                    getMinDRepDeposit)
 import           Testnet.Components.TestWatchdog
 import           Testnet.Defaults
+import           Testnet.EpochStateProcessing (watchEpochStateView)
 import qualified Testnet.Process.Cli as P
 import qualified Testnet.Process.Run as H
 import qualified Testnet.Property.Util as H
 import           Testnet.Runtime
 
 import           Hedgehog
+import qualified Hedgehog as H
 import qualified Hedgehog.Extras as H
 import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO
 
@@ -192,44 +192,25 @@ activityChangeProposalTest execConfig epochStateView configurationFile socketPat
   (EpochNo epochAfterProp) <- getCurrentEpochNo epochStateView
   H.note_ $ "Epoch after \"" <> prefix <> "\" prop: " <> show epochAfterProp
 
-  waitAndCheck epochAfterProp
+  mResult <- watchEpochStateView epochStateView isSuccess minWait maxWait
+
+  void $ H.evalMaybe mResult
 
   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)
+    isSuccess :: (HasCallStack, MonadTest m)
+              => AnyNewEpochState -> m (Maybe ())
+    isSuccess (AnyNewEpochState sbe newEpochState) =
+      caseShelleyToBabbageOrConwayEraOnwards
+        (const $ error "activityChangeProposalTest: Only conway era onwards supported")
+        (const $ do
+          let (EpochInterval epochInterval) = newEpochState ^. nesEpochStateL . epochStateGovStateL . curPParamsGovStateL . ppDRepActivityL
+          return (case mExpected of
+                    Nothing -> Just ()
+                    Just expected -> if epochInterval == expected then Just () else Nothing)
+        )
+        sbe
 
 
 makeActivityChangeProposal