1
1
{-# LANGUAGE GADTs #-}
2
2
{-# LANGUAGE NumericUnderscores #-}
3
+ {-# LANGUAGE RankNTypes #-}
3
4
{-# LANGUAGE TypeApplications #-}
4
5
5
6
6
7
module Testnet.Components.SPO
7
8
( checkStakeKeyRegistered
8
- , convertToEraFlag
9
9
, createScriptStakeRegistrationCertificate
10
10
, createStakeDelegationCertificate
11
11
, createStakeKeyRegistrationCertificate
12
+ , createStakeKeyDeregistrationCertificate
12
13
, decodeEraUTxO
13
14
, registerSingleSpo
14
15
) where
@@ -22,7 +23,7 @@ import qualified Data.Map.Strict as Map
22
23
import Data.Set (Set )
23
24
import qualified Data.Set as Set
24
25
import qualified Data.Text as Text
25
- import GHC.Stack (HasCallStack )
26
+ import GHC.Stack (HasCallStack , withFrozenCallStack )
26
27
import qualified GHC.Stack as GHC
27
28
import System.FilePath.Posix ((</>) )
28
29
@@ -118,9 +119,9 @@ createStakeDelegationCertificate
118
119
createStakeDelegationCertificate tempAbsP anyCera delegatorStakeVerKey poolId outputFp =
119
120
GHC. withFrozenCallStack $ do
120
121
let tempAbsPath' = unTmpAbsPath tempAbsP
121
- void $ execCli
122
- [ " stake-address " , " delegation-certificate "
123
- , convertToEraFlag anyCera
122
+ execCli_
123
+ [ anyEraToString anyCera
124
+ , " stake-address " , " delegation-certificate "
124
125
, " --stake-verification-key-file" , delegatorStakeVerKey
125
126
, " --stake-pool-id" , poolId
126
127
, " --out-file" , tempAbsPath' </> outputFp
@@ -131,18 +132,23 @@ createStakeKeyRegistrationCertificate
131
132
=> TmpAbsolutePath
132
133
-> AnyCardanoEra
133
134
-> FilePath -- ^ Stake verification key file
135
+ -> Int -- ^ deposit amount used only in Conway
134
136
-> FilePath -- ^ Output file path
135
137
-> 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
- ]
138
+ createStakeKeyRegistrationCertificate tempAbsP (AnyCardanoEra cEra) stakeVerKey deposit outputFp = GHC. withFrozenCallStack $ do
139
+ sbe <- requireEon ShelleyEra cEra
140
+ let tempAbsPath' = unTmpAbsPath tempAbsP
141
+ extraArgs = caseShelleyToBabbageOrConwayEraOnwards
142
+ (const [] )
143
+ (const [" --key-reg-deposit-amt" , show deposit])
144
+ sbe
145
+ execCli_ $
146
+ [ eraToString cEra
147
+ , " stake-address" , " registration-certificate"
148
+ , " --stake-verification-key-file" , stakeVerKey
149
+ , " --out-file" , tempAbsPath' </> outputFp
150
+ ]
151
+ <> extraArgs
146
152
147
153
createScriptStakeRegistrationCertificate
148
154
:: (MonadTest m , MonadCatch m , MonadIO m , HasCallStack )
@@ -155,20 +161,39 @@ createScriptStakeRegistrationCertificate
155
161
createScriptStakeRegistrationCertificate tempAbsP anyCEra scriptFile deposit outputFp =
156
162
GHC. withFrozenCallStack $ do
157
163
let tempAbsPath' = unTmpAbsPath tempAbsP
158
-
159
- void $ execCli
164
+ execCli_
160
165
[ anyEraToString anyCEra
161
166
, " stake-address" , " registration-certificate"
162
167
, " --stake-script-file" , scriptFile
163
168
, " --key-reg-deposit-amt" , show deposit
164
169
, " --out-file" , tempAbsPath' </> outputFp
165
170
]
166
171
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
+ sbe <- requireEon ShelleyEra cEra
183
+ let tempAbsPath' = unTmpAbsPath tempAbsP
184
+ extraArgs = caseShelleyToBabbageOrConwayEraOnwards
185
+ (const [] )
186
+ (const [" --key-reg-deposit-amt" , show deposit])
187
+ sbe
188
+
189
+ execCli_ $
190
+ [ eraToString cEra
191
+ , " stake-address"
192
+ , " deregistration-certificate"
193
+ , " --stake-verification-key-file" , stakeVerKey
194
+ , " --out-file" , tempAbsPath' </> outputFp
195
+ ]
196
+ <> extraArgs
172
197
173
198
-- | Related documentation: https://github.com/input-output-hk/cardano-node-wiki/blob/main/docs/stake-pool-operations/8_register_stakepool.md
174
199
registerSingleSpo
@@ -192,7 +217,6 @@ registerSingleSpo
192
217
registerSingleSpo identifier tap@ (TmpAbsolutePath tempAbsPath') cTestnetOptions execConfig
193
218
(fundingInput, fundingSigninKey, changeAddr) = GHC. withFrozenCallStack $ do
194
219
let testnetMag = cardanoTestnetMagic cTestnetOptions
195
- eraFlag= convertToEraFlag $ cardanoNodeEra cTestnetOptions
196
220
197
221
workDir <- H. note tempAbsPath'
198
222
@@ -251,11 +275,12 @@ registerSingleSpo identifier tap@(TmpAbsolutePath tempAbsPath') cTestnetOptions
251
275
252
276
-- 5. Create registration certificate
253
277
let poolRegCertFp = spoReqDir </> " registration.cert"
278
+ let era = cardanoNodeEra cTestnetOptions
254
279
255
280
-- The pledge, pool cost and pool margin can all be 0
256
281
execCli_
257
- [ " stake-pool " , " registration-certificate "
258
- , " --babbage-era "
282
+ [ anyEraToString era
283
+ , " stake-pool " , " registration-certificate "
259
284
, " --testnet-magic" , show @ Int testnetMag
260
285
, " --pool-pledge" , " 0"
261
286
, " --pool-cost" , " 0"
@@ -272,15 +297,14 @@ registerSingleSpo identifier tap@(TmpAbsolutePath tempAbsPath') cTestnetOptions
272
297
273
298
-- Create pledger registration certificate
274
299
275
- createStakeKeyRegistrationCertificate
276
- tap
277
- (cardanoNodeEra cTestnetOptions)
300
+ createStakeKeyRegistrationCertificate tap era
278
301
poolOwnerstakeVkeyFp
302
+ 2_000_000
279
303
(workDir </> " pledger.regcert" )
280
304
281
305
void $ execCli' execConfig
282
- [ " transaction " , " build "
283
- , eraFlag
306
+ [ anyEraToString era
307
+ , " transaction " , " build "
284
308
, " --change-address" , changeAddr
285
309
, " --tx-in" , Text. unpack $ renderTxIn fundingInput
286
310
, " --tx-out" , poolowneraddresswstakecred <> " +" <> show @ Int 5_000_000
@@ -332,3 +356,17 @@ registerSingleSpo identifier tap@(TmpAbsolutePath tempAbsPath') cTestnetOptions
332
356
currentRegistedPoolsJson
333
357
return (poolId, poolColdSkeyFp, poolColdVkeyFp, vrfSkeyFp, vrfVkeyFp)
334
358
359
+
360
+ requireEon :: forall eon era minEra m . Eon eon
361
+ => MonadTest m
362
+ => CardanoEra minEra -- ^ minimal required era i.e. for 'ConwayEraOnwards' eon it's 'Conway'
363
+ -> CardanoEra era -- ^ node era
364
+ -> m (eon era )
365
+ -- TODO: implement 'Bounded' for `Some eon` and remove 'minEra'
366
+ requireEon minEra era = withFrozenCallStack $
367
+ maybe
368
+ (H. note_ errorMessage >> failure)
369
+ pure
370
+ (forEraMaybeEon era)
371
+ where
372
+ errorMessage = " Required at least " <> eraToString minEra <> " . Tried to execute in " <> eraToString era <> " ."
0 commit comments