Skip to content

Commit 4b8f3d2

Browse files
authored
Merge pull request #5950 from IntersectMBO/smelc/cardano-testnet-to-sbe
cardano-testnet: use ShelleyBasedEra instead of CardanoEra (i.e. remove Byron support in types)
2 parents e9ab511 + aa785d4 commit 4b8f3d2

33 files changed

+147
-263
lines changed

cardano-testnet/src/Parsers/Cardano.hs

Lines changed: 5 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,10 @@
1-
{-# LANGUAGE LambdaCase #-}
21
{-# LANGUAGE NumericUnderscores #-}
32

43
module Parsers.Cardano
54
( cmdCardano
65
) where
76

8-
import Cardano.Api (AnyCardanoEra (..), EraInEon (..), ToCardanoEra (..), bounded)
7+
import Cardano.Api (EraInEon (..), bounded, AnyShelleyBasedEra (AnyShelleyBasedEra))
98

109
import Cardano.CLI.Environment
1110
import Cardano.CLI.EraBased.Options.Common hiding (pNetworkId)
@@ -25,9 +24,8 @@ import Testnet.Types (readNodeLoggingFormat)
2524

2625
optsTestnet :: EnvCli -> Parser CardanoTestnetOptions
2726
optsTestnet envCli = CardanoTestnetOptions
28-
-- TODO <$> (OA.many pSpo <|> pNumSpoNodes)
2927
<$> pNumSpoNodes
30-
<*> pCardanoEra
28+
<*> pAnyShelleyBasedEra'
3129
<*> OA.option auto
3230
( OA.long "epoch-length"
3331
<> OA.help "Epoch length, in number of slots"
@@ -77,14 +75,10 @@ optsTestnet envCli = CardanoTestnetOptions
7775
<> OA.help "Enable new epoch state logging to logs/ledger-epoch-state.log"
7876
<> OA.showDefault
7977
)
80-
8178
where
82-
-- TODO replace era in 'CardanoTestnetOptions' 'AnyShelleyBasedEra' - we're not supporting
83-
-- byron testnets
84-
pCardanoEra :: Parser AnyCardanoEra
85-
pCardanoEra =
86-
pAnyShelleyBasedEra envCli <&>
87-
\case EraInEon eon -> AnyCardanoEra $ toCardanoEra eon
79+
pAnyShelleyBasedEra' :: Parser AnyShelleyBasedEra
80+
pAnyShelleyBasedEra' =
81+
pAnyShelleyBasedEra envCli <&> (\(EraInEon x) -> AnyShelleyBasedEra x)
8882

8983
pNumSpoNodes :: Parser [TestnetNodeOptions]
9084
pNumSpoNodes =

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

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -61,7 +61,7 @@ import System.FilePath.Posix (takeDirectory, (</>))
6161
import Testnet.Defaults
6262
import Testnet.Filepath
6363
import Testnet.Process.Run (execCli_)
64-
import Testnet.Start.Types (CardanoTestnetOptions (..), anyEraToString, eraToString)
64+
import Testnet.Start.Types (CardanoTestnetOptions (..), anyEraToString, anyShelleyBasedEraToString, eraToString)
6565

6666
import Hedgehog
6767
import qualified Hedgehog as H
@@ -73,9 +73,9 @@ import qualified Hedgehog.Extras.Test.File as H
7373
createConfigJson :: ()
7474
=> (MonadTest m, MonadIO m, HasCallStack)
7575
=> TmpAbsolutePath
76-
-> AnyCardanoEra -- ^ The era used for generating the hard fork configuration toggle
76+
-> ShelleyBasedEra era -- ^ The era used for generating the hard fork configuration toggle
7777
-> m LBS.ByteString
78-
createConfigJson (TmpAbsolutePath tempAbsPath) era = GHC.withFrozenCallStack $ do
78+
createConfigJson (TmpAbsolutePath tempAbsPath) sbe = GHC.withFrozenCallStack $ do
7979
byronGenesisHash <- getByronGenesisHash $ tempAbsPath </> "byron/genesis.json"
8080
shelleyGenesisHash <- getHash ShelleyEra "ShelleyGenesisHash"
8181
alonzoGenesisHash <- getHash AlonzoEra "AlonzoGenesisHash"
@@ -86,7 +86,7 @@ createConfigJson (TmpAbsolutePath tempAbsPath) era = GHC.withFrozenCallStack $ d
8686
, shelleyGenesisHash
8787
, alonzoGenesisHash
8888
, conwayGenesisHash
89-
, defaultYamlHardforkViaConfig era
89+
, defaultYamlHardforkViaConfig sbe
9090
]
9191
where
9292
getHash :: (MonadTest m, MonadIO m) => CardanoEra a -> Text.Text -> m (KeyMap Value)
@@ -132,13 +132,13 @@ createSPOGenesisAndFiles
132132
:: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack)
133133
=> NumPools -- ^ The number of pools to make
134134
-> NumDReps -- ^ The number of pools to make
135-
-> AnyCardanoEra -- ^ The era to use
135+
-> AnyShelleyBasedEra -- ^ The era to use
136136
-> ShelleyGenesis StandardCrypto -- ^ The shelley genesis to use.
137137
-> AlonzoGenesis -- ^ The alonzo genesis to use, for example 'getDefaultAlonzoGenesis' from this module.
138138
-> ConwayGenesis StandardCrypto -- ^ The conway genesis to use, for example 'Defaults.defaultConwayGenesis'.
139139
-> TmpAbsolutePath
140140
-> m FilePath -- ^ Shelley genesis directory
141-
createSPOGenesisAndFiles (NumPools numPoolNodes) (NumDReps numDelReps) era shelleyGenesis
141+
createSPOGenesisAndFiles (NumPools numPoolNodes) (NumDReps numDelReps) sbe shelleyGenesis
142142
alonzoGenesis conwayGenesis (TmpAbsolutePath tempAbsPath) = GHC.withFrozenCallStack $ do
143143
let inputGenesisShelleyFp = tempAbsPath </> genesisInputFilepath ShelleyEra
144144
inputGenesisAlonzoFp = tempAbsPath </> genesisInputFilepath AlonzoEra
@@ -175,7 +175,7 @@ createSPOGenesisAndFiles (NumPools numPoolNodes) (NumDReps numDelReps) era shell
175175
H.note_ $ "Number of seeded UTxO keys: " <> show numSeededUTxOKeys
176176

