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 27, 2024
1 parent 8b2f7c7 commit aa9210a
Show file tree
Hide file tree
Showing 11 changed files with 213 additions and 74 deletions.
1 change: 1 addition & 0 deletions cardano-testnet/cardano-testnet.cabal
Original file line number Diff line number Diff line change
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
63 changes: 39 additions & 24 deletions cardano-testnet/src/Testnet/Components/SPO.hs
Original file line number Diff line number Diff line change
Expand Up @@ -5,10 +5,10 @@

module Testnet.Components.SPO
( checkStakeKeyRegistered
, convertToEraFlag
, createScriptStakeRegistrationCertificate
, createStakeDelegationCertificate
, createStakeKeyRegistrationCertificate
, createStakeKeyDeregistrationCertificate
, decodeEraUTxO
, registerSingleSpo
) where
Expand Down Expand Up @@ -119,8 +119,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 +131,19 @@ createStakeKeyRegistrationCertificate
=> TmpAbsolutePath
-> AnyCardanoEra
-> FilePath -- ^ Stake verification key file
-> Int -- ^ deposit amount
-> FilePath -- ^ Output file path
-> m ()
createStakeKeyRegistrationCertificate tempAbsP anyCEra stakeVerKey outputFp =
GHC.withFrozenCallStack $ do
let tempAbsPath' = unTmpAbsPath tempAbsP
createStakeKeyRegistrationCertificate tempAbsP anyCEra stakeVerKey deposit 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
]
void $ execCli
[ anyEraToString anyCEra
, "stake-address", "registration-certificate"
, "--key-reg-deposit-amt", show deposit
, "--stake-verification-key-file", stakeVerKey
, "--out-file", tempAbsPath' </> outputFp
]

createScriptStakeRegistrationCertificate
:: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack)
Expand All @@ -164,11 +165,26 @@ 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
-> FilePath -- ^ Output file path
-> m ()
createStakeKeyDeregistrationCertificate tempAbsP anyCEra stakeVerKey deposit outputFp =
GHC.withFrozenCallStack $ do
let tempAbsPath' = unTmpAbsPath tempAbsP

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

-- | 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 +208,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 +266,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 +288,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
Original file line number Diff line number Diff line change
@@ -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
Original file line number Diff line number Diff line change
@@ -1,4 +1,3 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
Expand Down
Original file line number Diff line number Diff line change
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
Original file line number Diff line number Diff line change
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
Original file line number Diff line number Diff line change
@@ -0,0 +1,137 @@
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.Testnet.Test.Cli.Conway.RepeatedCertificatesInTransaction where

import Cardano.Api hiding (Value)

import Cardano.Testnet

import Prelude

import Control.Monad (void)
import qualified Data.Aeson as A
import qualified Data.Aeson.Encode.Pretty as A
import qualified Data.Aeson.Lens as L
import Data.String
import qualified Data.Text as Text
import Lens.Micro
import System.FilePath ((</>))
import qualified System.Info as SYS

import Testnet.Components.Configuration (anyEraToString, eraToString)
import Testnet.Components.Query
import Testnet.Components.SPO
import Testnet.Process.Cli hiding (File)
import qualified Testnet.Process.Run as H
import Testnet.Process.Run
import qualified Testnet.Property.Utils as H
import Testnet.Runtime

import Hedgehog (Property, (===))
import qualified Hedgehog as H
import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO
import qualified Hedgehog.Extras.Test.Base as H
import qualified Hedgehog.Extras.Test.File as H

hprop_repeated_certificates_in_transaction :: Property
hprop_repeated_certificates_in_transaction = H.integrationRetryWorkspace 0 "repeated-certificates-in-tx" $ \tempAbsBasePath' -> do
H.note_ SYS.os
conf@Conf { tempAbsPath } <- mkConf tempAbsBasePath'
let tempAbsPath' = unTmpAbsPath tempAbsPath
work <- H.createDirectoryIfMissing $ tempAbsPath' </> "work"

let
sbe = ShelleyBasedEraConway
era = AnyCardanoEra $ toCardanoEra sbe
eraString = anyEraToString era

tempBaseAbsPath = makeTmpBaseAbsPath $ TmpAbsolutePath tempAbsPath'
options = cardanoDefaultTestnetOptions
{ cardanoNodeEra = era
}

TestnetRuntime
{ configurationFile
, testnetMagic
, poolNodes
, wallets=wallet0:wallet1:_
} <- cardanoTestnetDefault options conf

poolNode1 <- H.headM poolNodes
poolSprocket1 <- H.noteShow $ nodeSprocket $ poolRuntime poolNode1
execConfig <- H.mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic

let socketName' = IO.sprocketName poolSprocket1
socketBase = IO.sprocketBase poolSprocket1 -- /tmp
socketPath = socketBase </> socketName'
epochStateView <- getEpochStateView (File configurationFile) (File socketPath)


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"
testDelegatorRegCertFp = testStakeDelegator </> "test-delegator.regcert"
testDelegatorDeregCertFp = testStakeDelegator </> "test-delegator.deregcert"

_ <- cliStakeAddressKeyGen work
$ KeyNames testDelegatorVkeyFp testDelegatorSKeyFp
_ <- cliAddressKeyGen work
$ KeyNames testDelegatorPaymentVKeyFp testDelegatorPaymentSKeyFp

-- NB: We must include the stake credential
testDelegatorPaymentAddr <- execCli
[ "address", "build"
, "--testnet-magic", show @Int testnetMagic
, "--payment-verification-key-file", testDelegatorPaymentVKeyFp
, "--stake-verification-key-file", testDelegatorVkeyFp
]

-- Test stake address registration cert
createStakeKeyRegistrationCertificate
tempAbsPath
era
testDelegatorVkeyFp
2_000_000
testDelegatorRegCertFp

createStakeKeyDeregistrationCertificate
tempAbsPath
era
testDelegatorVkeyFp
2_000_000
testDelegatorDeregCertFp

txin1 <- findLargestUtxoForPaymentKey epochStateView sbe wallet0
multipleCertTxBodyFp <- H.note $ work </> "registration.txbody"
void $ execCli' execConfig
[ eraString
, "transaction", "build"
, "--change-address", testDelegatorPaymentAddr -- NB: A large balance ends up at our test delegator's address
, "--tx-in", Text.unpack $ renderTxIn txin1
, "--tx-out", Text.unpack (paymentKeyInfoAddr wallet1) <> "+" <> show @Int 5_000_000
, "--witness-override", show @Int 2
, "--certificate-file", testDelegatorRegCertFp
, "--certificate-file", testDelegatorDeregCertFp
, "--certificate-file", testDelegatorRegCertFp
, "--certificate-file", testDelegatorDeregCertFp
, "--certificate-file", testDelegatorRegCertFp
, "--out-file", multipleCertTxBodyFp
]

txJson <- (H.leftFail . A.eitherDecode @A.Value . fromString) =<< H.execCli
["transaction", "view"
, "--tx-file", multipleCertTxBodyFp
]
A.Success certificates <- fmap (A.fromJSON @[A.Value]) . H.nothingFail $ txJson ^? L.key "certificates"
H.noteShow_ $ A.encode certificates
length certificates === 5

Loading

0 comments on commit aa9210a

Please sign in to comment.