Skip to content

Commit

Permalink
create-testnet-data: use experimental API and tighten arguments so th…
Browse files Browse the repository at this point in the history
…at they are era specific
  • Loading branch information
smelc committed Nov 14, 2024
1 parent ee17ed5 commit 704f869
Show file tree
Hide file tree
Showing 3 changed files with 21 additions and 12 deletions.
14 changes: 10 additions & 4 deletions cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE LambdaCase #-}

module Cardano.CLI.EraBased.Commands.Genesis
Expand All @@ -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

Expand All @@ -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
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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)
Expand Down
11 changes: 6 additions & 5 deletions cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 (..))
Expand Down Expand Up @@ -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
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -166,7 +166,7 @@ runGenesisKeyGenUTxOCmd
vkeyDesc = "Genesis Initial UTxO Verification Key"

runGenesisCreateTestNetDataCmd
:: GenesisCreateTestNetDataCmdArgs era
:: GenesisCreateTestNetDataCmdArgs
-> ExceptT GenesisCmdError IO ()
runGenesisCreateTestNetDataCmd
Cmd.GenesisCreateTestNetDataCmdArgs
Expand Down Expand Up @@ -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"
Expand All @@ -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 $
Expand Down

0 comments on commit 704f869

Please sign in to comment.