From cf4b4cf10023f21720012ee6c884ae0172ae9805 Mon Sep 17 00:00:00 2001 From: Carl Hammann Date: Fri, 20 Oct 2023 17:16:04 +0200 Subject: [PATCH 1/7] Command argument types: 'genesis create' --- .../Cardano/CLI/EraBased/Commands/Genesis.hs | 20 +++++---- .../Cardano/CLI/EraBased/Options/Genesis.hs | 2 +- .../src/Cardano/CLI/EraBased/Run/Genesis.hs | 45 ++++++++++--------- .../src/Cardano/CLI/Legacy/Run/Genesis.hs | 13 +++++- 4 files changed, 48 insertions(+), 32 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs index 3503a3b85f..9f8fc523fc 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs @@ -3,6 +3,7 @@ module Cardano.CLI.EraBased.Commands.Genesis ( GenesisCmds (..) + , GenesisCreateCmdArgs (..) , renderGenesisCmds ) where @@ -14,14 +15,7 @@ import Cardano.CLI.Types.Common import Data.Text (Text) data GenesisCmds era - = GenesisCreate - KeyOutputFormat - GenesisDir - Word - Word - (Maybe SystemStart) - (Maybe Lovelace) - NetworkId + = GenesisCreate !GenesisCreateCmdArgs | GenesisCreateCardano GenesisDir Word @@ -79,6 +73,16 @@ data GenesisCmds era GenesisFile deriving Show +data GenesisCreateCmdArgs = GenesisCreateCmdArgs + { keyOutputFormat :: !KeyOutputFormat + , genesisDir :: !GenesisDir + , numGenesisKeys :: !Word + , numUTxOKeys :: !Word + , mSystemStart :: !(Maybe SystemStart) + , mSupply :: !(Maybe Lovelace) + , network :: !NetworkId + } deriving Show + renderGenesisCmds :: GenesisCmds era -> Text renderGenesisCmds = \case GenesisCreate {} -> diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs index a3686ccd9a..a81dfd9831 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs @@ -164,7 +164,7 @@ pGenesisCreateCardano envCli = pGenesisCreate :: EnvCli -> Parser (GenesisCmds era) pGenesisCreate envCli = - GenesisCreate + fmap GenesisCreate $ GenesisCreateCmdArgs <$> pKeyOutputFormat <*> pGenesisDir <*> pGenesisNumGenesisKeys diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs index fa5fa6f50b..c2e14852a3 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs @@ -12,6 +12,7 @@ {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} {- HLINT ignore "Reduce duplication" -} {- HLINT ignore "Redundant <$>" -} @@ -54,7 +55,7 @@ import Cardano.Chain.Update hiding (ProtocolParameters) import Cardano.CLI.Byron.Delegation import Cardano.CLI.Byron.Genesis as Byron import qualified Cardano.CLI.Byron.Key as Byron -import Cardano.CLI.EraBased.Commands.Genesis +import Cardano.CLI.EraBased.Commands.Genesis as Cmd import Cardano.CLI.EraBased.Run.Node (runNodeIssueOpCertCmd, runNodeKeyGenColdCmd, runNodeKeyGenKesCmd, runNodeKeyGenVrfCmd) import Cardano.CLI.EraBased.Run.StakeAddress (runStakeAddressKeyGenCmd) @@ -155,8 +156,8 @@ runGenesisCmds = \case runGenesisTxInCmd vk nw mOutFile GenesisAddr vk nw mOutFile -> runGenesisAddrCmd vk nw mOutFile - GenesisCreate fmt gd gn un ms am nw -> - runGenesisCreateCmd fmt gd gn un ms am nw + GenesisCreate args -> + runGenesisCreateCmd args GenesisCreateCardano gd gn un ms am k slotLength sc nw bg sg ag cg mNodeCfg -> runGenesisCreateCardanoCmd gd gn un ms am k slotLength sc nw bg sg ag cg mNodeCfg GenesisCreateStaked fmt gd gn gp gl un ms am ds nw bf bp su relayJsonFp -> @@ -354,19 +355,22 @@ writeOutput Nothing = Text.putStrLn -- runGenesisCreateCmd - :: KeyOutputFormat - -> GenesisDir - -> Word -- ^ num genesis & delegate keys to make - -> Word -- ^ num utxo keys to make - -> Maybe SystemStart - -> Maybe Lovelace - -> NetworkId + :: GenesisCreateCmdArgs -> ExceptT GenesisCmdError IO () runGenesisCreateCmd - fmt (GenesisDir rootdir) - genNumGenesisKeys genNumUTxOKeys - mStart mAmount network = do - + Cmd.GenesisCreateCmdArgs + { Cmd.keyOutputFormat + , Cmd.genesisDir + , Cmd.numGenesisKeys + , Cmd.numUTxOKeys + , Cmd.mSystemStart + , Cmd.mSupply + , Cmd.network + } = do + let GenesisDir rootdir = genesisDir + gendir = rootdir "genesis-keys" + deldir = rootdir "delegate-keys" + utxodir = rootdir "utxo-keys" liftIO $ do createDirectoryIfMissing False rootdir createDirectoryIfMissing False gendir @@ -377,21 +381,21 @@ runGenesisCreateCmd alonzoGenesis <- readAlonzoGenesis (rootdir "genesis.alonzo.spec.json") conwayGenesis <- readConwayGenesis (rootdir "genesis.conway.spec.json") - forM_ [ 1 .. genNumGenesisKeys ] $ \index -> do + forM_ [ 1 .. numGenesisKeys ] $ \index -> do createGenesisKeys gendir index - createDelegateKeys fmt deldir index + createDelegateKeys keyOutputFormat deldir index - forM_ [ 1 .. genNumUTxOKeys ] $ \index -> + forM_ [ 1 .. numUTxOKeys ] $ \index -> createUtxoKeys utxodir index genDlgs <- readGenDelegsMap gendir deldir utxoAddrs <- readInitialFundAddresses utxodir network - start <- maybe (SystemStart <$> getCurrentTimePlus30) pure mStart + start <- maybe (SystemStart <$> getCurrentTimePlus30) pure mSystemStart let shelleyGenesis = updateTemplate -- Shelley genesis parameters - start genDlgs mAmount utxoAddrs mempty (Lovelace 0) [] [] template + start genDlgs mSupply utxoAddrs mempty (Lovelace 0) [] [] template void $ writeFileGenesis (rootdir "genesis.json") $ WritePretty shelleyGenesis void $ writeFileGenesis (rootdir "genesis.alonzo.json") $ WritePretty alonzoGenesis @@ -399,9 +403,6 @@ runGenesisCreateCmd --TODO: rationalise the naming convention on these genesis json files. where adjustTemplate t = t { sgNetworkMagic = unNetworkMagic (toNetworkMagic network) } - gendir = rootdir "genesis-keys" - deldir = rootdir "delegate-keys" - utxodir = rootdir "utxo-keys" toSKeyJSON :: Key a => SigningKey a -> ByteString toSKeyJSON = LBS.toStrict . textEnvelopeToJSON Nothing diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs index 8faf4f7d5b..698ed58b77 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs @@ -17,6 +17,7 @@ import Cardano.CLI.Types.Common import Cardano.CLI.Types.Errors.GenesisCmdError import Control.Monad.Trans.Except (ExceptT) +import qualified Cardano.CLI.EraBased.Commands.Genesis as Cmd runLegacyGenesisCmds :: LegacyGenesisCmds -> ExceptT GenesisCmdError IO () runLegacyGenesisCmds = \case @@ -94,7 +95,17 @@ runLegacyGenesisCreateCmd :: () -> Maybe Lovelace -> NetworkId -> ExceptT GenesisCmdError IO () -runLegacyGenesisCreateCmd = runGenesisCreateCmd +runLegacyGenesisCreateCmd fmt genDir nGenKeys nUTxOKeys mStart mSupply network = + runGenesisCreateCmd + Cmd.GenesisCreateCmdArgs + { Cmd.keyOutputFormat = fmt + , Cmd.genesisDir = genDir + , Cmd.numGenesisKeys = nGenKeys + , Cmd.numUTxOKeys = nUTxOKeys + , Cmd.mSystemStart = mStart + , Cmd.mSupply = mSupply + , Cmd.network = network + } runLegacyGenesisCreateCardanoCmd :: () => GenesisDir From 41e9a5a996ec1d67ba58512f577298d13e6144be Mon Sep 17 00:00:00 2001 From: Carl Hammann Date: Fri, 20 Oct 2023 17:42:31 +0200 Subject: [PATCH 2/7] Command argument types: 'genesis create-cardano' --- .../Cardano/CLI/EraBased/Commands/Genesis.hs | 35 ++++---- .../Cardano/CLI/EraBased/Options/Genesis.hs | 2 +- .../src/Cardano/CLI/EraBased/Run/Genesis.hs | 82 ++++++++++--------- .../src/Cardano/CLI/Legacy/Run/Genesis.hs | 22 ++++- 4 files changed, 85 insertions(+), 56 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs index 9f8fc523fc..c86d87ff5f 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs @@ -1,9 +1,11 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE LambdaCase #-} module Cardano.CLI.EraBased.Commands.Genesis ( GenesisCmds (..) , GenesisCreateCmdArgs (..) + , GenesisCreateCardanoCmdArgs (..) , renderGenesisCmds ) where @@ -16,21 +18,7 @@ import Data.Text (Text) data GenesisCmds era = GenesisCreate !GenesisCreateCmdArgs - | GenesisCreateCardano - GenesisDir - Word - Word - (Maybe SystemStart) - (Maybe Lovelace) - BlockCount - Word - Rational - NetworkId - FilePath - FilePath - FilePath - FilePath - (Maybe FilePath) + | GenesisCreateCardano !GenesisCreateCardanoCmdArgs | GenesisCreateStaked KeyOutputFormat GenesisDir @@ -83,6 +71,23 @@ data GenesisCreateCmdArgs = GenesisCreateCmdArgs , network :: !NetworkId } deriving Show +data GenesisCreateCardanoCmdArgs = GenesisCreateCardanoCmdArgs + { genesisDir :: !GenesisDir + , numGenesisKeys :: !Word + , numUTxOKeys :: !Word + , mSystemStart :: !(Maybe SystemStart) + , mSupply :: !(Maybe Lovelace) + , security :: !BlockCount + , slotLength :: !Word + , slotCoeff :: !Rational + , network :: !NetworkId + , byronGenesisTemplate :: !FilePath + , shelleyGenesisTemplate :: !FilePath + , alonzoGenesisTemplate :: !FilePath + , conwayGenesisTemplate :: !FilePath + , mNodeConfigTemplate :: !(Maybe FilePath) + } deriving Show + renderGenesisCmds :: GenesisCmds era -> Text renderGenesisCmds = \case GenesisCreate {} -> diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs index a81dfd9831..5ae87b3935 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs @@ -138,7 +138,7 @@ pGenesisTxIn envCli = pGenesisCreateCardano :: EnvCli -> Parser (GenesisCmds era) pGenesisCreateCardano envCli = - GenesisCreateCardano + fmap GenesisCreateCardano $ GenesisCreateCardanoCmdArgs <$> pGenesisDir <*> pGenesisNumGenesisKeys <*> pGenesisNumUTxOKeys diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs index c2e14852a3..6e7b6cd089 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs @@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} @@ -158,8 +159,8 @@ runGenesisCmds = \case runGenesisAddrCmd vk nw mOutFile GenesisCreate args -> runGenesisCreateCmd args - GenesisCreateCardano gd gn un ms am k slotLength sc nw bg sg ag cg mNodeCfg -> - runGenesisCreateCardanoCmd gd gn un ms am k slotLength sc nw bg sg ag cg mNodeCfg + GenesisCreateCardano args -> + runGenesisCreateCardanoCmd args GenesisCreateStaked fmt gd gn gp gl un ms am ds nw bf bp su relayJsonFp -> runGenesisCreateStakedCmd fmt gd gn gp gl un ms am ds nw bf bp su relayJsonFp GenesisHashFile gf -> @@ -472,31 +473,32 @@ generateShelleyNodeSecrets shelleyDelegateKeys shelleyGenesisvkeys = do -- Create Genesis Cardano command implementation -- -runGenesisCreateCardanoCmd :: GenesisDir - -> Word -- ^ num genesis & delegate keys to make - -> Word -- ^ num utxo keys to make - -> Maybe SystemStart - -> Maybe Lovelace - -> BlockCount - -> Word -- ^ slot length in ms - -> Rational - -> NetworkId - -> FilePath -- ^ Byron Genesis - -> FilePath -- ^ Shelley Genesis - -> FilePath -- ^ Alonzo Genesis - -> FilePath -- ^ Conway Genesis - -> Maybe FilePath - -> ExceptT GenesisCmdError IO () -runGenesisCreateCardanoCmd (GenesisDir rootdir) - genNumGenesisKeys genNumUTxOKeys - mStart mAmount mSecurity slotLength mSlotCoeff - network byronGenesisT shelleyGenesisT alonzoGenesisT conwayGenesisT mNodeCfg = do - start <- maybe (SystemStart <$> getCurrentTimePlus30) pure mStart +runGenesisCreateCardanoCmd + :: GenesisCreateCardanoCmdArgs + -> ExceptT GenesisCmdError IO () +runGenesisCreateCardanoCmd + Cmd.GenesisCreateCardanoCmdArgs + { Cmd.genesisDir + , Cmd.numGenesisKeys + , Cmd.numUTxOKeys + , Cmd.mSystemStart + , Cmd.mSupply + , Cmd.security + , Cmd.slotLength + , Cmd.slotCoeff + , Cmd.network + , Cmd.byronGenesisTemplate + , Cmd.shelleyGenesisTemplate + , Cmd.alonzoGenesisTemplate + , Cmd.conwayGenesisTemplate + , Cmd.mNodeConfigTemplate + } = do + start <- maybe (SystemStart <$> getCurrentTimePlus30) pure mSystemStart (byronGenesis', byronSecrets) <- convertToShelleyError $ Byron.mkGenesis $ byronParams start let byronGenesis = byronGenesis' { gdProtocolParameters = (gdProtocolParameters byronGenesis') { - ppSlotDuration = floor ( toRational slotLength * recip mSlotCoeff ) + ppSlotDuration = floor ( toRational slotLength * recip slotCoeff ) } } @@ -522,21 +524,26 @@ runGenesisCreateCardanoCmd (GenesisDir rootdir) overrideShelleyGenesis t = t { sgNetworkMagic = unNetworkMagic (toNetworkMagic network) , sgNetworkId = toShelleyNetwork network - , sgActiveSlotsCoeff = fromMaybe (error $ "Could not convert from Rational: " ++ show mSlotCoeff) $ Ledger.boundRational mSlotCoeff - , sgSecurityParam = unBlockCount mSecurity - , sgUpdateQuorum = fromIntegral $ ((genNumGenesisKeys `div` 3) * 2) + 1 - , sgEpochLength = EpochSize $ floor $ (fromIntegral (unBlockCount mSecurity) * 10) / mSlotCoeff + , sgActiveSlotsCoeff = fromMaybe (error $ "Could not convert from Rational: " ++ show slotCoeff) $ Ledger.boundRational slotCoeff + , sgSecurityParam = unBlockCount security + , sgUpdateQuorum = fromIntegral $ ((numGenesisKeys `div` 3) * 2) + 1 + , sgEpochLength = EpochSize $ floor $ (fromIntegral (unBlockCount security) * 10) / slotCoeff , sgMaxLovelaceSupply = 45000000000000000 , sgSystemStart = getSystemStart start , sgSlotLength = secondsToNominalDiffTimeMicro $ MkFixed (fromIntegral slotLength) * 1000 } - shelleyGenesisTemplate <- liftIO $ overrideShelleyGenesis . fromRight (error "shelley genesis template not found") <$> readAndDecodeShelleyGenesis shelleyGenesisT - alonzoGenesis <- readAlonzoGenesis alonzoGenesisT - conwayGenesis <- readConwayGenesis conwayGenesisT + shelleyGenesisTemplate' <- liftIO $ overrideShelleyGenesis . fromRight (error "shelley genesis template not found") <$> readAndDecodeShelleyGenesis shelleyGenesisTemplate + alonzoGenesis <- readAlonzoGenesis alonzoGenesisTemplate + conwayGenesis <- readConwayGenesis conwayGenesisTemplate (delegateMap, vrfKeys, kesKeys, opCerts) <- liftIO $ generateShelleyNodeSecrets shelleyDelegateKeys shelleyGenesisvkeys let shelleyGenesis :: ShelleyGenesis StandardCrypto - shelleyGenesis = updateTemplate start delegateMap Nothing [] mempty 0 [] [] shelleyGenesisTemplate + shelleyGenesis = updateTemplate start delegateMap Nothing [] mempty 0 [] [] shelleyGenesisTemplate' + + let GenesisDir rootdir = genesisDir + gendir = rootdir "genesis-keys" + deldir = rootdir "delegate-keys" + utxodir = rootdir "utxo-keys" liftIO $ do createDirectoryIfMissing False rootdir @@ -571,7 +578,7 @@ runGenesisCreateCardanoCmd (GenesisDir rootdir) conwayGenesisHash <- writeFileGenesis (rootdir "conway-genesis.json") $ WritePretty conwayGenesis liftIO $ do - case mNodeCfg of + case mNodeConfigTemplate of Nothing -> pure () Just nodeCfg -> do nodeConfig <- Yaml.decodeFileThrow nodeCfg @@ -600,17 +607,14 @@ runGenesisCreateCardanoCmd (GenesisDir rootdir) convertPoor :: Byron.SigningKey -> SigningKey ByronKey convertPoor = ByronSigningKey - byronParams start = Byron.GenesisParameters (getSystemStart start) byronGenesisT mSecurity byronNetwork byronBalance byronFakeAvvm byronAvvmFactor Nothing - gendir = rootdir "genesis-keys" - deldir = rootdir "delegate-keys" - utxodir = rootdir "utxo-keys" + byronParams start = Byron.GenesisParameters (getSystemStart start) byronGenesisTemplate security byronNetwork byronBalance byronFakeAvvm byronAvvmFactor Nothing byronNetwork = CC.AProtocolMagic (Annotated (toByronProtocolMagicId network) ()) (toByronRequiresNetworkMagic network) byronBalance = TestnetBalanceOptions - { tboRichmen = genNumGenesisKeys - , tboPoors = genNumUTxOKeys - , tboTotalBalance = fromMaybe zeroLovelace $ toByronLovelace (fromMaybe 0 mAmount) + { tboRichmen = numGenesisKeys + , tboPoors = numUTxOKeys + , tboTotalBalance = fromMaybe zeroLovelace $ toByronLovelace (fromMaybe 0 mSupply) , tboRichmenShare = 0 } byronFakeAvvm = FakeAvvmOptions diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs index 698ed58b77..f3e3817f12 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} @@ -123,7 +124,26 @@ runLegacyGenesisCreateCardanoCmd :: () -> FilePath -- ^ Conway Genesis -> Maybe FilePath -> ExceptT GenesisCmdError IO () -runLegacyGenesisCreateCardanoCmd = runGenesisCreateCardanoCmd +runLegacyGenesisCreateCardanoCmd + genDir nGenKeys nUTxOKeys mStart mSupply security slotLength slotCoeff + network byronGenesis shelleyGenesis alonzoGenesis conwayGenesis mNodeCfg + = runGenesisCreateCardanoCmd + Cmd.GenesisCreateCardanoCmdArgs + { Cmd.genesisDir = genDir + , Cmd.numGenesisKeys = nGenKeys + , Cmd.numUTxOKeys = nUTxOKeys + , Cmd.mSystemStart = mStart + , Cmd.mSupply = mSupply + , Cmd.security = security + , Cmd.slotLength = slotLength + , Cmd.slotCoeff = slotCoeff + , Cmd.network = network + , Cmd.byronGenesisTemplate = byronGenesis + , Cmd.shelleyGenesisTemplate = shelleyGenesis + , Cmd.alonzoGenesisTemplate = alonzoGenesis + , Cmd.conwayGenesisTemplate = conwayGenesis + , Cmd.mNodeConfigTemplate = mNodeCfg + } runLegacyGenesisCreateStakedCmd :: () => KeyOutputFormat -- ^ key output format From e249d9459cbb7ac59f8a4eb9392e776d1837da1b Mon Sep 17 00:00:00 2001 From: Carl Hammann Date: Fri, 20 Oct 2023 18:13:29 +0200 Subject: [PATCH 3/7] Command argument types: 'genesis create-staked' --- .../Cardano/CLI/EraBased/Commands/Genesis.hs | 34 ++++--- .../Cardano/CLI/EraBased/Options/Genesis.hs | 2 +- .../src/Cardano/CLI/EraBased/Run/Genesis.hs | 97 +++++++++---------- .../src/Cardano/CLI/Legacy/Run/Genesis.hs | 23 ++++- 4 files changed, 90 insertions(+), 66 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs index c86d87ff5f..636fde0f67 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs @@ -6,6 +6,7 @@ module Cardano.CLI.EraBased.Commands.Genesis ( GenesisCmds (..) , GenesisCreateCmdArgs (..) , GenesisCreateCardanoCmdArgs (..) + , GenesisCreateStakedCmdArgs (..) , renderGenesisCmds ) where @@ -19,21 +20,7 @@ import Data.Text (Text) data GenesisCmds era = GenesisCreate !GenesisCreateCmdArgs | GenesisCreateCardano !GenesisCreateCardanoCmdArgs - | GenesisCreateStaked - KeyOutputFormat - GenesisDir - Word - Word - Word - Word - (Maybe SystemStart) - (Maybe Lovelace) - Lovelace - NetworkId - Word - Word - Word - (Maybe FilePath) -- ^ Relay specification filepath + | GenesisCreateStaked !GenesisCreateStakedCmdArgs | GenesisKeyGenGenesis (VerificationKeyFile Out) (SigningKeyFile Out) @@ -88,6 +75,23 @@ data GenesisCreateCardanoCmdArgs = GenesisCreateCardanoCmdArgs , mNodeConfigTemplate :: !(Maybe FilePath) } deriving Show +data GenesisCreateStakedCmdArgs = GenesisCreateStakedCmdArgs + { keyOutputFormat :: !KeyOutputFormat + , genesisDir :: !GenesisDir + , numGenesisKeys :: !Word + , numUTxOKeys :: !Word + , numPools :: !Word + , numStakeDelegators :: !Word + , mSystemStart :: !(Maybe SystemStart) + , mNonDelegatedSupply :: !(Maybe Lovelace) + , delegatedSupply :: !Lovelace + , network :: !NetworkId + , numBulkPoolCredFiles :: !Word + , numBulkPoolsPerFile :: !Word + , numStuffedUtxo :: !Word + , mStakePoolRelaySpecFile :: !(Maybe FilePath) -- ^ Relay specification filepath + } deriving Show + renderGenesisCmds :: GenesisCmds era -> Text renderGenesisCmds = \case GenesisCreate {} -> diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs index 5ae87b3935..7714fec651 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs @@ -175,7 +175,7 @@ pGenesisCreate envCli = pGenesisCreateStaked :: EnvCli -> Parser (GenesisCmds era) pGenesisCreateStaked envCli = - GenesisCreateStaked + fmap GenesisCreateStaked $ GenesisCreateStakedCmdArgs <$> pKeyOutputFormat <*> pGenesisDir <*> pGenesisNumGenesisKeys diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs index 6e7b6cd089..06a37c21e8 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs @@ -161,8 +161,8 @@ runGenesisCmds = \case runGenesisCreateCmd args GenesisCreateCardano args -> runGenesisCreateCardanoCmd args - GenesisCreateStaked fmt gd gn gp gl un ms am ds nw bf bp su relayJsonFp -> - runGenesisCreateStakedCmd fmt gd gn gp gl un ms am ds nw bf bp su relayJsonFp + GenesisCreateStaked args -> + runGenesisCreateStakedCmd args GenesisHashFile gf -> runGenesisHashFileCmd gf @@ -639,27 +639,32 @@ runGenesisCreateCardanoCmd dlgCertMap byronGenesis = Genesis.unGenesisDelegation $ Genesis.gdHeavyDelegation byronGenesis runGenesisCreateStakedCmd - :: KeyOutputFormat -- ^ key output format - -> GenesisDir - -> Word -- ^ num genesis & delegate keys to make - -> Word -- ^ num utxo keys to make - -> Word -- ^ num pools to make - -> Word -- ^ num delegators to make - -> Maybe SystemStart - -> Maybe Lovelace -- ^ supply going to non-delegators - -> Lovelace -- ^ supply going to delegators - -> NetworkId - -> Word -- ^ bulk credential files to write - -> Word -- ^ pool credentials per bulk file - -> Word -- ^ num stuffed UTxO entries - -> Maybe FilePath -- ^ Specified stake pool relays + :: GenesisCreateStakedCmdArgs -> ExceptT GenesisCmdError IO () runGenesisCreateStakedCmd - fmt (GenesisDir rootdir) - genNumGenesisKeys genNumUTxOKeys genNumPools genNumStDelegs - mStart mNonDlgAmount stDlgAmount network - numBulkPoolCredFiles bulkPoolsPerFile numStuffedUtxo - sPoolRelayFp = do + Cmd.GenesisCreateStakedCmdArgs + { Cmd.keyOutputFormat + , Cmd.genesisDir + , Cmd.numGenesisKeys + , Cmd.numUTxOKeys + , Cmd.numPools + , Cmd.numStakeDelegators + , Cmd.mSystemStart + , Cmd.mNonDelegatedSupply + , Cmd.delegatedSupply + , Cmd.network + , Cmd.numBulkPoolCredFiles + , Cmd.numBulkPoolsPerFile + , Cmd.numStuffedUtxo + , Cmd.mStakePoolRelaySpecFile + } = do + let GenesisDir rootdir = genesisDir + gendir = rootdir "genesis-keys" + deldir = rootdir "delegate-keys" + pooldir = rootdir "pools" + stdeldir = rootdir "stake-delegator-keys" + utxodir = rootdir "utxo-keys" + liftIO $ do createDirectoryIfMissing False rootdir createDirectoryIfMissing False gendir @@ -672,37 +677,37 @@ runGenesisCreateStakedCmd alonzoGenesis <- readAlonzoGenesis (rootdir "genesis.alonzo.spec.json") conwayGenesis <- readConwayGenesis (rootdir "genesis.conway.spec.json") - forM_ [ 1 .. genNumGenesisKeys ] $ \index -> do + forM_ [ 1 .. numGenesisKeys ] $ \index -> do createGenesisKeys gendir index - createDelegateKeys fmt deldir index + createDelegateKeys keyOutputFormat deldir index - forM_ [ 1 .. genNumUTxOKeys ] $ \index -> + forM_ [ 1 .. numUTxOKeys ] $ \index -> createUtxoKeys utxodir index mayStakePoolRelays - <- forM sPoolRelayFp $ + <- forM mStakePoolRelaySpecFile $ \fp -> do relaySpecJsonBs <- handleIOExceptT (GenesisCmdStakePoolRelayFileError fp) (LBS.readFile fp) firstExceptT (GenesisCmdStakePoolRelayJsonDecodeError fp) . hoistEither $ Aeson.eitherDecode relaySpecJsonBs - poolParams <- forM [ 1 .. genNumPools ] $ \index -> do - createPoolCredentials fmt pooldir index + poolParams <- forM [ 1 .. numPools ] $ \index -> do + createPoolCredentials keyOutputFormat pooldir index buildPoolParams network pooldir index (fromMaybe mempty mayStakePoolRelays) - when (numBulkPoolCredFiles * bulkPoolsPerFile > genNumPools) $ - left $ GenesisCmdTooFewPoolsForBulkCreds genNumPools numBulkPoolCredFiles bulkPoolsPerFile + when (numBulkPoolCredFiles * numBulkPoolsPerFile > numPools) $ + left $ GenesisCmdTooFewPoolsForBulkCreds numPools numBulkPoolCredFiles numBulkPoolsPerFile -- We generate the bulk files for the last pool indices, -- so that all the non-bulk pools have stable indices at beginning: - let bulkOffset = fromIntegral $ genNumPools - numBulkPoolCredFiles * bulkPoolsPerFile - bulkIndices :: [Word] = [ 1 + bulkOffset .. genNumPools ] - bulkSlices :: [[Word]] = List.chunksOf (fromIntegral bulkPoolsPerFile) bulkIndices + let bulkOffset = fromIntegral $ numPools - numBulkPoolCredFiles * numBulkPoolsPerFile + bulkIndices :: [Word] = [ 1 + bulkOffset .. numPools ] + bulkSlices :: [[Word]] = List.chunksOf (fromIntegral numBulkPoolsPerFile) bulkIndices forM_ (zip [ 1 .. numBulkPoolCredFiles ] bulkSlices) $ uncurry (writeBulkPoolCredentials pooldir) - let (delegsPerPool, delegsRemaining) = divMod genNumStDelegs genNumPools - delegsForPool poolIx = if delegsRemaining /= 0 && poolIx == genNumPools + let (delegsPerPool, delegsRemaining) = divMod numStakeDelegators numPools + delegsForPool poolIx = if delegsRemaining /= 0 && poolIx == numPools then delegsPerPool else delegsPerPool + delegsRemaining distribution = [pool | (pool, poolIx) <- zip poolParams [1 ..], _ <- [1 .. delegsForPool poolIx]] @@ -716,7 +721,7 @@ runGenesisCreateStakedCmd genDlgs <- readGenDelegsMap gendir deldir nonDelegAddrs <- readInitialFundAddresses utxodir network - start <- maybe (SystemStart <$> getCurrentTimePlus30) pure mStart + start <- maybe (SystemStart <$> getCurrentTimePlus30) pure mSystemStart stuffedUtxoAddrs <- liftIO $ Lazy.replicateM (fromIntegral numStuffedUtxo) genStuffedAddress @@ -726,8 +731,8 @@ runGenesisCreateStakedCmd !shelleyGenesis = updateCreateStakedOutputTemplate -- Shelley genesis parameters - start genDlgs mNonDlgAmount (length nonDelegAddrs) nonDelegAddrs stakePools stake - stDlgAmount numDelegations delegAddrs stuffedUtxoAddrs template + start genDlgs mNonDelegatedSupply (length nonDelegAddrs) nonDelegAddrs stakePools stake + delegatedSupply numDelegations delegAddrs stuffedUtxoAddrs template liftIO $ LBS.writeFile (rootdir "genesis.json") $ Aeson.encode shelleyGenesis @@ -737,33 +742,27 @@ runGenesisCreateStakedCmd liftIO $ Text.hPutStrLn IO.stderr $ mconcat $ [ "generated genesis with: " - , textShow genNumGenesisKeys, " genesis keys, " - , textShow genNumUTxOKeys, " non-delegating UTxO keys, " - , textShow genNumPools, " stake pools, " - , textShow genNumStDelegs, " delegating UTxO keys, " + , textShow numGenesisKeys, " genesis keys, " + , textShow numUTxOKeys, " non-delegating UTxO keys, " + , textShow numPools, " stake pools, " + , textShow numStakeDelegators, " delegating UTxO keys, " , textShow numDelegations, " delegation map entries, " ] ++ [ mconcat [ ", " , textShow numBulkPoolCredFiles, " bulk pool credential files, " - , textShow bulkPoolsPerFile, " pools per bulk credential file, indices starting from " + , textShow numBulkPoolsPerFile, " pools per bulk credential file, indices starting from " , textShow bulkOffset, ", " , textShow $ length bulkIndices, " total pools in bulk nodes, each bulk node having this many entries: " , textShow $ length <$> bulkSlices ] - | numBulkPoolCredFiles * bulkPoolsPerFile > 0 ] + | numBulkPoolCredFiles * numBulkPoolsPerFile > 0 ] where adjustTemplate t = t { sgNetworkMagic = unNetworkMagic (toNetworkMagic network) } mkDelegationMapEntry :: Delegation -> (Ledger.KeyHash Ledger.Staking StandardCrypto, Ledger.PoolParams StandardCrypto) mkDelegationMapEntry d = (dDelegStaking d, dPoolParams d) - gendir = rootdir "genesis-keys" - deldir = rootdir "delegate-keys" - pooldir = rootdir "pools" - stdeldir = rootdir "stake-delegator-keys" - utxodir = rootdir "utxo-keys" - genStuffedAddress :: IO (AddressInEra ShelleyEra) genStuffedAddress = shelleyAddressInEra ShelleyBasedEraShelley <$> diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs index f3e3817f12..098abdf7d9 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs @@ -161,7 +161,28 @@ runLegacyGenesisCreateStakedCmd :: () -> Word -- ^ num stuffed UTxO entries -> Maybe FilePath -- ^ Specified stake pool relays -> ExceptT GenesisCmdError IO () -runLegacyGenesisCreateStakedCmd = runGenesisCreateStakedCmd +runLegacyGenesisCreateStakedCmd + keyOutputFormat genesisDir numGenesisKeys numUTxOKeys numPools + numStakeDelegators mSystemStart mNonDelegatedSupply delegatedSupply + network numBulkPoolCredFiles numBulkPoolsPerFile numStuffedUtxo + mStakePoolRelaySpecFile + = runGenesisCreateStakedCmd + Cmd.GenesisCreateStakedCmdArgs + { Cmd.keyOutputFormat = keyOutputFormat + , Cmd.genesisDir = genesisDir + , Cmd.numGenesisKeys = numGenesisKeys + , Cmd.numUTxOKeys = numUTxOKeys + , Cmd.numPools = numPools + , Cmd.numStakeDelegators = numStakeDelegators + , Cmd.mSystemStart = mSystemStart + , Cmd.mNonDelegatedSupply = mNonDelegatedSupply + , Cmd.delegatedSupply = delegatedSupply + , Cmd.network = network + , Cmd.numBulkPoolCredFiles = numBulkPoolCredFiles + , Cmd.numBulkPoolsPerFile = numBulkPoolsPerFile + , Cmd.numStuffedUtxo = numStuffedUtxo + , Cmd.mStakePoolRelaySpecFile = mStakePoolRelaySpecFile + } -- | Hash a genesis file runLegacyGenesisHashFileCmd :: () From bd4cf7af956f3e8bc7a55ac14843ca383c05d9e6 Mon Sep 17 00:00:00 2001 From: Carl Hammann Date: Fri, 20 Oct 2023 18:25:04 +0200 Subject: [PATCH 4/7] Command argument types: 'genesis key-gen-genesis' --- .../Cardano/CLI/EraBased/Commands/Genesis.hs | 10 ++++--- .../Cardano/CLI/EraBased/Options/Genesis.hs | 2 +- .../src/Cardano/CLI/EraBased/Run/Genesis.hs | 26 +++++++++++-------- .../src/Cardano/CLI/Legacy/Run/Genesis.hs | 3 ++- 4 files changed, 25 insertions(+), 16 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs index 636fde0f67..f2b7fa91e5 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs @@ -7,6 +7,7 @@ module Cardano.CLI.EraBased.Commands.Genesis , GenesisCreateCmdArgs (..) , GenesisCreateCardanoCmdArgs (..) , GenesisCreateStakedCmdArgs (..) + , GenesisKeyGenGenesisCmdArgs (..) , renderGenesisCmds ) where @@ -21,9 +22,7 @@ data GenesisCmds era = GenesisCreate !GenesisCreateCmdArgs | GenesisCreateCardano !GenesisCreateCardanoCmdArgs | GenesisCreateStaked !GenesisCreateStakedCmdArgs - | GenesisKeyGenGenesis - (VerificationKeyFile Out) - (SigningKeyFile Out) + | GenesisKeyGenGenesis !GenesisKeyGenGenesisCmdArgs | GenesisKeyGenDelegate (VerificationKeyFile Out) (SigningKeyFile Out) @@ -92,6 +91,11 @@ data GenesisCreateStakedCmdArgs = GenesisCreateStakedCmdArgs , mStakePoolRelaySpecFile :: !(Maybe FilePath) -- ^ Relay specification filepath } deriving Show +data GenesisKeyGenGenesisCmdArgs = GenesisKeyGenGenesisCmdArgs + { verificationKeyPath :: !(VerificationKeyFile Out) + , signingKeyPath :: !(SigningKeyFile Out) + } deriving Show + renderGenesisCmds :: GenesisCmds era -> Text renderGenesisCmds = \case GenesisCreate {} -> diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs index 7714fec651..b50f93afac 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs @@ -94,7 +94,7 @@ pGenesisCmds envCli = pGenesisKeyGen :: Parser (GenesisCmds era) pGenesisKeyGen = - GenesisKeyGenGenesis + fmap GenesisKeyGenGenesis $ GenesisKeyGenGenesisCmdArgs <$> pVerificationKeyFileOut <*> pSigningKeyFileOut diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs index 06a37c21e8..5e40a262f5 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs @@ -143,8 +143,8 @@ import Crypto.Random as Crypto runGenesisCmds :: GenesisCmds era -> ExceptT GenesisCmdError IO () runGenesisCmds = \case - GenesisKeyGenGenesis vk sk -> - runGenesisKeyGenGenesisCmd vk sk + GenesisKeyGenGenesis args -> + runGenesisKeyGenGenesisCmd args GenesisKeyGenDelegate vk sk ctr -> runGenesisKeyGenDelegateCmd vk sk ctr GenesisKeyGenUTxO vk sk -> @@ -166,20 +166,23 @@ runGenesisCmds = \case GenesisHashFile gf -> runGenesisHashFileCmd gf -runGenesisKeyGenGenesisCmd :: - VerificationKeyFile Out - -> SigningKeyFile Out +runGenesisKeyGenGenesisCmd + :: GenesisKeyGenGenesisCmdArgs -> ExceptT GenesisCmdError IO () -runGenesisKeyGenGenesisCmd vkeyPath skeyPath = do +runGenesisKeyGenGenesisCmd + Cmd.GenesisKeyGenGenesisCmdArgs + { Cmd.verificationKeyPath + , Cmd.signingKeyPath + } = do skey <- liftIO $ generateSigningKey AsGenesisKey let vkey = getVerificationKey skey firstExceptT GenesisCmdGenesisFileError . newExceptT - $ writeLazyByteStringFile skeyPath + $ writeLazyByteStringFile signingKeyPath $ textEnvelopeToJSON (Just skeyDesc) skey firstExceptT GenesisCmdGenesisFileError . newExceptT - $ writeLazyByteStringFile vkeyPath + $ writeLazyByteStringFile verificationKeyPath $ textEnvelopeToJSON (Just vkeyDesc) vkey where skeyDesc, vkeyDesc :: TextEnvelopeDescr @@ -816,9 +819,10 @@ createGenesisKeys dir index = do liftIO $ createDirectoryIfMissing False dir let strIndex = show index runGenesisKeyGenGenesisCmd - (File @(VerificationKey ()) $ dir "genesis" ++ strIndex ++ ".vkey") - (File @(SigningKey ()) $ dir "genesis" ++ strIndex ++ ".skey") - + GenesisKeyGenGenesisCmdArgs + { verificationKeyPath = File @(VerificationKey ()) $ dir "genesis" ++ strIndex ++ ".vkey" + , signingKeyPath = File @(SigningKey ()) $ dir "genesis" ++ strIndex ++ ".skey" + } createUtxoKeys :: FilePath -> Word -> ExceptT GenesisCmdError IO () createUtxoKeys dir index = do diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs index 098abdf7d9..34d9181fbd 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs @@ -19,6 +19,7 @@ import Cardano.CLI.Types.Errors.GenesisCmdError import Control.Monad.Trans.Except (ExceptT) import qualified Cardano.CLI.EraBased.Commands.Genesis as Cmd +import Cardano.CLI.EraBased.Commands.Genesis (GenesisKeyGenGenesisCmdArgs(GenesisKeyGenGenesisCmdArgs)) runLegacyGenesisCmds :: LegacyGenesisCmds -> ExceptT GenesisCmdError IO () runLegacyGenesisCmds = \case @@ -49,7 +50,7 @@ runLegacyGenesisKeyGenGenesisCmd :: () => VerificationKeyFile Out -> SigningKeyFile Out -> ExceptT GenesisCmdError IO () -runLegacyGenesisKeyGenGenesisCmd = runGenesisKeyGenGenesisCmd +runLegacyGenesisKeyGenGenesisCmd vk sk = runGenesisKeyGenGenesisCmd $ GenesisKeyGenGenesisCmdArgs vk sk runLegacyGenesisKeyGenDelegateCmd :: () => VerificationKeyFile Out From a744d8eed27dd2233112ab24c9f854249626cb0f Mon Sep 17 00:00:00 2001 From: Carl Hammann Date: Mon, 23 Oct 2023 12:11:22 +0200 Subject: [PATCH 5/7] Command argument types: 'genesis key-gen-delegate' --- .../Cardano/CLI/EraBased/Commands/Genesis.hs | 12 ++++--- .../Cardano/CLI/EraBased/Options/Genesis.hs | 2 +- .../src/Cardano/CLI/EraBased/Run/Genesis.hs | 31 +++++++++++-------- .../src/Cardano/CLI/Legacy/Run/Genesis.hs | 8 ++++- 4 files changed, 34 insertions(+), 19 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs index f2b7fa91e5..7f10967d4c 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs @@ -8,6 +8,7 @@ module Cardano.CLI.EraBased.Commands.Genesis , GenesisCreateCardanoCmdArgs (..) , GenesisCreateStakedCmdArgs (..) , GenesisKeyGenGenesisCmdArgs (..) + , GenesisKeyGenDelegateCmdArgs (..) , renderGenesisCmds ) where @@ -23,10 +24,7 @@ data GenesisCmds era | GenesisCreateCardano !GenesisCreateCardanoCmdArgs | GenesisCreateStaked !GenesisCreateStakedCmdArgs | GenesisKeyGenGenesis !GenesisKeyGenGenesisCmdArgs - | GenesisKeyGenDelegate - (VerificationKeyFile Out) - (SigningKeyFile Out) - (OpCertCounterFile Out) + | GenesisKeyGenDelegate !GenesisKeyGenDelegateCmdArgs | GenesisKeyGenUTxO (VerificationKeyFile Out) (SigningKeyFile Out) @@ -96,6 +94,12 @@ data GenesisKeyGenGenesisCmdArgs = GenesisKeyGenGenesisCmdArgs , signingKeyPath :: !(SigningKeyFile Out) } deriving Show +data GenesisKeyGenDelegateCmdArgs = GenesisKeyGenDelegateCmdArgs + { verificationKeyPath :: !(VerificationKeyFile Out) + , signingKeyPath :: !(SigningKeyFile Out) + , opCertCounterPath :: !(OpCertCounterFile Out) + } deriving Show + renderGenesisCmds :: GenesisCmds era -> Text renderGenesisCmds = \case GenesisCreate {} -> diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs index b50f93afac..46b824fd95 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs @@ -100,7 +100,7 @@ pGenesisKeyGen = pGenesisDelegateKeyGen :: Parser (GenesisCmds era) pGenesisDelegateKeyGen = - GenesisKeyGenDelegate + fmap GenesisKeyGenDelegate $ GenesisKeyGenDelegateCmdArgs <$> pVerificationKeyFileOut <*> pSigningKeyFileOut <*> pOperatorCertIssueCounterFile diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs index 5e40a262f5..e46d958028 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs @@ -145,8 +145,8 @@ runGenesisCmds :: GenesisCmds era -> ExceptT GenesisCmdError IO () runGenesisCmds = \case GenesisKeyGenGenesis args -> runGenesisKeyGenGenesisCmd args - GenesisKeyGenDelegate vk sk ctr -> - runGenesisKeyGenDelegateCmd vk sk ctr + GenesisKeyGenDelegate args -> + runGenesisKeyGenDelegateCmd args GenesisKeyGenUTxO vk sk -> runGenesisKeyGenUTxOCmd vk sk GenesisCmdKeyHash vk -> @@ -190,25 +190,28 @@ runGenesisKeyGenGenesisCmd vkeyDesc = "Genesis Verification Key" -runGenesisKeyGenDelegateCmd :: - VerificationKeyFile Out - -> SigningKeyFile Out - -> OpCertCounterFile Out +runGenesisKeyGenDelegateCmd + :: GenesisKeyGenDelegateCmdArgs -> ExceptT GenesisCmdError IO () -runGenesisKeyGenDelegateCmd vkeyPath skeyPath ocertCtrPath = do +runGenesisKeyGenDelegateCmd + Cmd.GenesisKeyGenDelegateCmdArgs + { Cmd.verificationKeyPath + , Cmd.signingKeyPath + , Cmd.opCertCounterPath + } = do skey <- liftIO $ generateSigningKey AsGenesisDelegateKey let vkey = getVerificationKey skey firstExceptT GenesisCmdGenesisFileError . newExceptT - $ writeLazyByteStringFile skeyPath + $ writeLazyByteStringFile signingKeyPath $ textEnvelopeToJSON (Just skeyDesc) skey firstExceptT GenesisCmdGenesisFileError . newExceptT - $ writeLazyByteStringFile vkeyPath + $ writeLazyByteStringFile verificationKeyPath $ textEnvelopeToJSON (Just vkeyDesc) vkey firstExceptT GenesisCmdGenesisFileError . newExceptT - $ writeLazyByteStringFile ocertCtrPath + $ writeLazyByteStringFile opCertCounterPath $ textEnvelopeToJSON (Just certCtrDesc) $ OperationalCertificateIssueCounter initialCounter @@ -791,9 +794,11 @@ createDelegateKeys :: KeyOutputFormat -> FilePath -> Word -> ExceptT GenesisCmdE createDelegateKeys fmt dir index = do liftIO $ createDirectoryIfMissing False dir runGenesisKeyGenDelegateCmd - (File @(VerificationKey ()) $ dir "delegate" ++ strIndex ++ ".vkey") - (onlyOut coldSK) - (onlyOut opCertCtr) + Cmd.GenesisKeyGenDelegateCmdArgs + { Cmd.verificationKeyPath = File @(VerificationKey ()) $ dir "delegate" ++ strIndex ++ ".vkey" + , Cmd.signingKeyPath = onlyOut coldSK + , Cmd.opCertCounterPath = onlyOut opCertCtr + } runGenesisKeyGenDelegateVRF (File @(VerificationKey ()) $ dir "delegate" ++ strIndex ++ ".vrf.vkey") (File @(SigningKey ()) $ dir "delegate" ++ strIndex ++ ".vrf.skey") diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs index 34d9181fbd..4872bbeb24 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs @@ -57,7 +57,13 @@ runLegacyGenesisKeyGenDelegateCmd :: () -> SigningKeyFile Out -> OpCertCounterFile Out -> ExceptT GenesisCmdError IO () -runLegacyGenesisKeyGenDelegateCmd = runGenesisKeyGenDelegateCmd +runLegacyGenesisKeyGenDelegateCmd vkf skf okf = + runGenesisKeyGenDelegateCmd + Cmd.GenesisKeyGenDelegateCmdArgs + { Cmd.verificationKeyPath = vkf + , Cmd.signingKeyPath = skf + , Cmd.opCertCounterPath = okf + } runLegacyGenesisKeyGenUTxOCmd :: () => VerificationKeyFile Out From 13147d43050d36af1f35ec68f5eeb2bbb952fb49 Mon Sep 17 00:00:00 2001 From: Carl Hammann Date: Mon, 23 Oct 2023 12:17:34 +0200 Subject: [PATCH 6/7] Command argument types: 'genesis key-gen-utxo' --- .../Cardano/CLI/EraBased/Commands/Genesis.hs | 11 +++++--- .../Cardano/CLI/EraBased/Options/Genesis.hs | 2 +- .../src/Cardano/CLI/EraBased/Run/Genesis.hs | 25 +++++++++++-------- .../src/Cardano/CLI/Legacy/Run/Genesis.hs | 7 +++++- 4 files changed, 30 insertions(+), 15 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs index 7f10967d4c..f9b99eec00 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs @@ -9,6 +9,7 @@ module Cardano.CLI.EraBased.Commands.Genesis , GenesisCreateStakedCmdArgs (..) , GenesisKeyGenGenesisCmdArgs (..) , GenesisKeyGenDelegateCmdArgs (..) + , GenesisKeyGenUTxOCmdArgs (..) , renderGenesisCmds ) where @@ -25,9 +26,7 @@ data GenesisCmds era | GenesisCreateStaked !GenesisCreateStakedCmdArgs | GenesisKeyGenGenesis !GenesisKeyGenGenesisCmdArgs | GenesisKeyGenDelegate !GenesisKeyGenDelegateCmdArgs - | GenesisKeyGenUTxO - (VerificationKeyFile Out) - (SigningKeyFile Out) + | GenesisKeyGenUTxO !GenesisKeyGenUTxOCmdArgs | GenesisCmdKeyHash (VerificationKeyFile In) | GenesisVerKey @@ -100,6 +99,12 @@ data GenesisKeyGenDelegateCmdArgs = GenesisKeyGenDelegateCmdArgs , opCertCounterPath :: !(OpCertCounterFile Out) } deriving Show +data GenesisKeyGenUTxOCmdArgs = GenesisKeyGenUTxOCmdArgs + { verificationKeyPath :: !(VerificationKeyFile Out) + , signingKeyPath :: !(SigningKeyFile Out) + } deriving Show + + renderGenesisCmds :: GenesisCmds era -> Text renderGenesisCmds = \case GenesisCreate {} -> diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs index 46b824fd95..70a2b34671 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs @@ -107,7 +107,7 @@ pGenesisDelegateKeyGen = pGenesisUTxOKeyGen :: Parser (GenesisCmds era) pGenesisUTxOKeyGen = - GenesisKeyGenUTxO + fmap GenesisKeyGenUTxO $ GenesisKeyGenUTxOCmdArgs <$> pVerificationKeyFileOut <*> pSigningKeyFileOut diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs index e46d958028..3af2f335b9 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs @@ -147,8 +147,8 @@ runGenesisCmds = \case runGenesisKeyGenGenesisCmd args GenesisKeyGenDelegate args -> runGenesisKeyGenDelegateCmd args - GenesisKeyGenUTxO vk sk -> - runGenesisKeyGenUTxOCmd vk sk + GenesisKeyGenUTxO args -> + runGenesisKeyGenUTxOCmd args GenesisCmdKeyHash vk -> runGenesisKeyHashCmd vk GenesisVerKey vk sk -> @@ -248,20 +248,23 @@ runGenesisKeyGenDelegateVRF vkeyPath skeyPath = do vkeyDesc = "VRF Verification Key" -runGenesisKeyGenUTxOCmd :: - VerificationKeyFile Out - -> SigningKeyFile Out +runGenesisKeyGenUTxOCmd + :: GenesisKeyGenUTxOCmdArgs -> ExceptT GenesisCmdError IO () -runGenesisKeyGenUTxOCmd vkeyPath skeyPath = do +runGenesisKeyGenUTxOCmd + Cmd.GenesisKeyGenUTxOCmdArgs + { Cmd.verificationKeyPath + , Cmd.signingKeyPath + } = do skey <- liftIO $ generateSigningKey AsGenesisUTxOKey let vkey = getVerificationKey skey firstExceptT GenesisCmdGenesisFileError . newExceptT - $ writeLazyByteStringFile skeyPath + $ writeLazyByteStringFile signingKeyPath $ textEnvelopeToJSON (Just skeyDesc) skey firstExceptT GenesisCmdGenesisFileError . newExceptT - $ writeLazyByteStringFile vkeyPath + $ writeLazyByteStringFile verificationKeyPath $ textEnvelopeToJSON (Just vkeyDesc) vkey where skeyDesc, vkeyDesc :: TextEnvelopeDescr @@ -834,8 +837,10 @@ createUtxoKeys dir index = do liftIO $ createDirectoryIfMissing False dir let strIndex = show index runGenesisKeyGenUTxOCmd - (File @(VerificationKey ()) $ dir "utxo" ++ strIndex ++ ".vkey") - (File @(SigningKey ()) $ dir "utxo" ++ strIndex ++ ".skey") + Cmd.GenesisKeyGenUTxOCmdArgs + { Cmd.verificationKeyPath = File @(VerificationKey ()) $ dir "utxo" ++ strIndex ++ ".vkey" + , Cmd.signingKeyPath = File @(SigningKey ()) $ dir "utxo" ++ strIndex ++ ".skey" + } createPoolCredentials :: KeyOutputFormat -> FilePath -> Word -> ExceptT GenesisCmdError IO () createPoolCredentials fmt dir index = do diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs index 4872bbeb24..0e807eaf1a 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs @@ -69,7 +69,12 @@ runLegacyGenesisKeyGenUTxOCmd :: () => VerificationKeyFile Out -> SigningKeyFile Out -> ExceptT GenesisCmdError IO () -runLegacyGenesisKeyGenUTxOCmd = runGenesisKeyGenUTxOCmd +runLegacyGenesisKeyGenUTxOCmd vk sk = + runGenesisKeyGenUTxOCmd + Cmd.GenesisKeyGenUTxOCmdArgs + { Cmd.verificationKeyPath = vk + , Cmd.signingKeyPath = sk + } runLegacyGenesisKeyHashCmd :: VerificationKeyFile In -> ExceptT GenesisCmdError IO () runLegacyGenesisKeyHashCmd = runGenesisKeyHashCmd From f62ad62f4997c07ee9a6a02c9b563f6eec4c3ca2 Mon Sep 17 00:00:00 2001 From: Carl Hammann Date: Mon, 23 Oct 2023 12:39:45 +0200 Subject: [PATCH 7/7] Command argument types: rest of 'genesis', format --- .../Cardano/CLI/EraBased/Commands/Genesis.hs | 39 +++++---- .../Cardano/CLI/EraBased/Options/Genesis.hs | 6 +- .../src/Cardano/CLI/EraBased/Run/Genesis.hs | 84 +++++++++---------- .../src/Cardano/CLI/Legacy/Run/Genesis.hs | 28 +++++-- 4 files changed, 91 insertions(+), 66 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs index f9b99eec00..2db1b5a876 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs @@ -10,6 +10,9 @@ module Cardano.CLI.EraBased.Commands.Genesis , GenesisKeyGenGenesisCmdArgs (..) , GenesisKeyGenDelegateCmdArgs (..) , GenesisKeyGenUTxOCmdArgs (..) + , GenesisVerKeyCmdArgs (..) + , GenesisTxInCmdArgs (..) + , GenesisAddrCmdArgs (..) , renderGenesisCmds ) where @@ -27,21 +30,11 @@ data GenesisCmds era | GenesisKeyGenGenesis !GenesisKeyGenGenesisCmdArgs | GenesisKeyGenDelegate !GenesisKeyGenDelegateCmdArgs | GenesisKeyGenUTxO !GenesisKeyGenUTxOCmdArgs - | GenesisCmdKeyHash - (VerificationKeyFile In) - | GenesisVerKey - (VerificationKeyFile Out) - (SigningKeyFile In) - | GenesisTxIn - (VerificationKeyFile In) - NetworkId - (Maybe (File () Out)) - | GenesisAddr - (VerificationKeyFile In) - NetworkId - (Maybe (File () Out)) - | GenesisHashFile - GenesisFile + | GenesisCmdKeyHash !(VerificationKeyFile In) + | GenesisVerKey !GenesisVerKeyCmdArgs + | GenesisTxIn !GenesisTxInCmdArgs + | GenesisAddr !GenesisAddrCmdArgs + | GenesisHashFile !GenesisFile deriving Show data GenesisCreateCmdArgs = GenesisCreateCmdArgs @@ -104,6 +97,22 @@ data GenesisKeyGenUTxOCmdArgs = GenesisKeyGenUTxOCmdArgs , signingKeyPath :: !(SigningKeyFile Out) } deriving Show +data GenesisVerKeyCmdArgs = GenesisVerKeyCmdArgs + { verificationKeyPath :: !(VerificationKeyFile Out) + , signingKeyPath :: !(SigningKeyFile In) + } deriving Show + +data GenesisTxInCmdArgs = GenesisTxInCmdArgs + { verificationKeyPath :: !(VerificationKeyFile In) + , network :: !NetworkId + , mOutFile :: !(Maybe (File () Out)) + } deriving Show + +data GenesisAddrCmdArgs = GenesisAddrCmdArgs + { verificationKeyPath :: !(VerificationKeyFile In) + , network :: !NetworkId + , mOutFile :: !(Maybe (File () Out)) + } deriving Show renderGenesisCmds :: GenesisCmds era -> Text renderGenesisCmds = \case diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs index 70a2b34671..4dc8aa8664 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs @@ -118,20 +118,20 @@ pGenesisKeyHash = pGenesisVerKey :: Parser (GenesisCmds era) pGenesisVerKey = - GenesisVerKey + fmap GenesisVerKey $ GenesisVerKeyCmdArgs <$> pVerificationKeyFileOut <*> pSigningKeyFileIn pGenesisAddr :: EnvCli -> Parser (GenesisCmds era) pGenesisAddr envCli = - GenesisAddr + fmap GenesisAddr $ GenesisAddrCmdArgs <$> pVerificationKeyFileIn <*> pNetworkId envCli <*> pMaybeOutputFile pGenesisTxIn :: EnvCli -> Parser (GenesisCmds era) pGenesisTxIn envCli = - GenesisTxIn + fmap GenesisTxIn $ GenesisTxInCmdArgs <$> pVerificationKeyFileIn <*> pNetworkId envCli <*> pMaybeOutputFile diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs index 3af2f335b9..4e31a50cf9 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs @@ -1,9 +1,9 @@ {-# LANGUAGE BangPatterns #-} -{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -143,28 +143,17 @@ import Crypto.Random as Crypto runGenesisCmds :: GenesisCmds era -> ExceptT GenesisCmdError IO () runGenesisCmds = \case - GenesisKeyGenGenesis args -> - runGenesisKeyGenGenesisCmd args - GenesisKeyGenDelegate args -> - runGenesisKeyGenDelegateCmd args - GenesisKeyGenUTxO args -> - runGenesisKeyGenUTxOCmd args - GenesisCmdKeyHash vk -> - runGenesisKeyHashCmd vk - GenesisVerKey vk sk -> - runGenesisVerKeyCmd vk sk - GenesisTxIn vk nw mOutFile -> - runGenesisTxInCmd vk nw mOutFile - GenesisAddr vk nw mOutFile -> - runGenesisAddrCmd vk nw mOutFile - GenesisCreate args -> - runGenesisCreateCmd args - GenesisCreateCardano args -> - runGenesisCreateCardanoCmd args - GenesisCreateStaked args -> - runGenesisCreateStakedCmd args - GenesisHashFile gf -> - runGenesisHashFileCmd gf + GenesisKeyGenGenesis args -> runGenesisKeyGenGenesisCmd args + GenesisKeyGenDelegate args -> runGenesisKeyGenDelegateCmd args + GenesisKeyGenUTxO args -> runGenesisKeyGenUTxOCmd args + GenesisCmdKeyHash vk -> runGenesisKeyHashCmd vk + GenesisVerKey args -> runGenesisVerKeyCmd args + GenesisTxIn args -> runGenesisTxInCmd args + GenesisAddr args -> runGenesisAddrCmd args + GenesisCreate args -> runGenesisCreateCmd args + GenesisCreateCardano args -> runGenesisCreateCardanoCmd args + GenesisCreateStaked args -> runGenesisCreateStakedCmd args + GenesisHashFile gf -> runGenesisHashFileCmd gf runGenesisKeyGenGenesisCmd :: GenesisKeyGenGenesisCmdArgs @@ -296,11 +285,14 @@ runGenesisKeyHashCmd vkeyPath = do . verificationKeyHash -runGenesisVerKeyCmd :: - VerificationKeyFile Out - -> SigningKeyFile In +runGenesisVerKeyCmd + :: GenesisVerKeyCmdArgs -> ExceptT GenesisCmdError IO () -runGenesisVerKeyCmd vkeyPath skeyPath = do +runGenesisVerKeyCmd + Cmd.GenesisVerKeyCmdArgs + { Cmd.verificationKeyPath + , Cmd.signingKeyPath + } = do skey <- firstExceptT GenesisCmdTextEnvReadFileError . newExceptT $ readFileTextEnvelopeAnyOf [ FromSomeType (AsSigningKey AsGenesisKey) @@ -310,7 +302,7 @@ runGenesisVerKeyCmd vkeyPath skeyPath = do , FromSomeType (AsSigningKey AsGenesisUTxOKey) AGenesisUTxOKey ] - skeyPath + signingKeyPath let vkey :: SomeGenesisKey VerificationKey vkey = case skey of @@ -320,9 +312,9 @@ runGenesisVerKeyCmd vkeyPath skeyPath = do firstExceptT GenesisCmdGenesisFileError . newExceptT . liftIO $ case vkey of - AGenesisKey vk -> writeLazyByteStringFile vkeyPath $ textEnvelopeToJSON Nothing vk - AGenesisDelegateKey vk -> writeLazyByteStringFile vkeyPath $ textEnvelopeToJSON Nothing vk - AGenesisUTxOKey vk -> writeLazyByteStringFile vkeyPath $ textEnvelopeToJSON Nothing vk + AGenesisKey vk -> writeLazyByteStringFile verificationKeyPath $ textEnvelopeToJSON Nothing vk + AGenesisDelegateKey vk -> writeLazyByteStringFile verificationKeyPath $ textEnvelopeToJSON Nothing vk + AGenesisUTxOKey vk -> writeLazyByteStringFile verificationKeyPath $ textEnvelopeToJSON Nothing vk data SomeGenesisKey f = AGenesisKey (f GenesisKey) @@ -330,26 +322,32 @@ data SomeGenesisKey f | AGenesisUTxOKey (f GenesisUTxOKey) -runGenesisTxInCmd :: - VerificationKeyFile In - -> NetworkId - -> Maybe (File () Out) +runGenesisTxInCmd + :: GenesisTxInCmdArgs -> ExceptT GenesisCmdError IO () -runGenesisTxInCmd vkeyPath network mOutFile = do +runGenesisTxInCmd + Cmd.GenesisTxInCmdArgs + { Cmd.verificationKeyPath + , Cmd.network + , Cmd.mOutFile + } = do vkey <- firstExceptT GenesisCmdTextEnvReadFileError . newExceptT $ - readFileTextEnvelope (AsVerificationKey AsGenesisUTxOKey) vkeyPath + readFileTextEnvelope (AsVerificationKey AsGenesisUTxOKey) verificationKeyPath let txin = genesisUTxOPseudoTxIn network (verificationKeyHash vkey) liftIO $ writeOutput mOutFile (renderTxIn txin) -runGenesisAddrCmd :: - VerificationKeyFile In - -> NetworkId - -> Maybe (File () Out) +runGenesisAddrCmd + :: GenesisAddrCmdArgs -> ExceptT GenesisCmdError IO () -runGenesisAddrCmd vkeyPath network mOutFile = do +runGenesisAddrCmd + Cmd.GenesisAddrCmdArgs + { Cmd.verificationKeyPath + , Cmd.network + , Cmd.mOutFile + } = do vkey <- firstExceptT GenesisCmdTextEnvReadFileError . newExceptT $ - readFileTextEnvelope (AsVerificationKey AsGenesisUTxOKey) vkeyPath + readFileTextEnvelope (AsVerificationKey AsGenesisUTxOKey) verificationKeyPath let vkh = verificationKeyHash (castVerificationKey vkey) addr = makeShelleyAddress network (PaymentCredentialByKey vkh) NoStakeAddress diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs index 0e807eaf1a..c50ff9c396 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs @@ -12,14 +12,15 @@ module Cardano.CLI.Legacy.Run.Genesis import Cardano.Api import Cardano.Chain.Common (BlockCount) +import Cardano.CLI.EraBased.Commands.Genesis + (GenesisKeyGenGenesisCmdArgs (GenesisKeyGenGenesisCmdArgs)) +import qualified Cardano.CLI.EraBased.Commands.Genesis as Cmd import Cardano.CLI.EraBased.Run.Genesis import Cardano.CLI.Legacy.Commands.Genesis import Cardano.CLI.Types.Common import Cardano.CLI.Types.Errors.GenesisCmdError import Control.Monad.Trans.Except (ExceptT) -import qualified Cardano.CLI.EraBased.Commands.Genesis as Cmd -import Cardano.CLI.EraBased.Commands.Genesis (GenesisKeyGenGenesisCmdArgs(GenesisKeyGenGenesisCmdArgs)) runLegacyGenesisCmds :: LegacyGenesisCmds -> ExceptT GenesisCmdError IO () runLegacyGenesisCmds = \case @@ -83,21 +84,38 @@ runLegacyGenesisVerKeyCmd :: VerificationKeyFile Out -> SigningKeyFile In -> ExceptT GenesisCmdError IO () -runLegacyGenesisVerKeyCmd = runGenesisVerKeyCmd +runLegacyGenesisVerKeyCmd vk sk = + runGenesisVerKeyCmd + Cmd.GenesisVerKeyCmdArgs + { Cmd.verificationKeyPath = vk + , Cmd.signingKeyPath = sk + } runLegacyGenesisTxInCmd :: () => VerificationKeyFile In -> NetworkId -> Maybe (File () Out) -> ExceptT GenesisCmdError IO () -runLegacyGenesisTxInCmd = runGenesisTxInCmd +runLegacyGenesisTxInCmd vkt nid mOf = + runGenesisTxInCmd + Cmd.GenesisTxInCmdArgs + { Cmd.verificationKeyPath = vkt + , Cmd.network = nid + , Cmd.mOutFile = mOf + } runLegacyGenesisAddrCmd :: () => VerificationKeyFile In -> NetworkId -> Maybe (File () Out) -> ExceptT GenesisCmdError IO () -runLegacyGenesisAddrCmd = runGenesisAddrCmd +runLegacyGenesisAddrCmd vkf nid mOf = + runGenesisAddrCmd + Cmd.GenesisAddrCmdArgs + { Cmd.verificationKeyPath = vkf + , Cmd.network = nid + , Cmd.mOutFile = mOf + } runLegacyGenesisCreateCmd :: () => KeyOutputFormat