Skip to content

Commit

Permalink
Repeated certs test
Browse files Browse the repository at this point in the history
  • Loading branch information
carbolymer committed Mar 28, 2024
1 parent 8b2f7c7 commit 89b1f1f
Show file tree
Hide file tree
Showing 11 changed files with 240 additions and 76 deletions.
1 change: 1 addition & 0 deletions cardano-testnet/cardano-testnet.cabal
Expand Up @@ -173,6 +173,7 @@ test-suite cardano-testnet-test
Cardano.Testnet.Test.Cli.Babbage.Transaction
Cardano.Testnet.Test.Cli.Conway.DRepRetirement
Cardano.Testnet.Test.Cli.Conway.Plutus
Cardano.Testnet.Test.Cli.Conway.RepeatedCertificatesInTransaction
Cardano.Testnet.Test.Cli.Conway.StakeSnapshot
Cardano.Testnet.Test.Cli.KesPeriodInfo
Cardano.Testnet.Test.Cli.Queries
Expand Down
92 changes: 66 additions & 26 deletions cardano-testnet/src/Testnet/Components/SPO.hs
@@ -1,14 +1,15 @@
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}


module Testnet.Components.SPO
( checkStakeKeyRegistered
, convertToEraFlag
, createScriptStakeRegistrationCertificate
, createStakeDelegationCertificate
, createStakeKeyRegistrationCertificate
, createStakeKeyDeregistrationCertificate
, decodeEraUTxO
, registerSingleSpo
) where
Expand All @@ -22,7 +23,7 @@ import qualified Data.Map.Strict as Map
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.Text as Text
import GHC.Stack (HasCallStack)
import GHC.Stack (HasCallStack, withFrozenCallStack)
import qualified GHC.Stack as GHC
import System.FilePath.Posix ((</>))

Expand Down Expand Up @@ -119,8 +120,8 @@ createStakeDelegationCertificate tempAbsP anyCera delegatorStakeVerKey poolId ou
GHC.withFrozenCallStack $ do
let tempAbsPath' = unTmpAbsPath tempAbsP
void $ execCli
[ "stake-address", "delegation-certificate"
, convertToEraFlag anyCera
[ anyEraToString anyCera
, "stake-address", "delegation-certificate"
, "--stake-verification-key-file", delegatorStakeVerKey
, "--stake-pool-id", poolId
, "--out-file", tempAbsPath' </> outputFp
Expand All @@ -131,18 +132,24 @@ createStakeKeyRegistrationCertificate
=> TmpAbsolutePath
-> AnyCardanoEra
-> FilePath -- ^ Stake verification key file
-> Int -- ^ deposit amount used only in Conway
-> FilePath -- ^ Output file path
-> m ()
createStakeKeyRegistrationCertificate tempAbsP anyCEra stakeVerKey outputFp =
GHC.withFrozenCallStack $ do
let tempAbsPath' = unTmpAbsPath tempAbsP

void $ execCli
[ "stake-address", "registration-certificate"
, convertToEraFlag anyCEra
, "--stake-verification-key-file", stakeVerKey
, "--out-file", tempAbsPath' </> outputFp
]
createStakeKeyRegistrationCertificate tempAbsP anyCEra@(AnyCardanoEra cEra) stakeVerKey deposit outputFp = GHC.withFrozenCallStack $ do
sbe <- requireEon ShelleyEra cEra
let tempAbsPath' = unTmpAbsPath tempAbsP
extraArgs = caseShelleyToBabbageOrConwayEraOnwards
(const [])
(const ["--key-reg-deposit-amt", show deposit])
sbe

execCli_ $
[ anyEraToString anyCEra
, "stake-address", "registration-certificate"
, "--stake-verification-key-file", stakeVerKey
, "--out-file", tempAbsPath' </> outputFp
]
<> extraArgs

createScriptStakeRegistrationCertificate
:: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack)
Expand All @@ -164,11 +171,31 @@ createScriptStakeRegistrationCertificate tempAbsP anyCEra scriptFile deposit out
, "--out-file", tempAbsPath' </> outputFp
]

createStakeKeyDeregistrationCertificate
:: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack)
=> TmpAbsolutePath
-> AnyCardanoEra
-> FilePath -- ^ Stake verification key file
-> Int -- ^ deposit amount used only in Conway
-> FilePath -- ^ Output file path
-> m ()
createStakeKeyDeregistrationCertificate tempAbsP anyCEra@(AnyCardanoEra cEra) stakeVerKey deposit outputFp =
GHC.withFrozenCallStack $ do
sbe <- requireEon ShelleyEra cEra
let tempAbsPath' = unTmpAbsPath tempAbsP
extraArgs = caseShelleyToBabbageOrConwayEraOnwards
(const [])
(const ["--key-reg-deposit-amt", show deposit])
sbe

