create-testnet-data: use experimental API and make arguments era specific

cabal.project

@@ -57,3 +57,9 @@ write-ghc-environment-files: always
 -- IMPORTANT
 -- Do NOT add more source-repository-package stanzas here unless they are strictly
 -- temporary! Please read the section in CONTRIBUTING about updating dependencies.
+
+source-repository-package
+   type: git
+   location: https://github.com/IntersectMBO/cardano-api
+   subdir: cardano-api
+   tag: aa2a852403e6ac7fdb0db28ff79b21ba8efcafe2

cardano-cli/src/Cardano/CLI/Compatible/Transaction.hs

@@ -270,18 +270,18 @@ readUpdateProposalFile
   :: Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile)
   -> ExceptT CompatibleTransactionError IO (AnyProtocolUpdate era)
 readUpdateProposalFile (Featured sToB Nothing) =
-  return $ NoPParamsUpdate $ shelleyToBabbageEraToShelleyBasedEra sToB
+  return $ NoPParamsUpdate $ inject sToB
 readUpdateProposalFile (Featured sToB (Just updateProposalFile)) = do
   prop <- firstExceptT CompatibleFileError $ readTxUpdateProposal sToB updateProposalFile
   case prop of
-    TxUpdateProposalNone -> return $ NoPParamsUpdate $ shelleyToBabbageEraToShelleyBasedEra sToB
+    TxUpdateProposalNone -> return $ NoPParamsUpdate $ inject sToB
     TxUpdateProposal _ proposal -> return $ ProtocolUpdate sToB proposal
 
 readProposalProcedureFile
   :: Featured ConwayEraOnwards era [(ProposalFile In, Maybe (ScriptWitnessFiles WitCtxStake))]
   -> ExceptT CompatibleTransactionError IO (AnyProtocolUpdate era)
 readProposalProcedureFile (Featured cEraOnwards []) =
-  let sbe = conwayEraOnwardsToShelleyBasedEra cEraOnwards
+  let sbe = inject cEraOnwards
    in return $ NoPParamsUpdate sbe
 readProposalProcedureFile (Featured cEraOnwards proposals) = do
   props <-

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/Options/Governance/Actions.hs

