diff --git a/cabal.project b/cabal.project index d0d53d59565..1943edcefe8 100644 --- a/cabal.project +++ b/cabal.project @@ -31,8 +31,8 @@ packages: trace-resources trace-forward -program-options - ghc-options: -Werror +-- program-options +-- ghc-options: -Werror test-show-details: direct diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index b287e03f916..9022db0f057 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -48,7 +48,7 @@ library , cardano-ledger-conway , cardano-ledger-core:{cardano-ledger-core, testlib} , cardano-ledger-shelley - , cardano-node + , cardano-node , cardano-ping ^>= 0.2.0.13 , contra-tracer , containers @@ -166,7 +166,7 @@ test-suite cardano-testnet-golden ghc-options: -threaded -rtsopts "-with-rtsopts=-N -T" - build-tool-depends: cardano-node:cardano-node + build-tool-depends: cardano-node:cardano-node , cardano-cli:cardano-cli , cardano-submit-api:cardano-submit-api , cardano-testnet:cardano-testnet @@ -199,6 +199,7 @@ test-suite cardano-testnet-test Cardano.Testnet.Test.Gov.GovActionTimeout Cardano.Testnet.Test.Gov.TreasuryGrowth Cardano.Testnet.Test.Gov.TreasuryWithdrawal + Cardano.Testnet.Test.Gov.UpdatePParam Cardano.Testnet.Test.Misc Cardano.Testnet.Test.Gov.DRepActivity Cardano.Testnet.Test.Gov.PredefinedAbstainDRep @@ -216,10 +217,12 @@ test-suite cardano-testnet-test , cardano-api:{cardano-api, internal} , cardano-cli , cardano-crypto-class + , cardano-ledger-api + , cardano-ledger-core , cardano-ledger-conway , cardano-ledger-core , cardano-ledger-shelley - , cardano-node + , cardano-node , cardano-slotting , cardano-strict-containers ^>= 0.1 , cardano-testnet @@ -243,7 +246,7 @@ test-suite cardano-testnet-test ghc-options: -threaded -rtsopts "-with-rtsopts=-N -T" - build-tool-depends: cardano-node:cardano-node + build-tool-depends: cardano-node:cardano-node , cardano-cli:cardano-cli , cardano-submit-api:cardano-submit-api , cardano-testnet:cardano-testnet diff --git a/cardano-testnet/src/Testnet/Defaults.hs b/cardano-testnet/src/Testnet/Defaults.hs index 4d232d3412f..0a7228a46d8 100644 --- a/cardano-testnet/src/Testnet/Defaults.hs +++ b/cardano-testnet/src/Testnet/Defaults.hs @@ -14,6 +14,10 @@ module Testnet.Defaults , defaultByronProtocolParamsJsonValue , defaultYamlConfig , defaultConwayGenesis + , defaultCommitteeHotAuthCertFp + , defaultCommitteeHotKeyPair + , defaultCommitteeHotVkeyFp + , defaultCommitteeHotSkeyFp , defaultCommitteeKeyPair , defaultCommitteeVkeyFp , defaultCommitteeSkeyFp @@ -26,6 +30,7 @@ module Testnet.Defaults , defaultSpoKeys , defaultShelleyGenesis , defaultGenesisFilepath + , defaultV3CostModel , defaultYamlHardforkViaConfig , defaultMainnetTopology , plutusV3NonSpendingScript @@ -60,6 +65,7 @@ import qualified Data.Aeson as Aeson import qualified Data.Aeson.Key as Key import qualified Data.Aeson.KeyMap as KeyMapAeson import qualified Data.Default.Class as DefaultClass +import qualified Data.Map.Strict as Map import Data.Maybe import Data.Proxy import Data.Ratio @@ -69,6 +75,7 @@ import qualified Data.Text as Text import Data.Time (UTCTime) import Data.Typeable import qualified Data.Vector as Vector +import GHC.Int import GHC.Stack import Lens.Micro import Numeric.Natural @@ -107,6 +114,76 @@ defaultAlonzoGenesis = do Nothing -> Left $ AlonzoGenErrTooMuchPrecision r Just s -> return s + maxTxExUnits = Api.toAlonzoExUnits + $ Api.ExecutionUnits + { Api.executionSteps = 100000000000 + , Api.executionMemory = 1400000000 + } + maxBlockExUnits = Api.toAlonzoExUnits + $ Api.ExecutionUnits + { Api.executionSteps = 20000000000 + , Api.executionMemory = 62000000 + } + apiCostModels = + let pv1 = Api.AnyPlutusScriptVersion Api.PlutusScriptV1 + pv2 = Api.AnyPlutusScriptVersion Api.PlutusScriptV2 + pv3 = Api.AnyPlutusScriptVersion Api.PlutusScriptV3 + in mconcat [ Map.singleton pv1 defaultV1CostModel + , Map.singleton pv2 defaultV2CostModel + , Map.singleton pv3 defaultV3CostModel + ] + defaultV1CostModel = Api.CostModel + [ 205665, 812, 1, 1, 1000, 571, 0, 1, 1000, 24177, 4, 1, 1000, 32, 117366, 102, 4 + , 23000, 100, 23000, 100, 23000, 100, 23000, 100, 23000, 100, 23000, 100, 100, 100 + , 23000, 100, 19537, 32, 175354, 32, 46417, 4, 221973, 511, 0, 1, 89141, 32, 497525 + , 14068, 4, 2, 196500, 453240, 220, 0, 1, 1, 1000, 28662, 4, 2, 245000, 216773, 62 + , 1, 1060367, 12586, 1, 208512, 421, 1, 187000, 1000, 52998, 1, 80436, 32, 43249, 32 + , 1000, 32, 80556, 1, 57667, 4, 1000, 10, 197145, 156, 1, 197145, 156, 1, 204924, 473 + , 1, 208896, 511, 1, 52467, 32, 64832, 32, 65493, 32, 22558, 32, 16563, 32, 76511, 32 + , 196500, 453240, 220, 0, 1, 1, 69522, 11687, 0, 1, 60091, 32, 196500, 453240, 220, 0 + , 1, 1, 196500, 453240, 220, 0, 1, 1, 806990, 30482, 4, 1927926, 82523, 4, 265318, 0 + , 4, 0, 85931, 32, 205665, 812, 1, 1, 41182, 32, 212342, 32, 31220, 32, 32696, 32, 43357 + , 32, 32247, 32, 38314, 32, 57996947, 18975, 10 + ] + defaultV2CostModel = Api.CostModel + [ 205665, 812, 1, 1, 1000, 571, 0, 1, 1000, 24177, 4, 1, 1000, 32, 117366, 10475, 4 + , 23000, 100, 23000, 100, 23000, 100, 23000, 100, 23000, 100, 23000, 100, 100, 100 + , 23000, 100, 19537, 32, 175354, 32, 46417, 4, 221973, 511, 0, 1, 89141, 32, 497525 + , 14068, 4, 2, 196500, 453240, 220, 0, 1, 1, 1000, 28662, 4, 2, 245000, 216773, 62 + , 1, 1060367, 12586, 1, 208512, 421, 1, 187000, 1000, 52998, 1, 80436, 32, 43249, 32 + , 1000, 32, 80556, 1, 57667, 4, 1000, 10, 197145, 156, 1, 197145, 156, 1, 204924, 473 + , 1, 208896, 511, 1, 52467, 32, 64832, 32, 65493, 32, 22558, 32, 16563, 32, 76511, 32 + , 196500, 453240, 220, 0, 1, 1, 69522, 11687, 0, 1, 60091, 32, 196500, 453240, 220, 0 + , 1, 1, 196500, 453240, 220, 0, 1, 1, 1159724, 392670, 0, 2, 806990, 30482, 4, 1927926 + , 82523, 4, 265318, 0, 4, 0, 85931, 32, 205665, 812, 1, 1, 41182, 32, 212342, 32, 31220 + , 32, 32696, 32, 43357, 32, 32247, 32, 38314, 32, 35892428, 10, 9462713, 1021, 10, 38887044 + , 32947, 10 + ] + + +-- | Proposing script (protocol parameter update) fails to execute unless this is set to 0 +cekStartupCost_exBudgetCPU :: Int64 +cekStartupCost_exBudgetCPU = 1 + +cekLamCost_exBudgetMemory :: Int64 +cekLamCost_exBudgetMemory = 1 + +defaultV3CostModel :: Api.CostModel +defaultV3CostModel = Api.CostModel + [ 205665, 812, 1, 1, 1000, 571, 0, 1, 1000, 24177, 4, 1, 1000, 32, 100, 10475, 4, 117366, 10475, 4, 103, 18 + , 3209094, 6, 331451, 1, 65990684, 23097, 19, cekStartupCost_exBudgetCPU, cekLamCost_exBudgetMemory, 107 + , 87060, 21, 16420089, 22, 2145798, 36, 3795345, 12, 889023, 1, 204237282, 23271, 36, 129165, 36, 189977790 + , 85902, 36, 33012864, 36, 388443360, 1, 401885761, 72, 2331379, 72, 23000, 100, 23000, 100, 23000, 100, 23000, 100, 23000 + , 100, 23000, 100, 23000, 100, 23000, 100, 100, 100, 23000, 100 + , 19537, 32, 175354, 32, 46417, 4, 221973, 511, 0, 1, 89141, 32, 497525, 14068, 4, 2, 196500, 453240, 220, 0, 1, 1, 1000, 28662 + , 4, 2, 245000, 216773, 62, 1, 1060367, 12586, 1, 208512, 421, 1, 187000, 1000, 52998, 1, 80436, 32 + , 43249, 1000, 32, 32, 80556, 1, 57667, 4, 1927926, 82523, 4, 1000, 10, 197145, 156, 1, 197145, 156, 1, 204924, 473, 1, 208896 + , 511, 1, 52467, 32, 64832, 32, 65493, 32, 22558, 32, 16563, 32, 76511, 32, 196500, 453240, 220, 0 + , 1, 1, 69522, 11687, 0, 1, 60091, 32, 196500, 453240, 220, 0, 1, 1, 196500, 453240, 220, 0, 1, 1, 1159724, 392670, 0, 2, 806990 + , 30482, 4, 1927926, 82523, 4, 265318, 0, 4, 0, 85931, 32, 205665, 812, 1, 1, 41182 + , 32, 212342, 32, 31220, 32, 32696, 32, 43357, 32, 32247, 32, 38314, 32, 35190005, 10, 57996947, 18975, 10, 39121781, 32260, 10 + ] + defaultConwayGenesis :: ConwayGenesis StandardCrypto defaultConwayGenesis = let upPParams :: UpgradeConwayPParams Identity @@ -115,8 +192,8 @@ defaultConwayGenesis = , ucppDRepVotingThresholds = drepVotingThresholds , ucppCommitteeMinSize = 0 , ucppCommitteeMaxTermLength = EpochInterval 200 - , ucppGovActionLifetime = EpochInterval 1 -- One Epoch - , ucppGovActionDeposit = Coin 1_000_000 + , ucppGovActionLifetime = EpochInterval 2 -- One Epoch + , ucppGovActionDeposit = Coin 2_000_000 , ucppDRepDeposit = Coin 1_000_000 , ucppDRepActivity = EpochInterval 100 , ucppMinFeeRefScriptCostPerByte = 0 %! 1 -- FIXME GARBAGE VALUE @@ -124,22 +201,22 @@ defaultConwayGenesis = } drepVotingThresholds = DRepVotingThresholds { dvtMotionNoConfidence = 0 %! 1 - , dvtCommitteeNormal = 1 %! 2 + , dvtCommitteeNormal = 0 %! 2 , dvtCommitteeNoConfidence = 0 %! 1 , dvtUpdateToConstitution = 0 %! 2 -- TODO: Requires a constitutional committee when non-zero - , dvtHardForkInitiation = 1 %! 2 - , dvtPPNetworkGroup = 1 %! 2 - , dvtPPEconomicGroup = 1 %! 2 - , dvtPPTechnicalGroup = 1 %! 2 - , dvtPPGovGroup = 1 %! 2 - , dvtTreasuryWithdrawal = 1 %! 2 + , dvtHardForkInitiation = 0 %! 2 + , dvtPPNetworkGroup = 0 %! 2 + , dvtPPEconomicGroup = 0 %! 2 + , dvtPPTechnicalGroup = 0 %! 2 + , dvtPPGovGroup = 0 %! 3 + , dvtTreasuryWithdrawal = 0 %! 2 } poolVotingThresholds = PoolVotingThresholds - { pvtMotionNoConfidence = 1 %! 2 - , pvtCommitteeNormal = 1 %! 2 - , pvtCommitteeNoConfidence = 1 %! 2 - , pvtHardForkInitiation = 1 %! 2 - , pvtPPSecurityGroup = 1 %! 2 + { pvtMotionNoConfidence = 0 %! 2 + , pvtCommitteeNormal = 0 %! 2 + , pvtCommitteeNoConfidence = 0 %! 2 + , pvtHardForkInitiation = 0 %! 2 + , pvtPPSecurityGroup = 0 %! 2 } in ConwayGenesis { cgUpgradePParams = upPParams @@ -523,13 +600,33 @@ defaultDRepSkeyFp -> FilePath defaultDRepSkeyFp n = "drep-keys" ("drep" <> show n) "drep.skey" -defaultCommitteeKeyPair :: Int -> KeyPair PaymentKey -defaultCommitteeKeyPair n = +defaultCommitteeKeyPair :: FilePath -> Int -> KeyPair CCColdKey +defaultCommitteeKeyPair work n = + KeyPair + { verificationKey = File $ work defaultCommitteeVkeyFp n + , signingKey = File $ work defaultCommitteeSkeyFp n + } + +defaultCommitteeHotKeyPair :: FilePath -> Int -> KeyPair CCHotKey +defaultCommitteeHotKeyPair work n = KeyPair - { verificationKey = File $ defaultCommitteeVkeyFp n - , signingKey = File $ defaultCommitteeSkeyFp n + { verificationKey = File $ work defaultCommitteeHotVkeyFp n + , signingKey = File $ work defaultCommitteeHotSkeyFp n } +defaultCommitteeHotAuthCertFp :: Int -> FilePath +defaultCommitteeHotAuthCertFp n = "committee-keys" "committee" <> show n <>"hot.auth" + +defaultCommitteeHotVkeyFp + :: Int -- ^ The Committee's index (starts at 1) + -> FilePath +defaultCommitteeHotVkeyFp n = "committee-keys" "committee" <> show n <> "hot.vkey" + +defaultCommitteeHotSkeyFp + :: Int -- ^ The Committee's index (starts at 1) + -> FilePath +defaultCommitteeHotSkeyFp n = "committee-keys" "committee" <> show n <> "hot.skey" + -- | The relative path to SPO cold verification key in directories created by cardano-testnet defaultSPOColdVKeyFp :: Int -> FilePath defaultSPOColdVKeyFp n = "pools-keys" "pool" <> show n "cold.vkey" diff --git a/cardano-testnet/src/Testnet/Process/Cli/DRep.hs b/cardano-testnet/src/Testnet/Process/Cli/DRep.hs index ad6eff60d8c..6bb7880d959 100644 --- a/cardano-testnet/src/Testnet/Process/Cli/DRep.hs +++ b/cardano-testnet/src/Testnet/Process/Cli/DRep.hs @@ -9,6 +9,7 @@ module Testnet.Process.Cli.DRep , generateRegistrationCertificate , createCertificatePublicationTxBody , generateVoteFiles + , generateVoteFilesCC , createVotingTxBody , registerDRep , delegateToDRep @@ -171,6 +172,36 @@ generateVoteFiles execConfig work prefix governanceActionTxId governanceActionIn ] return path +generateVoteFilesCC + :: MonadTest m + => MonadIO m + => MonadCatch m + => H.ExecConfig -- ^ Specifies the CLI execution configuration. + -> FilePath -- ^ Base directory path where the voting files and directories will be + -- stored. + -> String -- ^ Name for the subfolder that will be created under 'work' to store + -- the output voting files. + -> String -- ^ Transaction ID string of the governance action. + -> Word32 -- ^ Index of the governance action. + -> [(KeyPair CCHotKey, [Char])] -- ^ List of tuples where each tuple contains a 'PaymentKeyPair' + -- representing the DRep key pair and a 'String' representing the + -- vote type (i.e: "yes", "no", or "abstain"). + -> m [File VoteFile In] +generateVoteFilesCC execConfig work prefix governanceActionTxId governanceActionIndex allVotes = do + baseDir <- H.createDirectoryIfMissing $ work prefix + forM (zip [(1 :: Integer)..] allVotes) $ \(idx, (ccKeyPair, vote)) -> do + let path = File (baseDir "vote-hot-committee-" <> show idx) + void $ execCli' execConfig + [ "conway", "governance", "vote", "create" + , "--" ++ vote + , "--governance-action-tx-id", governanceActionTxId + , "--governance-action-index", show @Word32 governanceActionIndex + , "--cc-hot-verification-key-file", verificationKeyFp ccKeyPair + , "--out-file", unFile path + ] + return path + + -- | Composes a voting transaction body file using @cardano-cli@. -- For the transaction to be valid it needs witnesses corresponding -- to the spent UTxOs and votes issued (typically these witnesses are diff --git a/cardano-testnet/src/Testnet/Types.hs b/cardano-testnet/src/Testnet/Types.hs index db0c15a6182..2e56663339d 100644 --- a/cardano-testnet/src/Testnet/Types.hs +++ b/cardano-testnet/src/Testnet/Types.hs @@ -26,6 +26,8 @@ module Testnet.Types , VKey , SKey , ColdPoolKey + , CCColdKey + , CCHotKey , VrfKey , StakingKey , PaymentKey @@ -130,6 +132,8 @@ nodeSocketPath = File . H.sprocketSystemName . nodeSprocket data ColdPoolKey data StakingKey data SpoColdKey +data CCColdKey +data CCHotKey data PoolNodeKeys = PoolNodeKeys { poolNodeKeysCold :: KeyPair SpoColdKey @@ -142,6 +146,9 @@ data PaymentKeyInfo = PaymentKeyInfo , paymentKeyInfoAddr :: Text } deriving (Eq, Show) +data CommitteeMember = CommitteeMember + { ccPaymentKeyPair :: KeyPair CCColdKey } + data Delegator = Delegator { paymentKeyPair :: KeyPair PaymentKey , stakingKeyPair :: KeyPair StakingKey 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 47049cdb6f5..a586c23bdbc 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 @@ -241,7 +241,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. - H.nothingFailM $ watchEpochStateUpdate epochStateView (EpochInterval 10) (return . committeeIsPresent False) + H.nothingFailM $ watchEpochStateUpdate epochStateView (EpochInterval 15) (return . committeeIsPresent False) -- | Checks if the committee is empty or not. committeeIsPresent :: Bool -> (AnyNewEpochState, SlotNo, BlockNo) -> Maybe () diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/UpdatePParam.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/UpdatePParam.hs new file mode 100644 index 00000000000..9b1132d054f --- /dev/null +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/UpdatePParam.hs @@ -0,0 +1,370 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module Cardano.Testnet.Test.Gov.UpdatePParam + ( hprop_update_pparam + ) where + +import Cardano.Api as Api +import Cardano.Api.Ledger (EpochInterval (..)) +import qualified Cardano.Api.Ledger as L +import Cardano.Api.Shelley + +import qualified Cardano.Ledger.Api.State.Query as L +import qualified Cardano.Ledger.Conway.Governance as L +import qualified Cardano.Ledger.Conway.PParams as L +import qualified Cardano.Ledger.Shelley.LedgerState as L +import Cardano.Testnet + +import Prelude + +import Control.Monad +import Data.Aeson.Encode.Pretty (encodePretty) +import Data.Bifunctor (first) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BSC +import qualified Data.List as List +import qualified Data.Map.Strict as Map +import Data.Maybe +import qualified Data.Set as Set +import Data.String +import qualified Data.Text as Text +import Data.Word +import GHC.Stack +import Lens.Micro +import System.FilePath (()) + +import Testnet.Components.Configuration +import Testnet.Components.Query +import Testnet.Defaults +import Testnet.Process.Cli.DRep +import Testnet.Process.Cli.Keys +import Testnet.Process.Cli.Transaction +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 + +-- | Execute me with: +-- @DISABLE_RETRIES=1 cabal test cardano-testnet-test --test-options '-p "/Update PParams/"'@ +hprop_update_pparam :: Property +hprop_update_pparam = H.integrationWorkspace "pparam-update" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do + -- Start a local test net + conf@Conf { tempAbsPath } <- mkConf tempAbsBasePath' + let tempAbsPath' = unTmpAbsPath tempAbsPath + tempBaseAbsPath = makeTmpBaseAbsPath tempAbsPath + + work <- H.createDirectoryIfMissing $ tempAbsPath' "work" + let ceo = ConwayEraOnwardsConway + sbe = conwayEraOnwardsToShelleyBasedEra ceo + era = toCardanoEra sbe + cEra = AnyCardanoEra era + -- Generate model for votes + drepVotes :: [(String, Int)] + drepVotes = [("yes", 1), ("yes", 2), ("yes", 3)] + ccVotes :: [(String, Int)] + ccVotes = [("yes", 1)] + + -- SPOs dont votes on cc term limits + annotateShow drepVotes + + let numVotes :: Int + numVotes = length drepVotes + annotateShow numVotes + + guardRailScript <- H.note $ work "guard-rail-script.plutusV3" + H.writeFile guardRailScript $ Text.unpack plutusV3NonSpendingScript + execConfigOffline <- H.mkExecConfigOffline tempBaseAbsPath + + gov <- H.createDirectoryIfMissing $ work "governance" + + proposalAnchorFile <- H.note $ gov "sample-proposal-anchor" + H.writeFile proposalAnchorFile "dummy anchor data" + proposalAnchorDataBS <- evalIO $ BS.readFile proposalAnchorFile + proposalAnchorDataHash <- H.execCli' execConfigOffline + [ anyEraToString cEra, "governance" + , "hash", "anchor-data", "--file-text", proposalAnchorFile + ] + + -- TODO: Update help text for policyid. The script hash is not + -- only useful for minting scripts + constitutionScriptHash <- filter (/= '\n') <$> + H.execCli' execConfigOffline + [ anyEraToString cEra, "transaction" + , "policyid" + , "--script-file", guardRailScript + ] + + H.note_ $ "Constitution script hash: " <> constitutionScriptHash + + + -- Step 1. Define generate and define a committee in the genesis file + + -- Create committee cold key + hot key + H.createDirectoryIfMissing_ $ tempAbsPath' work "committee-keys" + H.forConcurrently_ [1] $ \n -> do + H.execCli' execConfigOffline + [ anyEraToString cEra, "governance", "committee" + , "key-gen-cold" + , "--cold-verification-key-file", work defaultCommitteeVkeyFp n + , "--cold-signing-key-file", work defaultCommitteeSkeyFp n + ] + + void $ H.execCli' execConfigOffline + [ anyEraToString cEra, "governance", "committee" + , "key-gen-hot" + , "--verification-key-file", work defaultCommitteeHotVkeyFp 1 + , "--signing-key-file", work defaultCommitteeHotSkeyFp 1 + ] + + hotKeyHash1 <- H.execCli' execConfigOffline + [ anyEraToString cEra, "governance", "committee" + , "key-hash" + , "--verification-key-file", work defaultCommitteeHotVkeyFp 1 + ] + + CommitteeHotKeyHash comHotKeyHash1 <- + evalEither + $ deserialiseFromRawBytesHex (AsHash AsCommitteeHotKey) + $ BSC.pack $ filter (/= '\n') hotKeyHash1 + + let comHotKeyCred1 = L.KeyHashObj comHotKeyHash1 + + void $ H.execCli' execConfigOffline + [ anyEraToString cEra, "governance", "committee" + , "create-hot-key-authorization-certificate" + , "--cold-verification-key-file", work defaultCommitteeVkeyFp 1 + , "--hot-key-file", work defaultCommitteeHotVkeyFp 1 + , "--out-file", work defaultCommitteeHotAuthCertFp 1 + ] + + committeeVkey1Fp <- H.noteShow $ work defaultCommitteeVkeyFp 1 + committeeAuthCert1Fp <- H.noteShow $ work defaultCommitteeHotAuthCertFp 1 + + -- Read committee cold keys from disk to put into conway genesis + + comKeyHash1Str <- filter (/= '\n') <$> H.execCli' execConfigOffline + [ anyEraToString cEra, "governance", "committee" + , "key-hash" + , "--verification-key-file", committeeVkey1Fp + ] + + CommitteeColdKeyHash comKeyHash1 <- + evalEither + $ deserialiseFromRawBytesHex (AsHash AsCommitteeColdKey) + $ BSC.pack comKeyHash1Str + + let comKeyCred1 = L.KeyHashObj comKeyHash1 + committeeThreshold = unsafeBoundedRational 0 --0.4 + committee = L.Committee (Map.fromList [(comKeyCred1, EpochNo 100)]) committeeThreshold + + + + url <- evalMaybe $ L.textToUrl 28 "https://tinyurl.com/3wrwb2as" + let fastTestnetOptions = cardanoDefaultTestnetOptions + { cardanoEpochLength = 100 + , cardanoNodeEra = cEra + , cardanoNumDReps = numVotes + } + anchor = createAnchor url $ BSC.concat [proposalAnchorDataBS, BSC.pack "more"] + ScriptHash cScriptHash = fromString constitutionScriptHash + constitution = L.Constitution anchor $ L.SJust cScriptHash + + alonzoGenesis <- evalEither $ first prettyError defaultAlonzoGenesis + (startTime, shelleyGenesis') <- getDefaultShelleyGenesis fastTestnetOptions + let conwayGenesisWithCommittee = + defaultConwayGenesis { L.cgConstitution = constitution + , L.cgCommittee = committee + } + + TestnetRuntime + { testnetMagic + , poolNodes + , wallets=wallet0:_wallet1:_ + , configurationFile + } <- cardanoTestnet + fastTestnetOptions + conf startTime shelleyGenesis' + alonzoGenesis conwayGenesisWithCommittee + + 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 + + waitedTill <- waitForEpochs epochStateView (EpochInterval 3) + H.noteShow_ $ "Should be epoch 4: " <> show waitedTill + + let stakeVkeyFp = gov "stake.vkey" + stakeSKeyFp = gov "stake.skey" + + cliStakeAddressKeyGen + $ KeyPair { verificationKey = File stakeVkeyFp + , signingKey = File stakeSKeyFp + } + + -- Attempt a protocol parameters update (witnessed with guard rail script) + let newCommitteeTermLength = 20 + pparamsUpdateFp <- H.note $ work "protocol-parameters-upate.action" + void $ H.execCli' execConfig + [ anyEraToString cEra, "governance", "action", "create-protocol-parameters-update" + , "--testnet" + , "--governance-action-deposit", show @Int 2_000_000 -- TODO: retrieve this from conway genesis. + , "--deposit-return-stake-verification-key-file", stakeVkeyFp + , "--anchor-url", "https://tinyurl.com/3wrwb2as" + , "--anchor-data-hash", proposalAnchorDataHash + , "--constitution-script-hash", constitutionScriptHash + , "--committee-term-length", show @Word32 newCommitteeTermLength + , "--out-file", pparamsUpdateFp + ] + + updateProposalTxBody <- H.note $ work "update-proposal.txbody" + txin4 <- findLargestUtxoForPaymentKey epochStateView sbe wallet0 + utxo <- findAllUtxos epochStateView sbe + + let utxoJSON1 = encodePretty utxo + H.lbsWriteFile (work "utxo1.json") utxoJSON1 + H.noteShow_ (work "utxo1.json") + + let relevantValue = fromMaybe mempty ((\(TxOut _ txVal _ _) -> txOutValueToValue txVal) <$> Map.lookup txin4 utxo) + adaAtInput = L.unCoin $ selectLovelace relevantValue + + + H.noteShow_ adaAtInput + protocolParametersFile <- H.note $ work "protocol-parameters.json" + void $ H.execCli' execConfig + [ anyEraToString cEra, "query", "protocol-parameters" + , "--out-file", protocolParametersFile + ] + + utxo2 <- findAllUtxos epochStateView sbe + let utxoJSON2 = encodePretty utxo2 + H.lbsWriteFile (work "utxo2.json") utxoJSON2 + H.noteShow_ (work "utxo2.json") + + void $ H.execCli' execConfig + [ anyEraToString cEra, "transaction", "build-estimate" + , "--shelley-key-witnesses", show @Int 2 + , "--total-utxo-value", show @Integer adaAtInput + , "--change-address", Text.unpack $ paymentKeyInfoAddr wallet0 + , "--protocol-params-file", protocolParametersFile + , "--tx-in", Text.unpack $ renderTxIn txin4 + , "--tx-in-collateral", Text.unpack $ renderTxIn txin4 + , "--tx-out", Text.unpack (paymentKeyInfoAddr wallet0) <> "+" <> show @Int 3_000_001 + , "--proposal-file", pparamsUpdateFp + , "--proposal-script-file", guardRailScript + , "--proposal-redeemer-value", "0" + , "--proposal-execution-units", "(2000000,20000000)" + , "--certificate-file", committeeAuthCert1Fp + , "--out-file", updateProposalTxBody + ] + + updateProposalTx <- H.note $ work "update-proposal.tx" + + signedPParamsProposalTx <- signTx execConfig cEra work updateProposalTx + (File updateProposalTxBody) + [ SomeKeyPair (paymentKeyInfoPair wallet0) + , SomeKeyPair (defaultCommitteeKeyPair work 1) + ] + + + void $ H.execCli' execConfig + [ anyEraToString cEra, "transaction", "submit" + , "--tx-file", unFile signedPParamsProposalTx + ] + + -- Need to vote on proposal. Drep threshold must be met + governanceActionTxIdPParamUpdate <- retrieveTransactionId execConfig signedPParamsProposalTx + + !governanceActionIndexPParams + <- H.nothingFailM $ watchEpochStateUpdate + epochStateView + (EpochInterval 5) + (\(eState, _, _) -> return $ maybeExtractGovernanceActionIndex (fromString governanceActionTxIdPParamUpdate) eState) + + -- Confirm that committee hot keys have been authorized + H.nothingFailM $ watchEpochStateUpdate epochStateView + (EpochInterval 5) + (\(eState, _, _) -> checkCommitteeHotKeyAuthorizationStatus [comHotKeyCred1] eState) + + -- Proposal was successfully submitted, now we vote on the proposal and confirm it was ratified + pparamsDRepVoteFiles <- generateVoteFiles execConfig work "pparams-update-vote-files" + governanceActionTxIdPParamUpdate governanceActionIndexPParams + [(defaultDRepKeyPair idx, vote) | (vote, idx) <- drepVotes] + + pparamsCCVoteFiles <- generateVoteFilesCC execConfig work "pparams-update-cc-vote-files" + governanceActionTxIdPParamUpdate governanceActionIndexPParams + [(defaultCommitteeHotKeyPair work idx, vote) | (vote, idx) <- ccVotes] + + -- Submit votes + pparamsVoteTxBodyFp <- createVotingTxBody execConfig epochStateView sbe work "pparams-vote-tx-body" + (pparamsDRepVoteFiles ++ pparamsCCVoteFiles) wallet0 + + let drepSigningKeys :: [SomeKeyPair] + drepSigningKeys = map SomeKeyPair $ defaultDRepKeyPair . snd <$> drepVotes + + ccSigningKeys :: [SomeKeyPair] + ccSigningKeys = map SomeKeyPair $ defaultCommitteeHotKeyPair work . snd <$> ccVotes + + utxoSigningKey = SomeKeyPair $ paymentKeyInfoPair wallet0 + + signingKeys = [utxoSigningKey] ++ drepSigningKeys ++ ccSigningKeys + + pparamsVoteTxFp <- signTx execConfig cEra work "signed-vote-tx" pparamsVoteTxBodyFp signingKeys + submitTx execConfig cEra pparamsVoteTxFp + + H.nothingFailM $ watchEpochStateUpdate epochStateView + (EpochInterval 10) + (\(eState, _, _) -> return $ checkPParamsUpdated (EpochInterval newCommitteeTermLength) eState) + +checkPParamsUpdated + :: EpochInterval -- ^ The epoch interval to check for in the updated protocol parameters + -> AnyNewEpochState + -> Maybe () +checkPParamsUpdated committeeTermLength (AnyNewEpochState sbe nes) = + let curCommTermLength :: EpochInterval + curCommTermLength = caseShelleyToBabbageOrConwayEraOnwards + (const $ error "Committee max term length only exists in Conway era onwards") + (const $ nes ^. L.newEpochStateGovStateL . L.cgsCurPParamsL . L.ppCommitteeMaxTermLengthL) + sbe + in if curCommTermLength == committeeTermLength + then Just () -- PParams was successfully updated and we terminate the fold. + else Nothing -- PParams was not updated yet, we continue the fold. + +checkCommitteeHotKeyAuthorizationStatus + :: MonadTest m + => [L.Credential L.HotCommitteeRole L.StandardCrypto] + -> AnyNewEpochState + -> m (Maybe ()) +checkCommitteeHotKeyAuthorizationStatus hotCreds (AnyNewEpochState sbe nes) = + caseShelleyToBabbageOrConwayEraOnwards + (const $ error "Committee hot key authorization only exists in Conway era onwards") + (const $ + let commMemStat = L.queryCommitteeMembersState mempty (Set.fromList hotCreds) (Set.singleton L.Active) nes + activeMembers = [ hotKeyCred + | L.MemberAuthorized hotKeyCred <- map L.cmsHotCredAuthStatus $ Map.elems $ L.csCommittee commMemStat + ] + unregisteredHotKeys = hotCreds List.\\ activeMembers + in if null activeMembers + then return Nothing + else if null unregisteredHotKeys + then return $ Just () + else H.failMessage callStack + $ "Some hot keys were not authorized: " <> show unregisteredHotKeys + + ) + 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 0abd882d754..ec8433aa181 100644 --- a/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs +++ b/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs @@ -23,6 +23,7 @@ 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 import qualified Cardano.Testnet.Test.Gov.TreasuryWithdrawal as Gov +import qualified Cardano.Testnet.Test.Gov.UpdatePParam as Gov import qualified Cardano.Testnet.Test.Node.Shutdown import qualified Cardano.Testnet.Test.SanityCheck as LedgerEvents import qualified Cardano.Testnet.Test.SubmitApi.Babbage.Transaction @@ -56,6 +57,7 @@ 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 "Update PParams" Gov.hprop_update_pparam , ignoreOnWindows "DRep Deposits" Gov.hprop_ledger_events_drep_deposits , ignoreOnWindows "DRep Retirement" Gov.hprop_drep_retirement , ignoreOnMacAndWindows "Propose And Ratify New Constitution" Gov.hprop_ledger_events_propose_new_constitution