From f482c1096e95d820e357b280dd71086f4956f802 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Wed, 8 May 2024 21:34:52 +0200 Subject: [PATCH] Add Constitutional Committee members test --- cardano-testnet/cardano-testnet.cabal | 1 + .../src/Testnet/Components/DRep.hs | 2 +- .../src/Testnet/Components/Query.hs | 16 +- cardano-testnet/src/Testnet/Components/SPO.hs | 2 +- .../src/Testnet/EpochStateProcessing.hs | 1 - cardano-testnet/src/Testnet/Start/Cardano.hs | 24 +- .../Testnet/Test/Gov/CommitteeAddNew.hs | 274 ++++++++++++++++++ .../cardano-testnet-test.hs | 5 +- 8 files changed, 308 insertions(+), 17 deletions(-) create mode 100644 cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index a3e03a4fccb..5294df7ee2c 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -186,6 +186,7 @@ test-suite cardano-testnet-test Cardano.Testnet.Test.Cli.Query Cardano.Testnet.Test.Cli.QuerySlotNumber Cardano.Testnet.Test.FoldEpochState + Cardano.Testnet.Test.Gov.CommitteeAddNew Cardano.Testnet.Test.Gov.DRepActivity Cardano.Testnet.Test.Gov.DRepDeposit Cardano.Testnet.Test.Gov.DRepRetirement diff --git a/cardano-testnet/src/Testnet/Components/DRep.hs b/cardano-testnet/src/Testnet/Components/DRep.hs index d7c395873e9..7147fda3dc4 100644 --- a/cardano-testnet/src/Testnet/Components/DRep.hs +++ b/cardano-testnet/src/Testnet/Components/DRep.hs @@ -163,7 +163,7 @@ generateVoteFiles generateVoteFiles execConfig work prefix governanceActionTxId governanceActionIndex allVotes = do baseDir <- H.createDirectoryIfMissing $ work prefix forM (zip [(1 :: Integer)..] allVotes) $ \(idx, (drepKeyPair, vote)) -> do - let path = File (baseDir "vote-" <> show idx) + let path = File (baseDir "vote-drep-" <> show idx) void $ H.execCli' execConfig [ "conway", "governance", "vote", "create" , "--" ++ vote diff --git a/cardano-testnet/src/Testnet/Components/Query.hs b/cardano-testnet/src/Testnet/Components/Query.hs index 7f42bbe6b2b..6ac751f0f4a 100644 --- a/cardano-testnet/src/Testnet/Components/Query.hs +++ b/cardano-testnet/src/Testnet/Components/Query.hs @@ -10,6 +10,7 @@ module Testnet.Components.Query , checkDRepState , getEpochState , getMinDRepDeposit + , getMinGovActionDeposit , getGovState , getCurrentEpochNo , waitUntilEpoch @@ -312,6 +313,19 @@ getGovState epochStateView ceo = withFrozenCallStack $ do Refl <- H.leftFail $ assertErasEqual sbe sbe' pure $ conwayEraOnwardsConstraints ceo $ newEpochState ^. L.newEpochStateGovStateL +-- | Obtain minimum deposit amount for governance action from node +getMinGovActionDeposit + :: HasCallStack + => MonadAssertion m + => MonadIO m + => MonadTest m + => EpochStateView + -> ConwayEraOnwards era + -> m Integer -- ^ The minimum deposit +getMinGovActionDeposit epochStateView ceo = withFrozenCallStack $ do + govState <- getGovState epochStateView ceo + pure $ conwayEraOnwardsConstraints ceo $ govState ^. L.cgsCurPParamsL . L.ppGovActionDepositL . to L.unCoin + -- | Obtain minimum deposit amount for DRep registration from node getMinDRepDeposit :: HasCallStack @@ -320,7 +334,7 @@ getMinDRepDeposit => MonadTest m => EpochStateView -> ConwayEraOnwards era - -> m Integer -- ^ The governance state + -> m Integer -- ^ The minimum deposit getMinDRepDeposit epochStateView ceo = withFrozenCallStack $ do govState <- getGovState epochStateView ceo pure $ conwayEraOnwardsConstraints ceo $ govState ^. L.cgsCurPParamsL . L.ppDRepDepositL . to L.unCoin diff --git a/cardano-testnet/src/Testnet/Components/SPO.hs b/cardano-testnet/src/Testnet/Components/SPO.hs index 9f7caabacec..ce7892e8990 100644 --- a/cardano-testnet/src/Testnet/Components/SPO.hs +++ b/cardano-testnet/src/Testnet/Components/SPO.hs @@ -427,7 +427,7 @@ generateVoteFiles :: (MonadTest m, MonadIO m, MonadCatch m) generateVoteFiles ceo execConfig work prefix governanceActionTxId governanceActionIndex allVotes = do baseDir <- H.createDirectoryIfMissing $ work prefix forM (zip [(1 :: Integer)..] allVotes) $ \(idx, (spoKeys, vote)) -> do - let path = File (baseDir "vote-" <> show idx) + let path = File (baseDir "vote-spo-" <> show idx) void $ H.execCli' execConfig [ eraToString $ toCardanoEra ceo , "governance", "vote", "create" , "--" ++ vote diff --git a/cardano-testnet/src/Testnet/EpochStateProcessing.hs b/cardano-testnet/src/Testnet/EpochStateProcessing.hs index e2dd8790658..b12a9f489ac 100644 --- a/cardano-testnet/src/Testnet/EpochStateProcessing.hs +++ b/cardano-testnet/src/Testnet/EpochStateProcessing.hs @@ -1,5 +1,4 @@ {-# LANGUAGE DataKinds #-} -{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} diff --git a/cardano-testnet/src/Testnet/Start/Cardano.hs b/cardano-testnet/src/Testnet/Start/Cardano.hs index 042fe9b8bb0..6c4e9a90245 100644 --- a/cardano-testnet/src/Testnet/Start/Cardano.hs +++ b/cardano-testnet/src/Testnet/Start/Cardano.hs @@ -273,25 +273,32 @@ cardanoTestnet _ <- createSPOGenesisAndFiles nPools nDReps era shelleyGenesis alonzoGenesis conwayGenesis (TmpAbsolutePath tmpAbsPath) + -- TODO: This should come from the configuration! + let poolKeyDir :: Int -> FilePath + poolKeyDir i = "pools-keys" mkNodeName i + mkNodeName :: Int -> String + mkNodeName i = "pool" <> show i + poolKeys <- H.noteShow $ flip fmap [1..numPoolNodes] $ \n -> -- TODO: use Testnet.Defaults.defaultSpoKeys here PoolNodeKeys { poolNodeKeysCold = KeyPair - { verificationKey = File $ tmpAbsPath "pools-keys" "cold" <> show n <> ".vkey" - , signingKey = File $ tmpAbsPath "pools-keys" "cold" <> show n <> ".skey" + { verificationKey = File $ tmpAbsPath poolKeyDir n "cold.vkey" + , signingKey = File $ tmpAbsPath poolKeyDir n "cold.skey" } , poolNodeKeysVrf = KeyPair - { verificationKey = File $ tmpAbsPath "pools-keys" "vrf" <> show n <> ".vkey" - , signingKey = File $ tmpAbsPath "pools-keys" "vrf" <> show n <> ".skey" + { verificationKey = File $ tmpAbsPath poolKeyDir n "vrf.vkey" + , signingKey = File $ tmpAbsPath poolKeyDir n "vrf.skey" } , poolNodeKeysStaking = KeyPair - { verificationKey = File $ tmpAbsPath "pools-keys" "staking-reward" <> show n <> ".vkey" - , signingKey = File $ tmpAbsPath "pools-keys" "staking-reward" <> show n <> ".skey" + { verificationKey = File $ tmpAbsPath poolKeyDir n "staking-reward.vkey" + , signingKey = File $ tmpAbsPath poolKeyDir n "staking-reward.skey" } } + let makeUTxOVKeyFp :: Int -> FilePath makeUTxOVKeyFp n = tmpAbsPath "utxo-keys" "utxo" <> show n "utxo.vkey" @@ -332,11 +339,6 @@ cardanoTestnet } } - -- TODO: This should come from the configuration! - let poolKeyDir :: Int -> FilePath - poolKeyDir i = "pools-keys" mkNodeName i - mkNodeName :: Int -> String - mkNodeName i = "pool" <> show i -- Add Byron, Shelley and Alonzo genesis hashes to node configuration config <- createConfigJson (TmpAbsolutePath tmpAbsPath) era 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 new file mode 100644 index 00000000000..7940ccb41a6 --- /dev/null +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs @@ -0,0 +1,274 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} + +module Cardano.Testnet.Test.Gov.CommitteeAddNew + ( hprop_constitutional_committee_add_new + ) where + +import Cardano.Api as Api +import qualified Cardano.Api.Ledger as L +import Cardano.Api.Shelley (ShelleyLedgerEra) + +import qualified Cardano.Ledger.Conway.Governance as L +import qualified Cardano.Ledger.Credential as L +import qualified Cardano.Ledger.Shelley.LedgerState as L +import Cardano.Testnet + +import Prelude + +import Control.Monad +import qualified Data.Char as C +import qualified Data.Map as Map +import Data.Maybe.Strict +import Data.Set (Set) +import Data.String +import qualified Data.Text as Text +import GHC.Exts (IsList (..)) +import GHC.Stack +import Lens.Micro +import System.FilePath (()) + +import Testnet.Components.Configuration +import qualified Testnet.Components.DRep as DRep +import Testnet.Components.Query +import qualified Testnet.Components.SPO as SPO +import Testnet.Components.TestWatchdog +import Testnet.Defaults +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.Extras as H + +hprop_constitutional_committee_add_new :: Property +hprop_constitutional_committee_add_new = H.integrationWorkspace "constitutional-committee-add-new" $ \tempAbsBasePath' -> runWithDefaultWatchdog_ $ do + conf@Conf { tempAbsPath } <- mkConf tempAbsBasePath' + let tempAbsPath' = unTmpAbsPath tempAbsPath + tempBaseAbsPath = makeTmpBaseAbsPath tempAbsPath + + work <- H.createDirectoryIfMissing $ tempAbsPath' "work" + + -- how many votes to cast + let drepVotes, spoVotes :: [(String, Int)] + drepVotes = zip (concatMap (uncurry replicate) [(5, "yes"), (3, "no"), (2, "abstain")]) [1..] + spoVotes = zip (concatMap (uncurry replicate) [(1, "yes")]) [1..] + H.noteShow_ drepVotes + + let nDrepVotes :: Int + nDrepVotes = length drepVotes + H.noteShow_ nDrepVotes + + let ceo = ConwayEraOnwardsConway + sbe = conwayEraOnwardsToShelleyBasedEra ceo + era = toCardanoEra sbe + cEra = AnyCardanoEra era + eraName = eraToString era + fastTestnetOptions = cardanoDefaultTestnetOptions + { cardanoEpochLength = 100 + , cardanoNodeEra = cEra + , cardanoNumDReps = nDrepVotes + } + + TestnetRuntime + { testnetMagic + , poolNodes + , wallets=wallet0:_ + , configurationFile + } + <- cardanoTestnetDefault fastTestnetOptions conf + + PoolNode{poolRuntime, poolKeys} <- 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" + proposalAnchorFp <- H.note $ gov "sample-proposal-anchor" + proposalDataFp <- H.note $ gov "sample-proposal-data" + updateCommitteeFp <- H.note $ gov "update-cc.action" + + H.writeFile proposalAnchorFp "dummy anchor data" + H.writeFile proposalDataFp "dummy proposal data" + + proposalAnchorDataHash <- H.execCli' execConfig + [ eraName, "governance" , "hash", "anchor-data" + , "--file-text", proposalAnchorFp + ] + + let ccColdSKeyFp n = gov "cc-" <> show n <> "-cold.skey" + ccColdVKeyFp n = gov "cc-" <> show n <> "-cold.vkey" + stakeVkeyFp = gov "stake.vkey" + stakeSKeyFp = gov "stake.skey" + + P.cliStakeAddressKeyGen + $ KeyPair { verificationKey = File stakeVkeyFp + , signingKey = File stakeSKeyFp + } + + minGovActDeposit <- getMinGovActionDeposit epochStateView ceo + + ccColdKeys <- H.noteShowM $ + H.forConcurrently [1..3] $ \(i :: Int) -> do + let coldVKey = ccColdVKeyFp i + _ <- H.execCli' execConfig + [ eraName, "governance", "committee", "key-gen-cold" + , "--cold-verification-key-file", ccColdVKeyFp i + , "--cold-signing-key-file", ccColdSKeyFp i + ] + fmap (coldVKey, i,) $ + parseKeyHashCred =<< H.execCli' execConfig + [ eraName, "governance", "committee", "key-hash" + , "--verification-key-file", ccColdVKeyFp i + ] + let (ccColdKeyFps, _, ccCredentials) = unzip3 ccColdKeys + + EpochNo epochNo <- H.noteShowM $ getCurrentEpochNo epochStateView + let ccExpiryEpoch = epochNo + 200 + deadlineEpoch = EpochNo $ epochNo + 10 + + _ <- H.execCli' execConfig $ + [ eraName, "governance", "action" , "update-committee" + , "--testnet" + , "--anchor-url", "https://tinyurl.com/3wrwb2as" + , "--anchor-data-hash", proposalAnchorDataHash + , "--governance-action-deposit", show minGovActDeposit + , "--deposit-return-stake-verification-key-file", stakeVkeyFp + , "--threshold", "0.2" + , "--out-file", updateCommitteeFp + ] + <> concatMap + (\fp -> ["--add-cc-cold-verification-key-file", fp, "--epoch", show ccExpiryEpoch]) + ccColdKeyFps + + txbodyFp <- H.note $ work "tx.body" + txin1 <- findLargestUtxoForPaymentKey epochStateView sbe wallet0 + void $ H.execCli' execConfig + [ eraToString era, "transaction", "build" + , "--change-address", Text.unpack $ paymentKeyInfoAddr wallet0 + , "--tx-in", Text.unpack $ renderTxIn txin1 + , "--tx-out", Text.unpack (paymentKeyInfoAddr wallet0) <> "+" <> show @Int 5_000_000 + , "--proposal-file", updateCommitteeFp + , "--out-file", txbodyFp + ] + + -- double check that we're starting with an empty committee + committeeMembers <- getCommitteeMembers epochStateView ceo + committeeMembers `H.assertWith` null + + signedProposalTx <- + DRep.signTx execConfig cEra work "signed-proposal" (File txbodyFp) [SomeKeyPair $ paymentKeyInfoPair wallet0] + DRep.submitTx execConfig cEra signedProposalTx + + governanceActionTxId <- H.noteM $ DRep.retrieveTransactionId execConfig signedProposalTx + + governanceActionIx <- + H.nothingFailM . + H.leftFailM $ + findCondition + (maybeExtractGovernanceActionIndex (fromString governanceActionTxId)) + configurationFile + socketPath + deadlineEpoch + + dRepVoteFiles <- + DRep.generateVoteFiles + execConfig work "vote-files" governanceActionTxId governanceActionIx + [(defaultDRepKeyPair idx, vote) | (vote, idx) <- drepVotes] + + spoVoteFiles <- + SPO.generateVoteFiles + ceo execConfig work "vote-files" governanceActionTxId governanceActionIx + [(poolKeys, vote) | (vote, _idx) <- spoVotes] + + let voteFiles = dRepVoteFiles <> spoVoteFiles + + voteTxBodyFp <- + DRep.createVotingTxBody + execConfig epochStateView sbe work "vote-tx-body" voteFiles wallet0 + + -- FIXME: remove dependence of signTx on PaymentKeyPair + let poolNodePaymentKeyPair = KeyPair + { signingKey = File . signingKeyFp $ poolNodeKeysCold poolKeys + , verificationKey = error "unused" + } + drepSKeys = map (defaultDRepKeyPair . snd) drepVotes + signingKeys = SomeKeyPair <$> paymentKeyInfoPair wallet0:poolNodePaymentKeyPair:drepSKeys + voteTxFp <- DRep.signTx + execConfig cEra gov "signed-vote-tx" voteTxBodyFp signingKeys + + DRep.submitTx execConfig cEra voteTxFp + + _ <- waitForEpochs epochStateView (L.EpochInterval 1) + + govState <- getGovState epochStateView ceo + govActionState <- H.headM $ govState ^. L.cgsProposalsL . L.pPropsL . to toList + let gaDRepVotes = govActionState ^. L.gasDRepVotesL . to toList + gaSpoVotes = govActionState ^. L.gasStakePoolVotesL . to toList + + length (filter ((== L.VoteYes) . snd) gaDRepVotes) === 5 + length (filter ((== L.VoteNo) . snd) gaDRepVotes) === 3 + length (filter ((== L.Abstain) . snd) gaDRepVotes) === 2 + length drepVotes === length gaDRepVotes + length (filter ((== L.VoteYes) . snd) gaSpoVotes) === 1 + length spoVotes === length gaSpoVotes + + H.nothingFailM . H.leftFailM $ + findCondition committeeIsPresent configurationFile socketPath deadlineEpoch + + -- show proposed committe meembers + H.noteShow_ ccCredentials + + newCommitteeMembers :: Set (L.Credential L.ColdCommitteeRole L.StandardCrypto) + <- fromList <$> getCommitteeMembers epochStateView ceo + + -- check that the committee is actually what we expect + newCommitteeMembers === fromList ccCredentials + +parseKeyHashCred :: MonadFail m => String -> m (L.Credential kr L.StandardCrypto) +parseKeyHashCred hash = L.parseCredential $ "keyHash-" <> Text.pack (trim hash) + +trim :: String -> String +trim = f . f + where f = reverse . dropWhile C.isSpace + +getCommitteeMembers + :: HasCallStack + => H.MonadAssertion m + => MonadIO m + => MonadTest m + => EpochStateView + -> ConwayEraOnwards era + -> m [L.Credential L.ColdCommitteeRole (L.EraCrypto (ShelleyLedgerEra era))] +getCommitteeMembers epochStateView ceo = withFrozenCallStack $ do + govState <- getGovState epochStateView ceo + fmap (Map.keys . L.committeeMembers) . H.nothingFail $ strictMaybeToMaybe $ govState ^. L.cgsCommitteeL + +committeeIsPresent :: AnyNewEpochState -> Maybe () +committeeIsPresent (AnyNewEpochState sbe newEpochState) = + caseShelleyToBabbageOrConwayEraOnwards + (const $ error "Constitutional committee does not exist pre-Conway era") + (\_ -> do + let mCommittee = newEpochState + ^. L.nesEsL + . L.esLStateL + . L.lsUTxOStateL + . L.utxosGovStateL + . L.cgsCommitteeL + members <- L.committeeMembers <$> strictMaybeToMaybe mCommittee + when (Map.null members) Nothing + ) + sbe 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 9c7e52d6e37..2ce5171ba5f 100644 --- a/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs +++ b/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs @@ -13,6 +13,7 @@ import qualified Cardano.Testnet.Test.Cli.KesPeriodInfo 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.DRepDeposit as Gov import qualified Cardano.Testnet.Test.Gov.DRepRetirement as Gov import qualified Cardano.Testnet.Test.Gov.ProposeNewConstitution as Gov @@ -47,10 +48,10 @@ tests = do , H.ignoreOnWindows "Treasury Growth" Gov.prop_check_if_treasury_is_growing -- 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 Deposits" Gov.hprop_ledger_events_drep_deposits + , H.ignoreOnWindows "DRep Deposits" Gov.hprop_ledger_events_drep_deposits -- FIXME Those tests are flaky -- , H.ignoreOnWindows "InfoAction" LedgerEvents.hprop_ledger_events_info_action , H.ignoreOnWindows "DRep Retirement" Gov.hprop_drep_retirement