From c9f15b4528ff2e94aa2f74889489d749a549d114 Mon Sep 17 00:00:00 2001 From: John Ky Date: Thu, 2 Nov 2023 22:46:38 +1100 Subject: [PATCH] Command types for node commands --- .../src/Cardano/CLI/EraBased/Commands/Node.hs | 111 ++++--- .../src/Cardano/CLI/EraBased/Options/Node.hs | 59 ++-- .../src/Cardano/CLI/EraBased/Run/Genesis.hs | 13 +- .../src/Cardano/CLI/EraBased/Run/Node.hs | 302 +++++++++--------- .../src/Cardano/CLI/Legacy/Commands/Node.hs | 48 +-- cardano-cli/src/Cardano/CLI/Legacy/Options.hs | 60 ++-- .../src/Cardano/CLI/Legacy/Run/Node.hs | 55 +--- 7 files changed, 330 insertions(+), 318 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Node.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Node.hs index 82d03e9d93..cce39fc201 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Node.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Node.hs @@ -1,9 +1,17 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE LambdaCase #-} module Cardano.CLI.EraBased.Commands.Node ( NodeCmds (..) , renderNodeCmds + + , NodeKeyGenColdCmdArgs(..) + , NodeKeyGenKESCmdArgs(..) + , NodeKeyGenVRFCmdArgs(..) + , NodeKeyHashVRFCmdArgs(..) + , NodeNewCounterCmdArgs(..) + , NodeIssueOpCertCmdArgs(..) ) where import Cardano.Api.Shelley @@ -14,44 +22,73 @@ import Cardano.CLI.Types.Key import Data.Text (Text) data NodeCmds era - = NodeKeyGenCold - KeyOutputFormat - (VerificationKeyFile Out) - (SigningKeyFile Out) - (OpCertCounterFile Out) - | NodeKeyGenKES - KeyOutputFormat - (VerificationKeyFile Out) - (SigningKeyFile Out) - | NodeKeyGenVRF - KeyOutputFormat - (VerificationKeyFile Out) - (SigningKeyFile Out) - | NodeKeyHashVRF - (VerificationKeyOrFile VrfKey) - (Maybe (File () Out)) - | NodeNewCounter - ColdVerificationKeyOrFile - Word - (OpCertCounterFile InOut) - | NodeIssueOpCert - (VerificationKeyOrFile KesKey) - (SigningKeyFile In) - (OpCertCounterFile InOut) - KESPeriod (File () Out) + = NodeKeyGenColdCmd !NodeKeyGenColdCmdArgs + | NodeKeyGenKESCmd !NodeKeyGenKESCmdArgs + | NodeKeyGenVRFCmd !NodeKeyGenVRFCmdArgs + | NodeKeyHashVRFCmd !NodeKeyHashVRFCmdArgs + | NodeNewCounterCmd !NodeNewCounterCmdArgs + | NodeIssueOpCertCmd !NodeIssueOpCertCmdArgs + deriving Show + +data NodeKeyGenColdCmdArgs = + NodeKeyGenColdCmdArgs + { keyOutputFormat :: !KeyOutputFormat + , vkeyFile :: !(VerificationKeyFile Out) + , skeyFile :: !(SigningKeyFile Out) + , operationalCertificateIssueCounter :: !(OpCertCounterFile Out) + } + deriving Show + +data NodeKeyGenKESCmdArgs = + NodeKeyGenKESCmdArgs + { keyOutputFormat :: !KeyOutputFormat + , vkeyFile :: !(VerificationKeyFile Out) + , skeyFile :: !(SigningKeyFile Out) + } + deriving Show + +data NodeKeyGenVRFCmdArgs = + NodeKeyGenVRFCmdArgs + { keyOutputFormat :: !KeyOutputFormat + , vkeyFile :: !(VerificationKeyFile Out) + , skeyFile :: !(SigningKeyFile Out) + } + deriving Show + +data NodeKeyHashVRFCmdArgs = + NodeKeyHashVRFCmdArgs + { vkeySource :: !(VerificationKeyOrFile VrfKey) + , mOutFile :: !(Maybe (File () Out)) + } + deriving Show + +data NodeNewCounterCmdArgs = + NodeNewCounterCmdArgs + { coldVkeyFile :: !ColdVerificationKeyOrFile + , counter :: !Word + , mOutFile :: !(OpCertCounterFile InOut) + } + deriving Show + +data NodeIssueOpCertCmdArgs = + NodeIssueOpCertCmdArgs + { kesVkeySource :: !(VerificationKeyOrFile KesKey) + -- ^ The hot KES verification key. + , poolSkeyFile :: !(SigningKeyFile In) + -- ^ The cold signing key. + , operationalCertificateCounterFile :: !(OpCertCounterFile InOut) + -- ^ Counter that establishes the precedence of the operational certificate. + , kesPeriod :: !KESPeriod + -- ^ Start of the validity period for this certificate. + , outFile :: !(File () Out) + } deriving Show renderNodeCmds :: NodeCmds era -> Text renderNodeCmds = \case - NodeKeyGenCold {} -> - "node key-gen" - NodeKeyGenKES {} -> - "node key-gen-KES" - NodeKeyGenVRF {} -> - "node key-gen-VRF" - NodeKeyHashVRF {} -> - "node key-hash-VRF" - NodeNewCounter {} -> - "node new-counter" - NodeIssueOpCert{} -> - "node issue-op-cert" + NodeKeyGenColdCmd {} -> "node key-gen" + NodeKeyGenKESCmd {} -> "node key-gen-KES" + NodeKeyGenVRFCmd {} -> "node key-gen-VRF" + NodeKeyHashVRFCmd {} -> "node key-hash-VRF" + NodeNewCounterCmd {} -> "node new-counter" + NodeIssueOpCertCmd {} -> "node issue-op-cert" diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Node.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Node.hs index b691b5d89b..ed7b3e5509 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Node.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Node.hs @@ -10,6 +10,7 @@ module Cardano.CLI.EraBased.Options.Node import Cardano.Api hiding (QueryInShelleyBasedEra (..)) import Cardano.CLI.EraBased.Commands.Node +import qualified Cardano.CLI.EraBased.Commands.Node as Cmd import Cardano.CLI.EraBased.Options.Common import Options.Applicative hiding (help, str) @@ -71,38 +72,43 @@ pNodeCmds = pKeyGenOperator :: Parser (NodeCmds era) pKeyGenOperator = - NodeKeyGenCold - <$> pKeyOutputFormat - <*> pColdVerificationKeyFile - <*> pColdSigningKeyFile - <*> pOperatorCertIssueCounterFile + fmap Cmd.NodeKeyGenColdCmd $ + Cmd.NodeKeyGenColdCmdArgs + <$> pKeyOutputFormat + <*> pColdVerificationKeyFile + <*> pColdSigningKeyFile + <*> pOperatorCertIssueCounterFile pKeyGenKES :: Parser (NodeCmds era) pKeyGenKES = - NodeKeyGenKES - <$> pKeyOutputFormat - <*> pVerificationKeyFileOut - <*> pSigningKeyFileOut + fmap Cmd.NodeKeyGenKESCmd $ + Cmd.NodeKeyGenKESCmdArgs + <$> pKeyOutputFormat + <*> pVerificationKeyFileOut + <*> pSigningKeyFileOut pKeyGenVRF :: Parser (NodeCmds era) pKeyGenVRF = - NodeKeyGenVRF - <$> pKeyOutputFormat - <*> pVerificationKeyFileOut - <*> pSigningKeyFileOut + fmap Cmd.NodeKeyGenVRFCmd $ + Cmd.NodeKeyGenVRFCmdArgs + <$> pKeyOutputFormat + <*> pVerificationKeyFileOut + <*> pSigningKeyFileOut pKeyHashVRF :: Parser (NodeCmds era) pKeyHashVRF = - NodeKeyHashVRF - <$> pVerificationKeyOrFileIn AsVrfKey - <*> pMaybeOutputFile + fmap Cmd.NodeKeyHashVRFCmd $ + Cmd.NodeKeyHashVRFCmdArgs + <$> pVerificationKeyOrFileIn AsVrfKey + <*> pMaybeOutputFile pNewCounter :: Parser (NodeCmds era) pNewCounter = - NodeNewCounter - <$> pColdVerificationKeyOrFile Nothing - <*> pCounterValue - <*> pOperatorCertIssueCounterFile + fmap Cmd.NodeNewCounterCmd $ + Cmd.NodeNewCounterCmdArgs + <$> pColdVerificationKeyOrFile Nothing + <*> pCounterValue + <*> pOperatorCertIssueCounterFile pCounterValue :: Parser Word pCounterValue = @@ -114,9 +120,10 @@ pCounterValue = pIssueOpCert :: Parser (NodeCmds era) pIssueOpCert = - NodeIssueOpCert - <$> pKesVerificationKeyOrFile - <*> pColdSigningKeyFile - <*> pOperatorCertIssueCounterFile - <*> pKesPeriod - <*> pOutputFile + fmap Cmd.NodeIssueOpCertCmd $ + Cmd.NodeIssueOpCertCmdArgs + <$> pKesVerificationKeyOrFile + <*> pColdSigningKeyFile + <*> pOperatorCertIssueCounterFile + <*> pKesPeriod + <*> pOutputFile diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs index a1d586a9ad..92e03ad0fc 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs @@ -57,6 +57,7 @@ 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 as Cmd +import qualified Cardano.CLI.EraBased.Commands.Node as Cmd import qualified Cardano.CLI.EraBased.Run.Key as Key import Cardano.CLI.EraBased.Run.Node (runNodeIssueOpCertCmd, runNodeKeyGenColdCmd, runNodeKeyGenKesCmd, runNodeKeyGenVrfCmd) @@ -803,11 +804,11 @@ createDelegateKeys fmt dir index = do (File @(VerificationKey ()) $ dir "delegate" ++ strIndex ++ ".vrf.vkey") (File @(SigningKey ()) $ dir "delegate" ++ strIndex ++ ".vrf.skey") firstExceptT GenesisCmdNodeCmdError $ do - runNodeKeyGenKesCmd + runNodeKeyGenKesCmd $ Cmd.NodeKeyGenKESCmdArgs fmt (onlyOut kesVK) (File @(SigningKey ()) $ dir "delegate" ++ strIndex ++ ".kes.skey") - runNodeIssueOpCertCmd + runNodeIssueOpCertCmd $ Cmd.NodeIssueOpCertCmdArgs (VerificationKeyFilePath (onlyIn kesVK)) (onlyIn coldSK) opCertCtr @@ -843,20 +844,20 @@ createPoolCredentials :: KeyOutputFormat -> FilePath -> Word -> ExceptT GenesisC createPoolCredentials fmt dir index = do liftIO $ createDirectoryIfMissing False dir firstExceptT GenesisCmdNodeCmdError $ do - runNodeKeyGenKesCmd + runNodeKeyGenKesCmd $ Cmd.NodeKeyGenKESCmdArgs fmt (onlyOut kesVK) (File @(SigningKey ()) $ dir "kes" ++ strIndex ++ ".skey") - runNodeKeyGenVrfCmd + runNodeKeyGenVrfCmd $ Cmd.NodeKeyGenVRFCmdArgs fmt (File @(VerificationKey ()) $ dir "vrf" ++ strIndex ++ ".vkey") (File @(SigningKey ()) $ dir "vrf" ++ strIndex ++ ".skey") - runNodeKeyGenColdCmd + runNodeKeyGenColdCmd $ Cmd.NodeKeyGenColdCmdArgs fmt (File @(VerificationKey ()) $ dir "cold" ++ strIndex ++ ".vkey") (onlyOut coldSK) (onlyOut opCertCtr) - runNodeIssueOpCertCmd + runNodeIssueOpCertCmd $ Cmd.NodeIssueOpCertCmdArgs (VerificationKeyFilePath (onlyIn kesVK)) (onlyIn coldSK) opCertCtr diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Node.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Node.hs index b91ec37ab7..af2240a921 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Node.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Node.hs @@ -1,5 +1,7 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} module Cardano.CLI.EraBased.Run.Node ( runNodeCmds @@ -15,7 +17,7 @@ module Cardano.CLI.EraBased.Run.Node import Cardano.Api import Cardano.Api.Shelley -import Cardano.CLI.EraBased.Commands.Node +import qualified Cardano.CLI.EraBased.Commands.Node as Cmd import Cardano.CLI.Types.Common import Cardano.CLI.Types.Errors.NodeCmdError import Cardano.CLI.Types.Key @@ -30,61 +32,59 @@ import Data.Word (Word64) {- HLINT ignore "Reduce duplication" -} runNodeCmds :: () - => NodeCmds era + => Cmd.NodeCmds era -> ExceptT NodeCmdError IO () runNodeCmds = \case - NodeKeyGenCold fmt vk sk ctr -> - runNodeKeyGenColdCmd fmt vk sk ctr - NodeKeyGenKES fmt vk sk -> - runNodeKeyGenKesCmd fmt vk sk - NodeKeyGenVRF fmt vk sk -> - runNodeKeyGenVrfCmd fmt vk sk - NodeKeyHashVRF vk mOutFp -> - runNodeKeyHashVrfCmd vk mOutFp - NodeNewCounter vk ctr out -> - runNodeNewCounterCmd vk ctr out - NodeIssueOpCert vk sk ctr p out -> - runNodeIssueOpCertCmd vk sk ctr p out - -runNodeKeyGenColdCmd - :: KeyOutputFormat - -> VerificationKeyFile Out - -> SigningKeyFile Out - -> OpCertCounterFile Out + Cmd.NodeKeyGenColdCmd args -> runNodeKeyGenColdCmd args + Cmd.NodeKeyGenKESCmd args -> runNodeKeyGenKesCmd args + Cmd.NodeKeyGenVRFCmd args -> runNodeKeyGenVrfCmd args + Cmd.NodeKeyHashVRFCmd args -> runNodeKeyHashVrfCmd args + Cmd.NodeNewCounterCmd args -> runNodeNewCounterCmd args + Cmd.NodeIssueOpCertCmd args -> runNodeIssueOpCertCmd args + +runNodeKeyGenColdCmd :: () + => Cmd.NodeKeyGenColdCmdArgs -> ExceptT NodeCmdError IO () -runNodeKeyGenColdCmd fmt vkeyPath skeyPath ocertCtrPath = do - skey <- liftIO $ generateSigningKey AsStakePoolKey - let vkey = getVerificationKey skey - - case fmt of - KeyOutputFormatTextEnvelope -> - firstExceptT NodeCmdWriteFileError - . newExceptT - $ writeLazyByteStringFile skeyPath - $ textEnvelopeToJSON (Just skeyDesc) skey - KeyOutputFormatBech32 -> - firstExceptT NodeCmdWriteFileError - . newExceptT - $ writeTextFile skeyPath - $ serialiseToBech32 skey - - case fmt of - KeyOutputFormatTextEnvelope -> - firstExceptT NodeCmdWriteFileError - . newExceptT - $ writeLazyByteStringFile vkeyPath - $ textEnvelopeToJSON (Just vkeyDesc) vkey - KeyOutputFormatBech32 -> - firstExceptT NodeCmdWriteFileError - . newExceptT - $ writeTextFile vkeyPath - $ serialiseToBech32 vkey - - firstExceptT NodeCmdWriteFileError - . newExceptT - $ writeLazyByteStringFile ocertCtrPath - $ textEnvelopeToJSON (Just ocertCtrDesc) - $ OperationalCertificateIssueCounter initialCounter vkey +runNodeKeyGenColdCmd + Cmd.NodeKeyGenColdCmdArgs + { keyOutputFormat + , vkeyFile + , skeyFile + , operationalCertificateIssueCounter + } = do + skey <- liftIO $ generateSigningKey AsStakePoolKey + let vkey = getVerificationKey skey + + case keyOutputFormat of + KeyOutputFormatTextEnvelope -> + firstExceptT NodeCmdWriteFileError + . newExceptT + $ writeLazyByteStringFile skeyFile + $ textEnvelopeToJSON (Just skeyDesc) skey + KeyOutputFormatBech32 -> + firstExceptT NodeCmdWriteFileError + . newExceptT + $ writeTextFile skeyFile + $ serialiseToBech32 skey + + case keyOutputFormat of + KeyOutputFormatTextEnvelope -> + firstExceptT NodeCmdWriteFileError + . newExceptT + $ writeLazyByteStringFile vkeyFile + $ textEnvelopeToJSON (Just vkeyDesc) vkey + KeyOutputFormatBech32 -> + firstExceptT NodeCmdWriteFileError + . newExceptT + $ writeTextFile vkeyFile + $ serialiseToBech32 vkey + + firstExceptT NodeCmdWriteFileError + . newExceptT + $ writeLazyByteStringFile operationalCertificateIssueCounter + $ textEnvelopeToJSON (Just ocertCtrDesc) + $ OperationalCertificateIssueCounter initialCounter vkey + where skeyDesc :: TextEnvelopeDescr skeyDesc = "Stake Pool Operator Signing Key" @@ -100,38 +100,41 @@ runNodeKeyGenColdCmd fmt vkeyPath skeyPath ocertCtrPath = do initialCounter = 0 -runNodeKeyGenKesCmd - :: KeyOutputFormat - -> VerificationKeyFile Out - -> SigningKeyFile Out +runNodeKeyGenKesCmd :: () + => Cmd.NodeKeyGenKESCmdArgs -> ExceptT NodeCmdError IO () -runNodeKeyGenKesCmd fmt vkeyPath skeyPath = do +runNodeKeyGenKesCmd + Cmd.NodeKeyGenKESCmdArgs + { keyOutputFormat + , vkeyFile + , skeyFile + } = do skey <- liftIO $ generateSigningKey AsKesKey let vkey = getVerificationKey skey - case fmt of + case keyOutputFormat of KeyOutputFormatTextEnvelope -> firstExceptT NodeCmdWriteFileError . newExceptT - $ writeLazyByteStringFileWithOwnerPermissions skeyPath + $ writeLazyByteStringFileWithOwnerPermissions skeyFile $ textEnvelopeToJSON (Just skeyDesc) skey KeyOutputFormatBech32 -> firstExceptT NodeCmdWriteFileError . newExceptT - $ writeTextFile skeyPath + $ writeTextFile skeyFile $ serialiseToBech32 skey - case fmt of + case keyOutputFormat of KeyOutputFormatTextEnvelope -> firstExceptT NodeCmdWriteFileError . newExceptT - $ writeLazyByteStringFile vkeyPath + $ writeLazyByteStringFile vkeyFile $ textEnvelopeToJSON (Just vkeyDesc) vkey KeyOutputFormatBech32 -> firstExceptT NodeCmdWriteFileError . newExceptT - $ writeTextFile vkeyPath + $ writeTextFile vkeyFile $ serialiseToBech32 vkey where @@ -141,124 +144,131 @@ runNodeKeyGenKesCmd fmt vkeyPath skeyPath = do vkeyDesc :: TextEnvelopeDescr vkeyDesc = "KES Verification Key" -runNodeKeyGenVrfCmd - :: KeyOutputFormat - -> VerificationKeyFile Out - -> SigningKeyFile Out +runNodeKeyGenVrfCmd :: () + => Cmd.NodeKeyGenVRFCmdArgs -> ExceptT NodeCmdError IO () -runNodeKeyGenVrfCmd fmt vkeyPath skeyPath = do +runNodeKeyGenVrfCmd + Cmd.NodeKeyGenVRFCmdArgs + { keyOutputFormat + , vkeyFile + , skeyFile + } = do skey <- liftIO $ generateSigningKey AsVrfKey let vkey = getVerificationKey skey - case fmt of + case keyOutputFormat of KeyOutputFormatTextEnvelope -> firstExceptT NodeCmdWriteFileError . newExceptT - $ writeLazyByteStringFileWithOwnerPermissions skeyPath + $ writeLazyByteStringFileWithOwnerPermissions skeyFile $ textEnvelopeToJSON (Just skeyDesc) skey KeyOutputFormatBech32 -> firstExceptT NodeCmdWriteFileError . newExceptT - $ writeTextFile skeyPath + $ writeTextFile skeyFile $ serialiseToBech32 skey - case fmt of + case keyOutputFormat of KeyOutputFormatTextEnvelope -> firstExceptT NodeCmdWriteFileError . newExceptT - $ writeLazyByteStringFile vkeyPath + $ writeLazyByteStringFile vkeyFile $ textEnvelopeToJSON (Just vkeyDesc) vkey KeyOutputFormatBech32 -> firstExceptT NodeCmdWriteFileError . newExceptT - $ writeTextFile vkeyPath + $ writeTextFile vkeyFile $ serialiseToBech32 vkey where skeyDesc, vkeyDesc :: TextEnvelopeDescr skeyDesc = "VRF Signing Key" vkeyDesc = "VRF Verification Key" -runNodeKeyHashVrfCmd :: VerificationKeyOrFile VrfKey - -> Maybe (File () Out) - -> ExceptT NodeCmdError IO () -runNodeKeyHashVrfCmd verKeyOrFile mOutputFp = do +runNodeKeyHashVrfCmd :: () + => Cmd.NodeKeyHashVRFCmdArgs + -> ExceptT NodeCmdError IO () +runNodeKeyHashVrfCmd + Cmd.NodeKeyHashVRFCmdArgs + { vkeySource + , mOutFile + } = do vkey <- firstExceptT NodeCmdReadKeyFileError . newExceptT - $ readVerificationKeyOrFile AsVrfKey verKeyOrFile + $ readVerificationKeyOrFile AsVrfKey vkeySource let hexKeyHash = serialiseToRawBytesHex (verificationKeyHash vkey) - case mOutputFp of + case mOutFile of Just fpath -> liftIO $ BS.writeFile (unFile fpath) hexKeyHash Nothing -> liftIO $ BS.putStrLn hexKeyHash +runNodeNewCounterCmd :: () + => Cmd.NodeNewCounterCmdArgs + -> ExceptT NodeCmdError IO () +runNodeNewCounterCmd + Cmd.NodeNewCounterCmdArgs + { coldVkeyFile + , counter + , mOutFile + } = do + vkey <- firstExceptT NodeCmdReadFileError . newExceptT $ + readColdVerificationKeyOrFile coldVkeyFile + + let ocertIssueCounter = + OperationalCertificateIssueCounter (fromIntegral counter) vkey + + firstExceptT NodeCmdWriteFileError . newExceptT + $ writeLazyByteStringFile (onlyOut mOutFile) + $ textEnvelopeToJSON Nothing ocertIssueCounter + +runNodeIssueOpCertCmd :: () + => Cmd.NodeIssueOpCertCmdArgs + -> ExceptT NodeCmdError IO () +runNodeIssueOpCertCmd + Cmd.NodeIssueOpCertCmdArgs + { kesVkeySource + , poolSkeyFile + , operationalCertificateCounterFile + , kesPeriod + , outFile + } = do + ocertIssueCounter <- firstExceptT NodeCmdReadFileError + . newExceptT + $ readFileTextEnvelope AsOperationalCertificateIssueCounter (onlyIn operationalCertificateCounterFile) + + verKeyKes <- firstExceptT NodeCmdReadKeyFileError + . newExceptT + $ readVerificationKeyOrFile AsKesKey kesVkeySource + + signKey <- firstExceptT NodeCmdReadKeyFileError + . newExceptT + $ readKeyFileAnyOf + bech32PossibleBlockIssuers + textEnvPossibleBlockIssuers + poolSkeyFile + + (ocert, nextOcertCtr) <- + firstExceptT NodeCmdOperationalCertificateIssueError + . hoistEither + $ issueOperationalCertificate + verKeyKes + signKey + kesPeriod + ocertIssueCounter + + -- Write the counter first, to reduce the chance of ending up with + -- a new cert but without updating the counter. + firstExceptT NodeCmdWriteFileError + . newExceptT + $ writeLazyByteStringFile (onlyOut operationalCertificateCounterFile) + $ textEnvelopeToJSON (Just $ ocertCtrDesc $ getCounter nextOcertCtr) nextOcertCtr + + firstExceptT NodeCmdWriteFileError + . newExceptT + $ writeLazyByteStringFile outFile + $ textEnvelopeToJSON Nothing ocert -runNodeNewCounterCmd :: ColdVerificationKeyOrFile - -> Word - -> OpCertCounterFile InOut - -> ExceptT NodeCmdError IO () -runNodeNewCounterCmd coldVerKeyOrFile counter ocertCtrPath = do - - vkey <- firstExceptT NodeCmdReadFileError . newExceptT $ - readColdVerificationKeyOrFile coldVerKeyOrFile - - let ocertIssueCounter = - OperationalCertificateIssueCounter (fromIntegral counter) vkey - - firstExceptT NodeCmdWriteFileError . newExceptT - $ writeLazyByteStringFile (onlyOut ocertCtrPath) - $ textEnvelopeToJSON Nothing ocertIssueCounter - - -runNodeIssueOpCertCmd :: VerificationKeyOrFile KesKey - -- ^ This is the hot KES verification key. - -> SigningKeyFile In - -- ^ This is the cold signing key. - -> OpCertCounterFile InOut - -- ^ Counter that establishes the precedence - -- of the operational certificate. - -> KESPeriod - -- ^ Start of the validity period for this certificate. - -> File () Out - -> ExceptT NodeCmdError IO () -runNodeIssueOpCertCmd kesVerKeyOrFile stakePoolSKeyFile ocertCtrPath kesPeriod certFile = do - - ocertIssueCounter <- firstExceptT NodeCmdReadFileError - . newExceptT - $ readFileTextEnvelope AsOperationalCertificateIssueCounter (onlyIn ocertCtrPath) - - verKeyKes <- firstExceptT NodeCmdReadKeyFileError - . newExceptT - $ readVerificationKeyOrFile AsKesKey kesVerKeyOrFile - - signKey <- firstExceptT NodeCmdReadKeyFileError - . newExceptT - $ readKeyFileAnyOf - bech32PossibleBlockIssuers - textEnvPossibleBlockIssuers - stakePoolSKeyFile - - (ocert, nextOcertCtr) <- - firstExceptT NodeCmdOperationalCertificateIssueError - . hoistEither - $ issueOperationalCertificate - verKeyKes - signKey - kesPeriod - ocertIssueCounter - - -- Write the counter first, to reduce the chance of ending up with - -- a new cert but without updating the counter. - firstExceptT NodeCmdWriteFileError - . newExceptT - $ writeLazyByteStringFile (onlyOut ocertCtrPath) - $ textEnvelopeToJSON (Just $ ocertCtrDesc $ getCounter nextOcertCtr) nextOcertCtr - - firstExceptT NodeCmdWriteFileError - . newExceptT - $ writeLazyByteStringFile certFile - $ textEnvelopeToJSON Nothing ocert where getCounter :: OperationalCertificateIssueCounter -> Word64 getCounter (OperationalCertificateIssueCounter n _) = n diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Commands/Node.hs b/cardano-cli/src/Cardano/CLI/Legacy/Commands/Node.hs index a66925a729..d110e8093d 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Commands/Node.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Commands/Node.hs @@ -6,46 +6,24 @@ module Cardano.CLI.Legacy.Commands.Node , renderLegacyNodeCmds ) where -import Cardano.Api.Shelley - -import Cardano.CLI.Types.Common -import Cardano.CLI.Types.Key +import qualified Cardano.CLI.EraBased.Commands.Node as Cmd import Data.Text (Text) data LegacyNodeCmds - = NodeKeyGenCold - KeyOutputFormat - (VerificationKeyFile Out) - (SigningKeyFile Out) - (OpCertCounterFile Out) - | NodeKeyGenKES - KeyOutputFormat - (VerificationKeyFile Out) - (SigningKeyFile Out) - | NodeKeyGenVRF - KeyOutputFormat - (VerificationKeyFile Out) - (SigningKeyFile Out) - | NodeKeyHashVRF - (VerificationKeyOrFile VrfKey) - (Maybe (File () Out)) - | NodeNewCounter - ColdVerificationKeyOrFile - Word - (OpCertCounterFile InOut) - | NodeIssueOpCert - (VerificationKeyOrFile KesKey) - (SigningKeyFile In) - (OpCertCounterFile InOut) - KESPeriod (File () Out) + = LegacyNodeKeyGenColdCmd !Cmd.NodeKeyGenColdCmdArgs + | LegacyNodeKeyGenKESCmd !Cmd.NodeKeyGenKESCmdArgs + | LegacyNodeKeyGenVRFCmd !Cmd.NodeKeyGenVRFCmdArgs + | LegacyNodeKeyHashVRFCmd !Cmd.NodeKeyHashVRFCmdArgs + | LegacyNodeNewCounterCmd !Cmd.NodeNewCounterCmdArgs + | LegacyNodeIssueOpCertCmd !Cmd.NodeIssueOpCertCmdArgs deriving Show renderLegacyNodeCmds :: LegacyNodeCmds -> Text renderLegacyNodeCmds = \case - NodeKeyGenCold {} -> "node key-gen" - NodeKeyGenKES {} -> "node key-gen-KES" - NodeKeyGenVRF {} -> "node key-gen-VRF" - NodeKeyHashVRF {} -> "node key-hash-VRF" - NodeNewCounter {} -> "node new-counter" - NodeIssueOpCert{} -> "node issue-op-cert" + LegacyNodeKeyGenColdCmd {} -> "node key-gen" + LegacyNodeKeyGenKESCmd {} -> "node key-gen-KES" + LegacyNodeKeyGenVRFCmd {} -> "node key-gen-VRF" + LegacyNodeKeyHashVRFCmd {} -> "node key-hash-VRF" + LegacyNodeNewCounterCmd {} -> "node new-counter" + LegacyNodeIssueOpCertCmd {} -> "node issue-op-cert" diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Options.hs b/cardano-cli/src/Cardano/CLI/Legacy/Options.hs index 6552ce06f1..28966a50ca 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Options.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Options.hs @@ -26,12 +26,14 @@ import Cardano.Api.Shelley hiding (QueryInShelleyBasedEra (..)) import Cardano.Chain.Common (BlockCount (BlockCount)) import Cardano.CLI.Environment +import qualified Cardano.CLI.EraBased.Commands.Node as Cmd import Cardano.CLI.EraBased.Options.Common import Cardano.CLI.Legacy.Commands import Cardano.CLI.Legacy.Commands.Address import Cardano.CLI.Legacy.Commands.Genesis import Cardano.CLI.Legacy.Commands.Governance import Cardano.CLI.Legacy.Commands.Node +import qualified Cardano.CLI.Legacy.Commands.Node as Cmd import Cardano.CLI.Legacy.Commands.Query import Cardano.CLI.Legacy.Commands.StakeAddress import Cardano.CLI.Legacy.Commands.StakePool @@ -471,38 +473,43 @@ pNodeCmds = where pKeyGenOperator :: Parser LegacyNodeCmds pKeyGenOperator = - NodeKeyGenCold - <$> pKeyOutputFormat - <*> pColdVerificationKeyFile - <*> pColdSigningKeyFile - <*> pOperatorCertIssueCounterFile + fmap Cmd.LegacyNodeKeyGenColdCmd $ + Cmd.NodeKeyGenColdCmdArgs + <$> pKeyOutputFormat + <*> pColdVerificationKeyFile + <*> pColdSigningKeyFile + <*> pOperatorCertIssueCounterFile pKeyGenKES :: Parser LegacyNodeCmds pKeyGenKES = - NodeKeyGenKES - <$> pKeyOutputFormat - <*> pVerificationKeyFileOut - <*> pSigningKeyFileOut + fmap Cmd.LegacyNodeKeyGenKESCmd $ + Cmd.NodeKeyGenKESCmdArgs + <$> pKeyOutputFormat + <*> pVerificationKeyFileOut + <*> pSigningKeyFileOut pKeyGenVRF :: Parser LegacyNodeCmds pKeyGenVRF = - NodeKeyGenVRF - <$> pKeyOutputFormat - <*> pVerificationKeyFileOut - <*> pSigningKeyFileOut + fmap Cmd.LegacyNodeKeyGenVRFCmd $ + Cmd.NodeKeyGenVRFCmdArgs + <$> pKeyOutputFormat + <*> pVerificationKeyFileOut + <*> pSigningKeyFileOut pKeyHashVRF :: Parser LegacyNodeCmds pKeyHashVRF = - NodeKeyHashVRF - <$> pVerificationKeyOrFileIn AsVrfKey - <*> pMaybeOutputFile + fmap Cmd.LegacyNodeKeyHashVRFCmd $ + Cmd.NodeKeyHashVRFCmdArgs + <$> pVerificationKeyOrFileIn AsVrfKey + <*> pMaybeOutputFile pNewCounter :: Parser LegacyNodeCmds pNewCounter = - NodeNewCounter - <$> pColdVerificationKeyOrFile Nothing - <*> pCounterValue - <*> pOperatorCertIssueCounterFile + fmap Cmd.LegacyNodeNewCounterCmd $ + Cmd.NodeNewCounterCmdArgs + <$> pColdVerificationKeyOrFile Nothing + <*> pCounterValue + <*> pOperatorCertIssueCounterFile pCounterValue :: Parser Word pCounterValue = @@ -514,12 +521,13 @@ pNodeCmds = pIssueOpCert :: Parser LegacyNodeCmds pIssueOpCert = - NodeIssueOpCert - <$> pKesVerificationKeyOrFile - <*> pColdSigningKeyFile - <*> pOperatorCertIssueCounterFile - <*> pKesPeriod - <*> pOutputFile + fmap Cmd.LegacyNodeIssueOpCertCmd $ + Cmd.NodeIssueOpCertCmdArgs + <$> pKesVerificationKeyOrFile + <*> pColdSigningKeyFile + <*> pOperatorCertIssueCounterFile + <*> pKesPeriod + <*> pOutputFile pStakePoolCmds :: EnvCli -> Parser LegacyStakePoolCmds pStakePoolCmds envCli = diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Node.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Node.hs index e23455bd2d..f2ea190791 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/Node.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/Node.hs @@ -5,14 +5,10 @@ module Cardano.CLI.Legacy.Run.Node ( runLegacyNodeCmds ) where -import Cardano.Api -import Cardano.Api.Shelley - +import qualified Cardano.CLI.EraBased.Commands.Node as Cmd import Cardano.CLI.EraBased.Run.Node import Cardano.CLI.Legacy.Commands.Node -import Cardano.CLI.Types.Common import Cardano.CLI.Types.Errors.NodeCmdError -import Cardano.CLI.Types.Key import Control.Monad.Trans.Except (ExceptT) @@ -22,64 +18,39 @@ runLegacyNodeCmds :: () => LegacyNodeCmds -> ExceptT NodeCmdError IO () runLegacyNodeCmds = \case - NodeKeyGenCold fmt vk sk ctr -> - runLegacyNodeKeyGenColdCmd fmt vk sk ctr - NodeKeyGenKES fmt vk sk -> - runLegacyNodeKeyGenKesCmd fmt vk sk - NodeKeyGenVRF fmt vk sk -> - runLegacyNodeKeyGenVrfCmd fmt vk sk - NodeKeyHashVRF vk mOutFp -> - runLegacyNodeKeyHashVrfCmd vk mOutFp - NodeNewCounter vk ctr out -> - runLegacyNodeNewCounterCmd vk ctr out - NodeIssueOpCert vk sk ctr p out -> - runLegacyNodeIssueOpCertCmd vk sk ctr p out + LegacyNodeKeyGenColdCmd args -> runLegacyNodeKeyGenColdCmd args + LegacyNodeKeyGenKESCmd args -> runLegacyNodeKeyGenKesCmd args + LegacyNodeKeyGenVRFCmd args -> runLegacyNodeKeyGenVrfCmd args + LegacyNodeKeyHashVRFCmd args -> runLegacyNodeKeyHashVrfCmd args + LegacyNodeNewCounterCmd args -> runLegacyNodeNewCounterCmd args + LegacyNodeIssueOpCertCmd args -> runLegacyNodeIssueOpCertCmd args runLegacyNodeKeyGenColdCmd :: () - => KeyOutputFormat - -> VerificationKeyFile Out - -> SigningKeyFile Out - -> OpCertCounterFile Out + => Cmd.NodeKeyGenColdCmdArgs -> ExceptT NodeCmdError IO () runLegacyNodeKeyGenColdCmd = runNodeKeyGenColdCmd runLegacyNodeKeyGenKesCmd :: () - => KeyOutputFormat - -> VerificationKeyFile Out - -> SigningKeyFile Out + => Cmd.NodeKeyGenKESCmdArgs -> ExceptT NodeCmdError IO () runLegacyNodeKeyGenKesCmd = runNodeKeyGenKesCmd runLegacyNodeKeyGenVrfCmd :: () - => KeyOutputFormat - -> VerificationKeyFile Out - -> SigningKeyFile Out + => Cmd.NodeKeyGenVRFCmdArgs -> ExceptT NodeCmdError IO () runLegacyNodeKeyGenVrfCmd = runNodeKeyGenVrfCmd runLegacyNodeKeyHashVrfCmd :: () - => VerificationKeyOrFile VrfKey - -> Maybe (File () Out) + => Cmd.NodeKeyHashVRFCmdArgs -> ExceptT NodeCmdError IO () runLegacyNodeKeyHashVrfCmd = runNodeKeyHashVrfCmd runLegacyNodeNewCounterCmd :: () - => ColdVerificationKeyOrFile - -> Word - -> OpCertCounterFile InOut + => Cmd.NodeNewCounterCmdArgs -> ExceptT NodeCmdError IO () runLegacyNodeNewCounterCmd = runNodeNewCounterCmd runLegacyNodeIssueOpCertCmd :: () - => VerificationKeyOrFile KesKey - -- ^ This is the hot KES verification key. - -> SigningKeyFile In - -- ^ This is the cold signing key. - -> OpCertCounterFile InOut - -- ^ Counter that establishes the precedence - -- of the operational certificate. - -> KESPeriod - -- ^ Start of the validity period for this certificate. - -> File () Out + => Cmd.NodeIssueOpCertCmdArgs -> ExceptT NodeCmdError IO () runLegacyNodeIssueOpCertCmd = runNodeIssueOpCertCmd