create-testnet-data: use experimental API and tighten arguments so that they are era specific

Author: smelc

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)

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

cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis/CreateTestnetData.hs

@@ -208,7 +208,7 @@ data WriteFileGenesis where
   WritePretty :: ToJSON genesis => genesis -> WriteFileGenesis
 
 runGenesisCreateTestNetDataCmd
-  :: GenesisCreateTestNetDataCmdArgs era
+  :: GenesisCreateTestNetDataCmdArgs
   -> ExceptT GenesisCmdError IO ()
 runGenesisCreateTestNetDataCmd
   Cmd.GenesisCreateTestNetDataCmdArgs
@@ -239,7 +239,7 @@ runGenesisCreateTestNetDataCmd
     , outputDir
     } = do
     liftIO $ createDirectoryIfMissing False outputDir
-    let era = toCardanoEra eon
+    let era = convert eon
     shelleyGenesisInit <-
       fromMaybe shelleyGenesisDefaults <$> traverse decodeShelleyGenesisFile specShelley
     alonzoGenesis <-
@@ -298,7 +298,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"
@@ -318,7 +319,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 $