From 71890fbb590a91e7821a8e9ffe4c9831089bd92c Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Wed, 8 May 2024 23:14:37 +0200 Subject: [PATCH 1/7] Improve stability of DRep Activity test and reenable --- .../Cardano/Testnet/Test/Gov/DRepActivity.hs | 6 +++--- .../test/cardano-testnet-test/cardano-testnet-test.hs | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) 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 06b62270089..ae4a9c6baaf 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 @@ -64,7 +64,7 @@ hprop_check_drep_activity = H.integrationWorkspace "test-activity" $ \tempAbsBas era = toCardanoEra sbe cEra = AnyCardanoEra era fastTestnetOptions = cardanoDefaultTestnetOptions - { cardanoEpochLength = 100 + { cardanoEpochLength = 200 , cardanoNodeEra = cEra , cardanoNumDReps = 1 } @@ -93,8 +93,8 @@ hprop_check_drep_activity = H.integrationWorkspace "test-activity" $ \tempAbsBas -- This proposal should pass let minEpochsToWaitIfChanging = 0 -- The change already provides a min bound - minEpochsToWaitIfNotChanging = 3 -- We cannot wait for change since there is no change (we wait a bit) - maxEpochsToWaitAfterProposal = 10 -- If it takes more than 10 epochs we give up in any case + minEpochsToWaitIfNotChanging = 2 -- We cannot wait for change since there is no change (we wait a bit) + maxEpochsToWaitAfterProposal = 2 -- If it takes more than 2 epochs we give up in any case firstTargetDRepActivity = 3 void $ activityChangeProposalTest execConfig epochStateView configurationFile socketPath ceo gov "firstProposal" wallet0 [(1, "yes")] firstTargetDRepActivity diff --git a/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs b/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs index 2ce5171ba5f..216a2cfa116 100644 --- a/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs +++ b/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs @@ -14,6 +14,7 @@ import qualified Cardano.Testnet.Test.Cli.Query import qualified Cardano.Testnet.Test.Cli.QuerySlotNumber import qualified Cardano.Testnet.Test.FoldEpochState import qualified Cardano.Testnet.Test.Gov.CommitteeAddNew as Gov +import qualified Cardano.Testnet.Test.Gov.DRepActivity as Gov import qualified Cardano.Testnet.Test.Gov.DRepDeposit as Gov import qualified Cardano.Testnet.Test.Gov.DRepRetirement as Gov import qualified Cardano.Testnet.Test.Gov.ProposeNewConstitution as Gov @@ -49,8 +50,7 @@ tests = do -- TODO: Replace foldBlocks with checkLedgerStateCondition , T.testGroup "Governance" [ H.ignoreOnMacAndWindows "Committee Add New" Gov.hprop_constitutional_committee_add_new - -- TODO: "DRep Activity" is too flaky at the moment. Disabling until we can fix it. - -- , H.ignoreOnWindows "DRep Activity" Cardano.Testnet.Test.LedgerEvents.Gov.DRepActivity.hprop_check_drep_activity + , H.ignoreOnWindows "DRep Activity" Gov.hprop_check_drep_activity , H.ignoreOnWindows "DRep Deposits" Gov.hprop_ledger_events_drep_deposits -- FIXME Those tests are flaky -- , H.ignoreOnWindows "InfoAction" LedgerEvents.hprop_ledger_events_info_action From 1edac1ad870cca26cfc300c9de207a1097d6c75c Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Thu, 9 May 2024 01:01:39 +0200 Subject: [PATCH 2/7] Implement function `watchEpochStateView` --- .../src/Testnet/EpochStateProcessing.hs | 39 +++++++++++++- .../Cardano/Testnet/Test/Gov/DRepActivity.hs | 53 ++++++------------- 2 files changed, 55 insertions(+), 37 deletions(-) diff --git a/cardano-testnet/src/Testnet/EpochStateProcessing.hs b/cardano-testnet/src/Testnet/EpochStateProcessing.hs index b12a9f489ac..648b8d3d2c6 100644 --- a/cardano-testnet/src/Testnet/EpochStateProcessing.hs +++ b/cardano-testnet/src/Testnet/EpochStateProcessing.hs @@ -1,10 +1,12 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} module Testnet.EpochStateProcessing ( maybeExtractGovernanceActionIndex , findCondition + , watchEpochStateView ) where import Cardano.Api @@ -19,11 +21,15 @@ import Prelude import Control.Monad.State.Strict (MonadState (put), StateT) import qualified Data.Map as Map -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 @@ -72,3 +78,34 @@ 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 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) + 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 ae4a9c6baaf..ba559485b86 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 @@ -15,7 +15,6 @@ 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 @@ -23,7 +22,6 @@ 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.Types import Hedgehog +import qualified Hedgehog as H import qualified Hedgehog.Extras as H -- | Execute me with: @@ -188,44 +188,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 - configurationFile - 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 From e739fac0f31add304c519ae88b5e1cdf05bca191 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Thu, 9 May 2024 21:19:53 +0200 Subject: [PATCH 3/7] Apply suggestions from code review Co-authored-by: Mateusz Galazyn <228866+carbolymer@users.noreply.github.com> --- .../src/Testnet/EpochStateProcessing.hs | 20 +++++------ .../Cardano/Testnet/Test/Gov/DRepActivity.hs | 33 +++++++++---------- 2 files changed, 26 insertions(+), 27 deletions(-) diff --git a/cardano-testnet/src/Testnet/EpochStateProcessing.hs b/cardano-testnet/src/Testnet/EpochStateProcessing.hs index 648b8d3d2c6..dab866b8126 100644 --- a/cardano-testnet/src/Testnet/EpochStateProcessing.hs +++ b/cardano-testnet/src/Testnet/EpochStateProcessing.hs @@ -10,7 +10,7 @@ module Testnet.EpochStateProcessing ) where import Cardano.Api -import Cardano.Api.Ledger (GovActionId (..)) +import Cardano.Api.Ledger (EpochInterval (..), GovActionId (..)) import qualified Cardano.Api.Ledger as L import qualified Cardano.Ledger.Conway.Governance as L @@ -21,7 +21,7 @@ import Prelude import Control.Monad.State.Strict (MonadState (put), StateT) import qualified Data.Map as Map -import Data.Word (Word32, Word64) +import Data.Word (Word32) import GHC.Stack import Lens.Micro ((^.)) @@ -78,20 +78,20 @@ 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 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@. +-- | Watch the epoch state view until the guard function returns 'Just' or the timeout epoch 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) + :: 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) - -> Word64 -- ^ The minimum number of epochs to wait - -> Word64 -- ^ The maximum number of epochs to wait + -> EpochInterval -- ^ The minimum number of epochs to wait + -> EpochInterval -- ^ The maximum number of epochs to wait -> m (Maybe a) -watchEpochStateView epochStateView f minWait maxWait = do +watchEpochStateView epochStateView f (EpochInterval minWait) (EpochInterval maxWait) = withFrozenCallStack $ do AnyNewEpochState _ newEpochState <- getEpochState epochStateView let (EpochNo currentEpoch) = L.nesEL newEpochState - go (EpochNo $ currentEpoch + minWait) (EpochNo $ currentEpoch + maxWait) + go (EpochNo $ currentEpoch + fromIntegral minWait) (EpochNo $ currentEpoch + fromIntegral maxWait) where go :: EpochNo -> EpochNo -> m (Maybe a) go (EpochNo startEpoch) (EpochNo timeout) = do 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 ba559485b86..7706834b927 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 @@ -36,16 +36,17 @@ import Testnet.Components.DRep (createVotingTxBody, delegateToDRep, ge import Testnet.Components.Query (EpochStateView, checkDRepState, findLargestUtxoForPaymentKey, getCurrentEpochNo, getEpochStateView, getMinDRepDeposit) -import Testnet.Components.TestWatchdog -import Testnet.Defaults +import Testnet.Components.TestWatchdog (runWithDefaultWatchdog_) +import Testnet.Defaults (defaultDRepKeyPair, defaultDelegatorStakeKeyPair) 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.Types +import Testnet.Types (KeyPair (..), PaymentKeyInfo (..), PoolNode (..), SomeKeyPair (..), + TestnetRuntime (TestnetRuntime, configurationFile, poolNodes, testnetMagic, wallets), + nodeSocketPath) -import Hedgehog -import qualified Hedgehog as H +import Hedgehog (MonadTest, Property, annotateShow) import qualified Hedgehog.Extras as H -- | Execute me with: @@ -92,9 +93,9 @@ hprop_check_drep_activity = H.integrationWorkspace "test-activity" $ \tempAbsBas gov <- H.createDirectoryIfMissing $ work "governance" -- This proposal should pass - let minEpochsToWaitIfChanging = 0 -- The change already provides a min bound - minEpochsToWaitIfNotChanging = 2 -- We cannot wait for change since there is no change (we wait a bit) - maxEpochsToWaitAfterProposal = 2 -- If it takes more than 2 epochs we give up in any case + let minEpochsToWaitIfChanging = EpochInterval 0 -- The change already provides a min bound + minEpochsToWaitIfNotChanging = EpochInterval 2 -- We cannot wait for change since there is no change (we wait a bit) + maxEpochsToWaitAfterProposal = EpochInterval 2 -- If it takes more than 2 epochs we give up in any case firstTargetDRepActivity = 3 void $ activityChangeProposalTest execConfig epochStateView configurationFile socketPath ceo gov "firstProposal" wallet0 [(1, "yes")] firstTargetDRepActivity @@ -159,12 +160,12 @@ activityChangeProposalTest -> PaymentKeyInfo -> t (Int, String) -> Word32 - -> Word64 + -> EpochInterval -> Maybe Word32 - -> Word64 + -> EpochInterval -> m (String, Word32) activityChangeProposalTest execConfig epochStateView configurationFile socketPath ceo work prefix - wallet votes change minWait mExpected maxWait = do + wallet votes change minWait mExpected maxWait@(EpochInterval maxWaitNum) = do let sbe = conwayEraOnwardsToShelleyBasedEra ceo @@ -180,7 +181,7 @@ activityChangeProposalTest execConfig epochStateView configurationFile socketPat thisProposal@(governanceActionTxId, governanceActionIndex) <- makeActivityChangeProposal execConfig epochStateView configurationFile socketPath - ceo baseDir "proposal" mPreviousProposalInfo change wallet (epochBeforeProp + maxWait) + ceo baseDir "proposal" mPreviousProposalInfo change wallet (epochBeforeProp + fromIntegral maxWaitNum) voteChangeProposal execConfig epochStateView sbe baseDir "vote" governanceActionTxId governanceActionIndex propVotes wallet @@ -188,16 +189,14 @@ activityChangeProposalTest execConfig epochStateView configurationFile socketPat (EpochNo epochAfterProp) <- getCurrentEpochNo epochStateView H.note_ $ "Epoch after \"" <> prefix <> "\" prop: " <> show epochAfterProp - mResult <- watchEpochStateView epochStateView isSuccess minWait maxWait - - void $ H.evalMaybe mResult + H.nothingFailM $ watchEpochStateView epochStateView isDRepActivityUpdated minWait maxWait return thisProposal where - isSuccess :: (HasCallStack, MonadTest m) + isDRepActivityUpdated :: (HasCallStack, MonadTest m) => AnyNewEpochState -> m (Maybe ()) - isSuccess (AnyNewEpochState sbe newEpochState) = + isDRepActivityUpdated (AnyNewEpochState sbe newEpochState) = caseShelleyToBabbageOrConwayEraOnwards (const $ error "activityChangeProposalTest: Only conway era onwards supported") (const $ do From dc8d3a8d933f0ebf0513d635f2785b4d8a1604aa Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Thu, 9 May 2024 23:19:08 +0200 Subject: [PATCH 4/7] Remove initial wait from `watchEpochStateView` --- .../src/Testnet/EpochStateProcessing.hs | 31 ++++++++---------- .../Cardano/Testnet/Test/Gov/DRepActivity.hs | 32 +++++++++---------- 2 files changed, 30 insertions(+), 33 deletions(-) diff --git a/cardano-testnet/src/Testnet/EpochStateProcessing.hs b/cardano-testnet/src/Testnet/EpochStateProcessing.hs index dab866b8126..8004c4dd1aa 100644 --- a/cardano-testnet/src/Testnet/EpochStateProcessing.hs +++ b/cardano-testnet/src/Testnet/EpochStateProcessing.hs @@ -79,33 +79,30 @@ maybeExtractGovernanceActionIndex txid (AnyNewEpochState sbe newEpochState) = compareWithTxId _ x _ _ = x -- | Watch the epoch state view until the guard function returns 'Just' or the timeout epoch is reached. --- Wait for at least @minWait@ epochs and at most @maxWait@ epochs. +-- 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 minimum number of epochs to wait -> EpochInterval -- ^ The maximum number of epochs to wait -> m (Maybe a) -watchEpochStateView epochStateView f (EpochInterval minWait) (EpochInterval maxWait) = withFrozenCallStack $ do +watchEpochStateView epochStateView f (EpochInterval maxWait) = withFrozenCallStack $ do AnyNewEpochState _ newEpochState <- getEpochState epochStateView let (EpochNo currentEpoch) = L.nesEL newEpochState - go (EpochNo $ currentEpoch + fromIntegral minWait) (EpochNo $ currentEpoch + fromIntegral maxWait) + go (EpochNo $ currentEpoch + fromIntegral maxWait) where - go :: EpochNo -> EpochNo -> m (Maybe a) - go (EpochNo startEpoch) (EpochNo timeout) = do + go :: EpochNo -> m (Maybe a) + go (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) + 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 7706834b927..9ce1ff0be36 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 @@ -11,7 +11,7 @@ module Cardano.Testnet.Test.Gov.DRepActivity import Cardano.Api as Api import Cardano.Api.Error (displayError) -import Cardano.Api.Ledger (EpochInterval (EpochInterval), drepExpiry) +import Cardano.Api.Ledger (EpochInterval (EpochInterval, unEpochInterval), drepExpiry) import Cardano.Ledger.Conway.Core (curPParamsGovStateL) import Cardano.Ledger.Conway.PParams (ppDRepActivityL) @@ -96,7 +96,7 @@ hprop_check_drep_activity = H.integrationWorkspace "test-activity" $ \tempAbsBas let minEpochsToWaitIfChanging = EpochInterval 0 -- The change already provides a min bound minEpochsToWaitIfNotChanging = EpochInterval 2 -- We cannot wait for change since there is no change (we wait a bit) maxEpochsToWaitAfterProposal = EpochInterval 2 -- If it takes more than 2 epochs we give up in any case - firstTargetDRepActivity = 3 + firstTargetDRepActivity = EpochInterval 3 void $ activityChangeProposalTest execConfig epochStateView configurationFile socketPath ceo gov "firstProposal" wallet0 [(1, "yes")] firstTargetDRepActivity minEpochsToWaitIfChanging (Just firstTargetDRepActivity) @@ -119,7 +119,7 @@ hprop_check_drep_activity = H.integrationWorkspace "test-activity" $ \tempAbsBas -- This proposal should fail because there is 2 DReps that don't vote (out of 3) -- and we have the stake distributed evenly - let secondTargetDRepActivity = firstTargetDRepActivity + 1 + let secondTargetDRepActivity = EpochInterval (unEpochInterval firstTargetDRepActivity + 1) void $ activityChangeProposalTest execConfig epochStateView configurationFile socketPath ceo gov "failingProposal" wallet2 [(1, "yes")] secondTargetDRepActivity minEpochsToWaitIfNotChanging (Just firstTargetDRepActivity) @@ -132,7 +132,7 @@ hprop_check_drep_activity = H.integrationWorkspace "test-activity" $ \tempAbsBas sequence_ [activityChangeProposalTest execConfig epochStateView configurationFile socketPath ceo gov ("fillerProposalNum" ++ show proposalNum) wallet [(1, "yes")] - (secondTargetDRepActivity + fromIntegral proposalNum) + (EpochInterval (unEpochInterval secondTargetDRepActivity + fromIntegral proposalNum)) minEpochsToWaitIfNotChanging Nothing maxEpochsToWaitAfterProposal | (proposalNum, wallet) <- zip [1..numOfFillerProposals] (cycle [wallet0, wallet1, wallet2])] @@ -142,7 +142,7 @@ hprop_check_drep_activity = H.integrationWorkspace "test-activity" $ \tempAbsBas -- Last proposal (set activity to something else again and it should pass, because of inactivity) -- Because 2 out of 3 DReps were inactive, prop should pass - let lastTargetDRepActivity = secondTargetDRepActivity + fromIntegral numOfFillerProposals + 1 + let lastTargetDRepActivity = EpochInterval (unEpochInterval secondTargetDRepActivity + fromIntegral numOfFillerProposals + 1) void $ activityChangeProposalTest execConfig epochStateView configurationFile socketPath ceo gov "lastProposal" wallet0 [(1, "yes")] lastTargetDRepActivity minEpochsToWaitIfChanging (Just lastTargetDRepActivity) @@ -159,9 +159,9 @@ activityChangeProposalTest -> FilePath -> PaymentKeyInfo -> t (Int, String) - -> Word32 -> EpochInterval - -> Maybe Word32 + -> EpochInterval + -> Maybe EpochInterval -> EpochInterval -> m (String, Word32) activityChangeProposalTest execConfig epochStateView configurationFile socketPath ceo work prefix @@ -189,25 +189,25 @@ activityChangeProposalTest execConfig epochStateView configurationFile socketPat (EpochNo epochAfterProp) <- getCurrentEpochNo epochStateView H.note_ $ "Epoch after \"" <> prefix <> "\" prop: " <> show epochAfterProp - H.nothingFailM $ watchEpochStateView epochStateView isDRepActivityUpdated minWait maxWait + void $ waitForEpochs epochStateView minWait + case mExpected of + Nothing -> return () + Just expected -> H.nothingFailM $ watchEpochStateView epochStateView (isDRepActivityUpdated expected) maxWait return thisProposal where isDRepActivityUpdated :: (HasCallStack, MonadTest m) - => AnyNewEpochState -> m (Maybe ()) - isDRepActivityUpdated (AnyNewEpochState sbe newEpochState) = + => EpochInterval -> AnyNewEpochState -> m (Maybe ()) + isDRepActivityUpdated (EpochInterval expected) (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) + return (if epochInterval == expected then Just () else Nothing) ) sbe - makeActivityChangeProposal :: (HasCallStack, H.MonadAssertion m, MonadTest m, MonadCatch m, MonadIO m) => H.ExecConfig @@ -218,7 +218,7 @@ makeActivityChangeProposal -> FilePath -> String -> Maybe (String, Word32) - -> Word32 + -> EpochInterval -> PaymentKeyInfo -> Word64 -> m (String, Word32) @@ -260,7 +260,7 @@ makeActivityChangeProposal execConfig epochStateView configurationFile socketPat [ "--prev-governance-action-tx-id", prevGovernanceActionTxId , "--prev-governance-action-index", show prevGovernanceActionIndex ]) prevGovActionInfo ++ - [ "--drep-activity", show drepActivity + [ "--drep-activity", show (unEpochInterval drepActivity) , "--anchor-url", "https://tinyurl.com/3wrwb2as" , "--anchor-data-hash", proposalAnchorDataHash , "--out-file", proposalFile From 39812aa5d0ce44b58618183bc7f1e35d7d623e39 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Mon, 13 May 2024 19:09:30 +0200 Subject: [PATCH 5/7] Use `forM_` instead of `case` over `Maybe` Co-authored-by: Mateusz Galazyn <228866+carbolymer@users.noreply.github.com> --- .../Cardano/Testnet/Test/Gov/DRepActivity.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) 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 9ce1ff0be36..ece5c220884 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 @@ -190,9 +190,8 @@ activityChangeProposalTest execConfig epochStateView configurationFile socketPat H.note_ $ "Epoch after \"" <> prefix <> "\" prop: " <> show epochAfterProp void $ waitForEpochs epochStateView minWait - case mExpected of - Nothing -> return () - Just expected -> H.nothingFailM $ watchEpochStateView epochStateView (isDRepActivityUpdated expected) maxWait + forM_ mExpected $ \expected -> + H.nothingFailM $ watchEpochStateView epochStateView (isDRepActivityUpdated expected) maxWait return thisProposal From 7d018423dca48a655e67b1f9d33d46a9a6fae0aa Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Mon, 13 May 2024 19:25:46 +0200 Subject: [PATCH 6/7] Remove unnecessary parenthesis --- cardano-testnet/src/Testnet/EpochStateProcessing.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cardano-testnet/src/Testnet/EpochStateProcessing.hs b/cardano-testnet/src/Testnet/EpochStateProcessing.hs index 8004c4dd1aa..4068fd55bf0 100644 --- a/cardano-testnet/src/Testnet/EpochStateProcessing.hs +++ b/cardano-testnet/src/Testnet/EpochStateProcessing.hs @@ -89,13 +89,13 @@ watchEpochStateView -> m (Maybe a) watchEpochStateView epochStateView f (EpochInterval maxWait) = withFrozenCallStack $ do AnyNewEpochState _ newEpochState <- getEpochState epochStateView - let (EpochNo currentEpoch) = L.nesEL newEpochState + 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' + let EpochNo currentEpoch = L.nesEL newEpochState' condition <- f epochState case condition of Just result -> pure (Just result) From 88c6839e7bec22c216379f9fa3b80ab4df46d243 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Mon, 13 May 2024 19:57:00 +0200 Subject: [PATCH 7/7] Add comments to `activityChangeProposalTest`, `makeActivityChangeProposal`, and `voteChangeProposal` --- .../Cardano/Testnet/Test/Gov/DRepActivity.hs | 114 ++++++++++-------- 1 file changed, 66 insertions(+), 48 deletions(-) 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 ece5c220884..c7e407de6d4 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 @@ -22,6 +22,7 @@ import Prelude import Control.Monad import Control.Monad.Catch (MonadCatch) +import Data.Data (Typeable) import qualified Data.Map as Map import Data.String import qualified Data.Text as Text @@ -93,9 +94,15 @@ hprop_check_drep_activity = H.integrationWorkspace "test-activity" $ \tempAbsBas gov <- H.createDirectoryIfMissing $ work "governance" -- This proposal should pass - let minEpochsToWaitIfChanging = EpochInterval 0 -- The change already provides a min bound - minEpochsToWaitIfNotChanging = EpochInterval 2 -- We cannot wait for change since there is no change (we wait a bit) - maxEpochsToWaitAfterProposal = EpochInterval 2 -- If it takes more than 2 epochs we give up in any case + let minEpochsToWaitIfChanging = EpochInterval 0 -- We don't need a min wait since we are changing + -- the parameter, to a new value, if the parameter + -- becomes the new value we will know the proposal + -- passed. + minEpochsToWaitIfNotChanging = EpochInterval 2 -- We are not making a change to a parameter + -- so we are testing the absence of a change and + -- that means we have to wait some time to + -- make sure it doesn't change. + maxEpochsToWaitAfterProposal = EpochInterval 2 -- If it takes more than 2 epochs we give up in any case. firstTargetDRepActivity = EpochInterval 3 void $ activityChangeProposalTest execConfig epochStateView configurationFile socketPath ceo gov "firstProposal" wallet0 [(1, "yes")] firstTargetDRepActivity @@ -148,25 +155,32 @@ hprop_check_drep_activity = H.integrationWorkspace "test-activity" $ \tempAbsBas minEpochsToWaitIfChanging (Just lastTargetDRepActivity) maxEpochsToWaitAfterProposal +-- | This function creates a proposal to change the DRep activity interval +-- and issues the specified votes using default DReps. Optionally, it also +-- waits checks the expected effect of the proposal. activityChangeProposalTest - :: (HasCallStack, MonadTest m, MonadIO m, H.MonadAssertion m, MonadCatch m, Foldable t) - => H.ExecConfig - -> EpochStateView - -> NodeConfigFile In - -> SocketPath - -> ConwayEraOnwards ConwayEra - -> FilePath - -> FilePath - -> PaymentKeyInfo - -> t (Int, String) - -> EpochInterval - -> EpochInterval - -> Maybe EpochInterval - -> EpochInterval - -> m (String, Word32) + :: (HasCallStack, MonadTest m, MonadIO m, H.MonadAssertion m, MonadCatch m, Foldable t, Typeable era) + => H.ExecConfig -- ^ Specifies the CLI execution configuration. + -> EpochStateView -- ^ Current epoch state view for transaction building. It can be obtained + -- using the 'getEpochStateView' function. + -> NodeConfigFile In -- ^ Path to the node configuration file as returned by 'cardanoTestnetDefault'. + -> SocketPath -- ^ Path to the cardano-node unix socket file. + -> ConwayEraOnwards era -- ^ The ConwayEraOnwards witness for current era. + -> FilePath -- ^ Base directory path where generated files will be stored. + -> String -- ^ Name for the subfolder that will be created under 'work' folder. + -> PaymentKeyInfo -- ^ Wallet that will pay for the transactions. + -> t (Int, String) -- ^ Votes to be casted for the proposal. Each tuple contains the number + -- of votes of each type and the type of vote (i.e: "yes", "no", "abstain"). + -> EpochInterval -- ^ The target DRep activity interval to be set by the proposal. + -> EpochInterval -- ^ The minimum number of epochs to wait before checking the proposal result. + -> Maybe EpochInterval -- ^ The expected DRep activity interval after the proposal is applied, + -- or 'Nothing' if there are no expectations about whether the result of + -- the proposal. + -> EpochInterval -- ^ The maximum number of epochs to wait for the DRep activity interval to + -- become expected value. + -> m (String, Word32) -- ^ The transaction id and the index of the governance action. activityChangeProposalTest execConfig epochStateView configurationFile socketPath ceo work prefix wallet votes change minWait mExpected maxWait@(EpochInterval maxWaitNum) = do - let sbe = conwayEraOnwardsToShelleyBasedEra ceo mPreviousProposalInfo <- getLastPParamUpdateActionId execConfig @@ -190,8 +204,9 @@ activityChangeProposalTest execConfig epochStateView configurationFile socketPat H.note_ $ "Epoch after \"" <> prefix <> "\" prop: " <> show epochAfterProp void $ waitForEpochs epochStateView minWait - forM_ mExpected $ \expected -> - H.nothingFailM $ watchEpochStateView epochStateView (isDRepActivityUpdated expected) maxWait + case mExpected of + Nothing -> return () + Just expected -> H.nothingFailM $ watchEpochStateView epochStateView (isDRepActivityUpdated expected) maxWait return thisProposal @@ -207,20 +222,23 @@ activityChangeProposalTest execConfig epochStateView configurationFile socketPat ) sbe +-- | Create a proposal to change the DRep activity interval. +-- Return the transaction id and the index of the governance action. makeActivityChangeProposal - :: (HasCallStack, H.MonadAssertion m, MonadTest m, MonadCatch m, MonadIO m) - => H.ExecConfig - -> EpochStateView - -> NodeConfigFile 'In - -> SocketPath - -> ConwayEraOnwards ConwayEra - -> FilePath - -> String - -> Maybe (String, Word32) - -> EpochInterval - -> PaymentKeyInfo - -> Word64 - -> m (String, Word32) + :: (HasCallStack, H.MonadAssertion m, MonadTest m, MonadCatch m, MonadIO m, Typeable era) + => H.ExecConfig -- ^ Specifies the CLI execution configuration. + -> EpochStateView -- ^ Current epoch state view for transaction building. It can be obtained + -- using the 'getEpochStateView' function. + -> NodeConfigFile In -- ^ Path to the node configuration file as returned by 'cardanoTestnetDefault'. + -> SocketPath -- ^ Path to the cardano-node unix socket file. + -> ConwayEraOnwards era -- ^ The 'ConwayEraOnwards' witness for current era. + -> FilePath -- ^ Base directory path where generated files will be stored. + -> String -- ^ Name for the subfolder that will be created under 'work' folder. + -> Maybe (String, Word32) -- ^ The transaction id and the index of the previosu governance action if any. + -> EpochInterval -- ^ The target DRep activity interval to be set by the proposal. + -> PaymentKeyInfo -- ^ Wallet that will pay for the transaction. + -> Word64 -- ^ The latest epoch until which to wait for the proposal to be registered by the chain. + -> m (String, Word32) -- ^ The transaction id and the index of the governance action. makeActivityChangeProposal execConfig epochStateView configurationFile socketPath ceo work prefix prevGovActionInfo drepActivity wallet timeout = do @@ -298,21 +316,21 @@ makeActivityChangeProposal execConfig epochStateView configurationFile socketPat return (governanceActionTxId, governanceActionIndex) +-- | Cast votes for a governance action. voteChangeProposal - :: HasCallStack - => MonadTest m - => MonadIO m - => MonadCatch m - => H.MonadAssertion m - => H.ExecConfig - -> EpochStateView - -> ShelleyBasedEra ConwayEra - -> FilePath - -> FilePath - -> String - -> Word32 - -> [([Char], Int)] - -> PaymentKeyInfo + :: (HasCallStack, MonadTest m, MonadIO m, MonadCatch m, H.MonadAssertion m, Typeable era) + => H.ExecConfig -- ^ Specifies the CLI execution configuration.v + -> EpochStateView -- ^ Current epoch state view for transaction building. It can be obtained + -- using the 'getEpochStateView' function. + -> ShelleyBasedEra era -- ^ The 'ShelleyBasedEra' witness for current era. + -> FilePath -- ^ Base directory path where generated files will be stored. + -> String -- ^ Name for the subfolder that will be created under 'work' folder. + -> String -- ^ The transaction id of the governance action to vote. + -> Word32 -- ^ The index of the governance action to vote. + -> [([Char], Int)] -- ^ Votes to be casted for the proposal. Each tuple contains the index + -- of the default DRep that will make the vote and the type of the vote + -- (i.e: "yes", "no", "abstain"). + -> PaymentKeyInfo -- ^ Wallet that will pay for the transaction. -> m () voteChangeProposal execConfig epochStateView sbe work prefix governanceActionTxId governanceActionIndex votes wallet = do baseDir <- H.createDirectoryIfMissing $ work prefix