diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index 2d9ab117aa9..dc9dc6aa1b4 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -67,6 +67,7 @@ library , mtl , network , network-mux + , monad-control , optparse-applicative-fork , ouroboros-network ^>= 0.16 , ouroboros-network-api @@ -200,6 +201,7 @@ test-suite cardano-testnet-test Cardano.Testnet.Test.Misc Cardano.Testnet.Test.Gov.DRepActivity Cardano.Testnet.Test.Gov.PredefinedAbstainDRep + Cardano.Testnet.Test.Gov.PredefinedNoConfidenceDRep Cardano.Testnet.Test.Node.Shutdown Cardano.Testnet.Test.SanityCheck Cardano.Testnet.Test.SubmitApi.Babbage.Transaction @@ -230,6 +232,7 @@ test-suite cardano-testnet-test , http-conduit , lens-aeson , microlens + , monad-control , mtl , process , regex-compat diff --git a/cardano-testnet/src/Testnet/Process/Cli/DRep.hs b/cardano-testnet/src/Testnet/Process/Cli/DRep.hs index 4406b8408cb..0316905c265 100644 --- a/cardano-testnet/src/Testnet/Process/Cli/DRep.hs +++ b/cardano-testnet/src/Testnet/Process/Cli/DRep.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} diff --git a/cardano-testnet/src/Testnet/Process/Cli/SPO.hs b/cardano-testnet/src/Testnet/Process/Cli/SPO.hs index fdefc8badef..805be627a1e 100644 --- a/cardano-testnet/src/Testnet/Process/Cli/SPO.hs +++ b/cardano-testnet/src/Testnet/Process/Cli/SPO.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -25,6 +26,7 @@ import qualified Cardano.Ledger.UMap as L import Control.Monad import Control.Monad.Catch (MonadCatch) import Control.Monad.State.Strict as StateT +import Control.Monad.Trans.Control (MonadBaseControl) import qualified Data.Aeson as Aeson import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map @@ -47,6 +49,7 @@ import Testnet.Types import Hedgehog import Hedgehog.Extras (ExecConfig) import qualified Hedgehog.Extras as H +import Hedgehog.Extras.Test.Concurrent (forConcurrently) checkStakePoolRegistered :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) @@ -408,7 +411,7 @@ registerSingleSpo identifier tap@(TmpAbsolutePath tempAbsPath') nodeConfigFile s -- Returns a list of generated @File VoteFile In@ representing the paths to -- the generated voting files. -- TODO: unify with DRep.generateVoteFiles -generateVoteFiles :: (MonadTest m, MonadIO m, MonadCatch m) +generateVoteFiles :: (MonadTest m, MonadIO m, MonadCatch m, HasCallStack, MonadBaseControl IO m) => ConwayEraOnwards era -- ^ The conway era onwards witness for the era in which the -- transaction will be constructed. -> H.ExecConfig -- ^ Specifies the CLI execution configuration. @@ -424,10 +427,10 @@ generateVoteFiles :: (MonadTest m, MonadIO m, MonadCatch m) -> m [File VoteFile In] generateVoteFiles ceo execConfig work prefix governanceActionTxId governanceActionIndex allVotes = do baseDir <- H.createDirectoryIfMissing $ work prefix - forM (zip [(1 :: Integer)..] allVotes) $ \(idx, (spoKeys, vote)) -> do + forConcurrently (zip [(1 :: Integer)..] allVotes) $ \(idx, (spoKeys, vote)) -> do let path = File (baseDir "vote-spo-" <> show idx) void $ execCli' execConfig - [ eraToString $ toCardanoEra ceo , "governance", "vote", "create" + [ eraToString $ toCardanoEra ceo, "governance", "vote", "create" , "--" ++ vote , "--governance-action-tx-id", governanceActionTxId , "--governance-action-index", show @Word32 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 4799aef74a9..bc55eccdecd 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 @@ -56,8 +56,8 @@ hprop_ledger_events_info_action = integrationRetryWorkspace 0 "info-hash" $ \tem work <- H.createDirectoryIfMissing $ tempAbsPath' "work" let ceo = ConwayEraOnwardsConway - era = toCardanoEra sbe sbe = conwayEraOnwardsToShelleyBasedEra ceo + era = toCardanoEra sbe fastTestnetOptions = cardanoDefaultTestnetOptions { cardanoEpochLength = 200 , cardanoNodeEra = AnyCardanoEra era 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 index 9f65bde583b..8a2aa3c4b36 100644 --- 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 @@ -6,7 +6,12 @@ {-# LANGUAGE TypeApplications #-} module Cardano.Testnet.Test.Gov.PredefinedAbstainDRep - ( hprop_check_predefined_abstain_drep + ( AutomaticDRepType(..) + , hprop_check_predefined_abstain_drep + , delegateToAutomaticDRep + , desiredPoolNumberProposalTest + , getDesiredPoolNumberValue + , voteChangeProposal ) where import Cardano.Api as Api @@ -23,6 +28,7 @@ import Prelude import Control.Monad (void) import Control.Monad.Catch (MonadCatch) +import Control.Monad.Trans.Control (MonadBaseControl) import Data.Data (Typeable) import Data.String (fromString) import qualified Data.Text as Text @@ -36,10 +42,12 @@ 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 Testnet.Defaults (defaultDRepKeyPair, defaultDelegatorStakeKeyPair, + defaultSpoColdKeyPair, defaultSpoKeys) +import qualified Testnet.Process.Cli.DRep as DRep +import Testnet.Process.Cli.DRep (createCertificatePublicationTxBody, createVotingTxBody) import qualified Testnet.Process.Cli.Keys as P +import qualified Testnet.Process.Cli.SPO as SPO import Testnet.Process.Cli.Transaction (retrieveTransactionId, signTx, submitTx) import qualified Testnet.Process.Run as H import qualified Testnet.Property.Util as H @@ -116,11 +124,11 @@ hprop_check_predefined_abstain_drep = H.integrationWorkspace "test-activity" $ \ 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) + -- Take the last two stake delegators and delegate them to "AlwaysAbstainDRep". + delegateToAutomaticDRep execConfig epochStateView sbe gov "delegateToAbstain1" + AlwaysAbstainDRep wallet1 (defaultDelegatorStakeKeyPair 2) + delegateToAutomaticDRep execConfig epochStateView sbe gov "delegateToAbstain2" + AlwaysAbstainDRep wallet2 (defaultDelegatorStakeKeyPair 3) -- Do some other proposal and vote yes with first DRep only -- and assert the new proposal passes now. @@ -128,7 +136,11 @@ hprop_check_predefined_abstain_drep = H.integrationWorkspace "test-activity" $ \ void $ desiredPoolNumberProposalTest execConfig epochStateView ceo gov "secondProposal" wallet0 Nothing [(1, "yes")] newNumberOfDesiredPools2 0 (Just newNumberOfDesiredPools2) 10 -delegateToAlwaysAbstain +-- | Which automatic DRep to delegate to +data AutomaticDRepType = AlwaysAbstainDRep + | NoConfidenceDRep + +delegateToAutomaticDRep :: (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 @@ -136,12 +148,11 @@ delegateToAlwaysAbstain -> 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. + -> AutomaticDRepType -- ^ Which type of automatic DRep to delegate to. -> 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 - +delegateToAutomaticDRep execConfig epochStateView sbe work prefix flag payingWallet skeyPair@(KeyPair vKeyFile _sKeyFile) = do let era = toCardanoEra sbe cEra = AnyCardanoEra era @@ -151,7 +162,9 @@ delegateToAlwaysAbstain execConfig epochStateView sbe work prefix let voteDelegationCertificatePath = baseDir "delegation-certificate.delegcert" void $ H.execCli' execConfig [ anyEraToString cEra, "stake-address", "vote-delegation-certificate" - , "--always-abstain" + , case flag of + AlwaysAbstainDRep -> "--always-abstain" + NoConfidenceDRep -> "--always-no-confidence" , "--stake-verification-key-file", unFile vKeyFile , "--out-file", voteDelegationCertificatePath ] @@ -172,7 +185,7 @@ delegateToAlwaysAbstain execConfig epochStateView sbe work prefix void $ waitForEpochs epochStateView (EpochInterval 1) desiredPoolNumberProposalTest - :: (HasCallStack, MonadTest m, MonadIO m, H.MonadAssertion m, MonadCatch m, Foldable t) + :: (HasCallStack, MonadTest m, MonadIO m, H.MonadAssertion m, MonadCatch m, MonadBaseControl IO 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 @@ -190,8 +203,6 @@ desiredPoolNumberProposalTest -> 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] @@ -202,8 +213,8 @@ desiredPoolNumberProposalTest execConfig epochStateView ceo work prefix wallet makeDesiredPoolNumberChangeProposal execConfig epochStateView ceo baseDir "proposal" previousProposalInfo (fromIntegral change) wallet - voteChangeProposal execConfig epochStateView sbe baseDir "vote" - governanceActionTxId governanceActionIndex propVotes wallet + voteChangeProposal execConfig epochStateView ceo baseDir "vote" + governanceActionTxId governanceActionIndex propVotes [] wallet (EpochNo epochAfterProp) <- getCurrentEpochNo epochStateView H.note_ $ "Epoch after \"" <> prefix <> "\" prop: " <> show epochAfterProp @@ -300,36 +311,51 @@ makeDesiredPoolNumberChangeProposal execConfig epochStateView ceo work prefix -- a default DRep (from the ones created by 'cardanoTestnetDefault') type DefaultDRepVote = (String, Int) +-- A pair of a vote string (i.e: "yes", "no", or "abstain") and the number of +-- a default SPO (from the ones created by 'cardanoTestnetDefault') +type DefaultSPOVote = (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) +-- Delegate Representative (DReps created by 'cardanoTestnetDefault') and +-- default Stake Pool Operatorsusing using @cardano-cli@. +voteChangeProposal :: (Typeable era, MonadTest m, MonadIO m, MonadCatch m, H.MonadAssertion m, MonadBaseControl IO 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). + -> ConwayEraOnwards era -- ^ The @ConwayEraOnwards@ witness for the current era. -> 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. + -> [DefaultSPOVote] -- ^ 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 +voteChangeProposal execConfig epochStateView ceo work prefix + governanceActionTxId governanceActionIndex drepVotes spoVotes wallet = do baseDir <- H.createDirectoryIfMissing $ work prefix - let era = toCardanoEra sbe + let sbe = conwayEraOnwardsToShelleyBasedEra ceo + era = toCardanoEra sbe cEra = AnyCardanoEra era - voteFiles <- generateVoteFiles execConfig baseDir "vote-files" - governanceActionTxId governanceActionIndex - [(defaultDRepKeyPair idx, vote) | (vote, idx) <- votes] + drepVoteFiles <- DRep.generateVoteFiles execConfig baseDir "drep-vote-files" + governanceActionTxId governanceActionIndex + [(defaultDRepKeyPair idx, vote) | (vote, idx) <- drepVotes] + + spoVoteFiles <- SPO.generateVoteFiles ceo execConfig baseDir "spo-vote-files" + governanceActionTxId governanceActionIndex + [(defaultSpoKeys idx, vote) | (vote, idx) <- spoVotes] + + let voteFiles = drepVoteFiles ++ spoVoteFiles 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]) + (SomeKeyPair (paymentKeyInfoPair wallet): + [SomeKeyPair $ defaultDRepKeyPair n | (_, n) <- drepVotes] ++ + [SomeKeyPair $ defaultSpoColdKeyPair n | (_, n) <- drepVotes] + ) submitTx execConfig cEra voteTxFp -- | Obtains the @desiredPoolNumberValue@ from the protocol parameters. diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PredefinedNoConfidenceDRep.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PredefinedNoConfidenceDRep.hs new file mode 100644 index 00000000000..a969bd0e82b --- /dev/null +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PredefinedNoConfidenceDRep.hs @@ -0,0 +1,378 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module Cardano.Testnet.Test.Gov.PredefinedNoConfidenceDRep + ( hprop_check_predefined_no_confidence_drep + ) where + +import Cardano.Api as Api +import Cardano.Api.Ledger (EpochInterval (..), StrictMaybe (..)) +import qualified Cardano.Api.Ledger as L + +import qualified Cardano.Ledger.Conway.Governance as L +import qualified Cardano.Ledger.Shelley.LedgerState as L +import Cardano.Testnet +import Cardano.Testnet.Test.Gov.PredefinedAbstainDRep (AutomaticDRepType (..), + delegateToAutomaticDRep, desiredPoolNumberProposalTest, + getDesiredPoolNumberValue, voteChangeProposal) + +import Prelude + +import Control.Monad (void) +import Control.Monad.Catch (MonadCatch) +import Control.Monad.Trans.Control (MonadBaseControl) +import qualified Data.Map as Map +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.Query (EpochStateView, findLargestUtxoForPaymentKey, + getCurrentEpochNo, getEpochStateView, getMinDRepDeposit, watchEpochStateView) +import Testnet.Components.TestWatchdog (runWithDefaultWatchdog_) +import Testnet.Defaults (defaultDelegatorStakeKeyPair) +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 (..), PoolNode (..), + SomeKeyPair (SomeKeyPair), TestnetRuntime (..), nodeSocketPath) + +import Hedgehog +import qualified Hedgehog.Extras as H + +-- | Execute me with: +-- @DISABLE_RETRIES=1 cabal test cardano-testnet-test --test-options '-p "/Predefined No Confidence DRep/"'@ +hprop_check_predefined_no_confidence_drep :: Property +hprop_check_predefined_no_confidence_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 = 100 + , 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" + + -- Create constitutional committee and check it exists + constitutionalAction <- updateConstitutionalCommittee execConfig epochStateView ceo work + "committeeUpdate" wallet0 Nothing [(3, "yes")] + + -- Do some proposal and vote yes with all the DReps + -- and assert that proposal passes. + initialDesiredNumberOfPools <- getDesiredPoolNumberValue epochStateView ceo + + let newNumberOfDesiredPools = initialDesiredNumberOfPools + 1 + + firstProposalInfo <- desiredPoolNumberProposalTest execConfig epochStateView ceo gov "firstProposal" + wallet1 Nothing [(3, "yes")] newNumberOfDesiredPools 0 (Just newNumberOfDesiredPools) 10 + + -- Take the last two stake delegators and delegate them to "No Confidence" automatic DRep. + delegateToAutomaticDRep execConfig epochStateView sbe work + "delegateToNoConfidence1" NoConfidenceDRep wallet2 (defaultDelegatorStakeKeyPair 2) + delegateToAutomaticDRep execConfig epochStateView sbe work + "delegateToNoConfidence2" NoConfidenceDRep wallet2 (defaultDelegatorStakeKeyPair 3) + + -- Do some other proposal and vote yes with all the DReps + -- and assert the new proposal does NOT pass. + let newNumberOfDesiredPools2 = newNumberOfDesiredPools + 1 + + void $ desiredPoolNumberProposalTest execConfig epochStateView ceo gov "secondProposal" + wallet0 (Just firstProposalInfo) [(3, "yes")] newNumberOfDesiredPools2 3 (Just newNumberOfDesiredPools) 10 + + -- Create a no confidence proposal and vote "no" to the proposal with all DReps. + -- Assert the no confidence proposal passes. + void $ testNoConfidenceProposal execConfig epochStateView ceo gov "noConfidenceProposal" + wallet1 constitutionalAction [(3, "no")] + +filterCommittee :: AnyNewEpochState -> Maybe [(L.Credential L.ColdCommitteeRole L.StandardCrypto, EpochNo)] +filterCommittee (AnyNewEpochState sbe newEpochState) = + caseShelleyToBabbageOrConwayEraOnwards + (const $ error "filterNoCommittee: Only conway era supported") + (const $ do + let rState = L.extractDRepPulsingState $ newEpochState ^. L.newEpochStateGovStateL . L.drepPulsingStateGovStateL + ensCommittee = rState ^. L.rsEnactStateL . L.ensCommitteeL + case ensCommittee of + SNothing -> Nothing + SJust x | Map.null (L.committeeMembers x) -> Nothing + | otherwise -> Just $ Map.toList $ L.committeeMembers x + ) + sbe + +updateConstitutionalCommittee + :: (MonadTest m, MonadIO m, H.MonadAssertion m, MonadCatch m, MonadBaseControl IO m, Foldable t, HasCallStack) + => H.ExecConfig + -> EpochStateView + -> ConwayEraOnwards ConwayEra + -> FilePath + -> FilePath + -> PaymentKeyInfo + -> Maybe (String, Word32) + -> t (Int, String) + -> m (String, Word32) +updateConstitutionalCommittee execConfig epochStateView ceo work prefix + wallet previousProposalInfo votes = do + baseDir <- H.createDirectoryIfMissing $ work prefix + + let propVotes :: [(String, Int)] + propVotes = zip (concatMap (uncurry replicate) votes) [1..] + annotateShow propVotes + + let coldVKeyFile = baseDir "cold-key.vkey" + coldSKeyFile = baseDir "cold-key.skey" + + void $ H.execCli' execConfig + [ "conway", "governance", "committee", "key-gen-cold" + , "--cold-verification-key-file", coldVKeyFile + , "--cold-signing-key-file", coldSKeyFile + ] + + coldKeyHash <- Text.unpack . Text.strip . Text.pack <$> H.execCli' execConfig + [ "conway", "governance", "committee", "key-hash" + , "--verification-key-file", coldVKeyFile + ] + + thisProposal@(governanceActionTxId, governanceActionIndex) <- + makeUpdateConstitutionalCommitteeProposal execConfig epochStateView ceo baseDir "proposal" + previousProposalInfo [coldKeyHash] wallet + + voteChangeProposal execConfig epochStateView ceo baseDir "vote" + governanceActionTxId governanceActionIndex propVotes (zip (repeat "yes") [1..3]) wallet + + (EpochNo epochAfterProp) <- getCurrentEpochNo epochStateView + H.note_ $ "Epoch after \"" <> prefix <> "\" prop: " <> show epochAfterProp + + committee <- H.nothingFailM $ watchEpochStateView epochStateView (return . filterCommittee) (EpochInterval 1) + + H.note_ $ show committee + + return thisProposal + +makeUpdateConstitutionalCommitteeProposal + :: (HasCallStack, H.MonadAssertion m, MonadTest m, MonadCatch m, MonadIO m, Foldable f) + => H.ExecConfig + -> EpochStateView + -> ConwayEraOnwards ConwayEra + -> FilePath + -> String + -> Maybe (String, Word32) + -> f String + -> PaymentKeyInfo + -> m (String, Word32) +makeUpdateConstitutionalCommitteeProposal execConfig epochStateView ceo work prefix + prevGovActionInfo coldKeyHashes 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", "update-committee" + , "--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 ++ + [ "--anchor-url", "https://tinyurl.com/3wrwb2as" + , "--anchor-data-hash", proposalAnchorDataHash + ] ++ concatMap (\keyHash -> + [ "--add-cc-cold-verification-key-hash", keyHash + , "--epoch", show (100 :: Int) + ]) coldKeyHashes ++ + [ "--threshold", "0" + , "--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) + +-- Run a no confidence motion and check the result. Vote "yes" with 3 SPOs. Check the no +-- confidence motion passes. +testNoConfidenceProposal + :: (MonadTest m, MonadIO m, H.MonadAssertion m, MonadCatch m, MonadBaseControl IO m, Foldable t, HasCallStack) + => H.ExecConfig -- ^ Specifies the CLI execution configuration. + -> EpochStateView -- ^ Current epoch state view for transaction building. It can be obtained + -- using the 'getEpochStateView' function. + -> ConwayEraOnwards ConwayEra -- ^ The Shelley based era witness for ConwayEra onwards. + -> 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. + -> (String, Word32) -- ^ Tuple containing the preivous proposal transaction id and index. + -> t (Int, String) -- ^ Model of DRep votes for proposal, list of pairs with an amount + -- of votes and the and type of vote (i.e: "yes", "no", or "abstain"). + -> m (String, Word32) +testNoConfidenceProposal execConfig epochStateView ceo work prefix + wallet previousProposalInfo votes = do + baseDir <- H.createDirectoryIfMissing $ work prefix + + let propVotes :: [(String, Int)] + propVotes = zip (concatMap (uncurry replicate) votes) [1..] + annotateShow propVotes + + thisProposal@(governanceActionTxId, governanceActionIndex) <- + makeNoConfidenceProposal execConfig epochStateView ceo baseDir + "proposal" previousProposalInfo wallet + + voteChangeProposal execConfig epochStateView ceo baseDir "vote" + governanceActionTxId governanceActionIndex propVotes (zip (repeat "yes") [1..3]) wallet + + (EpochNo epochAfterProp) <- getCurrentEpochNo epochStateView + H.note_ $ "Epoch after \"" <> prefix <> "\" prop: " <> show epochAfterProp + + committee <- H.nothingFailM $ watchEpochStateView epochStateView (return . filterCommittee) (EpochInterval 1) + + H.note_ $ show committee + + return thisProposal + +makeNoConfidenceProposal + :: (H.MonadAssertion m, MonadTest m, MonadCatch m, MonadIO m, HasCallStack) + => H.ExecConfig + -> EpochStateView + -> ConwayEraOnwards ConwayEra + -> FilePath + -> String + -> (String, Word32) + -> PaymentKeyInfo + -> m (String, Word32) +makeNoConfidenceProposal execConfig epochStateView + ceo work prefix (prevGovernanceActionTxId, prevGovernanceActionIndex) 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-no-confidence" + , "--testnet" + , "--governance-action-deposit", show @Integer minDRepDeposit + , "--deposit-return-stake-verification-key-file", stakeVkeyFp + , "--prev-governance-action-tx-id", prevGovernanceActionTxId + , "--prev-governance-action-index", show prevGovernanceActionIndex + , "--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) 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 bd6bd73624c..8704f93a210 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 @@ -231,8 +231,7 @@ filterRatificationState c guardRailScriptHash (AnyNewEpochState sbe newEpochStat constitution = rState ^. Ledger.rsEnactStateL . Ledger.ensConstitutionL constitutionAnchorHash = Ledger.anchorDataHash $ Ledger.constitutionAnchor constitution L.ScriptHash constitutionScriptHash = fromMaybe (error "filterRatificationState: consitution does not have a guardrail script") - $ strictMaybeToMaybe $ constitution ^. Ledger.constitutionScriptL + $ strictMaybeToMaybe $ constitution ^. Ledger.constitutionScriptL Text.pack c == renderSafeHashAsHex constitutionAnchorHash && L.hashToTextAsHex constitutionScriptHash == Text.pack guardRailScriptHash - ) 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 aa47ff9755e..8edb1ecf059 100644 --- a/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs +++ b/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs @@ -17,6 +17,7 @@ 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.NoConfidence as Gov +import qualified Cardano.Testnet.Test.Gov.PredefinedNoConfidenceDRep as Gov import qualified Cardano.Testnet.Test.Gov.ProposeNewConstitution as Gov import qualified Cardano.Testnet.Test.Gov.ProposeNewConstitutionSPO as Gov import qualified Cardano.Testnet.Test.Gov.TreasuryGrowth as Gov @@ -53,7 +54,8 @@ tests = do -- 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 "Predefined No Confidence DRep" Gov.hprop_check_predefined_no_confidence_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 -- , ignoreOnWindows "InfoAction" LedgerEvents.hprop_ledger_events_info_action