diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index 31762be8e27..2d9ab117aa9 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -198,6 +198,8 @@ test-suite cardano-testnet-test Cardano.Testnet.Test.Gov.TreasuryGrowth Cardano.Testnet.Test.Gov.TreasuryWithdrawal Cardano.Testnet.Test.Misc + Cardano.Testnet.Test.Gov.DRepActivity + Cardano.Testnet.Test.Gov.PredefinedAbstainDRep Cardano.Testnet.Test.Node.Shutdown Cardano.Testnet.Test.SanityCheck Cardano.Testnet.Test.SubmitApi.Babbage.Transaction diff --git a/cardano-testnet/src/Cardano/Testnet.hs b/cardano-testnet/src/Cardano/Testnet.hs index 052943262ea..cfc727f607f 100644 --- a/cardano-testnet/src/Cardano/Testnet.hs +++ b/cardano-testnet/src/Cardano/Testnet.hs @@ -27,7 +27,6 @@ module Cardano.Testnet ( -- * EpochState processsing helper functions maybeExtractGovernanceActionIndex, - findCondition, -- * Processes procChairman, diff --git a/cardano-testnet/src/Testnet/Components/Query.hs b/cardano-testnet/src/Testnet/Components/Query.hs index 6ac751f0f4a..5787a62bd5e 100644 --- a/cardano-testnet/src/Testnet/Components/Query.hs +++ b/cardano-testnet/src/Testnet/Components/Query.hs @@ -1,7 +1,10 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} module Testnet.Components.Query @@ -20,14 +23,16 @@ module Testnet.Components.Query , findUtxosWithAddress , findLargestUtxoWithAddress , findLargestUtxoForPaymentKey + , assertNewEpochState + , watchEpochStateView ) where import Cardano.Api as Api -import Cardano.Api.Ledger (Credential, DRepState, KeyRole (DRepRole), StandardCrypto) +import Cardano.Api.Ledger (Credential, DRepState, EpochInterval (..), KeyRole (DRepRole), + StandardCrypto) import Cardano.Api.Shelley (ShelleyLedgerEra, fromShelleyTxIn, fromShelleyTxOut) import qualified Cardano.Ledger.Api as L -import Cardano.Ledger.BaseTypes (EpochInterval, addEpochInterval) import qualified Cardano.Ledger.Coin as L import qualified Cardano.Ledger.Conway.Governance as L import qualified Cardano.Ledger.Conway.PParams as L @@ -35,6 +40,7 @@ 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 (put) import Data.Bifunctor (bimap) @@ -50,7 +56,7 @@ import qualified Data.Text as T import Data.Type.Equality import GHC.Exts (IsList (..)) import GHC.Stack -import Lens.Micro (to, (^.)) +import Lens.Micro (Lens', to, (^.)) import Testnet.Property.Assert import Testnet.Property.Util (runInBackground) @@ -94,9 +100,9 @@ waitForEpochs => EpochStateView -> EpochInterval -- ^ Number of epochs to wait -> m EpochNo -- ^ The epoch number reached -waitForEpochs epochStateView@EpochStateView{nodeConfigPath, socketPath} interval = withFrozenCallStack $ do - currentEpoch <- getCurrentEpochNo epochStateView - waitUntilEpoch nodeConfigPath socketPath $ addEpochInterval currentEpoch interval +waitForEpochs epochStateView interval = withFrozenCallStack $ do + void $ watchEpochStateView epochStateView (const $ pure Nothing) interval + getCurrentEpochNo epochStateView -- | A read-only mutable pointer to an epoch state, updated automatically data EpochStateView = EpochStateView @@ -353,3 +359,70 @@ getCurrentEpochNo getCurrentEpochNo epochStateView = withFrozenCallStack $ do AnyNewEpochState _ newEpochState <- getEpochState epochStateView pure $ newEpochState ^. L.nesELL + +-- | 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. + (Show value, MonadAssertion m, MonadTest m, MonadIO m, Eq value, HasCallStack) + => EpochStateView -- ^ Current epoch state view. It can be obtained using the 'getEpochStateView' function. + -> 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 () +assertNewEpochState epochStateView ceo expected maxWait lens = withFrozenCallStack $ do + let sbe = conwayEraOnwardsToShelleyBasedEra ceo + 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 + checkEpochState :: HasCallStack + => ShelleyBasedEra era -> AnyNewEpochState -> m (Maybe ()) + checkEpochState sbe newEpochState = do + val <- getFromEpochState sbe newEpochState + return $ if val == expected then Just () else Nothing + + 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 10_000 + go (EpochNo timeout) diff --git a/cardano-testnet/src/Testnet/EpochStateProcessing.hs b/cardano-testnet/src/Testnet/EpochStateProcessing.hs index 4068fd55bf0..568c624207e 100644 --- a/cardano-testnet/src/Testnet/EpochStateProcessing.hs +++ b/cardano-testnet/src/Testnet/EpochStateProcessing.hs @@ -1,65 +1,40 @@ {-# LANGUAGE DataKinds #-} -{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} module Testnet.EpochStateProcessing ( maybeExtractGovernanceActionIndex - , findCondition - , watchEpochStateView + , waitForGovActionVotes ) where import Cardano.Api -import Cardano.Api.Ledger (EpochInterval (..), GovActionId (..)) +import Cardano.Api.Ledger (EpochInterval, GovActionId (..)) import qualified Cardano.Api.Ledger as L +import Cardano.Api.Shelley (ShelleyLedgerEra) import qualified Cardano.Ledger.Conway.Governance as L import qualified Cardano.Ledger.Shelley.API as L +import Cardano.Ledger.Shelley.LedgerState (newEpochStateGovStateL) import qualified Cardano.Ledger.Shelley.LedgerState as L import Prelude -import Control.Monad.State.Strict (MonadState (put), StateT) +import Data.Data ((:~:) (..)) import qualified Data.Map as Map import Data.Word (Word32) +import GHC.Exts (IsList (toList), toList) import GHC.Stack -import Lens.Micro ((^.)) +import Lens.Micro (to, (^.)) -import Testnet.Components.Query (EpochStateView, getEpochState) +import Testnet.Components.Query (EpochStateView, watchEpochStateView) +import Testnet.Property.Assert (assertErasEqual) -import Hedgehog +import Hedgehog (MonadTest) import Hedgehog.Extras (MonadAssertion) import qualified Hedgehog.Extras as H -findCondition - :: HasCallStack - => MonadTest m - => MonadIO m - => (AnyNewEpochState -> Maybe a) - -> NodeConfigFile In - -> SocketPath - -> EpochNo -- ^ The termination epoch: the condition must be found *before* this epoch - -> m (Either FoldBlocksError (Maybe a)) -findCondition epochStateFoldFunc configurationFile socketPath maxEpochNo = withFrozenCallStack $ evalIO . runExceptT $ do - result <- - foldEpochState - configurationFile - socketPath - FullValidation - maxEpochNo - Nothing - (\epochState _ _ -> go epochStateFoldFunc epochState) - pure $ case result of - (ConditionMet, Just x) -> Just x - _ -> Nothing - - where - go :: (AnyNewEpochState -> Maybe a) -> AnyNewEpochState -> StateT (Maybe a) IO LedgerStateCondition - go f epochState = do - case f epochState of - Just x -> put (Just x) >> pure ConditionMet - Nothing -> pure ConditionNotMet - maybeExtractGovernanceActionIndex :: HasCallStack => TxId -- ^ transaction id searched for @@ -78,31 +53,33 @@ 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) - +-- | Wait for the last gov action proposal in the list to have DRep or SPO votes. +waitForGovActionVotes + :: forall m era. + (MonadAssertion m, MonadTest m, MonadIO m, HasCallStack) + => EpochStateView -- ^ Current epoch state view. It can be obtained using the 'getEpochStateView' function. + -> ConwayEraOnwards era -- ^ The ConwayEraOnwards witness for current era. + -> EpochInterval -- ^ The maximum wait time in epochs. + -> m () +waitForGovActionVotes epochStateView ceo maxWait = withFrozenCallStack $ do + mResult <- watchEpochStateView epochStateView getFromEpochState maxWait + case mResult of + Just () -> pure () + Nothing -> H.failMessage callStack "waitForGovActionVotes: No votes appeared before timeout." + where + getFromEpochState :: HasCallStack + => AnyNewEpochState -> m (Maybe ()) + getFromEpochState (AnyNewEpochState actualEra newEpochState) = do + let sbe = conwayEraOnwardsToShelleyBasedEra ceo + Refl <- H.leftFail $ assertErasEqual sbe actualEra + let govState :: L.ConwayGovState (ShelleyLedgerEra era) = conwayEraOnwardsConstraints ceo $ newEpochState ^. newEpochStateGovStateL + proposals = govState ^. L.cgsProposalsL . L.pPropsL . to toList + if null proposals + then pure Nothing + else do + let lastProposal = last proposals + gaDRepVotes = lastProposal ^. L.gasDRepVotesL . to toList + gaSpoVotes = lastProposal ^. L.gasStakePoolVotesL . to toList + if null gaDRepVotes && null gaSpoVotes + then pure Nothing + else pure $ Just () diff --git a/cardano-testnet/src/Testnet/Process/Cli/DRep.hs b/cardano-testnet/src/Testnet/Process/Cli/DRep.hs index 4ffde9b535e..4406b8408cb 100644 --- a/cardano-testnet/src/Testnet/Process/Cli/DRep.hs +++ b/cardano-testnet/src/Testnet/Process/Cli/DRep.hs @@ -16,6 +16,7 @@ module Testnet.Process.Cli.DRep ) where import Cardano.Api hiding (Certificate, TxBody) +import Cardano.Api.Ledger (EpochInterval (EpochInterval)) import Prelude @@ -248,8 +249,7 @@ delegateToDRep => MonadCatch m => H.ExecConfig -- ^ Specifies the CLI execution configuration. -> EpochStateView -- ^ Current epoch state view for transaction building. It can be obtained - -> NodeConfigFile In -- ^ Path to the node configuration file as returned by 'cardanoTestnetDefault'. - -> SocketPath -- ^ Path to the cardano-node unix socket file. + -- using the 'getEpochStateView' function. -> ShelleyBasedEra ConwayEra -- ^ The Shelley-based era (e.g., 'ConwayEra') in which the transaction will be constructed. -> FilePath -- ^ Base directory path where generated files will be stored. -> String -- ^ Name for the subfolder that will be created under 'work' folder. @@ -257,7 +257,7 @@ delegateToDRep -> KeyPair StakingKey -- ^ Staking key pair used for delegation. -> KeyPair PaymentKey -- ^ Delegate Representative (DRep) key pair ('PaymentKeyPair') to which delegate. -> m () -delegateToDRep execConfig epochStateView configurationFile' socketPath sbe work prefix +delegateToDRep execConfig epochStateView sbe work prefix payingWallet skeyPair@KeyPair{verificationKey=File vKeyFile} KeyPair{verificationKey=File drepVKey} = do @@ -287,9 +287,8 @@ delegateToDRep execConfig epochStateView configurationFile' socketPath sbe work -- Submit transaction submitTx execConfig cEra repRegSignedRegTx1 - -- Wait two epochs - (EpochNo epochAfterProp) <- getCurrentEpochNo epochStateView - void $ waitUntilEpoch configurationFile' socketPath (EpochNo (epochAfterProp + 2)) + -- Wait one epoch + void $ waitForEpochs epochStateView (EpochInterval 1) -- | This function obtains the identifier for the last enacted parameter update proposal -- if any. diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/Plutus.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/Plutus.hs index 8a60974f369..f96de449fe3 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/Plutus.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/Plutus.hs @@ -11,7 +11,6 @@ module Cardano.Testnet.Test.Cli.Conway.Plutus ) where import Cardano.Api -import qualified Cardano.Api.Ledger as L import Cardano.Testnet @@ -142,11 +141,9 @@ hprop_plutus_v3 = integrationWorkspace "all-plutus-script-purposes" $ \tempAbsBa , "--tx-file", sendAdaToScriptAddressTx ] - _ <- waitForEpochs epochStateView (L.EpochInterval 1) - -- 2. Successfully spend conway spending script txinCollateral <- findLargestUtxoForPaymentKey epochStateView sbe wallet1 - plutusScriptTxIn <- fmap fst . H.nothingFailM $ + plutusScriptTxIn <- fmap fst . waitForJustM $ findLargestUtxoWithAddress epochStateView sbe $ Text.pack plutusSpendingScriptAddr let spendScriptUTxOTxBody = work "spend-script-utxo-tx-body" @@ -187,4 +184,11 @@ hprop_plutus_v3 = integrationWorkspace "all-plutus-script-purposes" $ \tempAbsBa ] H.success +waitForJustM :: (H.MonadTest m, MonadIO m) => m (Maybe a) -> m a +waitForJustM src = do m <- src + case m of + Just a -> pure a + Nothing -> do H.threadDelay 100_000 + waitForJustM src + diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs index adcbd61baa5..4900e710565 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs @@ -37,6 +37,7 @@ import Testnet.Components.Configuration import Testnet.Components.Query import Testnet.Components.TestWatchdog import Testnet.Defaults +import Testnet.EpochStateProcessing (waitForGovActionVotes) import qualified Testnet.Process.Cli.DRep as DRep import Testnet.Process.Cli.Keys import qualified Testnet.Process.Cli.SPO as SPO @@ -72,7 +73,7 @@ hprop_constitutional_committee_add_new = integrationWorkspace "constitutional-co cEra = AnyCardanoEra era eraName = eraToString era fastTestnetOptions = cardanoDefaultTestnetOptions - { cardanoEpochLength = 100 + { cardanoEpochLength = 200 , cardanoNodeEra = cEra , cardanoNumDReps = nDrepVotes } @@ -139,7 +140,6 @@ hprop_constitutional_committee_add_new = integrationWorkspace "constitutional-co EpochNo epochNo <- H.noteShowM $ getCurrentEpochNo epochStateView let ccExpiryEpoch = epochNo + 200 - deadlineEpoch = EpochNo $ epochNo + 10 _ <- execCli' execConfig $ [ eraName, "governance", "action" , "update-committee" @@ -176,14 +176,7 @@ hprop_constitutional_committee_add_new = integrationWorkspace "constitutional-co governanceActionTxId <- H.noteM $ retrieveTransactionId execConfig signedProposalTx - governanceActionIx <- - H.nothingFailM . - H.leftFailM $ - findCondition - (maybeExtractGovernanceActionIndex (fromString governanceActionTxId)) - configurationFile - socketPath - deadlineEpoch + governanceActionIx <- H.nothingFailM $ watchEpochStateView epochStateView (return . maybeExtractGovernanceActionIndex (fromString governanceActionTxId)) (L.EpochInterval 1) dRepVoteFiles <- DRep.generateVoteFiles @@ -213,7 +206,7 @@ hprop_constitutional_committee_add_new = integrationWorkspace "constitutional-co submitTx execConfig cEra voteTxFp - _ <- waitForEpochs epochStateView (L.EpochInterval 1) + waitForGovActionVotes epochStateView ceo (L.EpochInterval 1) govState <- getGovState epochStateView ceo govActionState <- H.headM $ govState ^. L.cgsProposalsL . L.pPropsL . to toList @@ -227,8 +220,7 @@ hprop_constitutional_committee_add_new = integrationWorkspace "constitutional-co length (filter ((== L.VoteYes) . snd) gaSpoVotes) === 1 length spoVotes === length gaSpoVotes - H.nothingFailM . H.leftFailM $ - findCondition committeeIsPresent configurationFile socketPath deadlineEpoch + H.nothingFailM $ watchEpochStateView epochStateView (return . committeeIsPresent) (L.EpochInterval 1) -- show proposed committe meembers H.noteShow_ ccCredentials 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 63181e1a470..07c9d552b45 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 @@ -1,5 +1,5 @@ -{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -10,11 +10,11 @@ module Cardano.Testnet.Test.Gov.DRepActivity ) where import Cardano.Api as Api -import Cardano.Api.Error (displayError) +import Cardano.Api.Eon.ShelleyBasedEra (ShelleyLedgerEra) import Cardano.Api.Ledger (EpochInterval (EpochInterval, unEpochInterval), drepExpiry) -import Cardano.Ledger.Conway.Core (curPParamsGovStateL) -import Cardano.Ledger.Conway.PParams (ppDRepActivityL) +import Cardano.Ledger.Conway.Core (EraGov, curPParamsGovStateL) +import Cardano.Ledger.Conway.PParams (ConwayEraPParams, ppDRepActivityL) import Cardano.Ledger.Shelley.LedgerState (epochStateGovStateL, nesEpochStateL) import Cardano.Testnet @@ -26,15 +26,15 @@ import Data.Data (Typeable) import qualified Data.Map as Map import Data.String import qualified Data.Text as Text -import Data.Word (Word32, Word64) -import GHC.Stack -import Lens.Micro ((^.)) +import Data.Word (Word32) +import GHC.Stack (HasCallStack, withFrozenCallStack) import System.FilePath (()) -import Testnet.Components.Query -import Testnet.Components.TestWatchdog (runWithDefaultWatchdog_) +import Testnet.Components.Query (EpochStateView, assertNewEpochState, checkDRepState, + findLargestUtxoForPaymentKey, getCurrentEpochNo, getEpochStateView, + getMinDRepDeposit, watchEpochStateView) +import Testnet.Components.TestWatchdog (kickWatchdog, runWithDefaultWatchdog) import Testnet.Defaults (defaultDRepKeyPair, defaultDelegatorStakeKeyPair) -import Testnet.EpochStateProcessing (watchEpochStateView) import Testnet.Process.Cli.DRep import Testnet.Process.Cli.Keys import Testnet.Process.Cli.Transaction @@ -48,7 +48,8 @@ import qualified Hedgehog.Extras as H -- | Execute me with: -- @DISABLE_RETRIES=1 cabal test cardano-testnet-test --test-options '-p "/DRep Activity/"'@ hprop_check_drep_activity :: Property -hprop_check_drep_activity = integrationWorkspace "test-activity" $ \tempAbsBasePath' -> runWithDefaultWatchdog_ $ do +hprop_check_drep_activity = integrationWorkspace "test-activity" $ \tempAbsBasePath' -> + runWithDefaultWatchdog $ \watchdog -> do -- Start a local test net conf@Conf { tempAbsPath } <- mkConf tempAbsBasePath' let tempAbsPath' = unTmpAbsPath tempAbsPath @@ -56,6 +57,7 @@ hprop_check_drep_activity = integrationWorkspace "test-activity" $ \tempAbsBaseP work <- H.createDirectoryIfMissing $ tempAbsPath' "work" + -- Create default testnet with 3 DReps and 3 stake holders delegated, one to each DRep. let ceo = ConwayEraOnwardsConway sbe = conwayEraOnwardsToShelleyBasedEra ceo era = toCardanoEra sbe @@ -99,18 +101,18 @@ hprop_check_drep_activity = integrationWorkspace "test-activity" $ \tempAbsBaseP -- 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 + void $ activityChangeProposalTest execConfig epochStateView ceo gov "firstProposal" wallet0 [(1, "yes")] firstTargetDRepActivity minEpochsToWaitIfChanging (Just firstTargetDRepActivity) maxEpochsToWaitAfterProposal -- Now we register two new DReps drep2 <- registerDRep execConfig epochStateView ceo work "drep2" wallet1 - delegateToDRep execConfig epochStateView configurationFile socketPath sbe work "drep2-delegation" + delegateToDRep execConfig epochStateView sbe work "drep2-delegation" wallet2 (defaultDelegatorStakeKeyPair 2) drep2 drep3 <- registerDRep execConfig epochStateView ceo work "drep3" wallet0 - delegateToDRep execConfig epochStateView configurationFile socketPath sbe work "drep3-delegation" + delegateToDRep execConfig epochStateView sbe work "drep3-delegation" wallet1 (defaultDelegatorStakeKeyPair 3) drep3 expirationDates <- checkDRepState epochStateView sbe $ \m -> @@ -122,17 +124,19 @@ hprop_check_drep_activity = integrationWorkspace "test-activity" $ \tempAbsBaseP -- 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 = EpochInterval (unEpochInterval firstTargetDRepActivity + 1) - void $ activityChangeProposalTest execConfig epochStateView configurationFile socketPath ceo gov + void $ activityChangeProposalTest execConfig epochStateView ceo gov "failingProposal" wallet2 [(1, "yes")] secondTargetDRepActivity minEpochsToWaitIfNotChanging (Just firstTargetDRepActivity) maxEpochsToWaitAfterProposal + kickWatchdog watchdog + -- We now send a bunch of proposals to make sure that the 2 new DReps expire. -- because DReps won't expire if there is not enough activity (opportunites to participate). -- This is accounted for by the dormant epoch count let numOfFillerProposals = 4 :: Int sequence_ - [activityChangeProposalTest execConfig epochStateView configurationFile socketPath ceo gov + [activityChangeProposalTest execConfig epochStateView ceo gov ("fillerProposalNum" ++ show proposalNum) wallet [(1, "yes")] (EpochInterval (unEpochInterval secondTargetDRepActivity + fromIntegral proposalNum)) minEpochsToWaitIfNotChanging Nothing @@ -145,7 +149,7 @@ hprop_check_drep_activity = integrationWorkspace "test-activity" $ \tempAbsBaseP -- 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 = EpochInterval (unEpochInterval secondTargetDRepActivity + fromIntegral numOfFillerProposals + 1) - void $ activityChangeProposalTest execConfig epochStateView configurationFile socketPath ceo gov + void $ activityChangeProposalTest execConfig epochStateView ceo gov "lastProposal" wallet0 [(1, "yes")] lastTargetDRepActivity minEpochsToWaitIfChanging (Just lastTargetDRepActivity) maxEpochsToWaitAfterProposal @@ -154,12 +158,11 @@ hprop_check_drep_activity = integrationWorkspace "test-activity" $ \tempAbsBaseP -- 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, Typeable era) + :: forall m t era . (HasCallStack, MonadTest m, MonadIO m, H.MonadAssertion m, MonadCatch m, Foldable t, Typeable era, + EraGov (ShelleyLedgerEra era), ConwayEraPParams (ShelleyLedgerEra 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. @@ -174,8 +177,8 @@ activityChangeProposalTest -> 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 +activityChangeProposalTest execConfig epochStateView ceo work prefix + wallet votes change minWait mExpected maxWait = do let sbe = conwayEraOnwardsToShelleyBasedEra ceo mPreviousProposalInfo <- getLastPParamUpdateActionId execConfig @@ -189,8 +192,8 @@ activityChangeProposalTest execConfig epochStateView configurationFile socketPat H.note_ $ "Epoch before \"" <> prefix <> "\" prop: " <> show epochBeforeProp thisProposal@(governanceActionTxId, governanceActionIndex) <- - makeActivityChangeProposal execConfig epochStateView configurationFile socketPath - ceo baseDir "proposal" mPreviousProposalInfo change wallet (epochBeforeProp + fromIntegral maxWaitNum) + makeActivityChangeProposal execConfig epochStateView ceo baseDir "proposal" + mPreviousProposalInfo change wallet maxWait voteChangeProposal execConfig epochStateView sbe baseDir "vote" governanceActionTxId governanceActionIndex propVotes wallet @@ -199,42 +202,29 @@ 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 -> assertNewEpochState epochStateView ceo expected maxWait + (nesEpochStateL . epochStateGovStateL . curPParamsGovStateL . ppDRepActivityL) return thisProposal - where - 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, 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. + -> EpochInterval -- ^ Number of epochs 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 +makeActivityChangeProposal execConfig epochStateView ceo work prefix + prevGovActionInfo drepActivity wallet timeout = do let sbe = conwayEraOnwardsToShelleyBasedEra ceo era = toCardanoEra sbe @@ -295,18 +285,7 @@ makeActivityChangeProposal execConfig epochStateView configurationFile socketPat governanceActionTxId <- retrieveTransactionId execConfig signedProposalTx - !propSubmittedResult <- findCondition (maybeExtractGovernanceActionIndex (fromString governanceActionTxId)) - configurationFile - socketPath - (EpochNo timeout) - - governanceActionIndex <- case propSubmittedResult of - Left e -> - H.failMessage callStack - $ "makeActivityChangeProposal failed waiting for gov action with: " <> displayError e - Right Nothing -> - H.failMessage callStack "Couldn't find proposal." - Right (Just a) -> return a + governanceActionIndex <- H.nothingFailM $ watchEpochStateView epochStateView (return . maybeExtractGovernanceActionIndex (fromString governanceActionTxId)) timeout return (governanceActionTxId, governanceActionIndex) diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/InfoAction.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/InfoAction.hs index eb2178c0fdd..4799aef74a9 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/InfoAction.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/InfoAction.hs @@ -13,6 +13,7 @@ module Cardano.Testnet.Test.Gov.InfoAction import Cardano.Api as Api import Cardano.Api.Error (displayError) +import Cardano.Api.Ledger (EpochInterval (EpochInterval)) import Cardano.Api.Shelley import Cardano.Ledger.Conway.Governance (RatifyState (..)) @@ -58,7 +59,7 @@ hprop_ledger_events_info_action = integrationRetryWorkspace 0 "info-hash" $ \tem era = toCardanoEra sbe sbe = conwayEraOnwardsToShelleyBasedEra ceo fastTestnetOptions = cardanoDefaultTestnetOptions - { cardanoEpochLength = 100 + { cardanoEpochLength = 200 , cardanoNodeEra = AnyCardanoEra era } @@ -144,18 +145,7 @@ hprop_ledger_events_info_action = integrationRetryWorkspace 0 "info-hash" $ \tem , "--tx-file", txbodySignedFp ] - !propSubmittedResult <- findCondition (maybeExtractGovernanceActionIndex (fromString txidString)) - configurationFile - socketPath - (EpochNo 10) - - governanceActionIndex <- case propSubmittedResult of - Left e -> - H.failMessage callStack - $ "findCondition failed with: " <> displayError e - Right Nothing -> - H.failMessage callStack "Couldn't find proposal." - Right (Just a) -> return a + governanceActionIndex <- H.nothingFailM $ watchEpochStateView epochStateView (return . maybeExtractGovernanceActionIndex (fromString txidString)) (EpochInterval 1) let voteFp :: Int -> FilePath voteFp n = work gov "vote-" <> show n diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/NoConfidence.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/NoConfidence.hs index b1c268283f0..93996d8c082 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/NoConfidence.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/NoConfidence.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE BangPatterns #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} @@ -10,7 +9,6 @@ module Cardano.Testnet.Test.Gov.NoConfidence ) where import Cardano.Api as Api -import Cardano.Api.Error import Cardano.Api.Ledger import Cardano.Api.Shelley @@ -29,7 +27,6 @@ import qualified Data.Map.Strict as Map import Data.Maybe.Strict import Data.String import qualified Data.Text as Text -import GHC.Stack import Lens.Micro import System.FilePath (()) @@ -132,9 +129,10 @@ hprop_gov_no_confidence = integrationWorkspace "no-confidence" $ \tempAbsBasePat H.note_ $ "Abs path: " <> tempAbsBasePath' H.note_ $ "Socketpath: " <> socketPath - mCommitteePresent - <- H.leftFailM $ findCondition (committeeIsPresent True) configurationFile (File socketPath) (EpochNo 3) - H.nothingFail mCommitteePresent + epochStateView <- getEpochStateView configurationFile (File socketPath) + + H.nothingFailM $ watchEpochStateView epochStateView (return . committeeIsPresent True) (EpochInterval 3) + -- Step 2. Propose motion of no confidence. DRep and SPO voting thresholds must be met. @@ -156,10 +154,9 @@ hprop_gov_no_confidence = integrationWorkspace "no-confidence" $ \tempAbsBasePat cliStakeAddressKeyGen $ KeyPair (File stakeVkeyFp) (File stakeSKeyFp) - epochStateView <- getEpochStateView configurationFile (File socketPath) minActDeposit <- getMinGovActionDeposit epochStateView ceo - void $ H.execCli' execConfig $ + void $ H.execCli' execConfig [ eraToString era, "governance", "action", "create-no-confidence" , "--testnet" , "--governance-action-deposit", show @Integer minActDeposit @@ -193,18 +190,7 @@ hprop_gov_no_confidence = integrationWorkspace "no-confidence" $ \tempAbsBasePat governanceActionTxId <- retrieveTransactionId execConfig signedProposalTx - !propSubmittedResult <- findCondition (maybeExtractGovernanceActionIndex (fromString governanceActionTxId)) - configurationFile - (File socketPath) - (EpochNo 10) - - governanceActionIndex <- case propSubmittedResult of - Left e -> - H.failMessage callStack - $ "findCondition failed with: " <> displayError e - Right Nothing -> - H.failMessage callStack "Couldn't find proposal." - Right (Just a) -> return a + governanceActionIndex <- H.nothingFailM $ watchEpochStateView epochStateView (return . maybeExtractGovernanceActionIndex (fromString governanceActionTxId)) (EpochInterval 10) let spoVotes :: [(String, Int)] spoVotes = [("yes", 1), ("yes", 2), ("yes", 3)] @@ -236,9 +222,7 @@ hprop_gov_no_confidence = integrationWorkspace "no-confidence" $ \tempAbsBasePat -- Step 4. We confirm the no confidence motion has been ratified by checking -- for an empty constitutional committee. - mCommitteeEmpty - <- H.leftFailM $ findCondition (committeeIsPresent False) configurationFile (File socketPath) (EpochNo 5) - H.nothingFail mCommitteeEmpty + H.nothingFailM $ watchEpochStateView epochStateView (return . committeeIsPresent False) (EpochInterval 10) -- | Checks if the committee is empty or not. committeeIsPresent :: Bool -> AnyNewEpochState -> Maybe () 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 new file mode 100644 index 00000000000..9f65bde583b --- /dev/null +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PredefinedAbstainDRep.hs @@ -0,0 +1,348 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module Cardano.Testnet.Test.Gov.PredefinedAbstainDRep + ( hprop_check_predefined_abstain_drep + ) where + +import Cardano.Api as Api +import Cardano.Api.Eon.ShelleyBasedEra (ShelleyLedgerEra) +import Cardano.Api.Ledger (EpochInterval (EpochInterval)) + +import Cardano.Ledger.Conway.Core (ppNOptL) +import Cardano.Ledger.Conway.Governance (ConwayGovState, cgsCurPParamsL) +import Cardano.Ledger.Core (EraPParams) +import Cardano.Ledger.Shelley.LedgerState (epochStateGovStateL, nesEpochStateL) +import Cardano.Testnet + +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) +import Lens.Micro ((^.)) +import System.FilePath (()) + +import Testnet.Components.Configuration (anyEraToString) +import Testnet.Components.Query (EpochStateView, assertNewEpochState, + findLargestUtxoForPaymentKey, getCurrentEpochNo, getEpochStateView, getGovState, + getMinDRepDeposit, watchEpochStateView) +import Testnet.Components.TestWatchdog (runWithDefaultWatchdog_) +import Testnet.Defaults (defaultDRepKeyPair, defaultDelegatorStakeKeyPair) +import Testnet.Process.Cli.DRep (createCertificatePublicationTxBody, createVotingTxBody, + generateVoteFiles) +import qualified Testnet.Process.Cli.Keys as P +import Testnet.Process.Cli.Transaction (retrieveTransactionId, signTx, submitTx) +import qualified Testnet.Process.Run as H +import qualified Testnet.Property.Util as H +import Testnet.Types (KeyPair (..), + PaymentKeyInfo (paymentKeyInfoAddr, paymentKeyInfoPair), PoolNode (..), + SomeKeyPair (SomeKeyPair), StakingKey, TestnetRuntime (..), nodeSocketPath) + +import Hedgehog +import qualified Hedgehog.Extras as H + +-- | 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 +-- parameter change (in this case to the @desiredNumberOfPools@ parameter) to check +-- that it fails, when the first DRep votes "yes" and the last two vote "no". Later +-- we chack that if we change the stake holders under the DReps that vote "no" to +-- delegate to the automate "always abstain" DRep, the same kind of proposal passes. +-- If the proposal passes, it means that the stake was counted as abstaining, +-- because the threshold of minimum participation is 50%, if the stake was not counted as +-- abstaining, the "yes" votes would not have been enough, since they only account +-- for the 33% of the total active stake. +-- +-- This test is meant to ensure that delegating to "always abstain" has the desired +-- effect of counting as abstaining for the stake delegated. +-- +-- Execute me with: +-- @DISABLE_RETRIES=1 cabal test cardano-testnet-test --test-options '-p "/Predefined Abstain DRep/"'@ +hprop_check_predefined_abstain_drep :: Property +hprop_check_predefined_abstain_drep = H.integrationWorkspace "test-activity" $ \tempAbsBasePath' -> runWithDefaultWatchdog_ $ do + -- Start a local test net + conf@Conf { tempAbsPath } <- mkConf tempAbsBasePath' + let tempAbsPath' = unTmpAbsPath tempAbsPath + tempBaseAbsPath = makeTmpBaseAbsPath tempAbsPath + work <- H.createDirectoryIfMissing $ tempAbsPath' "work" + + -- Create default testnet with 3 DReps and 3 stake holders delegated, one to each DRep. + let ceo = ConwayEraOnwardsConway + sbe = conwayEraOnwardsToShelleyBasedEra ceo + era = toCardanoEra sbe + cEra = AnyCardanoEra era + fastTestnetOptions = cardanoDefaultTestnetOptions + { cardanoEpochLength = 200 + , cardanoNodeEra = cEra + , cardanoNumDReps = 3 + } + + TestnetRuntime + { testnetMagic + , poolNodes + , wallets=wallet0:wallet1:wallet2:_ + , configurationFile + } + <- cardanoTestnetDefault fastTestnetOptions conf + + PoolNode{poolRuntime} <- H.headM poolNodes + poolSprocket1 <- H.noteShow $ nodeSprocket poolRuntime + execConfig <- H.mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic + let socketPath = nodeSocketPath poolRuntime + + epochStateView <- getEpochStateView configurationFile socketPath + + H.note_ $ "Sprocket: " <> show poolSprocket1 + H.note_ $ "Abs path: " <> tempAbsBasePath' + H.note_ $ "Socketpath: " <> unFile socketPath + H.note_ $ "Foldblocks config file: " <> unFile configurationFile + + gov <- H.createDirectoryIfMissing $ work "governance" + + initialDesiredNumberOfPools <- getDesiredPoolNumberValue epochStateView ceo + + let newNumberOfDesiredPools = initialDesiredNumberOfPools + 1 + + -- Do some proposal and vote yes with the first DRep only + -- and assert that proposal does NOT pass. + void $ desiredPoolNumberProposalTest execConfig epochStateView ceo gov "firstProposal" + wallet0 Nothing [(1, "yes")] newNumberOfDesiredPools 3 (Just initialDesiredNumberOfPools) 10 + + -- Take the last two stake delegators and delegate them to "Abstain". + delegateToAlwaysAbstain execConfig epochStateView sbe gov "delegateToAbstain1" + wallet1 (defaultDelegatorStakeKeyPair 2) + delegateToAlwaysAbstain execConfig epochStateView sbe gov "delegateToAbstain2" + wallet2 (defaultDelegatorStakeKeyPair 3) + + -- Do some other proposal and vote yes with first DRep only + -- and assert the new proposal passes now. + let newNumberOfDesiredPools2 = newNumberOfDesiredPools + 1 + void $ desiredPoolNumberProposalTest execConfig epochStateView ceo gov "secondProposal" + wallet0 Nothing [(1, "yes")] newNumberOfDesiredPools2 0 (Just newNumberOfDesiredPools2) 10 + +delegateToAlwaysAbstain + :: (HasCallStack, MonadTest m, MonadIO m, H.MonadAssertion m, MonadCatch 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. + -> ShelleyBasedEra era -- ^ The Shelley-based era (e.g., 'ConwayEra') in which the transaction will be constructed. + -> 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 transaction. + -> KeyPair StakingKey -- ^ Staking key pair used for delegation. + -> m () +delegateToAlwaysAbstain execConfig epochStateView sbe work prefix + payingWallet skeyPair@(KeyPair vKeyFile _sKeyFile) = do + + let era = toCardanoEra sbe + cEra = AnyCardanoEra era + + baseDir <- H.createDirectoryIfMissing $ work prefix + + -- Create vote delegation certificate + let voteDelegationCertificatePath = baseDir "delegation-certificate.delegcert" + void $ H.execCli' execConfig + [ anyEraToString cEra, "stake-address", "vote-delegation-certificate" + , "--always-abstain" + , "--stake-verification-key-file", unFile vKeyFile + , "--out-file", voteDelegationCertificatePath + ] + + -- Compose transaction to publish delegation certificate + repRegTxBody1 <- createCertificatePublicationTxBody execConfig epochStateView sbe baseDir "del-cert-txbody" + (File voteDelegationCertificatePath) payingWallet + + -- Sign transaction + repRegSignedRegTx1 <- signTx execConfig cEra baseDir "signed-reg-tx" + repRegTxBody1 [ SomeKeyPair (paymentKeyInfoPair payingWallet) + , SomeKeyPair skeyPair] + + -- Submit transaction + submitTx execConfig cEra repRegSignedRegTx1 + + -- Wait two epochs + void $ waitForEpochs epochStateView (EpochInterval 1) + +desiredPoolNumberProposalTest + :: (HasCallStack, MonadTest m, MonadIO m, H.MonadAssertion m, MonadCatch m, Foldable t) + => H.ExecConfig -- ^ Specifies the CLI execution configuration. + -> EpochStateView -- ^ Current epoch state view for transaction building. It can be obtained + -> ConwayEraOnwards ConwayEra -- ^ The ConwaysEraOnwards witness for the Conway 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 transaction. + -> Maybe (String, Word32) -- ^ The transaction identifier and index of the previous passed + -- governance action if any. + -> t (Int, String) -- ^ Model of votes to issue as a list of pairs of amount of each vote + -- together with the vote (i.e: "yes", "no", "abstain") + -> Integer -- ^ What to change the @desiredPoolNumber@ to + -> Integer -- ^ Minimum number of epochs to wait before checking the result + -> Maybe Integer -- ^ What the expected result is of the change (if anything) + -> Integer -- ^ Maximum number of epochs to wait while waiting for the result + -> m (String, Word32) +desiredPoolNumberProposalTest execConfig epochStateView ceo work prefix wallet + previousProposalInfo votes change minWait mExpected maxWait = do + let sbe = conwayEraOnwardsToShelleyBasedEra ceo + + baseDir <- H.createDirectoryIfMissing $ work prefix + + let propVotes :: [DefaultDRepVote] + propVotes = zip (concatMap (uncurry replicate) votes) [1..] + annotateShow propVotes + + thisProposal@(governanceActionTxId, governanceActionIndex) <- + makeDesiredPoolNumberChangeProposal execConfig epochStateView ceo baseDir "proposal" + previousProposalInfo (fromIntegral change) wallet + + voteChangeProposal execConfig epochStateView sbe baseDir "vote" + governanceActionTxId governanceActionIndex propVotes wallet + + (EpochNo epochAfterProp) <- getCurrentEpochNo epochStateView + H.note_ $ "Epoch after \"" <> prefix <> "\" prop: " <> show epochAfterProp + + 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 + +makeDesiredPoolNumberChangeProposal + :: (HasCallStack, H.MonadAssertion m, MonadTest m, MonadCatch m, MonadIO m) + => H.ExecConfig -- ^ Specifies the CLI execution configuration. + -> EpochStateView -- ^ Current epoch state view for transaction building. It can be obtained + -> ConwayEraOnwards ConwayEra -- ^ The conway era onwards witness for the era in which the transaction will be constructed. + -> 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 identifier and index of the previous passed + -- governance action if any. + -> Word32 -- ^ What to change the @desiredPoolNumber@ to + -> PaymentKeyInfo -- ^ Wallet that will pay for the transaction. + -> m (String, Word32) +makeDesiredPoolNumberChangeProposal execConfig epochStateView ceo work prefix + prevGovActionInfo desiredPoolNumber wallet = do + + let sbe = conwayEraOnwardsToShelleyBasedEra ceo + era = toCardanoEra sbe + cEra = AnyCardanoEra era + + baseDir <- H.createDirectoryIfMissing $ work prefix + + let stakeVkeyFp = baseDir "stake.vkey" + stakeSKeyFp = baseDir "stake.skey" + + P.cliStakeAddressKeyGen + $ KeyPair { verificationKey = File stakeVkeyFp + , signingKey = File stakeSKeyFp + } + + proposalAnchorFile <- H.note $ baseDir "sample-proposal-anchor" + H.writeFile proposalAnchorFile "dummy anchor data" + + proposalAnchorDataHash <- H.execCli' execConfig + [ "conway", "governance" + , "hash", "anchor-data", "--file-text", proposalAnchorFile + ] + + minDRepDeposit <- getMinDRepDeposit epochStateView ceo + + proposalFile <- H.note $ baseDir "sample-proposal-file" + + void $ H.execCli' execConfig $ + [ "conway", "governance", "action", "create-protocol-parameters-update" + , "--testnet" + , "--governance-action-deposit", show @Integer minDRepDeposit + , "--deposit-return-stake-verification-key-file", stakeVkeyFp + ] ++ concatMap (\(prevGovernanceActionTxId, prevGovernanceActionIndex) -> + [ "--prev-governance-action-tx-id", prevGovernanceActionTxId + , "--prev-governance-action-index", show prevGovernanceActionIndex + ]) prevGovActionInfo ++ + [ "--number-of-pools", show desiredPoolNumber + , "--anchor-url", "https://tinyurl.com/3wrwb2as" + , "--anchor-data-hash", proposalAnchorDataHash + , "--out-file", proposalFile + ] + + proposalBody <- H.note $ baseDir "tx.body" + txIn <- findLargestUtxoForPaymentKey epochStateView sbe wallet + + void $ H.execCli' execConfig + [ "conway", "transaction", "build" + , "--change-address", Text.unpack $ paymentKeyInfoAddr wallet + , "--tx-in", Text.unpack $ renderTxIn txIn + , "--proposal-file", proposalFile + , "--out-file", proposalBody + ] + + signedProposalTx <- signTx execConfig cEra baseDir "signed-proposal" + (File proposalBody) [SomeKeyPair $ paymentKeyInfoPair wallet] + + submitTx execConfig cEra signedProposalTx + + governanceActionTxId <- retrieveTransactionId execConfig signedProposalTx + + governanceActionIndex <- H.nothingFailM $ watchEpochStateView epochStateView (return . maybeExtractGovernanceActionIndex (fromString governanceActionTxId)) (EpochInterval 1) + + return (governanceActionTxId, governanceActionIndex) + +-- A pair of a vote string (i.e: "yes", "no", or "abstain") and the number of +-- a default DRep (from the ones created by 'cardanoTestnetDefault') +type DefaultDRepVote = (String, Int) + +-- | Create and issue votes for (or against) a government proposal with default +-- Delegate Representative (DReps created by 'cardanoTestnetDefault') using @cardano-cli@. +voteChangeProposal :: (MonadTest m, MonadIO m, MonadCatch m, H.MonadAssertion m) + => H.ExecConfig -- ^ Specifies the CLI execution configuration. + -> EpochStateView -- ^ Current epoch state view for transaction building. It can be obtained + -- using the 'getEpochStateView' function. + -> ShelleyBasedEra ConwayEra -- ^ The Shelley-based witness for ConwayEra (i.e: ShelleyBasedEraConway). + -> FilePath -- ^ Base directory path where the subdirectory with the intermediate files will be created. + -> String -- ^ Name for the subdirectory that will be created for storing the intermediate files. + -> String -- ^ Transaction id of the governance action to vote. + -> Word32 -- ^ Index of the governance action to vote in the transaction. + -> [DefaultDRepVote] -- ^ List of votes to issue as pairs of the vote and the number of DRep that votes it. + -> PaymentKeyInfo -- ^ Wallet that will pay for the transactions + -> m () +voteChangeProposal execConfig epochStateView sbe work prefix + governanceActionTxId governanceActionIndex votes wallet = do + baseDir <- H.createDirectoryIfMissing $ work prefix + + let era = toCardanoEra sbe + cEra = AnyCardanoEra era + + voteFiles <- generateVoteFiles execConfig baseDir "vote-files" + governanceActionTxId governanceActionIndex + [(defaultDRepKeyPair idx, vote) | (vote, idx) <- votes] + + voteTxBodyFp <- createVotingTxBody execConfig epochStateView sbe baseDir "vote-tx-body" + voteFiles wallet + + voteTxFp <- signTx execConfig cEra baseDir "signed-vote-tx" voteTxBodyFp + (SomeKeyPair (paymentKeyInfoPair wallet):[SomeKeyPair $ defaultDRepKeyPair n | (_, n) <- votes]) + submitTx execConfig cEra voteTxFp + +-- | Obtains the @desiredPoolNumberValue@ from the protocol parameters. +-- The @desiredPoolNumberValue@ or (@k@ in the spec) is the protocol parameter +-- that defines what is the optimal number of SPOs. It is a tradeoff between +-- decentralization and efficiency and the spec suggest it should be between 100 an 1000. +-- Changing this parameter will indirectly affect how easy it is to saturate a pool in order to +-- incentivize that the number of SPOs stays close to the parameter value. +getDesiredPoolNumberValue :: (EraPParams (ShelleyLedgerEra era), H.MonadAssertion m, MonadTest m, MonadIO m) + => EpochStateView + -> ConwayEraOnwards era + -> m Integer +getDesiredPoolNumberValue epochStateView ceo = do + govState :: ConwayGovState era <- getGovState epochStateView ceo + return $ toInteger $ govState ^. cgsCurPParamsL + . ppNOptL diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitution.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitution.hs index a3bb6650a54..bd6bd73624c 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitution.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitution.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE BangPatterns #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} @@ -10,7 +9,6 @@ module Cardano.Testnet.Test.Gov.ProposeNewConstitution ) where import Cardano.Api as Api -import Cardano.Api.Error (displayError) import Cardano.Api.Ledger (EpochInterval (..)) import qualified Cardano.Crypto.Hash as L @@ -29,7 +27,6 @@ import Data.Maybe.Strict import Data.String import qualified Data.Text as Text import GHC.Exts (IsList (..)) -import GHC.Stack (callStack) import Lens.Micro import System.FilePath (()) @@ -37,6 +34,7 @@ import Testnet.Components.Configuration import Testnet.Components.Query import Testnet.Components.TestWatchdog import Testnet.Defaults +import Testnet.EpochStateProcessing (waitForGovActionVotes) import Testnet.Process.Cli.DRep import Testnet.Process.Cli.Keys import Testnet.Process.Cli.Transaction @@ -72,7 +70,7 @@ hprop_ledger_events_propose_new_constitution = integrationWorkspace "propose-new era = toCardanoEra sbe cEra = AnyCardanoEra era fastTestnetOptions = cardanoDefaultTestnetOptions - { cardanoEpochLength = 100 + { cardanoEpochLength = 200 , cardanoNodeEra = cEra , cardanoNumDReps = numVotes } @@ -169,18 +167,7 @@ hprop_ledger_events_propose_new_constitution = integrationWorkspace "propose-new governanceActionTxId <- retrieveTransactionId execConfig signedProposalTx - !propSubmittedResult <- findCondition (maybeExtractGovernanceActionIndex (fromString governanceActionTxId)) - configurationFile - socketPath - (EpochNo 10) - - governanceActionIndex <- case propSubmittedResult of - Left e -> - H.failMessage callStack - $ "findCondition failed with: " <> displayError e - Right Nothing -> - H.failMessage callStack "Couldn't find proposal." - Right (Just a) -> return a + governanceActionIndex <- H.nothingFailM $ watchEpochStateView epochStateView (return . maybeExtractGovernanceActionIndex (fromString governanceActionTxId)) (EpochInterval 1) -- Proposal was successfully submitted, now we vote on the proposal and confirm it was ratified voteFiles <- generateVoteFiles execConfig work "vote-files" @@ -196,7 +183,7 @@ hprop_ledger_events_propose_new_constitution = integrationWorkspace "propose-new submitTx execConfig cEra voteTxFp - _ <- waitForEpochs epochStateView (EpochInterval 1) + waitForGovActionVotes epochStateView ceo (EpochInterval 1) -- Count votes before checking for ratification. It may happen that the proposal gets removed after -- ratification because of a long waiting time, so we won't be able to access votes. diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryWithdrawal.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryWithdrawal.hs index b36f0110b81..ccf06d80166 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryWithdrawal.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryWithdrawal.hs @@ -63,7 +63,7 @@ hprop_ledger_events_treasury_withdrawal = integrationRetryWorkspace 1 "treasury cEra = AnyCardanoEra era fastTestnetOptions = cardanoDefaultTestnetOptions - { cardanoEpochLength = 100 + { cardanoEpochLength = 200 , cardanoNodeEra = cEra , cardanoActiveSlotsCoeff = 0.3 } 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 859875dadd3..aa47ff9755e 100644 --- a/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs +++ b/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs @@ -50,8 +50,9 @@ tests = do -- TODO: Replace foldBlocks with checkLedgerStateCondition , T.testGroup "Governance" [ ignoreOnMacAndWindows "Committee Add New" Gov.hprop_constitutional_committee_add_new - -- FIXME: This test is broken - drepActivity is not updated within the expeted period + -- TODO: Disabled because proposals for parameter changes are not working -- , ignoreOnWindows "DRep Activity" Gov.hprop_check_drep_activity + -- , ignoreOnWindows "Predefined Abstain DRep" Gov.hprop_check_predefined_abstain_drep , ignoreOnMacAndWindows "Committee Motion Of No Confidence" Gov.hprop_gov_no_confidence , ignoreOnWindows "DRep Deposits" Gov.hprop_ledger_events_drep_deposits -- FIXME Those tests are flaky