Skip to content

Commit 4beaff3

Browse files
authored
Merge pull request #5733 from IntersectMBO/mgalazyn/refactor/testnet-spo-functions
Refactor testnet SPO certificates functions
2 parents 8430590 + 2a0ef9d commit 4beaff3

File tree

14 files changed

+121
-149
lines changed

14 files changed

+121
-149
lines changed

cardano-node/test/Test/Cardano/Node/Gen.hs

-1
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,4 @@
11
{-# LANGUAGE AllowAmbiguousTypes #-}
2-
{-# LANGUAGE CPP #-}
32
{-# LANGUAGE DataKinds #-}
43
{-# LANGUAGE OverloadedStrings #-}
54
{-# LANGUAGE ScopedTypeVariables #-}

cardano-testnet/src/Testnet/Components/SPO.hs

+54-36
Original file line numberDiff line numberDiff line change
@@ -1,14 +1,16 @@
11
{-# LANGUAGE GADTs #-}
22
{-# LANGUAGE NumericUnderscores #-}
3+
{-# LANGUAGE RankNTypes #-}
4+
{-# LANGUAGE ScopedTypeVariables #-}
35
{-# LANGUAGE TypeApplications #-}
46

57

68
module Testnet.Components.SPO
79
( checkStakeKeyRegistered
8-
, convertToEraFlag
910
, createScriptStakeRegistrationCertificate
1011
, createStakeDelegationCertificate
1112
, createStakeKeyRegistrationCertificate
13+
, createStakeKeyDeregistrationCertificate
1214
, decodeEraUTxO
1315
, registerSingleSpo
1416
) where
@@ -115,12 +117,12 @@ createStakeDelegationCertificate
115117
-> String -- ^ Pool id
116118
-> FilePath
117119
-> m ()
118-
createStakeDelegationCertificate tempAbsP anyCera delegatorStakeVerKey poolId outputFp =
120+
createStakeDelegationCertificate tempAbsP (AnyCardanoEra cEra) delegatorStakeVerKey poolId outputFp =
119121
GHC.withFrozenCallStack $ do
120122
let tempAbsPath' = unTmpAbsPath tempAbsP
121-
void $ execCli
122-
[ "stake-address", "delegation-certificate"
123-
, convertToEraFlag anyCera
123+
execCli_
124+
[ eraToString cEra
125+
, "stake-address", "stake-delegation-certificate"
124126
, "--stake-verification-key-file", delegatorStakeVerKey
125127
, "--stake-pool-id", poolId
126128
, "--out-file", tempAbsPath' </> outputFp
@@ -131,44 +133,62 @@ createStakeKeyRegistrationCertificate
131133
=> TmpAbsolutePath
132134
-> AnyCardanoEra
133135
-> FilePath -- ^ Stake verification key file
136+
-> Int -- ^ deposit amount used only in Conway
134137
-> FilePath -- ^ Output file path
135138
-> m ()
136-
createStakeKeyRegistrationCertificate tempAbsP anyCEra stakeVerKey outputFp =
137-
GHC.withFrozenCallStack $ do
138-
let tempAbsPath' = unTmpAbsPath tempAbsP
139-
140-
void $ execCli
141-
[ "stake-address", "registration-certificate"
142-
, convertToEraFlag anyCEra
143-
, "--stake-verification-key-file", stakeVerKey
144-
, "--out-file", tempAbsPath' </> outputFp
145-
]
139+
createStakeKeyRegistrationCertificate tempAbsP (AnyCardanoEra cEra) stakeVerKey deposit outputFp = GHC.withFrozenCallStack $ do
140+
let tempAbsPath' = unTmpAbsPath tempAbsP
141+
extraArgs = monoidForEraInEon @ConwayEraOnwards cEra $
142+
const ["--key-reg-deposit-amt", show deposit]
143+
execCli_ $
144+
[ eraToString cEra
145+
, "stake-address", "registration-certificate"
146+
, "--stake-verification-key-file", stakeVerKey
147+
, "--out-file", tempAbsPath' </> outputFp
148+
]
149+
<> extraArgs
146150

147151
createScriptStakeRegistrationCertificate
148152
:: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack)
149153
=> TmpAbsolutePath
150154
-> AnyCardanoEra
151155
-> FilePath -- ^ Script file
152-
-> Int -- ^ Registration deposit amount
156+
-> Int -- ^ Registration deposit amount used only in Conway
153157
-> FilePath -- ^ Output file path
154158
-> m ()
155-
createScriptStakeRegistrationCertificate tempAbsP anyCEra scriptFile deposit outputFp =
159+
createScriptStakeRegistrationCertificate tempAbsP (AnyCardanoEra cEra) scriptFile deposit outputFp =
156160
GHC.withFrozenCallStack $ do
157161
let tempAbsPath' = unTmpAbsPath tempAbsP
158-
159-
void $ execCli
160-
[ anyEraToString anyCEra
162+
extraArgs = monoidForEraInEon @ConwayEraOnwards cEra $
163+
const ["--key-reg-deposit-amt", show deposit]
164+
execCli_ $
165+
[ eraToString cEra
161166
, "stake-address", "registration-certificate"
162167
, "--stake-script-file", scriptFile
163-
, "--key-reg-deposit-amt", show deposit
164168
, "--out-file", tempAbsPath' </> outputFp
165169
]
170+
<> extraArgs
166171

167-
168-
-- TODO: Remove me and replace with new era based commands
169-
-- i.e "conway", "babbage" etc
170-
convertToEraFlag :: AnyCardanoEra -> String
171-
convertToEraFlag era = "--" <> anyEraToString era <> "-era"
172+
createStakeKeyDeregistrationCertificate
173+
:: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack)
174+
=> TmpAbsolutePath
175+
-> AnyCardanoEra
176+
-> FilePath -- ^ Stake verification key file
177+
-> Int -- ^ deposit amount used only in Conway
178+
-> FilePath -- ^ Output file path
179+
-> m ()
180+
createStakeKeyDeregistrationCertificate tempAbsP (AnyCardanoEra cEra) stakeVerKey deposit outputFp =
181+
GHC.withFrozenCallStack $ do
182+
let tempAbsPath' = unTmpAbsPath tempAbsP
183+
extraArgs = monoidForEraInEon @ConwayEraOnwards cEra $
184+
const ["--key-reg-deposit-amt", show deposit]
185+
execCli_ $
186+
[ eraToString cEra
187+
, "stake-address" , "deregistration-certificate"
188+
, "--stake-verification-key-file", stakeVerKey
189+
, "--out-file", tempAbsPath' </> outputFp
190+
]
191+
<> extraArgs
172192

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

197216
workDir <- H.note tempAbsPath'
198217

@@ -251,11 +270,12 @@ registerSingleSpo identifier tap@(TmpAbsolutePath tempAbsPath') cTestnetOptions
251270

252271
-- 5. Create registration certificate
253272
let poolRegCertFp = spoReqDir </> "registration.cert"
273+
let era = cardanoNodeEra cTestnetOptions
254274

255275
-- The pledge, pool cost and pool margin can all be 0
256276
execCli_
257-
[ "stake-pool", "registration-certificate"
258-
, "--babbage-era"
277+
[ anyEraToString era
278+
, "stake-pool", "registration-certificate"
259279
, "--testnet-magic", show @Int testnetMag
260280
, "--pool-pledge", "0"
261281
, "--pool-cost", "0"
@@ -272,15 +292,14 @@ registerSingleSpo identifier tap@(TmpAbsolutePath tempAbsPath') cTestnetOptions
272292

273293
-- Create pledger registration certificate
274294

275-
createStakeKeyRegistrationCertificate
276-
tap
277-
(cardanoNodeEra cTestnetOptions)
295+
createStakeKeyRegistrationCertificate tap era
278296
poolOwnerstakeVkeyFp
297+
2_000_000
279298
(workDir </> "pledger.regcert")
280299

281300
void $ execCli' execConfig
282-
[ "transaction", "build"
283-
, eraFlag
301+
[ anyEraToString era
302+
, "transaction", "build"
284303
, "--change-address", changeAddr
285304
, "--tx-in", Text.unpack $ renderTxIn fundingInput
286305
, "--tx-out", poolowneraddresswstakecred <> "+" <> show @Int 5_000_000
@@ -310,7 +329,7 @@ registerSingleSpo identifier tap@(TmpAbsolutePath tempAbsPath') cTestnetOptions
310329
]
311330
-- TODO: Currently we can't propagate the error message thrown by checkStakeKeyRegistered when using byDurationM
312331
-- Instead we wait 15 seconds
313-
threadDelay 15_000000
332+
threadDelay 15_000_000
314333
-- Check the pledger/owner stake key was registered
315334
delegsAndRewards <-
316335
checkStakeKeyRegistered
@@ -331,4 +350,3 @@ registerSingleSpo identifier tap@(TmpAbsolutePath tempAbsPath') cTestnetOptions
331350
poolColdVkeyFp
332351
currentRegistedPoolsJson
333352
return (poolId, poolColdSkeyFp, poolColdVkeyFp, vrfSkeyFp, vrfVkeyFp)
334-

cardano-testnet/src/Testnet/Property/Utils.hs

+1
Original file line numberDiff line numberDiff line change
@@ -122,3 +122,4 @@ runInBackground act = void . H.evalM $ allocate (H.async act) cleanUp
122122

123123
decodeEraUTxO :: (IsShelleyBasedEra era, MonadTest m) => ShelleyBasedEra era -> Aeson.Value -> m (UTxO era)
124124
decodeEraUTxO _ = H.jsonErrorFail . Aeson.fromJSON
125+

cardano-testnet/src/Testnet/Start/Cardano.hs

-1
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,3 @@
1-
{-# LANGUAGE CPP #-}
21
{-# LANGUAGE DataKinds #-}
32
{-# LANGUAGE NamedFieldPuns #-}
43
{-# LANGUAGE OverloadedStrings #-}

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/LeadershipSchedule.hs

+4-4
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,4 @@
11
{-# LANGUAGE BlockArguments #-}
2-
{-# LANGUAGE CPP #-}
32
{-# LANGUAGE DisambiguateRecordFields #-}
43
{-# LANGUAGE NamedFieldPuns #-}
54
{-# LANGUAGE NumericUnderscores #-}
@@ -135,6 +134,7 @@ hprop_leadershipSchedule = H.integrationRetryWorkspace 2 "babbage-leadership-sch
135134
tempAbsPath
136135
(cardanoNodeEra cTestnetOptions)
137136
testDelegatorVkeyFp
137+
2_000_000
138138
testDelegatorRegCertFp
139139

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

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

167167
void $ execCli' execConfig
168-
[ "transaction", "build"
169-
, eraFlag
168+
[ eraString
169+
, "transaction", "build"
170170
, "--change-address", testDelegatorPaymentAddr -- NB: A large balance ends up at our test delegator's address
171171
, "--tx-in", Text.unpack $ renderTxIn txin2
172172
, "--tx-out", utxoAddr <> "+" <> show @Int 5_000_000

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/Transaction.hs

-1
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,3 @@
1-
{-# LANGUAGE CPP #-}
21
{-# LANGUAGE DisambiguateRecordFields #-}
32
{-# LANGUAGE LambdaCase #-}
43
{-# LANGUAGE NamedFieldPuns #-}

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/DRepRetirement.hs

+8-15
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,3 @@
1-
{-# LANGUAGE CPP #-}
21
{-# LANGUAGE DataKinds #-}
32
{-# LANGUAGE GADTs #-}
43
{-# LANGUAGE NamedFieldPuns #-}
@@ -7,12 +6,6 @@
76
{-# LANGUAGE ScopedTypeVariables #-}
87
{-# LANGUAGE TypeApplications #-}
98

10-
#if __GLASGOW_HASKELL__ >= 908
11-
{-# OPTIONS_GHC -Wno-x-partial #-}
12-
#endif
13-
14-
{- HLINT ignore "Use head" -}
15-
169
module Cardano.Testnet.Test.Cli.Conway.DRepRetirement
1710
( hprop_drep_retirement
1811
) where
@@ -64,7 +57,7 @@ hprop_drep_retirement = H.integrationRetryWorkspace 2 "drep-retirement" $ \tempA
6457
TestnetRuntime
6558
{ testnetMagic
6659
, poolNodes
67-
, wallets
60+
, wallets=wallet0:_
6861
, configurationFile
6962
}
7063
<- cardanoTestnetDefault fastTestnetOptions conf
@@ -111,7 +104,7 @@ hprop_drep_retirement = H.integrationRetryWorkspace 2 "drep-retirement" $ \tempA
111104
, "--out-file", drepCertFile n
112105
]
113106

114-
txin1 <- findLargestUtxoForPaymentKey epochStateView sbe $ wallets !! 0
107+
txin1 <- findLargestUtxoForPaymentKey epochStateView sbe wallet0
115108

116109
-- Submit registration certificates
117110
drepRegTxbodyFp <- H.note $ work </> "drep.registration.txbody"
@@ -120,7 +113,7 @@ hprop_drep_retirement = H.integrationRetryWorkspace 2 "drep-retirement" $ \tempA
120113
H.noteM_ $ H.execCli' execConfig
121114
[ "conway", "transaction", "build"
122115
, "--tx-in", Text.unpack $ renderTxIn txin1
123-
, "--change-address", Text.unpack $ paymentKeyInfoAddr $ wallets !! 0
116+
, "--change-address", Text.unpack $ paymentKeyInfoAddr wallet0
124117
, "--certificate-file", drepCertFile 1
125118
, "--certificate-file", drepCertFile 2
126119
, "--certificate-file", drepCertFile 3
@@ -131,7 +124,7 @@ hprop_drep_retirement = H.integrationRetryWorkspace 2 "drep-retirement" $ \tempA
131124
H.noteM_ $ H.execCli' execConfig
132125
[ "conway", "transaction", "sign"
133126
, "--tx-body-file", drepRegTxbodyFp
134-
, "--signing-key-file", paymentSKey $ paymentKeyInfoPair $ wallets !! 0
127+
, "--signing-key-file", paymentSKey $ paymentKeyInfoPair wallet0
135128
, "--signing-key-file", drepSKeyFp 1
136129
, "--signing-key-file", drepSKeyFp 2
137130
, "--signing-key-file", drepSKeyFp 3
@@ -161,20 +154,20 @@ hprop_drep_retirement = H.integrationRetryWorkspace 2 "drep-retirement" $ \tempA
161154

162155
H.noteM_ $ H.execCli' execConfig
163156
[ "conway", "query", "utxo"
164-
, "--address", Text.unpack $ paymentKeyInfoAddr $ wallets !! 0
157+
, "--address", Text.unpack $ paymentKeyInfoAddr wallet0
165158
, "--cardano-mode"
166159
, "--out-file", work </> "utxo-11.json"
167160
]
168161

169-
txin2 <- findLargestUtxoForPaymentKey epochStateView sbe $ wallets !! 0
162+
txin2 <- findLargestUtxoForPaymentKey epochStateView sbe wallet0
170163

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

174167
H.noteM_ $ H.execCli' execConfig
175168
[ "conway", "transaction", "build"
176169
, "--tx-in", Text.unpack $ renderTxIn txin2
177-
, "--change-address", Text.unpack $ paymentKeyInfoAddr $ wallets !! 0
170+
, "--change-address", Text.unpack $ paymentKeyInfoAddr wallet0
178171
, "--certificate-file", dreprRetirementCertFile
179172
, "--witness-override", "2"
180173
, "--out-file", drepRetirementRegTxbodyFp
@@ -183,7 +176,7 @@ hprop_drep_retirement = H.integrationRetryWorkspace 2 "drep-retirement" $ \tempA
183176
H.noteM_ $ H.execCli' execConfig
184177
[ "conway", "transaction", "sign"
185178
, "--tx-body-file", drepRetirementRegTxbodyFp
186-
, "--signing-key-file", paymentSKey $ paymentKeyInfoPair $ wallets !! 0
179+
, "--signing-key-file", paymentSKey $ paymentKeyInfoPair wallet0
187180
, "--signing-key-file", drepSKeyFp 1
188181
, "--out-file", drepRetirementRegTxSignedFp
189182
]

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/Plutus.hs

-1
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,6 @@
1010
{- HLINT ignore "Redundant id" -}
1111
{- HLINT ignore "Redundant return" -}
1212
{- HLINT ignore "Use head" -}
13-
{- HLINT ignore "Use let" -}
1413

1514
module Cardano.Testnet.Test.Cli.Conway.Plutus
1615
( hprop_plutus_v3

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/StakeSnapshot.hs

-2
Original file line numberDiff line numberDiff line change
@@ -3,8 +3,6 @@
33
{-# LANGUAGE OverloadedStrings #-}
44
{-# LANGUAGE ScopedTypeVariables #-}
55

6-
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
7-
86
module Cardano.Testnet.Test.Cli.Conway.StakeSnapshot
97
( hprop_stakeSnapshot
108
) where

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/KesPeriodInfo.hs

+4-4
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,3 @@
1-
{-# LANGUAGE CPP #-}
21
{-# LANGUAGE DataKinds #-}
32
{-# LANGUAGE DisambiguateRecordFields #-}
43
{-# LANGUAGE GADTs #-}
@@ -127,6 +126,7 @@ hprop_kes_period_info = H.integrationRetryWorkspace 2 "kes-period-info" $ \tempA
127126
tempAbsPath
128127
(cardanoNodeEra cTestnetOptions)
129128
testDelegatorVkeyFp
129+
2_000_000
130130
testDelegatorRegCertFp
131131

132132
-- Test stake address deleg cert
@@ -153,12 +153,12 @@ hprop_kes_period_info = H.integrationRetryWorkspace 2 "kes-period-info" $ \tempA
153153
UTxO utxo2 <- H.noteShowM $ decodeEraUTxO sbe utxo2Json
154154
txin2 <- H.noteShow =<< H.headM (Map.keys utxo2)
155155

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

159159
void $ execCli' execConfig
160-
[ "transaction", "build"
161-
, eraFlag
160+
[ eraString
161+
, "transaction", "build"
162162
, "--change-address", testDelegatorPaymentAddr -- NB: A large balance ends up at our test delegator's address
163163
, "--tx-in", Text.unpack $ renderTxIn txin2
164164
, "--tx-out", utxoAddr <> "+" <> show @Int 5_000_000

0 commit comments

Comments
 (0)