@@ -185,11 +185,11 @@ pUpdateProtocolParametersCmd
 pUpdateProtocolParametersCmd =
   caseShelleyToBabbageOrConwayEraOnwards
     ( \shelleyToBab ->
-        let sbe = shelleyToBabbageEraToShelleyBasedEra shelleyToBab
+        let sbe = inject shelleyToBab
          in subParser "create-protocol-parameters-update"
               $ Opt.info
                 ( Cmd.GovernanceActionProtocolParametersUpdateCmdArgs
-                    (shelleyToBabbageEraToShelleyBasedEra shelleyToBab)
+                    (inject shelleyToBab)
                     <$> fmap Just (pUpdateProtocolParametersPreConway shelleyToBab)
                     <*> pure Nothing
                     <*> dpGovActionProtocolParametersUpdate sbe
@@ -199,11 +199,11 @@ pUpdateProtocolParametersCmd =
               $ Opt.progDesc "Create a protocol parameters update."
     )
     ( \conwayOnwards ->
-        let sbe = conwayEraOnwardsToShelleyBasedEra conwayOnwards
+        let sbe = inject conwayOnwards
          in subParser "create-protocol-parameters-update"
               $ Opt.info
                 ( Cmd.GovernanceActionProtocolParametersUpdateCmdArgs
-                    (conwayEraOnwardsToShelleyBasedEra conwayOnwards)
+                    (inject conwayOnwards)
                     Nothing
                     <$> fmap Just (pUpdateProtocolParametersPostConway conwayOnwards)
                     <*> dpGovActionProtocolParametersUpdate sbe

cardano-cli/src/Cardano/CLI/EraBased/Options/Query.hs

@@ -678,7 +678,7 @@ pQueryTreasuryValueCmd era envCli = do
       <*> optional pOutputFile
 
 pQueryNoArgCmdArgs
-  :: ()
+  :: forall era. ()
   => ConwayEraOnwards era
   -> EnvCli
   -> Parser (QueryNoArgCmdArgs era)
@@ -687,5 +687,5 @@ pQueryNoArgCmdArgs w envCli =
     <$> pSocketPath envCli
     <*> pConsensusModeParams
     <*> pNetworkId envCli
-    <*> pTarget (conwayEraOnwardsToShelleyBasedEra w)
+    <*> pTarget (inject w :: ShelleyBasedEra era)
     <*> optional pOutputFile

cardano-cli/src/Cardano/CLI/EraBased/Options/StakeAddress.hs

@@ -121,7 +121,7 @@ pStakeAddressDeregistrationCertificateCmd =
     ( \shelleyToBabbage ->
         subParser "deregistration-certificate"
           $ Opt.info
-            ( StakeAddressDeregistrationCertificateCmd (shelleyToBabbageEraToShelleyBasedEra shelleyToBabbage)
+            ( StakeAddressDeregistrationCertificateCmd (inject shelleyToBabbage)
                 <$> pStakeIdentifier Nothing
                 <*> pure Nothing
                 <*> pOutputFile
@@ -131,7 +131,7 @@ pStakeAddressDeregistrationCertificateCmd =
     ( \conwayOnwards ->
         subParser "deregistration-certificate"
           $ Opt.info
-            ( StakeAddressDeregistrationCertificateCmd (conwayEraOnwardsToShelleyBasedEra conwayOnwards)
+            ( StakeAddressDeregistrationCertificateCmd (inject conwayOnwards)
                 <$> pStakeIdentifier Nothing
                 <*> fmap Just pKeyRegistDeposit
                 <*> pOutputFile

cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs

@@ -227,7 +227,7 @@ pTransactionBuildEstimateCmd eon' _envCli = do
  where
   pCmd :: Exp.Era era -> Parser (TransactionCmds era)
   pCmd era' = do
-    let sbe = Exp.eraToSbe era'
+    let sbe = inject era'
     fmap TransactionBuildEstimateCmd $
       TransactionBuildEstimateCmdArgs era'
         <$> optional pScriptValidity

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
@@ -197,7 +197,7 @@ runGenesisCreateTestNetDataCmd
     , outputDir
     } = do
     liftIO $ createDirectoryIfMissing False outputDir
-    let era = toCardanoEra eon
+    let era = inject eon
     shelleyGenesisInit <-
       fromMaybe shelleyGenesisDefaults <$> traverse decodeShelleyGenesisFile specShelley
     alonzoGenesis <-
@@ -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 $

cardano-cli/src/Cardano/CLI/EraBased/Run/Governance.hs

@@ -65,7 +65,7 @@ runGovernanceCmds = \case
     runGovernanceVoteCmds cmds
 
 runGovernanceMIRCertificatePayStakeAddrs
-  :: ShelleyToBabbageEra era
+  :: forall era. ShelleyToBabbageEra era
   -> L.MIRPot
   -> [StakeAddress]
   -- ^ Stake addresses
@@ -92,18 +92,19 @@ runGovernanceMIRCertificatePayStakeAddrs w mirPot sAddrs rwdAmts oFp = do
         makeMIRCertificate $
           MirCertificateRequirements w mirPot $
             shelleyToBabbageEraConstraints w mirTarget
+      sbe :: ShelleyBasedEra era = inject w
 
   firstExceptT GovernanceCmdTextEnvWriteError
     . newExceptT
-    $ shelleyBasedEraConstraints (shelleyToBabbageEraToShelleyBasedEra w)
+    $ shelleyBasedEraConstraints sbe
     $ writeLazyByteStringFile oFp
     $ textEnvelopeToJSON (Just mirCertDesc) mirCert
  where
   mirCertDesc :: TextEnvelopeDescr
   mirCertDesc = "Move Instantaneous Rewards Certificate"
 
 runGovernanceCreateMirCertificateTransferToTreasuryCmd
-  :: ()
+  :: forall era. ()
   => ShelleyToBabbageEra era
   -> Lovelace
   -> File () Out
@@ -112,18 +113,19 @@ runGovernanceCreateMirCertificateTransferToTreasuryCmd w ll oFp = do
   let mirTarget = L.SendToOppositePotMIR ll
 
   let mirCert = makeMIRCertificate $ MirCertificateRequirements w L.ReservesMIR mirTarget
+      sbe :: ShelleyBasedEra era = inject w
 
   firstExceptT GovernanceCmdTextEnvWriteError
     . newExceptT
-    $ shelleyBasedEraConstraints (shelleyToBabbageEraToShelleyBasedEra w)
+    $ shelleyBasedEraConstraints sbe
     $ writeLazyByteStringFile oFp
     $ textEnvelopeToJSON (Just mirCertDesc) mirCert
  where
   mirCertDesc :: TextEnvelopeDescr
   mirCertDesc = "MIR Certificate Send To Treasury"
 
 runGovernanceCreateMirCertificateTransferToReservesCmd
-  :: ()
+  :: forall era. ()
   => ShelleyToBabbageEra era
   -> Lovelace
   -> File () Out
@@ -132,10 +134,11 @@ runGovernanceCreateMirCertificateTransferToReservesCmd w ll oFp = do
   let mirTarget = L.SendToOppositePotMIR ll
 
   let mirCert = makeMIRCertificate $ MirCertificateRequirements w L.TreasuryMIR mirTarget
+      sbe :: ShelleyBasedEra era = inject w
 
   firstExceptT GovernanceCmdTextEnvWriteError
     . newExceptT
-    $ shelleyBasedEraConstraints (shelleyToBabbageEraToShelleyBasedEra w)
+    $ shelleyBasedEraConstraints sbe
     $ writeLazyByteStringFile oFp
     $ textEnvelopeToJSON (Just mirCertDesc) mirCert
  where