diff --git a/cardano-testnet/src/Testnet/Defaults.hs b/cardano-testnet/src/Testnet/Defaults.hs index 0ea0b233112..3a8b7fab4b5 100644 --- a/cardano-testnet/src/Testnet/Defaults.hs +++ b/cardano-testnet/src/Testnet/Defaults.hs @@ -17,13 +17,13 @@ module Testnet.Defaults , defaultDRepVkeyFp , defaultDRepSkeyFp , defaultDRepKeyPair + , defaultDelegatorStakeKeyPair , defaultShelleyGenesis , defaultGenesisFilepath , defaultYamlHardforkViaConfig , defaultMainnetTopology , plutusV3NonSpendingScript , plutusV3SpendingScript - , defaultDelegatorStakeKeyPair ) where import Cardano.Api (AnyCardanoEra (..), CardanoEra (..), pshow) @@ -517,13 +517,13 @@ defaultDRepKeyPair n = PaymentKeyPair (defaultDRepVkeyFp n) (defaultDRepSkeyFp n -- | The relative path to stake delegator stake keys in directories created by cardano-testnet defaultDelegatorStakeVkeyFp - :: Int -- ^ The Stake delegator index (starts at 1) + :: Int -- ^The Stake delegator index (starts at 1) -> FilePath defaultDelegatorStakeVkeyFp n = "stake-delegators" ("delegator" <> show n) "staking.vkey" -- | The relative path to stake delegator stake secret keys in directories created by cardano-testnet defaultDelegatorStakeSkeyFp - :: Int -- ^ The Stake delegator index (starts at 1) + :: Int -- ^The Stake delegator index (starts at 1) -> FilePath defaultDelegatorStakeSkeyFp n = "stake-delegators" ("delegator" <> show n) "staking.skey" diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/PredefinedAbstainDRep.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/PredefinedAbstainDRep.hs index 7116fd7e9ce..7a9dea055c5 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/PredefinedAbstainDRep.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/PredefinedAbstainDRep.hs @@ -1,21 +1,39 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} module Cardano.Testnet.Test.LedgerEvents.Gov.PredefinedAbstainDRep ( hprop_check_predefined_abstain_drep ) where import Cardano.Api as Api +import Cardano.Api.Error (displayError) import Cardano.Testnet import Prelude +import Control.Monad (void) +import Control.Monad.Catch (MonadCatch) +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Lens as AL +import Data.ByteString.Lazy.Char8 (pack) +import Data.String (fromString) +import qualified Data.Text as Text +import Data.Word (Word32) +import GHC.Stack (callStack) +import Lens.Micro ((^?)) import System.FilePath (()) -import Testnet.Components.Query (getEpochStateView) +import Testnet.Components.DReps (createCertificatePublicationTxBody, createVotingTxBody, + generateVoteFiles, retrieveTransactionId, signTx, submitTx) +import Testnet.Components.Query (EpochStateView, findLargestUtxoForPaymentKey, + getCurrentEpochNo, getEpochStateView, getMinDRepDeposit) +import Testnet.Defaults (defaultDRepKeyPair, defaultDelegatorStakeKeyPair) +import qualified Testnet.Process.Cli as P import qualified Testnet.Process.Run as H import qualified Testnet.Property.Utils as H import Testnet.Runtime @@ -28,7 +46,7 @@ import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO -- @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' -> do - -- Start a local test net + -- Start a local test net conf@Conf { tempAbsPath } <- mkConf tempAbsBasePath' let tempAbsPath' = unTmpAbsPath tempAbsPath tempBaseAbsPath = makeTmpBaseAbsPath tempAbsPath @@ -36,7 +54,8 @@ hprop_check_predefined_abstain_drep = H.integrationWorkspace "test-activity" $ \ work <- H.createDirectoryIfMissing $ tempAbsPath' "work" -- Create default testnet with 3 DReps and 3 stake holders delegated, one to each DRep. - let sbe = ShelleyBasedEraConway + let ceo = ConwayEraOnwardsConway + sbe = conwayEraOnwardsToShelleyBasedEra ceo era = toCardanoEra sbe cEra = AnyCardanoEra era fastTestnetOptions = cardanoDefaultTestnetOptions @@ -48,20 +67,20 @@ hprop_check_predefined_abstain_drep = H.integrationWorkspace "test-activity" $ \ testnetRuntime@TestnetRuntime { testnetMagic , poolNodes - , wallets=_wallet0:_wallet1:_wallet2:_ + , wallets=wallet0:wallet1:wallet2:_ , configurationFile } <- cardanoTestnetDefault fastTestnetOptions conf poolNode1 <- H.headM poolNodes poolSprocket1 <- H.noteShow $ nodeSprocket $ poolRuntime poolNode1 - _execConfig <- H.mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic + execConfig <- H.mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic let socketName' = IO.sprocketName poolSprocket1 socketBase = IO.sprocketBase poolSprocket1 -- /tmp socketPath = socketBase socketName' - _epochStateView <- getEpochStateView (File configurationFile) (File socketPath) + epochStateView <- getEpochStateView (File configurationFile) (File socketPath) startLedgerNewEpochStateLogging testnetRuntime tempAbsPath' @@ -70,13 +89,246 @@ hprop_check_predefined_abstain_drep = H.integrationWorkspace "test-activity" $ \ H.note_ $ "Socketpath: " <> socketPath H.note_ $ "Foldblocks config file: " <> configurationFile - _gov <- H.createDirectoryIfMissing $ work "governance" + gov <- H.createDirectoryIfMissing $ work "governance" - -- ToDo: Do some proposal and vote yes with the first DRep only. - -- ToDo: ASSERT: Check that proposal does NOT pass. - -- ToDo: Take the last two stake delegators and delegate them to "Abstain". - -- ToDo: This can be done using cardano-cli conway stake-address vote-delegation-certificate --always-abstain - -- ToDo: Do some other proposal and vote yes with first DRep only. - -- ToDo: ASSERT: Check the new proposal passes now. + initialDesiredNumberOfPools <- getDesiredPoolNumberValue execConfig - success + let newNumberOfDesiredPools = fromIntegral (initialDesiredNumberOfPools + 1) + + -- Do some proposal and vote yes with the first DRep only + -- and assert that proposal does NOT pass. + void $ desiredPoolNumberProposalTest execConfig epochStateView configurationFile socketPath ceo gov "firstProposal" + wallet0 Nothing [(1, "yes")] newNumberOfDesiredPools initialDesiredNumberOfPools 2 + + -- Take the last two stake delegators and delegate them to "Abstain". + delegateToAlwaysAbstain execConfig epochStateView configurationFile socketPath sbe gov "delegateToAbstain1" + wallet1 (defaultDelegatorStakeKeyPair 2) + delegateToAlwaysAbstain execConfig epochStateView configurationFile socketPath 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 = fromIntegral (newNumberOfDesiredPools + 1) + void $ desiredPoolNumberProposalTest execConfig epochStateView configurationFile socketPath ceo gov "secondProposal" + wallet0 Nothing [(1, "yes")] newNumberOfDesiredPools2 newNumberOfDesiredPools2 2 + +delegateToAlwaysAbstain + :: (MonadTest m, MonadIO m, H.MonadAssertion m, MonadCatch m) + => H.ExecConfig + -> EpochStateView + -> FilePath + -> FilePath + -> ShelleyBasedEra ConwayEra + -> FilePath + -> String + -> PaymentKeyInfo + -> StakingKeyPair + -> m () +delegateToAlwaysAbstain execConfig epochStateView configurationFile socketPath sbe work prefix + payingWallet skeyPair@(StakingKeyPair 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 + [ "conway", "stake-address", "vote-delegation-certificate" + , "--always-abstain" + , "--stake-verification-key-file", 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 + (EpochNo epochAfterProp) <- getCurrentEpochNo epochStateView + void $ waitUntilEpoch (File configurationFile) (File socketPath) (EpochNo (epochAfterProp + 2)) + +desiredPoolNumberProposalTest + :: (MonadTest m, MonadIO m, H.MonadAssertion m, MonadCatch m, Foldable t) + => H.ExecConfig + -> EpochStateView + -> FilePath + -> FilePath + -> ConwayEraOnwards ConwayEra + -> FilePath + -> FilePath + -> PaymentKeyInfo + -> Maybe (String, Word32) + -> t (Int, String) + -> Integer + -> Integer + -> Integer + -> m (String, Word32) +desiredPoolNumberProposalTest execConfig epochStateView configurationFile socketPath ceo work prefix + wallet previousProposalInfo votes change expected epochsToWait = do + let sbe = conwayEraOnwardsToShelleyBasedEra ceo + + baseDir <- H.createDirectoryIfMissing $ work prefix + + let propVotes :: [(String, Int)] + propVotes = zip (concatMap (uncurry replicate) votes) [1..] + annotateShow propVotes + + thisProposal@(governanceActionTxId, governanceActionIndex) <- + makeDesiredPoolNumberChangeProposal execConfig epochStateView (File configurationFile) (File socketPath) + 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 $ waitUntilEpoch (File configurationFile) (File socketPath) (EpochNo (epochAfterProp + fromIntegral epochsToWait)) + desiredPoolNumberAfterProp <- getDesiredPoolNumberValue execConfig + + desiredPoolNumberAfterProp === expected + + return thisProposal + +makeDesiredPoolNumberChangeProposal + :: (H.MonadAssertion m, MonadTest m, MonadCatch m, MonadIO m) + => H.ExecConfig + -> EpochStateView + -> NodeConfigFile 'In + -> SocketPath + -> ConwayEraOnwards ConwayEra + -> FilePath + -> String + -> Maybe (String, Word32) + -> Word32 + -> PaymentKeyInfo + -> m (String, Word32) +makeDesiredPoolNumberChangeProposal execConfig epochStateView configurationFile socketPath + 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 baseDir + $ P.KeyNames { P.verificationKeyFile = stakeVkeyFp + , P.signingKeyFile = 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) [paymentKeyInfoPair wallet] + + submitTx execConfig cEra signedProposalTx + + governanceActionTxId <- retrieveTransactionId execConfig signedProposalTx + + !propSubmittedResult <- findCondition (maybeExtractGovernanceActionIndex sbe (fromString governanceActionTxId)) + (unFile configurationFile) + (unFile socketPath) + (EpochNo 30) + + 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 + + return (governanceActionTxId, governanceActionIndex) + +voteChangeProposal :: (MonadTest m, MonadIO m, MonadCatch m, H.MonadAssertion m) + => H.ExecConfig + -> EpochStateView + -> ShelleyBasedEra ConwayEra + -> FilePath + -> FilePath + -> String + -> Word32 + -> [([Char], Int)] + -> PaymentKeyInfo + -> 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 + (paymentKeyInfoPair wallet:[defaultDRepKeyPair n | (_, n) <- votes]) + submitTx execConfig cEra voteTxFp + +getDesiredPoolNumberValue :: (MonadTest m, MonadCatch m, MonadIO m) => H.ExecConfig -> m Integer +getDesiredPoolNumberValue execConfig = do + govStateString <- H.execCli' execConfig + [ "conway", "query", "gov-state" + , "--volatile-tip" + ] + + govStateJSON <- H.nothingFail (Aeson.decode (pack govStateString) :: Maybe Aeson.Value) + let mTargetPoolNum :: Maybe Integer + mTargetPoolNum = govStateJSON + ^? AL.key "currentPParams" + . AL.key "stakePoolTargetNum" + . AL._Integer + evalMaybe mTargetPoolNum