177177
execCli_
178-
[ anyEraToString era, "genesis", "create-testnet-data"
178+
[ anyShelleyBasedEraToString sbe, "genesis", "create-testnet-data"
179179
, "--spec-shelley", inputGenesisShelleyFp
180180
, "--spec-alonzo", inputGenesisAlonzoFp
181181
, "--spec-conway", inputGenesisConwayFp

cardano-testnet/src/Testnet/Defaults.hs

Lines changed: 37 additions & 45 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
{-# LANGUAGE DataKinds #-}
22
{-# LANGUAGE GADTs #-}
3+
{-# LANGUAGE LambdaCase #-}
34
{-# LANGUAGE NamedFieldPuns #-}
45
{-# LANGUAGE NumericUnderscores #-}
56
{-# LANGUAGE OverloadedStrings #-}
@@ -31,8 +32,8 @@ module Testnet.Defaults
3132
, plutusV3Script
3233
) where
3334

34-
import Cardano.Api (AnyCardanoEra (..), CardanoEra (..), File (..), pshow,
35-
unsafeBoundedRational)
35+
import Cardano.Api (CardanoEra (..), File (..), pshow, ShelleyBasedEra (..),
36+
toCardanoEra, unsafeBoundedRational, AnyShelleyBasedEra (..))
3637
import qualified Cardano.Api.Shelley as Api
3738

3839
import Cardano.Ledger.Alonzo.Core (PParams (..))
@@ -86,9 +87,9 @@ newtype AlonzoGenesisError
8687
= AlonzoGenErrTooMuchPrecision Rational
8788
deriving Show
8889

89-
defaultAlonzoGenesis :: CardanoEra era -> Either AlonzoGenesisError AlonzoGenesis
90-
defaultAlonzoGenesis era = do
91-
let genesis = Api.alonzoGenesisDefaults era
90+
defaultAlonzoGenesis :: ShelleyBasedEra era -> Either AlonzoGenesisError AlonzoGenesis
91+
defaultAlonzoGenesis sbe = do
92+
let genesis = Api.alonzoGenesisDefaults (toCardanoEra sbe)
9293
prices = Ledger.agPrices genesis
9394

9495
-- double check that prices have correct values - they're set using unsafeBoundedRational in cardano-api
@@ -150,61 +151,54 @@ defaultConwayGenesis =
150151

151152
-- | Configuration value that allows you to hardfork to any Cardano era
152153
-- at epoch 0.
153-
defaultYamlHardforkViaConfig :: AnyCardanoEra -> KeyMapAeson.KeyMap Aeson.Value
154-
defaultYamlHardforkViaConfig era =
154+
defaultYamlHardforkViaConfig :: ShelleyBasedEra era -> KeyMapAeson.KeyMap Aeson.Value
155+
defaultYamlHardforkViaConfig sbe =
155156
mconcat $ concat
156157
[ defaultYamlConfig
157158
, tracers
158-
, protocolVersions era
159-
, hardforkViaConfig era
159+
, protocolVersions sbe
160+
, hardforkViaConfig sbe
160161
]
161162

162163
where
163164
-- The protocol version number gets used by block producing nodes as part
164165
-- of the system for agreeing on and synchronising protocol updates.
165166
-- NB: We follow the mainnet protocol versions and assume the latest
166167
-- protocol version for a given era that has had an intraera hardfork.
167-
protocolVersions :: AnyCardanoEra -> [KeyMapAeson.KeyMap Aeson.Value]
168-
protocolVersions (AnyCardanoEra era') =
169-
case era' of
170-
ByronEra ->
171-
map (uncurry KeyMapAeson.singleton)
172-
-- We assume Byron with Ouroboros permissive BFT
173-
[ ("LastKnownBlockVersion-Major", Aeson.Number 1)
174-
, ("LastKnownBlockVersion-Minor", Aeson.Number 0)
175-
, ("LastKnownBlockVersion-Alt", Aeson.Number 0)
176-
]
177-
ShelleyEra ->
168+
protocolVersions :: ShelleyBasedEra era -> [KeyMapAeson.KeyMap Aeson.Value]
169+
protocolVersions sbe' =
170+
case sbe' of
171+
ShelleyBasedEraShelley ->
178172
map (uncurry KeyMapAeson.singleton)
179173
[ ("LastKnownBlockVersion-Major", Aeson.Number 2)
180174
, ("LastKnownBlockVersion-Minor", Aeson.Number 0)
181175
, ("LastKnownBlockVersion-Alt", Aeson.Number 0)
182176
]
183-
AllegraEra ->
177+
ShelleyBasedEraAllegra ->
184178
map (uncurry KeyMapAeson.singleton)
185179
[ ("LastKnownBlockVersion-Major", Aeson.Number 3)
186180
, ("LastKnownBlockVersion-Minor", Aeson.Number 0)
187181
, ("LastKnownBlockVersion-Alt", Aeson.Number 0)
188182
]
189-
MaryEra ->
183+
ShelleyBasedEraMary ->
190184
map (uncurry KeyMapAeson.singleton)
191185
[ ("LastKnownBlockVersion-Major", Aeson.Number 4)
192186
, ("LastKnownBlockVersion-Minor", Aeson.Number 0)
193187
, ("LastKnownBlockVersion-Alt", Aeson.Number 0)
194188
]
195-
AlonzoEra ->
189+
ShelleyBasedEraAlonzo ->
196190
map (uncurry KeyMapAeson.singleton)
197191
[ ("LastKnownBlockVersion-Major", Aeson.Number 5)
198192
, ("LastKnownBlockVersion-Minor", Aeson.Number 0)
199193
, ("LastKnownBlockVersion-Alt", Aeson.Number 0)
200194
]
201-
BabbageEra ->
195+
ShelleyBasedEraBabbage ->
202196
map (uncurry KeyMapAeson.singleton)
203197
[ ("LastKnownBlockVersion-Major", Aeson.Number 8)
204198
, ("LastKnownBlockVersion-Minor", Aeson.Number 0)
205199
, ("LastKnownBlockVersion-Alt", Aeson.Number 0)
206200
]
207-
ConwayEra ->
201+
ShelleyBasedEraConway ->
208202
map (uncurry KeyMapAeson.singleton)
209203
[ ("LastKnownBlockVersion-Major", Aeson.Number 9)
210204
, ("LastKnownBlockVersion-Minor", Aeson.Number 0)
@@ -214,32 +208,31 @@ defaultYamlHardforkViaConfig era =
214208
-- Allows a direct hardfork to an era of your choice via the configuration.
215209
-- This removes the usual requirement for submitting an update proposal,
216210
-- waiting for the protocol to change and then restarting the nodes.
217-
hardforkViaConfig :: AnyCardanoEra -> [KeyMapAeson.KeyMap Aeson.Value]
218-
hardforkViaConfig (AnyCardanoEra era') =
219-
case era' of
220-
ByronEra -> []
221-
ShelleyEra ->
211+
hardforkViaConfig :: ShelleyBasedEra era -> [KeyMapAeson.KeyMap Aeson.Value]
212+
hardforkViaConfig sbe' =
213+
case sbe' of
214+
ShelleyBasedEraShelley ->
222215
map (uncurry KeyMapAeson.singleton)
223216
[ ("ExperimentalHardForksEnabled", Aeson.Bool True)
224217
, ("ExperimentalProtocolsEnabled", Aeson.Bool True)
225218
, ("TestShelleyHardForkAtEpoch", Aeson.Number 0)
226219
]
227-
AllegraEra ->
220+
ShelleyBasedEraAllegra ->
228221
map (uncurry KeyMapAeson.singleton)
229222
[ ("ExperimentalHardForksEnabled", Aeson.Bool True)
230223
, ("ExperimentalProtocolsEnabled", Aeson.Bool True)
231224
, ("TestShelleyHardForkAtEpoch", Aeson.Number 0)
232225
, ("TestAllegraHardForkAtEpoch", Aeson.Number 0)
233226
]
234-
MaryEra ->
227+
ShelleyBasedEraMary ->
235228
map (uncurry KeyMapAeson.singleton)
236229
[ ("ExperimentalHardForksEnabled", Aeson.Bool True)
237230
, ("ExperimentalProtocolsEnabled", Aeson.Bool True)
238231
, ("TestShelleyHardForkAtEpoch", Aeson.Number 0)
239232
, ("TestAllegraHardForkAtEpoch", Aeson.Number 0)
240233
, ("TestMaryHardForkAtEpoch", Aeson.Number 0)
241234
]
242-
AlonzoEra ->
235+
ShelleyBasedEraAlonzo ->
243236
map (uncurry KeyMapAeson.singleton)
244237
[ ("ExperimentalHardForksEnabled", Aeson.Bool True)
245238
, ("ExperimentalProtocolsEnabled", Aeson.Bool True)
@@ -248,7 +241,7 @@ defaultYamlHardforkViaConfig era =
248241
, ("TestMaryHardForkAtEpoch", Aeson.Number 0)
249242
, ("TestAlonzoHardForkAtEpoch", Aeson.Number 0)
250243
]
251-
BabbageEra ->
244+
ShelleyBasedEraBabbage ->
252245
map (uncurry KeyMapAeson.singleton)
253246
[ ("ExperimentalHardForksEnabled", Aeson.Bool True)
254247
, ("ExperimentalProtocolsEnabled", Aeson.Bool True)
@@ -258,7 +251,7 @@ defaultYamlHardforkViaConfig era =
258251
, ("TestAlonzoHardForkAtEpoch", Aeson.Number 0)
259252
, ("TestBabbageHardForkAtEpoch", Aeson.Number 0)
260253
]
261-
ConwayEra ->
254+
ShelleyBasedEraConway ->
262255
map (uncurry KeyMapAeson.singleton)
263256
[ ("ExperimentalHardForksEnabled", Aeson.Bool True)
264257
, ("ExperimentalProtocolsEnabled", Aeson.Bool True)
@@ -456,19 +449,18 @@ defaultShelleyGenesis startTime testnetOptions = do
456449
}
457450

458451

459-
eraToProtocolVersion :: AnyCardanoEra -> ProtVer
460-
eraToProtocolVersion (AnyCardanoEra era) =
461-
case era of
462-
ByronEra -> error "eraToProtocolVersion: Byron not supported"
463-
ShelleyEra -> mkProtVer (2, 0)
464-
AllegraEra -> mkProtVer (3, 0)
465-
MaryEra -> mkProtVer (4, 0)
452+
eraToProtocolVersion :: AnyShelleyBasedEra -> ProtVer
453+
eraToProtocolVersion =
454+
\case
455+
AnyShelleyBasedEra ShelleyBasedEraShelley -> mkProtVer (2, 0)
456+
AnyShelleyBasedEra ShelleyBasedEraAllegra -> mkProtVer (3, 0)
457+
AnyShelleyBasedEra ShelleyBasedEraMary -> mkProtVer (4, 0)
466458
-- Alonzo had an intra-era hardfork
467-
AlonzoEra -> mkProtVer (6, 0)
459+
AnyShelleyBasedEra ShelleyBasedEraAlonzo -> mkProtVer (6, 0)
468460
-- Babbage had an intra-era hardfork
469-
BabbageEra -> mkProtVer (8, 0)
461+
AnyShelleyBasedEra ShelleyBasedEraBabbage -> mkProtVer (8, 0)
470462
-- By default start after bootstrap (which is PV9)
471-
ConwayEra -> mkProtVer (10, 0)
463+
AnyShelleyBasedEra ShelleyBasedEraConway -> mkProtVer (10, 0)
472464

473465
-- TODO: Expose from cardano-api
474466
mkProtVer :: (Natural, Natural) -> ProtVer

cardano-testnet/src/Testnet/Process/Cli/SPO.hs

Lines changed: 16 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -159,16 +159,16 @@ toApiPoolId = StakePoolKeyHash
159159
createStakeDelegationCertificate
160160
:: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack)
161161
=> TmpAbsolutePath
162-
-> AnyCardanoEra
162+
-> ShelleyBasedEra era
163163
-> FilePath -- ^ Delegate stake verification key file
164164
-> String -- ^ Pool id
165165
-> FilePath
166166
-> m ()
167-
createStakeDelegationCertificate tempAbsP (AnyCardanoEra cEra) delegatorStakeVerKey poolId outputFp =
167+
createStakeDelegationCertificate tempAbsP sbe delegatorStakeVerKey poolId outputFp =
168168
GHC.withFrozenCallStack $ do
169169
let tempAbsPath' = unTmpAbsPath tempAbsP
170170
execCli_
171-
[ eraToString cEra
171+
[ eraToString sbe
172172
, "stake-address", "stake-delegation-certificate"
173173
, "--stake-verification-key-file", delegatorStakeVerKey
174174
, "--stake-pool-id", poolId
@@ -178,17 +178,18 @@ createStakeDelegationCertificate tempAbsP (AnyCardanoEra cEra) delegatorStakeVer
178178
createStakeKeyRegistrationCertificate
179179
:: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack)
180180
=> TmpAbsolutePath
181-
-> AnyCardanoEra
181+
-> AnyShelleyBasedEra
182182
-> FilePath -- ^ Stake verification key file
183183
-> Int -- ^ deposit amount used only in Conway
184184
-> FilePath -- ^ Output file path
185185
-> m ()
186-
createStakeKeyRegistrationCertificate tempAbsP (AnyCardanoEra cEra) stakeVerKey deposit outputFp = GHC.withFrozenCallStack $ do
186+
createStakeKeyRegistrationCertificate tempAbsP asbe stakeVerKey deposit outputFp = GHC.withFrozenCallStack $ do
187+
AnyShelleyBasedEra sbe <- return asbe
187188
let tempAbsPath' = unTmpAbsPath tempAbsP
188-
extraArgs = monoidForEraInEon @ConwayEraOnwards cEra $
189+
extraArgs = monoidForEraInEon @ConwayEraOnwards (toCardanoEra sbe) $
189190
const ["--key-reg-deposit-amt", show deposit]
190191
execCli_ $
191-
[ eraToString cEra
192+
[ eraToString sbe
192193
, "stake-address", "registration-certificate"
193194
, "--stake-verification-key-file", stakeVerKey
194195
, "--out-file", tempAbsPath' </> outputFp
@@ -219,18 +220,18 @@ createScriptStakeRegistrationCertificate tempAbsP (AnyCardanoEra cEra) scriptFil
219220
createStakeKeyDeregistrationCertificate
220221
:: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack)
221222
=> TmpAbsolutePath
222-
-> AnyCardanoEra
223+
-> ShelleyBasedEra era
223224
-> FilePath -- ^ Stake verification key file
224225
-> Int -- ^ deposit amount used only in Conway
225226
-> FilePath -- ^ Output file path
226227
-> m ()
227-
createStakeKeyDeregistrationCertificate tempAbsP (AnyCardanoEra cEra) stakeVerKey deposit outputFp =
228+
createStakeKeyDeregistrationCertificate tempAbsP sbe stakeVerKey deposit outputFp =
228229
GHC.withFrozenCallStack $ do
229230
let tempAbsPath' = unTmpAbsPath tempAbsP
230-
extraArgs = monoidForEraInEon @ConwayEraOnwards cEra $
231+
extraArgs = monoidForEraInEon @ConwayEraOnwards (toCardanoEra sbe) $
231232
const ["--key-reg-deposit-amt", show deposit]
232233
execCli_ $
233-
[ eraToString cEra
234+
[ eraToString sbe
234235
, "stake-address" , "deregistration-certificate"
235236
, "--stake-verification-key-file", stakeVerKey
236237
, "--out-file", tempAbsPath' </> outputFp
@@ -321,11 +322,11 @@ registerSingleSpo identifier tap@(TmpAbsolutePath tempAbsPath') nodeConfigFile s
321322

322323
-- 5. Create registration certificate
323324
let poolRegCertFp = spoReqDir </> "registration.cert"
324-
let era = cardanoNodeEra cTestnetOptions
325+
let asbe = cardanoNodeEra cTestnetOptions
325326

326327
-- The pledge, pool cost and pool margin can all be 0
327328
execCli_
328-
[ anyEraToString era
329+
[ anyShelleyBasedEraToString asbe
329330
, "stake-pool", "registration-certificate"
330331
, "--testnet-magic", show @Int testnetMag
331332
, "--pool-pledge", "0"
@@ -343,13 +344,13 @@ registerSingleSpo identifier tap@(TmpAbsolutePath tempAbsPath') nodeConfigFile s
343344

344345
-- Create pledger registration certificate
345346

346-
createStakeKeyRegistrationCertificate tap era
347+
createStakeKeyRegistrationCertificate tap asbe
347348
poolOwnerstakeVkeyFp
348349
2_000_000
349350
(workDir </> "pledger.regcert")
350351

351352
void $ execCli' execConfig
352-
[ anyEraToString era
353+
[ anyShelleyBasedEraToString asbe
353354
, "transaction", "build"
354355
, "--change-address", changeAddr
355356
, "--tx-in", Text.unpack $ renderTxIn fundingInput

0 commit comments

Comments
 (0)