diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index f58cb639eb..1383ec545d 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -133,6 +133,7 @@ library Cardano.CLI.Legacy.Commands.TextView Cardano.CLI.Legacy.Commands.Transaction Cardano.CLI.Legacy.Options + Cardano.CLI.Legacy.Options.Key Cardano.CLI.Legacy.Run Cardano.CLI.Legacy.Run.Address Cardano.CLI.Legacy.Run.Genesis diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Key.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Key.hs index 70af7f20bc..b2ef3705de 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Key.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Key.hs @@ -1,8 +1,17 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE LambdaCase #-} module Cardano.CLI.EraBased.Commands.Key ( KeyCmds (..) + , KeyVerificationKeyCmdArgs(..) + , KeyNonExtendedKeyCmdArgs(..) + , KeyConvertByronKeyCmdArgs(..) + , KeyConvertByronGenesisVKeyCmdArgs(..) + , KeyConvertITNKeyCmdArgs(..) + , KeyConvertITNExtendedKeyCmdArgs(..) + , KeyConvertITNBip32KeyCmdArgs(..) + , KeyConvertCardanoAddressKeyCmdArgs(..) , renderKeyCmds ) where @@ -13,50 +22,89 @@ import Cardano.CLI.Types.Common import Data.Text (Text) data KeyCmds era - = KeyGetVerificationKey - (SigningKeyFile In) - (VerificationKeyFile Out) - | KeyNonExtendedKey - (VerificationKeyFile In) - (VerificationKeyFile Out) - | KeyConvertByronKey - (Maybe Text) - ByronKeyType - (SomeKeyFile In) - (File () Out) - | KeyConvertByronGenesisVKey - VerificationKeyBase64 - (File () Out) - | KeyConvertITNStakeKey - (SomeKeyFile In) - (File () Out) - | KeyConvertITNExtendedToStakeKey - (SomeKeyFile In) - (File () Out) - | KeyConvertITNBip32ToStakeKey - (SomeKeyFile In) - (File () Out) - | KeyConvertCardanoAddressSigningKey - CardanoAddressKeyType - (SigningKeyFile In) - (File () Out) + = KeyVerificationKeyCmd !KeyVerificationKeyCmdArgs + | KeyNonExtendedKeyCmd !KeyNonExtendedKeyCmdArgs + | KeyConvertByronKeyCmd !KeyConvertByronKeyCmdArgs + | KeyConvertByronGenesisVKeyCmd !KeyConvertByronGenesisVKeyCmdArgs + | KeyConvertITNKeyCmd !KeyConvertITNKeyCmdArgs + | KeyConvertITNExtendedKeyCmd !KeyConvertITNExtendedKeyCmdArgs + | KeyConvertITNBip32KeyCmd !KeyConvertITNBip32KeyCmdArgs + | KeyConvertCardanoAddressKeyCmd !KeyConvertCardanoAddressKeyCmdArgs deriving Show +-- | Get a verification key from a signing key. This supports all key types +data KeyVerificationKeyCmdArgs = KeyVerificationKeyCmdArgs + { skeyFile :: !(SigningKeyFile In) -- ^ Input filepath of the signing key + , vkeyFile :: !(VerificationKeyFile Out) -- ^ Output filepath of the verification key + } deriving Show + +-- | Get a non-extended verification key from an extended verification key. This +-- supports all extended key types. +data KeyNonExtendedKeyCmdArgs = KeyNonExtendedKeyCmdArgs + { extendedVkeyFileIn :: !(VerificationKeyFile In) -- ^ Input filepath of the ed25519-bip32 verification key + , nonExtendedVkeyFileOut :: !(VerificationKeyFile Out) -- ^ Output filepath of the verification key + } deriving Show + +-- | Convert a Byron payment, genesis or genesis delegate key (signing or +-- verification) to a corresponding Shelley-format key. +data KeyConvertByronKeyCmdArgs = KeyConvertByronKeyCmdArgs + { mPassword :: !(Maybe Text) -- ^ Password for signing key (if applicable) + , byronKeyType :: !ByronKeyType -- ^ The byron key type of the input file + , someKeyFileIn :: !(SomeKeyFile In) -- ^ Input file containing the byron key + , someKeyFileOut :: !(File () Out) -- ^ The output file to which the Shelley-format key will be written + } deriving Show + +-- Convert a Base64-encoded Byron genesis verification key to a Shelley genesis +-- verification key +data KeyConvertByronGenesisVKeyCmdArgs = KeyConvertByronGenesisVKeyCmdArgs + { vkey :: !VerificationKeyBase64 -- ^ Base64 string for the Byron genesis verification key + , vkeyFileOut :: !(File () Out) -- ^ The output file + } deriving Show + +-- | Convert an Incentivized Testnet (ITN) non-extended (Ed25519) signing or +-- verification key to a corresponding Shelley stake key +data KeyConvertITNKeyCmdArgs = KeyConvertITNKeyCmdArgs + { itnKeyFile :: !(SomeKeyFile In) -- ^ Filepath of the ITN key (signing or verification) + , outFile :: !(File () Out) -- ^ The output file + } deriving Show + +-- | Convert an Incentivized Testnet (ITN) extended (Ed25519Extended) signing key +-- to a corresponding Shelley stake signing key +data KeyConvertITNExtendedKeyCmdArgs = KeyConvertITNExtendedKeyCmdArgs + { itnPrivKeyFile :: !(SomeKeyFile In) -- ^ Filepath of the ITN signing key + , outFile :: !(File () Out) -- ^ The output file + } deriving Show + +-- | Convert an Incentivized Testnet (ITN) BIP32 (Ed25519Bip32) signing key to a +-- corresponding Shelley stake signing key +data KeyConvertITNBip32KeyCmdArgs = KeyConvertITNBip32KeyCmdArgs + { itnPrivKeyFile :: !(SomeKeyFile In) -- ^ Filepath of the ITN signing key + , outFile :: !(File () Out) -- ^ The output file + } deriving Show + +-- | Convert a cardano-address extended signing key to a corresponding +-- Shelley-format key +data KeyConvertCardanoAddressKeyCmdArgs = KeyConvertCardanoAddressKeyCmdArgs + { cardanoAddressKeyType :: !CardanoAddressKeyType -- ^ Address key type of th signing key input file + , skeyFileIn :: !(SigningKeyFile In) -- ^ Input filepath of the signing key + , skeyFileOut :: !(File () Out) -- ^ The output file + } deriving Show + renderKeyCmds :: KeyCmds era -> Text renderKeyCmds = \case - KeyGetVerificationKey {} -> + KeyVerificationKeyCmd {} -> "key verification-key" - KeyNonExtendedKey {} -> + KeyNonExtendedKeyCmd {} -> "key non-extended-key" - KeyConvertByronKey {} -> + KeyConvertByronKeyCmd {} -> "key convert-byron-key" - KeyConvertByronGenesisVKey {} -> - "key convert-byron-genesis-key" - KeyConvertITNStakeKey {} -> + KeyConvertByronGenesisVKeyCmd {} -> + "key convert-byron-genesis-vkey" + KeyConvertITNKeyCmd {} -> "key convert-itn-key" - KeyConvertITNExtendedToStakeKey {} -> + KeyConvertITNExtendedKeyCmd {} -> "key convert-itn-extended-key" - KeyConvertITNBip32ToStakeKey {} -> + KeyConvertITNBip32KeyCmd {} -> "key convert-itn-bip32-key" - KeyConvertCardanoAddressSigningKey {} -> - "key convert-cardano-address-signing-key" + KeyConvertCardanoAddressKeyCmd {} -> + "key convert-cardano-address-key" diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Key.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Key.hs index 306e46d23b..96659a89a7 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Key.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Key.hs @@ -31,7 +31,7 @@ pKeyCmds = ) [ Just $ subParser "verification-key" - $ Opt.info pKeyGetVerificationKey + $ Opt.info pKeyVerificationKeyCmd $ Opt.progDesc $ mconcat [ "Get a verification key from a signing key. This " @@ -39,7 +39,7 @@ pKeyCmds = ] , Just $ subParser "non-extended-key" - $ Opt.info pKeyNonExtendedKey + $ Opt.info pKeyNonExtendedKeyCmd $ Opt.progDesc $ mconcat [ "Get a non-extended verification key from an " @@ -48,7 +48,7 @@ pKeyCmds = ] , Just $ subParser "convert-byron-key" - $ Opt.info pKeyConvertByronKey + $ Opt.info pKeyConvertByronKeyCmd $ Opt.progDesc $ mconcat [ "Convert a Byron payment, genesis or genesis " @@ -57,7 +57,7 @@ pKeyCmds = ] , Just $ subParser "convert-byron-genesis-vkey" - $ Opt.info pKeyConvertByronGenesisVKey + $ Opt.info pKeyConvertByronGenesisKeyCmd $ Opt.progDesc $ mconcat [ "Convert a Base64-encoded Byron genesis " @@ -66,7 +66,7 @@ pKeyCmds = ] , Just $ subParser "convert-itn-key" - $ Opt.info pKeyConvertITNKey + $ Opt.info pKeyConvertITNKeyCmd $ Opt.progDesc $ mconcat [ "Convert an Incentivized Testnet (ITN) non-extended " @@ -75,7 +75,7 @@ pKeyCmds = ] , Just $ subParser "convert-itn-extended-key" - $ Opt.info pKeyConvertITNExtendedKey + $ Opt.info pKeyConvertITNExtendedKeyCmd $ Opt.progDesc $ mconcat [ "Convert an Incentivized Testnet (ITN) extended " @@ -84,7 +84,7 @@ pKeyCmds = ] , Just $ subParser "convert-itn-bip32-key" - $ Opt.info pKeyConvertITNBip32Key + $ Opt.info pKeyConvertITNBip32KeyCmd $ Opt.progDesc $ mconcat [ "Convert an Incentivized Testnet (ITN) BIP32 " @@ -93,7 +93,7 @@ pKeyCmds = ] , Just $ subParser "convert-cardano-address-key" - $ Opt.info pKeyConvertCardanoAddressSigningKey + $ Opt.info pKeyConvertCardanoAddressKeyCmd $ Opt.progDesc $ mconcat [ "Convert a cardano-address extended signing key " @@ -101,25 +101,28 @@ pKeyCmds = ] ] -pKeyGetVerificationKey :: Parser (KeyCmds era) -pKeyGetVerificationKey = - KeyGetVerificationKey - <$> pSigningKeyFileIn - <*> pVerificationKeyFileOut +pKeyVerificationKeyCmd :: Parser (KeyCmds era) +pKeyVerificationKeyCmd = + fmap KeyVerificationKeyCmd $ + KeyVerificationKeyCmdArgs + <$> pSigningKeyFileIn + <*> pVerificationKeyFileOut -pKeyNonExtendedKey :: Parser (KeyCmds era) -pKeyNonExtendedKey = - KeyNonExtendedKey - <$> pExtendedVerificationKeyFileIn - <*> pVerificationKeyFileOut +pKeyNonExtendedKeyCmd :: Parser (KeyCmds era) +pKeyNonExtendedKeyCmd = + fmap KeyNonExtendedKeyCmd $ + KeyNonExtendedKeyCmdArgs + <$> pExtendedVerificationKeyFileIn + <*> pVerificationKeyFileOut -pKeyConvertByronKey :: Parser (KeyCmds era) -pKeyConvertByronKey = - KeyConvertByronKey - <$> optional pPassword - <*> pByronKeyType - <*> pByronKeyFile - <*> pOutputFile +pKeyConvertByronKeyCmd :: Parser (KeyCmds era) +pKeyConvertByronKeyCmd = + fmap KeyConvertByronKeyCmd $ + KeyConvertByronKeyCmdArgs + <$> optional pPassword + <*> pByronKeyType + <*> pByronKeyFile + <*> pOutputFile pPassword :: Parser Text pPassword = @@ -183,11 +186,12 @@ pByronVerificationKeyFile = , Opt.completer (Opt.bashCompleter "file") ] -pKeyConvertByronGenesisVKey :: Parser (KeyCmds era) -pKeyConvertByronGenesisVKey = - KeyConvertByronGenesisVKey - <$> pByronGenesisVKeyBase64 - <*> pOutputFile +pKeyConvertByronGenesisKeyCmd :: Parser (KeyCmds era) +pKeyConvertByronGenesisKeyCmd = + fmap KeyConvertByronGenesisVKeyCmd $ + KeyConvertByronGenesisVKeyCmdArgs + <$> pByronGenesisVKeyBase64 + <*> pOutputFile pByronGenesisVKeyBase64 :: Parser VerificationKeyBase64 pByronGenesisVKeyBase64 = @@ -197,23 +201,26 @@ pByronGenesisVKeyBase64 = , Opt.help "Base64 string for the Byron genesis verification key." ] -pKeyConvertITNKey :: Parser (KeyCmds era) -pKeyConvertITNKey = - KeyConvertITNStakeKey - <$> pITNKeyFIle - <*> pOutputFile +pKeyConvertITNKeyCmd :: Parser (KeyCmds era) +pKeyConvertITNKeyCmd = + fmap KeyConvertITNKeyCmd $ + KeyConvertITNKeyCmdArgs + <$> pITNKeyFIle + <*> pOutputFile -pKeyConvertITNExtendedKey :: Parser (KeyCmds era) -pKeyConvertITNExtendedKey = - KeyConvertITNExtendedToStakeKey - <$> pITNSigningKeyFile - <*> pOutputFile +pKeyConvertITNExtendedKeyCmd :: Parser (KeyCmds era) +pKeyConvertITNExtendedKeyCmd = + fmap KeyConvertITNExtendedKeyCmd $ + KeyConvertITNExtendedKeyCmdArgs + <$> pITNSigningKeyFile + <*> pOutputFile -pKeyConvertITNBip32Key :: Parser (KeyCmds era) -pKeyConvertITNBip32Key = - KeyConvertITNBip32ToStakeKey - <$> pITNSigningKeyFile - <*> pOutputFile +pKeyConvertITNBip32KeyCmd :: Parser (KeyCmds era) +pKeyConvertITNBip32KeyCmd = + fmap KeyConvertITNBip32KeyCmd $ + KeyConvertITNBip32KeyCmdArgs + <$> pITNSigningKeyFile + <*> pOutputFile pITNKeyFIle :: Parser (SomeKeyFile direction) pITNKeyFIle = @@ -240,12 +247,13 @@ pITNVerificationKeyFile = , Opt.completer (Opt.bashCompleter "file") ] -pKeyConvertCardanoAddressSigningKey :: Parser (KeyCmds era) -pKeyConvertCardanoAddressSigningKey = - KeyConvertCardanoAddressSigningKey - <$> pCardanoAddressKeyType - <*> pSigningKeyFileIn - <*> pOutputFile +pKeyConvertCardanoAddressKeyCmd :: Parser (KeyCmds era) +pKeyConvertCardanoAddressKeyCmd = + fmap KeyConvertCardanoAddressKeyCmd $ + KeyConvertCardanoAddressKeyCmdArgs + <$> pCardanoAddressKeyType + <*> pSigningKeyFileIn + <*> pOutputFile pCardanoAddressKeyType :: Parser CardanoAddressKeyType pCardanoAddressKeyType = diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Key.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Key.hs index 470cb7dc30..3ef15246a3 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Key.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Key.hs @@ -1,20 +1,22 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} module Cardano.CLI.EraBased.Run.Key ( runKeyCmds - , runConvertByronGenesisVerificationKeyCmd + , runConvertByronGenesisVKeyCmd , runConvertByronKeyCmd - , runConvertCardanoAddressSigningKeyCmd - , runConvertITNBip32ToStakeKeyCmd - , runConvertITNExtendedToStakeKeyCmd - , runConvertITNStakeKeyCmd - , runConvertToNonExtendedKeyCmd - , runGetVerificationKeyCmd + , runConvertCardanoAddressKeyCmd + , runConvertITNBip32KeyCmd + , runConvertITNExtendedKeyCmd + , runConvertITNKeyCmd + , runNonExtendedKeyCmd + , runVerificationKeyCmd -- * Exports for testing , decodeBech32 @@ -25,7 +27,7 @@ import qualified Cardano.Api.Byron as ByronApi import Cardano.Api.Crypto.Ed25519Bip32 (xPrvFromBytes) import qualified Cardano.CLI.Byron.Key as Byron -import Cardano.CLI.EraBased.Commands.Key +import qualified Cardano.CLI.EraBased.Commands.Key as Cmd import Cardano.CLI.Types.Common import Cardano.CLI.Types.Errors.CardanoAddressSigningKeyConversionError import Cardano.CLI.Types.Errors.ItnKeyConversionError @@ -46,49 +48,55 @@ import Control.Monad.Trans.Except.Extra (firstExceptT, hoistEither, le import Data.Bifunctor (Bifunctor (..)) import Data.ByteString (ByteString) import qualified Data.ByteString as BS +import Data.Function import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import System.Exit (exitFailure) runKeyCmds :: () - => KeyCmds era + => Cmd.KeyCmds era -> ExceptT KeyCmdError IO () runKeyCmds = \case - KeyGetVerificationKey skf vkf -> - runGetVerificationKeyCmd skf vkf - KeyNonExtendedKey evkf vkf -> - runConvertToNonExtendedKeyCmd evkf vkf - KeyConvertByronKey mPassword keytype skfOld skfNew -> - runConvertByronKeyCmd mPassword keytype skfOld skfNew - KeyConvertByronGenesisVKey oldVk newVkf -> - runConvertByronGenesisVerificationKeyCmd oldVk newVkf - KeyConvertITNStakeKey itnKeyFile outFile -> - runConvertITNStakeKeyCmd itnKeyFile outFile - KeyConvertITNExtendedToStakeKey itnPrivKeyFile outFile -> - runConvertITNExtendedToStakeKeyCmd itnPrivKeyFile outFile - KeyConvertITNBip32ToStakeKey itnPrivKeyFile outFile -> - runConvertITNBip32ToStakeKeyCmd itnPrivKeyFile outFile - KeyConvertCardanoAddressSigningKey keyType skfOld skfNew -> - runConvertCardanoAddressSigningKeyCmd keyType skfOld skfNew - -runGetVerificationKeyCmd :: () - => SigningKeyFile In - -> VerificationKeyFile Out + Cmd.KeyVerificationKeyCmd cmd -> + runVerificationKeyCmd cmd + Cmd.KeyNonExtendedKeyCmd cmd -> + runNonExtendedKeyCmd cmd + Cmd.KeyConvertByronKeyCmd cmd -> + runConvertByronKeyCmd cmd + Cmd.KeyConvertByronGenesisVKeyCmd cmd -> + runConvertByronGenesisVKeyCmd cmd + Cmd.KeyConvertITNKeyCmd cmd -> + runConvertITNKeyCmd cmd + Cmd.KeyConvertITNExtendedKeyCmd cmd -> + runConvertITNExtendedKeyCmd cmd + Cmd.KeyConvertITNBip32KeyCmd cmd -> + runConvertITNBip32KeyCmd cmd + Cmd.KeyConvertCardanoAddressKeyCmd cmd -> + runConvertCardanoAddressKeyCmd cmd + +runVerificationKeyCmd :: () + => Cmd.KeyVerificationKeyCmdArgs -> ExceptT KeyCmdError IO () -runGetVerificationKeyCmd skf vkf = do - ssk <- firstExceptT KeyCmdReadKeyFileError $ - readSigningKeyFile skf - withSomeSigningKey ssk $ \sk -> - let vk = getVerificationKey sk in - firstExceptT KeyCmdWriteFileError . newExceptT $ - writeLazyByteStringFile vkf $ textEnvelopeToJSON Nothing vk +runVerificationKeyCmd + Cmd.KeyVerificationKeyCmdArgs + { Cmd.skeyFile = skf + , Cmd.vkeyFile = vkf + } = do + ssk <- firstExceptT KeyCmdReadKeyFileError $ readSigningKeyFile skf + withSomeSigningKey ssk $ \sk -> + let vk = getVerificationKey sk in + firstExceptT KeyCmdWriteFileError . newExceptT $ + writeLazyByteStringFile vkf $ textEnvelopeToJSON Nothing vk -runConvertToNonExtendedKeyCmd - :: VerificationKeyFile In - -> VerificationKeyFile Out +runNonExtendedKeyCmd + :: Cmd.KeyNonExtendedKeyCmdArgs -> ExceptT KeyCmdError IO () -runConvertToNonExtendedKeyCmd evkf vkf = +runNonExtendedKeyCmd + Cmd.KeyNonExtendedKeyCmdArgs + { Cmd.extendedVkeyFileIn = evkf + , Cmd.nonExtendedVkeyFileOut = vkf + } = writeVerificationKey =<< readExtendedVerificationKeyFile evkf where -- TODO: Expose a function specifically for this purpose @@ -139,63 +147,61 @@ readExtendedVerificationKeyFile evkfile = do runConvertByronKeyCmd - :: Maybe Text -- ^ Password (if applicable) - -> ByronKeyType - -> SomeKeyFile In -- ^ Input file: old format - -> File () Out -- ^ Output file: new format + :: Cmd.KeyConvertByronKeyCmdArgs -> ExceptT KeyCmdError IO () -runConvertByronKeyCmd mPwd (ByronPaymentKey format) (ASigningKeyFile skeyPathOld) = - convertByronSigningKey mPwd format convert skeyPathOld - where - convert :: Byron.SigningKey -> SigningKey ByronKey - convert = ByronSigningKey - -runConvertByronKeyCmd mPwd (ByronGenesisKey format) (ASigningKeyFile skeyPathOld) = - convertByronSigningKey mPwd format convert skeyPathOld - where - convert :: Byron.SigningKey -> SigningKey GenesisExtendedKey - convert (Byron.SigningKey xsk) = GenesisExtendedSigningKey xsk - -runConvertByronKeyCmd mPwd (ByronDelegateKey format) (ASigningKeyFile skeyPathOld) = - convertByronSigningKey mPwd format convert skeyPathOld - where - convert :: Byron.SigningKey -> SigningKey GenesisDelegateExtendedKey - convert (Byron.SigningKey xsk) = GenesisDelegateExtendedSigningKey xsk - -runConvertByronKeyCmd _ (ByronPaymentKey NonLegacyByronKeyFormat) - (AVerificationKeyFile vkeyPathOld) = - convertByronVerificationKey convert vkeyPathOld - where - convert :: Byron.VerificationKey -> VerificationKey ByronKey - convert = ByronVerificationKey - -runConvertByronKeyCmd _ (ByronGenesisKey NonLegacyByronKeyFormat) - (AVerificationKeyFile vkeyPathOld) = - convertByronVerificationKey convert vkeyPathOld - where - convert :: Byron.VerificationKey -> VerificationKey GenesisExtendedKey - convert (Byron.VerificationKey xvk) = GenesisExtendedVerificationKey xvk - -runConvertByronKeyCmd _ (ByronDelegateKey NonLegacyByronKeyFormat) - (AVerificationKeyFile vkeyPathOld) = - convertByronVerificationKey convert vkeyPathOld - where - convert :: Byron.VerificationKey - -> VerificationKey GenesisDelegateExtendedKey - convert (Byron.VerificationKey xvk) = - GenesisDelegateExtendedVerificationKey xvk - -runConvertByronKeyCmd _ (ByronPaymentKey LegacyByronKeyFormat) - AVerificationKeyFile{} = - const legacyVerificationKeysNotSupported - -runConvertByronKeyCmd _ (ByronGenesisKey LegacyByronKeyFormat) - AVerificationKeyFile{} = - const legacyVerificationKeysNotSupported - -runConvertByronKeyCmd _ (ByronDelegateKey LegacyByronKeyFormat) - AVerificationKeyFile{} = - const legacyVerificationKeysNotSupported +runConvertByronKeyCmd + Cmd.KeyConvertByronKeyCmdArgs + { Cmd.mPassword = mPwd + , Cmd.byronKeyType + , Cmd.someKeyFileIn = inFile + , Cmd.someKeyFileOut = outFile + } = + case (byronKeyType, inFile) of + (ByronPaymentKey format, ASigningKeyFile skeyPathOld) -> + convertByronSigningKey mPwd format convert skeyPathOld outFile + where + convert :: Byron.SigningKey -> SigningKey ByronKey + convert = ByronSigningKey + + (ByronGenesisKey format, ASigningKeyFile skeyPathOld) -> + convertByronSigningKey mPwd format convert skeyPathOld outFile + where + convert :: Byron.SigningKey -> SigningKey GenesisExtendedKey + convert (Byron.SigningKey xsk) = GenesisExtendedSigningKey xsk + + (ByronDelegateKey format, ASigningKeyFile skeyPathOld) -> + convertByronSigningKey mPwd format convert skeyPathOld outFile + where + convert :: Byron.SigningKey -> SigningKey GenesisDelegateExtendedKey + convert (Byron.SigningKey xsk) = GenesisDelegateExtendedSigningKey xsk + + (ByronPaymentKey NonLegacyByronKeyFormat, AVerificationKeyFile vkeyPathOld) -> + convertByronVerificationKey convert vkeyPathOld outFile + where + convert :: Byron.VerificationKey -> VerificationKey ByronKey + convert = ByronVerificationKey + + (ByronGenesisKey NonLegacyByronKeyFormat, AVerificationKeyFile vkeyPathOld) -> + convertByronVerificationKey convert vkeyPathOld outFile + where + convert :: Byron.VerificationKey -> VerificationKey GenesisExtendedKey + convert (Byron.VerificationKey xvk) = GenesisExtendedVerificationKey xvk + + (ByronDelegateKey NonLegacyByronKeyFormat, AVerificationKeyFile vkeyPathOld) -> + convertByronVerificationKey convert vkeyPathOld outFile + where + convert :: Byron.VerificationKey -> VerificationKey GenesisDelegateExtendedKey + convert (Byron.VerificationKey xvk) = + GenesisDelegateExtendedVerificationKey xvk + + (ByronPaymentKey LegacyByronKeyFormat, AVerificationKeyFile{}) -> + legacyVerificationKeysNotSupported + + (ByronGenesisKey LegacyByronKeyFormat, AVerificationKeyFile{}) -> + legacyVerificationKeysNotSupported + + (ByronDelegateKey LegacyByronKeyFormat, AVerificationKeyFile{}) -> + legacyVerificationKeysNotSupported legacyVerificationKeysNotSupported :: ExceptT e IO a legacyVerificationKeysNotSupported = @@ -205,7 +211,6 @@ legacyVerificationKeysNotSupported = ++ "verification key." exitFailure - convertByronSigningKey :: forall keyrole. Key keyrole @@ -255,23 +260,25 @@ convertByronVerificationKey convert vkeyPathOld vkeyPathNew = do writeLazyByteStringFile vkeyPathNew $ textEnvelopeToJSON Nothing vk' -runConvertByronGenesisVerificationKeyCmd - :: VerificationKeyBase64 -- ^ Input key raw old format - -> File () Out -- ^ Output file: new format +runConvertByronGenesisVKeyCmd + :: Cmd.KeyConvertByronGenesisVKeyCmdArgs -> ExceptT KeyCmdError IO () -runConvertByronGenesisVerificationKeyCmd (VerificationKeyBase64 b64ByronVKey) vkeyPathNew = do +runConvertByronGenesisVKeyCmd + Cmd.KeyConvertByronGenesisVKeyCmdArgs + { Cmd.vkey = VerificationKeyBase64 b64ByronVKey + , Cmd.vkeyFileOut = vkeyPathNew + } = do + vk <- firstExceptT (KeyCmdByronKeyParseError . textShow) + . hoistEither + . Byron.Crypto.parseFullVerificationKey + . Text.pack + $ b64ByronVKey + + let vk' :: VerificationKey GenesisKey + vk' = convert vk - vk <- firstExceptT (KeyCmdByronKeyParseError . textShow) - . hoistEither - . Byron.Crypto.parseFullVerificationKey - . Text.pack - $ b64ByronVKey - - let vk' :: VerificationKey GenesisKey - vk' = convert vk - - firstExceptT KeyCmdWriteFileError . newExceptT $ - writeLazyByteStringFile vkeyPathNew $ textEnvelopeToJSON Nothing vk' + firstExceptT KeyCmdWriteFileError . newExceptT $ + writeLazyByteStringFile vkeyPathNew $ textEnvelopeToJSON Nothing vk' where convert :: Byron.VerificationKey -> VerificationKey GenesisKey convert (Byron.VerificationKey xvk) = @@ -282,48 +289,75 @@ runConvertByronGenesisVerificationKeyCmd (VerificationKeyBase64 b64ByronVKey) vk -- ITN verification/signing key conversion to Haskell verficiation/signing keys -------------------------------------------------------------------------------- -runConvertITNStakeKeyCmd - :: SomeKeyFile In - -> File () Out +runConvertITNKeyCmd + :: Cmd.KeyConvertITNKeyCmdArgs -> ExceptT KeyCmdError IO () -runConvertITNStakeKeyCmd (AVerificationKeyFile (File vk)) outFile = do - bech32publicKey <- firstExceptT KeyCmdItnKeyConvError . newExceptT $ - readFileITNKey vk - vkey <- hoistEither - . first KeyCmdItnKeyConvError - $ convertITNVerificationKey bech32publicKey - firstExceptT KeyCmdWriteFileError . newExceptT $ - writeLazyByteStringFile outFile $ textEnvelopeToJSON Nothing vkey - -runConvertITNStakeKeyCmd (ASigningKeyFile (File sk)) outFile = do - bech32privateKey <- firstExceptT KeyCmdItnKeyConvError . newExceptT $ - readFileITNKey sk - skey <- hoistEither - . first KeyCmdItnKeyConvError - $ convertITNSigningKey bech32privateKey - firstExceptT KeyCmdWriteFileError . newExceptT - $ writeLazyByteStringFile outFile - $ textEnvelopeToJSON Nothing skey - -runConvertITNExtendedToStakeKeyCmd :: SomeKeyFile In -> File () Out -> ExceptT KeyCmdError IO () -runConvertITNExtendedToStakeKeyCmd (AVerificationKeyFile _) _ = left KeyCmdWrongKeyTypeError -runConvertITNExtendedToStakeKeyCmd (ASigningKeyFile (File sk)) outFile = do - bech32privateKey <- firstExceptT KeyCmdItnKeyConvError . newExceptT $ readFileITNKey sk - skey <- hoistEither . first KeyCmdItnKeyConvError - $ convertITNExtendedSigningKey bech32privateKey - firstExceptT KeyCmdWriteFileError . newExceptT - $ writeLazyByteStringFile outFile - $ textEnvelopeToJSON Nothing skey - -runConvertITNBip32ToStakeKeyCmd :: SomeKeyFile In -> File () Out -> ExceptT KeyCmdError IO () -runConvertITNBip32ToStakeKeyCmd (AVerificationKeyFile _) _ = left KeyCmdWrongKeyTypeError -runConvertITNBip32ToStakeKeyCmd (ASigningKeyFile (File sk)) outFile = do - bech32privateKey <- firstExceptT KeyCmdItnKeyConvError . newExceptT $ readFileITNKey sk - skey <- hoistEither . first KeyCmdItnKeyConvError - $ convertITNBIP32SigningKey bech32privateKey - firstExceptT KeyCmdWriteFileError . newExceptT - $ writeLazyByteStringFile outFile - $ textEnvelopeToJSON Nothing skey +runConvertITNKeyCmd + Cmd.KeyConvertITNKeyCmdArgs + { Cmd.itnKeyFile + , Cmd.outFile + } = + case itnKeyFile of + AVerificationKeyFile (File vk) -> do + bech32publicKey <- firstExceptT KeyCmdItnKeyConvError . newExceptT $ + readFileITNKey vk + vkey <- hoistEither + . first KeyCmdItnKeyConvError + $ convertITNVerificationKey bech32publicKey + firstExceptT KeyCmdWriteFileError . newExceptT $ + writeLazyByteStringFile outFile $ textEnvelopeToJSON Nothing vkey + + ASigningKeyFile (File sk) -> do + bech32privateKey <- firstExceptT KeyCmdItnKeyConvError . newExceptT $ + readFileITNKey sk + skey <- hoistEither + . first KeyCmdItnKeyConvError + $ convertITNSigningKey bech32privateKey + firstExceptT KeyCmdWriteFileError . newExceptT + $ writeLazyByteStringFile outFile + $ textEnvelopeToJSON Nothing skey + +runConvertITNExtendedKeyCmd :: () + => Cmd.KeyConvertITNExtendedKeyCmdArgs + -> ExceptT KeyCmdError IO () +runConvertITNExtendedKeyCmd + Cmd.KeyConvertITNExtendedKeyCmdArgs + { Cmd.itnPrivKeyFile + , Cmd.outFile + } = + case itnPrivKeyFile of + AVerificationKeyFile _ -> + left KeyCmdWrongKeyTypeError + ASigningKeyFile (File sk) -> do + bech32privateKey <- firstExceptT KeyCmdItnKeyConvError . newExceptT $ readFileITNKey sk + skey <- + convertITNExtendedSigningKey bech32privateKey + & first KeyCmdItnKeyConvError + & hoistEither + firstExceptT KeyCmdWriteFileError . newExceptT + $ writeLazyByteStringFile outFile + $ textEnvelopeToJSON Nothing skey + +runConvertITNBip32KeyCmd :: () + => Cmd.KeyConvertITNBip32KeyCmdArgs + -> ExceptT KeyCmdError IO () +runConvertITNBip32KeyCmd + Cmd.KeyConvertITNBip32KeyCmdArgs + { Cmd.itnPrivKeyFile + , Cmd.outFile + } = + case itnPrivKeyFile of + AVerificationKeyFile _ -> + left KeyCmdWrongKeyTypeError + ASigningKeyFile (File sk) -> do + bech32privateKey <- firstExceptT KeyCmdItnKeyConvError . newExceptT $ readFileITNKey sk + skey <- + convertITNBIP32SigningKey bech32privateKey + & first KeyCmdItnKeyConvError + & hoistEither + firstExceptT KeyCmdWriteFileError . newExceptT + $ writeLazyByteStringFile outFile + $ textEnvelopeToJSON Nothing skey -- | Convert public ed25519 key to a Shelley stake verification key convertITNVerificationKey :: Text -> Either ItnKeyConversionError (VerificationKey StakeKey) @@ -372,12 +406,15 @@ readFileITNKey fp = do -- `cardano-address` extended signing key conversions -------------------------------------------------------------------------------- -runConvertCardanoAddressSigningKeyCmd - :: CardanoAddressKeyType - -> SigningKeyFile In - -> File () Out +runConvertCardanoAddressKeyCmd :: () + => Cmd.KeyConvertCardanoAddressKeyCmdArgs -> ExceptT KeyCmdError IO () -runConvertCardanoAddressSigningKeyCmd keyType skFile outFile = do +runConvertCardanoAddressKeyCmd + Cmd.KeyConvertCardanoAddressKeyCmdArgs + { cardanoAddressKeyType = keyType + , skeyFileIn = skFile + , skeyFileOut = outFile + } = do sKey <- firstExceptT KeyCmdCardanoAddressSigningKeyFileError . newExceptT $ readSomeCardanoAddressSigningKeyFile keyType skFile diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Commands/Key.hs b/cardano-cli/src/Cardano/CLI/Legacy/Commands/Key.hs index 56733932db..bb26e5d067 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Commands/Key.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Commands/Key.hs @@ -13,23 +13,41 @@ import Cardano.CLI.Types.Common import Data.Text (Text) data LegacyKeyCmds - = KeyGetVerificationKey (SigningKeyFile In) (VerificationKeyFile Out) - | KeyNonExtendedKey (VerificationKeyFile In) (VerificationKeyFile Out) - | KeyConvertByronKey (Maybe Text) ByronKeyType (SomeKeyFile In) (File () Out) - | KeyConvertByronGenesisVKey VerificationKeyBase64 (File () Out) - | KeyConvertITNStakeKey (SomeKeyFile In) (File () Out) - | KeyConvertITNExtendedToStakeKey (SomeKeyFile In) (File () Out) - | KeyConvertITNBip32ToStakeKey (SomeKeyFile In) (File () Out) - | KeyConvertCardanoAddressSigningKey CardanoAddressKeyType (SigningKeyFile In) (File () Out) + = KeyVerificationKeyCmd + (SigningKeyFile In) + (VerificationKeyFile Out) + | KeyNonExtendedKeyCmd + (VerificationKeyFile In) + (VerificationKeyFile Out) + | KeyConvertByronKeyCmd + (Maybe Text) + ByronKeyType + (SomeKeyFile In) + (File () Out) + | KeyConvertByronGenesisVKeyCmd + VerificationKeyBase64 + (File () Out) + | KeyConvertITNKeyCmd + (SomeKeyFile In) + (File () Out) + | KeyConvertITNExtendedKeyCmd + (SomeKeyFile In) (File () Out) + | KeyConvertITNBip32KeyCmd + (SomeKeyFile In) + (File () Out) + | KeyConvertCardanoAddressKeyCmd + CardanoAddressKeyType + (SigningKeyFile In) + (File () Out) deriving Show renderLegacyKeyCmds :: LegacyKeyCmds -> Text renderLegacyKeyCmds = \case - KeyGetVerificationKey {} -> "key verification-key" - KeyNonExtendedKey {} -> "key non-extended-key" - KeyConvertByronKey {} -> "key convert-byron-key" - KeyConvertByronGenesisVKey {} -> "key convert-byron-genesis-key" - KeyConvertITNStakeKey {} -> "key convert-itn-key" - KeyConvertITNExtendedToStakeKey {} -> "key convert-itn-extended-key" - KeyConvertITNBip32ToStakeKey {} -> "key convert-itn-bip32-key" - KeyConvertCardanoAddressSigningKey {} -> "key convert-cardano-address-signing-key" + KeyVerificationKeyCmd {} -> "key verification-key" + KeyNonExtendedKeyCmd {} -> "key non-extended-key" + KeyConvertByronKeyCmd {} -> "key convert-byron-key" + KeyConvertByronGenesisVKeyCmd {} -> "key convert-byron-genesis-vkey" + KeyConvertITNKeyCmd {} -> "key convert-itn-key" + KeyConvertITNExtendedKeyCmd {} -> "key convert-itn-extended-key" + KeyConvertITNBip32KeyCmd {} -> "key convert-itn-bip32-key" + KeyConvertCardanoAddressKeyCmd {} -> "key convert-cardano-address-key" diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Options.hs b/cardano-cli/src/Cardano/CLI/Legacy/Options.hs index 368ea62df8..407d3f0580 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Options.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Options.hs @@ -30,20 +30,19 @@ 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.Key import Cardano.CLI.Legacy.Commands.Node import Cardano.CLI.Legacy.Commands.Query import Cardano.CLI.Legacy.Commands.StakeAddress import Cardano.CLI.Legacy.Commands.StakePool import Cardano.CLI.Legacy.Commands.TextView import Cardano.CLI.Legacy.Commands.Transaction +import Cardano.CLI.Legacy.Options.Key import Cardano.CLI.Parser import Cardano.CLI.Types.Common import Data.Foldable import Data.Function import Data.Maybe (fromMaybe, maybeToList) -import Data.Text (Text) import Data.Word (Word64) import Options.Applicative hiding (help, str) import qualified Options.Applicative as Opt @@ -213,240 +212,6 @@ pStakeAddressCmds envCli = <*> pStakePoolVerificationKeyOrHashOrFile Nothing <*> pOutputFile -pKeyCmds :: Parser LegacyKeyCmds -pKeyCmds = - asum - [ subParser "verification-key" - $ Opt.info pKeyGetVerificationKey - $ Opt.progDesc - $ mconcat - [ "Get a verification key from a signing key. This " - , " supports all key types." - ] - , subParser "non-extended-key" - $ Opt.info pKeyNonExtendedKey - $ Opt.progDesc - $ mconcat - [ "Get a non-extended verification key from an " - , "extended verification key. This supports all " - , "extended key types." - ] - , subParser "convert-byron-key" - $ Opt.info pKeyConvertByronKey - $ Opt.progDesc - $ mconcat - [ "Convert a Byron payment, genesis or genesis " - , "delegate key (signing or verification) to a " - , "corresponding Shelley-format key." - ] - , subParser "convert-byron-genesis-vkey" - $ Opt.info pKeyConvertByronGenesisVKey - $ Opt.progDesc - $ mconcat - [ "Convert a Base64-encoded Byron genesis " - , "verification key to a Shelley genesis " - , "verification key" - ] - , subParser "convert-itn-key" - $ Opt.info pKeyConvertITNKey - $ Opt.progDesc - $ mconcat - [ "Convert an Incentivized Testnet (ITN) non-extended " - , "(Ed25519) signing or verification key to a " - , "corresponding Shelley stake key" - ] - , subParser "convert-itn-extended-key" - $ Opt.info pKeyConvertITNExtendedKey - $ Opt.progDesc - $ mconcat - [ "Convert an Incentivized Testnet (ITN) extended " - , "(Ed25519Extended) signing key to a corresponding " - , "Shelley stake signing key" - ] - , subParser "convert-itn-bip32-key" - $ Opt.info pKeyConvertITNBip32Key - $ Opt.progDesc - $ mconcat - [ "Convert an Incentivized Testnet (ITN) BIP32 " - , "(Ed25519Bip32) signing key to a corresponding " - , "Shelley stake signing key" - ] - , subParser "convert-cardano-address-key" - $ Opt.info pKeyConvertCardanoAddressSigningKey - $ Opt.progDesc - $ mconcat - [ "Convert a cardano-address extended signing key " - , "to a corresponding Shelley-format key." - ] - ] - where - pKeyGetVerificationKey :: Parser LegacyKeyCmds - pKeyGetVerificationKey = - KeyGetVerificationKey - <$> pSigningKeyFileIn - <*> pVerificationKeyFileOut - - pKeyNonExtendedKey :: Parser LegacyKeyCmds - pKeyNonExtendedKey = - KeyNonExtendedKey - <$> pExtendedVerificationKeyFileIn - <*> pVerificationKeyFileOut - - pKeyConvertByronKey :: Parser LegacyKeyCmds - pKeyConvertByronKey = - KeyConvertByronKey - <$> optional pPassword - <*> pByronKeyType - <*> pByronKeyFile - <*> pOutputFile - - pPassword :: Parser Text - pPassword = - Opt.strOption $ mconcat - [ Opt.long "password" - , Opt.metavar "TEXT" - , Opt.help "Password for signing key (if applicable)." - ] - - pByronKeyType :: Parser ByronKeyType - pByronKeyType = - asum - [ Opt.flag' (ByronPaymentKey NonLegacyByronKeyFormat) $ mconcat - [ Opt.long "byron-payment-key-type" - , Opt.help "Use a Byron-era payment key." - ] - , Opt.flag' (ByronPaymentKey LegacyByronKeyFormat) $ mconcat - [ Opt.long "legacy-byron-payment-key-type" - , Opt.help "Use a Byron-era payment key, in legacy SL format." - ] - , Opt.flag' (ByronGenesisKey NonLegacyByronKeyFormat) $ mconcat - [ Opt.long "byron-genesis-key-type" - , Opt.help "Use a Byron-era genesis key." - ] - , Opt.flag' (ByronGenesisKey LegacyByronKeyFormat) $ mconcat - [ Opt.long "legacy-byron-genesis-key-type" - , Opt.help "Use a Byron-era genesis key, in legacy SL format." - ] - , Opt.flag' (ByronDelegateKey NonLegacyByronKeyFormat) $ mconcat - [ Opt.long "byron-genesis-delegate-key-type" - , Opt.help "Use a Byron-era genesis delegate key." - ] - , Opt.flag' (ByronDelegateKey LegacyByronKeyFormat) $ mconcat - [ Opt.long "legacy-byron-genesis-delegate-key-type" - , Opt.help "Use a Byron-era genesis delegate key, in legacy SL format." - ] - ] - - pByronKeyFile :: Parser (SomeKeyFile In) - pByronKeyFile = - asum - [ ASigningKeyFile <$> pByronSigningKeyFile - , AVerificationKeyFile <$> pByronVerificationKeyFile - ] - - pByronSigningKeyFile :: Parser (SigningKeyFile In) - pByronSigningKeyFile = - fmap File $ Opt.strOption $ mconcat - [ Opt.long "byron-signing-key-file" - , Opt.metavar "FILE" - , Opt.help "Input filepath of the Byron-format signing key." - , Opt.completer (Opt.bashCompleter "file") - ] - - pByronVerificationKeyFile :: Parser (VerificationKeyFile In) - pByronVerificationKeyFile = - fmap File $ Opt.strOption $ mconcat - [ Opt.long "byron-verification-key-file" - , Opt.metavar "FILE" - , Opt.help "Input filepath of the Byron-format verification key." - , Opt.completer (Opt.bashCompleter "file") - ] - - pKeyConvertByronGenesisVKey :: Parser LegacyKeyCmds - pKeyConvertByronGenesisVKey = - KeyConvertByronGenesisVKey - <$> pByronGenesisVKeyBase64 - <*> pOutputFile - - pByronGenesisVKeyBase64 :: Parser VerificationKeyBase64 - pByronGenesisVKeyBase64 = - fmap VerificationKeyBase64 $ Opt.strOption $ mconcat - [ Opt.long "byron-genesis-verification-key" - , Opt.metavar "BASE64" - , Opt.help "Base64 string for the Byron genesis verification key." - ] - - pKeyConvertITNKey :: Parser LegacyKeyCmds - pKeyConvertITNKey = - KeyConvertITNStakeKey - <$> pITNKeyFIle - <*> pOutputFile - - pKeyConvertITNExtendedKey :: Parser LegacyKeyCmds - pKeyConvertITNExtendedKey = - KeyConvertITNExtendedToStakeKey - <$> pITNSigningKeyFile - <*> pOutputFile - - pKeyConvertITNBip32Key :: Parser LegacyKeyCmds - pKeyConvertITNBip32Key = - KeyConvertITNBip32ToStakeKey - <$> pITNSigningKeyFile - <*> pOutputFile - - pITNKeyFIle :: Parser (SomeKeyFile direction) - pITNKeyFIle = - asum - [ pITNSigningKeyFile - , pITNVerificationKeyFile - ] - - pITNSigningKeyFile :: Parser (SomeKeyFile direction) - pITNSigningKeyFile = - fmap (ASigningKeyFile . File) $ Opt.strOption $ mconcat - [ Opt.long "itn-signing-key-file" - , Opt.metavar "FILE" - , Opt.help "Filepath of the ITN signing key." - , Opt.completer (Opt.bashCompleter "file") - ] - - pITNVerificationKeyFile :: Parser (SomeKeyFile direction) - pITNVerificationKeyFile = - fmap (AVerificationKeyFile . File) $ Opt.strOption $ mconcat - [ Opt.long "itn-verification-key-file" - , Opt.metavar "FILE" - , Opt.help "Filepath of the ITN verification key." - , Opt.completer (Opt.bashCompleter "file") - ] - - pKeyConvertCardanoAddressSigningKey :: Parser LegacyKeyCmds - pKeyConvertCardanoAddressSigningKey = - KeyConvertCardanoAddressSigningKey - <$> pCardanoAddressKeyType - <*> pSigningKeyFileIn - <*> pOutputFile - - pCardanoAddressKeyType :: Parser CardanoAddressKeyType - pCardanoAddressKeyType = - asum - [ Opt.flag' CardanoAddressShelleyPaymentKey $ mconcat - [ Opt.long "shelley-payment-key" - , Opt.help "Use a Shelley-era extended payment key." - ] - , Opt.flag' CardanoAddressShelleyStakeKey $ mconcat - [ Opt.long "shelley-stake-key" - , Opt.help "Use a Shelley-era extended stake key." - ] - , Opt.flag' CardanoAddressIcarusPaymentKey $ mconcat - [ Opt.long "icarus-payment-key" - , Opt.help "Use a Byron-era extended payment key formatted in the Icarus style." - ] - , Opt.flag' CardanoAddressByronPaymentKey $ mconcat - [ Opt.long "byron-payment-key" - , Opt.help "Use a Byron-era extended payment key formatted in the deprecated Byron style." - ] - ] - pTransaction :: EnvCli -> Parser LegacyTransactionCmds pTransaction envCli = asum diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Options/Key.hs b/cardano-cli/src/Cardano/CLI/Legacy/Options/Key.hs new file mode 100644 index 0000000000..7fde88c0da --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Legacy/Options/Key.hs @@ -0,0 +1,253 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Cardano.CLI.Legacy.Options.Key + ( pKeyCmds + ) where + +import Cardano.Api hiding (QueryInShelleyBasedEra (..)) + +import Cardano.CLI.EraBased.Options.Common +import Cardano.CLI.Legacy.Commands.Key +import Cardano.CLI.Types.Common + +import Data.Foldable +import Data.Text (Text) +import Options.Applicative hiding (help, str) +import qualified Options.Applicative as Opt + +pKeyCmds :: Parser LegacyKeyCmds +pKeyCmds = + asum + [ subParser "verification-key" + $ Opt.info pKeyVerificationKeyCmd + $ Opt.progDesc + $ mconcat + [ "Get a verification key from a signing key. This " + , " supports all key types." + ] + , subParser "non-extended-key" + $ Opt.info pKeyNonExtendedKeyCmd + $ Opt.progDesc + $ mconcat + [ "Get a non-extended verification key from an " + , "extended verification key. This supports all " + , "extended key types." + ] + , subParser "convert-byron-key" + $ Opt.info pKeyConvertByronKeyCmd + $ Opt.progDesc + $ mconcat + [ "Convert a Byron payment, genesis or genesis " + , "delegate key (signing or verification) to a " + , "corresponding Shelley-format key." + ] + , subParser "convert-byron-genesis-vkey" + $ Opt.info pKeyConvertByronGenesisVKeyCmd + $ Opt.progDesc + $ mconcat + [ "Convert a Base64-encoded Byron genesis " + , "verification key to a Shelley genesis " + , "verification key" + ] + , subParser "convert-itn-key" + $ Opt.info pKeyConvertITNKeyCmd + $ Opt.progDesc + $ mconcat + [ "Convert an Incentivized Testnet (ITN) non-extended " + , "(Ed25519) signing or verification key to a " + , "corresponding Shelley stake key" + ] + , subParser "convert-itn-extended-key" + $ Opt.info pKeyConvertITNExtendedKeyCmd + $ Opt.progDesc + $ mconcat + [ "Convert an Incentivized Testnet (ITN) extended " + , "(Ed25519Extended) signing key to a corresponding " + , "Shelley stake signing key" + ] + , subParser "convert-itn-bip32-key" + $ Opt.info pKeyConvertITNBip32KeyCmd + $ Opt.progDesc + $ mconcat + [ "Convert an Incentivized Testnet (ITN) BIP32 " + , "(Ed25519Bip32) signing key to a corresponding " + , "Shelley stake signing key" + ] + , subParser "convert-cardano-address-key" + $ Opt.info pKeyConvertCardanoAddressKeyCmd + $ Opt.progDesc + $ mconcat + [ "Convert a cardano-address extended signing key " + , "to a corresponding Shelley-format key." + ] + ] + +pKeyVerificationKeyCmd :: Parser LegacyKeyCmds +pKeyVerificationKeyCmd = + KeyVerificationKeyCmd + <$> pSigningKeyFileIn + <*> pVerificationKeyFileOut + +pKeyNonExtendedKeyCmd :: Parser LegacyKeyCmds +pKeyNonExtendedKeyCmd = + KeyNonExtendedKeyCmd + <$> pExtendedVerificationKeyFileIn + <*> pVerificationKeyFileOut + +pKeyConvertByronKeyCmd :: Parser LegacyKeyCmds +pKeyConvertByronKeyCmd = + KeyConvertByronKeyCmd + <$> optional pPassword + <*> pByronKeyType + <*> pByronKeyFile + <*> pOutputFile + +pPassword :: Parser Text +pPassword = + Opt.strOption $ mconcat + [ Opt.long "password" + , Opt.metavar "TEXT" + , Opt.help "Password for signing key (if applicable)." + ] + +pByronKeyType :: Parser ByronKeyType +pByronKeyType = + asum + [ Opt.flag' (ByronPaymentKey NonLegacyByronKeyFormat) $ mconcat + [ Opt.long "byron-payment-key-type" + , Opt.help "Use a Byron-era payment key." + ] + , Opt.flag' (ByronPaymentKey LegacyByronKeyFormat) $ mconcat + [ Opt.long "legacy-byron-payment-key-type" + , Opt.help "Use a Byron-era payment key, in legacy SL format." + ] + , Opt.flag' (ByronGenesisKey NonLegacyByronKeyFormat) $ mconcat + [ Opt.long "byron-genesis-key-type" + , Opt.help "Use a Byron-era genesis key." + ] + , Opt.flag' (ByronGenesisKey LegacyByronKeyFormat) $ mconcat + [ Opt.long "legacy-byron-genesis-key-type" + , Opt.help "Use a Byron-era genesis key, in legacy SL format." + ] + , Opt.flag' (ByronDelegateKey NonLegacyByronKeyFormat) $ mconcat + [ Opt.long "byron-genesis-delegate-key-type" + , Opt.help "Use a Byron-era genesis delegate key." + ] + , Opt.flag' (ByronDelegateKey LegacyByronKeyFormat) $ mconcat + [ Opt.long "legacy-byron-genesis-delegate-key-type" + , Opt.help "Use a Byron-era genesis delegate key, in legacy SL format." + ] + ] + +pByronKeyFile :: Parser (SomeKeyFile In) +pByronKeyFile = + asum + [ ASigningKeyFile <$> pByronSigningKeyFile + , AVerificationKeyFile <$> pByronVerificationKeyFile + ] + +pByronSigningKeyFile :: Parser (SigningKeyFile In) +pByronSigningKeyFile = + fmap File $ Opt.strOption $ mconcat + [ Opt.long "byron-signing-key-file" + , Opt.metavar "FILE" + , Opt.help "Input filepath of the Byron-format signing key." + , Opt.completer (Opt.bashCompleter "file") + ] + +pByronVerificationKeyFile :: Parser (VerificationKeyFile In) +pByronVerificationKeyFile = + fmap File $ Opt.strOption $ mconcat + [ Opt.long "byron-verification-key-file" + , Opt.metavar "FILE" + , Opt.help "Input filepath of the Byron-format verification key." + , Opt.completer (Opt.bashCompleter "file") + ] + +pKeyConvertByronGenesisVKeyCmd :: Parser LegacyKeyCmds +pKeyConvertByronGenesisVKeyCmd = + KeyConvertByronGenesisVKeyCmd + <$> pByronGenesisVKeyBase64 + <*> pOutputFile + +pByronGenesisVKeyBase64 :: Parser VerificationKeyBase64 +pByronGenesisVKeyBase64 = + fmap VerificationKeyBase64 $ Opt.strOption $ mconcat + [ Opt.long "byron-genesis-verification-key" + , Opt.metavar "BASE64" + , Opt.help "Base64 string for the Byron genesis verification key." + ] + +pKeyConvertITNKeyCmd :: Parser LegacyKeyCmds +pKeyConvertITNKeyCmd = + KeyConvertITNKeyCmd + <$> pITNKeyFIle + <*> pOutputFile + +pKeyConvertITNExtendedKeyCmd :: Parser LegacyKeyCmds +pKeyConvertITNExtendedKeyCmd = + KeyConvertITNExtendedKeyCmd + <$> pITNSigningKeyFile + <*> pOutputFile + +pKeyConvertITNBip32KeyCmd :: Parser LegacyKeyCmds +pKeyConvertITNBip32KeyCmd = + KeyConvertITNBip32KeyCmd + <$> pITNSigningKeyFile + <*> pOutputFile + +pITNKeyFIle :: Parser (SomeKeyFile direction) +pITNKeyFIle = + asum + [ pITNSigningKeyFile + , pITNVerificationKeyFile + ] + +pITNSigningKeyFile :: Parser (SomeKeyFile direction) +pITNSigningKeyFile = + fmap (ASigningKeyFile . File) $ Opt.strOption $ mconcat + [ Opt.long "itn-signing-key-file" + , Opt.metavar "FILE" + , Opt.help "Filepath of the ITN signing key." + , Opt.completer (Opt.bashCompleter "file") + ] + +pITNVerificationKeyFile :: Parser (SomeKeyFile direction) +pITNVerificationKeyFile = + fmap (AVerificationKeyFile . File) $ Opt.strOption $ mconcat + [ Opt.long "itn-verification-key-file" + , Opt.metavar "FILE" + , Opt.help "Filepath of the ITN verification key." + , Opt.completer (Opt.bashCompleter "file") + ] + +pKeyConvertCardanoAddressKeyCmd :: Parser LegacyKeyCmds +pKeyConvertCardanoAddressKeyCmd = + KeyConvertCardanoAddressKeyCmd + <$> pCardanoAddressKeyType + <*> pSigningKeyFileIn + <*> pOutputFile + +pCardanoAddressKeyType :: Parser CardanoAddressKeyType +pCardanoAddressKeyType = + asum + [ Opt.flag' CardanoAddressShelleyPaymentKey $ mconcat + [ Opt.long "shelley-payment-key" + , Opt.help "Use a Shelley-era extended payment key." + ] + , Opt.flag' CardanoAddressShelleyStakeKey $ mconcat + [ Opt.long "shelley-stake-key" + , Opt.help "Use a Shelley-era extended stake key." + ] + , Opt.flag' CardanoAddressIcarusPaymentKey $ mconcat + [ Opt.long "icarus-payment-key" + , Opt.help "Use a Byron-era extended payment key formatted in the Icarus style." + ] + , Opt.flag' CardanoAddressByronPaymentKey $ mconcat + [ Opt.long "byron-payment-key" + , Opt.help "Use a Byron-era extended payment key formatted in the deprecated Byron style." + ] + ] diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Key.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Key.hs index 658189900e..80450fa268 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/Key.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/Key.hs @@ -7,6 +7,7 @@ module Cardano.CLI.Legacy.Run.Key import Cardano.Api +import qualified Cardano.CLI.EraBased.Commands.Key as Cmd import Cardano.CLI.EraBased.Run.Key import Cardano.CLI.Legacy.Commands.Key import Cardano.CLI.Types.Common @@ -19,34 +20,38 @@ runLegacyKeyCmds :: () => LegacyKeyCmds -> ExceptT KeyCmdError IO () runLegacyKeyCmds = \case - KeyGetVerificationKey skf vkf -> - runLegacyGetVerificationKeyCmd skf vkf - KeyNonExtendedKey evkf vkf -> - runLegacyConvertToNonExtendedKeyCmd evkf vkf - KeyConvertByronKey mPassword keytype skfOld skfNew -> + KeyVerificationKeyCmd skf vkf -> + runLegacyVerificationKeyCmd skf vkf + KeyNonExtendedKeyCmd evkf vkf -> + runLegacyNonExtendedKeyCmd evkf vkf + KeyConvertByronKeyCmd mPassword keytype skfOld skfNew -> runLegacyConvertByronKeyCmd mPassword keytype skfOld skfNew - KeyConvertByronGenesisVKey oldVk newVkf -> - runLegacyConvertByronGenesisVerificationKeyCmd oldVk newVkf - KeyConvertITNStakeKey itnKeyFile outFile -> + KeyConvertByronGenesisVKeyCmd oldVk newVkf -> + runLegacyConvertByronGenesisVKeyCmd oldVk newVkf + KeyConvertITNKeyCmd itnKeyFile outFile -> runLegacyConvertITNStakeKeyCmd itnKeyFile outFile - KeyConvertITNExtendedToStakeKey itnPrivKeyFile outFile -> - runLegacyConvertITNExtendedToStakeKeyCmd itnPrivKeyFile outFile - KeyConvertITNBip32ToStakeKey itnPrivKeyFile outFile -> - runLegacyConvertITNBip32ToStakeKeyCmd itnPrivKeyFile outFile - KeyConvertCardanoAddressSigningKey keyType skfOld skfNew -> - runLegacyConvertCardanoAddressSigningKeyCmd keyType skfOld skfNew + KeyConvertITNExtendedKeyCmd itnPrivKeyFile outFile -> + runLegacyConvertITNExtendedKeyCmd itnPrivKeyFile outFile + KeyConvertITNBip32KeyCmd itnPrivKeyFile outFile -> + runLegacyConvertITNBip32KeyCmd itnPrivKeyFile outFile + KeyConvertCardanoAddressKeyCmd keyType skfOld skfNew -> + runLegacyConvertCardanoAddressKeyCmd keyType skfOld skfNew -runLegacyGetVerificationKeyCmd :: () +runLegacyVerificationKeyCmd :: () => SigningKeyFile In -> VerificationKeyFile Out -> ExceptT KeyCmdError IO () -runLegacyGetVerificationKeyCmd = runGetVerificationKeyCmd +runLegacyVerificationKeyCmd skf vkf = + runVerificationKeyCmd $ + Cmd.KeyVerificationKeyCmdArgs skf vkf -runLegacyConvertToNonExtendedKeyCmd :: () +runLegacyNonExtendedKeyCmd :: () => VerificationKeyFile In -> VerificationKeyFile Out -> ExceptT KeyCmdError IO () -runLegacyConvertToNonExtendedKeyCmd = runConvertToNonExtendedKeyCmd +runLegacyNonExtendedKeyCmd evkf vkf = + runNonExtendedKeyCmd $ + Cmd.KeyNonExtendedKeyCmdArgs evkf vkf runLegacyConvertByronKeyCmd :: () => Maybe Text -- ^ Password (if applicable) @@ -54,13 +59,17 @@ runLegacyConvertByronKeyCmd :: () -> SomeKeyFile In -- ^ Input file: old format -> File () Out -- ^ Output file: new format -> ExceptT KeyCmdError IO () -runLegacyConvertByronKeyCmd = runConvertByronKeyCmd +runLegacyConvertByronKeyCmd mPassword keytype skfOld skfNew = + runConvertByronKeyCmd $ + Cmd.KeyConvertByronKeyCmdArgs mPassword keytype skfOld skfNew -runLegacyConvertByronGenesisVerificationKeyCmd :: () +runLegacyConvertByronGenesisVKeyCmd :: () => VerificationKeyBase64 -- ^ Input key raw old format -> File () Out -- ^ Output file: new format -> ExceptT KeyCmdError IO () -runLegacyConvertByronGenesisVerificationKeyCmd = runConvertByronGenesisVerificationKeyCmd +runLegacyConvertByronGenesisVKeyCmd oldVk newVkf = + runConvertByronGenesisVKeyCmd $ + Cmd.KeyConvertByronGenesisVKeyCmdArgs oldVk newVkf -------------------------------------------------------------------------------- -- ITN verification/signing key conversion to Haskell verficiation/signing keys @@ -70,23 +79,31 @@ runLegacyConvertITNStakeKeyCmd :: () => SomeKeyFile In -> File () Out -> ExceptT KeyCmdError IO () -runLegacyConvertITNStakeKeyCmd = runConvertITNStakeKeyCmd +runLegacyConvertITNStakeKeyCmd itnKeyFile outFile = + runConvertITNKeyCmd $ + Cmd.KeyConvertITNKeyCmdArgs itnKeyFile outFile -runLegacyConvertITNExtendedToStakeKeyCmd :: () +runLegacyConvertITNExtendedKeyCmd :: () => SomeKeyFile In -> File () Out -> ExceptT KeyCmdError IO () -runLegacyConvertITNExtendedToStakeKeyCmd = runConvertITNExtendedToStakeKeyCmd +runLegacyConvertITNExtendedKeyCmd itnPrivKeyFile outFile = + runConvertITNExtendedKeyCmd $ + Cmd.KeyConvertITNExtendedKeyCmdArgs itnPrivKeyFile outFile -runLegacyConvertITNBip32ToStakeKeyCmd :: () +runLegacyConvertITNBip32KeyCmd :: () => SomeKeyFile In -> File () Out -> ExceptT KeyCmdError IO () -runLegacyConvertITNBip32ToStakeKeyCmd = runConvertITNBip32ToStakeKeyCmd +runLegacyConvertITNBip32KeyCmd itnPrivKeyFile outFile = + runConvertITNBip32KeyCmd $ + Cmd.KeyConvertITNBip32KeyCmdArgs itnPrivKeyFile outFile -runLegacyConvertCardanoAddressSigningKeyCmd :: () +runLegacyConvertCardanoAddressKeyCmd :: () => CardanoAddressKeyType -> SigningKeyFile In -> File () Out -> ExceptT KeyCmdError IO () -runLegacyConvertCardanoAddressSigningKeyCmd = runConvertCardanoAddressSigningKeyCmd +runLegacyConvertCardanoAddressKeyCmd keyType skfOld skfNew = + runConvertCardanoAddressKeyCmd $ + Cmd.KeyConvertCardanoAddressKeyCmdArgs keyType skfOld skfNew