From 5cfd34e86801adb0c9116b85ac5749c8d362be19 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Tue, 14 May 2024 22:38:31 +0200 Subject: [PATCH] Remove waiting bit from `waitAndCheckNewEpochState` and use `watchEpochStateView` --- .../src/Testnet/Components/Query.hs | 108 ++++++++++-------- .../src/Testnet/EpochStateProcessing.hs | 36 +----- .../Cardano/Testnet/Test/Gov/DRepActivity.hs | 12 +- .../Testnet/Test/Gov/PredefinedAbstainDRep.hs | 23 ++-- 4 files changed, 85 insertions(+), 94 deletions(-) diff --git a/cardano-testnet/src/Testnet/Components/Query.hs b/cardano-testnet/src/Testnet/Components/Query.hs index 423a94cc9b7..84ba1b592d5 100644 --- a/cardano-testnet/src/Testnet/Components/Query.hs +++ b/cardano-testnet/src/Testnet/Components/Query.hs @@ -4,6 +4,8 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE FlexibleContexts #-} module Testnet.Components.Query ( EpochStateView @@ -21,7 +23,7 @@ module Testnet.Components.Query , findUtxosWithAddress , findLargestUtxoWithAddress , findLargestUtxoForPaymentKey - , waitAndCheckNewEpochState + , assertNewEpochState ) where import Cardano.Api as Api @@ -38,9 +40,8 @@ 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 (StateT, put) +import Control.Monad.Trans.State.Strict (put) import Data.Bifunctor (bimap) import Data.IORef import Data.List (sortOn) @@ -52,7 +53,6 @@ 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 (Lens', to, (^.)) @@ -359,53 +359,69 @@ getCurrentEpochNo epochStateView = withFrozenCallStack $ do AnyNewEpochState _ newEpochState <- getEpochState epochStateView pure $ newEpochState ^. L.nesELL --- | Waits for a minimum of @minWait@ epochs and a maximum of @maxWait@ epochs for --- the value pointed by the @lens@ to become the same as the @mExpected@ (if it is not 'Nothing'). --- If the value is not reached within the time frame, the test fails. If @mExpected@ is 'Nothing', --- the value is not checked, but the function will sitll wait for @minWait@ epochs. -waitAndCheckNewEpochState +-- | Assert that the value pointed by the @lens@ in the epoch state is the same as the @expected@ value +-- or it becomes the same within the @maxWait@ epochs. If the value is not reached within the time frame, +-- the test fails. +assertNewEpochState :: forall m era value. - (MonadAssertion m, MonadTest m, MonadIO m, Eq value) + (Show value, MonadAssertion m, MonadTest m, MonadIO m, Eq value, HasCallStack) => EpochStateView -- ^ Current epoch state view. It can be obtained using the 'getEpochStateView' function. - -> NodeConfigFile In -- ^ The file path to the configuration file. - -> SocketPath -- ^ The file path to the unix socket file to connect to the @cardano-node@. - -> ConwayEraOnwards era -- ^ Witness for the current era that shows it is Conway or onwards. - -> EpochInterval -- ^ The minimum wait time in epochs. - -> Maybe value -- ^ The expected value to check in the epoch state. + -> ConwayEraOnwards era -- ^ The ConwayEraOnwards witness for current era. + -> value -- ^ The expected value to check in the epoch state. -> EpochInterval -- ^ The maximum wait time in epochs. -> Lens' (L.NewEpochState (ShelleyLedgerEra era)) value -- ^ The lens to access the specific value in the epoch state. -> m () -waitAndCheckNewEpochState epochStateView configurationFile socketPath ceo (EpochInterval minWait) mExpected (EpochInterval maxWait) lens = do +assertNewEpochState epochStateView ceo expected maxWait lens = withFrozenCallStack $ do let sbe = conwayEraOnwardsToShelleyBasedEra ceo - (EpochNo curEpoch) <- getCurrentEpochNo epochStateView - eProposalResult - <- H.evalIO . runExceptT $ foldEpochState - configurationFile - socketPath - FullValidation - (EpochNo (curEpoch + fromIntegral maxWait)) - () - (\epochState _ _ -> filterEpochState (isSuccess curEpoch) epochState sbe) - void $ H.evalEither eProposalResult + mStateView <- watchEpochStateView epochStateView (checkEpochState sbe) maxWait + case mStateView of + Just () -> pure () + Nothing -> do epochState <- getEpochState epochStateView + val <- getFromEpochState sbe epochState + 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 + ] where - filterEpochState :: (EpochNo -> value -> Bool) -> AnyNewEpochState -> ShelleyBasedEra era -> StateT () IO LedgerStateCondition - filterEpochState f (AnyNewEpochState actualEra newEpochState) sbe = - 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 + checkEpochState :: HasCallStack + => ShelleyBasedEra era -> AnyNewEpochState -> m (Maybe ()) + checkEpochState sbe newEpochState = do + val <- getFromEpochState sbe newEpochState + return $ if val == expected then Just () else Nothing - isSuccess :: Word64 -> EpochNo -> value -> Bool - isSuccess epochAfterProp (EpochNo epochNo) value = - (epochAfterProp + fromIntegral minWait <= epochNo) && - (case mExpected of - Nothing -> True - Just expected -> value == expected) && - (epochNo <= epochAfterProp + fromIntegral maxWait) + getFromEpochState :: HasCallStack + => ShelleyBasedEra era -> AnyNewEpochState -> m value + getFromEpochState sbe (AnyNewEpochState actualEra newEpochState) = do + Refl <- either error pure $ assertErasEqual sbe actualEra + return $ newEpochState ^. lens + +-- | Watch the epoch state view until the guard function returns 'Just' or the timeout epoch is reached. +-- Wait for 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. (HasCallStack, 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) + -> EpochInterval -- ^ The maximum number of epochs to wait + -> m (Maybe a) +watchEpochStateView epochStateView f (EpochInterval maxWait) = withFrozenCallStack $ do + AnyNewEpochState _ newEpochState <- getEpochState epochStateView + let EpochNo currentEpoch = L.nesEL newEpochState + go (EpochNo $ currentEpoch + fromIntegral maxWait) + where + go :: EpochNo -> m (Maybe a) + go (EpochNo timeout) = do + epochState@(AnyNewEpochState _ newEpochState') <- getEpochState epochStateView + let EpochNo currentEpoch = L.nesEL newEpochState' + condition <- f epochState + case condition of + Just result -> pure (Just result) + Nothing -> do + if currentEpoch > timeout + then pure Nothing + else do + H.threadDelay 100_000 + go (EpochNo timeout) diff --git a/cardano-testnet/src/Testnet/EpochStateProcessing.hs b/cardano-testnet/src/Testnet/EpochStateProcessing.hs index 4068fd55bf0..b12a9f489ac 100644 --- a/cardano-testnet/src/Testnet/EpochStateProcessing.hs +++ b/cardano-testnet/src/Testnet/EpochStateProcessing.hs @@ -1,16 +1,14 @@ {-# LANGUAGE DataKinds #-} -{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} module Testnet.EpochStateProcessing ( maybeExtractGovernanceActionIndex , findCondition - , watchEpochStateView ) where import Cardano.Api -import Cardano.Api.Ledger (EpochInterval (..), GovActionId (..)) +import Cardano.Api.Ledger (GovActionId (..)) import qualified Cardano.Api.Ledger as L import qualified Cardano.Ledger.Conway.Governance as L @@ -25,11 +23,7 @@ import Data.Word (Word32) 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 @@ -78,31 +72,3 @@ maybeExtractGovernanceActionIndex txid (AnyNewEpochState sbe newEpochState) = | ti1 == L.extractHash ti2 = Just gai compareWithTxId _ x _ _ = x --- | Watch the epoch state view until the guard function returns 'Just' or the timeout epoch is reached. --- Wait for 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. (HasCallStack, 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) - -> EpochInterval -- ^ The maximum number of epochs to wait - -> m (Maybe a) -watchEpochStateView epochStateView f (EpochInterval maxWait) = withFrozenCallStack $ do - AnyNewEpochState _ newEpochState <- getEpochState epochStateView - let EpochNo currentEpoch = L.nesEL newEpochState - go (EpochNo $ currentEpoch + fromIntegral maxWait) - where - go :: EpochNo -> m (Maybe a) - go (EpochNo timeout) = do - epochState@(AnyNewEpochState _ newEpochState') <- getEpochState epochStateView - let EpochNo currentEpoch = L.nesEL newEpochState' - condition <- f epochState - case condition of - Just result -> pure (Just result) - Nothing -> do - if currentEpoch > timeout - then pure Nothing - else do - H.threadDelay 100_000 - go (EpochNo timeout) - diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepActivity.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepActivity.hs index c40fceb44ff..ff6256e8b61 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepActivity.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepActivity.hs @@ -32,7 +32,9 @@ import Data.Word (Word32, Word64) import GHC.Stack (HasCallStack, callStack) import System.FilePath (()) -import Testnet.Components.Query +import Testnet.Components.Query (EpochStateView, assertNewEpochState, checkDRepState, + findLargestUtxoForPaymentKey, getCurrentEpochNo, getEpochStateView, + getMinDRepDeposit) import Testnet.Components.TestWatchdog (runWithDefaultWatchdog_) import Testnet.Defaults (defaultDRepKeyPair, defaultDelegatorStakeKeyPair) import Testnet.Process.Cli.DRep @@ -200,8 +202,12 @@ activityChangeProposalTest execConfig epochStateView configurationFile socketPat (EpochNo epochAfterProp) <- getCurrentEpochNo epochStateView H.note_ $ "Epoch after \"" <> prefix <> "\" prop: " <> show epochAfterProp - waitAndCheckNewEpochState epochStateView configurationFile socketPath ceo minWait mExpected maxWait - (nesEpochStateL . epochStateGovStateL . curPParamsGovStateL . ppDRepActivityL) + void $ waitForEpochs epochStateView minWait + + case mExpected of + Nothing -> return () + Just expected -> assertNewEpochState epochStateView ceo expected maxWait + (nesEpochStateL . epochStateGovStateL . curPParamsGovStateL . ppDRepActivityL) return thisProposal diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PredefinedAbstainDRep.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PredefinedAbstainDRep.hs index 7afdf665ba3..f82fd3cdf41 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PredefinedAbstainDRep.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PredefinedAbstainDRep.hs @@ -26,6 +26,7 @@ import Prelude import Control.Monad (void) import Control.Monad.Catch (MonadCatch) +import Data.Data (Typeable) import Data.String (fromString) import qualified Data.Text as Text import Data.Word (Word32) @@ -33,9 +34,11 @@ import GHC.Stack (HasCallStack, callStack) import Lens.Micro ((^.)) import System.FilePath (()) -import Testnet.Components.Query (EpochStateView, findLargestUtxoForPaymentKey, - getCurrentEpochNo, getEpochStateView, getGovState, getMinDRepDeposit, - waitAndCheckNewEpochState) +import Testnet.Components.Configuration (anyEraToString) +import Testnet.Components.Query (EpochStateView, assertNewEpochState, + findLargestUtxoForPaymentKey, getCurrentEpochNo, getEpochStateView, getGovState, + getMinDRepDeposit) +import Testnet.Components.TestWatchdog (runWithDefaultWatchdog_) import Testnet.Defaults (defaultDRepKeyPair, defaultDelegatorStakeKeyPair) import Testnet.Process.Cli.DRep (createCertificatePublicationTxBody, createVotingTxBody, generateVoteFiles) @@ -49,9 +52,6 @@ import Testnet.Types (KeyPair (..), import Hedgehog import qualified Hedgehog.Extras as H -import Testnet.Components.TestWatchdog (runWithDefaultWatchdog_) -import Testnet.Components.Configuration (anyEraToString) -import Data.Data (Typeable) -- | This test creates a default testnet with three DReps delegated to by three -- separate stake holders (one per DRep). We then do a proposal for an arbitrary @@ -216,10 +216,13 @@ desiredPoolNumberProposalTest execConfig epochStateView configurationFile socket (EpochNo epochAfterProp) <- getCurrentEpochNo epochStateView H.note_ $ "Epoch after \"" <> prefix <> "\" prop: " <> show epochAfterProp - waitAndCheckNewEpochState epochStateView configurationFile socketPath ceo - (EpochInterval (fromIntegral minWait)) (fromIntegral <$> mExpected) - (EpochInterval (fromIntegral maxWait)) - (nesEpochStateL . epochStateGovStateL . cgsCurPParamsL . ppNOptL) + void $ waitForEpochs epochStateView (EpochInterval $ fromIntegral minWait) + + case mExpected of + Nothing -> return () + Just expected -> assertNewEpochState epochStateView ceo (fromIntegral expected) + (EpochInterval $ fromIntegral maxWait) + (nesEpochStateL . epochStateGovStateL . cgsCurPParamsL . ppNOptL) return thisProposal