From 400fec6c608575dc0467ee9c9bc3efb458eb34a6 Mon Sep 17 00:00:00 2001 From: Carl Hammann Date: Mon, 23 Oct 2023 12:39:45 +0200 Subject: [PATCH] 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