{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Cardano.CLI.Options.Key
  ( pKeyCmds
  )
where

import           Cardano.Api hiding (QueryInShelleyBasedEra (..), parseFilePath)

import           Cardano.CLI.Commands.Key
import           Cardano.CLI.EraBased.Options.Common
import           Cardano.CLI.Types.Common

import           Data.Foldable
import           Data.Text (Text)
import           Options.Applicative hiding (help, str)
import qualified Options.Applicative as Opt

{- HLINT ignore "Use <$>" -}
{- HLINT ignore "Move brackets to avoid $" -}

pKeyCmds :: Parser KeyCmds
pKeyCmds :: Parser KeyCmds
pKeyCmds =
  let keyCmdParsers :: Parser KeyCmds
keyCmdParsers =
        [Parser KeyCmds] -> Parser KeyCmds
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
          [ String -> ParserInfo KeyCmds -> Parser KeyCmds
forall a. String -> ParserInfo a -> Parser a
subParser String
"verification-key" (ParserInfo KeyCmds -> Parser KeyCmds)
-> ParserInfo KeyCmds -> Parser KeyCmds
forall a b. (a -> b) -> a -> b
$
              Parser KeyCmds -> InfoMod KeyCmds -> ParserInfo KeyCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser KeyCmds
pKeyVerificationKeyCmd (InfoMod KeyCmds -> ParserInfo KeyCmds)
-> InfoMod KeyCmds -> ParserInfo KeyCmds
forall a b. (a -> b) -> a -> b
$
                String -> InfoMod KeyCmds
forall a. String -> InfoMod a
Opt.progDesc (String -> InfoMod KeyCmds) -> String -> InfoMod KeyCmds
forall a b. (a -> b) -> a -> b
$
                  [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                    [ String
"Get a verification key from a signing key. This "
                    , String
" supports all key types."
                    ]
          , String -> ParserInfo KeyCmds -> Parser KeyCmds
forall a. String -> ParserInfo a -> Parser a
subParser String
"non-extended-key" (ParserInfo KeyCmds -> Parser KeyCmds)
-> ParserInfo KeyCmds -> Parser KeyCmds
forall a b. (a -> b) -> a -> b
$
              Parser KeyCmds -> InfoMod KeyCmds -> ParserInfo KeyCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser KeyCmds
pKeyNonExtendedKeyCmd (InfoMod KeyCmds -> ParserInfo KeyCmds)
-> InfoMod KeyCmds -> ParserInfo KeyCmds
forall a b. (a -> b) -> a -> b
$
                String -> InfoMod KeyCmds
forall a. String -> InfoMod a
Opt.progDesc (String -> InfoMod KeyCmds) -> String -> InfoMod KeyCmds
forall a b. (a -> b) -> a -> b
$
                  [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                    [ String
"Get a non-extended verification key from an "
                    , String
"extended verification key. This supports all "
                    , String
"extended key types."
                    ]
          , String -> ParserInfo KeyCmds -> Parser KeyCmds
forall a. String -> ParserInfo a -> Parser a
subParser String
"convert-byron-key" (ParserInfo KeyCmds -> Parser KeyCmds)
-> ParserInfo KeyCmds -> Parser KeyCmds
forall a b. (a -> b) -> a -> b
$
              Parser KeyCmds -> InfoMod KeyCmds -> ParserInfo KeyCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser KeyCmds
pKeyConvertByronKeyCmd (InfoMod KeyCmds -> ParserInfo KeyCmds)
-> InfoMod KeyCmds -> ParserInfo KeyCmds
forall a b. (a -> b) -> a -> b
$
                String -> InfoMod KeyCmds
forall a. String -> InfoMod a
Opt.progDesc (String -> InfoMod KeyCmds) -> String -> InfoMod KeyCmds
forall a b. (a -> b) -> a -> b
$
                  [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                    [ String
"Convert a Byron payment, genesis or genesis "
                    , String
"delegate key (signing or verification) to a "
                    , String
"corresponding Shelley-format key."
                    ]
          , String -> ParserInfo KeyCmds -> Parser KeyCmds
forall a. String -> ParserInfo a -> Parser a
subParser String
"convert-byron-genesis-vkey" (ParserInfo KeyCmds -> Parser KeyCmds)
-> ParserInfo KeyCmds -> Parser KeyCmds
forall a b. (a -> b) -> a -> b
$
              Parser KeyCmds -> InfoMod KeyCmds -> ParserInfo KeyCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser KeyCmds
pKeyConvertByronGenesisKeyCmd (InfoMod KeyCmds -> ParserInfo KeyCmds)
-> InfoMod KeyCmds -> ParserInfo KeyCmds
forall a b. (a -> b) -> a -> b
$
                String -> InfoMod KeyCmds
forall a. String -> InfoMod a
Opt.progDesc (String -> InfoMod KeyCmds) -> String -> InfoMod KeyCmds
forall a b. (a -> b) -> a -> b
$
                  [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                    [ String
"Convert a Base64-encoded Byron genesis "
                    , String
"verification key to a Shelley genesis "
                    , String
"verification key"
                    ]
          , String -> ParserInfo KeyCmds -> Parser KeyCmds
forall a. String -> ParserInfo a -> Parser a
subParser String
"convert-itn-key" (ParserInfo KeyCmds -> Parser KeyCmds)
-> ParserInfo KeyCmds -> Parser KeyCmds
forall a b. (a -> b) -> a -> b
$
              Parser KeyCmds -> InfoMod KeyCmds -> ParserInfo KeyCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser KeyCmds
pKeyConvertITNKeyCmd (InfoMod KeyCmds -> ParserInfo KeyCmds)
-> InfoMod KeyCmds -> ParserInfo KeyCmds
forall a b. (a -> b) -> a -> b
$
                String -> InfoMod KeyCmds
forall a. String -> InfoMod a
Opt.progDesc (String -> InfoMod KeyCmds) -> String -> InfoMod KeyCmds
forall a b. (a -> b) -> a -> b
$
                  [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                    [ String
"Convert an Incentivized Testnet (ITN) non-extended "
                    , String
"(Ed25519) signing or verification key to a "
                    , String
"corresponding Shelley stake key"
                    ]
          , String -> ParserInfo KeyCmds -> Parser KeyCmds
forall a. String -> ParserInfo a -> Parser a
subParser String
"convert-itn-extended-key" (ParserInfo KeyCmds -> Parser KeyCmds)
-> ParserInfo KeyCmds -> Parser KeyCmds
forall a b. (a -> b) -> a -> b
$
              Parser KeyCmds -> InfoMod KeyCmds -> ParserInfo KeyCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser KeyCmds
pKeyConvertITNExtendedKeyCmd (InfoMod KeyCmds -> ParserInfo KeyCmds)
-> InfoMod KeyCmds -> ParserInfo KeyCmds
forall a b. (a -> b) -> a -> b
$
                String -> InfoMod KeyCmds
forall a. String -> InfoMod a
Opt.progDesc (String -> InfoMod KeyCmds) -> String -> InfoMod KeyCmds
forall a b. (a -> b) -> a -> b
$
                  [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                    [ String
"Convert an Incentivized Testnet (ITN) extended "
                    , String
"(Ed25519Extended) signing key to a corresponding "
                    , String
"Shelley stake signing key"
                    ]
          , String -> ParserInfo KeyCmds -> Parser KeyCmds
forall a. String -> ParserInfo a -> Parser a
subParser String
"convert-itn-bip32-key" (ParserInfo KeyCmds -> Parser KeyCmds)
-> ParserInfo KeyCmds -> Parser KeyCmds
forall a b. (a -> b) -> a -> b
$
              Parser KeyCmds -> InfoMod KeyCmds -> ParserInfo KeyCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser KeyCmds
pKeyConvertITNBip32KeyCmd (InfoMod KeyCmds -> ParserInfo KeyCmds)
-> InfoMod KeyCmds -> ParserInfo KeyCmds
forall a b. (a -> b) -> a -> b
$
                String -> InfoMod KeyCmds
forall a. String -> InfoMod a
Opt.progDesc (String -> InfoMod KeyCmds) -> String -> InfoMod KeyCmds
forall a b. (a -> b) -> a -> b
$
                  [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                    [ String
"Convert an Incentivized Testnet (ITN) BIP32 "
                    , String
"(Ed25519Bip32) signing key to a corresponding "
                    , String
"Shelley stake signing key"
                    ]
          , String -> ParserInfo KeyCmds -> Parser KeyCmds
forall a. String -> ParserInfo a -> Parser a
subParser String
"convert-cardano-address-key" (ParserInfo KeyCmds -> Parser KeyCmds)
-> ParserInfo KeyCmds -> Parser KeyCmds
forall a b. (a -> b) -> a -> b
$
              Parser KeyCmds -> InfoMod KeyCmds -> ParserInfo KeyCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser KeyCmds
pKeyConvertCardanoAddressKeyCmd (InfoMod KeyCmds -> ParserInfo KeyCmds)
-> InfoMod KeyCmds -> ParserInfo KeyCmds
forall a b. (a -> b) -> a -> b
$
                String -> InfoMod KeyCmds
forall a. String -> InfoMod a
Opt.progDesc (String -> InfoMod KeyCmds) -> String -> InfoMod KeyCmds
forall a b. (a -> b) -> a -> b
$
                  [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                    [ String
"Convert a cardano-address extended signing key "
                    , String
"to a corresponding Shelley-format key."
                    ]
          ]
   in String -> ParserInfo KeyCmds -> Parser KeyCmds
forall a. String -> ParserInfo a -> Parser a
subParser
        String
"key"
        (ParserInfo KeyCmds -> Parser KeyCmds)
-> ParserInfo KeyCmds -> Parser KeyCmds
forall a b. (a -> b) -> a -> b
$ Parser KeyCmds -> InfoMod KeyCmds -> ParserInfo KeyCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info
          Parser KeyCmds
keyCmdParsers
          ( String -> InfoMod KeyCmds
forall a. String -> InfoMod a
Opt.progDesc (String -> InfoMod KeyCmds) -> String -> InfoMod KeyCmds
forall a b. (a -> b) -> a -> b
$
              [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                [ String
"Key utility commands."
                ]
          )

pKeyVerificationKeyCmd :: Parser KeyCmds
pKeyVerificationKeyCmd :: Parser KeyCmds
pKeyVerificationKeyCmd =
  (KeyVerificationKeyCmdArgs -> KeyCmds)
-> Parser KeyVerificationKeyCmdArgs -> Parser KeyCmds
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap KeyVerificationKeyCmdArgs -> KeyCmds
KeyVerificationKeyCmd (Parser KeyVerificationKeyCmdArgs -> Parser KeyCmds)
-> Parser KeyVerificationKeyCmdArgs -> Parser KeyCmds
forall a b. (a -> b) -> a -> b
$
    SigningKeyFile 'In
-> VerificationKeyFile 'Out -> KeyVerificationKeyCmdArgs
KeyVerificationKeyCmdArgs
      (SigningKeyFile 'In
 -> VerificationKeyFile 'Out -> KeyVerificationKeyCmdArgs)
-> Parser (SigningKeyFile 'In)
-> Parser (VerificationKeyFile 'Out -> KeyVerificationKeyCmdArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (SigningKeyFile 'In)
pSigningKeyFileIn
      Parser (VerificationKeyFile 'Out -> KeyVerificationKeyCmdArgs)
-> Parser (VerificationKeyFile 'Out)
-> Parser KeyVerificationKeyCmdArgs
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (VerificationKeyFile 'Out)
forall keyrole. Parser (File (VerificationKey keyrole) 'Out)
pVerificationKeyFileOut

pKeyNonExtendedKeyCmd :: Parser KeyCmds
pKeyNonExtendedKeyCmd :: Parser KeyCmds
pKeyNonExtendedKeyCmd =
  (KeyNonExtendedKeyCmdArgs -> KeyCmds)
-> Parser KeyNonExtendedKeyCmdArgs -> Parser KeyCmds
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap KeyNonExtendedKeyCmdArgs -> KeyCmds
KeyNonExtendedKeyCmd (Parser KeyNonExtendedKeyCmdArgs -> Parser KeyCmds)
-> Parser KeyNonExtendedKeyCmdArgs -> Parser KeyCmds
forall a b. (a -> b) -> a -> b
$
    VerificationKeyFile 'In
-> VerificationKeyFile 'Out -> KeyNonExtendedKeyCmdArgs
KeyNonExtendedKeyCmdArgs
      (VerificationKeyFile 'In
 -> VerificationKeyFile 'Out -> KeyNonExtendedKeyCmdArgs)
-> Parser (VerificationKeyFile 'In)
-> Parser (VerificationKeyFile 'Out -> KeyNonExtendedKeyCmdArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyFile 'In)
pExtendedVerificationKeyFileIn
      Parser (VerificationKeyFile 'Out -> KeyNonExtendedKeyCmdArgs)
-> Parser (VerificationKeyFile 'Out)
-> Parser KeyNonExtendedKeyCmdArgs
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (VerificationKeyFile 'Out)
forall keyrole. Parser (File (VerificationKey keyrole) 'Out)
pVerificationKeyFileOut

pKeyConvertByronKeyCmd :: Parser KeyCmds
pKeyConvertByronKeyCmd :: Parser KeyCmds
pKeyConvertByronKeyCmd =
  (KeyConvertByronKeyCmdArgs -> KeyCmds)
-> Parser KeyConvertByronKeyCmdArgs -> Parser KeyCmds
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap KeyConvertByronKeyCmdArgs -> KeyCmds
KeyConvertByronKeyCmd (Parser KeyConvertByronKeyCmdArgs -> Parser KeyCmds)
-> Parser KeyConvertByronKeyCmdArgs -> Parser KeyCmds
forall a b. (a -> b) -> a -> b
$
    Maybe Text
-> ByronKeyType
-> SomeKeyFile 'In
-> File () 'Out
-> KeyConvertByronKeyCmdArgs
KeyConvertByronKeyCmdArgs
      (Maybe Text
 -> ByronKeyType
 -> SomeKeyFile 'In
 -> File () 'Out
 -> KeyConvertByronKeyCmdArgs)
-> Parser (Maybe Text)
-> Parser
     (ByronKeyType
      -> SomeKeyFile 'In -> File () 'Out -> KeyConvertByronKeyCmdArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Text
pPassword
      Parser
  (ByronKeyType
   -> SomeKeyFile 'In -> File () 'Out -> KeyConvertByronKeyCmdArgs)
-> Parser ByronKeyType
-> Parser
     (SomeKeyFile 'In -> File () 'Out -> KeyConvertByronKeyCmdArgs)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByronKeyType
pByronKeyType
      Parser
  (SomeKeyFile 'In -> File () 'Out -> KeyConvertByronKeyCmdArgs)
-> Parser (SomeKeyFile 'In)
-> Parser (File () 'Out -> KeyConvertByronKeyCmdArgs)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (SomeKeyFile 'In)
pByronKeyFile
      Parser (File () 'Out -> KeyConvertByronKeyCmdArgs)
-> Parser (File () 'Out) -> Parser KeyConvertByronKeyCmdArgs
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (File () 'Out)
forall content. Parser (File content 'Out)
pOutputFile

pPassword :: Parser Text
pPassword :: Parser Text
pPassword =
  Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption (Mod OptionFields Text -> Parser Text)
-> Mod OptionFields Text -> Parser Text
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Text] -> Mod OptionFields Text
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"password"
      , String -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"TEXT"
      , String -> Mod OptionFields Text
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Password for signing key (if applicable)."
      ]

pByronKeyType :: Parser ByronKeyType
pByronKeyType :: Parser ByronKeyType
pByronKeyType =
  [Parser ByronKeyType] -> Parser ByronKeyType
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ ByronKeyType -> Mod FlagFields ByronKeyType -> Parser ByronKeyType
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' (ByronKeyFormat -> ByronKeyType
ByronPaymentKey ByronKeyFormat
NonLegacyByronKeyFormat) (Mod FlagFields ByronKeyType -> Parser ByronKeyType)
-> Mod FlagFields ByronKeyType -> Parser ByronKeyType
forall a b. (a -> b) -> a -> b
$
        [Mod FlagFields ByronKeyType] -> Mod FlagFields ByronKeyType
forall a. Monoid a => [a] -> a
mconcat
          [ String -> Mod FlagFields ByronKeyType
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"byron-payment-key-type"
          , String -> Mod FlagFields ByronKeyType
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use a Byron-era payment key."
          ]
    , ByronKeyType -> Mod FlagFields ByronKeyType -> Parser ByronKeyType
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' (ByronKeyFormat -> ByronKeyType
ByronPaymentKey ByronKeyFormat
LegacyByronKeyFormat) (Mod FlagFields ByronKeyType -> Parser ByronKeyType)
-> Mod FlagFields ByronKeyType -> Parser ByronKeyType
forall a b. (a -> b) -> a -> b
$
        [Mod FlagFields ByronKeyType] -> Mod FlagFields ByronKeyType
forall a. Monoid a => [a] -> a
mconcat
          [ String -> Mod FlagFields ByronKeyType
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"legacy-byron-payment-key-type"
          , String -> Mod FlagFields ByronKeyType
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use a Byron-era payment key, in legacy SL format."
          ]
    , ByronKeyType -> Mod FlagFields ByronKeyType -> Parser ByronKeyType
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' (ByronKeyFormat -> ByronKeyType
ByronGenesisKey ByronKeyFormat
NonLegacyByronKeyFormat) (Mod FlagFields ByronKeyType -> Parser ByronKeyType)
-> Mod FlagFields ByronKeyType -> Parser ByronKeyType
forall a b. (a -> b) -> a -> b
$
        [Mod FlagFields ByronKeyType] -> Mod FlagFields ByronKeyType
forall a. Monoid a => [a] -> a
mconcat
          [ String -> Mod FlagFields ByronKeyType
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"byron-genesis-key-type"
          , String -> Mod FlagFields ByronKeyType
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use a Byron-era genesis key."
          ]
    , ByronKeyType -> Mod FlagFields ByronKeyType -> Parser ByronKeyType
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' (ByronKeyFormat -> ByronKeyType
ByronGenesisKey ByronKeyFormat
LegacyByronKeyFormat) (Mod FlagFields ByronKeyType -> Parser ByronKeyType)
-> Mod FlagFields ByronKeyType -> Parser ByronKeyType
forall a b. (a -> b) -> a -> b
$
        [Mod FlagFields ByronKeyType] -> Mod FlagFields ByronKeyType
forall a. Monoid a => [a] -> a
mconcat
          [ String -> Mod FlagFields ByronKeyType
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"legacy-byron-genesis-key-type"
          , String -> Mod FlagFields ByronKeyType
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use a Byron-era genesis key, in legacy SL format."
          ]
    , ByronKeyType -> Mod FlagFields ByronKeyType -> Parser ByronKeyType
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' (ByronKeyFormat -> ByronKeyType
ByronDelegateKey ByronKeyFormat
NonLegacyByronKeyFormat) (Mod FlagFields ByronKeyType -> Parser ByronKeyType)
-> Mod FlagFields ByronKeyType -> Parser ByronKeyType
forall a b. (a -> b) -> a -> b
$
        [Mod FlagFields ByronKeyType] -> Mod FlagFields ByronKeyType
forall a. Monoid a => [a] -> a
mconcat
          [ String -> Mod FlagFields ByronKeyType
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"byron-genesis-delegate-key-type"
          , String -> Mod FlagFields ByronKeyType
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use a Byron-era genesis delegate key."
          ]
    , ByronKeyType -> Mod FlagFields ByronKeyType -> Parser ByronKeyType
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' (ByronKeyFormat -> ByronKeyType
ByronDelegateKey ByronKeyFormat
LegacyByronKeyFormat) (Mod FlagFields ByronKeyType -> Parser ByronKeyType)
-> Mod FlagFields ByronKeyType -> Parser ByronKeyType
forall a b. (a -> b) -> a -> b
$
        [Mod FlagFields ByronKeyType] -> Mod FlagFields ByronKeyType
forall a. Monoid a => [a] -> a
mconcat
          [ String -> Mod FlagFields ByronKeyType
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"legacy-byron-genesis-delegate-key-type"
          , String -> Mod FlagFields ByronKeyType
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use a Byron-era genesis delegate key, in legacy SL format."
          ]
    ]

pByronKeyFile :: Parser (SomeKeyFile In)
pByronKeyFile :: Parser (SomeKeyFile 'In)
pByronKeyFile =
  [Parser (SomeKeyFile 'In)] -> Parser (SomeKeyFile 'In)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ SigningKeyFile 'In -> SomeKeyFile 'In
forall (direction :: FileDirection).
SigningKeyFile direction -> SomeKeyFile direction
ASigningKeyFile (SigningKeyFile 'In -> SomeKeyFile 'In)
-> Parser (SigningKeyFile 'In) -> Parser (SomeKeyFile 'In)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (SigningKeyFile 'In)
pByronSigningKeyFile
    , VerificationKeyFile 'In -> SomeKeyFile 'In
forall (direction :: FileDirection).
VerificationKeyFile direction -> SomeKeyFile direction
AVerificationKeyFile (VerificationKeyFile 'In -> SomeKeyFile 'In)
-> Parser (VerificationKeyFile 'In) -> Parser (SomeKeyFile 'In)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyFile 'In)
pByronVerificationKeyFile
    ]

pByronSigningKeyFile :: Parser (SigningKeyFile In)
pByronSigningKeyFile :: Parser (SigningKeyFile 'In)
pByronSigningKeyFile =
  String -> SigningKeyFile 'In
forall content (direction :: FileDirection).
String -> File content direction
File (String -> SigningKeyFile 'In)
-> Parser String -> Parser (SigningKeyFile 'In)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser String
parseFilePath String
"byron-signing-key-file" String
"Input filepath of the Byron-format signing key."

pByronVerificationKeyFile :: Parser (VerificationKeyFile In)
pByronVerificationKeyFile :: Parser (VerificationKeyFile 'In)
pByronVerificationKeyFile =
  String -> VerificationKeyFile 'In
forall content (direction :: FileDirection).
String -> File content direction
File
    (String -> VerificationKeyFile 'In)
-> Parser String -> Parser (VerificationKeyFile 'In)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser String
parseFilePath String
"byron-verification-key-file" String
"Input filepath of the Byron-format verification key."

pKeyConvertByronGenesisKeyCmd :: Parser KeyCmds
pKeyConvertByronGenesisKeyCmd :: Parser KeyCmds
pKeyConvertByronGenesisKeyCmd =
  (KeyConvertByronGenesisVKeyCmdArgs -> KeyCmds)
-> Parser KeyConvertByronGenesisVKeyCmdArgs -> Parser KeyCmds
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap KeyConvertByronGenesisVKeyCmdArgs -> KeyCmds
KeyConvertByronGenesisVKeyCmd (Parser KeyConvertByronGenesisVKeyCmdArgs -> Parser KeyCmds)
-> Parser KeyConvertByronGenesisVKeyCmdArgs -> Parser KeyCmds
forall a b. (a -> b) -> a -> b
$
    VerificationKeyBase64
-> File () 'Out -> KeyConvertByronGenesisVKeyCmdArgs
KeyConvertByronGenesisVKeyCmdArgs
      (VerificationKeyBase64
 -> File () 'Out -> KeyConvertByronGenesisVKeyCmdArgs)
-> Parser VerificationKeyBase64
-> Parser (File () 'Out -> KeyConvertByronGenesisVKeyCmdArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VerificationKeyBase64
pByronGenesisVKeyBase64
      Parser (File () 'Out -> KeyConvertByronGenesisVKeyCmdArgs)
-> Parser (File () 'Out)
-> Parser KeyConvertByronGenesisVKeyCmdArgs
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (File () 'Out)
forall content. Parser (File content 'Out)
pOutputFile

pByronGenesisVKeyBase64 :: Parser VerificationKeyBase64
pByronGenesisVKeyBase64 :: Parser VerificationKeyBase64
pByronGenesisVKeyBase64 =
  (String -> VerificationKeyBase64)
-> Parser String -> Parser VerificationKeyBase64
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> VerificationKeyBase64
VerificationKeyBase64 (Parser String -> Parser VerificationKeyBase64)
-> Parser String -> Parser VerificationKeyBase64
forall a b. (a -> b) -> a -> b
$
    Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption (Mod OptionFields String -> Parser String)
-> Mod OptionFields String -> Parser String
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields String] -> Mod OptionFields String
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"byron-genesis-verification-key"
        , String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"BASE64"
        , String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Base64 string for the Byron genesis verification key."
        ]

pKeyConvertITNKeyCmd :: Parser KeyCmds
pKeyConvertITNKeyCmd :: Parser KeyCmds
pKeyConvertITNKeyCmd =
  (KeyConvertITNKeyCmdArgs -> KeyCmds)
-> Parser KeyConvertITNKeyCmdArgs -> Parser KeyCmds
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap KeyConvertITNKeyCmdArgs -> KeyCmds
KeyConvertITNKeyCmd (Parser KeyConvertITNKeyCmdArgs -> Parser KeyCmds)
-> Parser KeyConvertITNKeyCmdArgs -> Parser KeyCmds
forall a b. (a -> b) -> a -> b
$
    SomeKeyFile 'In -> File () 'Out -> KeyConvertITNKeyCmdArgs
KeyConvertITNKeyCmdArgs
      (SomeKeyFile 'In -> File () 'Out -> KeyConvertITNKeyCmdArgs)
-> Parser (SomeKeyFile 'In)
-> Parser (File () 'Out -> KeyConvertITNKeyCmdArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (SomeKeyFile 'In)
forall (direction :: FileDirection). Parser (SomeKeyFile direction)
pITNKeyFIle
      Parser (File () 'Out -> KeyConvertITNKeyCmdArgs)
-> Parser (File () 'Out) -> Parser KeyConvertITNKeyCmdArgs
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (File () 'Out)
forall content. Parser (File content 'Out)
pOutputFile

pKeyConvertITNExtendedKeyCmd :: Parser KeyCmds
pKeyConvertITNExtendedKeyCmd :: Parser KeyCmds
pKeyConvertITNExtendedKeyCmd =
  (KeyConvertITNExtendedKeyCmdArgs -> KeyCmds)
-> Parser KeyConvertITNExtendedKeyCmdArgs -> Parser KeyCmds
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap KeyConvertITNExtendedKeyCmdArgs -> KeyCmds
KeyConvertITNExtendedKeyCmd (Parser KeyConvertITNExtendedKeyCmdArgs -> Parser KeyCmds)
-> Parser KeyConvertITNExtendedKeyCmdArgs -> Parser KeyCmds
forall a b. (a -> b) -> a -> b
$
    SomeKeyFile 'In -> File () 'Out -> KeyConvertITNExtendedKeyCmdArgs
KeyConvertITNExtendedKeyCmdArgs
      (SomeKeyFile 'In
 -> File () 'Out -> KeyConvertITNExtendedKeyCmdArgs)
-> Parser (SomeKeyFile 'In)
-> Parser (File () 'Out -> KeyConvertITNExtendedKeyCmdArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (SomeKeyFile 'In)
forall (direction :: FileDirection). Parser (SomeKeyFile direction)
pITNSigningKeyFile
      Parser (File () 'Out -> KeyConvertITNExtendedKeyCmdArgs)
-> Parser (File () 'Out) -> Parser KeyConvertITNExtendedKeyCmdArgs
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (File () 'Out)
forall content. Parser (File content 'Out)
pOutputFile

pKeyConvertITNBip32KeyCmd :: Parser KeyCmds
pKeyConvertITNBip32KeyCmd :: Parser KeyCmds
pKeyConvertITNBip32KeyCmd =
  (KeyConvertITNBip32KeyCmdArgs -> KeyCmds)
-> Parser KeyConvertITNBip32KeyCmdArgs -> Parser KeyCmds
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap KeyConvertITNBip32KeyCmdArgs -> KeyCmds
KeyConvertITNBip32KeyCmd (Parser KeyConvertITNBip32KeyCmdArgs -> Parser KeyCmds)
-> Parser KeyConvertITNBip32KeyCmdArgs -> Parser KeyCmds
forall a b. (a -> b) -> a -> b
$
    SomeKeyFile 'In -> File () 'Out -> KeyConvertITNBip32KeyCmdArgs
KeyConvertITNBip32KeyCmdArgs
      (SomeKeyFile 'In -> File () 'Out -> KeyConvertITNBip32KeyCmdArgs)
-> Parser (SomeKeyFile 'In)
-> Parser (File () 'Out -> KeyConvertITNBip32KeyCmdArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (SomeKeyFile 'In)
forall (direction :: FileDirection). Parser (SomeKeyFile direction)
pITNSigningKeyFile
      Parser (File () 'Out -> KeyConvertITNBip32KeyCmdArgs)
-> Parser (File () 'Out) -> Parser KeyConvertITNBip32KeyCmdArgs
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (File () 'Out)
forall content. Parser (File content 'Out)
pOutputFile

pITNKeyFIle :: Parser (SomeKeyFile direction)
pITNKeyFIle :: forall (direction :: FileDirection). Parser (SomeKeyFile direction)
pITNKeyFIle =
  [Parser (SomeKeyFile direction)] -> Parser (SomeKeyFile direction)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ Parser (SomeKeyFile direction)
forall (direction :: FileDirection). Parser (SomeKeyFile direction)
pITNSigningKeyFile
    , Parser (SomeKeyFile direction)
forall (direction :: FileDirection). Parser (SomeKeyFile direction)
pITNVerificationKeyFile
    ]

pITNSigningKeyFile :: Parser (SomeKeyFile direction)
pITNSigningKeyFile :: forall (direction :: FileDirection). Parser (SomeKeyFile direction)
pITNSigningKeyFile =
  SigningKeyFile direction -> SomeKeyFile direction
forall (direction :: FileDirection).
SigningKeyFile direction -> SomeKeyFile direction
ASigningKeyFile (SigningKeyFile direction -> SomeKeyFile direction)
-> (String -> SigningKeyFile direction)
-> String
-> SomeKeyFile direction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SigningKeyFile direction
forall content (direction :: FileDirection).
String -> File content direction
File (String -> SomeKeyFile direction)
-> Parser String -> Parser (SomeKeyFile direction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser String
parseFilePath String
"itn-signing-key-file" String
"Filepath of the ITN signing key."

pITNVerificationKeyFile :: Parser (SomeKeyFile direction)
pITNVerificationKeyFile :: forall (direction :: FileDirection). Parser (SomeKeyFile direction)
pITNVerificationKeyFile =
  VerificationKeyFile direction -> SomeKeyFile direction
forall (direction :: FileDirection).
VerificationKeyFile direction -> SomeKeyFile direction
AVerificationKeyFile (VerificationKeyFile direction -> SomeKeyFile direction)
-> (String -> VerificationKeyFile direction)
-> String
-> SomeKeyFile direction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> VerificationKeyFile direction
forall content (direction :: FileDirection).
String -> File content direction
File
    (String -> SomeKeyFile direction)
-> Parser String -> Parser (SomeKeyFile direction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser String
parseFilePath String
"itn-verification-key-file" String
"Filepath of the ITN verification key."

pKeyConvertCardanoAddressKeyCmd :: Parser KeyCmds
pKeyConvertCardanoAddressKeyCmd :: Parser KeyCmds
pKeyConvertCardanoAddressKeyCmd =
  (KeyConvertCardanoAddressKeyCmdArgs -> KeyCmds)
-> Parser KeyConvertCardanoAddressKeyCmdArgs -> Parser KeyCmds
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap KeyConvertCardanoAddressKeyCmdArgs -> KeyCmds
KeyConvertCardanoAddressKeyCmd (Parser KeyConvertCardanoAddressKeyCmdArgs -> Parser KeyCmds)
-> Parser KeyConvertCardanoAddressKeyCmdArgs -> Parser KeyCmds
forall a b. (a -> b) -> a -> b
$
    CardanoAddressKeyType
-> SigningKeyFile 'In
-> File () 'Out
-> KeyConvertCardanoAddressKeyCmdArgs
KeyConvertCardanoAddressKeyCmdArgs
      (CardanoAddressKeyType
 -> SigningKeyFile 'In
 -> File () 'Out
 -> KeyConvertCardanoAddressKeyCmdArgs)
-> Parser CardanoAddressKeyType
-> Parser
     (SigningKeyFile 'In
      -> File () 'Out -> KeyConvertCardanoAddressKeyCmdArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser CardanoAddressKeyType
pCardanoAddressKeyType
      Parser
  (SigningKeyFile 'In
   -> File () 'Out -> KeyConvertCardanoAddressKeyCmdArgs)
-> Parser (SigningKeyFile 'In)
-> Parser (File () 'Out -> KeyConvertCardanoAddressKeyCmdArgs)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (SigningKeyFile 'In)
pSigningKeyFileIn
      Parser (File () 'Out -> KeyConvertCardanoAddressKeyCmdArgs)
-> Parser (File () 'Out)
-> Parser KeyConvertCardanoAddressKeyCmdArgs
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (File () 'Out)
forall content. Parser (File content 'Out)
pOutputFile

pCardanoAddressKeyType :: Parser CardanoAddressKeyType
pCardanoAddressKeyType :: Parser CardanoAddressKeyType
pCardanoAddressKeyType =
  [Parser CardanoAddressKeyType] -> Parser CardanoAddressKeyType
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ CardanoAddressKeyType
-> Mod FlagFields CardanoAddressKeyType
-> Parser CardanoAddressKeyType
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' CardanoAddressKeyType
CardanoAddressCommitteeColdKey (Mod FlagFields CardanoAddressKeyType
 -> Parser CardanoAddressKeyType)
-> Mod FlagFields CardanoAddressKeyType
-> Parser CardanoAddressKeyType
forall a b. (a -> b) -> a -> b
$
        [Mod FlagFields CardanoAddressKeyType]
-> Mod FlagFields CardanoAddressKeyType
forall a. Monoid a => [a] -> a
mconcat
          [ String -> Mod FlagFields CardanoAddressKeyType
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"cc-cold-key"
          , String -> Mod FlagFields CardanoAddressKeyType
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use a committee cold key."
          ]
    , CardanoAddressKeyType
-> Mod FlagFields CardanoAddressKeyType
-> Parser CardanoAddressKeyType
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' CardanoAddressKeyType
CardanoAddressCommitteeHotKey (Mod FlagFields CardanoAddressKeyType
 -> Parser CardanoAddressKeyType)
-> Mod FlagFields CardanoAddressKeyType
-> Parser CardanoAddressKeyType
forall a b. (a -> b) -> a -> b
$
        [Mod FlagFields CardanoAddressKeyType]
-> Mod FlagFields CardanoAddressKeyType
forall a. Monoid a => [a] -> a
mconcat
          [ String -> Mod FlagFields CardanoAddressKeyType
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"cc-hot-key"
          , String -> Mod FlagFields CardanoAddressKeyType
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use a committee hot key."
          ]
    , CardanoAddressKeyType
-> Mod FlagFields CardanoAddressKeyType
-> Parser CardanoAddressKeyType
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' CardanoAddressKeyType
CardanoAddressDRepKey (Mod FlagFields CardanoAddressKeyType
 -> Parser CardanoAddressKeyType)
-> Mod FlagFields CardanoAddressKeyType
-> Parser CardanoAddressKeyType
forall a b. (a -> b) -> a -> b
$
        [Mod FlagFields CardanoAddressKeyType]
-> Mod FlagFields CardanoAddressKeyType
forall a. Monoid a => [a] -> a
mconcat
          [ String -> Mod FlagFields CardanoAddressKeyType
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"drep-key"
          , String -> Mod FlagFields CardanoAddressKeyType
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use a DRep key."
          ]
    , CardanoAddressKeyType
-> Mod FlagFields CardanoAddressKeyType
-> Parser CardanoAddressKeyType
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' CardanoAddressKeyType
CardanoAddressShelleyPaymentKey (Mod FlagFields CardanoAddressKeyType
 -> Parser CardanoAddressKeyType)
-> Mod FlagFields CardanoAddressKeyType
-> Parser CardanoAddressKeyType
forall a b. (a -> b) -> a -> b
$
        [Mod FlagFields CardanoAddressKeyType]
-> Mod FlagFields CardanoAddressKeyType
forall a. Monoid a => [a] -> a
mconcat
          [ String -> Mod FlagFields CardanoAddressKeyType
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"shelley-payment-key"
          , String -> Mod FlagFields CardanoAddressKeyType
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use a Shelley-era extended payment key."
          ]
    , CardanoAddressKeyType
-> Mod FlagFields CardanoAddressKeyType
-> Parser CardanoAddressKeyType
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' CardanoAddressKeyType
CardanoAddressShelleyStakeKey (Mod FlagFields CardanoAddressKeyType
 -> Parser CardanoAddressKeyType)
-> Mod FlagFields CardanoAddressKeyType
-> Parser CardanoAddressKeyType
forall a b. (a -> b) -> a -> b
$
        [Mod FlagFields CardanoAddressKeyType]
-> Mod FlagFields CardanoAddressKeyType
forall a. Monoid a => [a] -> a
mconcat
          [ String -> Mod FlagFields CardanoAddressKeyType
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"shelley-stake-key"
          , String -> Mod FlagFields CardanoAddressKeyType
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use a Shelley-era extended stake key."
          ]
    , CardanoAddressKeyType
-> Mod FlagFields CardanoAddressKeyType
-> Parser CardanoAddressKeyType
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' CardanoAddressKeyType
CardanoAddressIcarusPaymentKey (Mod FlagFields CardanoAddressKeyType
 -> Parser CardanoAddressKeyType)
-> Mod FlagFields CardanoAddressKeyType
-> Parser CardanoAddressKeyType
forall a b. (a -> b) -> a -> b
$
        [Mod FlagFields CardanoAddressKeyType]
-> Mod FlagFields CardanoAddressKeyType
forall a. Monoid a => [a] -> a
mconcat
          [ String -> Mod FlagFields CardanoAddressKeyType
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"icarus-payment-key"
          , String -> Mod FlagFields CardanoAddressKeyType
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use a Byron-era extended payment key formatted in the Icarus style."
          ]
    , CardanoAddressKeyType
-> Mod FlagFields CardanoAddressKeyType
-> Parser CardanoAddressKeyType
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' CardanoAddressKeyType
CardanoAddressByronPaymentKey (Mod FlagFields CardanoAddressKeyType
 -> Parser CardanoAddressKeyType)
-> Mod FlagFields CardanoAddressKeyType
-> Parser CardanoAddressKeyType
forall a b. (a -> b) -> a -> b
$
        [Mod FlagFields CardanoAddressKeyType]
-> Mod FlagFields CardanoAddressKeyType
forall a. Monoid a => [a] -> a
mconcat
          [ String -> Mod FlagFields CardanoAddressKeyType
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"byron-payment-key"
          , String -> Mod FlagFields CardanoAddressKeyType
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use a Byron-era extended payment key formatted in the deprecated Byron style."
          ]
    ]