Skip to content

Commit

Permalink
Remove waiting bit from waitAndCheckNewEpochState and use `watchEpo…
Browse files Browse the repository at this point in the history 
…chStateView`
  • Loading branch information
@palas
palas committed May 15, 2024
1 parent f7e3e27 commit 5cfd34e
Show file tree
Hide file tree
Showing 4 changed files with 85 additions and 94 deletions.
108 changes: 62 additions & 46 deletions cardano-testnet/src/Testnet/Components/Query.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,8 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE FlexibleContexts #-}

module Testnet.Components.Query
( EpochStateView
Expand All @@ -21,7 +23,7 @@ module Testnet.Components.Query
, findUtxosWithAddress
, findLargestUtxoWithAddress
, findLargestUtxoForPaymentKey
, waitAndCheckNewEpochState
, assertNewEpochState
) where

import Cardano.Api as Api
Expand All @@ -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)
Expand All @@ -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, (^.))
Expand Down Expand Up @@ -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)
36 changes: 1 addition & 35 deletions cardano-testnet/src/Testnet/EpochStateProcessing.hs
View file
Original file line number Diff line number Diff line change
@@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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)

12 changes: 9 additions & 3 deletions cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepActivity.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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

Expand Down
23 changes: 13 additions & 10 deletions cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PredefinedAbstainDRep.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -26,16 +26,19 @@ 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)
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)
Expand All @@ -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
Expand Down Expand Up @@ -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

Expand Down

0 comments on commit 5cfd34e

Please sign in to comment.