diff --git a/cardano-testnet/src/Testnet/EpochStateProcessing.hs b/cardano-testnet/src/Testnet/EpochStateProcessing.hs index b12a9f489ac..4068fd55bf0 100644 --- a/cardano-testnet/src/Testnet/EpochStateProcessing.hs +++ b/cardano-testnet/src/Testnet/EpochStateProcessing.hs @@ -1,14 +1,16 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} module Testnet.EpochStateProcessing ( maybeExtractGovernanceActionIndex , findCondition + , watchEpochStateView ) 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 @@ -23,7 +25,11 @@ 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 @@ -72,3 +78,31 @@ 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 06b62270089..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 @@ -11,11 +11,10 @@ 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) -import Cardano.Ledger.Shelley.API (NewEpochState (..)) import Cardano.Ledger.Shelley.LedgerState (epochStateGovStateL, nesEpochStateL) import Cardano.Testnet @@ -23,7 +22,7 @@ import Prelude import Control.Monad import Control.Monad.Catch (MonadCatch) -import Control.Monad.Trans.State.Strict (StateT) +import Data.Data (Typeable) import qualified Data.Map as Map import Data.String import qualified Data.Text as Text @@ -38,14 +37,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 Hedgehog (MonadTest, Property, annotateShow) import qualified Hedgehog.Extras as H -- | Execute me with: @@ -64,7 +66,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 } @@ -92,10 +94,16 @@ 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 = 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 - firstTargetDRepActivity = 3 + 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 minEpochsToWaitIfChanging (Just firstTargetDRepActivity) @@ -118,7 +126,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) @@ -131,7 +139,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])] @@ -141,31 +149,38 @@ 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) 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) - -> Word32 - -> Word64 - -> Maybe Word32 - -> Word64 - -> 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 = do - + wallet votes change minWait mExpected maxWait@(EpochInterval maxWaitNum) = do let sbe = conwayEraOnwardsToShelleyBasedEra ceo mPreviousProposalInfo <- getLastPParamUpdateActionId execConfig @@ -180,7 +195,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,60 +203,42 @@ activityChangeProposalTest execConfig epochStateView configurationFile socketPat (EpochNo epochAfterProp) <- getCurrentEpochNo epochStateView H.note_ $ "Epoch after \"" <> prefix <> "\" prop: " <> show epochAfterProp - waitAndCheck epochAfterProp + void $ waitForEpochs epochStateView minWait + case mExpected of + Nothing -> return () + Just expected -> H.nothingFailM $ watchEpochStateView epochStateView (isDRepActivityUpdated expected) maxWait 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) - - + isDRepActivityUpdated :: (HasCallStack, MonadTest m) + => 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 (if epochInterval == expected then Just () else Nothing) + ) + 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) - -> Word32 - -> 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 @@ -280,7 +277,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 @@ -319,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 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