-- TODO: Remove me and replace with new era based commands
-- i.e "conway", "babbage" etc
convertToEraFlag :: AnyCardanoEra -> String
convertToEraFlag era = "--" <> anyEraToString era <> "-era"
execCli_ $
[ anyEraToString anyCEra
, "stake-address"
, "deregistration-certificate"
, "--stake-verification-key-file", stakeVerKey
, "--out-file", tempAbsPath' </> outputFp
]
<> extraArgs

-- | Related documentation: https://github.com/input-output-hk/cardano-node-wiki/blob/main/docs/stake-pool-operations/8_register_stakepool.md
registerSingleSpo
Expand All @@ -192,7 +219,6 @@ registerSingleSpo
registerSingleSpo identifier tap@(TmpAbsolutePath tempAbsPath') cTestnetOptions execConfig
(fundingInput, fundingSigninKey, changeAddr) = GHC.withFrozenCallStack $ do
let testnetMag = cardanoTestnetMagic cTestnetOptions
eraFlag= convertToEraFlag $ cardanoNodeEra cTestnetOptions

workDir <- H.note tempAbsPath'

Expand Down Expand Up @@ -251,11 +277,12 @@ registerSingleSpo identifier tap@(TmpAbsolutePath tempAbsPath') cTestnetOptions

-- 5. Create registration certificate
let poolRegCertFp = spoReqDir </> "registration.cert"
let era = cardanoNodeEra cTestnetOptions

-- The pledge, pool cost and pool margin can all be 0
execCli_
[ "stake-pool", "registration-certificate"
, "--babbage-era"
[ anyEraToString era
, "stake-pool", "registration-certificate"
, "--testnet-magic", show @Int testnetMag
, "--pool-pledge", "0"
, "--pool-cost", "0"
Expand All @@ -272,15 +299,14 @@ registerSingleSpo identifier tap@(TmpAbsolutePath tempAbsPath') cTestnetOptions

-- Create pledger registration certificate

createStakeKeyRegistrationCertificate
tap
(cardanoNodeEra cTestnetOptions)
createStakeKeyRegistrationCertificate tap era
poolOwnerstakeVkeyFp
2_000_000
(workDir </> "pledger.regcert")

void $ execCli' execConfig
[ "transaction", "build"
, eraFlag
[ anyEraToString era
, "transaction", "build"
, "--change-address", changeAddr
, "--tx-in", Text.unpack $ renderTxIn fundingInput
, "--tx-out", poolowneraddresswstakecred <> "+" <> show @Int 5_000_000
Expand Down Expand Up @@ -332,3 +358,17 @@ registerSingleSpo identifier tap@(TmpAbsolutePath tempAbsPath') cTestnetOptions
currentRegistedPoolsJson
return (poolId, poolColdSkeyFp, poolColdVkeyFp, vrfSkeyFp, vrfVkeyFp)


requireEon :: forall eon era minEra m. Eon eon
=> MonadTest m
=> CardanoEra minEra -- ^ minimal required era i.e. for 'ConwayEraOnwards' eon it's 'Conway'
-> CardanoEra era -- ^ node era
-> m (eon era)
-- TODO: implement 'Bounded' for `Some eon` and remove 'minEra'
requireEon minEra era = withFrozenCallStack $
maybe
(H.note_ errorMessage >> failure)
pure
(forEraMaybeEon era)
where
errorMessage = "Required at least " <> eraToString minEra <> ". Tried to execute in " <> eraToString era <> "."
@@ -1,5 +1,4 @@
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NumericUnderscores #-}
Expand Down Expand Up @@ -135,6 +134,7 @@ hprop_leadershipSchedule = H.integrationRetryWorkspace 2 "babbage-leadership-sch
tempAbsPath
(cardanoNodeEra cTestnetOptions)
testDelegatorVkeyFp
2_000_000
testDelegatorRegCertFp

-- Test stake address deleg cert
Expand All @@ -161,12 +161,12 @@ hprop_leadershipSchedule = H.integrationRetryWorkspace 2 "babbage-leadership-sch
UTxO utxo2 <- H.noteShowM $ decodeEraUTxO sbe utxo2Json
txin2 <- H.noteShow =<< H.headM (Map.keys utxo2)

let eraFlag = convertToEraFlag $ cardanoNodeEra cTestnetOptions
let eraString = anyEraToString $ cardanoNodeEra cTestnetOptions
delegRegTestDelegatorTxBodyFp = work </> "deleg-register-test-delegator.txbody"

void $ execCli' execConfig
[ "transaction", "build"
, eraFlag
[ eraString
, "transaction", "build"
, "--change-address", testDelegatorPaymentAddr -- NB: A large balance ends up at our test delegator's address
, "--tx-in", Text.unpack $ renderTxIn txin2
, "--tx-out", utxoAddr <> "+" <> show @Int 5_000_000
Expand Down
@@ -1,4 +1,3 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
Expand Down
Expand Up @@ -7,12 +7,6 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

#if __GLASGOW_HASKELL__ >= 908
{-# OPTIONS_GHC -Wno-x-partial #-}
#endif

{- HLINT ignore "Use head" -}

module Cardano.Testnet.Test.Cli.Conway.DRepRetirement
( hprop_drep_retirement
) where
Expand Down Expand Up @@ -64,7 +58,7 @@ hprop_drep_retirement = H.integrationRetryWorkspace 2 "drep-retirement" $ \tempA
TestnetRuntime
{ testnetMagic
, poolNodes
, wallets
, wallets=wallet0:_
, configurationFile
}
<- cardanoTestnetDefault fastTestnetOptions conf
Expand Down Expand Up @@ -111,7 +105,7 @@ hprop_drep_retirement = H.integrationRetryWorkspace 2 "drep-retirement" $ \tempA
, "--out-file", drepCertFile n
]

txin1 <- findLargestUtxoForPaymentKey epochStateView sbe $ wallets !! 0
txin1 <- findLargestUtxoForPaymentKey epochStateView sbe wallet0

-- Submit registration certificates
drepRegTxbodyFp <- H.note $ work </> "drep.registration.txbody"
Expand All @@ -120,7 +114,7 @@ hprop_drep_retirement = H.integrationRetryWorkspace 2 "drep-retirement" $ \tempA
H.noteM_ $ H.execCli' execConfig
[ "conway", "transaction", "build"
, "--tx-in", Text.unpack $ renderTxIn txin1
, "--change-address", Text.unpack $ paymentKeyInfoAddr $ wallets !! 0
, "--change-address", Text.unpack $ paymentKeyInfoAddr wallet0
, "--certificate-file", drepCertFile 1
, "--certificate-file", drepCertFile 2
, "--certificate-file", drepCertFile 3
Expand All @@ -131,7 +125,7 @@ hprop_drep_retirement = H.integrationRetryWorkspace 2 "drep-retirement" $ \tempA
H.noteM_ $ H.execCli' execConfig
[ "conway", "transaction", "sign"
, "--tx-body-file", drepRegTxbodyFp
, "--signing-key-file", paymentSKey $ paymentKeyInfoPair $ wallets !! 0
, "--signing-key-file", paymentSKey $ paymentKeyInfoPair wallet0
, "--signing-key-file", drepSKeyFp 1
, "--signing-key-file", drepSKeyFp 2
, "--signing-key-file", drepSKeyFp 3
Expand Down Expand Up @@ -161,20 +155,20 @@ hprop_drep_retirement = H.integrationRetryWorkspace 2 "drep-retirement" $ \tempA

H.noteM_ $ H.execCli' execConfig
[ "conway", "query", "utxo"
, "--address", Text.unpack $ paymentKeyInfoAddr $ wallets !! 0
, "--address", Text.unpack $ paymentKeyInfoAddr wallet0
, "--cardano-mode"
, "--out-file", work </> "utxo-11.json"
]

txin2 <- findLargestUtxoForPaymentKey epochStateView sbe $ wallets !! 0
txin2 <- findLargestUtxoForPaymentKey epochStateView sbe wallet0

drepRetirementRegTxbodyFp <- H.note $ work </> "drep.retirement.txbody"
drepRetirementRegTxSignedFp <- H.note $ work </> "drep.retirement.tx"

H.noteM_ $ H.execCli' execConfig
[ "conway", "transaction", "build"
, "--tx-in", Text.unpack $ renderTxIn txin2
, "--change-address", Text.unpack $ paymentKeyInfoAddr $ wallets !! 0
, "--change-address", Text.unpack $ paymentKeyInfoAddr wallet0
, "--certificate-file", dreprRetirementCertFile
, "--witness-override", "2"
, "--out-file", drepRetirementRegTxbodyFp
Expand All @@ -183,7 +177,7 @@ hprop_drep_retirement = H.integrationRetryWorkspace 2 "drep-retirement" $ \tempA
H.noteM_ $ H.execCli' execConfig
[ "conway", "transaction", "sign"
, "--tx-body-file", drepRetirementRegTxbodyFp
, "--signing-key-file", paymentSKey $ paymentKeyInfoPair $ wallets !! 0
, "--signing-key-file", paymentSKey $ paymentKeyInfoPair wallet0
, "--signing-key-file", drepSKeyFp 1
, "--out-file", drepRetirementRegTxSignedFp
]
Expand Down
Expand Up @@ -10,7 +10,6 @@
{- HLINT ignore "Redundant id" -}
{- HLINT ignore "Redundant return" -}
{- HLINT ignore "Use head" -}
{- HLINT ignore "Use let" -}

module Cardano.Testnet.Test.Cli.Conway.Plutus
( hprop_plutus_v3
Expand Down

0 comments on commit 89b1f1f

Please sign in to comment.