diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index e180f6645c6..65dc8812e7e 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -183,30 +183,31 @@ test-suite cardano-testnet-test main-is: cardano-testnet-test.hs - other-modules: Cardano.Testnet.Test.Cli.LeadershipSchedule - Cardano.Testnet.Test.Cli.StakeSnapshot - Cardano.Testnet.Test.Cli.Transaction - Cardano.Testnet.Test.Cli.Conway.Plutus + other-modules: Cardano.Testnet.Test.Cli.Conway.Plutus Cardano.Testnet.Test.Cli.Conway.StakeSnapshot Cardano.Testnet.Test.Cli.KesPeriodInfo + Cardano.Testnet.Test.Cli.LeadershipSchedule Cardano.Testnet.Test.Cli.Query Cardano.Testnet.Test.Cli.QuerySlotNumber + Cardano.Testnet.Test.Cli.StakeSnapshot + Cardano.Testnet.Test.Cli.Transaction + Cardano.Testnet.Test.Cli.Transaction.RegisterDeregisterStakeAddress Cardano.Testnet.Test.FoldEpochState Cardano.Testnet.Test.Gov.CommitteeAddNew Cardano.Testnet.Test.Gov.DRepActivity Cardano.Testnet.Test.Gov.DRepDeposit Cardano.Testnet.Test.Gov.DRepRetirement + Cardano.Testnet.Test.Gov.GovActionTimeout Cardano.Testnet.Test.Gov.InfoAction Cardano.Testnet.Test.Gov.NoConfidence Cardano.Testnet.Test.Gov.PParamChangeFailsSPO + Cardano.Testnet.Test.Gov.PredefinedAbstainDRep Cardano.Testnet.Test.Gov.ProposeNewConstitution Cardano.Testnet.Test.Gov.ProposeNewConstitutionSPO - Cardano.Testnet.Test.Gov.GovActionTimeout Cardano.Testnet.Test.Gov.TreasuryDonation Cardano.Testnet.Test.Gov.TreasuryGrowth Cardano.Testnet.Test.Gov.TreasuryWithdrawal Cardano.Testnet.Test.Misc - Cardano.Testnet.Test.Gov.PredefinedAbstainDRep Cardano.Testnet.Test.Node.Shutdown Cardano.Testnet.Test.SanityCheck Cardano.Testnet.Test.SubmitApi.Transaction diff --git a/cardano-testnet/src/Testnet/Components/Query.hs b/cardano-testnet/src/Testnet/Components/Query.hs index b4ce6aec66e..b17d5a04641 100644 --- a/cardano-testnet/src/Testnet/Components/Query.hs +++ b/cardano-testnet/src/Testnet/Components/Query.hs @@ -37,6 +37,7 @@ module Testnet.Components.Query , checkDRepState , assertNewEpochState , getGovActionLifetime + , getKeyDeposit ) where import Cardano.Api as Api @@ -48,7 +49,6 @@ import Cardano.Ledger.Api (ConwayGovState) import qualified Cardano.Ledger.Api as L import qualified Cardano.Ledger.Coin as L import qualified Cardano.Ledger.Conway.Governance as L -import Cardano.Ledger.Conway.PParams (ConwayEraPParams) import qualified Cardano.Ledger.Conway.PParams as L import qualified Cardano.Ledger.Shelley.LedgerState as L import qualified Cardano.Ledger.UTxO as L @@ -571,11 +571,22 @@ assertNewEpochState epochStateView sbe maxWait lens expected = withFrozenCallSta -- The @govActionLifetime@ or governance action maximum lifetime in epochs is -- the number of epochs such that a governance action submitted during an epoch @e@ -- expires if it is still not ratified as of the end of epoch: @e + govActionLifetime + 1@. -getGovActionLifetime :: (ConwayEraPParams (ShelleyLedgerEra era), H.MonadAssertion m, MonadTest m, MonadIO m) +getGovActionLifetime :: (H.MonadAssertion m, MonadTest m, MonadIO m) => EpochStateView -> ConwayEraOnwards era -> m EpochInterval -getGovActionLifetime epochStateView ceo = do +getGovActionLifetime epochStateView ceo = conwayEraOnwardsConstraints ceo $ do govState :: ConwayGovState era <- getGovState epochStateView ceo return $ govState ^. L.cgsCurPParamsL . L.ppGovActionLifetimeL + +-- | Obtains the key registration deposit from the protocol parameters. +getKeyDeposit :: (H.MonadAssertion m, MonadTest m, MonadIO m) + => EpochStateView + -> ConwayEraOnwards era + -> m L.Coin +getKeyDeposit epochStateView ceo = conwayEraOnwardsConstraints ceo $ do + govState :: ConwayGovState era <- getGovState epochStateView ceo + return $ govState ^. L.cgsCurPParamsL + . L.ppKeyDepositL + diff --git a/cardano-testnet/src/Testnet/Defaults.hs b/cardano-testnet/src/Testnet/Defaults.hs index 0c7176abcce..0511cd77417 100644 --- a/cardano-testnet/src/Testnet/Defaults.hs +++ b/cardano-testnet/src/Testnet/Defaults.hs @@ -44,7 +44,6 @@ import qualified Cardano.Api.Shelley as Api import Cardano.Ledger.Alonzo.Core (PParams (..)) import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis) import qualified Cardano.Ledger.Alonzo.Genesis as Ledger -import qualified Cardano.Ledger.Api as L import Cardano.Ledger.BaseTypes import qualified Cardano.Ledger.BaseTypes as Ledger import Cardano.Ledger.Binary.Version () @@ -388,8 +387,7 @@ defaultShelleyGenesis asbe startTime maxSupply options = do -- TODO: find out why this actually degrates network stability - turned off for now -- securityParam = ceiling $ fromIntegral epochLength * cardanoActiveSlotsCoeff / 10 pVer = eraToProtocolVersion asbe - -- TODO: Remove after merging https://github.com/IntersectMBO/cardano-node/pull/6017 - protocolParams = Api.sgProtocolParams Api.shelleyGenesisDefaults & L.ppKeyDepositL .~ 0 + protocolParams = Api.sgProtocolParams Api.shelleyGenesisDefaults protocolParamsWithPVer = protocolParams & ppProtocolVersionL' .~ pVer Api.shelleyGenesisDefaults { Api.sgActiveSlotsCoeff = unsafeBoundedRational activeSlotsCoeff diff --git a/cardano-testnet/src/Testnet/Process/Cli/DRep.hs b/cardano-testnet/src/Testnet/Process/Cli/DRep.hs index eb877002a6b..e24d67e4d00 100644 --- a/cardano-testnet/src/Testnet/Process/Cli/DRep.hs +++ b/cardano-testnet/src/Testnet/Process/Cli/DRep.hs @@ -17,6 +17,7 @@ module Testnet.Process.Cli.DRep ) where import Cardano.Api hiding (Certificate, TxBody) +import Cardano.Api.Experimental (Some (..)) import Cardano.Api.Ledger (EpochInterval (EpochInterval, unEpochInterval)) import Cardano.Testnet (maybeExtractGovernanceActionIndex) @@ -239,7 +240,7 @@ registerDRep execConfig epochStateView ceo work prefix wallet = do drepRegTxBody <- createCertificatePublicationTxBody execConfig epochStateView sbe baseDir "reg-cert-txbody" drepRegCert wallet drepSignedRegTx <- signTx execConfig cEra baseDir "signed-reg-tx" - drepRegTxBody [SomeKeyPair drepKeyPair, SomeKeyPair $ paymentKeyInfoPair wallet] + drepRegTxBody [Some drepKeyPair, Some $ paymentKeyInfoPair wallet] submitTx execConfig cEra drepSignedRegTx return drepKeyPair @@ -286,8 +287,8 @@ delegateToDRep execConfig epochStateView sbe work prefix -- Sign transaction repRegSignedRegTx1 <- signTx execConfig cEra baseDir "signed-reg-tx" - repRegTxBody1 [ SomeKeyPair $ paymentKeyInfoPair payingWallet - , SomeKeyPair skeyPair] + repRegTxBody1 [ Some $ paymentKeyInfoPair payingWallet + , Some skeyPair] -- Submit transaction submitTx execConfig cEra repRegSignedRegTx1 @@ -398,7 +399,7 @@ makeActivityChangeProposal execConfig epochStateView ceo work ] signedProposalTx <- signTx execConfig cEra baseDir "signed-proposal" - (File proposalBody) [SomeKeyPair $ paymentKeyInfoPair wallet] + (File proposalBody) [Some $ paymentKeyInfoPair wallet] submitTx execConfig cEra signedProposalTx diff --git a/cardano-testnet/src/Testnet/Process/Cli/SPO.hs b/cardano-testnet/src/Testnet/Process/Cli/SPO.hs index 39a5f199429..e2e7ebc2887 100644 --- a/cardano-testnet/src/Testnet/Process/Cli/SPO.hs +++ b/cardano-testnet/src/Testnet/Process/Cli/SPO.hs @@ -52,10 +52,10 @@ checkStakePoolRegistered :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) => TmpAbsolutePath -> ExecConfig - -> FilePath -- ^ Stake pool cold verification key file + -> File (VKey StakeKey) In -- ^ Stake pool cold verification key file -> FilePath -- ^ Output file path of stake pool info -> m String -- ^ Stake pool ID -checkStakePoolRegistered tempAbsP execConfig poolColdVkeyFp outputFp = +checkStakePoolRegistered tempAbsP execConfig (File poolColdVkeyFp) outputFp = GHC.withFrozenCallStack $ do let tempAbsPath' = unTmpAbsPath tempAbsP oFpAbs = tempAbsPath' outputFp @@ -160,11 +160,11 @@ createStakeDelegationCertificate :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) => TmpAbsolutePath -> ShelleyBasedEra era - -> FilePath -- ^ Delegate stake verification key file + -> File (VKey StakeKey) In -- ^ Delegate stake verification key file -> String -- ^ Pool id -> FilePath -> m () -createStakeDelegationCertificate tempAbsP sbe delegatorStakeVerKey poolId outputFp = +createStakeDelegationCertificate tempAbsP sbe (File delegatorStakeVerKey) poolId outputFp = GHC.withFrozenCallStack $ do let tempAbsPath' = unTmpAbsPath tempAbsP execCli_ @@ -179,12 +179,11 @@ createStakeKeyRegistrationCertificate :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) => TmpAbsolutePath -> AnyShelleyBasedEra - -> FilePath -- ^ Stake verification key file - -> Int -- ^ deposit amount used only in Conway + -> File (VKey StakeKey) In -- ^ Stake verification key file + -> L.Coin -- ^ deposit amount used only in Conway -> FilePath -- ^ Output file path -> m () -createStakeKeyRegistrationCertificate tempAbsP asbe stakeVerKey deposit outputFp = GHC.withFrozenCallStack $ do - AnyShelleyBasedEra sbe <- return asbe +createStakeKeyRegistrationCertificate tempAbsP (AnyShelleyBasedEra sbe) (File stakeVerKey) (L.Coin deposit) outputFp = GHC.withFrozenCallStack $ do let tempAbsPath' = unTmpAbsPath tempAbsP extraArgs = monoidForEraInEon @ConwayEraOnwards (toCardanoEra sbe) $ const ["--key-reg-deposit-amt", show deposit] @@ -201,10 +200,10 @@ createScriptStakeRegistrationCertificate => TmpAbsolutePath -> AnyCardanoEra -> FilePath -- ^ Script file - -> Int -- ^ Registration deposit amount used only in Conway + -> L.Coin -- ^ Registration deposit amount used only in Conway -> FilePath -- ^ Output file path -> m () -createScriptStakeRegistrationCertificate tempAbsP (AnyCardanoEra cEra) scriptFile deposit outputFp = +createScriptStakeRegistrationCertificate tempAbsP (AnyCardanoEra cEra) scriptFile (L.Coin deposit) outputFp = GHC.withFrozenCallStack $ do let tempAbsPath' = unTmpAbsPath tempAbsP extraArgs = monoidForEraInEon @ConwayEraOnwards cEra $ @@ -221,11 +220,11 @@ createStakeKeyDeregistrationCertificate :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) => TmpAbsolutePath -> ShelleyBasedEra era - -> FilePath -- ^ Stake verification key file - -> Int -- ^ deposit amount used only in Conway + -> File (VKey StakeKey) In -- ^ Stake verification key file + -> L.Coin -- ^ deposit amount used only in Conway -> FilePath -- ^ Output file path -> m () -createStakeKeyDeregistrationCertificate tempAbsP sbe stakeVerKey deposit outputFp = +createStakeKeyDeregistrationCertificate tempAbsP sbe (File stakeVerKey) (L.Coin deposit) outputFp = GHC.withFrozenCallStack $ do let tempAbsPath' = unTmpAbsPath tempAbsP extraArgs = monoidForEraInEon @ConwayEraOnwards (toCardanoEra sbe) $ @@ -248,21 +247,18 @@ registerSingleSpo -> SocketPath -> EpochNo -- ^ Termination epoch -> Int -- ^ Testnet magic + -> L.Coin -- ^ key deposit -> ExecConfig - -> (TxIn, FilePath, String) + -> (TxIn, File (SKey PaymentKey) In, String) -> m ( String - , FilePath - , FilePath - , FilePath - , FilePath + , KeyPair StakeKey + , KeyPair VrfKey ) -- ^ Result tuple: -- 1. String: Registered stake pool ID - -- 2. FilePath: Stake pool cold signing key - -- 3. FilePath: Stake pool cold verification key - -- 4. FilePath: Stake pool VRF signing key - -- 5. FilePath: Stake pool VRF verification key -registerSingleSpo asbe identifier tap@(TmpAbsolutePath tempAbsPath') nodeConfigFile socketPath termEpoch testnetMag execConfig - (fundingInput, fundingSigninKey, changeAddr) = GHC.withFrozenCallStack $ do + -- 2. Stake pool cold keys + -- 3. Stake pool VRF keys +registerSingleSpo asbe identifier tap@(TmpAbsolutePath tempAbsPath') nodeConfigFile socketPath termEpoch testnetMag keyDeposit execConfig + (fundingInput, File fundingSigninKey, changeAddr) = GHC.withFrozenCallStack $ do workDir <- H.note tempAbsPath' -- In order to register a stake pool we need two certificates: @@ -276,48 +272,53 @@ registerSingleSpo asbe identifier tap@(TmpAbsolutePath tempAbsPath') nodeConfigF let spoReqDir = workDir "spo-"<> show identifier <> "-requirements" H.createDirectoryIfMissing_ spoReqDir - let poolOwnerstakeVkeyFp = spoReqDir "pool-owner-stake.vkey" - poolOwnerstakeSKeyFp = spoReqDir "pool-owner-stake.skey" + let poolOwnerStakeKeys = KeyPair + { verificationKey = File $ spoReqDir "pool-owner-stake.vkey" + , signingKey = File $ spoReqDir "pool-owner-stake.skey" + } - cliStakeAddressKeyGen - $ KeyPair (File poolOwnerstakeVkeyFp) (File poolOwnerstakeSKeyFp) + cliStakeAddressKeyGen poolOwnerStakeKeys poolownerstakeaddr <- filter (/= '\n') <$> execCli [ "latest", "stake-address", "build" - , "--stake-verification-key-file", poolOwnerstakeVkeyFp + , "--stake-verification-key-file", verificationKeyFp poolOwnerStakeKeys , "--testnet-magic", show @Int testnetMag ] -- 2. Generate stake pool owner payment key pair - let poolOwnerPaymentVkeyFp = spoReqDir "pool-owner-payment.vkey" - poolOwnerPaymentSkeyFp = spoReqDir "pool-owner-payment.skey" - cliAddressKeyGen - $ KeyPair (File poolOwnerPaymentVkeyFp) (File poolOwnerPaymentSkeyFp) + let poolOwnerPaymentKeys = KeyPair + { verificationKey = File $ spoReqDir "pool-owner-payment.vkey" + , signingKey = File $ spoReqDir "pool-owner-payment.skey" + } + cliAddressKeyGen poolOwnerPaymentKeys poolowneraddresswstakecred <- execCli [ "latest", "address", "build" - , "--payment-verification-key-file", poolOwnerPaymentVkeyFp - , "--stake-verification-key-file", poolOwnerstakeVkeyFp + , "--payment-verification-key-file", verificationKeyFp poolOwnerPaymentKeys + , "--stake-verification-key-file", verificationKeyFp poolOwnerStakeKeys , "--testnet-magic", show @Int testnetMag ] -- 3. Generate pool cold keys - let poolColdVkeyFp = spoReqDir "pool-cold.vkey" - poolColdSkeyFp = spoReqDir "pool-cold.skey" + let poolColdKeys = KeyPair + { verificationKey = File $ spoReqDir "pool-cold.vkey" + , signingKey = File $ spoReqDir "pool-cold.skey" + } execCli_ [ "latest", "node", "key-gen" - , "--cold-verification-key-file", poolColdVkeyFp - , "--cold-signing-key-file", poolColdSkeyFp + , "--cold-verification-key-file", verificationKeyFp poolColdKeys + , "--cold-signing-key-file", signingKeyFp poolColdKeys , "--operational-certificate-issue-counter-file", spoReqDir "operator.counter" ] -- 4. Generate VRF keys - let vrfVkeyFp = spoReqDir "pool-vrf.vkey" - vrfSkeyFp = spoReqDir "pool-vrf.skey" - cliNodeKeyGenVrf - $ KeyPair (File vrfVkeyFp) (File vrfSkeyFp) + let vrfKeys = KeyPair + { verificationKey = File $ spoReqDir "pool-vrf.vkey" + , signingKey = File $ spoReqDir "pool-vrf.skey" + } + cliNodeKeyGenVrf vrfKeys -- 5. Create registration certificate let poolRegCertFp = spoReqDir "registration.cert" @@ -330,10 +331,10 @@ registerSingleSpo asbe identifier tap@(TmpAbsolutePath tempAbsPath') nodeConfigF , "--pool-pledge", "0" , "--pool-cost", "0" , "--pool-margin", "0" - , "--cold-verification-key-file", poolColdVkeyFp - , "--vrf-verification-key-file", vrfVkeyFp - , "--reward-account-verification-key-file", poolOwnerstakeVkeyFp - , "--pool-owner-stake-verification-key-file", poolOwnerstakeVkeyFp + , "--cold-verification-key-file", verificationKeyFp poolColdKeys + , "--vrf-verification-key-file", verificationKeyFp vrfKeys + , "--reward-account-verification-key-file", verificationKeyFp poolOwnerStakeKeys + , "--pool-owner-stake-verification-key-file", verificationKeyFp poolOwnerStakeKeys , "--out-file", poolRegCertFp ] @@ -341,10 +342,9 @@ registerSingleSpo asbe identifier tap@(TmpAbsolutePath tempAbsPath') nodeConfigF -- NB: Pledger and owner can be the same -- Create pledger registration certificate - createStakeKeyRegistrationCertificate tap asbe - poolOwnerstakeVkeyFp - 0 + (verificationKey poolOwnerStakeKeys) + keyDeposit (workDir "pledger.regcert") void $ execCli' execConfig @@ -366,8 +366,8 @@ registerSingleSpo asbe identifier tap@(TmpAbsolutePath tempAbsPath') nodeConfigF , "--tx-body-file", workDir "pledge-registration-cert.txbody" , "--testnet-magic", show @Int testnetMag , "--signing-key-file", fundingSigninKey - , "--signing-key-file", poolOwnerstakeSKeyFp - , "--signing-key-file", poolColdSkeyFp + , "--signing-key-file", signingKeyFp poolOwnerStakeKeys + , "--signing-key-file", signingKeyFp poolColdKeys , "--out-file", pledgeAndPoolRegistrationTx ] @@ -398,9 +398,9 @@ registerSingleSpo asbe identifier tap@(TmpAbsolutePath tempAbsPath') nodeConfigF poolId <- checkStakePoolRegistered tap execConfig - poolColdVkeyFp + (verificationKey poolColdKeys) currentRegistedPoolsJson - return (poolId, poolColdSkeyFp, poolColdVkeyFp, vrfSkeyFp, vrfVkeyFp) + return (poolId, poolColdKeys, vrfKeys) -- | Generates Stake Pool Operator (SPO) voting files, using @cardano-cli@. -- diff --git a/cardano-testnet/src/Testnet/Process/Cli/Transaction.hs b/cardano-testnet/src/Testnet/Process/Cli/Transaction.hs index 6f4e691ac81..1c134b6c07f 100644 --- a/cardano-testnet/src/Testnet/Process/Cli/Transaction.hs +++ b/cardano-testnet/src/Testnet/Process/Cli/Transaction.hs @@ -15,6 +15,7 @@ module Testnet.Process.Cli.Transaction ) where import Cardano.Api hiding (Certificate, TxBody) +import Cardano.Api.Experimental (Some (..)) import Cardano.Api.Ledger (Coin (unCoin)) import Prelude @@ -146,14 +147,14 @@ signTx -> FilePath -- ^ Base directory path where the signed transaction file will be stored. -> String -- ^ Prefix for the output signed transaction file name. The extension will be @.tx@. -> File TxBody In -- ^ Transaction body to be signed, obtained using 'createCertificatePublicationTxBody' or similar. - -> [SomeKeyPair] -- ^ List of key pairs used for signing the transaction. + -> [Some KeyPair] -- ^ List of key pairs used for signing the transaction. -> m (File SignedTx In) signTx execConfig cEra work prefix txBody signatoryKeyPairs = do let signedTx = File (work prefix <> ".tx") void $ execCli' execConfig $ [ anyEraToString cEra, "transaction", "sign" , "--tx-body-file", unFile txBody - ] ++ (concat [["--signing-key-file", signingKeyFp kp] | SomeKeyPair kp <- signatoryKeyPairs]) ++ + ] ++ (concat [["--signing-key-file", signingKeyFp kp] | Some kp <- signatoryKeyPairs]) ++ [ "--out-file", unFile signedTx ] return signedTx diff --git a/cardano-testnet/src/Testnet/Types.hs b/cardano-testnet/src/Testnet/Types.hs index bd9e84402e6..f5fd5ad3341 100644 --- a/cardano-testnet/src/Testnet/Types.hs +++ b/cardano-testnet/src/Testnet/Types.hs @@ -3,6 +3,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} @@ -26,10 +27,8 @@ module Testnet.Types , KeyPair(..) , verificationKeyFp , signingKeyFp - , SomeKeyPair(..) , VKey , SKey - , ColdPoolKey , VrfKey , StakingKey , PaymentKey @@ -44,6 +43,7 @@ module Testnet.Types ) where import Cardano.Api +import Cardano.Api.Experimental (Some (..)) import Cardano.Api.Shelley (VrfKey) import qualified Cardano.Chain.Genesis as G @@ -92,15 +92,20 @@ instance MonoFunctor (KeyPair k) where deriving instance Show (KeyPair k) deriving instance Eq (KeyPair k) +instance {-# OVERLAPPING #-} Show (Some KeyPair) where + show (Some kp) = show kp + +instance {-# OVERLAPPING #-} Eq (Some KeyPair) where + (Some KeyPair{verificationKey=File vk1, signingKey=File sk1}) + == (Some KeyPair{verificationKey=File vk2, signingKey=File sk2}) = + vk1 == vk2 && sk1 == sk2 + verificationKeyFp :: KeyPair k -> FilePath verificationKeyFp = unFile . verificationKey signingKeyFp :: KeyPair k -> FilePath signingKeyFp = unFile . signingKey -data SomeKeyPair = forall a. SomeKeyPair (KeyPair a) -deriving instance Show SomeKeyPair - -- | Verification key tag data VKey k @@ -143,7 +148,6 @@ isTestnetNodeSpo = isJust . poolKeys nodeSocketPath :: TestnetNode -> SocketPath nodeSocketPath = File . H.sprocketSystemName . nodeSprocket -data ColdPoolKey data StakingKey data SpoColdKey diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/Plutus.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/Plutus.hs index 926e6a57769..221b65f046e 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/Plutus.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/Plutus.hs @@ -11,6 +11,7 @@ module Cardano.Testnet.Test.Cli.Conway.Plutus ) where import Cardano.Api +import qualified Cardano.Api.Ledger as L import Cardano.Testnet @@ -53,7 +54,8 @@ hprop_plutus_v3 = integrationWorkspace "all-plutus-script-purposes" $ \tempAbsBa let tempBaseAbsPath = makeTmpBaseAbsPath $ TmpAbsolutePath tempAbsPath' - sbe = ShelleyBasedEraConway -- TODO: We should only support the latest era and the upcoming era + ceo = ConwayEraOnwardsConway + sbe = conwayEraOnwardsToShelleyBasedEra ceo era = toCardanoEra sbe anyEra = AnyCardanoEra era options = def { cardanoNodeEra = AnyShelleyBasedEra sbe } @@ -106,12 +108,13 @@ hprop_plutus_v3 = integrationWorkspace "all-plutus-script-purposes" $ \tempAbsBa scriptStakeRegistrationCertificate <- H.note $ work "script-stake-registration-certificate" + keyDeposit <- fromIntegral . L.unCoin <$> getKeyDeposit epochStateView ceo -- Create script stake registration certificate createScriptStakeRegistrationCertificate tempAbsPath anyEra plutusScript - 0 + keyDeposit scriptStakeRegistrationCertificate -- 1. Put UTxO and datum at Plutus spending script address diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/KesPeriodInfo.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/KesPeriodInfo.hs index 7c7e38d5be4..dc70f16dd98 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/KesPeriodInfo.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/KesPeriodInfo.hs @@ -32,6 +32,7 @@ import System.FilePath (()) import qualified System.Info as SYS import Testnet.Components.Configuration +import Testnet.Components.Query import Testnet.Process.Cli.Keys import Testnet.Process.Cli.SPO import Testnet.Process.Run (execCli, execCli', mkExecConfig) @@ -60,7 +61,8 @@ hprop_kes_period_info = integrationRetryWorkspace 2 "kes-period-info" $ \tempAbs <- mkConf tempAbsBasePath' let tempBaseAbsPath = makeTmpBaseAbsPath tempAbsPath - sbe = ShelleyBasedEraConway + ceo = ConwayEraOnwardsConway + sbe = conwayEraOnwardsToShelleyBasedEra ceo asbe = AnyShelleyBasedEra sbe eraString = eraToString sbe cTestnetOptions = def { cardanoNodeEra = asbe } @@ -76,7 +78,7 @@ hprop_kes_period_info = integrationRetryWorkspace 2 "kes-period-info" $ \tempAbs -- We get our UTxOs from here let utxoAddr = Text.unpack $ paymentKeyInfoAddr wallet0 - utxoSKeyFile = signingKeyFp $ paymentKeyInfoPair wallet0 + utxoSKeyFile = signingKey $ paymentKeyInfoPair wallet0 void $ execCli' execConfig [ eraString, "query", "utxo" , "--address", utxoAddr @@ -90,12 +92,15 @@ hprop_kes_period_info = integrationRetryWorkspace 2 "kes-period-info" $ \tempAbs let node1SocketPath = Api.File $ IO.sprocketSystemName node1sprocket termEpoch = EpochNo 3 - (stakePoolId, stakePoolColdSigningKey, stakePoolColdVKey, _, _) + epochStateView <- getEpochStateView configurationFile node1SocketPath + keyDeposit <- getKeyDeposit epochStateView ceo + (stakePoolId, KeyPair{signingKey=File stakePoolColdSigningKey, verificationKey=File stakePoolColdVKey}, _) <- registerSingleSpo asbe 1 tempAbsPath configurationFile node1SocketPath termEpoch testnetMagic + keyDeposit execConfig (txin1, utxoSKeyFile, utxoAddr) @@ -108,30 +113,32 @@ hprop_kes_period_info = integrationRetryWorkspace 2 "kes-period-info" $ \tempAbs let testStakeDelegator = work "test-delegator" H.createDirectoryIfMissing_ testStakeDelegator - let testDelegatorVkeyFp = testStakeDelegator "test-delegator.vkey" - testDelegatorSKeyFp = testStakeDelegator "test-delegator.skey" - testDelegatorPaymentVKeyFp = testStakeDelegator "test-delegator-payment.vkey" - testDelegatorPaymentSKeyFp = testStakeDelegator "test-delegator-payment.skey" + let testDelegatorKeys = KeyPair + { signingKey = File $ testStakeDelegator "test-delegator.skey" + , verificationKey = File $ testStakeDelegator "test-delegator.vkey" + } + testDelegatorPaymentKeys = KeyPair + { signingKey = File $ testStakeDelegator "test-delegator-payment.skey" + , verificationKey = File $ testStakeDelegator "test-delegator-payment.vkey" + } testDelegatorRegCertFp = testStakeDelegator "test-delegator.regcert" testDelegatorDelegCert = testStakeDelegator "test-delegator.delegcert" - cliStakeAddressKeyGen - $ KeyPair (File testDelegatorVkeyFp) (File testDelegatorSKeyFp) - cliAddressKeyGen - $ KeyPair (File testDelegatorPaymentVKeyFp) (File testDelegatorPaymentSKeyFp) + cliStakeAddressKeyGen testDelegatorKeys + cliAddressKeyGen testDelegatorPaymentKeys -- NB: We must include the stake credential testDelegatorPaymentAddr <- execCli [ "latest", "address", "build" , "--testnet-magic", show @Int testnetMagic - , "--payment-verification-key-file", testDelegatorPaymentVKeyFp - , "--stake-verification-key-file", testDelegatorVkeyFp + , "--payment-verification-key-file", verificationKeyFp testDelegatorPaymentKeys + , "--stake-verification-key-file", verificationKeyFp testDelegatorKeys ] testDelegatorStakeAddress <- filter (/= '\n') <$> execCli [ "latest", "stake-address", "build" - , "--stake-verification-key-file", testDelegatorVkeyFp + , "--stake-verification-key-file", verificationKeyFp testDelegatorKeys , "--testnet-magic", show @Int testnetMagic ] @@ -139,15 +146,15 @@ hprop_kes_period_info = integrationRetryWorkspace 2 "kes-period-info" $ \tempAbs createStakeKeyRegistrationCertificate tempAbsPath (cardanoNodeEra cTestnetOptions) - testDelegatorVkeyFp - 0 + (verificationKey testDelegatorKeys) + keyDeposit testDelegatorRegCertFp -- Test stake address deleg cert createStakeDelegationCertificate tempAbsPath sbe - testDelegatorVkeyFp + (verificationKey testDelegatorKeys) stakePoolId testDelegatorDelegCert @@ -186,8 +193,8 @@ hprop_kes_period_info = integrationRetryWorkspace 2 "kes-period-info" $ \tempAbs [ "latest", "transaction", "sign" , "--tx-body-file", delegRegTestDelegatorTxBodyFp , "--testnet-magic", show @Int testnetMagic - , "--signing-key-file", utxoSKeyFile - , "--signing-key-file", testDelegatorSKeyFp + , "--signing-key-file", unFile utxoSKeyFile + , "--signing-key-file", signingKeyFp testDelegatorKeys , "--out-file", delegRegTestDelegatorTxFp ] diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/LeadershipSchedule.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/LeadershipSchedule.hs index b6397560a06..40373ff4910 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/LeadershipSchedule.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/LeadershipSchedule.hs @@ -37,6 +37,7 @@ import System.FilePath (()) import qualified System.Info as SYS import Testnet.Components.Configuration +import Testnet.Components.Query import Testnet.Process.Cli.Keys import Testnet.Process.Cli.SPO import Testnet.Process.Run (execCli, execCli', mkExecConfig) @@ -60,7 +61,8 @@ hprop_leadershipSchedule = integrationRetryWorkspace 2 "leadership-schedule" $ \ H.note_ SYS.os conf@Conf { tempAbsPath=tempAbsPath@(TmpAbsolutePath work) } <- mkConf tempAbsBasePath' let tempBaseAbsPath = makeTmpBaseAbsPath tempAbsPath - sbe = shelleyBasedEra @ConwayEra -- TODO: We should only support the latest era and the upcoming era + ceo = ConwayEraOnwardsConway + sbe = conwayEraOnwardsToShelleyBasedEra ceo asbe = AnyShelleyBasedEra sbe cTestnetOptions = def { cardanoNodeEra = asbe @@ -84,7 +86,7 @@ hprop_leadershipSchedule = integrationRetryWorkspace 2 "leadership-schedule" $ \ ----------------Need to register an SPO------------------ let utxoAddr = Text.unpack $ paymentKeyInfoAddr wallet0 - utxoSKeyFile = signingKeyFp $ paymentKeyInfoPair wallet0 + utxoSKeyFile = signingKey $ paymentKeyInfoPair wallet0 void $ execCli' execConfig [ eraString, "query", "utxo" , "--address", utxoAddr @@ -97,12 +99,15 @@ hprop_leadershipSchedule = integrationRetryWorkspace 2 "leadership-schedule" $ \ txin1 <- H.noteShow =<< H.headM (Map.keys utxo1) let node1SocketPath = Api.File $ IO.sprocketSystemName node1sprocket termEpoch = EpochNo 15 - (stakePoolIdNewSpo, stakePoolColdSigningKey, stakePoolColdVKey, vrfSkey, _) + epochStateView <- getEpochStateView configurationFile node1SocketPath + keyDeposit <- getKeyDeposit epochStateView ceo + (stakePoolIdNewSpo, KeyPair{signingKey=File stakePoolColdSigningKey, verificationKey=File stakePoolColdVKey}, KeyPair{signingKey=File vrfSkey}) <- registerSingleSpo asbe 1 tempAbsPath configurationFile node1SocketPath (EpochNo 10) testnetMagic + keyDeposit execConfig (txin1, utxoSKeyFile, utxoAddr) @@ -113,30 +118,32 @@ hprop_leadershipSchedule = integrationRetryWorkspace 2 "leadership-schedule" $ \ let testStakeDelegator = work "test-delegator" H.createDirectoryIfMissing_ testStakeDelegator - let testDelegatorVkeyFp = testStakeDelegator "test-delegator.vkey" - testDelegatorSKeyFp = testStakeDelegator "test-delegator.skey" - testDelegatorPaymentVKeyFp = testStakeDelegator "test-delegator-payment.vkey" - testDelegatorPaymentSKeyFp = testStakeDelegator "test-delegator-payment.skey" + let testDelegatorKeys = KeyPair + { signingKey = File $ testStakeDelegator "test-delegator.skey" + , verificationKey = File $ testStakeDelegator "test-delegator.vkey" + } + testDelegatorPaymentKeys = KeyPair + { signingKey = File $ testStakeDelegator "test-delegator-payment.skey" + , verificationKey = File $ testStakeDelegator "test-delegator-payment.vkey" + } testDelegatorRegCertFp = testStakeDelegator "test-delegator.regcert" testDelegatorDelegCert = testStakeDelegator "test-delegator.delegcert" - cliStakeAddressKeyGen - $ KeyPair (File testDelegatorVkeyFp) (File testDelegatorSKeyFp) - cliAddressKeyGen - $ KeyPair (File testDelegatorPaymentVKeyFp) (File testDelegatorPaymentSKeyFp) + cliStakeAddressKeyGen testDelegatorKeys + cliAddressKeyGen testDelegatorPaymentKeys -- NB: We must include the stake credential testDelegatorPaymentAddr <- execCli [ "latest", "address", "build" , "--testnet-magic", show @Int testnetMagic - , "--payment-verification-key-file", testDelegatorPaymentVKeyFp - , "--stake-verification-key-file", testDelegatorVkeyFp + , "--payment-verification-key-file", verificationKeyFp testDelegatorPaymentKeys + , "--stake-verification-key-file", verificationKeyFp testDelegatorKeys ] testDelegatorStakeAddress <- filter (/= '\n') <$> execCli [ "latest", "stake-address", "build" - , "--stake-verification-key-file", testDelegatorVkeyFp + , "--stake-verification-key-file", verificationKeyFp testDelegatorKeys , "--testnet-magic", show @Int testnetMagic ] @@ -144,15 +151,15 @@ hprop_leadershipSchedule = integrationRetryWorkspace 2 "leadership-schedule" $ \ createStakeKeyRegistrationCertificate tempAbsPath (cardanoNodeEra cTestnetOptions) - testDelegatorVkeyFp - 0 + (verificationKey testDelegatorKeys) + keyDeposit testDelegatorRegCertFp -- Test stake address deleg cert createStakeDelegationCertificate tempAbsPath sbe - testDelegatorVkeyFp + (verificationKey testDelegatorKeys) stakePoolIdNewSpo testDelegatorDelegCert @@ -191,8 +198,8 @@ hprop_leadershipSchedule = integrationRetryWorkspace 2 "leadership-schedule" $ \ [ "latest", "transaction", "sign" , "--tx-body-file", delegRegTestDelegatorTxBodyFp , "--testnet-magic", show @Int testnetMagic - , "--signing-key-file", utxoSKeyFile - , "--signing-key-file", testDelegatorSKeyFp + , "--signing-key-file", unFile utxoSKeyFile + , "--signing-key-file", signingKeyFp testDelegatorKeys , "--out-file", delegRegTestDelegatorTxFp ] diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs index a30b2499086..f190ff36fb9 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs @@ -14,6 +14,7 @@ module Cardano.Testnet.Test.Cli.Query ) where import Cardano.Api +import Cardano.Api.Experimental (Some (..)) import qualified Cardano.Api.Genesis as Api import Cardano.Api.Ledger (Coin (Coin), EpochInterval (EpochInterval), StandardCrypto, extractHash, unboundRational) @@ -327,7 +328,7 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. -- Now we create a transaction and check if it exists in the mempool mempoolWork <- H.createDirectoryIfMissing $ work "mempool-test" txBody <- mkSimpleSpendOutputsOnlyTx execConfig epochStateView sbe mempoolWork "tx-body" wallet0 wallet1 10_000_000 - signedTx <- signTx execConfig cEra mempoolWork "signed-tx" txBody [SomeKeyPair $ paymentKeyInfoPair wallet0] + signedTx <- signTx execConfig cEra mempoolWork "signed-tx" txBody [Some $ paymentKeyInfoPair wallet0] submitTx execConfig cEra signedTx txId <- retrieveTransactionId execConfig signedTx -- And we check @@ -349,7 +350,7 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. -- Submit a transaction to publish the reference script txBody <- mkSpendOutputsOnlyTx execConfig epochStateView sbe refScriptSizeWork "tx-body" wallet1 [(ReferenceScriptAddress plutusV3Script, transferAmount)] - signedTx <- signTx execConfig cEra refScriptSizeWork "signed-tx" txBody [SomeKeyPair $ paymentKeyInfoPair wallet1] + signedTx <- signTx execConfig cEra refScriptSizeWork "signed-tx" txBody [Some $ paymentKeyInfoPair wallet1] submitTx execConfig cEra signedTx -- Wait until transaction is on chain and obtain transaction identifier txId <- retrieveTransactionId execConfig signedTx diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Transaction/RegisterDeregisterStakeAddress.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Transaction/RegisterDeregisterStakeAddress.hs new file mode 100644 index 00000000000..c86946976ae --- /dev/null +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Transaction/RegisterDeregisterStakeAddress.hs @@ -0,0 +1,147 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module Cardano.Testnet.Test.Cli.Transaction.RegisterDeregisterStakeAddress + ( hprop_tx_register_deregister_stake_address + ) where + +import Cardano.Api as Api + +import Cardano.Testnet + +import Prelude + +import Control.Monad +import Data.Default.Class +import qualified Data.Text as Text +import System.FilePath (()) + +import Testnet.Components.Configuration +import Testnet.Components.Query +import Testnet.Process.Cli.Keys +import Testnet.Process.Cli.SPO (createStakeKeyDeregistrationCertificate, + createStakeKeyRegistrationCertificate) +import Testnet.Process.Run (execCli', execCliAny, mkExecConfig) +import Testnet.Property.Util (integrationWorkspace) +import Testnet.Start.Types +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 "/register deregister stake address in transaction build/"'@ +hprop_tx_register_deregister_stake_address :: Property +hprop_tx_register_deregister_stake_address = integrationWorkspace "register-deregister-stake-address" $ \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 + eraName = eraToString sbe + fastTestnetOptions = def { cardanoNodeEra = AnyShelleyBasedEra sbe } + shelleyOptions = def { genesisEpochLength = 200 } + + TestnetRuntime + { testnetMagic + , testnetNodes + , wallets=wallet0:wallet1:_ + , configurationFile + } + <- cardanoTestnetDefault fastTestnetOptions shelleyOptions conf + + node <- H.headM testnetNodes + poolSprocket1 <- H.noteShow $ nodeSprocket node + execConfig <- mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic + let socketPath = nodeSocketPath node + + 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 + + -- Register stake address + let stakeCertFp = work "stake.regcert" + stakeCertDeregFp = work "stake.deregcert" + stakeKeys = KeyPair { verificationKey = File $ work "stake.vkey" + , signingKey = File $ work "stake.skey" + } + cliStakeAddressKeyGen stakeKeys + keyDeposit <- getKeyDeposit epochStateView ceo + createStakeKeyRegistrationCertificate + tempAbsPath (AnyShelleyBasedEra sbe) (verificationKey stakeKeys) keyDeposit stakeCertFp + + stakeCertTxBodyFp <- H.note $ work "stake.registration.txbody" + stakeCertTxSignedFp <- H.note $ work "stake.registration.tx" + + txin1 <- findLargestUtxoForPaymentKey epochStateView sbe wallet0 + + (_, stdout, stderr) <- execCliAny execConfig + [ eraName, "transaction", "build" + , "--change-address", Text.unpack $ paymentKeyInfoAddr wallet0 + , "--tx-in", Text.unpack $ renderTxIn txin1 + , "--tx-out", Text.unpack (paymentKeyInfoAddr wallet1) <> "+" <> show @Int 10_000_000 + , "--certificate-file", stakeCertFp + , "--witness-override", show @Int 2 + , "--out-file", stakeCertTxBodyFp + ] + H.note_ stdout + H.note_ stderr + + void $ execCli' execConfig + [ eraName, "transaction", "sign" + , "--tx-body-file", stakeCertTxBodyFp + , "--signing-key-file", signingKeyFp $ paymentKeyInfoPair wallet0 + , "--signing-key-file", signingKeyFp stakeKeys + , "--out-file", stakeCertTxSignedFp + ] + + void $ execCli' execConfig + [ eraName, "transaction", "submit" + , "--tx-file", stakeCertTxSignedFp + ] + + H.noteShowM_ $ waitForBlocks epochStateView 1 + + -- deregister stake address + createStakeKeyDeregistrationCertificate + tempAbsPath sbe (verificationKey stakeKeys) keyDeposit stakeCertDeregFp + + stakeCertDeregTxBodyFp <- H.note $ work "stake.deregistration.txbody" + stakeCertDeregTxSignedFp <- H.note $ work "stake.deregistration.tx" + + txin2 <- findLargestUtxoForPaymentKey epochStateView sbe wallet1 + + (_, stdout', stderr') <- execCliAny execConfig + [ eraName, "transaction", "build" + , "--change-address", Text.unpack $ paymentKeyInfoAddr wallet1 + , "--tx-in", Text.unpack $ renderTxIn txin2 + , "--tx-out", Text.unpack (paymentKeyInfoAddr wallet0) <> "+" <> show @Int 10_000_000 + , "--certificate-file", stakeCertDeregFp + , "--witness-override", show @Int 2 + , "--out-file", stakeCertDeregTxBodyFp + ] + H.note_ stdout' + H.note_ stderr' + + void $ execCli' execConfig + [ eraName, "transaction", "sign" + , "--tx-body-file", stakeCertDeregTxBodyFp + , "--signing-key-file", signingKeyFp $ paymentKeyInfoPair wallet1 + , "--signing-key-file", signingKeyFp stakeKeys + , "--out-file", stakeCertDeregTxSignedFp + ] + + void $ execCli' execConfig + [ eraName, "transaction", "submit" + , "--tx-file", stakeCertDeregTxSignedFp + ] diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs index 61dbe2b2f2b..4071e9ade89 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs @@ -11,6 +11,7 @@ module Cardano.Testnet.Test.Gov.CommitteeAddNew ) where import Cardano.Api as Api +import Cardano.Api.Experimental (Some (..)) import qualified Cardano.Api.Ledger as L import Cardano.Api.Shelley (ShelleyLedgerEra) @@ -41,6 +42,7 @@ import Testnet.EpochStateProcessing (waitForGovActionVotes) import qualified Testnet.Process.Cli.DRep as DRep import Testnet.Process.Cli.Keys import qualified Testnet.Process.Cli.SPO as SPO +import Testnet.Process.Cli.SPO (createStakeKeyRegistrationCertificate) import Testnet.Process.Cli.Transaction import Testnet.Process.Run (execCli', mkExecConfig) import Testnet.Property.Util (integrationWorkspace) @@ -118,23 +120,16 @@ hprop_constitutional_committee_add_new = integrationWorkspace "constitutional-co 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" stakeCertFp = gov "stake.regcert" + stakeKeys = KeyPair { verificationKey = File $ gov "stake.vkey" + , signingKey = File $ gov "stake.skey" + } - cliStakeAddressKeyGen - $ KeyPair { verificationKey = File stakeVkeyFp - , signingKey = File stakeSKeyFp - } - - -- Register stake address - - void $ execCli' execConfig - [ eraName, "stake-address", "registration-certificate" - , "--stake-verification-key-file", stakeVkeyFp - , "--key-reg-deposit-amt", show @Int 0 -- TODO: why this needs to be 0???? - , "--out-file", stakeCertFp - ] + -- Register new stake address + cliStakeAddressKeyGen stakeKeys + keyDeposit <- getKeyDeposit epochStateView ceo + createStakeKeyRegistrationCertificate + tempAbsPath (AnyShelleyBasedEra sbe) (verificationKey stakeKeys) keyDeposit stakeCertFp stakeCertTxBodyFp <- H.note $ work "stake.registration.txbody" stakeCertTxSignedFp <- H.note $ work "stake.registration.tx" @@ -155,7 +150,7 @@ hprop_constitutional_committee_add_new = integrationWorkspace "constitutional-co [ eraName, "transaction", "sign" , "--tx-body-file", stakeCertTxBodyFp , "--signing-key-file", signingKeyFp $ paymentKeyInfoPair wallet1 - , "--signing-key-file", stakeSKeyFp + , "--signing-key-file", signingKeyFp stakeKeys , "--out-file", stakeCertTxSignedFp ] @@ -164,7 +159,6 @@ hprop_constitutional_committee_add_new = integrationWorkspace "constitutional-co , "--tx-file", stakeCertTxSignedFp ] - minGovActDeposit <- getMinGovActionDeposit epochStateView ceo ccColdKeys <- H.noteShowM $ @@ -191,7 +185,7 @@ hprop_constitutional_committee_add_new = integrationWorkspace "constitutional-co , "--anchor-url", "https://tinyurl.com/3wrwb2as" , "--anchor-data-hash", proposalAnchorDataHash , "--governance-action-deposit", show minGovActDeposit - , "--deposit-return-stake-verification-key-file", stakeVkeyFp + , "--deposit-return-stake-verification-key-file", verificationKeyFp stakeKeys , "--threshold", "0.2" , "--out-file", updateCommitteeFp ] @@ -215,7 +209,7 @@ hprop_constitutional_committee_add_new = integrationWorkspace "constitutional-co committeeMembers `H.assertWith` null signedProposalTx <- - signTx execConfig cEra work "signed-proposal" (File txbodyFp) [SomeKeyPair $ paymentKeyInfoPair wallet0] + signTx execConfig cEra work "signed-proposal" (File txbodyFp) [Some $ paymentKeyInfoPair wallet0] submitTx execConfig cEra signedProposalTx governanceActionTxId <- H.noteM $ retrieveTransactionId execConfig signedProposalTx @@ -246,7 +240,7 @@ hprop_constitutional_committee_add_new = integrationWorkspace "constitutional-co , verificationKey = error "unused" } drepSKeys = map (defaultDRepKeyPair . snd) drepVotes - signingKeys = SomeKeyPair <$> paymentKeyInfoPair wallet0:poolNodePaymentKeyPair:drepSKeys + signingKeys = Some <$> paymentKeyInfoPair wallet0:poolNodePaymentKeyPair:drepSKeys voteTxFp <- signTx execConfig cEra gov "signed-vote-tx" voteTxBodyFp signingKeys diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepActivity.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepActivity.hs index d958e9c502a..87a3cb874ce 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepActivity.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepActivity.hs @@ -12,6 +12,7 @@ module Cardano.Testnet.Test.Gov.DRepActivity import Cardano.Api as Api import Cardano.Api.Eon.ShelleyBasedEra (ShelleyLedgerEra) +import Cardano.Api.Experimental (Some (..)) import Cardano.Api.Ledger (EpochInterval (EpochInterval, unEpochInterval), drepExpiry) import Cardano.Ledger.Conway.Core (EraGov, curPParamsGovStateL) @@ -35,6 +36,7 @@ import Testnet.Components.Query import Testnet.Defaults (defaultDRepKeyPair, defaultDelegatorStakeKeyPair) import Testnet.Process.Cli.DRep import Testnet.Process.Cli.Keys (cliStakeAddressKeyGen) +import Testnet.Process.Cli.SPO (createStakeKeyRegistrationCertificate) import Testnet.Process.Cli.Transaction import Testnet.Process.Run (execCli', mkExecConfig) import Testnet.Property.Util (integrationWorkspace) @@ -88,23 +90,15 @@ hprop_check_drep_activity = integrationWorkspace "test-activity" $ \tempAbsBaseP gov <- H.createDirectoryIfMissing $ work "governance" - let stakeVkeyFp = gov "stake.vkey" - stakeSKeyFp = gov "stake.skey" - stakeCertFp = gov "stake.regcert" - stakeKeys = KeyPair { verificationKey = File stakeVkeyFp - , signingKey = File stakeSKeyFp + -- Register stake address + let stakeCertFp = gov "stake.regcert" + stakeKeys = KeyPair { verificationKey = File $ gov "stake.vkey" + , signingKey = File $ gov "stake.skey" } - cliStakeAddressKeyGen stakeKeys - - -- Register stake address - - void $ execCli' execConfig - [ eraName, "stake-address", "registration-certificate" - , "--stake-verification-key-file", stakeVkeyFp - , "--key-reg-deposit-amt", show @Int 0 -- TODO: why this needs to be 0???? - , "--out-file", stakeCertFp - ] + keyDeposit <- getKeyDeposit epochStateView ceo + createStakeKeyRegistrationCertificate + tempAbsPath (AnyShelleyBasedEra sbe) (verificationKey stakeKeys) keyDeposit stakeCertFp stakeCertTxBodyFp <- H.note $ work "stake.registration.txbody" stakeCertTxSignedFp <- H.note $ work "stake.registration.tx" @@ -125,7 +119,7 @@ hprop_check_drep_activity = integrationWorkspace "test-activity" $ \tempAbsBaseP [ eraName, "transaction", "sign" , "--tx-body-file", stakeCertTxBodyFp , "--signing-key-file", signingKeyFp $ paymentKeyInfoPair wallet1 - , "--signing-key-file", stakeSKeyFp + , "--signing-key-file", signingKeyFp stakeKeys , "--out-file", stakeCertTxSignedFp ] @@ -286,7 +280,7 @@ voteChangeProposal execConfig epochStateView sbe work prefix governanceActionTxI voteTxBodyFp <- createVotingTxBody execConfig epochStateView sbe baseDir "vote-tx-body" voteFiles wallet - let signingKeys = SomeKeyPair <$> (paymentKeyInfoPair wallet:(defaultDRepKeyPair . snd <$> votes)) + let signingKeys = Some <$> (paymentKeyInfoPair wallet:(defaultDRepKeyPair . snd <$> votes)) voteTxFp <- signTx execConfig cEra baseDir "signed-vote-tx" voteTxBodyFp signingKeys submitTx execConfig cEra voteTxFp diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepDeposit.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepDeposit.hs index 4ccd9aa4379..1d5fcca563c 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepDeposit.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepDeposit.hs @@ -5,6 +5,7 @@ module Cardano.Testnet.Test.Gov.DRepDeposit ) where import Cardano.Api +import Cardano.Api.Experimental (Some (..)) import qualified Cardano.Api.Ledger as L import Cardano.Testnet @@ -84,7 +85,7 @@ hprop_ledger_events_drep_deposits = integrationWorkspace "drep-deposits" $ \temp drepRegTxBody1 <- createCertificatePublicationTxBody execConfig epochStateView sbe drepDir1 "reg-cert-txbody" drepRegCert1 wallet0 drepSignedRegTx1 <- signTx execConfig cEra drepDir1 "signed-reg-tx" - drepRegTxBody1 [SomeKeyPair drepKeyPair1, SomeKeyPair $ paymentKeyInfoPair wallet0] + drepRegTxBody1 [Some drepKeyPair1, Some $ paymentKeyInfoPair wallet0] failToSubmitTx execConfig cEra drepSignedRegTx1 "ConwayDRepIncorrectDeposit" diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/GovActionTimeout.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/GovActionTimeout.hs index 633e0127191..6916c5c3fcd 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/GovActionTimeout.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/GovActionTimeout.hs @@ -11,7 +11,7 @@ module Cardano.Testnet.Test.Gov.GovActionTimeout ) where import Cardano.Api as Api -import Cardano.Api.Ledger (EpochInterval (EpochInterval, unEpochInterval)) +import Cardano.Api.Ledger (EpochInterval (..)) import Cardano.Testnet @@ -26,6 +26,7 @@ import System.FilePath (()) import Testnet.Components.Query import Testnet.Process.Cli.DRep (makeActivityChangeProposal) import Testnet.Process.Cli.Keys (cliStakeAddressKeyGen) +import Testnet.Process.Cli.SPO (createStakeKeyRegistrationCertificate) import Testnet.Process.Run (execCli', mkExecConfig) import Testnet.Property.Util (integrationWorkspace) import Testnet.Start.Types @@ -85,23 +86,16 @@ hprop_check_gov_action_timeout = integrationWorkspace "gov-action-timeout" $ \te govActionLifetime <- getGovActionLifetime epochStateView ceo H.note_ $ "govActionLifetime: " <> show govActionLifetime - let stakeVkeyFp = gov "stake.vkey" - stakeSKeyFp = gov "stake.skey" - stakeCertFp = gov "stake.regcert" - stakeKeys = KeyPair { verificationKey = File stakeVkeyFp - , signingKey = File stakeSKeyFp - } - - cliStakeAddressKeyGen stakeKeys - -- Register stake address + let stakeCertFp = gov "stake.regcert" + stakeKeys = KeyPair { verificationKey = File $ gov "stake.vkey" + , signingKey = File $ gov "stake.skey" + } + cliStakeAddressKeyGen stakeKeys + keyDeposit <- getKeyDeposit epochStateView ceo + createStakeKeyRegistrationCertificate + tempAbsPath (AnyShelleyBasedEra sbe) (verificationKey stakeKeys) keyDeposit stakeCertFp - void $ execCli' execConfig - [ eraName, "stake-address", "registration-certificate" - , "--stake-verification-key-file", stakeVkeyFp - , "--key-reg-deposit-amt", show @Int 0 -- TODO: why this needs to be 0???? - , "--out-file", stakeCertFp - ] stakeCertTxBodyFp <- H.note $ work "stake.registration.txbody" stakeCertTxSignedFp <- H.note $ work "stake.registration.tx" @@ -122,7 +116,7 @@ hprop_check_gov_action_timeout = integrationWorkspace "gov-action-timeout" $ \te [ eraName, "transaction", "sign" , "--tx-body-file", stakeCertTxBodyFp , "--signing-key-file", signingKeyFp $ paymentKeyInfoPair wallet1 - , "--signing-key-file", stakeSKeyFp + , "--signing-key-file", signingKeyFp stakeKeys , "--out-file", stakeCertTxSignedFp ] 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 d0bbc1e79ad..a1567dfc74d 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 @@ -36,6 +36,7 @@ import System.FilePath (()) import Testnet.Components.Query import Testnet.Defaults import Testnet.Process.Cli.Keys +import Testnet.Process.Cli.SPO (createStakeKeyRegistrationCertificate) import Testnet.Process.Run (execCli', mkExecConfig) import Testnet.Property.Util (integrationRetryWorkspace) import Testnet.Start.Types @@ -93,23 +94,15 @@ hprop_ledger_events_info_action = integrationRetryWorkspace 2 "info-hash" $ \tem [ "hash", "anchor-data", "--file-text", proposalAnchorFile ] - let stakeVkeyFp = gov "stake.vkey" - stakeSKeyFp = gov "stake.skey" - stakeCertFp = gov "stake.regcert" - stakeKeys = KeyPair { verificationKey = File stakeVkeyFp - , signingKey = File stakeSKeyFp + -- Register stake address + let stakeCertFp = gov "stake.regcert" + stakeKeys = KeyPair { verificationKey = File $ gov "stake.vkey" + , signingKey = File $ gov "stake.skey" } - cliStakeAddressKeyGen stakeKeys - - -- Register stake address - - void $ execCli' execConfig - [ eraName, "stake-address", "registration-certificate" - , "--stake-verification-key-file", stakeVkeyFp - , "--key-reg-deposit-amt", show @Int 0 -- TODO: why this needs to be 0???? - , "--out-file", stakeCertFp - ] + keyDeposit <- getKeyDeposit epochStateView ceo + createStakeKeyRegistrationCertificate + tempAbsPath (AnyShelleyBasedEra sbe) (verificationKey stakeKeys) keyDeposit stakeCertFp stakeCertTxBodyFp <- H.note $ work "stake.registration.txbody" stakeCertTxSignedFp <- H.note $ work "stake.registration.tx" @@ -130,7 +123,7 @@ hprop_ledger_events_info_action = integrationRetryWorkspace 2 "info-hash" $ \tem [ eraName, "transaction", "sign" , "--tx-body-file", stakeCertTxBodyFp , "--signing-key-file", signingKeyFp $ paymentKeyInfoPair wallet0 - , "--signing-key-file", stakeSKeyFp + , "--signing-key-file", signingKeyFp stakeKeys , "--out-file", stakeCertTxSignedFp ] @@ -145,7 +138,7 @@ hprop_ledger_events_info_action = integrationRetryWorkspace 2 "info-hash" $ \tem [ eraName, "governance", "action", "create-info" , "--testnet" , "--governance-action-deposit", show @Int 1_000_000 -- TODO: Get this from the node - , "--deposit-return-stake-verification-key-file", stakeVkeyFp + , "--deposit-return-stake-verification-key-file", verificationKeyFp stakeKeys , "--anchor-url", "https://tinyurl.com/3wrwb2as" , "--anchor-data-hash", proposalAnchorDataHash , "--out-file", infoActionFp 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 5e21b03ad43..cdd92a8abe0 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 @@ -9,6 +9,7 @@ module Cardano.Testnet.Test.Gov.NoConfidence ) where import Cardano.Api as Api +import Cardano.Api.Experimental (Some (..)) import Cardano.Api.Ledger import Cardano.Api.Shelley @@ -184,7 +185,7 @@ hprop_gov_no_confidence = integrationWorkspace "no-confidence" $ \tempAbsBasePat ] signedProposalTx <- signTx execConfig cEra work "signed-proposal" - (File txbodyFp) [SomeKeyPair $ paymentKeyInfoPair wallet0] + (File txbodyFp) [Some $ paymentKeyInfoPair wallet0] submitTx execConfig cEra signedProposalTx @@ -216,12 +217,12 @@ hprop_gov_no_confidence = integrationWorkspace "no-confidence" $ \tempAbsBasePat -- Submit votes voteTxBodyFp <- DRep.createVotingTxBody execConfig epochStateView sbe work "vote-tx-body" allVoteFiles wallet0 - let spoSigningKeys = [SomeKeyPair $ defaultSpoColdKeyPair n | (_, n) <- spoVotes] - drepSigningKeys = [SomeKeyPair $ defaultDRepKeyPair n | (_, n) <- drepVotes] + let spoSigningKeys = [Some $ defaultSpoColdKeyPair n | (_, n) <- spoVotes] + drepSigningKeys = [Some $ defaultDRepKeyPair n | (_, n) <- drepVotes] allVoteSigningKeys = spoSigningKeys ++ drepSigningKeys voteTxFp <- signTx execConfig cEra work "signed-vote-tx" voteTxBodyFp - (SomeKeyPair (paymentKeyInfoPair wallet0) : allVoteSigningKeys) + (Some (paymentKeyInfoPair wallet0) : allVoteSigningKeys) submitTx execConfig cEra voteTxFp diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PParamChangeFailsSPO.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PParamChangeFailsSPO.hs index 522f7e3224a..5218ba340c5 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PParamChangeFailsSPO.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PParamChangeFailsSPO.hs @@ -11,7 +11,8 @@ module Cardano.Testnet.Test.Gov.PParamChangeFailsSPO ) where import Cardano.Api as Api -import Cardano.Api.Ledger (EpochInterval (EpochInterval)) +import Cardano.Api.Experimental (Some (..)) +import Cardano.Api.Ledger (EpochInterval (..)) import Cardano.Testnet @@ -30,6 +31,7 @@ import Testnet.Defaults (defaultSpoColdKeyPair, defaultSpoKeys) import Testnet.Process.Cli.DRep import Testnet.Process.Cli.Keys (cliStakeAddressKeyGen) import qualified Testnet.Process.Cli.SPO as SPO +import Testnet.Process.Cli.SPO (createStakeKeyRegistrationCertificate) import Testnet.Process.Cli.Transaction (failToSubmitTx, signTx) import Testnet.Process.Run (execCli', mkExecConfig) import Testnet.Property.Util (integrationWorkspace) @@ -86,23 +88,15 @@ hprop_check_pparam_fails_spo = integrationWorkspace "test-pparam-spo" $ \tempAbs baseDir <- H.createDirectoryIfMissing $ gov "output" - let stakeVkeyFp = gov "stake.vkey" - stakeSKeyFp = gov "stake.skey" - stakeCertFp = gov "stake.regcert" - stakingKeys = KeyPair { verificationKey = File stakeVkeyFp - , signingKey= File stakeSKeyFp - } - - cliStakeAddressKeyGen stakingKeys - -- Register stake address - - void $ execCli' execConfig - [ eraName, "stake-address", "registration-certificate" - , "--stake-verification-key-file", stakeVkeyFp - , "--key-reg-deposit-amt", show @Int 0 -- TODO: why this needs to be 0???? - , "--out-file", stakeCertFp - ] + let stakeCertFp = gov "stake.regcert" + stakeKeys = KeyPair { verificationKey = File $ gov "stake.vkey" + , signingKey = File $ gov "stake.skey" + } + cliStakeAddressKeyGen stakeKeys + keyDeposit <- getKeyDeposit epochStateView ceo + createStakeKeyRegistrationCertificate + tempAbsPath (AnyShelleyBasedEra sbe) (verificationKey stakeKeys) keyDeposit stakeCertFp stakeCertTxBodyFp <- H.note $ work "stake.registration.txbody" stakeCertTxSignedFp <- H.note $ work "stake.registration.tx" @@ -123,7 +117,7 @@ hprop_check_pparam_fails_spo = integrationWorkspace "test-pparam-spo" $ \tempAbs [ eraName, "transaction", "sign" , "--tx-body-file", stakeCertTxBodyFp , "--signing-key-file", signingKeyFp $ paymentKeyInfoPair wallet1 - , "--signing-key-file", stakeSKeyFp + , "--signing-key-file", signingKeyFp stakeKeys , "--out-file", stakeCertTxSignedFp ] @@ -143,7 +137,7 @@ hprop_check_pparam_fails_spo = integrationWorkspace "test-pparam-spo" $ \tempAbs (governanceActionTxId, governanceActionIndex) <- makeActivityChangeProposal execConfig epochStateView ceo (baseDir "proposal") - Nothing (EpochInterval 3) stakingKeys wallet0 (EpochInterval 2) + Nothing (EpochInterval 3) stakeKeys wallet0 (EpochInterval 2) failToVoteChangeProposalWithSPOs ceo execConfig epochStateView baseDir "vote" governanceActionTxId governanceActionIndex propVotes wallet1 @@ -180,7 +174,7 @@ failToVoteChangeProposalWithSPOs ceo execConfig epochStateView work prefix voteTxBodyFp <- createVotingTxBody execConfig epochStateView sbe baseDir "vote-tx-body" voteFiles wallet - let signingKeys = SomeKeyPair (paymentKeyInfoPair wallet):(SomeKeyPair . defaultSpoColdKeyPair . snd <$> votes) + let signingKeys = Some (paymentKeyInfoPair wallet):(Some . defaultSpoColdKeyPair . snd <$> votes) voteTxFp <- signTx execConfig cEra baseDir "signed-vote-tx" voteTxBodyFp signingKeys failToSubmitTx execConfig cEra voteTxFp "DisallowedVoters" 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 f0174043d1c..025d2774592 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 @@ -11,6 +11,7 @@ module Cardano.Testnet.Test.Gov.PredefinedAbstainDRep import Cardano.Api as Api import Cardano.Api.Eon.ShelleyBasedEra (ShelleyLedgerEra) +import Cardano.Api.Experimental (Some (..)) import Cardano.Api.Ledger (EpochInterval (EpochInterval)) import Cardano.Ledger.Conway.Core (ppNOptL) @@ -42,8 +43,7 @@ import qualified Testnet.Process.Run as H import qualified Testnet.Property.Util as H import Testnet.Start.Types import Testnet.Types (KeyPair (..), - PaymentKeyInfo (paymentKeyInfoAddr, paymentKeyInfoPair), - SomeKeyPair (SomeKeyPair), StakingKey) + PaymentKeyInfo (paymentKeyInfoAddr, paymentKeyInfoPair), StakingKey) import Hedgehog import qualified Hedgehog.Extras as H @@ -158,8 +158,8 @@ delegateToAlwaysAbstain execConfig epochStateView sbe work prefix -- Sign transaction repRegSignedRegTx1 <- signTx execConfig cEra baseDir "signed-reg-tx" - repRegTxBody1 [ SomeKeyPair (paymentKeyInfoPair payingWallet) - , SomeKeyPair skeyPair] + repRegTxBody1 [ Some (paymentKeyInfoPair payingWallet) + , Some skeyPair] -- Submit transaction submitTx execConfig cEra repRegSignedRegTx1 @@ -281,7 +281,7 @@ makeDesiredPoolNumberChangeProposal execConfig epochStateView ceo work prefix ] signedProposalTx <- signTx execConfig cEra baseDir "signed-proposal" - (File proposalBody) [SomeKeyPair $ paymentKeyInfoPair wallet] + (File proposalBody) [Some $ paymentKeyInfoPair wallet] submitTx execConfig cEra signedProposalTx @@ -326,7 +326,7 @@ voteChangeProposal execConfig epochStateView sbe work prefix voteFiles wallet voteTxFp <- signTx execConfig cEra baseDir "signed-vote-tx" voteTxBodyFp - (SomeKeyPair (paymentKeyInfoPair wallet):[SomeKeyPair $ defaultDRepKeyPair n | (_, n) <- votes]) + (Some (paymentKeyInfoPair wallet):[Some $ defaultDRepKeyPair n | (_, n) <- votes]) submitTx execConfig cEra voteTxFp -- | Obtains the @desiredPoolNumberValue@ from the protocol parameters. 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 4c2ee15182b..f692fc690cb 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 @@ -9,6 +9,7 @@ module Cardano.Testnet.Test.Gov.ProposeNewConstitution ) where import Cardano.Api as Api +import Cardano.Api.Experimental (Some (..)) import Cardano.Api.Ledger (EpochInterval (..)) import qualified Cardano.Crypto.Hash as L @@ -37,6 +38,7 @@ import Testnet.Defaults import Testnet.EpochStateProcessing (waitForGovActionVotes) import Testnet.Process.Cli.DRep import Testnet.Process.Cli.Keys +import Testnet.Process.Cli.SPO (createStakeKeyRegistrationCertificate) import Testnet.Process.Cli.Transaction import Testnet.Process.Run (execCli', mkExecConfig) import Testnet.Property.Util (integrationWorkspace) @@ -113,22 +115,15 @@ hprop_ledger_events_propose_new_constitution = integrationWorkspace "propose-new [ "hash", "anchor-data", "--file-text", proposalAnchorFile ] - let stakeVkeyFp = gov "stake.vkey" - stakeSKeyFp = gov "stake.skey" - stakeCertFp = gov "stake.regcert" - - cliStakeAddressKeyGen - $ KeyPair { verificationKey = File stakeVkeyFp - , signingKey = File stakeSKeyFp - } -- Register stake address - - void $ execCli' execConfig - [ eraName, "stake-address", "registration-certificate" - , "--stake-verification-key-file", stakeVkeyFp - , "--key-reg-deposit-amt", show @Int 0 -- TODO: why this needs to be 0???? - , "--out-file", stakeCertFp - ] + let stakeCertFp = gov "stake.regcert" + stakeKeys = KeyPair { verificationKey = File $ gov "stake.vkey" + , signingKey = File $ gov "stake.skey" + } + cliStakeAddressKeyGen stakeKeys + keyDeposit <- getKeyDeposit epochStateView ceo + createStakeKeyRegistrationCertificate + tempAbsPath (AnyShelleyBasedEra sbe) (verificationKey stakeKeys) keyDeposit stakeCertFp stakeCertTxBodyFp <- H.note $ work "stake.registration.txbody" stakeCertTxSignedFp <- H.note $ work "stake.registration.tx" @@ -149,7 +144,7 @@ hprop_ledger_events_propose_new_constitution = integrationWorkspace "propose-new [ eraName, "transaction", "sign" , "--tx-body-file", stakeCertTxBodyFp , "--signing-key-file", signingKeyFp $ paymentKeyInfoPair wallet1 - , "--signing-key-file", stakeSKeyFp + , "--signing-key-file", signingKeyFp stakeKeys , "--out-file", stakeCertTxSignedFp ] @@ -175,7 +170,7 @@ hprop_ledger_events_propose_new_constitution = integrationWorkspace "propose-new [ "conway", "governance", "action", "create-constitution" , "--testnet" , "--governance-action-deposit", show minDRepDeposit - , "--deposit-return-stake-verification-key-file", stakeVkeyFp + , "--deposit-return-stake-verification-key-file", verificationKeyFp stakeKeys , "--anchor-url", "https://tinyurl.com/3wrwb2as" , "--anchor-data-hash", proposalAnchorDataHash , "--constitution-url", "https://tinyurl.com/2pahcy6z" @@ -199,7 +194,7 @@ hprop_ledger_events_propose_new_constitution = integrationWorkspace "propose-new ] signedProposalTx <- signTx execConfig cEra gov "signed-proposal" - (File txbodyFp) [SomeKeyPair $ paymentKeyInfoPair wallet1] + (File txbodyFp) [Some $ paymentKeyInfoPair wallet1] submitTx execConfig cEra signedProposalTx @@ -218,7 +213,7 @@ hprop_ledger_events_propose_new_constitution = integrationWorkspace "propose-new voteTxBodyFp <- createVotingTxBody execConfig epochStateView sbe work "vote-tx-body" voteFiles wallet0 - let signingKeys = SomeKeyPair <$> (paymentKeyInfoPair wallet0:(defaultDRepKeyPair . snd <$> allVotes)) + let signingKeys = Some <$> (paymentKeyInfoPair wallet0:(defaultDRepKeyPair . snd <$> allVotes)) voteTxFp <- signTx execConfig cEra gov "signed-vote-tx" voteTxBodyFp signingKeys submitTx execConfig cEra voteTxFp diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitutionSPO.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitutionSPO.hs index dcb239eafa9..60332862042 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitutionSPO.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitutionSPO.hs @@ -9,6 +9,7 @@ module Cardano.Testnet.Test.Gov.ProposeNewConstitutionSPO ) where import Cardano.Api +import Cardano.Api.Experimental (Some (..)) import Cardano.Api.Ledger import qualified Cardano.Ledger.Conway.Governance as L @@ -135,7 +136,7 @@ hprop_ledger_events_propose_new_constitution_spo = integrationWorkspace "propose , "--out-file", txBodyFp ] - txBodySigned <- signTx execConfig cEra work "proposal-signed-tx" (File txBodyFp) [SomeKeyPair $ paymentKeyInfoPair wallet0] + txBodySigned <- signTx execConfig cEra work "proposal-signed-tx" (File txBodyFp) [Some $ paymentKeyInfoPair wallet0] submitTx execConfig cEra txBodySigned @@ -160,8 +161,8 @@ hprop_ledger_events_propose_new_constitution_spo = integrationWorkspace "propose votesTxBody <- createVotingTxBody execConfig epochStateView sbe work "vote-tx-body" votes wallet0 votesSignedTx <- signTx execConfig cEra work "vote-signed-tx" - votesTxBody (SomeKeyPair (paymentKeyInfoPair wallet0) - :[SomeKeyPair $ defaultSpoColdKeyPair n | n <- [1..3]]) + votesTxBody (Some (paymentKeyInfoPair wallet0) + :[Some $ defaultSpoColdKeyPair n | n <- [1..3]]) -- Call should fail, because SPOs are unallowed to vote on the constitution failToSubmitTx execConfig cEra votesSignedTx "DisallowedVoters" diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryWithdrawal.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryWithdrawal.hs index 881c2519b0b..83877be9692 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryWithdrawal.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryWithdrawal.hs @@ -40,6 +40,7 @@ import System.FilePath (()) import Testnet.Components.Query import Testnet.Defaults import Testnet.Process.Cli.Keys (cliStakeAddressKeyGen) +import Testnet.Process.Cli.SPO (createStakeKeyRegistrationCertificate) import Testnet.Process.Run (execCli', mkExecConfig) import Testnet.Property.Util (integrationRetryWorkspace) import Testnet.Start.Types @@ -99,21 +100,15 @@ hprop_ledger_events_treasury_withdrawal = integrationRetryWorkspace 2 "treasury txin2 <- findLargestUtxoForPaymentKey epochStateView sbe wallet1 -- {{{ Register stake address - let stakeVkeyFp = gov "stake.vkey" - stakeSKeyFp = gov "stake.skey" - stakeCertFp = gov "stake.regcert" - - cliStakeAddressKeyGen - $ KeyPair { verificationKey = File stakeVkeyFp - , signingKey= File stakeSKeyFp - } + let stakeCertFp = gov "stake.regcert" + stakeKeys = KeyPair { verificationKey = File $ gov "stake.vkey" + , signingKey = File $ gov "stake.skey" + } + cliStakeAddressKeyGen stakeKeys + keyDeposit <- getKeyDeposit epochStateView ceo + createStakeKeyRegistrationCertificate + tempAbsPath (AnyShelleyBasedEra sbe) (verificationKey stakeKeys) keyDeposit stakeCertFp - void $ execCli' execConfig - [ eraName, "stake-address", "registration-certificate" - , "--stake-verification-key-file", stakeVkeyFp - , "--key-reg-deposit-amt", show @Int 0 -- TODO: why this needs to be 0???? - , "--out-file", stakeCertFp - ] stakeCertTxBodyFp <- H.note $ work "stake.registration.txbody" stakeCertTxSignedFp <- H.note $ work "stake.registration.tx" @@ -132,7 +127,7 @@ hprop_ledger_events_treasury_withdrawal = integrationRetryWorkspace 2 "treasury [ eraName, "transaction", "sign" , "--tx-body-file", stakeCertTxBodyFp , "--signing-key-file", signingKeyFp $ paymentKeyInfoPair wallet1 - , "--signing-key-file", stakeSKeyFp + , "--signing-key-file", signingKeyFp stakeKeys , "--out-file", stakeCertTxSignedFp ] @@ -151,9 +146,9 @@ hprop_ledger_events_treasury_withdrawal = integrationRetryWorkspace 2 "treasury , "--anchor-url", "https://tinyurl.com/3wrwb2as" , "--anchor-data-hash", proposalAnchorDataHash , "--governance-action-deposit", show govActionDeposit - , "--deposit-return-stake-verification-key-file", stakeVkeyFp + , "--deposit-return-stake-verification-key-file", verificationKeyFp stakeKeys , "--transfer", show withdrawalAmount - , "--funds-receiving-stake-verification-key-file", stakeVkeyFp + , "--funds-receiving-stake-verification-key-file", verificationKeyFp stakeKeys , "--out-file", treasuryWithdrawalActionFp ] 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 e8c61817b5e..8e993360147 100644 --- a/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs +++ b/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs @@ -11,6 +11,7 @@ import qualified Cardano.Testnet.Test.Cli.Query import qualified Cardano.Testnet.Test.Cli.QuerySlotNumber import qualified Cardano.Testnet.Test.Cli.StakeSnapshot import qualified Cardano.Testnet.Test.Cli.Transaction +import qualified Cardano.Testnet.Test.Cli.Transaction.RegisterDeregisterStakeAddress import qualified Cardano.Testnet.Test.FoldEpochState import qualified Cardano.Testnet.Test.Gov.CommitteeAddNew as Gov import qualified Cardano.Testnet.Test.Gov.DRepDeposit as Gov @@ -76,9 +77,10 @@ tests = do -- ShutdownOnSigint fails on Mac with -- "Log file: /private/tmp/tmp.JqcjW7sLKS/kes-period-info-2-test-30c2d0d8eb042a37/logs/test-spo.stdout.log had no logs indicating the relevant node has minted blocks." , ignoreOnMacAndWindows "Shutdown On Sigint" Cardano.Testnet.Test.Node.Shutdown.hprop_shutdownOnSigint - , ignoreOnWindows "ShutdownOnSlotSynced" Cardano.Testnet.Test.Node.Shutdown.hprop_shutdownOnSlotSynced - , ignoreOnWindows "stake-snapshot" Cardano.Testnet.Test.Cli.StakeSnapshot.hprop_stakeSnapshot + , ignoreOnWindows "Shutdown On SlotSynced" Cardano.Testnet.Test.Node.Shutdown.hprop_shutdownOnSlotSynced + , ignoreOnWindows "stake snapshot" Cardano.Testnet.Test.Cli.StakeSnapshot.hprop_stakeSnapshot , ignoreOnWindows "simple transaction build" Cardano.Testnet.Test.Cli.Transaction.hprop_transaction + , ignoreOnWindows "register deregister stake address in transaction build" Cardano.Testnet.Test.Cli.Transaction.RegisterDeregisterStakeAddress.hprop_tx_register_deregister_stake_address -- FIXME -- , ignoreOnMacAndWindows "leadership-schedule" Cardano.Testnet.Test.Cli.LeadershipSchedule.hprop_leadershipSchedule diff --git a/cardano-testnet/test/cardano-testnet-test/files/golden/queries/govStateOut.json b/cardano-testnet/test/cardano-testnet-test/files/golden/queries/govStateOut.json index 96dc93f55c8..ff31fb08fd1 100644 --- a/cardano-testnet/test/cardano-testnet-test/files/golden/queries/govStateOut.json +++ b/cardano-testnet/test/cardano-testnet-test/files/golden/queries/govStateOut.json @@ -652,7 +652,7 @@ "major": 10, "minor": 0 }, - "stakeAddressDeposit": 0, + "stakeAddressDeposit": 400000, "stakePoolDeposit": 0, "stakePoolTargetNum": 100, "treasuryCut": 0.1, @@ -1320,7 +1320,7 @@ "major": 10, "minor": 0 }, - "stakeAddressDeposit": 0, + "stakeAddressDeposit": 400000, "stakePoolDeposit": 0, "stakePoolTargetNum": 100, "treasuryCut": 0.1, @@ -1977,7 +1977,7 @@ "major": 10, "minor": 0 }, - "stakeAddressDeposit": 0, + "stakeAddressDeposit": 400000, "stakePoolDeposit": 0, "stakePoolTargetNum": 100, "treasuryCut": 0.1, @@ -2631,7 +2631,7 @@ "major": 10, "minor": 0 }, - "stakeAddressDeposit": 0, + "stakeAddressDeposit": 400000, "stakePoolDeposit": 0, "stakePoolTargetNum": 100, "treasuryCut": 0.1, diff --git a/cardano-testnet/test/cardano-testnet-test/files/golden/queries/protocolParametersFileOut.json b/cardano-testnet/test/cardano-testnet-test/files/golden/queries/protocolParametersFileOut.json index bfd05cf4ce3..b66a0bee7ee 100644 --- a/cardano-testnet/test/cardano-testnet-test/files/golden/queries/protocolParametersFileOut.json +++ b/cardano-testnet/test/cardano-testnet-test/files/golden/queries/protocolParametersFileOut.json @@ -641,7 +641,7 @@ "major": 10, "minor": 0 }, - "stakeAddressDeposit": 0, + "stakeAddressDeposit": 400000, "stakePoolDeposit": 0, "stakePoolTargetNum": 100, "treasuryCut": 0.1, diff --git a/cardano-testnet/test/cardano-testnet-test/files/golden/queries/protocolParametersOut.txt b/cardano-testnet/test/cardano-testnet-test/files/golden/queries/protocolParametersOut.txt index bfd05cf4ce3..b66a0bee7ee 100644 --- a/cardano-testnet/test/cardano-testnet-test/files/golden/queries/protocolParametersOut.txt +++ b/cardano-testnet/test/cardano-testnet-test/files/golden/queries/protocolParametersOut.txt @@ -641,7 +641,7 @@ "major": 10, "minor": 0 }, - "stakeAddressDeposit": 0, + "stakeAddressDeposit": 400000, "stakePoolDeposit": 0, "stakePoolTargetNum": 100, "treasuryCut": 0.1,