diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs index 50410f3da..bea18c357 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE LambdaCase #-} module Cardano.CLI.EraBased.Commands.Genesis @@ -19,6 +20,7 @@ module Cardano.CLI.EraBased.Commands.Genesis where import qualified Cardano.Api.Byron as Byron +import qualified Cardano.Api.Experimental as Exp import Cardano.Api.Ledger (Coin) import Cardano.Api.Shelley @@ -30,7 +32,7 @@ data GenesisCmds era = GenesisCreate !(GenesisCreateCmdArgs era) | GenesisCreateCardano !(GenesisCreateCardanoCmdArgs era) | GenesisCreateStaked !(GenesisCreateStakedCmdArgs era) - | GenesisCreateTestNetData !(GenesisCreateTestNetDataCmdArgs era) + | GenesisCreateTestNetData !GenesisCreateTestNetDataCmdArgs | GenesisKeyGenGenesis !GenesisKeyGenGenesisCmdArgs | GenesisKeyGenDelegate !GenesisKeyGenDelegateCmdArgs | GenesisKeyGenUTxO !GenesisKeyGenUTxOCmdArgs @@ -92,8 +94,10 @@ data GenesisCreateStakedCmdArgs era = GenesisCreateStakedCmdArgs } deriving Show -data GenesisCreateTestNetDataCmdArgs era = GenesisCreateTestNetDataCmdArgs - { eon :: !(ShelleyBasedEra era) +-- TODO This existential type parameter should become a regular type parameter +-- when we parameterize the parent type by the experimental era API. +data GenesisCreateTestNetDataCmdArgs = forall era. GenesisCreateTestNetDataCmdArgs + { eon :: !(Exp.Era era) , specShelley :: !(Maybe FilePath) -- ^ Path to the @genesis-shelley@ file to use. If unspecified, a default one will be used. , specAlonzo :: !(Maybe FilePath) @@ -127,7 +131,9 @@ data GenesisCreateTestNetDataCmdArgs era = GenesisCreateTestNetDataCmdArgs , outputDir :: !FilePath -- ^ Directory where to write credentials and files. } - deriving Show + +instance Show GenesisCreateTestNetDataCmdArgs where + show _ = "GenesisCreateTestNetDataCmdArgs" data GenesisKeyGenGenesisCmdArgs = GenesisKeyGenGenesisCmdArgs { verificationKeyPath :: !(VerificationKeyFile Out) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs index f6e749b04..c920276eb 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs @@ -11,6 +11,7 @@ where import Cardano.Api hiding (QueryInShelleyBasedEra (..)) import qualified Cardano.Api.Byron as Byron +import qualified Cardano.Api.Experimental as Exp import Cardano.Api.Ledger (Coin (..)) import Cardano.CLI.Environment (EnvCli (..)) @@ -217,18 +218,18 @@ pGenesisCreateStaked sbe envCli = pRelayJsonFp = parseFilePath "relay-specification-file" "JSON file that specifies the relays of each stake pool." -pGenesisCreateTestNetData :: ShelleyBasedEra era -> EnvCli -> Parser (GenesisCmds era) -pGenesisCreateTestNetData sbe envCli = +pGenesisCreateTestNetData :: Exp.Era era -> EnvCli -> Parser (GenesisCmds era) +pGenesisCreateTestNetData era envCli = fmap GenesisCreateTestNetData $ - GenesisCreateTestNetDataCmdArgs sbe + GenesisCreateTestNetDataCmdArgs era <$> optional (pSpecFile "shelley") <*> optional (pSpecFile "alonzo") <*> optional (pSpecFile "conway") <*> pNumGenesisKeys <*> pNumPools <*> pNumStakeDelegs - <*> pNumCommittee - <*> pNumDReps + <*> (case era of Exp.BabbageEra -> pure 0; Exp.ConwayEra -> pNumCommittee) -- Committee doesn't exist in babbage + <*> (case era of Exp.BabbageEra -> pure $ DRepCredentials OnDisk 0; Exp.ConwayEra -> pNumDReps) -- DReps don't exist in babbage <*> pNumStuffedUtxoCount <*> pNumUtxoKeys <*> pSupply diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis/CreateTestnetData.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis/CreateTestnetData.hs index d225efee1..386805f23 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis/CreateTestnetData.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis/CreateTestnetData.hs @@ -166,7 +166,7 @@ runGenesisKeyGenUTxOCmd vkeyDesc = "Genesis Initial UTxO Verification Key" runGenesisCreateTestNetDataCmd - :: GenesisCreateTestNetDataCmdArgs era + :: GenesisCreateTestNetDataCmdArgs -> ExceptT GenesisCmdError IO () runGenesisCreateTestNetDataCmd Cmd.GenesisCreateTestNetDataCmdArgs @@ -255,7 +255,8 @@ runGenesisCreateTestNetDataCmd when (0 < numPools) $ writeREADME poolsDir poolsREADME - -- CC members + -- CC members. We don't need to look at the eon, because the command's parser guarantees + -- that before Conway, the number of CC members at this point is 0. ccColdKeys <- forM [1 .. numCommitteeKeys] $ \index -> do let committeeDir = committeesDir "cc" <> show index vkeyHotFile = File @(VerificationKey ()) $ committeeDir "cc.hot.vkey" @@ -275,7 +276,8 @@ runGenesisCreateTestNetDataCmd when (0 < numCommitteeKeys) $ writeREADME committeesDir committeeREADME - -- DReps + -- DReps. We don't need to look at the eon, because the command's parser guarantees + -- that before Conway, the number of DReps at this point is 0. g <- Random.getStdGen dRepKeys <- firstExceptT GenesisCmdFileError $