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

module Bcc.CLI.Sophie.Parsers
  ( -- * CLI command parser
    parseSophieCommands

    -- * CLI command and flag types
  , module Bcc.CLI.Sophie.Commands

    -- * Field parser and renderers
  , parseTxIn
  , renderTxIn
  ) where

import           Bcc.Prelude hiding (All, Any, option)
import           Prelude (String)

import           Bcc.Api
import           Bcc.Api.Sophie

import           Bcc.CLI.Jen.ValueParser (parseValue)
import           Bcc.CLI.Sophie.Commands
import           Bcc.CLI.Sophie.Key (InputFormat (..), PaymentVerifier (..),
                   StakeVerifier (..), VerificationKeyOrFile (..), VerificationKeyOrHashOrFile (..),
                   VerificationKeyTextOrFile (..), deserialiseInput, renderInputDecodeError)
import           Bcc.CLI.Types
import qualified Bcc.Ledger.BaseTypes as Sophie
import           Control.Monad.Fail (fail)
import           Data.Time.Clock (UTCTime)
import           Data.Time.Format (defaultTimeLocale, iso8601DateFormat, parseTimeOrError)
import           Network.Socket (PortNumber)
import           Options.Applicative hiding (help, str)
import           Shardagnostic.Consensus.BlockchainTime (SystemStart (..))
import           Prettyprinter (line, pretty)

import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Char8 as BSC
import qualified Data.IP as IP
import qualified Data.List.NonEmpty as NE
import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text

import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Parser as Aeson.Parser
import qualified Data.Attoparsec.ByteString.Char8 as Atto
import qualified Options.Applicative as Opt
import qualified Options.Applicative.Help as H
import qualified Text.Parsec as Parsec
import qualified Text.Parsec.Error as Parsec
import qualified Text.Parsec.Language as Parsec
import qualified Text.Parsec.String as Parsec
import qualified Text.Parsec.Token as Parsec

import qualified Sophie.Spec.Ledger.TxBody as Sophie

{- HLINT ignore "Use <$>" -}

--
-- Sophie CLI command parsers
--

parseSophieCommands :: Parser SophieCommand
parseSophieCommands :: Parser SophieCommand
parseSophieCommands =
  Mod CommandFields SophieCommand -> Parser SophieCommand
forall a. Mod CommandFields a -> Parser a
Opt.hsubparser (Mod CommandFields SophieCommand -> Parser SophieCommand)
-> Mod CommandFields SophieCommand -> Parser SophieCommand
forall a b. (a -> b) -> a -> b
$
    [Mod CommandFields SophieCommand]
-> Mod CommandFields SophieCommand
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod CommandFields SophieCommand
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"Era based commands"
      , String -> Mod CommandFields SophieCommand
forall a. String -> Mod CommandFields a
Opt.commandGroup String
"Era based commands"
      , String
-> ParserInfo SophieCommand -> Mod CommandFields SophieCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
Opt.command String
"address"
          (Parser SophieCommand
-> InfoMod SophieCommand -> ParserInfo SophieCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (AddressCmd -> SophieCommand
AddressCmd (AddressCmd -> SophieCommand)
-> Parser AddressCmd -> Parser SophieCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser AddressCmd
pAddressCmd) (InfoMod SophieCommand -> ParserInfo SophieCommand)
-> InfoMod SophieCommand -> ParserInfo SophieCommand
forall a b. (a -> b) -> a -> b
$ String -> InfoMod SophieCommand
forall a. String -> InfoMod a
Opt.progDesc String
"Payment address commands")
      , String
-> ParserInfo SophieCommand -> Mod CommandFields SophieCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
Opt.command String
"stake-address"
          (Parser SophieCommand
-> InfoMod SophieCommand -> ParserInfo SophieCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (StakeAddressCmd -> SophieCommand
StakeAddressCmd (StakeAddressCmd -> SophieCommand)
-> Parser StakeAddressCmd -> Parser SophieCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser StakeAddressCmd
pStakeAddressCmd) (InfoMod SophieCommand -> ParserInfo SophieCommand)
-> InfoMod SophieCommand -> ParserInfo SophieCommand
forall a b. (a -> b) -> a -> b
$ String -> InfoMod SophieCommand
forall a. String -> InfoMod a
Opt.progDesc String
"Stake address commands")
      , String
-> ParserInfo SophieCommand -> Mod CommandFields SophieCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
Opt.command String
"key"
          (Parser SophieCommand
-> InfoMod SophieCommand -> ParserInfo SophieCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (KeyCmd -> SophieCommand
KeyCmd (KeyCmd -> SophieCommand) -> Parser KeyCmd -> Parser SophieCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser KeyCmd
pKeyCmd) (InfoMod SophieCommand -> ParserInfo SophieCommand)
-> InfoMod SophieCommand -> ParserInfo SophieCommand
forall a b. (a -> b) -> a -> b
$ String -> InfoMod SophieCommand
forall a. String -> InfoMod a
Opt.progDesc String
"Key utility commands")
      , String
-> ParserInfo SophieCommand -> Mod CommandFields SophieCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
Opt.command String
"transaction"
          (Parser SophieCommand
-> InfoMod SophieCommand -> ParserInfo SophieCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (TransactionCmd -> SophieCommand
TransactionCmd (TransactionCmd -> SophieCommand)
-> Parser TransactionCmd -> Parser SophieCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TransactionCmd
pTransaction) (InfoMod SophieCommand -> ParserInfo SophieCommand)
-> InfoMod SophieCommand -> ParserInfo SophieCommand
forall a b. (a -> b) -> a -> b
$ String -> InfoMod SophieCommand
forall a. String -> InfoMod a
Opt.progDesc String
"Transaction commands")
      , String
-> ParserInfo SophieCommand -> Mod CommandFields SophieCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
Opt.command String
"node"
          (Parser SophieCommand
-> InfoMod SophieCommand -> ParserInfo SophieCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (NodeCmd -> SophieCommand
NodeCmd (NodeCmd -> SophieCommand)
-> Parser NodeCmd -> Parser SophieCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser NodeCmd
pNodeCmd) (InfoMod SophieCommand -> ParserInfo SophieCommand)
-> InfoMod SophieCommand -> ParserInfo SophieCommand
forall a b. (a -> b) -> a -> b
$ String -> InfoMod SophieCommand
forall a. String -> InfoMod a
Opt.progDesc String
"Node operation commands")
      , String
-> ParserInfo SophieCommand -> Mod CommandFields SophieCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
Opt.command String
"stake-pool"
          (Parser SophieCommand
-> InfoMod SophieCommand -> ParserInfo SophieCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (PoolCmd -> SophieCommand
PoolCmd (PoolCmd -> SophieCommand)
-> Parser PoolCmd -> Parser SophieCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PoolCmd
pPoolCmd) (InfoMod SophieCommand -> ParserInfo SophieCommand)
-> InfoMod SophieCommand -> ParserInfo SophieCommand
forall a b. (a -> b) -> a -> b
$ String -> InfoMod SophieCommand
forall a. String -> InfoMod a
Opt.progDesc String
"Stake pool commands")
      , String
-> ParserInfo SophieCommand -> Mod CommandFields SophieCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
Opt.command String
"query"
          (Parser SophieCommand
-> InfoMod SophieCommand -> ParserInfo SophieCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (QueryCmd -> SophieCommand
QueryCmd (QueryCmd -> SophieCommand)
-> Parser QueryCmd -> Parser SophieCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser QueryCmd
pQueryCmd) (InfoMod SophieCommand -> ParserInfo SophieCommand)
-> (String -> InfoMod SophieCommand)
-> String
-> ParserInfo SophieCommand
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> InfoMod SophieCommand
forall a. String -> InfoMod a
Opt.progDesc (String -> ParserInfo SophieCommand)
-> String -> ParserInfo SophieCommand
forall a b. (a -> b) -> a -> b
$
             [String] -> String
forall a. Monoid a => [a] -> a
mconcat
               [ String
"Node query commands. Will query the local node whose Unix domain socket "
               , String
"is obtained from the BCC_NODE_SOCKET_PATH enviromnent variable."
               ]
            )
      , String
-> ParserInfo SophieCommand -> Mod CommandFields SophieCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
Opt.command String
"genesis"
          (Parser SophieCommand
-> InfoMod SophieCommand -> ParserInfo SophieCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (GenesisCmd -> SophieCommand
GenesisCmd (GenesisCmd -> SophieCommand)
-> Parser GenesisCmd -> Parser SophieCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser GenesisCmd
pGenesisCmd) (InfoMod SophieCommand -> ParserInfo SophieCommand)
-> InfoMod SophieCommand -> ParserInfo SophieCommand
forall a b. (a -> b) -> a -> b
$ String -> InfoMod SophieCommand
forall a. String -> InfoMod a
Opt.progDesc String
"Genesis block commands")
      , String
-> ParserInfo SophieCommand -> Mod CommandFields SophieCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
Opt.command String
"governance"
          (Parser SophieCommand
-> InfoMod SophieCommand -> ParserInfo SophieCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (GovernanceCmd -> SophieCommand
GovernanceCmd (GovernanceCmd -> SophieCommand)
-> Parser GovernanceCmd -> Parser SophieCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser GovernanceCmd
pGovernanceCmd) (InfoMod SophieCommand -> ParserInfo SophieCommand)
-> InfoMod SophieCommand -> ParserInfo SophieCommand
forall a b. (a -> b) -> a -> b
$ String -> InfoMod SophieCommand
forall a. String -> InfoMod a
Opt.progDesc String
"Governance commands")
      , String
-> ParserInfo SophieCommand -> Mod CommandFields SophieCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
Opt.command String
"text-view"
          (Parser SophieCommand
-> InfoMod SophieCommand -> ParserInfo SophieCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (TextViewCmd -> SophieCommand
TextViewCmd (TextViewCmd -> SophieCommand)
-> Parser TextViewCmd -> Parser SophieCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TextViewCmd
pTextViewCmd) (InfoMod SophieCommand -> ParserInfo SophieCommand)
-> (String -> InfoMod SophieCommand)
-> String
-> ParserInfo SophieCommand
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> InfoMod SophieCommand
forall a. String -> InfoMod a
Opt.progDesc (String -> ParserInfo SophieCommand)
-> String -> ParserInfo SophieCommand
forall a b. (a -> b) -> a -> b
$
             [String] -> String
forall a. Monoid a => [a] -> a
mconcat
               [ String
"Commands for dealing with Sophie TextView files. "
               , String
"Transactions, addresses etc are stored on disk as TextView files."
               ]
            )

      ]

pTextViewCmd :: Parser TextViewCmd
pTextViewCmd :: Parser TextViewCmd
pTextViewCmd =
  [Parser TextViewCmd] -> Parser TextViewCmd
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ String -> ParserInfo TextViewCmd -> Parser TextViewCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"decode-cbor"
        (Parser TextViewCmd -> InfoMod TextViewCmd -> ParserInfo TextViewCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (String -> Maybe OutputFile -> TextViewCmd
TextViewInfo (String -> Maybe OutputFile -> TextViewCmd)
-> Parser String -> Parser (Maybe OutputFile -> TextViewCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
pCBORInFile Parser (Maybe OutputFile -> TextViewCmd)
-> Parser (Maybe OutputFile) -> Parser TextViewCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe OutputFile)
pMaybeOutputFile)
          (InfoMod TextViewCmd -> ParserInfo TextViewCmd)
-> InfoMod TextViewCmd -> ParserInfo TextViewCmd
forall a b. (a -> b) -> a -> b
$ String -> InfoMod TextViewCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Print a TextView file as decoded CBOR."
          )
    ]

pCBORInFile :: Parser FilePath
pCBORInFile :: Parser String
pCBORInFile =
  Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
    (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"in-file"
    Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
    Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"CBOR input file."
    Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
    )
  Parser String -> Parser String -> Parser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
    (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"file"
    Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall (f :: * -> *) a. Mod f a
Opt.internal
    )

pAddressCmd :: Parser AddressCmd
pAddressCmd :: Parser AddressCmd
pAddressCmd =
   [Parser AddressCmd] -> Parser AddressCmd
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
     [ String -> ParserInfo AddressCmd -> Parser AddressCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"key-gen"
         (Parser AddressCmd -> InfoMod AddressCmd -> ParserInfo AddressCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser AddressCmd
pAddressKeyGen (InfoMod AddressCmd -> ParserInfo AddressCmd)
-> InfoMod AddressCmd -> ParserInfo AddressCmd
forall a b. (a -> b) -> a -> b
$ String -> InfoMod AddressCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Create an address key pair.")
     , String -> ParserInfo AddressCmd -> Parser AddressCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"key-hash"
         (Parser AddressCmd -> InfoMod AddressCmd -> ParserInfo AddressCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser AddressCmd
pAddressKeyHash (InfoMod AddressCmd -> ParserInfo AddressCmd)
-> InfoMod AddressCmd -> ParserInfo AddressCmd
forall a b. (a -> b) -> a -> b
$ String -> InfoMod AddressCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Print the hash of an address key.")
     , String -> ParserInfo AddressCmd -> Parser AddressCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"build"
         (Parser AddressCmd -> InfoMod AddressCmd -> ParserInfo AddressCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser AddressCmd
pAddressBuild (InfoMod AddressCmd -> ParserInfo AddressCmd)
-> InfoMod AddressCmd -> ParserInfo AddressCmd
forall a b. (a -> b) -> a -> b
$ String -> InfoMod AddressCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Build a Sophie payment address, with optional delegation to a stake address.")
     , String -> ParserInfo AddressCmd -> Parser AddressCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"build-script"
         (Parser AddressCmd -> InfoMod AddressCmd -> ParserInfo AddressCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser AddressCmd
pAddressBuildScript (InfoMod AddressCmd -> ParserInfo AddressCmd)
-> InfoMod AddressCmd -> ParserInfo AddressCmd
forall a b. (a -> b) -> a -> b
$ String -> InfoMod AddressCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Build a Sophie script address. (deprecated; use 'build' instead with '--payment-script-file')")
     , String -> ParserInfo AddressCmd -> Parser AddressCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"info"
         (Parser AddressCmd -> InfoMod AddressCmd -> ParserInfo AddressCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser AddressCmd
pAddressInfo (InfoMod AddressCmd -> ParserInfo AddressCmd)
-> InfoMod AddressCmd -> ParserInfo AddressCmd
forall a b. (a -> b) -> a -> b
$ String -> InfoMod AddressCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Print information about an address.")
     ]
  where
    pAddressKeyGen :: Parser AddressCmd
    pAddressKeyGen :: Parser AddressCmd
pAddressKeyGen = AddressKeyType
-> VerificationKeyFile -> SigningKeyFile -> AddressCmd
AddressKeyGen (AddressKeyType
 -> VerificationKeyFile -> SigningKeyFile -> AddressCmd)
-> Parser AddressKeyType
-> Parser (VerificationKeyFile -> SigningKeyFile -> AddressCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser AddressKeyType
pAddressKeyType
                                   Parser (VerificationKeyFile -> SigningKeyFile -> AddressCmd)
-> Parser VerificationKeyFile
-> Parser (SigningKeyFile -> AddressCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FileDirection -> Parser VerificationKeyFile
pVerificationKeyFile FileDirection
Output
                                   Parser (SigningKeyFile -> AddressCmd)
-> Parser SigningKeyFile -> Parser AddressCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FileDirection -> Parser SigningKeyFile
pSigningKeyFile FileDirection
Output

    pAddressKeyHash :: Parser AddressCmd
    pAddressKeyHash :: Parser AddressCmd
pAddressKeyHash =
      VerificationKeyTextOrFile -> Maybe OutputFile -> AddressCmd
AddressKeyHash
        (VerificationKeyTextOrFile -> Maybe OutputFile -> AddressCmd)
-> Parser VerificationKeyTextOrFile
-> Parser (Maybe OutputFile -> AddressCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VerificationKeyTextOrFile
pPaymentVerificationKeyTextOrFile
        Parser (Maybe OutputFile -> AddressCmd)
-> Parser (Maybe OutputFile) -> Parser AddressCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe OutputFile)
pMaybeOutputFile

    pAddressBuild :: Parser AddressCmd
    pAddressBuild :: Parser AddressCmd
pAddressBuild = PaymentVerifier
-> Maybe StakeVerifier
-> NetworkId
-> Maybe OutputFile
-> AddressCmd
AddressBuild
      (PaymentVerifier
 -> Maybe StakeVerifier
 -> NetworkId
 -> Maybe OutputFile
 -> AddressCmd)
-> Parser PaymentVerifier
-> Parser
     (Maybe StakeVerifier
      -> NetworkId -> Maybe OutputFile -> AddressCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PaymentVerifier
pPaymentVerifier
      Parser
  (Maybe StakeVerifier
   -> NetworkId -> Maybe OutputFile -> AddressCmd)
-> Parser (Maybe StakeVerifier)
-> Parser (NetworkId -> Maybe OutputFile -> AddressCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser StakeVerifier -> Parser (Maybe StakeVerifier)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional Parser StakeVerifier
pStakeVerifier
      Parser (NetworkId -> Maybe OutputFile -> AddressCmd)
-> Parser NetworkId -> Parser (Maybe OutputFile -> AddressCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser NetworkId
pNetworkId
      Parser (Maybe OutputFile -> AddressCmd)
-> Parser (Maybe OutputFile) -> Parser AddressCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe OutputFile)
pMaybeOutputFile

    pAddressBuildScript :: Parser AddressCmd
    pAddressBuildScript :: Parser AddressCmd
pAddressBuildScript = ScriptFile -> NetworkId -> Maybe OutputFile -> AddressCmd
AddressBuildMultiSig
      (ScriptFile -> NetworkId -> Maybe OutputFile -> AddressCmd)
-> Parser ScriptFile
-> Parser (NetworkId -> Maybe OutputFile -> AddressCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ScriptFile
pScript
      Parser (NetworkId -> Maybe OutputFile -> AddressCmd)
-> Parser NetworkId -> Parser (Maybe OutputFile -> AddressCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser NetworkId
pNetworkId
      Parser (Maybe OutputFile -> AddressCmd)
-> Parser (Maybe OutputFile) -> Parser AddressCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe OutputFile)
pMaybeOutputFile

    pAddressInfo :: Parser AddressCmd
    pAddressInfo :: Parser AddressCmd
pAddressInfo = Text -> Maybe OutputFile -> AddressCmd
AddressInfo (Text -> Maybe OutputFile -> AddressCmd)
-> Parser Text -> Parser (Maybe OutputFile -> AddressCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
pAddress Parser (Maybe OutputFile -> AddressCmd)
-> Parser (Maybe OutputFile) -> Parser AddressCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe OutputFile)
pMaybeOutputFile

pPaymentVerifier :: Parser PaymentVerifier
pPaymentVerifier :: Parser PaymentVerifier
pPaymentVerifier =
        VerificationKeyTextOrFile -> PaymentVerifier
PaymentVerifierKey (VerificationKeyTextOrFile -> PaymentVerifier)
-> Parser VerificationKeyTextOrFile -> Parser PaymentVerifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VerificationKeyTextOrFile
pPaymentVerificationKeyTextOrFile
    Parser PaymentVerifier
-> Parser PaymentVerifier -> Parser PaymentVerifier
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ScriptFile -> PaymentVerifier
PaymentVerifierScriptFile (ScriptFile -> PaymentVerifier)
-> Parser ScriptFile -> Parser PaymentVerifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          String -> Maybe String -> String -> Parser ScriptFile
pScriptFor String
"payment-script-file" Maybe String
forall a. Maybe a
Nothing
                     String
"Filepath of the payment script."

pStakeVerifier :: Parser StakeVerifier
pStakeVerifier :: Parser StakeVerifier
pStakeVerifier =
        VerificationKeyOrFile StakeKey -> StakeVerifier
StakeVerifierKey (VerificationKeyOrFile StakeKey -> StakeVerifier)
-> Parser (VerificationKeyOrFile StakeKey) -> Parser StakeVerifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyOrFile StakeKey)
pStakeVerificationKeyOrFile
    Parser StakeVerifier
-> Parser StakeVerifier -> Parser StakeVerifier
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ScriptFile -> StakeVerifier
StakeVerifierScriptFile (ScriptFile -> StakeVerifier)
-> Parser ScriptFile -> Parser StakeVerifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          String -> Maybe String -> String -> Parser ScriptFile
pScriptFor String
"stake-script-file" Maybe String
forall a. Maybe a
Nothing
                     String
"Filepath of the staking script."

pPaymentVerificationKeyTextOrFile :: Parser VerificationKeyTextOrFile
pPaymentVerificationKeyTextOrFile :: Parser VerificationKeyTextOrFile
pPaymentVerificationKeyTextOrFile =
        Text -> VerificationKeyTextOrFile
VktofVerificationKeyText (Text -> VerificationKeyTextOrFile)
-> Parser Text -> Parser VerificationKeyTextOrFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
pPaymentVerificationKeyText
    Parser VerificationKeyTextOrFile
-> Parser VerificationKeyTextOrFile
-> Parser VerificationKeyTextOrFile
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> VerificationKeyFile -> VerificationKeyTextOrFile
VktofVerificationKeyFile (VerificationKeyFile -> VerificationKeyTextOrFile)
-> Parser VerificationKeyFile -> Parser VerificationKeyTextOrFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VerificationKeyFile
pPaymentVerificationKeyFile

pPaymentVerificationKeyText :: Parser Text
pPaymentVerificationKeyText :: Parser Text
pPaymentVerificationKeyText =
  String -> Text
Text.pack (String -> Text) -> Parser String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
      (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"payment-verification-key"
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Payment verification key (Bech32-encoded)"
      )

pPaymentVerificationKeyFile :: Parser VerificationKeyFile
pPaymentVerificationKeyFile :: Parser VerificationKeyFile
pPaymentVerificationKeyFile =
  String -> VerificationKeyFile
VerificationKeyFile (String -> VerificationKeyFile)
-> Parser String -> Parser VerificationKeyFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ( Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
        (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"payment-verification-key-file"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Filepath of the payment verification key."
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
        )
    Parser String -> Parser String -> Parser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
        (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"verification-key-file"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall (f :: * -> *) a. Mod f a
Opt.internal
        )
    )

pScript :: Parser ScriptFile
pScript :: Parser ScriptFile
pScript = String -> Maybe String -> String -> Parser ScriptFile
pScriptFor String
"script-file" Maybe String
forall a. Maybe a
Nothing String
"Filepath of the script."

pScriptFor :: String -> Maybe String -> String -> Parser ScriptFile
pScriptFor :: String -> Maybe String -> String -> Parser ScriptFile
pScriptFor String
name Maybe String
Nothing String
help =
  String -> ScriptFile
ScriptFile (String -> ScriptFile) -> Parser String -> Parser ScriptFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
    (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
name
    Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
    Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
help
    Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
    )

pScriptFor String
name (Just String
deprecated) String
help =
      String -> Maybe String -> String -> Parser ScriptFile
pScriptFor String
name Maybe String
forall a. Maybe a
Nothing String
help
  Parser ScriptFile -> Parser ScriptFile -> Parser ScriptFile
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ScriptFile
ScriptFile (String -> ScriptFile) -> Parser String -> Parser ScriptFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
        (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
deprecated
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall (f :: * -> *) a. Mod f a
Opt.internal
        )

pScriptWitnessFiles :: forall witctx.
                       WitCtx witctx
                    -> BalanceTxExecUnits -- ^ Use the @execution-units@ flag.
                    -> String
                    -> Maybe String
                    -> String
                    -> Parser (ScriptWitnessFiles witctx)
pScriptWitnessFiles :: WitCtx witctx
-> BalanceTxExecUnits
-> String
-> Maybe String
-> String
-> Parser (ScriptWitnessFiles witctx)
pScriptWitnessFiles WitCtx witctx
witctx BalanceTxExecUnits
autoBalanceExecUnits String
scriptFlagPrefix Maybe String
scriptFlagPrefixDeprecated String
help =
    ScriptFile
-> Maybe
     (ScriptDatumOrFile witctx, ScriptRedeemerOrFile, ExecutionUnits)
-> ScriptWitnessFiles witctx
toScriptWitnessFiles
      (ScriptFile
 -> Maybe
      (ScriptDatumOrFile witctx, ScriptRedeemerOrFile, ExecutionUnits)
 -> ScriptWitnessFiles witctx)
-> Parser ScriptFile
-> Parser
     (Maybe
        (ScriptDatumOrFile witctx, ScriptRedeemerOrFile, ExecutionUnits)
      -> ScriptWitnessFiles witctx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe String -> String -> Parser ScriptFile
pScriptFor (String
scriptFlagPrefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-script-file")
                     ((String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-script-file") (String -> String) -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
scriptFlagPrefixDeprecated)
                     (String
"The file containing the script to witness " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
help)
      Parser
  (Maybe
     (ScriptDatumOrFile witctx, ScriptRedeemerOrFile, ExecutionUnits)
   -> ScriptWitnessFiles witctx)
-> Parser
     (Maybe
        (ScriptDatumOrFile witctx, ScriptRedeemerOrFile, ExecutionUnits))
-> Parser (ScriptWitnessFiles witctx)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser
  (ScriptDatumOrFile witctx, ScriptRedeemerOrFile, ExecutionUnits)
-> Parser
     (Maybe
        (ScriptDatumOrFile witctx, ScriptRedeemerOrFile, ExecutionUnits))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ((,,) (ScriptDatumOrFile witctx
 -> ScriptRedeemerOrFile
 -> ExecutionUnits
 -> (ScriptDatumOrFile witctx, ScriptRedeemerOrFile,
     ExecutionUnits))
-> Parser (ScriptDatumOrFile witctx)
-> Parser
     (ScriptRedeemerOrFile
      -> ExecutionUnits
      -> (ScriptDatumOrFile witctx, ScriptRedeemerOrFile,
          ExecutionUnits))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (ScriptDatumOrFile witctx)
pScriptDatumOrFile
                         Parser
  (ScriptRedeemerOrFile
   -> ExecutionUnits
   -> (ScriptDatumOrFile witctx, ScriptRedeemerOrFile,
       ExecutionUnits))
-> Parser ScriptRedeemerOrFile
-> Parser
     (ExecutionUnits
      -> (ScriptDatumOrFile witctx, ScriptRedeemerOrFile,
          ExecutionUnits))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ScriptRedeemerOrFile
pScriptRedeemerOrFile
                         Parser
  (ExecutionUnits
   -> (ScriptDatumOrFile witctx, ScriptRedeemerOrFile,
       ExecutionUnits))
-> Parser ExecutionUnits
-> Parser
     (ScriptDatumOrFile witctx, ScriptRedeemerOrFile, ExecutionUnits)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (case BalanceTxExecUnits
autoBalanceExecUnits of
                               BalanceTxExecUnits
AutoBalance -> ExecutionUnits -> Parser ExecutionUnits
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> Word64 -> ExecutionUnits
ExecutionUnits Word64
0 Word64
0)
                               BalanceTxExecUnits
ManualBalance -> Parser ExecutionUnits
pExecutionUnits)
                   )
  where
    toScriptWitnessFiles :: ScriptFile
                         -> Maybe (ScriptDatumOrFile witctx,
                                   ScriptRedeemerOrFile,
                                   ExecutionUnits)
                         -> ScriptWitnessFiles witctx
    toScriptWitnessFiles :: ScriptFile
-> Maybe
     (ScriptDatumOrFile witctx, ScriptRedeemerOrFile, ExecutionUnits)
-> ScriptWitnessFiles witctx
toScriptWitnessFiles ScriptFile
sf Maybe
  (ScriptDatumOrFile witctx, ScriptRedeemerOrFile, ExecutionUnits)
Nothing        = ScriptFile -> ScriptWitnessFiles witctx
forall witctx. ScriptFile -> ScriptWitnessFiles witctx
SimpleScriptWitnessFile  ScriptFile
sf
    toScriptWitnessFiles ScriptFile
sf (Just (ScriptDatumOrFile witctx
d,ScriptRedeemerOrFile
r, ExecutionUnits
e)) = ScriptFile
-> ScriptDatumOrFile witctx
-> ScriptRedeemerOrFile
-> ExecutionUnits
-> ScriptWitnessFiles witctx
forall witctx.
ScriptFile
-> ScriptDatumOrFile witctx
-> ScriptRedeemerOrFile
-> ExecutionUnits
-> ScriptWitnessFiles witctx
ZerepochScriptWitnessFiles ScriptFile
sf ScriptDatumOrFile witctx
d ScriptRedeemerOrFile
r ExecutionUnits
e

    pScriptDatumOrFile :: Parser (ScriptDatumOrFile witctx)
    pScriptDatumOrFile :: Parser (ScriptDatumOrFile witctx)
pScriptDatumOrFile =
      case WitCtx witctx
witctx of
        WitCtx witctx
WitCtxTxIn  -> ScriptRedeemerOrFile -> ScriptDatumOrFile WitCtxTxIn
ScriptDatumOrFileForTxIn (ScriptRedeemerOrFile -> ScriptDatumOrFile WitCtxTxIn)
-> Parser ScriptRedeemerOrFile
-> Parser (ScriptDatumOrFile WitCtxTxIn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                         String -> Parser ScriptRedeemerOrFile
pScriptDataOrFile (String
scriptFlagPrefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-datum")
        WitCtx witctx
WitCtxMint  -> ScriptDatumOrFile WitCtxMint
-> Parser (ScriptDatumOrFile WitCtxMint)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScriptDatumOrFile WitCtxMint
NoScriptDatumOrFileForMint
        WitCtx witctx
WitCtxStake -> ScriptDatumOrFile WitCtxStake
-> Parser (ScriptDatumOrFile WitCtxStake)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScriptDatumOrFile WitCtxStake
NoScriptDatumOrFileForStake

    pScriptRedeemerOrFile :: Parser ScriptDataOrFile
    pScriptRedeemerOrFile :: Parser ScriptRedeemerOrFile
pScriptRedeemerOrFile = String -> Parser ScriptRedeemerOrFile
pScriptDataOrFile (String
scriptFlagPrefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-redeemer")

    pExecutionUnits :: Parser ExecutionUnits
    pExecutionUnits :: Parser ExecutionUnits
pExecutionUnits =
      (Word64 -> Word64 -> ExecutionUnits)
-> (Word64, Word64) -> ExecutionUnits
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Word64 -> Word64 -> ExecutionUnits
ExecutionUnits ((Word64, Word64) -> ExecutionUnits)
-> Parser (Word64, Word64) -> Parser ExecutionUnits
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        ReadM (Word64, Word64)
-> Mod OptionFields (Word64, Word64) -> Parser (Word64, Word64)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM (Word64, Word64)
forall a. Read a => ReadM a
Opt.auto
          (  String -> Mod OptionFields (Word64, Word64)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long (String
scriptFlagPrefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-execution-units")
          Mod OptionFields (Word64, Word64)
-> Mod OptionFields (Word64, Word64)
-> Mod OptionFields (Word64, Word64)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Word64, Word64)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"(INT, INT)"
          Mod OptionFields (Word64, Word64)
-> Mod OptionFields (Word64, Word64)
-> Mod OptionFields (Word64, Word64)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Word64, Word64)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The time and space units needed by the script."
          )


pScriptDataOrFile :: String -> Parser ScriptDataOrFile
pScriptDataOrFile :: String -> Parser ScriptRedeemerOrFile
pScriptDataOrFile String
dataFlagPrefix =
      String -> ScriptRedeemerOrFile
ScriptDataFile  (String -> ScriptRedeemerOrFile)
-> Parser String -> Parser ScriptRedeemerOrFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
pScriptDataFile
  Parser ScriptRedeemerOrFile
-> Parser ScriptRedeemerOrFile -> Parser ScriptRedeemerOrFile
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ScriptData -> ScriptRedeemerOrFile
ScriptDataValue (ScriptData -> ScriptRedeemerOrFile)
-> Parser ScriptData -> Parser ScriptRedeemerOrFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ScriptData
pScriptDataValue
  where
    pScriptDataFile :: Parser String
pScriptDataFile =
      Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
        (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long (String
dataFlagPrefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-file")
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The JSON file containing the script data."
        )

    pScriptDataValue :: Parser ScriptData
pScriptDataValue =
      ReadM ScriptData
-> Mod OptionFields ScriptData -> Parser ScriptData
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM ScriptData
readerScriptData
        (  String -> Mod OptionFields ScriptData
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long (String
dataFlagPrefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-value")
        Mod OptionFields ScriptData
-> Mod OptionFields ScriptData -> Mod OptionFields ScriptData
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields ScriptData
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"JSON VALUE"
        Mod OptionFields ScriptData
-> Mod OptionFields ScriptData -> Mod OptionFields ScriptData
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields ScriptData
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The JSON value for the script data. Supported JSON data types: string, number, object & array."
        )

    readerScriptData :: ReadM ScriptData
readerScriptData = do
      Value
v <- ReadM Value
readerJSON
      case ScriptDataJsonSchema
-> Value -> Either ScriptDataJsonError ScriptData
scriptDataFromJson ScriptDataJsonSchema
ScriptDataJsonNoSchema Value
v of
        Left ScriptDataJsonError
err -> String -> ReadM ScriptData
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (ScriptDataJsonError -> String
forall e. Error e => e -> String
displayError ScriptDataJsonError
err)
        Right ScriptData
sd -> ScriptData -> ReadM ScriptData
forall (m :: * -> *) a. Monad m => a -> m a
return ScriptData
sd


pStakeAddressCmd :: Parser StakeAddressCmd
pStakeAddressCmd :: Parser StakeAddressCmd
pStakeAddressCmd =
    [Parser StakeAddressCmd] -> Parser StakeAddressCmd
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
      [ String -> ParserInfo StakeAddressCmd -> Parser StakeAddressCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"key-gen"
          (Parser StakeAddressCmd
-> InfoMod StakeAddressCmd -> ParserInfo StakeAddressCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser StakeAddressCmd
pStakeAddressKeyGen (InfoMod StakeAddressCmd -> ParserInfo StakeAddressCmd)
-> InfoMod StakeAddressCmd -> ParserInfo StakeAddressCmd
forall a b. (a -> b) -> a -> b
$ String -> InfoMod StakeAddressCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Create a stake address key pair")
      , String -> ParserInfo StakeAddressCmd -> Parser StakeAddressCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"build"
          (Parser StakeAddressCmd
-> InfoMod StakeAddressCmd -> ParserInfo StakeAddressCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser StakeAddressCmd
pStakeAddressBuild (InfoMod StakeAddressCmd -> ParserInfo StakeAddressCmd)
-> InfoMod StakeAddressCmd -> ParserInfo StakeAddressCmd
forall a b. (a -> b) -> a -> b
$ String -> InfoMod StakeAddressCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Build a stake address")
      , String -> ParserInfo StakeAddressCmd -> Parser StakeAddressCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"key-hash"
          (Parser StakeAddressCmd
-> InfoMod StakeAddressCmd -> ParserInfo StakeAddressCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser StakeAddressCmd
pStakeAddressKeyHash (InfoMod StakeAddressCmd -> ParserInfo StakeAddressCmd)
-> InfoMod StakeAddressCmd -> ParserInfo StakeAddressCmd
forall a b. (a -> b) -> a -> b
$ String -> InfoMod StakeAddressCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Print the hash of a stake address key.")
      , String -> ParserInfo StakeAddressCmd -> Parser StakeAddressCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"registration-certificate"
          (Parser StakeAddressCmd
-> InfoMod StakeAddressCmd -> ParserInfo StakeAddressCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser StakeAddressCmd
pStakeAddressRegistrationCert (InfoMod StakeAddressCmd -> ParserInfo StakeAddressCmd)
-> InfoMod StakeAddressCmd -> ParserInfo StakeAddressCmd
forall a b. (a -> b) -> a -> b
$ String -> InfoMod StakeAddressCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Create a stake address registration certificate")
      , String -> ParserInfo StakeAddressCmd -> Parser StakeAddressCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"deregistration-certificate"
          (Parser StakeAddressCmd
-> InfoMod StakeAddressCmd -> ParserInfo StakeAddressCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser StakeAddressCmd
pStakeAddressDeregistrationCert (InfoMod StakeAddressCmd -> ParserInfo StakeAddressCmd)
-> InfoMod StakeAddressCmd -> ParserInfo StakeAddressCmd
forall a b. (a -> b) -> a -> b
$ String -> InfoMod StakeAddressCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Create a stake address deregistration certificate")
      , String -> ParserInfo StakeAddressCmd -> Parser StakeAddressCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"delegation-certificate"
          (Parser StakeAddressCmd
-> InfoMod StakeAddressCmd -> ParserInfo StakeAddressCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser StakeAddressCmd
pStakeAddressDelegationCert (InfoMod StakeAddressCmd -> ParserInfo StakeAddressCmd)
-> InfoMod StakeAddressCmd -> ParserInfo StakeAddressCmd
forall a b. (a -> b) -> a -> b
$ String -> InfoMod StakeAddressCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Create a stake address delegation certificate")
      ]
  where
    pStakeAddressKeyGen :: Parser StakeAddressCmd
    pStakeAddressKeyGen :: Parser StakeAddressCmd
pStakeAddressKeyGen = VerificationKeyFile -> SigningKeyFile -> StakeAddressCmd
StakeAddressKeyGen
                            (VerificationKeyFile -> SigningKeyFile -> StakeAddressCmd)
-> Parser VerificationKeyFile
-> Parser (SigningKeyFile -> StakeAddressCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileDirection -> Parser VerificationKeyFile
pVerificationKeyFile FileDirection
Output
                            Parser (SigningKeyFile -> StakeAddressCmd)
-> Parser SigningKeyFile -> Parser StakeAddressCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FileDirection -> Parser SigningKeyFile
pSigningKeyFile FileDirection
Output

    pStakeAddressKeyHash :: Parser StakeAddressCmd
    pStakeAddressKeyHash :: Parser StakeAddressCmd
pStakeAddressKeyHash = VerificationKeyOrFile StakeKey
-> Maybe OutputFile -> StakeAddressCmd
StakeAddressKeyHash (VerificationKeyOrFile StakeKey
 -> Maybe OutputFile -> StakeAddressCmd)
-> Parser (VerificationKeyOrFile StakeKey)
-> Parser (Maybe OutputFile -> StakeAddressCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyOrFile StakeKey)
pStakeVerificationKeyOrFile Parser (Maybe OutputFile -> StakeAddressCmd)
-> Parser (Maybe OutputFile) -> Parser StakeAddressCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe OutputFile)
pMaybeOutputFile

    pStakeAddressBuild :: Parser StakeAddressCmd
    pStakeAddressBuild :: Parser StakeAddressCmd
pStakeAddressBuild = VerificationKeyOrFile StakeKey
-> NetworkId -> Maybe OutputFile -> StakeAddressCmd
StakeAddressBuild (VerificationKeyOrFile StakeKey
 -> NetworkId -> Maybe OutputFile -> StakeAddressCmd)
-> Parser (VerificationKeyOrFile StakeKey)
-> Parser (NetworkId -> Maybe OutputFile -> StakeAddressCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyOrFile StakeKey)
pStakeVerificationKeyOrFile
                                           Parser (NetworkId -> Maybe OutputFile -> StakeAddressCmd)
-> Parser NetworkId -> Parser (Maybe OutputFile -> StakeAddressCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser NetworkId
pNetworkId
                                           Parser (Maybe OutputFile -> StakeAddressCmd)
-> Parser (Maybe OutputFile) -> Parser StakeAddressCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe OutputFile)
pMaybeOutputFile

    pStakeAddressRegistrationCert :: Parser StakeAddressCmd
    pStakeAddressRegistrationCert :: Parser StakeAddressCmd
pStakeAddressRegistrationCert = StakeVerifier -> OutputFile -> StakeAddressCmd
StakeRegistrationCert
                                      (StakeVerifier -> OutputFile -> StakeAddressCmd)
-> Parser StakeVerifier -> Parser (OutputFile -> StakeAddressCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser StakeVerifier
pStakeVerifier
                                      Parser (OutputFile -> StakeAddressCmd)
-> Parser OutputFile -> Parser StakeAddressCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser OutputFile
pOutputFile

    pStakeAddressDeregistrationCert :: Parser StakeAddressCmd
    pStakeAddressDeregistrationCert :: Parser StakeAddressCmd
pStakeAddressDeregistrationCert = StakeVerifier -> OutputFile -> StakeAddressCmd
StakeCredentialDeRegistrationCert
                                        (StakeVerifier -> OutputFile -> StakeAddressCmd)
-> Parser StakeVerifier -> Parser (OutputFile -> StakeAddressCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser StakeVerifier
pStakeVerifier
                                        Parser (OutputFile -> StakeAddressCmd)
-> Parser OutputFile -> Parser StakeAddressCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser OutputFile
pOutputFile

    pStakeAddressDelegationCert :: Parser StakeAddressCmd
    pStakeAddressDelegationCert :: Parser StakeAddressCmd
pStakeAddressDelegationCert = StakeVerifier
-> VerificationKeyOrHashOrFile StakePoolKey
-> OutputFile
-> StakeAddressCmd
StakeCredentialDelegationCert
                                    (StakeVerifier
 -> VerificationKeyOrHashOrFile StakePoolKey
 -> OutputFile
 -> StakeAddressCmd)
-> Parser StakeVerifier
-> Parser
     (VerificationKeyOrHashOrFile StakePoolKey
      -> OutputFile -> StakeAddressCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser StakeVerifier
pStakeVerifier
                                    Parser
  (VerificationKeyOrHashOrFile StakePoolKey
   -> OutputFile -> StakeAddressCmd)
-> Parser (VerificationKeyOrHashOrFile StakePoolKey)
-> Parser (OutputFile -> StakeAddressCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (VerificationKeyOrHashOrFile StakePoolKey)
pStakePoolVerificationKeyOrHashOrFile
                                    Parser (OutputFile -> StakeAddressCmd)
-> Parser OutputFile -> Parser StakeAddressCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser OutputFile
pOutputFile

pKeyCmd :: Parser KeyCmd
pKeyCmd :: Parser KeyCmd
pKeyCmd =
  [Parser KeyCmd] -> Parser KeyCmd
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ String -> ParserInfo KeyCmd -> Parser KeyCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"verification-key" (ParserInfo KeyCmd -> Parser KeyCmd)
-> ParserInfo KeyCmd -> Parser KeyCmd
forall a b. (a -> b) -> a -> b
$
        Parser KeyCmd -> InfoMod KeyCmd -> ParserInfo KeyCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser KeyCmd
pKeyGetVerificationKey (InfoMod KeyCmd -> ParserInfo KeyCmd)
-> InfoMod KeyCmd -> ParserInfo KeyCmd
forall a b. (a -> b) -> a -> b
$
          String -> InfoMod KeyCmd
forall a. String -> InfoMod a
Opt.progDesc (String -> InfoMod KeyCmd) -> String -> InfoMod KeyCmd
forall a b. (a -> b) -> a -> b
$ String
"Get a verification key from a signing key. This "
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" supports all key types."
    , String -> ParserInfo KeyCmd -> Parser KeyCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"non-extended-key" (ParserInfo KeyCmd -> Parser KeyCmd)
-> ParserInfo KeyCmd -> Parser KeyCmd
forall a b. (a -> b) -> a -> b
$
        Parser KeyCmd -> InfoMod KeyCmd -> ParserInfo KeyCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser KeyCmd
pKeyNonExtendedKey (InfoMod KeyCmd -> ParserInfo KeyCmd)
-> InfoMod KeyCmd -> ParserInfo KeyCmd
forall a b. (a -> b) -> a -> b
$
          String -> InfoMod KeyCmd
forall a. String -> InfoMod a
Opt.progDesc (String -> InfoMod KeyCmd) -> String -> InfoMod KeyCmd
forall a b. (a -> b) -> a -> b
$ String
"Get a non-extended verification key from an "
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"extended verification key. This supports all "
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"extended key types."
    , String -> ParserInfo KeyCmd -> Parser KeyCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"convert-cole-key" (ParserInfo KeyCmd -> Parser KeyCmd)
-> ParserInfo KeyCmd -> Parser KeyCmd
forall a b. (a -> b) -> a -> b
$
        Parser KeyCmd -> InfoMod KeyCmd -> ParserInfo KeyCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser KeyCmd
pKeyConvertColeKey (InfoMod KeyCmd -> ParserInfo KeyCmd)
-> InfoMod KeyCmd -> ParserInfo KeyCmd
forall a b. (a -> b) -> a -> b
$
          String -> InfoMod KeyCmd
forall a. String -> InfoMod a
Opt.progDesc (String -> InfoMod KeyCmd) -> String -> InfoMod KeyCmd
forall a b. (a -> b) -> a -> b
$ String
"Convert a Cole payment, genesis or genesis "
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"delegate key (signing or verification) to a "
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"corresponding Sophie-format key."
    , String -> ParserInfo KeyCmd -> Parser KeyCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"convert-cole-genesis-vkey" (ParserInfo KeyCmd -> Parser KeyCmd)
-> ParserInfo KeyCmd -> Parser KeyCmd
forall a b. (a -> b) -> a -> b
$
        Parser KeyCmd -> InfoMod KeyCmd -> ParserInfo KeyCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser KeyCmd
pKeyConvertColeGenesisVKey (InfoMod KeyCmd -> ParserInfo KeyCmd)
-> InfoMod KeyCmd -> ParserInfo KeyCmd
forall a b. (a -> b) -> a -> b
$
          String -> InfoMod KeyCmd
forall a. String -> InfoMod a
Opt.progDesc (String -> InfoMod KeyCmd) -> String -> InfoMod KeyCmd
forall a b. (a -> b) -> a -> b
$ String
"Convert a Base64-encoded Cole genesis "
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"verification key to a Sophie genesis "
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"verification key"
    , String -> ParserInfo KeyCmd -> Parser KeyCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"convert-cole-vested-vkey" (ParserInfo KeyCmd -> Parser KeyCmd)
-> ParserInfo KeyCmd -> Parser KeyCmd
forall a b. (a -> b) -> a -> b
$
        Parser KeyCmd -> InfoMod KeyCmd -> ParserInfo KeyCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser KeyCmd
pKeyConvertColeVestedVKey (InfoMod KeyCmd -> ParserInfo KeyCmd)
-> InfoMod KeyCmd -> ParserInfo KeyCmd
forall a b. (a -> b) -> a -> b
$
          String -> InfoMod KeyCmd
forall a. String -> InfoMod a
Opt.progDesc (String -> InfoMod KeyCmd) -> String -> InfoMod KeyCmd
forall a b. (a -> b) -> a -> b
$ String
"Convert a Base64-encoded Cole vested "
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"verification key to a Sophie vested "
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"verification key"
    , String -> ParserInfo KeyCmd -> Parser KeyCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"convert-itn-key" (ParserInfo KeyCmd -> Parser KeyCmd)
-> ParserInfo KeyCmd -> Parser KeyCmd
forall a b. (a -> b) -> a -> b
$
        Parser KeyCmd -> InfoMod KeyCmd -> ParserInfo KeyCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser KeyCmd
pKeyConvertITNKey (InfoMod KeyCmd -> ParserInfo KeyCmd)
-> InfoMod KeyCmd -> ParserInfo KeyCmd
forall a b. (a -> b) -> a -> b
$
          String -> InfoMod KeyCmd
forall a. String -> InfoMod a
Opt.progDesc (String -> InfoMod KeyCmd) -> String -> InfoMod KeyCmd
forall a b. (a -> b) -> a -> b
$ String
"Convert an Incentivized Testnet (ITN) non-extended "
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(Ed25519) signing or verification key to a "
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"corresponding Sophie stake key"
    , String -> ParserInfo KeyCmd -> Parser KeyCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"convert-itn-extended-key" (ParserInfo KeyCmd -> Parser KeyCmd)
-> ParserInfo KeyCmd -> Parser KeyCmd
forall a b. (a -> b) -> a -> b
$
        Parser KeyCmd -> InfoMod KeyCmd -> ParserInfo KeyCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser KeyCmd
pKeyConvertITNExtendedKey (InfoMod KeyCmd -> ParserInfo KeyCmd)
-> InfoMod KeyCmd -> ParserInfo KeyCmd
forall a b. (a -> b) -> a -> b
$
          String -> InfoMod KeyCmd
forall a. String -> InfoMod a
Opt.progDesc (String -> InfoMod KeyCmd) -> String -> InfoMod KeyCmd
forall a b. (a -> b) -> a -> b
$ String
"Convert an Incentivized Testnet (ITN) extended "
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(Ed25519Extended) signing key to a corresponding "
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Sophie stake signing key"
    , String -> ParserInfo KeyCmd -> Parser KeyCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"convert-itn-bip32-key" (ParserInfo KeyCmd -> Parser KeyCmd)
-> ParserInfo KeyCmd -> Parser KeyCmd
forall a b. (a -> b) -> a -> b
$
        Parser KeyCmd -> InfoMod KeyCmd -> ParserInfo KeyCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser KeyCmd
pKeyConvertITNBip32Key (InfoMod KeyCmd -> ParserInfo KeyCmd)
-> InfoMod KeyCmd -> ParserInfo KeyCmd
forall a b. (a -> b) -> a -> b
$
          String -> InfoMod KeyCmd
forall a. String -> InfoMod a
Opt.progDesc (String -> InfoMod KeyCmd) -> String -> InfoMod KeyCmd
forall a b. (a -> b) -> a -> b
$ String
"Convert an Incentivized Testnet (ITN) BIP32 "
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(Ed25519Bip32) signing key to a corresponding "
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Sophie stake signing key"
    , String -> ParserInfo KeyCmd -> Parser KeyCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"convert-bcc-address-key" (ParserInfo KeyCmd -> Parser KeyCmd)
-> ParserInfo KeyCmd -> Parser KeyCmd
forall a b. (a -> b) -> a -> b
$
        Parser KeyCmd -> InfoMod KeyCmd -> ParserInfo KeyCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser KeyCmd
pKeyConvertBccAddressSigningKey (InfoMod KeyCmd -> ParserInfo KeyCmd)
-> InfoMod KeyCmd -> ParserInfo KeyCmd
forall a b. (a -> b) -> a -> b
$
          String -> InfoMod KeyCmd
forall a. String -> InfoMod a
Opt.progDesc (String -> InfoMod KeyCmd) -> String -> InfoMod KeyCmd
forall a b. (a -> b) -> a -> b
$ String
"Convert a bcc-address extended signing key "
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"to a corresponding Sophie-format key."
    ]
  where
    pKeyGetVerificationKey :: Parser KeyCmd
    pKeyGetVerificationKey :: Parser KeyCmd
pKeyGetVerificationKey =
      SigningKeyFile -> VerificationKeyFile -> KeyCmd
KeyGetVerificationKey
        (SigningKeyFile -> VerificationKeyFile -> KeyCmd)
-> Parser SigningKeyFile -> Parser (VerificationKeyFile -> KeyCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileDirection -> Parser SigningKeyFile
pSigningKeyFile      FileDirection
Input
        Parser (VerificationKeyFile -> KeyCmd)
-> Parser VerificationKeyFile -> Parser KeyCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FileDirection -> Parser VerificationKeyFile
pVerificationKeyFile FileDirection
Output

    pKeyNonExtendedKey :: Parser KeyCmd
    pKeyNonExtendedKey :: Parser KeyCmd
pKeyNonExtendedKey =
      VerificationKeyFile -> VerificationKeyFile -> KeyCmd
KeyNonExtendedKey
        (VerificationKeyFile -> VerificationKeyFile -> KeyCmd)
-> Parser VerificationKeyFile
-> Parser (VerificationKeyFile -> KeyCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileDirection -> Parser VerificationKeyFile
pExtendedVerificationKeyFile FileDirection
Input
        Parser (VerificationKeyFile -> KeyCmd)
-> Parser VerificationKeyFile -> Parser KeyCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FileDirection -> Parser VerificationKeyFile
pVerificationKeyFile FileDirection
Output

    pKeyConvertColeKey :: Parser KeyCmd
    pKeyConvertColeKey :: Parser KeyCmd
pKeyConvertColeKey =
      Maybe Text -> ColeKeyType -> SomeKeyFile -> OutputFile -> KeyCmd
KeyConvertColeKey
        (Maybe Text -> ColeKeyType -> SomeKeyFile -> OutputFile -> KeyCmd)
-> Parser (Maybe Text)
-> Parser (ColeKeyType -> SomeKeyFile -> OutputFile -> KeyCmd)
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 (ColeKeyType -> SomeKeyFile -> OutputFile -> KeyCmd)
-> Parser ColeKeyType
-> Parser (SomeKeyFile -> OutputFile -> KeyCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ColeKeyType
pColeKeyType
        Parser (SomeKeyFile -> OutputFile -> KeyCmd)
-> Parser SomeKeyFile -> Parser (OutputFile -> KeyCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SomeKeyFile
pColeKeyFile
        Parser (OutputFile -> KeyCmd) -> Parser OutputFile -> Parser KeyCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser OutputFile
pOutputFile

    pPassword :: Parser Text
    pPassword :: Parser Text
pPassword = Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
                  (  String -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"password"
                  Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"TEXT"
                  Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Password for signing key (if applicable)."
                  )

    pColeKeyType :: Parser ColeKeyType
    pColeKeyType :: Parser ColeKeyType
pColeKeyType =
          ColeKeyType -> Mod FlagFields ColeKeyType -> Parser ColeKeyType
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' (ColeKeyFormat -> ColeKeyType
ColePaymentKey ColeKeyFormat
NonLegacyColeKeyFormat)
            (  String -> Mod FlagFields ColeKeyType
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"cole-payment-key-type"
            Mod FlagFields ColeKeyType
-> Mod FlagFields ColeKeyType -> Mod FlagFields ColeKeyType
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields ColeKeyType
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use a Cole-era payment key."
            )
      Parser ColeKeyType -> Parser ColeKeyType -> Parser ColeKeyType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ColeKeyType -> Mod FlagFields ColeKeyType -> Parser ColeKeyType
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' (ColeKeyFormat -> ColeKeyType
ColePaymentKey ColeKeyFormat
LegacyColeKeyFormat)
            (  String -> Mod FlagFields ColeKeyType
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"legacy-cole-payment-key-type"
            Mod FlagFields ColeKeyType
-> Mod FlagFields ColeKeyType -> Mod FlagFields ColeKeyType
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields ColeKeyType
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use a Cole-era payment key, in legacy SL format."
            )
      Parser ColeKeyType -> Parser ColeKeyType -> Parser ColeKeyType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ColeKeyType -> Mod FlagFields ColeKeyType -> Parser ColeKeyType
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' (ColeKeyFormat -> ColeKeyType
ColeGenesisKey ColeKeyFormat
NonLegacyColeKeyFormat)
            (  String -> Mod FlagFields ColeKeyType
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"cole-genesis-key-type"
            Mod FlagFields ColeKeyType
-> Mod FlagFields ColeKeyType -> Mod FlagFields ColeKeyType
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields ColeKeyType
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use a Cole-era genesis key."
            )
      Parser ColeKeyType -> Parser ColeKeyType -> Parser ColeKeyType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ColeKeyType -> Mod FlagFields ColeKeyType -> Parser ColeKeyType
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' (ColeKeyFormat -> ColeKeyType
ColeGenesisKey ColeKeyFormat
LegacyColeKeyFormat)
            (  String -> Mod FlagFields ColeKeyType
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"legacy-cole-genesis-key-type"
            Mod FlagFields ColeKeyType
-> Mod FlagFields ColeKeyType -> Mod FlagFields ColeKeyType
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields ColeKeyType
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use a Cole-era genesis key, in legacy SL format."
            )
      Parser ColeKeyType -> Parser ColeKeyType -> Parser ColeKeyType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ColeKeyType -> Mod FlagFields ColeKeyType -> Parser ColeKeyType
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' (ColeKeyFormat -> ColeKeyType
ColeGenesisVestedKey ColeKeyFormat
NonLegacyColeKeyFormat)
            (  String -> Mod FlagFields ColeKeyType
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"cole-genesis-key-type"
            Mod FlagFields ColeKeyType
-> Mod FlagFields ColeKeyType -> Mod FlagFields ColeKeyType
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields ColeKeyType
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use a Cole-era genesis key."
            )
      Parser ColeKeyType -> Parser ColeKeyType -> Parser ColeKeyType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ColeKeyType -> Mod FlagFields ColeKeyType -> Parser ColeKeyType
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' (ColeKeyFormat -> ColeKeyType
ColeGenesisVestedKey ColeKeyFormat
LegacyColeKeyFormat)
            (  String -> Mod FlagFields ColeKeyType
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"legacy-cole-genesis-key-type"
            Mod FlagFields ColeKeyType
-> Mod FlagFields ColeKeyType -> Mod FlagFields ColeKeyType
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields ColeKeyType
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use a Cole-era genesis key, in legacy SL format."
            )
      Parser ColeKeyType -> Parser ColeKeyType -> Parser ColeKeyType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ColeKeyType -> Mod FlagFields ColeKeyType -> Parser ColeKeyType
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' (ColeKeyFormat -> ColeKeyType
ColeVestedKey ColeKeyFormat
NonLegacyColeKeyFormat)
            (  String -> Mod FlagFields ColeKeyType
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"cole-vested-key-type"
            Mod FlagFields ColeKeyType
-> Mod FlagFields ColeKeyType -> Mod FlagFields ColeKeyType
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields ColeKeyType
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use a Cole-era vested key."
            )
      Parser ColeKeyType -> Parser ColeKeyType -> Parser ColeKeyType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ColeKeyType -> Mod FlagFields ColeKeyType -> Parser ColeKeyType
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' (ColeKeyFormat -> ColeKeyType
ColeVestedKey ColeKeyFormat
LegacyColeKeyFormat)
            (  String -> Mod FlagFields ColeKeyType
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"legacy-cole-vested-key-type"
            Mod FlagFields ColeKeyType
-> Mod FlagFields ColeKeyType -> Mod FlagFields ColeKeyType
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields ColeKeyType
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use a Cole-era vested key, in legacy SL format."
            )
      Parser ColeKeyType -> Parser ColeKeyType -> Parser ColeKeyType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ColeKeyType -> Mod FlagFields ColeKeyType -> Parser ColeKeyType
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' (ColeKeyFormat -> ColeKeyType
ColeDelegateKey ColeKeyFormat
NonLegacyColeKeyFormat)
            (  String -> Mod FlagFields ColeKeyType
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"cole-genesis-delegate-key-type"
            Mod FlagFields ColeKeyType
-> Mod FlagFields ColeKeyType -> Mod FlagFields ColeKeyType
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields ColeKeyType
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use a Cole-era genesis delegate key."
            )
      Parser ColeKeyType -> Parser ColeKeyType -> Parser ColeKeyType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ColeKeyType -> Mod FlagFields ColeKeyType -> Parser ColeKeyType
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' (ColeKeyFormat -> ColeKeyType
ColeDelegateKey ColeKeyFormat
LegacyColeKeyFormat)
            (  String -> Mod FlagFields ColeKeyType
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"legacy-cole-genesis-delegate-key-type"
            Mod FlagFields ColeKeyType
-> Mod FlagFields ColeKeyType -> Mod FlagFields ColeKeyType
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields ColeKeyType
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use a Cole-era genesis delegate key, in legacy SL format."
            )
      Parser ColeKeyType -> Parser ColeKeyType -> Parser ColeKeyType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ColeKeyType -> Mod FlagFields ColeKeyType -> Parser ColeKeyType
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' (ColeKeyFormat -> ColeKeyType
ColeVestedDelegateKey ColeKeyFormat
NonLegacyColeKeyFormat)
            (  String -> Mod FlagFields ColeKeyType
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"cole-vested-delegate-key-type"
            Mod FlagFields ColeKeyType
-> Mod FlagFields ColeKeyType -> Mod FlagFields ColeKeyType
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields ColeKeyType
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use a Cole-era vested delegate key."
            )
      Parser ColeKeyType -> Parser ColeKeyType -> Parser ColeKeyType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ColeKeyType -> Mod FlagFields ColeKeyType -> Parser ColeKeyType
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' (ColeKeyFormat -> ColeKeyType
ColeVestedDelegateKey ColeKeyFormat
LegacyColeKeyFormat)
            (  String -> Mod FlagFields ColeKeyType
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"legacy-cole-vested-delegate-key-type"
            Mod FlagFields ColeKeyType
-> Mod FlagFields ColeKeyType -> Mod FlagFields ColeKeyType
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields ColeKeyType
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use a Cole-era vested delegate key, in legacy SL format."
            )
    
    pColeKeyFile :: Parser SomeKeyFile
    pColeKeyFile :: Parser SomeKeyFile
pColeKeyFile =
          (SigningKeyFile -> SomeKeyFile
ASigningKeyFile      (SigningKeyFile -> SomeKeyFile)
-> Parser SigningKeyFile -> Parser SomeKeyFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SigningKeyFile
pColeSigningKeyFile)
      Parser SomeKeyFile -> Parser SomeKeyFile -> Parser SomeKeyFile
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (VerificationKeyFile -> SomeKeyFile
AVerificationKeyFile (VerificationKeyFile -> SomeKeyFile)
-> Parser VerificationKeyFile -> Parser SomeKeyFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VerificationKeyFile
pColeVerificationKeyFile)

    pColeSigningKeyFile :: Parser SigningKeyFile
    pColeSigningKeyFile :: Parser SigningKeyFile
pColeSigningKeyFile =
      String -> SigningKeyFile
SigningKeyFile (String -> SigningKeyFile)
-> Parser String -> Parser SigningKeyFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
          (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"cole-signing-key-file"
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Input filepath of the Cole-format signing key."
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
          )

    pColeVerificationKeyFile :: Parser VerificationKeyFile
    pColeVerificationKeyFile :: Parser VerificationKeyFile
pColeVerificationKeyFile =
      String -> VerificationKeyFile
VerificationKeyFile (String -> VerificationKeyFile)
-> Parser String -> Parser VerificationKeyFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
          (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"cole-verification-key-file"
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Input filepath of the Cole-format verification key."
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
          )

    pKeyConvertColeGenesisVKey :: Parser KeyCmd
    pKeyConvertColeGenesisVKey :: Parser KeyCmd
pKeyConvertColeGenesisVKey =
      VerificationKeyBase64 -> OutputFile -> KeyCmd
KeyConvertColeGenesisVKey
        (VerificationKeyBase64 -> OutputFile -> KeyCmd)
-> Parser VerificationKeyBase64 -> Parser (OutputFile -> KeyCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VerificationKeyBase64
pColeGenesisVKeyBase64
        Parser (OutputFile -> KeyCmd) -> Parser OutputFile -> Parser KeyCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser OutputFile
pOutputFile

    pColeGenesisVKeyBase64 :: Parser VerificationKeyBase64
    pColeGenesisVKeyBase64 :: Parser VerificationKeyBase64
pColeGenesisVKeyBase64 =
      String -> VerificationKeyBase64
VerificationKeyBase64 (String -> VerificationKeyBase64)
-> Parser String -> Parser VerificationKeyBase64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
          (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"cole-genesis-verification-key"
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"BASE64"
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Base64 string for the Cole genesis verification key."
          )
    pKeyConvertColeVestedVKey :: Parser KeyCmd
    pKeyConvertColeVestedVKey :: Parser KeyCmd
pKeyConvertColeVestedVKey =
      VerificationKeyBase64 -> OutputFile -> KeyCmd
KeyConvertColeVestedVKey
        (VerificationKeyBase64 -> OutputFile -> KeyCmd)
-> Parser VerificationKeyBase64 -> Parser (OutputFile -> KeyCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VerificationKeyBase64
pColeVestedVKeyBase64
        Parser (OutputFile -> KeyCmd) -> Parser OutputFile -> Parser KeyCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser OutputFile
pOutputFile

    pColeVestedVKeyBase64 :: Parser VerificationKeyBase64
    pColeVestedVKeyBase64 :: Parser VerificationKeyBase64
pColeVestedVKeyBase64 =
      String -> VerificationKeyBase64
VerificationKeyBase64 (String -> VerificationKeyBase64)
-> Parser String -> Parser VerificationKeyBase64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
          (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"cole-vested-verification-key"
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"BASE64"
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Base64 string for the Cole vested verification key."
          )

    pKeyConvertITNKey :: Parser KeyCmd
    pKeyConvertITNKey :: Parser KeyCmd
pKeyConvertITNKey =
      SomeKeyFile -> OutputFile -> KeyCmd
KeyConvertITNStakeKey
        (SomeKeyFile -> OutputFile -> KeyCmd)
-> Parser SomeKeyFile -> Parser (OutputFile -> KeyCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SomeKeyFile
pITNKeyFIle
        Parser (OutputFile -> KeyCmd) -> Parser OutputFile -> Parser KeyCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser OutputFile
pOutputFile

    pKeyConvertITNExtendedKey :: Parser KeyCmd
    pKeyConvertITNExtendedKey :: Parser KeyCmd
pKeyConvertITNExtendedKey =
      SomeKeyFile -> OutputFile -> KeyCmd
KeyConvertITNExtendedToStakeKey
        (SomeKeyFile -> OutputFile -> KeyCmd)
-> Parser SomeKeyFile -> Parser (OutputFile -> KeyCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SomeKeyFile
pITNSigningKeyFile
        Parser (OutputFile -> KeyCmd) -> Parser OutputFile -> Parser KeyCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser OutputFile
pOutputFile

    pKeyConvertITNBip32Key :: Parser KeyCmd
    pKeyConvertITNBip32Key :: Parser KeyCmd
pKeyConvertITNBip32Key =
      SomeKeyFile -> OutputFile -> KeyCmd
KeyConvertITNBip32ToStakeKey
        (SomeKeyFile -> OutputFile -> KeyCmd)
-> Parser SomeKeyFile -> Parser (OutputFile -> KeyCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SomeKeyFile
pITNSigningKeyFile
        Parser (OutputFile -> KeyCmd) -> Parser OutputFile -> Parser KeyCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser OutputFile
pOutputFile

    pITNKeyFIle :: Parser SomeKeyFile
    pITNKeyFIle :: Parser SomeKeyFile
pITNKeyFIle = Parser SomeKeyFile
pITNSigningKeyFile
              Parser SomeKeyFile -> Parser SomeKeyFile -> Parser SomeKeyFile
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser SomeKeyFile
pITNVerificationKeyFile

    pITNSigningKeyFile :: Parser SomeKeyFile
    pITNSigningKeyFile :: Parser SomeKeyFile
pITNSigningKeyFile =
      SigningKeyFile -> SomeKeyFile
ASigningKeyFile (SigningKeyFile -> SomeKeyFile)
-> (String -> SigningKeyFile) -> String -> SomeKeyFile
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> SigningKeyFile
SigningKeyFile (String -> SomeKeyFile) -> Parser String -> Parser SomeKeyFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
          (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"itn-signing-key-file"
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Filepath of the ITN signing key."
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
          )

    pITNVerificationKeyFile :: Parser SomeKeyFile
    pITNVerificationKeyFile :: Parser SomeKeyFile
pITNVerificationKeyFile =
      VerificationKeyFile -> SomeKeyFile
AVerificationKeyFile (VerificationKeyFile -> SomeKeyFile)
-> (String -> VerificationKeyFile) -> String -> SomeKeyFile
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> VerificationKeyFile
VerificationKeyFile (String -> SomeKeyFile) -> Parser String -> Parser SomeKeyFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
          (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"itn-verification-key-file"
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Filepath of the ITN verification key."
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
          )

    pKeyConvertBccAddressSigningKey :: Parser KeyCmd
    pKeyConvertBccAddressSigningKey :: Parser KeyCmd
pKeyConvertBccAddressSigningKey =
      BccAddressKeyType -> SigningKeyFile -> OutputFile -> KeyCmd
KeyConvertBccAddressSigningKey
        (BccAddressKeyType -> SigningKeyFile -> OutputFile -> KeyCmd)
-> Parser BccAddressKeyType
-> Parser (SigningKeyFile -> OutputFile -> KeyCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser BccAddressKeyType
pBccAddressKeyType
        Parser (SigningKeyFile -> OutputFile -> KeyCmd)
-> Parser SigningKeyFile -> Parser (OutputFile -> KeyCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FileDirection -> Parser SigningKeyFile
pSigningKeyFile FileDirection
Input
        Parser (OutputFile -> KeyCmd) -> Parser OutputFile -> Parser KeyCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser OutputFile
pOutputFile

    pBccAddressKeyType :: Parser BccAddressKeyType
    pBccAddressKeyType :: Parser BccAddressKeyType
pBccAddressKeyType =
          BccAddressKeyType
-> Mod FlagFields BccAddressKeyType -> Parser BccAddressKeyType
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' BccAddressKeyType
BccAddressSophiePaymentKey
            (  String -> Mod FlagFields BccAddressKeyType
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"sophie-payment-key"
            Mod FlagFields BccAddressKeyType
-> Mod FlagFields BccAddressKeyType
-> Mod FlagFields BccAddressKeyType
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields BccAddressKeyType
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use a Sophie-era extended payment key."
            )
      Parser BccAddressKeyType
-> Parser BccAddressKeyType -> Parser BccAddressKeyType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BccAddressKeyType
-> Mod FlagFields BccAddressKeyType -> Parser BccAddressKeyType
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' BccAddressKeyType
BccAddressSophieStakeKey
            (  String -> Mod FlagFields BccAddressKeyType
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"sophie-stake-key"
            Mod FlagFields BccAddressKeyType
-> Mod FlagFields BccAddressKeyType
-> Mod FlagFields BccAddressKeyType
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields BccAddressKeyType
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use a Sophie-era extended stake key."
            )
      Parser BccAddressKeyType
-> Parser BccAddressKeyType -> Parser BccAddressKeyType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BccAddressKeyType
-> Mod FlagFields BccAddressKeyType -> Parser BccAddressKeyType
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' BccAddressKeyType
BccAddressIcarusPaymentKey
            (  String -> Mod FlagFields BccAddressKeyType
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"icarus-payment-key"
            Mod FlagFields BccAddressKeyType
-> Mod FlagFields BccAddressKeyType
-> Mod FlagFields BccAddressKeyType
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields BccAddressKeyType
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use a Cole-era extended payment key formatted in the Icarus style."
            )
      Parser BccAddressKeyType
-> Parser BccAddressKeyType -> Parser BccAddressKeyType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BccAddressKeyType
-> Mod FlagFields BccAddressKeyType -> Parser BccAddressKeyType
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' BccAddressKeyType
BccAddressColePaymentKey
            (  String -> Mod FlagFields BccAddressKeyType
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"cole-payment-key"
            Mod FlagFields BccAddressKeyType
-> Mod FlagFields BccAddressKeyType
-> Mod FlagFields BccAddressKeyType
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields BccAddressKeyType
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use a Cole-era extended payment key formatted in the deprecated Cole style."
            )

pTransaction :: Parser TransactionCmd
pTransaction :: Parser TransactionCmd
pTransaction =
  [Parser TransactionCmd] -> Parser TransactionCmd
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ String -> ParserInfo TransactionCmd -> Parser TransactionCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"build-raw"
        (ParserInfo TransactionCmd -> Parser TransactionCmd)
-> ParserInfo TransactionCmd -> Parser TransactionCmd
forall a b. (a -> b) -> a -> b
$ Parser TransactionCmd
-> InfoMod TransactionCmd -> ParserInfo TransactionCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser TransactionCmd
pTransactionBuildRaw (InfoMod TransactionCmd -> ParserInfo TransactionCmd)
-> InfoMod TransactionCmd -> ParserInfo TransactionCmd
forall a b. (a -> b) -> a -> b
$ Maybe Doc -> InfoMod TransactionCmd
forall a. Maybe Doc -> InfoMod a
Opt.progDescDoc (Maybe Doc -> InfoMod TransactionCmd)
-> Maybe Doc -> InfoMod TransactionCmd
forall a b. (a -> b) -> a -> b
$ Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat
          [ String -> Doc
forall a ann. Pretty a => a -> Doc ann
pretty @String String
"Build a transaction (low-level, inconvenient)"
          , Doc
forall ann. Doc ann
line
          , Doc
forall ann. Doc ann
line
          , Doc -> Doc
H.yellow (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat
            [ Doc
"Please note the order of some cmd options is crucial. If used incorrectly may produce "
            , Doc
"undesired tx body. See nested [] notation above for details."
            ]
          ]
    , String -> ParserInfo TransactionCmd -> Parser TransactionCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"build"
        (ParserInfo TransactionCmd -> Parser TransactionCmd)
-> ParserInfo TransactionCmd -> Parser TransactionCmd
forall a b. (a -> b) -> a -> b
$ Parser TransactionCmd
-> InfoMod TransactionCmd -> ParserInfo TransactionCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser TransactionCmd
pTransactionBuild (InfoMod TransactionCmd -> ParserInfo TransactionCmd)
-> InfoMod TransactionCmd -> ParserInfo TransactionCmd
forall a b. (a -> b) -> a -> b
$ Maybe Doc -> InfoMod TransactionCmd
forall a. Maybe Doc -> InfoMod a
Opt.progDescDoc (Maybe Doc -> InfoMod TransactionCmd)
-> Maybe Doc -> InfoMod TransactionCmd
forall a b. (a -> b) -> a -> b
$ Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat
          [ String -> Doc
forall a ann. Pretty a => a -> Doc ann
pretty @String String
"Build a balanced transaction (automatically calculates fees)"
          , Doc
forall ann. Doc ann
line
          , Doc
forall ann. Doc ann
line
          , Doc -> Doc
H.yellow (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat
            [ Doc
"Please note "
            , Doc -> Doc
H.underline Doc
"the order"
            , Doc
" of some cmd options is crucial. If used incorrectly may produce "
            , Doc
"undesired tx body. See nested [] notation above for details."
            ]
          ]
    , String -> ParserInfo TransactionCmd -> Parser TransactionCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"sign"
        (Parser TransactionCmd
-> InfoMod TransactionCmd -> ParserInfo TransactionCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser TransactionCmd
pTransactionSign (InfoMod TransactionCmd -> ParserInfo TransactionCmd)
-> InfoMod TransactionCmd -> ParserInfo TransactionCmd
forall a b. (a -> b) -> a -> b
$ String -> InfoMod TransactionCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Sign a transaction")
    , String -> ParserInfo TransactionCmd -> Parser TransactionCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"witness"
        (Parser TransactionCmd
-> InfoMod TransactionCmd -> ParserInfo TransactionCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser TransactionCmd
pTransactionCreateWitness (InfoMod TransactionCmd -> ParserInfo TransactionCmd)
-> InfoMod TransactionCmd -> ParserInfo TransactionCmd
forall a b. (a -> b) -> a -> b
$ String -> InfoMod TransactionCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Create a transaction witness")
    , String -> ParserInfo TransactionCmd -> Parser TransactionCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"assemble"
        (Parser TransactionCmd
-> InfoMod TransactionCmd -> ParserInfo TransactionCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser TransactionCmd
pTransactionAssembleTxBodyWit
          (InfoMod TransactionCmd -> ParserInfo TransactionCmd)
-> InfoMod TransactionCmd -> ParserInfo TransactionCmd
forall a b. (a -> b) -> a -> b
$ String -> InfoMod TransactionCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Assemble a tx body and witness(es) to form a transaction")
    , Parser TransactionCmd
pSignWitnessBackwardCompatible
    , String -> ParserInfo TransactionCmd -> Parser TransactionCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"submit"
        (Parser TransactionCmd
-> InfoMod TransactionCmd -> ParserInfo TransactionCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser TransactionCmd
pTransactionSubmit (InfoMod TransactionCmd -> ParserInfo TransactionCmd)
-> (String -> InfoMod TransactionCmd)
-> String
-> ParserInfo TransactionCmd
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> InfoMod TransactionCmd
forall a. String -> InfoMod a
Opt.progDesc (String -> ParserInfo TransactionCmd)
-> String -> ParserInfo TransactionCmd
forall a b. (a -> b) -> a -> b
$
           [String] -> String
forall a. Monoid a => [a] -> a
mconcat
             [ String
"Submit a transaction to the local node whose Unix domain socket "
             , String
"is obtained from the BCC_NODE_SOCKET_PATH enviromnent variable."
             ]
          )
    , String -> ParserInfo TransactionCmd -> Parser TransactionCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"policyid"
        (Parser TransactionCmd
-> InfoMod TransactionCmd -> ParserInfo TransactionCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser TransactionCmd
pTransactionPolicyId (InfoMod TransactionCmd -> ParserInfo TransactionCmd)
-> InfoMod TransactionCmd -> ParserInfo TransactionCmd
forall a b. (a -> b) -> a -> b
$ String -> InfoMod TransactionCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Calculate the PolicyId from the monetary policy script.")
    , String -> ParserInfo TransactionCmd -> Parser TransactionCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"calculate-min-fee"
        (Parser TransactionCmd
-> InfoMod TransactionCmd -> ParserInfo TransactionCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser TransactionCmd
pTransactionCalculateMinFee (InfoMod TransactionCmd -> ParserInfo TransactionCmd)
-> InfoMod TransactionCmd -> ParserInfo TransactionCmd
forall a b. (a -> b) -> a -> b
$ String -> InfoMod TransactionCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Calculate the minimum fee for a transaction.")
    , String -> ParserInfo TransactionCmd -> Parser TransactionCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"calculate-min-required-utxo"
        (Parser TransactionCmd
-> InfoMod TransactionCmd -> ParserInfo TransactionCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser TransactionCmd
pTransactionCalculateMinReqUTxO (InfoMod TransactionCmd -> ParserInfo TransactionCmd)
-> InfoMod TransactionCmd -> ParserInfo TransactionCmd
forall a b. (a -> b) -> a -> b
$ String -> InfoMod TransactionCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Calculate the minimum required UTxO for a transaction output.")
    , Parser TransactionCmd
pCalculateMinRequiredUtxoBackwardCompatible
    , String -> ParserInfo TransactionCmd -> Parser TransactionCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"hash-script-data"
        (Parser TransactionCmd
-> InfoMod TransactionCmd -> ParserInfo TransactionCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser TransactionCmd
pTxHashScriptData (InfoMod TransactionCmd -> ParserInfo TransactionCmd)
-> InfoMod TransactionCmd -> ParserInfo TransactionCmd
forall a b. (a -> b) -> a -> b
$ String -> InfoMod TransactionCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Calculate the hash of script data.")
    , String -> ParserInfo TransactionCmd -> Parser TransactionCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"txid"
        (Parser TransactionCmd
-> InfoMod TransactionCmd -> ParserInfo TransactionCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser TransactionCmd
pTransactionId (InfoMod TransactionCmd -> ParserInfo TransactionCmd)
-> InfoMod TransactionCmd -> ParserInfo TransactionCmd
forall a b. (a -> b) -> a -> b
$ String -> InfoMod TransactionCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Print a transaction identifier.")
    , String -> ParserInfo TransactionCmd -> Parser TransactionCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"view" (ParserInfo TransactionCmd -> Parser TransactionCmd)
-> ParserInfo TransactionCmd -> Parser TransactionCmd
forall a b. (a -> b) -> a -> b
$
        Parser TransactionCmd
-> InfoMod TransactionCmd -> ParserInfo TransactionCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser TransactionCmd
pTransactionView (InfoMod TransactionCmd -> ParserInfo TransactionCmd)
-> InfoMod TransactionCmd -> ParserInfo TransactionCmd
forall a b. (a -> b) -> a -> b
$ String -> InfoMod TransactionCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Print a transaction."
    ]
 where
  -- Backwards compatible parsers
  calcMinValueInfo :: ParserInfo TransactionCmd
  calcMinValueInfo :: ParserInfo TransactionCmd
calcMinValueInfo =
    Parser TransactionCmd
-> InfoMod TransactionCmd -> ParserInfo TransactionCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser TransactionCmd
pTransactionCalculateMinReqUTxO
      (InfoMod TransactionCmd -> ParserInfo TransactionCmd)
-> InfoMod TransactionCmd -> ParserInfo TransactionCmd
forall a b. (a -> b) -> a -> b
$ String -> InfoMod TransactionCmd
forall a. String -> InfoMod a
Opt.progDesc String
"DEPRECATED: Use 'calculate-min-required-utxo' instead."

  pCalculateMinRequiredUtxoBackwardCompatible :: Parser TransactionCmd
  pCalculateMinRequiredUtxoBackwardCompatible :: Parser TransactionCmd
pCalculateMinRequiredUtxoBackwardCompatible =
    Mod CommandFields TransactionCmd -> Parser TransactionCmd
forall a. Mod CommandFields a -> Parser a
Opt.subparser
      (Mod CommandFields TransactionCmd -> Parser TransactionCmd)
-> Mod CommandFields TransactionCmd -> Parser TransactionCmd
forall a b. (a -> b) -> a -> b
$ String
-> ParserInfo TransactionCmd -> Mod CommandFields TransactionCmd
forall a. String -> ParserInfo a -> Mod CommandFields a
Opt.command String
"calculate-min-value" ParserInfo TransactionCmd
calcMinValueInfo Mod CommandFields TransactionCmd
-> Mod CommandFields TransactionCmd
-> Mod CommandFields TransactionCmd
forall a. Semigroup a => a -> a -> a
<> Mod CommandFields TransactionCmd
forall (f :: * -> *) a. Mod f a
Opt.internal

  assembleInfo :: ParserInfo TransactionCmd
  assembleInfo :: ParserInfo TransactionCmd
assembleInfo =
    Parser TransactionCmd
-> InfoMod TransactionCmd -> ParserInfo TransactionCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser TransactionCmd
pTransactionAssembleTxBodyWit
      (InfoMod TransactionCmd -> ParserInfo TransactionCmd)
-> InfoMod TransactionCmd -> ParserInfo TransactionCmd
forall a b. (a -> b) -> a -> b
$ String -> InfoMod TransactionCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Assemble a tx body and witness(es) to form a transaction"

  pSignWitnessBackwardCompatible :: Parser TransactionCmd
  pSignWitnessBackwardCompatible :: Parser TransactionCmd
pSignWitnessBackwardCompatible =
    Mod CommandFields TransactionCmd -> Parser TransactionCmd
forall a. Mod CommandFields a -> Parser a
Opt.subparser
      (Mod CommandFields TransactionCmd -> Parser TransactionCmd)
-> Mod CommandFields TransactionCmd -> Parser TransactionCmd
forall a b. (a -> b) -> a -> b
$ String
-> ParserInfo TransactionCmd -> Mod CommandFields TransactionCmd
forall a. String -> ParserInfo a -> Mod CommandFields a
Opt.command String
"sign-witness" ParserInfo TransactionCmd
assembleInfo Mod CommandFields TransactionCmd
-> Mod CommandFields TransactionCmd
-> Mod CommandFields TransactionCmd
forall a. Semigroup a => a -> a -> a
<> Mod CommandFields TransactionCmd
forall (f :: * -> *) a. Mod f a
Opt.internal

  pScriptValidity :: Parser ScriptValidity
  pScriptValidity :: Parser ScriptValidity
pScriptValidity = [Parser ScriptValidity] -> Parser ScriptValidity
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ ScriptValidity
-> Mod FlagFields ScriptValidity -> Parser ScriptValidity
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' ScriptValidity
ScriptValid (Mod FlagFields ScriptValidity -> Parser ScriptValidity)
-> Mod FlagFields ScriptValidity -> Parser ScriptValidity
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields ScriptValidity] -> Mod FlagFields ScriptValidity
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod FlagFields ScriptValidity
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"script-valid"
      , String -> Mod FlagFields ScriptValidity
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Assertion that the script is valid. (default)"
      ]
    , ScriptValidity
-> Mod FlagFields ScriptValidity -> Parser ScriptValidity
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' ScriptValidity
ScriptInvalid (Mod FlagFields ScriptValidity -> Parser ScriptValidity)
-> Mod FlagFields ScriptValidity -> Parser ScriptValidity
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields ScriptValidity] -> Mod FlagFields ScriptValidity
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod FlagFields ScriptValidity
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"script-invalid"
      , String -> Mod FlagFields ScriptValidity
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod FlagFields ScriptValidity)
-> String -> Mod FlagFields ScriptValidity
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat
        [ String
"Assertion that the script is invalid.  "
        , String
"If a transaction is submitted with such a script, "
        , String
"the script will fail and the collateral taken"
        ]
      ]
    ]

  pTransactionBuild :: Parser TransactionCmd
  pTransactionBuild :: Parser TransactionCmd
pTransactionBuild =
    AnyBccEra
-> AnyConsensusModeParams
-> NetworkId
-> Maybe ScriptValidity
-> Maybe Word
-> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
-> [WitnessSigningData]
-> [TxIn]
-> [TxOutAnyEra]
-> TxOutChangeAddress
-> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
-> Maybe SlotNo
-> Maybe SlotNo
-> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
-> [(StakeAddress, Entropic,
     Maybe (ScriptWitnessFiles WitCtxStake))]
-> TxMetadataJsonSchema
-> [ScriptFile]
-> [MetadataFile]
-> Maybe ProtocolParamsSourceSpec
-> Maybe UpdateProposalFile
-> TxBodyFile
-> TransactionCmd
TxBuild (AnyBccEra
 -> AnyConsensusModeParams
 -> NetworkId
 -> Maybe ScriptValidity
 -> Maybe Word
 -> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
 -> [WitnessSigningData]
 -> [TxIn]
 -> [TxOutAnyEra]
 -> TxOutChangeAddress
 -> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
 -> Maybe SlotNo
 -> Maybe SlotNo
 -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
 -> [(StakeAddress, Entropic,
      Maybe (ScriptWitnessFiles WitCtxStake))]
 -> TxMetadataJsonSchema
 -> [ScriptFile]
 -> [MetadataFile]
 -> Maybe ProtocolParamsSourceSpec
 -> Maybe UpdateProposalFile
 -> TxBodyFile
 -> TransactionCmd)
-> Parser AnyBccEra
-> Parser
     (AnyConsensusModeParams
      -> NetworkId
      -> Maybe ScriptValidity
      -> Maybe Word
      -> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
      -> [WitnessSigningData]
      -> [TxIn]
      -> [TxOutAnyEra]
      -> TxOutChangeAddress
      -> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
      -> Maybe SlotNo
      -> Maybe SlotNo
      -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
      -> [(StakeAddress, Entropic,
           Maybe (ScriptWitnessFiles WitCtxStake))]
      -> TxMetadataJsonSchema
      -> [ScriptFile]
      -> [MetadataFile]
      -> Maybe ProtocolParamsSourceSpec
      -> Maybe UpdateProposalFile
      -> TxBodyFile
      -> TransactionCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser AnyBccEra
pBccEra
            Parser
  (AnyConsensusModeParams
   -> NetworkId
   -> Maybe ScriptValidity
   -> Maybe Word
   -> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
   -> [WitnessSigningData]
   -> [TxIn]
   -> [TxOutAnyEra]
   -> TxOutChangeAddress
   -> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
   -> Maybe SlotNo
   -> Maybe SlotNo
   -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
   -> [(StakeAddress, Entropic,
        Maybe (ScriptWitnessFiles WitCtxStake))]
   -> TxMetadataJsonSchema
   -> [ScriptFile]
   -> [MetadataFile]
   -> Maybe ProtocolParamsSourceSpec
   -> Maybe UpdateProposalFile
   -> TxBodyFile
   -> TransactionCmd)
-> Parser AnyConsensusModeParams
-> Parser
     (NetworkId
      -> Maybe ScriptValidity
      -> Maybe Word
      -> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
      -> [WitnessSigningData]
      -> [TxIn]
      -> [TxOutAnyEra]
      -> TxOutChangeAddress
      -> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
      -> Maybe SlotNo
      -> Maybe SlotNo
      -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
      -> [(StakeAddress, Entropic,
           Maybe (ScriptWitnessFiles WitCtxStake))]
      -> TxMetadataJsonSchema
      -> [ScriptFile]
      -> [MetadataFile]
      -> Maybe ProtocolParamsSourceSpec
      -> Maybe UpdateProposalFile
      -> TxBodyFile
      -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser AnyConsensusModeParams
pConsensusModeParams
            Parser
  (NetworkId
   -> Maybe ScriptValidity
   -> Maybe Word
   -> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
   -> [WitnessSigningData]
   -> [TxIn]
   -> [TxOutAnyEra]
   -> TxOutChangeAddress
   -> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
   -> Maybe SlotNo
   -> Maybe SlotNo
   -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
   -> [(StakeAddress, Entropic,
        Maybe (ScriptWitnessFiles WitCtxStake))]
   -> TxMetadataJsonSchema
   -> [ScriptFile]
   -> [MetadataFile]
   -> Maybe ProtocolParamsSourceSpec
   -> Maybe UpdateProposalFile
   -> TxBodyFile
   -> TransactionCmd)
-> Parser NetworkId
-> Parser
     (Maybe ScriptValidity
      -> Maybe Word
      -> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
      -> [WitnessSigningData]
      -> [TxIn]
      -> [TxOutAnyEra]
      -> TxOutChangeAddress
      -> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
      -> Maybe SlotNo
      -> Maybe SlotNo
      -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
      -> [(StakeAddress, Entropic,
           Maybe (ScriptWitnessFiles WitCtxStake))]
      -> TxMetadataJsonSchema
      -> [ScriptFile]
      -> [MetadataFile]
      -> Maybe ProtocolParamsSourceSpec
      -> Maybe UpdateProposalFile
      -> TxBodyFile
      -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser NetworkId
pNetworkId
            Parser
  (Maybe ScriptValidity
   -> Maybe Word
   -> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
   -> [WitnessSigningData]
   -> [TxIn]
   -> [TxOutAnyEra]
   -> TxOutChangeAddress
   -> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
   -> Maybe SlotNo
   -> Maybe SlotNo
   -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
   -> [(StakeAddress, Entropic,
        Maybe (ScriptWitnessFiles WitCtxStake))]
   -> TxMetadataJsonSchema
   -> [ScriptFile]
   -> [MetadataFile]
   -> Maybe ProtocolParamsSourceSpec
   -> Maybe UpdateProposalFile
   -> TxBodyFile
   -> TransactionCmd)
-> Parser (Maybe ScriptValidity)
-> Parser
     (Maybe Word
      -> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
      -> [WitnessSigningData]
      -> [TxIn]
      -> [TxOutAnyEra]
      -> TxOutChangeAddress
      -> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
      -> Maybe SlotNo
      -> Maybe SlotNo
      -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
      -> [(StakeAddress, Entropic,
           Maybe (ScriptWitnessFiles WitCtxStake))]
      -> TxMetadataJsonSchema
      -> [ScriptFile]
      -> [MetadataFile]
      -> Maybe ProtocolParamsSourceSpec
      -> Maybe UpdateProposalFile
      -> TxBodyFile
      -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ScriptValidity -> Parser (Maybe ScriptValidity)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ScriptValidity
pScriptValidity
            Parser
  (Maybe Word
   -> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
   -> [WitnessSigningData]
   -> [TxIn]
   -> [TxOutAnyEra]
   -> TxOutChangeAddress
   -> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
   -> Maybe SlotNo
   -> Maybe SlotNo
   -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
   -> [(StakeAddress, Entropic,
        Maybe (ScriptWitnessFiles WitCtxStake))]
   -> TxMetadataJsonSchema
   -> [ScriptFile]
   -> [MetadataFile]
   -> Maybe ProtocolParamsSourceSpec
   -> Maybe UpdateProposalFile
   -> TxBodyFile
   -> TransactionCmd)
-> Parser (Maybe Word)
-> Parser
     ([(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
      -> [WitnessSigningData]
      -> [TxIn]
      -> [TxOutAnyEra]
      -> TxOutChangeAddress
      -> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
      -> Maybe SlotNo
      -> Maybe SlotNo
      -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
      -> [(StakeAddress, Entropic,
           Maybe (ScriptWitnessFiles WitCtxStake))]
      -> TxMetadataJsonSchema
      -> [ScriptFile]
      -> [MetadataFile]
      -> Maybe ProtocolParamsSourceSpec
      -> Maybe UpdateProposalFile
      -> TxBodyFile
      -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word -> Parser (Maybe Word)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Word
pWitnessOverride
            Parser
  ([(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
   -> [WitnessSigningData]
   -> [TxIn]
   -> [TxOutAnyEra]
   -> TxOutChangeAddress
   -> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
   -> Maybe SlotNo
   -> Maybe SlotNo
   -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
   -> [(StakeAddress, Entropic,
        Maybe (ScriptWitnessFiles WitCtxStake))]
   -> TxMetadataJsonSchema
   -> [ScriptFile]
   -> [MetadataFile]
   -> Maybe ProtocolParamsSourceSpec
   -> Maybe UpdateProposalFile
   -> TxBodyFile
   -> TransactionCmd)
-> Parser [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
-> Parser
     ([WitnessSigningData]
      -> [TxIn]
      -> [TxOutAnyEra]
      -> TxOutChangeAddress
      -> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
      -> Maybe SlotNo
      -> Maybe SlotNo
      -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
      -> [(StakeAddress, Entropic,
           Maybe (ScriptWitnessFiles WitCtxStake))]
      -> TxMetadataJsonSchema
      -> [ScriptFile]
      -> [MetadataFile]
      -> Maybe ProtocolParamsSourceSpec
      -> Maybe UpdateProposalFile
      -> TxBodyFile
      -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))
-> Parser [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (BalanceTxExecUnits
-> Parser (TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))
pTxIn BalanceTxExecUnits
AutoBalance)
            Parser
  ([WitnessSigningData]
   -> [TxIn]
   -> [TxOutAnyEra]
   -> TxOutChangeAddress
   -> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
   -> Maybe SlotNo
   -> Maybe SlotNo
   -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
   -> [(StakeAddress, Entropic,
        Maybe (ScriptWitnessFiles WitCtxStake))]
   -> TxMetadataJsonSchema
   -> [ScriptFile]
   -> [MetadataFile]
   -> Maybe ProtocolParamsSourceSpec
   -> Maybe UpdateProposalFile
   -> TxBodyFile
   -> TransactionCmd)
-> Parser [WitnessSigningData]
-> Parser
     ([TxIn]
      -> [TxOutAnyEra]
      -> TxOutChangeAddress
      -> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
      -> Maybe SlotNo
      -> Maybe SlotNo
      -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
      -> [(StakeAddress, Entropic,
           Maybe (ScriptWitnessFiles WitCtxStake))]
      -> TxMetadataJsonSchema
      -> [ScriptFile]
      -> [MetadataFile]
      -> Maybe ProtocolParamsSourceSpec
      -> Maybe UpdateProposalFile
      -> TxBodyFile
      -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser WitnessSigningData -> Parser [WitnessSigningData]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser WitnessSigningData
pRequiredSigner
            Parser
  ([TxIn]
   -> [TxOutAnyEra]
   -> TxOutChangeAddress
   -> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
   -> Maybe SlotNo
   -> Maybe SlotNo
   -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
   -> [(StakeAddress, Entropic,
        Maybe (ScriptWitnessFiles WitCtxStake))]
   -> TxMetadataJsonSchema
   -> [ScriptFile]
   -> [MetadataFile]
   -> Maybe ProtocolParamsSourceSpec
   -> Maybe UpdateProposalFile
   -> TxBodyFile
   -> TransactionCmd)
-> Parser [TxIn]
-> Parser
     ([TxOutAnyEra]
      -> TxOutChangeAddress
      -> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
      -> Maybe SlotNo
      -> Maybe SlotNo
      -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
      -> [(StakeAddress, Entropic,
           Maybe (ScriptWitnessFiles WitCtxStake))]
      -> TxMetadataJsonSchema
      -> [ScriptFile]
      -> [MetadataFile]
      -> Maybe ProtocolParamsSourceSpec
      -> Maybe UpdateProposalFile
      -> TxBodyFile
      -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TxIn -> Parser [TxIn]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser TxIn
pTxInCollateral
            Parser
  ([TxOutAnyEra]
   -> TxOutChangeAddress
   -> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
   -> Maybe SlotNo
   -> Maybe SlotNo
   -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
   -> [(StakeAddress, Entropic,
        Maybe (ScriptWitnessFiles WitCtxStake))]
   -> TxMetadataJsonSchema
   -> [ScriptFile]
   -> [MetadataFile]
   -> Maybe ProtocolParamsSourceSpec
   -> Maybe UpdateProposalFile
   -> TxBodyFile
   -> TransactionCmd)
-> Parser [TxOutAnyEra]
-> Parser
     (TxOutChangeAddress
      -> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
      -> Maybe SlotNo
      -> Maybe SlotNo
      -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
      -> [(StakeAddress, Entropic,
           Maybe (ScriptWitnessFiles WitCtxStake))]
      -> TxMetadataJsonSchema
      -> [ScriptFile]
      -> [MetadataFile]
      -> Maybe ProtocolParamsSourceSpec
      -> Maybe UpdateProposalFile
      -> TxBodyFile
      -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TxOutAnyEra -> Parser [TxOutAnyEra]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser TxOutAnyEra
pTxOut
            Parser
  (TxOutChangeAddress
   -> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
   -> Maybe SlotNo
   -> Maybe SlotNo
   -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
   -> [(StakeAddress, Entropic,
        Maybe (ScriptWitnessFiles WitCtxStake))]
   -> TxMetadataJsonSchema
   -> [ScriptFile]
   -> [MetadataFile]
   -> Maybe ProtocolParamsSourceSpec
   -> Maybe UpdateProposalFile
   -> TxBodyFile
   -> TransactionCmd)
-> Parser TxOutChangeAddress
-> Parser
     (Maybe (Value, [ScriptWitnessFiles WitCtxMint])
      -> Maybe SlotNo
      -> Maybe SlotNo
      -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
      -> [(StakeAddress, Entropic,
           Maybe (ScriptWitnessFiles WitCtxStake))]
      -> TxMetadataJsonSchema
      -> [ScriptFile]
      -> [MetadataFile]
      -> Maybe ProtocolParamsSourceSpec
      -> Maybe UpdateProposalFile
      -> TxBodyFile
      -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TxOutChangeAddress
pChangeAddress
            Parser
  (Maybe (Value, [ScriptWitnessFiles WitCtxMint])
   -> Maybe SlotNo
   -> Maybe SlotNo
   -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
   -> [(StakeAddress, Entropic,
        Maybe (ScriptWitnessFiles WitCtxStake))]
   -> TxMetadataJsonSchema
   -> [ScriptFile]
   -> [MetadataFile]
   -> Maybe ProtocolParamsSourceSpec
   -> Maybe UpdateProposalFile
   -> TxBodyFile
   -> TransactionCmd)
-> Parser (Maybe (Value, [ScriptWitnessFiles WitCtxMint]))
-> Parser
     (Maybe SlotNo
      -> Maybe SlotNo
      -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
      -> [(StakeAddress, Entropic,
           Maybe (ScriptWitnessFiles WitCtxStake))]
      -> TxMetadataJsonSchema
      -> [ScriptFile]
      -> [MetadataFile]
      -> Maybe ProtocolParamsSourceSpec
      -> Maybe UpdateProposalFile
      -> TxBodyFile
      -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Value, [ScriptWitnessFiles WitCtxMint])
-> Parser (Maybe (Value, [ScriptWitnessFiles WitCtxMint]))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (BalanceTxExecUnits
-> Parser (Value, [ScriptWitnessFiles WitCtxMint])
pMintMultiAsset BalanceTxExecUnits
AutoBalance)
            Parser
  (Maybe SlotNo
   -> Maybe SlotNo
   -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
   -> [(StakeAddress, Entropic,
        Maybe (ScriptWitnessFiles WitCtxStake))]
   -> TxMetadataJsonSchema
   -> [ScriptFile]
   -> [MetadataFile]
   -> Maybe ProtocolParamsSourceSpec
   -> Maybe UpdateProposalFile
   -> TxBodyFile
   -> TransactionCmd)
-> Parser (Maybe SlotNo)
-> Parser
     (Maybe SlotNo
      -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
      -> [(StakeAddress, Entropic,
           Maybe (ScriptWitnessFiles WitCtxStake))]
      -> TxMetadataJsonSchema
      -> [ScriptFile]
      -> [MetadataFile]
      -> Maybe ProtocolParamsSourceSpec
      -> Maybe UpdateProposalFile
      -> TxBodyFile
      -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SlotNo -> Parser (Maybe SlotNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser SlotNo
pInvalidBefore
            Parser
  (Maybe SlotNo
   -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
   -> [(StakeAddress, Entropic,
        Maybe (ScriptWitnessFiles WitCtxStake))]
   -> TxMetadataJsonSchema
   -> [ScriptFile]
   -> [MetadataFile]
   -> Maybe ProtocolParamsSourceSpec
   -> Maybe UpdateProposalFile
   -> TxBodyFile
   -> TransactionCmd)
-> Parser (Maybe SlotNo)
-> Parser
     ([(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
      -> [(StakeAddress, Entropic,
           Maybe (ScriptWitnessFiles WitCtxStake))]
      -> TxMetadataJsonSchema
      -> [ScriptFile]
      -> [MetadataFile]
      -> Maybe ProtocolParamsSourceSpec
      -> Maybe UpdateProposalFile
      -> TxBodyFile
      -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SlotNo -> Parser (Maybe SlotNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser SlotNo
pInvalidHereafter
            Parser
  ([(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
   -> [(StakeAddress, Entropic,
        Maybe (ScriptWitnessFiles WitCtxStake))]
   -> TxMetadataJsonSchema
   -> [ScriptFile]
   -> [MetadataFile]
   -> Maybe ProtocolParamsSourceSpec
   -> Maybe UpdateProposalFile
   -> TxBodyFile
   -> TransactionCmd)
-> Parser
     [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
-> Parser
     ([(StakeAddress, Entropic, Maybe (ScriptWitnessFiles WitCtxStake))]
      -> TxMetadataJsonSchema
      -> [ScriptFile]
      -> [MetadataFile]
      -> Maybe ProtocolParamsSourceSpec
      -> Maybe UpdateProposalFile
      -> TxBodyFile
      -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))
-> Parser
     [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (BalanceTxExecUnits
-> Parser (CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))
pCertificateFile BalanceTxExecUnits
AutoBalance)
            Parser
  ([(StakeAddress, Entropic, Maybe (ScriptWitnessFiles WitCtxStake))]
   -> TxMetadataJsonSchema
   -> [ScriptFile]
   -> [MetadataFile]
   -> Maybe ProtocolParamsSourceSpec
   -> Maybe UpdateProposalFile
   -> TxBodyFile
   -> TransactionCmd)
-> Parser
     [(StakeAddress, Entropic, Maybe (ScriptWitnessFiles WitCtxStake))]
-> Parser
     (TxMetadataJsonSchema
      -> [ScriptFile]
      -> [MetadataFile]
      -> Maybe ProtocolParamsSourceSpec
      -> Maybe UpdateProposalFile
      -> TxBodyFile
      -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser
  (StakeAddress, Entropic, Maybe (ScriptWitnessFiles WitCtxStake))
-> Parser
     [(StakeAddress, Entropic, Maybe (ScriptWitnessFiles WitCtxStake))]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (BalanceTxExecUnits
-> Parser
     (StakeAddress, Entropic, Maybe (ScriptWitnessFiles WitCtxStake))
pWithdrawal BalanceTxExecUnits
AutoBalance)
            Parser
  (TxMetadataJsonSchema
   -> [ScriptFile]
   -> [MetadataFile]
   -> Maybe ProtocolParamsSourceSpec
   -> Maybe UpdateProposalFile
   -> TxBodyFile
   -> TransactionCmd)
-> Parser TxMetadataJsonSchema
-> Parser
     ([ScriptFile]
      -> [MetadataFile]
      -> Maybe ProtocolParamsSourceSpec
      -> Maybe UpdateProposalFile
      -> TxBodyFile
      -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TxMetadataJsonSchema
pTxMetadataJsonSchema
            Parser
  ([ScriptFile]
   -> [MetadataFile]
   -> Maybe ProtocolParamsSourceSpec
   -> Maybe UpdateProposalFile
   -> TxBodyFile
   -> TransactionCmd)
-> Parser [ScriptFile]
-> Parser
     ([MetadataFile]
      -> Maybe ProtocolParamsSourceSpec
      -> Maybe UpdateProposalFile
      -> TxBodyFile
      -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ScriptFile -> Parser [ScriptFile]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (String -> Maybe String -> String -> Parser ScriptFile
pScriptFor
                        String
"auxiliary-script-file"
                        Maybe String
forall a. Maybe a
Nothing
                        String
"Filepath of auxiliary script(s)")
            Parser
  ([MetadataFile]
   -> Maybe ProtocolParamsSourceSpec
   -> Maybe UpdateProposalFile
   -> TxBodyFile
   -> TransactionCmd)
-> Parser [MetadataFile]
-> Parser
     (Maybe ProtocolParamsSourceSpec
      -> Maybe UpdateProposalFile -> TxBodyFile -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser MetadataFile -> Parser [MetadataFile]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser MetadataFile
pMetadataFile
            Parser
  (Maybe ProtocolParamsSourceSpec
   -> Maybe UpdateProposalFile -> TxBodyFile -> TransactionCmd)
-> Parser (Maybe ProtocolParamsSourceSpec)
-> Parser
     (Maybe UpdateProposalFile -> TxBodyFile -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ProtocolParamsSourceSpec
-> Parser (Maybe ProtocolParamsSourceSpec)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ProtocolParamsSourceSpec
pProtocolParamsSourceSpec
            Parser (Maybe UpdateProposalFile -> TxBodyFile -> TransactionCmd)
-> Parser (Maybe UpdateProposalFile)
-> Parser (TxBodyFile -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser UpdateProposalFile -> Parser (Maybe UpdateProposalFile)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser UpdateProposalFile
pUpdateProposalFile
            Parser (TxBodyFile -> TransactionCmd)
-> Parser TxBodyFile -> Parser TransactionCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FileDirection -> Parser TxBodyFile
pTxBodyFile FileDirection
Output

  pChangeAddress :: Parser TxOutChangeAddress
  pChangeAddress :: Parser TxOutChangeAddress
pChangeAddress =
    AddressAny -> TxOutChangeAddress
TxOutChangeAddress (AddressAny -> TxOutChangeAddress)
-> Parser AddressAny -> Parser TxOutChangeAddress
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      ReadM AddressAny
-> Mod OptionFields AddressAny -> Parser AddressAny
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser AddressAny -> ReadM AddressAny
forall a. Parser a -> ReadM a
readerFromParsecParser Parser AddressAny
parseAddressAny)
        (  String -> Mod OptionFields AddressAny
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"change-address"
        Mod OptionFields AddressAny
-> Mod OptionFields AddressAny -> Mod OptionFields AddressAny
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields AddressAny
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"ADDRESS"
        Mod OptionFields AddressAny
-> Mod OptionFields AddressAny -> Mod OptionFields AddressAny
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields AddressAny
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Address where BCC in excess of the tx fee will go to."
        )

  pTransactionBuildRaw :: Parser TransactionCmd
  pTransactionBuildRaw :: Parser TransactionCmd
pTransactionBuildRaw =
    AnyBccEra
-> Maybe ScriptValidity
-> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
-> [TxIn]
-> [WitnessSigningData]
-> [TxOutAnyEra]
-> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
-> Maybe SlotNo
-> Maybe SlotNo
-> Maybe Entropic
-> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
-> [(StakeAddress, Entropic,
     Maybe (ScriptWitnessFiles WitCtxStake))]
-> TxMetadataJsonSchema
-> [ScriptFile]
-> [MetadataFile]
-> Maybe ProtocolParamsSourceSpec
-> Maybe UpdateProposalFile
-> TxBodyFile
-> TransactionCmd
TxBuildRaw (AnyBccEra
 -> Maybe ScriptValidity
 -> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
 -> [TxIn]
 -> [WitnessSigningData]
 -> [TxOutAnyEra]
 -> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
 -> Maybe SlotNo
 -> Maybe SlotNo
 -> Maybe Entropic
 -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
 -> [(StakeAddress, Entropic,
      Maybe (ScriptWitnessFiles WitCtxStake))]
 -> TxMetadataJsonSchema
 -> [ScriptFile]
 -> [MetadataFile]
 -> Maybe ProtocolParamsSourceSpec
 -> Maybe UpdateProposalFile
 -> TxBodyFile
 -> TransactionCmd)
-> Parser AnyBccEra
-> Parser
     (Maybe ScriptValidity
      -> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
      -> [TxIn]
      -> [WitnessSigningData]
      -> [TxOutAnyEra]
      -> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
      -> Maybe SlotNo
      -> Maybe SlotNo
      -> Maybe Entropic
      -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
      -> [(StakeAddress, Entropic,
           Maybe (ScriptWitnessFiles WitCtxStake))]
      -> TxMetadataJsonSchema
      -> [ScriptFile]
      -> [MetadataFile]
      -> Maybe ProtocolParamsSourceSpec
      -> Maybe UpdateProposalFile
      -> TxBodyFile
      -> TransactionCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser AnyBccEra
pBccEra
               Parser
  (Maybe ScriptValidity
   -> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
   -> [TxIn]
   -> [WitnessSigningData]
   -> [TxOutAnyEra]
   -> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
   -> Maybe SlotNo
   -> Maybe SlotNo
   -> Maybe Entropic
   -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
   -> [(StakeAddress, Entropic,
        Maybe (ScriptWitnessFiles WitCtxStake))]
   -> TxMetadataJsonSchema
   -> [ScriptFile]
   -> [MetadataFile]
   -> Maybe ProtocolParamsSourceSpec
   -> Maybe UpdateProposalFile
   -> TxBodyFile
   -> TransactionCmd)
-> Parser (Maybe ScriptValidity)
-> Parser
     ([(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
      -> [TxIn]
      -> [WitnessSigningData]
      -> [TxOutAnyEra]
      -> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
      -> Maybe SlotNo
      -> Maybe SlotNo
      -> Maybe Entropic
      -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
      -> [(StakeAddress, Entropic,
           Maybe (ScriptWitnessFiles WitCtxStake))]
      -> TxMetadataJsonSchema
      -> [ScriptFile]
      -> [MetadataFile]
      -> Maybe ProtocolParamsSourceSpec
      -> Maybe UpdateProposalFile
      -> TxBodyFile
      -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ScriptValidity -> Parser (Maybe ScriptValidity)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ScriptValidity
pScriptValidity
               Parser
  ([(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
   -> [TxIn]
   -> [WitnessSigningData]
   -> [TxOutAnyEra]
   -> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
   -> Maybe SlotNo
   -> Maybe SlotNo
   -> Maybe Entropic
   -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
   -> [(StakeAddress, Entropic,
        Maybe (ScriptWitnessFiles WitCtxStake))]
   -> TxMetadataJsonSchema
   -> [ScriptFile]
   -> [MetadataFile]
   -> Maybe ProtocolParamsSourceSpec
   -> Maybe UpdateProposalFile
   -> TxBodyFile
   -> TransactionCmd)
-> Parser [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
-> Parser
     ([TxIn]
      -> [WitnessSigningData]
      -> [TxOutAnyEra]
      -> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
      -> Maybe SlotNo
      -> Maybe SlotNo
      -> Maybe Entropic
      -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
      -> [(StakeAddress, Entropic,
           Maybe (ScriptWitnessFiles WitCtxStake))]
      -> TxMetadataJsonSchema
      -> [ScriptFile]
      -> [MetadataFile]
      -> Maybe ProtocolParamsSourceSpec
      -> Maybe UpdateProposalFile
      -> TxBodyFile
      -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))
-> Parser [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (BalanceTxExecUnits
-> Parser (TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))
pTxIn BalanceTxExecUnits
ManualBalance)
               Parser
  ([TxIn]
   -> [WitnessSigningData]
   -> [TxOutAnyEra]
   -> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
   -> Maybe SlotNo
   -> Maybe SlotNo
   -> Maybe Entropic
   -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
   -> [(StakeAddress, Entropic,
        Maybe (ScriptWitnessFiles WitCtxStake))]
   -> TxMetadataJsonSchema
   -> [ScriptFile]
   -> [MetadataFile]
   -> Maybe ProtocolParamsSourceSpec
   -> Maybe UpdateProposalFile
   -> TxBodyFile
   -> TransactionCmd)
-> Parser [TxIn]
-> Parser
     ([WitnessSigningData]
      -> [TxOutAnyEra]
      -> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
      -> Maybe SlotNo
      -> Maybe SlotNo
      -> Maybe Entropic
      -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
      -> [(StakeAddress, Entropic,
           Maybe (ScriptWitnessFiles WitCtxStake))]
      -> TxMetadataJsonSchema
      -> [ScriptFile]
      -> [MetadataFile]
      -> Maybe ProtocolParamsSourceSpec
      -> Maybe UpdateProposalFile
      -> TxBodyFile
      -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TxIn -> Parser [TxIn]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser TxIn
pTxInCollateral
               Parser
  ([WitnessSigningData]
   -> [TxOutAnyEra]
   -> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
   -> Maybe SlotNo
   -> Maybe SlotNo
   -> Maybe Entropic
   -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
   -> [(StakeAddress, Entropic,
        Maybe (ScriptWitnessFiles WitCtxStake))]
   -> TxMetadataJsonSchema
   -> [ScriptFile]
   -> [MetadataFile]
   -> Maybe ProtocolParamsSourceSpec
   -> Maybe UpdateProposalFile
   -> TxBodyFile
   -> TransactionCmd)
-> Parser [WitnessSigningData]
-> Parser
     ([TxOutAnyEra]
      -> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
      -> Maybe SlotNo
      -> Maybe SlotNo
      -> Maybe Entropic
      -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
      -> [(StakeAddress, Entropic,
           Maybe (ScriptWitnessFiles WitCtxStake))]
      -> TxMetadataJsonSchema
      -> [ScriptFile]
      -> [MetadataFile]
      -> Maybe ProtocolParamsSourceSpec
      -> Maybe UpdateProposalFile
      -> TxBodyFile
      -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser WitnessSigningData -> Parser [WitnessSigningData]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser WitnessSigningData
pRequiredSigner
               Parser
  ([TxOutAnyEra]
   -> Maybe (Value, [ScriptWitnessFiles WitCtxMint])
   -> Maybe SlotNo
   -> Maybe SlotNo
   -> Maybe Entropic
   -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
   -> [(StakeAddress, Entropic,
        Maybe (ScriptWitnessFiles WitCtxStake))]
   -> TxMetadataJsonSchema
   -> [ScriptFile]
   -> [MetadataFile]
   -> Maybe ProtocolParamsSourceSpec
   -> Maybe UpdateProposalFile
   -> TxBodyFile
   -> TransactionCmd)
-> Parser [TxOutAnyEra]
-> Parser
     (Maybe (Value, [ScriptWitnessFiles WitCtxMint])
      -> Maybe SlotNo
      -> Maybe SlotNo
      -> Maybe Entropic
      -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
      -> [(StakeAddress, Entropic,
           Maybe (ScriptWitnessFiles WitCtxStake))]
      -> TxMetadataJsonSchema
      -> [ScriptFile]
      -> [MetadataFile]
      -> Maybe ProtocolParamsSourceSpec
      -> Maybe UpdateProposalFile
      -> TxBodyFile
      -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TxOutAnyEra -> Parser [TxOutAnyEra]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser TxOutAnyEra
pTxOut
               Parser
  (Maybe (Value, [ScriptWitnessFiles WitCtxMint])
   -> Maybe SlotNo
   -> Maybe SlotNo
   -> Maybe Entropic
   -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
   -> [(StakeAddress, Entropic,
        Maybe (ScriptWitnessFiles WitCtxStake))]
   -> TxMetadataJsonSchema
   -> [ScriptFile]
   -> [MetadataFile]
   -> Maybe ProtocolParamsSourceSpec
   -> Maybe UpdateProposalFile
   -> TxBodyFile
   -> TransactionCmd)
-> Parser (Maybe (Value, [ScriptWitnessFiles WitCtxMint]))
-> Parser
     (Maybe SlotNo
      -> Maybe SlotNo
      -> Maybe Entropic
      -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
      -> [(StakeAddress, Entropic,
           Maybe (ScriptWitnessFiles WitCtxStake))]
      -> TxMetadataJsonSchema
      -> [ScriptFile]
      -> [MetadataFile]
      -> Maybe ProtocolParamsSourceSpec
      -> Maybe UpdateProposalFile
      -> TxBodyFile
      -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Value, [ScriptWitnessFiles WitCtxMint])
-> Parser (Maybe (Value, [ScriptWitnessFiles WitCtxMint]))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (BalanceTxExecUnits
-> Parser (Value, [ScriptWitnessFiles WitCtxMint])
pMintMultiAsset BalanceTxExecUnits
ManualBalance)
               Parser
  (Maybe SlotNo
   -> Maybe SlotNo
   -> Maybe Entropic
   -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
   -> [(StakeAddress, Entropic,
        Maybe (ScriptWitnessFiles WitCtxStake))]
   -> TxMetadataJsonSchema
   -> [ScriptFile]
   -> [MetadataFile]
   -> Maybe ProtocolParamsSourceSpec
   -> Maybe UpdateProposalFile
   -> TxBodyFile
   -> TransactionCmd)
-> Parser (Maybe SlotNo)
-> Parser
     (Maybe SlotNo
      -> Maybe Entropic
      -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
      -> [(StakeAddress, Entropic,
           Maybe (ScriptWitnessFiles WitCtxStake))]
      -> TxMetadataJsonSchema
      -> [ScriptFile]
      -> [MetadataFile]
      -> Maybe ProtocolParamsSourceSpec
      -> Maybe UpdateProposalFile
      -> TxBodyFile
      -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SlotNo -> Parser (Maybe SlotNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser SlotNo
pInvalidBefore
               Parser
  (Maybe SlotNo
   -> Maybe Entropic
   -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
   -> [(StakeAddress, Entropic,
        Maybe (ScriptWitnessFiles WitCtxStake))]
   -> TxMetadataJsonSchema
   -> [ScriptFile]
   -> [MetadataFile]
   -> Maybe ProtocolParamsSourceSpec
   -> Maybe UpdateProposalFile
   -> TxBodyFile
   -> TransactionCmd)
-> Parser (Maybe SlotNo)
-> Parser
     (Maybe Entropic
      -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
      -> [(StakeAddress, Entropic,
           Maybe (ScriptWitnessFiles WitCtxStake))]
      -> TxMetadataJsonSchema
      -> [ScriptFile]
      -> [MetadataFile]
      -> Maybe ProtocolParamsSourceSpec
      -> Maybe UpdateProposalFile
      -> TxBodyFile
      -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SlotNo -> Parser (Maybe SlotNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser SlotNo
pInvalidHereafter
               Parser
  (Maybe Entropic
   -> [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
   -> [(StakeAddress, Entropic,
        Maybe (ScriptWitnessFiles WitCtxStake))]
   -> TxMetadataJsonSchema
   -> [ScriptFile]
   -> [MetadataFile]
   -> Maybe ProtocolParamsSourceSpec
   -> Maybe UpdateProposalFile
   -> TxBodyFile
   -> TransactionCmd)
-> Parser (Maybe Entropic)
-> Parser
     ([(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
      -> [(StakeAddress, Entropic,
           Maybe (ScriptWitnessFiles WitCtxStake))]
      -> TxMetadataJsonSchema
      -> [ScriptFile]
      -> [MetadataFile]
      -> Maybe ProtocolParamsSourceSpec
      -> Maybe UpdateProposalFile
      -> TxBodyFile
      -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Entropic -> Parser (Maybe Entropic)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Entropic
pTxFee
               Parser
  ([(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
   -> [(StakeAddress, Entropic,
        Maybe (ScriptWitnessFiles WitCtxStake))]
   -> TxMetadataJsonSchema
   -> [ScriptFile]
   -> [MetadataFile]
   -> Maybe ProtocolParamsSourceSpec
   -> Maybe UpdateProposalFile
   -> TxBodyFile
   -> TransactionCmd)
-> Parser
     [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
-> Parser
     ([(StakeAddress, Entropic, Maybe (ScriptWitnessFiles WitCtxStake))]
      -> TxMetadataJsonSchema
      -> [ScriptFile]
      -> [MetadataFile]
      -> Maybe ProtocolParamsSourceSpec
      -> Maybe UpdateProposalFile
      -> TxBodyFile
      -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))
-> Parser
     [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (BalanceTxExecUnits
-> Parser (CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))
pCertificateFile BalanceTxExecUnits
ManualBalance )
               Parser
  ([(StakeAddress, Entropic, Maybe (ScriptWitnessFiles WitCtxStake))]
   -> TxMetadataJsonSchema
   -> [ScriptFile]
   -> [MetadataFile]
   -> Maybe ProtocolParamsSourceSpec
   -> Maybe UpdateProposalFile
   -> TxBodyFile
   -> TransactionCmd)
-> Parser
     [(StakeAddress, Entropic, Maybe (ScriptWitnessFiles WitCtxStake))]
-> Parser
     (TxMetadataJsonSchema
      -> [ScriptFile]
      -> [MetadataFile]
      -> Maybe ProtocolParamsSourceSpec
      -> Maybe UpdateProposalFile
      -> TxBodyFile
      -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser
  (StakeAddress, Entropic, Maybe (ScriptWitnessFiles WitCtxStake))
-> Parser
     [(StakeAddress, Entropic, Maybe (ScriptWitnessFiles WitCtxStake))]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (BalanceTxExecUnits
-> Parser
     (StakeAddress, Entropic, Maybe (ScriptWitnessFiles WitCtxStake))
pWithdrawal BalanceTxExecUnits
ManualBalance)
               Parser
  (TxMetadataJsonSchema
   -> [ScriptFile]
   -> [MetadataFile]
   -> Maybe ProtocolParamsSourceSpec
   -> Maybe UpdateProposalFile
   -> TxBodyFile
   -> TransactionCmd)
-> Parser TxMetadataJsonSchema
-> Parser
     ([ScriptFile]
      -> [MetadataFile]
      -> Maybe ProtocolParamsSourceSpec
      -> Maybe UpdateProposalFile
      -> TxBodyFile
      -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TxMetadataJsonSchema
pTxMetadataJsonSchema
               Parser
  ([ScriptFile]
   -> [MetadataFile]
   -> Maybe ProtocolParamsSourceSpec
   -> Maybe UpdateProposalFile
   -> TxBodyFile
   -> TransactionCmd)
-> Parser [ScriptFile]
-> Parser
     ([MetadataFile]
      -> Maybe ProtocolParamsSourceSpec
      -> Maybe UpdateProposalFile
      -> TxBodyFile
      -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ScriptFile -> Parser [ScriptFile]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (String -> Maybe String -> String -> Parser ScriptFile
pScriptFor
                           String
"auxiliary-script-file"
                           Maybe String
forall a. Maybe a
Nothing
                           String
"Filepath of auxiliary script(s)")
               Parser
  ([MetadataFile]
   -> Maybe ProtocolParamsSourceSpec
   -> Maybe UpdateProposalFile
   -> TxBodyFile
   -> TransactionCmd)
-> Parser [MetadataFile]
-> Parser
     (Maybe ProtocolParamsSourceSpec
      -> Maybe UpdateProposalFile -> TxBodyFile -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser MetadataFile -> Parser [MetadataFile]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser MetadataFile
pMetadataFile
               Parser
  (Maybe ProtocolParamsSourceSpec
   -> Maybe UpdateProposalFile -> TxBodyFile -> TransactionCmd)
-> Parser (Maybe ProtocolParamsSourceSpec)
-> Parser
     (Maybe UpdateProposalFile -> TxBodyFile -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ProtocolParamsSourceSpec
-> Parser (Maybe ProtocolParamsSourceSpec)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ProtocolParamsSourceSpec
pProtocolParamsSourceSpec
               Parser (Maybe UpdateProposalFile -> TxBodyFile -> TransactionCmd)
-> Parser (Maybe UpdateProposalFile)
-> Parser (TxBodyFile -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser UpdateProposalFile -> Parser (Maybe UpdateProposalFile)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser UpdateProposalFile
pUpdateProposalFile
               Parser (TxBodyFile -> TransactionCmd)
-> Parser TxBodyFile -> Parser TransactionCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FileDirection -> Parser TxBodyFile
pTxBodyFile FileDirection
Output

  pTransactionSign  :: Parser TransactionCmd
  pTransactionSign :: Parser TransactionCmd
pTransactionSign = TxBodyFile
-> [WitnessSigningData]
-> Maybe NetworkId
-> TxFile
-> TransactionCmd
TxSign (TxBodyFile
 -> [WitnessSigningData]
 -> Maybe NetworkId
 -> TxFile
 -> TransactionCmd)
-> Parser TxBodyFile
-> Parser
     ([WitnessSigningData]
      -> Maybe NetworkId -> TxFile -> TransactionCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileDirection -> Parser TxBodyFile
pTxBodyFile FileDirection
Input
                            Parser
  ([WitnessSigningData]
   -> Maybe NetworkId -> TxFile -> TransactionCmd)
-> Parser [WitnessSigningData]
-> Parser (Maybe NetworkId -> TxFile -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [WitnessSigningData]
pSomeWitnessSigningData
                            Parser (Maybe NetworkId -> TxFile -> TransactionCmd)
-> Parser (Maybe NetworkId) -> Parser (TxFile -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser NetworkId -> Parser (Maybe NetworkId)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser NetworkId
pNetworkId
                            Parser (TxFile -> TransactionCmd)
-> Parser TxFile -> Parser TransactionCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FileDirection -> Parser TxFile
pTxFile FileDirection
Output

  pTransactionCreateWitness :: Parser TransactionCmd
  pTransactionCreateWitness :: Parser TransactionCmd
pTransactionCreateWitness = TxBodyFile
-> WitnessSigningData
-> Maybe NetworkId
-> OutputFile
-> TransactionCmd
TxCreateWitness
                                (TxBodyFile
 -> WitnessSigningData
 -> Maybe NetworkId
 -> OutputFile
 -> TransactionCmd)
-> Parser TxBodyFile
-> Parser
     (WitnessSigningData
      -> Maybe NetworkId -> OutputFile -> TransactionCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileDirection -> Parser TxBodyFile
pTxBodyFile FileDirection
Input
                                Parser
  (WitnessSigningData
   -> Maybe NetworkId -> OutputFile -> TransactionCmd)
-> Parser WitnessSigningData
-> Parser (Maybe NetworkId -> OutputFile -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser WitnessSigningData
pWitnessSigningData
                                Parser (Maybe NetworkId -> OutputFile -> TransactionCmd)
-> Parser (Maybe NetworkId)
-> Parser (OutputFile -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser NetworkId -> Parser (Maybe NetworkId)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser NetworkId
pNetworkId
                                Parser (OutputFile -> TransactionCmd)
-> Parser OutputFile -> Parser TransactionCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser OutputFile
pOutputFile

  pTransactionAssembleTxBodyWit :: Parser TransactionCmd
  pTransactionAssembleTxBodyWit :: Parser TransactionCmd
pTransactionAssembleTxBodyWit = TxBodyFile -> [WitnessFile] -> OutputFile -> TransactionCmd
TxAssembleTxBodyWitness
                                    (TxBodyFile -> [WitnessFile] -> OutputFile -> TransactionCmd)
-> Parser TxBodyFile
-> Parser ([WitnessFile] -> OutputFile -> TransactionCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileDirection -> Parser TxBodyFile
pTxBodyFile FileDirection
Input
                                    Parser ([WitnessFile] -> OutputFile -> TransactionCmd)
-> Parser [WitnessFile] -> Parser (OutputFile -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser WitnessFile -> Parser [WitnessFile]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser WitnessFile
pWitnessFile
                                    Parser (OutputFile -> TransactionCmd)
-> Parser OutputFile -> Parser TransactionCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser OutputFile
pOutputFile

  pTransactionSubmit :: Parser TransactionCmd
  pTransactionSubmit :: Parser TransactionCmd
pTransactionSubmit = AnyConsensusModeParams -> NetworkId -> String -> TransactionCmd
TxSubmit (AnyConsensusModeParams -> NetworkId -> String -> TransactionCmd)
-> Parser AnyConsensusModeParams
-> Parser (NetworkId -> String -> TransactionCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser AnyConsensusModeParams
pConsensusModeParams
                                Parser (NetworkId -> String -> TransactionCmd)
-> Parser NetworkId -> Parser (String -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser NetworkId
pNetworkId
                                Parser (String -> TransactionCmd)
-> Parser String -> Parser TransactionCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String
pTxSubmitFile

  pTransactionPolicyId :: Parser TransactionCmd
  pTransactionPolicyId :: Parser TransactionCmd
pTransactionPolicyId = ScriptFile -> TransactionCmd
TxMintedPolicyId (ScriptFile -> TransactionCmd)
-> Parser ScriptFile -> Parser TransactionCmd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ScriptFile
pScript

  pTransactionCalculateMinFee :: Parser TransactionCmd
  pTransactionCalculateMinFee :: Parser TransactionCmd
pTransactionCalculateMinFee =
    TxBodyFile
-> Maybe NetworkId
-> ProtocolParamsSourceSpec
-> TxInCount
-> TxOutCount
-> TxSophieWitnessCount
-> TxColeWitnessCount
-> TransactionCmd
TxCalculateMinFee
      (TxBodyFile
 -> Maybe NetworkId
 -> ProtocolParamsSourceSpec
 -> TxInCount
 -> TxOutCount
 -> TxSophieWitnessCount
 -> TxColeWitnessCount
 -> TransactionCmd)
-> Parser TxBodyFile
-> Parser
     (Maybe NetworkId
      -> ProtocolParamsSourceSpec
      -> TxInCount
      -> TxOutCount
      -> TxSophieWitnessCount
      -> TxColeWitnessCount
      -> TransactionCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileDirection -> Parser TxBodyFile
pTxBodyFile FileDirection
Input
      Parser
  (Maybe NetworkId
   -> ProtocolParamsSourceSpec
   -> TxInCount
   -> TxOutCount
   -> TxSophieWitnessCount
   -> TxColeWitnessCount
   -> TransactionCmd)
-> Parser (Maybe NetworkId)
-> Parser
     (ProtocolParamsSourceSpec
      -> TxInCount
      -> TxOutCount
      -> TxSophieWitnessCount
      -> TxColeWitnessCount
      -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser NetworkId -> Parser (Maybe NetworkId)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser NetworkId
pNetworkId
      Parser
  (ProtocolParamsSourceSpec
   -> TxInCount
   -> TxOutCount
   -> TxSophieWitnessCount
   -> TxColeWitnessCount
   -> TransactionCmd)
-> Parser ProtocolParamsSourceSpec
-> Parser
     (TxInCount
      -> TxOutCount
      -> TxSophieWitnessCount
      -> TxColeWitnessCount
      -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ProtocolParamsSourceSpec
pProtocolParamsSourceSpec
      Parser
  (TxInCount
   -> TxOutCount
   -> TxSophieWitnessCount
   -> TxColeWitnessCount
   -> TransactionCmd)
-> Parser TxInCount
-> Parser
     (TxOutCount
      -> TxSophieWitnessCount -> TxColeWitnessCount -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TxInCount
pTxInCount
      Parser
  (TxOutCount
   -> TxSophieWitnessCount -> TxColeWitnessCount -> TransactionCmd)
-> Parser TxOutCount
-> Parser
     (TxSophieWitnessCount -> TxColeWitnessCount -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TxOutCount
pTxOutCount
      Parser
  (TxSophieWitnessCount -> TxColeWitnessCount -> TransactionCmd)
-> Parser TxSophieWitnessCount
-> Parser (TxColeWitnessCount -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TxSophieWitnessCount
pTxSophieWitnessCount
      Parser (TxColeWitnessCount -> TransactionCmd)
-> Parser TxColeWitnessCount -> Parser TransactionCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TxColeWitnessCount
pTxColeWitnessCount

  pTransactionCalculateMinReqUTxO :: Parser TransactionCmd
  pTransactionCalculateMinReqUTxO :: Parser TransactionCmd
pTransactionCalculateMinReqUTxO = AnyBccEra
-> ProtocolParamsSourceSpec -> TxOutAnyEra -> TransactionCmd
TxCalculateMinRequiredUTxO
    (AnyBccEra
 -> ProtocolParamsSourceSpec -> TxOutAnyEra -> TransactionCmd)
-> Parser AnyBccEra
-> Parser
     (ProtocolParamsSourceSpec -> TxOutAnyEra -> TransactionCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser AnyBccEra
pBccEra
    Parser (ProtocolParamsSourceSpec -> TxOutAnyEra -> TransactionCmd)
-> Parser ProtocolParamsSourceSpec
-> Parser (TxOutAnyEra -> TransactionCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ProtocolParamsSourceSpec
pProtocolParamsSourceSpec
    Parser (TxOutAnyEra -> TransactionCmd)
-> Parser TxOutAnyEra -> Parser TransactionCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TxOutAnyEra
pTxOut

  pProtocolParamsSourceSpec :: Parser ProtocolParamsSourceSpec
  pProtocolParamsSourceSpec :: Parser ProtocolParamsSourceSpec
pProtocolParamsSourceSpec =
    GenesisFile -> ProtocolParamsSourceSpec
ParamsFromGenesis (GenesisFile -> ProtocolParamsSourceSpec)
-> Parser GenesisFile -> Parser ProtocolParamsSourceSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      String -> Parser GenesisFile
pGenesisFile
        String
"[TESTING] The genesis file to take initial protocol parameters from.  For test clusters only, since the parameters are going to be obsolete for production clusters."
    Parser ProtocolParamsSourceSpec
-> Parser ProtocolParamsSourceSpec
-> Parser ProtocolParamsSourceSpec
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    ProtocolParamsFile -> ProtocolParamsSourceSpec
ParamsFromFile (ProtocolParamsFile -> ProtocolParamsSourceSpec)
-> Parser ProtocolParamsFile -> Parser ProtocolParamsSourceSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ProtocolParamsFile
pProtocolParamsFile

  pTxHashScriptData :: Parser TransactionCmd
  pTxHashScriptData :: Parser TransactionCmd
pTxHashScriptData = ScriptRedeemerOrFile -> TransactionCmd
TxHashScriptData (ScriptRedeemerOrFile -> TransactionCmd)
-> Parser ScriptRedeemerOrFile -> Parser TransactionCmd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Parser ScriptRedeemerOrFile
pScriptDataOrFile String
"script-data"

  pTransactionId  :: Parser TransactionCmd
  pTransactionId :: Parser TransactionCmd
pTransactionId = InputTxFile -> TransactionCmd
TxGetTxId (InputTxFile -> TransactionCmd)
-> Parser InputTxFile -> Parser TransactionCmd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser InputTxFile
pInputTxFile

  pTransactionView :: Parser TransactionCmd
  pTransactionView :: Parser TransactionCmd
pTransactionView = InputTxFile -> TransactionCmd
TxView (InputTxFile -> TransactionCmd)
-> Parser InputTxFile -> Parser TransactionCmd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser InputTxFile
pInputTxFile

pNodeCmd :: Parser NodeCmd
pNodeCmd :: Parser NodeCmd
pNodeCmd =
  [Parser NodeCmd] -> Parser NodeCmd
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ String -> ParserInfo NodeCmd -> Parser NodeCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"key-gen"
        (Parser NodeCmd -> InfoMod NodeCmd -> ParserInfo NodeCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser NodeCmd
pKeyGenOperator (InfoMod NodeCmd -> ParserInfo NodeCmd)
-> InfoMod NodeCmd -> ParserInfo NodeCmd
forall a b. (a -> b) -> a -> b
$
           String -> InfoMod NodeCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Create a key pair for a node operator's offline \
                       \ key and a new certificate issue counter")
    , String -> ParserInfo NodeCmd -> Parser NodeCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"key-gen-KES"
        (Parser NodeCmd -> InfoMod NodeCmd -> ParserInfo NodeCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser NodeCmd
pKeyGenKES (InfoMod NodeCmd -> ParserInfo NodeCmd)
-> InfoMod NodeCmd -> ParserInfo NodeCmd
forall a b. (a -> b) -> a -> b
$
           String -> InfoMod NodeCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Create a key pair for a node KES operational key")
    , String -> ParserInfo NodeCmd -> Parser NodeCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"key-gen-VRF"
        (Parser NodeCmd -> InfoMod NodeCmd -> ParserInfo NodeCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser NodeCmd
pKeyGenVRF (InfoMod NodeCmd -> ParserInfo NodeCmd)
-> InfoMod NodeCmd -> ParserInfo NodeCmd
forall a b. (a -> b) -> a -> b
$
           String -> InfoMod NodeCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Create a key pair for a node VRF operational key")
    , String -> ParserInfo NodeCmd -> Parser NodeCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"key-hash-VRF"
        (Parser NodeCmd -> InfoMod NodeCmd -> ParserInfo NodeCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser NodeCmd
pKeyHashVRF (InfoMod NodeCmd -> ParserInfo NodeCmd)
-> InfoMod NodeCmd -> ParserInfo NodeCmd
forall a b. (a -> b) -> a -> b
$
           String -> InfoMod NodeCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Print hash of a node's operational VRF key.")
    , String -> ParserInfo NodeCmd -> Parser NodeCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"new-counter"
        (Parser NodeCmd -> InfoMod NodeCmd -> ParserInfo NodeCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser NodeCmd
pNewCounter (InfoMod NodeCmd -> ParserInfo NodeCmd)
-> InfoMod NodeCmd -> ParserInfo NodeCmd
forall a b. (a -> b) -> a -> b
$
           String -> InfoMod NodeCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Create a new certificate issue counter")
    , String -> ParserInfo NodeCmd -> Parser NodeCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"issue-op-cert"
        (Parser NodeCmd -> InfoMod NodeCmd -> ParserInfo NodeCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser NodeCmd
pIssueOpCert (InfoMod NodeCmd -> ParserInfo NodeCmd)
-> InfoMod NodeCmd -> ParserInfo NodeCmd
forall a b. (a -> b) -> a -> b
$
           String -> InfoMod NodeCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Issue a node operational certificate")
    ]
  where
    pKeyGenOperator :: Parser NodeCmd
    pKeyGenOperator :: Parser NodeCmd
pKeyGenOperator =
      VerificationKeyFile
-> SigningKeyFile -> OpCertCounterFile -> NodeCmd
NodeKeyGenCold (VerificationKeyFile
 -> SigningKeyFile -> OpCertCounterFile -> NodeCmd)
-> Parser VerificationKeyFile
-> Parser (SigningKeyFile -> OpCertCounterFile -> NodeCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VerificationKeyFile
pColdVerificationKeyFile
                     Parser (SigningKeyFile -> OpCertCounterFile -> NodeCmd)
-> Parser SigningKeyFile -> Parser (OpCertCounterFile -> NodeCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SigningKeyFile
pColdSigningKeyFile
                     Parser (OpCertCounterFile -> NodeCmd)
-> Parser OpCertCounterFile -> Parser NodeCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser OpCertCounterFile
pOperatorCertIssueCounterFile

    pKeyGenKES :: Parser NodeCmd
    pKeyGenKES :: Parser NodeCmd
pKeyGenKES =
      VerificationKeyFile -> SigningKeyFile -> NodeCmd
NodeKeyGenKES (VerificationKeyFile -> SigningKeyFile -> NodeCmd)
-> Parser VerificationKeyFile -> Parser (SigningKeyFile -> NodeCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileDirection -> Parser VerificationKeyFile
pVerificationKeyFile FileDirection
Output Parser (SigningKeyFile -> NodeCmd)
-> Parser SigningKeyFile -> Parser NodeCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FileDirection -> Parser SigningKeyFile
pSigningKeyFile FileDirection
Output

    pKeyGenVRF :: Parser NodeCmd
    pKeyGenVRF :: Parser NodeCmd
pKeyGenVRF =
      VerificationKeyFile -> SigningKeyFile -> NodeCmd
NodeKeyGenVRF (VerificationKeyFile -> SigningKeyFile -> NodeCmd)
-> Parser VerificationKeyFile -> Parser (SigningKeyFile -> NodeCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileDirection -> Parser VerificationKeyFile
pVerificationKeyFile FileDirection
Output Parser (SigningKeyFile -> NodeCmd)
-> Parser SigningKeyFile -> Parser NodeCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FileDirection -> Parser SigningKeyFile
pSigningKeyFile FileDirection
Output

    pKeyHashVRF :: Parser NodeCmd
    pKeyHashVRF :: Parser NodeCmd
pKeyHashVRF =
      VerificationKeyOrFile VrfKey -> Maybe OutputFile -> NodeCmd
NodeKeyHashVRF (VerificationKeyOrFile VrfKey -> Maybe OutputFile -> NodeCmd)
-> Parser (VerificationKeyOrFile VrfKey)
-> Parser (Maybe OutputFile -> NodeCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsType VrfKey -> Parser (VerificationKeyOrFile VrfKey)
forall keyrole.
SerialiseAsBech32 (VerificationKey keyrole) =>
AsType keyrole -> Parser (VerificationKeyOrFile keyrole)
pVerificationKeyOrFile AsType VrfKey
AsVrfKey Parser (Maybe OutputFile -> NodeCmd)
-> Parser (Maybe OutputFile) -> Parser NodeCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe OutputFile)
pMaybeOutputFile

    pNewCounter :: Parser NodeCmd
    pNewCounter :: Parser NodeCmd
pNewCounter =
      ColdVerificationKeyOrFile -> Word -> OpCertCounterFile -> NodeCmd
NodeNewCounter (ColdVerificationKeyOrFile -> Word -> OpCertCounterFile -> NodeCmd)
-> Parser ColdVerificationKeyOrFile
-> Parser (Word -> OpCertCounterFile -> NodeCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ColdVerificationKeyOrFile
pColdVerificationKeyOrFile
                     Parser (Word -> OpCertCounterFile -> NodeCmd)
-> Parser Word -> Parser (OpCertCounterFile -> NodeCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word
pCounterValue
                     Parser (OpCertCounterFile -> NodeCmd)
-> Parser OpCertCounterFile -> Parser NodeCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser OpCertCounterFile
pOperatorCertIssueCounterFile

    pCounterValue :: Parser Word
    pCounterValue :: Parser Word
pCounterValue =
        ReadM Word -> Mod OptionFields Word -> Parser Word
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word
forall a. Read a => ReadM a
Opt.auto
          (  String -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"counter-value"
          Mod OptionFields Word
-> Mod OptionFields Word -> Mod OptionFields Word
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"INT"
          Mod OptionFields Word
-> Mod OptionFields Word -> Mod OptionFields Word
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The next certificate issue counter value to use."
          )

    pIssueOpCert :: Parser NodeCmd
    pIssueOpCert :: Parser NodeCmd
pIssueOpCert =
      VerificationKeyOrFile KesKey
-> SigningKeyFile
-> OpCertCounterFile
-> KESPeriod
-> OutputFile
-> NodeCmd
NodeIssueOpCert (VerificationKeyOrFile KesKey
 -> SigningKeyFile
 -> OpCertCounterFile
 -> KESPeriod
 -> OutputFile
 -> NodeCmd)
-> Parser (VerificationKeyOrFile KesKey)
-> Parser
     (SigningKeyFile
      -> OpCertCounterFile -> KESPeriod -> OutputFile -> NodeCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyOrFile KesKey)
pKesVerificationKeyOrFile
                      Parser
  (SigningKeyFile
   -> OpCertCounterFile -> KESPeriod -> OutputFile -> NodeCmd)
-> Parser SigningKeyFile
-> Parser (OpCertCounterFile -> KESPeriod -> OutputFile -> NodeCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SigningKeyFile
pColdSigningKeyFile
                      Parser (OpCertCounterFile -> KESPeriod -> OutputFile -> NodeCmd)
-> Parser OpCertCounterFile
-> Parser (KESPeriod -> OutputFile -> NodeCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser OpCertCounterFile
pOperatorCertIssueCounterFile
                      Parser (KESPeriod -> OutputFile -> NodeCmd)
-> Parser KESPeriod -> Parser (OutputFile -> NodeCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser KESPeriod
pKesPeriod
                      Parser (OutputFile -> NodeCmd)
-> Parser OutputFile -> Parser NodeCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser OutputFile
pOutputFile


pPoolCmd :: Parser PoolCmd
pPoolCmd :: Parser PoolCmd
pPoolCmd =
  [Parser PoolCmd] -> Parser PoolCmd
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
      [ String -> ParserInfo PoolCmd -> Parser PoolCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"registration-certificate"
          (Parser PoolCmd -> InfoMod PoolCmd -> ParserInfo PoolCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser PoolCmd
pStakePoolRegistrationCert (InfoMod PoolCmd -> ParserInfo PoolCmd)
-> InfoMod PoolCmd -> ParserInfo PoolCmd
forall a b. (a -> b) -> a -> b
$ String -> InfoMod PoolCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Create a stake pool registration certificate")
      , String -> ParserInfo PoolCmd -> Parser PoolCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"deregistration-certificate"
          (Parser PoolCmd -> InfoMod PoolCmd -> ParserInfo PoolCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser PoolCmd
pStakePoolRetirementCert (InfoMod PoolCmd -> ParserInfo PoolCmd)
-> InfoMod PoolCmd -> ParserInfo PoolCmd
forall a b. (a -> b) -> a -> b
$ String -> InfoMod PoolCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Create a stake pool deregistration certificate")
      , String -> ParserInfo PoolCmd -> Parser PoolCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"id"
          (Parser PoolCmd -> InfoMod PoolCmd -> ParserInfo PoolCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser PoolCmd
pId (InfoMod PoolCmd -> ParserInfo PoolCmd)
-> InfoMod PoolCmd -> ParserInfo PoolCmd
forall a b. (a -> b) -> a -> b
$
             String -> InfoMod PoolCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Build pool id from the offline key")
      , String -> ParserInfo PoolCmd -> Parser PoolCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"metadata-hash"
          (Parser PoolCmd -> InfoMod PoolCmd -> ParserInfo PoolCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser PoolCmd
pPoolMetadataHashSubCmd (InfoMod PoolCmd -> ParserInfo PoolCmd)
-> InfoMod PoolCmd -> ParserInfo PoolCmd
forall a b. (a -> b) -> a -> b
$ String -> InfoMod PoolCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Print the hash of pool metadata.")
      ]
  where
    pId :: Parser PoolCmd
    pId :: Parser PoolCmd
pId = VerificationKeyOrFile StakePoolKey -> OutputFormat -> PoolCmd
PoolGetId (VerificationKeyOrFile StakePoolKey -> OutputFormat -> PoolCmd)
-> Parser (VerificationKeyOrFile StakePoolKey)
-> Parser (OutputFormat -> PoolCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyOrFile StakePoolKey)
pStakePoolVerificationKeyOrFile Parser (OutputFormat -> PoolCmd)
-> Parser OutputFormat -> Parser PoolCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser OutputFormat
pOutputFormat

    pPoolMetadataHashSubCmd :: Parser PoolCmd
    pPoolMetadataHashSubCmd :: Parser PoolCmd
pPoolMetadataHashSubCmd = PoolMetadataFile -> Maybe OutputFile -> PoolCmd
PoolMetadataHash (PoolMetadataFile -> Maybe OutputFile -> PoolCmd)
-> Parser PoolMetadataFile -> Parser (Maybe OutputFile -> PoolCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PoolMetadataFile
pPoolMetadataFile Parser (Maybe OutputFile -> PoolCmd)
-> Parser (Maybe OutputFile) -> Parser PoolCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe OutputFile)
pMaybeOutputFile


pQueryCmd :: Parser QueryCmd
pQueryCmd :: Parser QueryCmd
pQueryCmd =
  [Parser QueryCmd] -> Parser QueryCmd
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ String -> ParserInfo QueryCmd -> Parser QueryCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"protocol-parameters"
        (Parser QueryCmd -> InfoMod QueryCmd -> ParserInfo QueryCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser QueryCmd
pQueryProtocolParameters (InfoMod QueryCmd -> ParserInfo QueryCmd)
-> InfoMod QueryCmd -> ParserInfo QueryCmd
forall a b. (a -> b) -> a -> b
$ String -> InfoMod QueryCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Get the node's current protocol parameters")
    , String -> ParserInfo QueryCmd -> Parser QueryCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"tip"
        (Parser QueryCmd -> InfoMod QueryCmd -> ParserInfo QueryCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser QueryCmd
pQueryTip (InfoMod QueryCmd -> ParserInfo QueryCmd)
-> InfoMod QueryCmd -> ParserInfo QueryCmd
forall a b. (a -> b) -> a -> b
$ String -> InfoMod QueryCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Get the node's current tip (slot no, hash, block no)")
    , String -> ParserInfo QueryCmd -> Parser QueryCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"stake-pools"
        (Parser QueryCmd -> InfoMod QueryCmd -> ParserInfo QueryCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser QueryCmd
pQueryStakePools (InfoMod QueryCmd -> ParserInfo QueryCmd)
-> InfoMod QueryCmd -> ParserInfo QueryCmd
forall a b. (a -> b) -> a -> b
$ String -> InfoMod QueryCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Get the node's current set of stake pool ids")
    , String -> ParserInfo QueryCmd -> Parser QueryCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"stake-distribution"
        (Parser QueryCmd -> InfoMod QueryCmd -> ParserInfo QueryCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser QueryCmd
pQueryStakeDistribution (InfoMod QueryCmd -> ParserInfo QueryCmd)
-> InfoMod QueryCmd -> ParserInfo QueryCmd
forall a b. (a -> b) -> a -> b
$ String -> InfoMod QueryCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Get the node's current aggregated stake distribution")
    , String -> ParserInfo QueryCmd -> Parser QueryCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"stake-address-info"
        (Parser QueryCmd -> InfoMod QueryCmd -> ParserInfo QueryCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser QueryCmd
pQueryStakeAddressInfo (InfoMod QueryCmd -> ParserInfo QueryCmd)
-> InfoMod QueryCmd -> ParserInfo QueryCmd
forall a b. (a -> b) -> a -> b
$ String -> InfoMod QueryCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Get the current delegations and \
                                                        \reward accounts filtered by stake \
                                                        \address.")
    , String -> ParserInfo QueryCmd -> Parser QueryCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"utxo"
        (Parser QueryCmd -> InfoMod QueryCmd -> ParserInfo QueryCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser QueryCmd
pQueryUTxO (InfoMod QueryCmd -> ParserInfo QueryCmd)
-> InfoMod QueryCmd -> ParserInfo QueryCmd
forall a b. (a -> b) -> a -> b
$ String -> InfoMod QueryCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Get a portion of the current UTxO: \
                                            \by tx in, by address or the whole.")
    , String -> ParserInfo QueryCmd -> Parser QueryCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"ledger-state"
        (Parser QueryCmd -> InfoMod QueryCmd -> ParserInfo QueryCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser QueryCmd
pQueryLedgerState (InfoMod QueryCmd -> ParserInfo QueryCmd)
-> InfoMod QueryCmd -> ParserInfo QueryCmd
forall a b. (a -> b) -> a -> b
$ String -> InfoMod QueryCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Dump the current ledger state of the node (Ledger.NewEpochState -- advanced command)")
    , String -> ParserInfo QueryCmd -> Parser QueryCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"protocol-state"
        (Parser QueryCmd -> InfoMod QueryCmd -> ParserInfo QueryCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser QueryCmd
pQueryProtocolState (InfoMod QueryCmd -> ParserInfo QueryCmd)
-> InfoMod QueryCmd -> ParserInfo QueryCmd
forall a b. (a -> b) -> a -> b
$ String -> InfoMod QueryCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Dump the current protocol state of the node (Ledger.ChainDepState -- advanced command)")
    , String -> ParserInfo QueryCmd -> Parser QueryCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"stake-snapshot"
        (Parser QueryCmd -> InfoMod QueryCmd -> ParserInfo QueryCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser QueryCmd
pQueryStakeSnapshot (InfoMod QueryCmd -> ParserInfo QueryCmd)
-> InfoMod QueryCmd -> ParserInfo QueryCmd
forall a b. (a -> b) -> a -> b
$ String -> InfoMod QueryCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Obtain the three stake snapshots for a pool, plus the total active stake (advanced command)")
    , String -> ParserInfo QueryCmd -> Parser QueryCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"pool-params"
        (Parser QueryCmd -> InfoMod QueryCmd -> ParserInfo QueryCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser QueryCmd
pQueryPoolParams (InfoMod QueryCmd -> ParserInfo QueryCmd)
-> InfoMod QueryCmd -> ParserInfo QueryCmd
forall a b. (a -> b) -> a -> b
$ String -> InfoMod QueryCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Dump the pool parameters (Ledger.NewEpochState.esLState._delegationState._pState._pParams -- advanced command)")
    ]
  where
    pQueryProtocolParameters :: Parser QueryCmd
    pQueryProtocolParameters :: Parser QueryCmd
pQueryProtocolParameters =
      AnyConsensusModeParams -> NetworkId -> Maybe OutputFile -> QueryCmd
QueryProtocolParameters'
        (AnyConsensusModeParams
 -> NetworkId -> Maybe OutputFile -> QueryCmd)
-> Parser AnyConsensusModeParams
-> Parser (NetworkId -> Maybe OutputFile -> QueryCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser AnyConsensusModeParams
pConsensusModeParams
        Parser (NetworkId -> Maybe OutputFile -> QueryCmd)
-> Parser NetworkId -> Parser (Maybe OutputFile -> QueryCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser NetworkId
pNetworkId
        Parser (Maybe OutputFile -> QueryCmd)
-> Parser (Maybe OutputFile) -> Parser QueryCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe OutputFile)
pMaybeOutputFile

    pQueryTip :: Parser QueryCmd
    pQueryTip :: Parser QueryCmd
pQueryTip = AnyConsensusModeParams -> NetworkId -> Maybe OutputFile -> QueryCmd
QueryTip
                  (AnyConsensusModeParams
 -> NetworkId -> Maybe OutputFile -> QueryCmd)
-> Parser AnyConsensusModeParams
-> Parser (NetworkId -> Maybe OutputFile -> QueryCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser AnyConsensusModeParams
pConsensusModeParams
                  Parser (NetworkId -> Maybe OutputFile -> QueryCmd)
-> Parser NetworkId -> Parser (Maybe OutputFile -> QueryCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser NetworkId
pNetworkId
                  Parser (Maybe OutputFile -> QueryCmd)
-> Parser (Maybe OutputFile) -> Parser QueryCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe OutputFile)
pMaybeOutputFile

    pQueryUTxO :: Parser QueryCmd
    pQueryUTxO :: Parser QueryCmd
pQueryUTxO =
      AnyConsensusModeParams
-> QueryUTxOFilter -> NetworkId -> Maybe OutputFile -> QueryCmd
QueryUTxO'
        (AnyConsensusModeParams
 -> QueryUTxOFilter -> NetworkId -> Maybe OutputFile -> QueryCmd)
-> Parser AnyConsensusModeParams
-> Parser
     (QueryUTxOFilter -> NetworkId -> Maybe OutputFile -> QueryCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser AnyConsensusModeParams
pConsensusModeParams
        Parser
  (QueryUTxOFilter -> NetworkId -> Maybe OutputFile -> QueryCmd)
-> Parser QueryUTxOFilter
-> Parser (NetworkId -> Maybe OutputFile -> QueryCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser QueryUTxOFilter
pQueryUTxOFilter
        Parser (NetworkId -> Maybe OutputFile -> QueryCmd)
-> Parser NetworkId -> Parser (Maybe OutputFile -> QueryCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser NetworkId
pNetworkId
        Parser (Maybe OutputFile -> QueryCmd)
-> Parser (Maybe OutputFile) -> Parser QueryCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe OutputFile)
pMaybeOutputFile

    pQueryStakePools :: Parser QueryCmd
    pQueryStakePools :: Parser QueryCmd
pQueryStakePools =
      AnyConsensusModeParams -> NetworkId -> Maybe OutputFile -> QueryCmd
QueryStakePools'
        (AnyConsensusModeParams
 -> NetworkId -> Maybe OutputFile -> QueryCmd)
-> Parser AnyConsensusModeParams
-> Parser (NetworkId -> Maybe OutputFile -> QueryCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser AnyConsensusModeParams
pConsensusModeParams
        Parser (NetworkId -> Maybe OutputFile -> QueryCmd)
-> Parser NetworkId -> Parser (Maybe OutputFile -> QueryCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser NetworkId
pNetworkId
        Parser (Maybe OutputFile -> QueryCmd)
-> Parser (Maybe OutputFile) -> Parser QueryCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe OutputFile)
pMaybeOutputFile

    pQueryStakeDistribution :: Parser QueryCmd
    pQueryStakeDistribution :: Parser QueryCmd
pQueryStakeDistribution =
      AnyConsensusModeParams -> NetworkId -> Maybe OutputFile -> QueryCmd
QueryStakeDistribution'
        (AnyConsensusModeParams
 -> NetworkId -> Maybe OutputFile -> QueryCmd)
-> Parser AnyConsensusModeParams
-> Parser (NetworkId -> Maybe OutputFile -> QueryCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser AnyConsensusModeParams
pConsensusModeParams
        Parser (NetworkId -> Maybe OutputFile -> QueryCmd)
-> Parser NetworkId -> Parser (Maybe OutputFile -> QueryCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser NetworkId
pNetworkId
        Parser (Maybe OutputFile -> QueryCmd)
-> Parser (Maybe OutputFile) -> Parser QueryCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe OutputFile)
pMaybeOutputFile

    pQueryStakeAddressInfo :: Parser QueryCmd
    pQueryStakeAddressInfo :: Parser QueryCmd
pQueryStakeAddressInfo =
      AnyConsensusModeParams
-> StakeAddress -> NetworkId -> Maybe OutputFile -> QueryCmd
QueryStakeAddressInfo
        (AnyConsensusModeParams
 -> StakeAddress -> NetworkId -> Maybe OutputFile -> QueryCmd)
-> Parser AnyConsensusModeParams
-> Parser
     (StakeAddress -> NetworkId -> Maybe OutputFile -> QueryCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser AnyConsensusModeParams
pConsensusModeParams
        Parser (StakeAddress -> NetworkId -> Maybe OutputFile -> QueryCmd)
-> Parser StakeAddress
-> Parser (NetworkId -> Maybe OutputFile -> QueryCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser StakeAddress
pFilterByStakeAddress
        Parser (NetworkId -> Maybe OutputFile -> QueryCmd)
-> Parser NetworkId -> Parser (Maybe OutputFile -> QueryCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser NetworkId
pNetworkId
        Parser (Maybe OutputFile -> QueryCmd)
-> Parser (Maybe OutputFile) -> Parser QueryCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe OutputFile)
pMaybeOutputFile

    pQueryLedgerState :: Parser QueryCmd
    pQueryLedgerState :: Parser QueryCmd
pQueryLedgerState = AnyConsensusModeParams -> NetworkId -> Maybe OutputFile -> QueryCmd
QueryDebugLedgerState'
                          (AnyConsensusModeParams
 -> NetworkId -> Maybe OutputFile -> QueryCmd)
-> Parser AnyConsensusModeParams
-> Parser (NetworkId -> Maybe OutputFile -> QueryCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser AnyConsensusModeParams
pConsensusModeParams
                          Parser (NetworkId -> Maybe OutputFile -> QueryCmd)
-> Parser NetworkId -> Parser (Maybe OutputFile -> QueryCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser NetworkId
pNetworkId
                          Parser (Maybe OutputFile -> QueryCmd)
-> Parser (Maybe OutputFile) -> Parser QueryCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe OutputFile)
pMaybeOutputFile

    pQueryProtocolState :: Parser QueryCmd
    pQueryProtocolState :: Parser QueryCmd
pQueryProtocolState = AnyConsensusModeParams -> NetworkId -> Maybe OutputFile -> QueryCmd
QueryProtocolState'
                            (AnyConsensusModeParams
 -> NetworkId -> Maybe OutputFile -> QueryCmd)
-> Parser AnyConsensusModeParams
-> Parser (NetworkId -> Maybe OutputFile -> QueryCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser AnyConsensusModeParams
pConsensusModeParams
                            Parser (NetworkId -> Maybe OutputFile -> QueryCmd)
-> Parser NetworkId -> Parser (Maybe OutputFile -> QueryCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser NetworkId
pNetworkId
                            Parser (Maybe OutputFile -> QueryCmd)
-> Parser (Maybe OutputFile) -> Parser QueryCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe OutputFile)
pMaybeOutputFile

    pQueryStakeSnapshot :: Parser QueryCmd
    pQueryStakeSnapshot :: Parser QueryCmd
pQueryStakeSnapshot = AnyConsensusModeParams
-> NetworkId -> Hash StakePoolKey -> QueryCmd
QueryStakeSnapshot'
      (AnyConsensusModeParams
 -> NetworkId -> Hash StakePoolKey -> QueryCmd)
-> Parser AnyConsensusModeParams
-> Parser (NetworkId -> Hash StakePoolKey -> QueryCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser AnyConsensusModeParams
pConsensusModeParams
      Parser (NetworkId -> Hash StakePoolKey -> QueryCmd)
-> Parser NetworkId -> Parser (Hash StakePoolKey -> QueryCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser NetworkId
pNetworkId
      Parser (Hash StakePoolKey -> QueryCmd)
-> Parser (Hash StakePoolKey) -> Parser QueryCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Hash StakePoolKey)
pStakePoolVerificationKeyHash

    pQueryPoolParams :: Parser QueryCmd
    pQueryPoolParams :: Parser QueryCmd
pQueryPoolParams = AnyConsensusModeParams
-> NetworkId -> Hash StakePoolKey -> QueryCmd
QueryPoolParams'
      (AnyConsensusModeParams
 -> NetworkId -> Hash StakePoolKey -> QueryCmd)
-> Parser AnyConsensusModeParams
-> Parser (NetworkId -> Hash StakePoolKey -> QueryCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser AnyConsensusModeParams
pConsensusModeParams
      Parser (NetworkId -> Hash StakePoolKey -> QueryCmd)
-> Parser NetworkId -> Parser (Hash StakePoolKey -> QueryCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser NetworkId
pNetworkId
      Parser (Hash StakePoolKey -> QueryCmd)
-> Parser (Hash StakePoolKey) -> Parser QueryCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Hash StakePoolKey)
pStakePoolVerificationKeyHash


pGovernanceCmd :: Parser GovernanceCmd
pGovernanceCmd :: Parser GovernanceCmd
pGovernanceCmd =
 [Parser GovernanceCmd] -> Parser GovernanceCmd
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
   [ String -> ParserInfo GovernanceCmd -> Parser GovernanceCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"create-mir-certificate"
       (Parser GovernanceCmd
-> InfoMod GovernanceCmd -> ParserInfo GovernanceCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (Parser GovernanceCmd
pMIRPayStakeAddresses Parser GovernanceCmd
-> Parser GovernanceCmd -> Parser GovernanceCmd
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser GovernanceCmd
mirCertParsers) (InfoMod GovernanceCmd -> ParserInfo GovernanceCmd)
-> InfoMod GovernanceCmd -> ParserInfo GovernanceCmd
forall a b. (a -> b) -> a -> b
$
         String -> InfoMod GovernanceCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Create an MIR (Move Instantaneous Rewards) certificate")
   , String -> ParserInfo GovernanceCmd -> Parser GovernanceCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"create-genesis-key-delegation-certificate"
       (Parser GovernanceCmd
-> InfoMod GovernanceCmd -> ParserInfo GovernanceCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser GovernanceCmd
pGovernanceGenesisKeyDelegationCertificate (InfoMod GovernanceCmd -> ParserInfo GovernanceCmd)
-> InfoMod GovernanceCmd -> ParserInfo GovernanceCmd
forall a b. (a -> b) -> a -> b
$
         String -> InfoMod GovernanceCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Create a genesis key delegation certificate")
  ,  String -> ParserInfo GovernanceCmd -> Parser GovernanceCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"create-vested-key-delegation-certificate"
       (Parser GovernanceCmd
-> InfoMod GovernanceCmd -> ParserInfo GovernanceCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser GovernanceCmd
pGovernanceVestedKeyDelegationCertificate (InfoMod GovernanceCmd -> ParserInfo GovernanceCmd)
-> InfoMod GovernanceCmd -> ParserInfo GovernanceCmd
forall a b. (a -> b) -> a -> b
$
         String -> InfoMod GovernanceCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Create a vested key delegation certificate")
   , String -> ParserInfo GovernanceCmd -> Parser GovernanceCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"create-update-proposal"
       (Parser GovernanceCmd
-> InfoMod GovernanceCmd -> ParserInfo GovernanceCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser GovernanceCmd
pUpdateProposal (InfoMod GovernanceCmd -> ParserInfo GovernanceCmd)
-> InfoMod GovernanceCmd -> ParserInfo GovernanceCmd
forall a b. (a -> b) -> a -> b
$
         String -> InfoMod GovernanceCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Create an update proposal")
   ]
  where
    mirCertParsers :: Parser GovernanceCmd
    mirCertParsers :: Parser GovernanceCmd
mirCertParsers = [Parser GovernanceCmd] -> Parser GovernanceCmd
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
      [ String -> ParserInfo GovernanceCmd -> Parser GovernanceCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"stake-addresses" (Parser GovernanceCmd
-> InfoMod GovernanceCmd -> ParserInfo GovernanceCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser GovernanceCmd
pMIRPayStakeAddresses (InfoMod GovernanceCmd -> ParserInfo GovernanceCmd)
-> InfoMod GovernanceCmd -> ParserInfo GovernanceCmd
forall a b. (a -> b) -> a -> b
$
          String -> InfoMod GovernanceCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Create an MIR certificate to pay stake addresses")
      , String -> ParserInfo GovernanceCmd -> Parser GovernanceCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"transfer-to-treasury" (Parser GovernanceCmd
-> InfoMod GovernanceCmd -> ParserInfo GovernanceCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser GovernanceCmd
pMIRTransferToTreasury (InfoMod GovernanceCmd -> ParserInfo GovernanceCmd)
-> InfoMod GovernanceCmd -> ParserInfo GovernanceCmd
forall a b. (a -> b) -> a -> b
$
          String -> InfoMod GovernanceCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Create an MIR certificate to transfer from the reserves pot\
                       \ to the treasury pot")
      , String -> ParserInfo GovernanceCmd -> Parser GovernanceCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"transfer-to-rewards" (Parser GovernanceCmd
-> InfoMod GovernanceCmd -> ParserInfo GovernanceCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser GovernanceCmd
pMIRTransferToReserves (InfoMod GovernanceCmd -> ParserInfo GovernanceCmd)
-> InfoMod GovernanceCmd -> ParserInfo GovernanceCmd
forall a b. (a -> b) -> a -> b
$
          String -> InfoMod GovernanceCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Create an MIR certificate to transfer from the treasury pot\
                       \ to the reserves pot")
      ]

    pMIRPayStakeAddresses :: Parser GovernanceCmd
    pMIRPayStakeAddresses :: Parser GovernanceCmd
pMIRPayStakeAddresses = MIRPot
-> [StakeAddress] -> [Entropic] -> OutputFile -> GovernanceCmd
GovernanceMIRPayStakeAddressesCertificate
                              (MIRPot
 -> [StakeAddress] -> [Entropic] -> OutputFile -> GovernanceCmd)
-> Parser MIRPot
-> Parser
     ([StakeAddress] -> [Entropic] -> OutputFile -> GovernanceCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MIRPot
pMIRPot
                              Parser
  ([StakeAddress] -> [Entropic] -> OutputFile -> GovernanceCmd)
-> Parser [StakeAddress]
-> Parser ([Entropic] -> OutputFile -> GovernanceCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser StakeAddress -> Parser [StakeAddress]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser StakeAddress
pStakeAddress
                              Parser ([Entropic] -> OutputFile -> GovernanceCmd)
-> Parser [Entropic] -> Parser (OutputFile -> GovernanceCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Entropic -> Parser [Entropic]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser Entropic
pRewardAmt
                              Parser (OutputFile -> GovernanceCmd)
-> Parser OutputFile -> Parser GovernanceCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser OutputFile
pOutputFile

    pMIRTransferToTreasury :: Parser GovernanceCmd
    pMIRTransferToTreasury :: Parser GovernanceCmd
pMIRTransferToTreasury = Entropic -> OutputFile -> TransferDirection -> GovernanceCmd
GovernanceMIRTransfer
                               (Entropic -> OutputFile -> TransferDirection -> GovernanceCmd)
-> Parser Entropic
-> Parser (OutputFile -> TransferDirection -> GovernanceCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Entropic
pTransferAmt
                               Parser (OutputFile -> TransferDirection -> GovernanceCmd)
-> Parser OutputFile -> Parser (TransferDirection -> GovernanceCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser OutputFile
pOutputFile
                               Parser (TransferDirection -> GovernanceCmd)
-> Parser TransferDirection -> Parser GovernanceCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TransferDirection -> Parser TransferDirection
forall (f :: * -> *) a. Applicative f => a -> f a
pure TransferDirection
TransferToTreasury

    pMIRTransferToReserves :: Parser GovernanceCmd
    pMIRTransferToReserves :: Parser GovernanceCmd
pMIRTransferToReserves = Entropic -> OutputFile -> TransferDirection -> GovernanceCmd
GovernanceMIRTransfer
                               (Entropic -> OutputFile -> TransferDirection -> GovernanceCmd)
-> Parser Entropic
-> Parser (OutputFile -> TransferDirection -> GovernanceCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Entropic
pTransferAmt
                               Parser (OutputFile -> TransferDirection -> GovernanceCmd)
-> Parser OutputFile -> Parser (TransferDirection -> GovernanceCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser OutputFile
pOutputFile
                               Parser (TransferDirection -> GovernanceCmd)
-> Parser TransferDirection -> Parser GovernanceCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TransferDirection -> Parser TransferDirection
forall (f :: * -> *) a. Applicative f => a -> f a
pure TransferDirection
TransferToReserves

    pGovernanceGenesisKeyDelegationCertificate :: Parser GovernanceCmd
    pGovernanceGenesisKeyDelegationCertificate :: Parser GovernanceCmd
pGovernanceGenesisKeyDelegationCertificate =
      VerificationKeyOrHashOrFile GenesisKey
-> VerificationKeyOrHashOrFile GenesisDelegateKey
-> VerificationKeyOrHashOrFile VrfKey
-> OutputFile
-> GovernanceCmd
GovernanceGenesisKeyDelegationCertificate
        (VerificationKeyOrHashOrFile GenesisKey
 -> VerificationKeyOrHashOrFile GenesisDelegateKey
 -> VerificationKeyOrHashOrFile VrfKey
 -> OutputFile
 -> GovernanceCmd)
-> Parser (VerificationKeyOrHashOrFile GenesisKey)
-> Parser
     (VerificationKeyOrHashOrFile GenesisDelegateKey
      -> VerificationKeyOrHashOrFile VrfKey
      -> OutputFile
      -> GovernanceCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyOrHashOrFile GenesisKey)
pGenesisVerificationKeyOrHashOrFile
        Parser
  (VerificationKeyOrHashOrFile GenesisDelegateKey
   -> VerificationKeyOrHashOrFile VrfKey
   -> OutputFile
   -> GovernanceCmd)
-> Parser (VerificationKeyOrHashOrFile GenesisDelegateKey)
-> Parser
     (VerificationKeyOrHashOrFile VrfKey -> OutputFile -> GovernanceCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (VerificationKeyOrHashOrFile GenesisDelegateKey)
pGenesisDelegateVerificationKeyOrHashOrFile
        Parser
  (VerificationKeyOrHashOrFile VrfKey -> OutputFile -> GovernanceCmd)
-> Parser (VerificationKeyOrHashOrFile VrfKey)
-> Parser (OutputFile -> GovernanceCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (VerificationKeyOrHashOrFile VrfKey)
pVrfVerificationKeyOrHashOrFile
        Parser (OutputFile -> GovernanceCmd)
-> Parser OutputFile -> Parser GovernanceCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser OutputFile
pOutputFile
    
    pGovernanceVestedKeyDelegationCertificate :: Parser GovernanceCmd
    pGovernanceVestedKeyDelegationCertificate :: Parser GovernanceCmd
pGovernanceVestedKeyDelegationCertificate =
      VerificationKeyOrHashOrFile VestedKey
-> VerificationKeyOrHashOrFile VestedDelegateKey
-> VerificationKeyOrHashOrFile VrfKey
-> OutputFile
-> GovernanceCmd
GovernanceVestedKeyDelegationCertificate
        (VerificationKeyOrHashOrFile VestedKey
 -> VerificationKeyOrHashOrFile VestedDelegateKey
 -> VerificationKeyOrHashOrFile VrfKey
 -> OutputFile
 -> GovernanceCmd)
-> Parser (VerificationKeyOrHashOrFile VestedKey)
-> Parser
     (VerificationKeyOrHashOrFile VestedDelegateKey
      -> VerificationKeyOrHashOrFile VrfKey
      -> OutputFile
      -> GovernanceCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyOrHashOrFile VestedKey)
pVestedVerificationKeyOrHashOrFile
        Parser
  (VerificationKeyOrHashOrFile VestedDelegateKey
   -> VerificationKeyOrHashOrFile VrfKey
   -> OutputFile
   -> GovernanceCmd)
-> Parser (VerificationKeyOrHashOrFile VestedDelegateKey)
-> Parser
     (VerificationKeyOrHashOrFile VrfKey -> OutputFile -> GovernanceCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (VerificationKeyOrHashOrFile VestedDelegateKey)
pVestedDelegateVerificationKeyOrHashOrFile
        Parser
  (VerificationKeyOrHashOrFile VrfKey -> OutputFile -> GovernanceCmd)
-> Parser (VerificationKeyOrHashOrFile VrfKey)
-> Parser (OutputFile -> GovernanceCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (VerificationKeyOrHashOrFile VrfKey)
pVrfVerificationKeyOrHashOrFile
        Parser (OutputFile -> GovernanceCmd)
-> Parser OutputFile -> Parser GovernanceCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser OutputFile
pOutputFile

    pMIRPot :: Parser Sophie.MIRPot
    pMIRPot :: Parser MIRPot
pMIRPot =
          MIRPot -> Mod FlagFields MIRPot -> Parser MIRPot
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' MIRPot
Sophie.ReservesMIR
            (  String -> Mod FlagFields MIRPot
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"reserves"
            Mod FlagFields MIRPot
-> Mod FlagFields MIRPot -> Mod FlagFields MIRPot
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields MIRPot
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use the reserves pot."
            )
      Parser MIRPot -> Parser MIRPot -> Parser MIRPot
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MIRPot -> Mod FlagFields MIRPot -> Parser MIRPot
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' MIRPot
Sophie.TreasuryMIR
            (  String -> Mod FlagFields MIRPot
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"treasury"
            Mod FlagFields MIRPot
-> Mod FlagFields MIRPot -> Mod FlagFields MIRPot
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields MIRPot
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use the treasury pot."
            )

    pUpdateProposal :: Parser GovernanceCmd
    pUpdateProposal :: Parser GovernanceCmd
pUpdateProposal = OutputFile
-> EpochNo
-> [VerificationKeyFile]
-> ProtocolParametersUpdate
-> GovernanceCmd
GovernanceUpdateProposal
                        (OutputFile
 -> EpochNo
 -> [VerificationKeyFile]
 -> ProtocolParametersUpdate
 -> GovernanceCmd)
-> Parser OutputFile
-> Parser
     (EpochNo
      -> [VerificationKeyFile]
      -> ProtocolParametersUpdate
      -> GovernanceCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser OutputFile
pOutputFile
                        Parser
  (EpochNo
   -> [VerificationKeyFile]
   -> ProtocolParametersUpdate
   -> GovernanceCmd)
-> Parser EpochNo
-> Parser
     ([VerificationKeyFile]
      -> ProtocolParametersUpdate -> GovernanceCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser EpochNo
pEpochNoUpdateProp
                        Parser
  ([VerificationKeyFile]
   -> ProtocolParametersUpdate -> GovernanceCmd)
-> Parser [VerificationKeyFile]
-> Parser (ProtocolParametersUpdate -> GovernanceCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser VerificationKeyFile -> Parser [VerificationKeyFile]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser VerificationKeyFile
pGenesisVerificationKeyFile
                        Parser (ProtocolParametersUpdate -> GovernanceCmd)
-> Parser ProtocolParametersUpdate -> Parser GovernanceCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ProtocolParametersUpdate
pProtocolParametersUpdate

pTransferAmt :: Parser Entropic
pTransferAmt :: Parser Entropic
pTransferAmt =
    ReadM Entropic -> Mod OptionFields Entropic -> Parser Entropic
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser Entropic -> ReadM Entropic
forall a. Parser a -> ReadM a
readerFromParsecParser Parser Entropic
parseEntropic)
      (  String -> Mod OptionFields Entropic
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"transfer"
      Mod OptionFields Entropic
-> Mod OptionFields Entropic -> Mod OptionFields Entropic
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Entropic
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"ENTROPIC"
      Mod OptionFields Entropic
-> Mod OptionFields Entropic -> Mod OptionFields Entropic
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Entropic
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The amount to transfer."
      )

pRewardAmt :: Parser Entropic
pRewardAmt :: Parser Entropic
pRewardAmt =
    ReadM Entropic -> Mod OptionFields Entropic -> Parser Entropic
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser Entropic -> ReadM Entropic
forall a. Parser a -> ReadM a
readerFromParsecParser Parser Entropic
parseEntropic)
      (  String -> Mod OptionFields Entropic
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"reward"
      Mod OptionFields Entropic
-> Mod OptionFields Entropic -> Mod OptionFields Entropic
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Entropic
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"ENTROPIC"
      Mod OptionFields Entropic
-> Mod OptionFields Entropic -> Mod OptionFields Entropic
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Entropic
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The reward for the relevant reward account."
      )

pGenesisCmd :: Parser GenesisCmd
pGenesisCmd :: Parser GenesisCmd
pGenesisCmd =
  [Parser GenesisCmd] -> Parser GenesisCmd
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ String -> ParserInfo GenesisCmd -> Parser GenesisCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"key-gen-genesis"
        (Parser GenesisCmd -> InfoMod GenesisCmd -> ParserInfo GenesisCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser GenesisCmd
pGenesisKeyGen (InfoMod GenesisCmd -> ParserInfo GenesisCmd)
-> InfoMod GenesisCmd -> ParserInfo GenesisCmd
forall a b. (a -> b) -> a -> b
$
           String -> InfoMod GenesisCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Create a Sophie genesis key pair")
    , String -> ParserInfo GenesisCmd -> Parser GenesisCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"key-gen-delegate"
        (Parser GenesisCmd -> InfoMod GenesisCmd -> ParserInfo GenesisCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser GenesisCmd
pGenesisDelegateKeyGen (InfoMod GenesisCmd -> ParserInfo GenesisCmd)
-> InfoMod GenesisCmd -> ParserInfo GenesisCmd
forall a b. (a -> b) -> a -> b
$
           String -> InfoMod GenesisCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Create a Sophie genesis delegate key pair")
    , String -> ParserInfo GenesisCmd -> Parser GenesisCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"key-gen-vested"
        (Parser GenesisCmd -> InfoMod GenesisCmd -> ParserInfo GenesisCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser GenesisCmd
pGenesisVestedKeyGen (InfoMod GenesisCmd -> ParserInfo GenesisCmd)
-> InfoMod GenesisCmd -> ParserInfo GenesisCmd
forall a b. (a -> b) -> a -> b
$
           String -> InfoMod GenesisCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Create a Sophie vested key pair")
    , String -> ParserInfo GenesisCmd -> Parser GenesisCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"key-gen-vesteddelegate"
        (Parser GenesisCmd -> InfoMod GenesisCmd -> ParserInfo GenesisCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser GenesisCmd
pGenesisVestedDelegateKeyGen (InfoMod GenesisCmd -> ParserInfo GenesisCmd)
-> InfoMod GenesisCmd -> ParserInfo GenesisCmd
forall a b. (a -> b) -> a -> b
$
           String -> InfoMod GenesisCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Create a Sophie genesis vested delegate key pair")
    , String -> ParserInfo GenesisCmd -> Parser GenesisCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"key-gen-utxo"
        (Parser GenesisCmd -> InfoMod GenesisCmd -> ParserInfo GenesisCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser GenesisCmd
pGenesisUTxOKeyGen (InfoMod GenesisCmd -> ParserInfo GenesisCmd)
-> InfoMod GenesisCmd -> ParserInfo GenesisCmd
forall a b. (a -> b) -> a -> b
$
           String -> InfoMod GenesisCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Create a Sophie genesis UTxO key pair")
    , String -> ParserInfo GenesisCmd -> Parser GenesisCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"key-hash"
        (Parser GenesisCmd -> InfoMod GenesisCmd -> ParserInfo GenesisCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser GenesisCmd
pGenesisKeyHash (InfoMod GenesisCmd -> ParserInfo GenesisCmd)
-> InfoMod GenesisCmd -> ParserInfo GenesisCmd
forall a b. (a -> b) -> a -> b
$
           String -> InfoMod GenesisCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Print the identifier (hash) of a public key")
    , String -> ParserInfo GenesisCmd -> Parser GenesisCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"get-ver-key"
        (Parser GenesisCmd -> InfoMod GenesisCmd -> ParserInfo GenesisCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser GenesisCmd
pGenesisVerKey (InfoMod GenesisCmd -> ParserInfo GenesisCmd)
-> InfoMod GenesisCmd -> ParserInfo GenesisCmd
forall a b. (a -> b) -> a -> b
$
           String -> InfoMod GenesisCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Derive the verification key from a signing key")
    , String -> ParserInfo GenesisCmd -> Parser GenesisCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"initial-addr"
        (Parser GenesisCmd -> InfoMod GenesisCmd -> ParserInfo GenesisCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser GenesisCmd
pGenesisAddr (InfoMod GenesisCmd -> ParserInfo GenesisCmd)
-> InfoMod GenesisCmd -> ParserInfo GenesisCmd
forall a b. (a -> b) -> a -> b
$
           String -> InfoMod GenesisCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Get the address for an initial UTxO based on the verification key")
    , String -> ParserInfo GenesisCmd -> Parser GenesisCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"initial-txin"
        (Parser GenesisCmd -> InfoMod GenesisCmd -> ParserInfo GenesisCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser GenesisCmd
pGenesisTxIn (InfoMod GenesisCmd -> ParserInfo GenesisCmd)
-> InfoMod GenesisCmd -> ParserInfo GenesisCmd
forall a b. (a -> b) -> a -> b
$
           String -> InfoMod GenesisCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Get the TxIn for an initial UTxO based on the verification key")
    , String -> ParserInfo GenesisCmd -> Parser GenesisCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"create"
        (Parser GenesisCmd -> InfoMod GenesisCmd -> ParserInfo GenesisCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser GenesisCmd
pGenesisCreate (InfoMod GenesisCmd -> ParserInfo GenesisCmd)
-> InfoMod GenesisCmd -> ParserInfo GenesisCmd
forall a b. (a -> b) -> a -> b
$
           String -> InfoMod GenesisCmd
forall a. String -> InfoMod a
Opt.progDesc (String
"Create a Sophie genesis file from a genesis "
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"template and genesis/delegation/spending keys."))
    , String -> ParserInfo GenesisCmd -> Parser GenesisCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"create-staked"
        (Parser GenesisCmd -> InfoMod GenesisCmd -> ParserInfo GenesisCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser GenesisCmd
pGenesisCreateStaked (InfoMod GenesisCmd -> ParserInfo GenesisCmd)
-> InfoMod GenesisCmd -> ParserInfo GenesisCmd
forall a b. (a -> b) -> a -> b
$
           String -> InfoMod GenesisCmd
forall a. String -> InfoMod a
Opt.progDesc (String
"Create a staked Sophie genesis file from a genesis "
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"template and genesis/delegation/spending keys."))
    , String -> ParserInfo GenesisCmd -> Parser GenesisCmd
forall a. String -> ParserInfo a -> Parser a
subParser String
"hash"
        (Parser GenesisCmd -> InfoMod GenesisCmd -> ParserInfo GenesisCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser GenesisCmd
pGenesisHash (InfoMod GenesisCmd -> ParserInfo GenesisCmd)
-> InfoMod GenesisCmd -> ParserInfo GenesisCmd
forall a b. (a -> b) -> a -> b
$
           String -> InfoMod GenesisCmd
forall a. String -> InfoMod a
Opt.progDesc String
"Compute the hash of a genesis file")
    ]
  where
    pGenesisKeyGen :: Parser GenesisCmd
    pGenesisKeyGen :: Parser GenesisCmd
pGenesisKeyGen =
      VerificationKeyFile -> SigningKeyFile -> GenesisCmd
GenesisKeyGenGenesis (VerificationKeyFile -> SigningKeyFile -> GenesisCmd)
-> Parser VerificationKeyFile
-> Parser (SigningKeyFile -> GenesisCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileDirection -> Parser VerificationKeyFile
pVerificationKeyFile FileDirection
Output Parser (SigningKeyFile -> GenesisCmd)
-> Parser SigningKeyFile -> Parser GenesisCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FileDirection -> Parser SigningKeyFile
pSigningKeyFile FileDirection
Output

    pGenesisDelegateKeyGen :: Parser GenesisCmd
    pGenesisDelegateKeyGen :: Parser GenesisCmd
pGenesisDelegateKeyGen =
      VerificationKeyFile
-> SigningKeyFile -> OpCertCounterFile -> GenesisCmd
GenesisKeyGenDelegate (VerificationKeyFile
 -> SigningKeyFile -> OpCertCounterFile -> GenesisCmd)
-> Parser VerificationKeyFile
-> Parser (SigningKeyFile -> OpCertCounterFile -> GenesisCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileDirection -> Parser VerificationKeyFile
pVerificationKeyFile FileDirection
Output
                            Parser (SigningKeyFile -> OpCertCounterFile -> GenesisCmd)
-> Parser SigningKeyFile
-> Parser (OpCertCounterFile -> GenesisCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FileDirection -> Parser SigningKeyFile
pSigningKeyFile FileDirection
Output
                            Parser (OpCertCounterFile -> GenesisCmd)
-> Parser OpCertCounterFile -> Parser GenesisCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser OpCertCounterFile
pOperatorCertIssueCounterFile
                            
    pGenesisVestedKeyGen :: Parser GenesisCmd
    pGenesisVestedKeyGen :: Parser GenesisCmd
pGenesisVestedKeyGen =
      VerificationKeyFile -> SigningKeyFile -> GenesisCmd
GenesisKeyGenVested (VerificationKeyFile -> SigningKeyFile -> GenesisCmd)
-> Parser VerificationKeyFile
-> Parser (SigningKeyFile -> GenesisCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileDirection -> Parser VerificationKeyFile
pVerificationKeyFile FileDirection
Output Parser (SigningKeyFile -> GenesisCmd)
-> Parser SigningKeyFile -> Parser GenesisCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FileDirection -> Parser SigningKeyFile
pSigningKeyFile FileDirection
Output

    pGenesisVestedDelegateKeyGen :: Parser GenesisCmd
    pGenesisVestedDelegateKeyGen :: Parser GenesisCmd
pGenesisVestedDelegateKeyGen =
      VerificationKeyFile
-> SigningKeyFile -> OpCertCounterFile -> GenesisCmd
GenesisKeyGenVestedDelegate (VerificationKeyFile
 -> SigningKeyFile -> OpCertCounterFile -> GenesisCmd)
-> Parser VerificationKeyFile
-> Parser (SigningKeyFile -> OpCertCounterFile -> GenesisCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileDirection -> Parser VerificationKeyFile
pVerificationKeyFile FileDirection
Output
                            Parser (SigningKeyFile -> OpCertCounterFile -> GenesisCmd)
-> Parser SigningKeyFile
-> Parser (OpCertCounterFile -> GenesisCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FileDirection -> Parser SigningKeyFile
pSigningKeyFile FileDirection
Output
                            Parser (OpCertCounterFile -> GenesisCmd)
-> Parser OpCertCounterFile -> Parser GenesisCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser OpCertCounterFile
pOperatorCertIssueCounterFile

    pGenesisUTxOKeyGen :: Parser GenesisCmd
    pGenesisUTxOKeyGen :: Parser GenesisCmd
pGenesisUTxOKeyGen =
      VerificationKeyFile -> SigningKeyFile -> GenesisCmd
GenesisKeyGenUTxO (VerificationKeyFile -> SigningKeyFile -> GenesisCmd)
-> Parser VerificationKeyFile
-> Parser (SigningKeyFile -> GenesisCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileDirection -> Parser VerificationKeyFile
pVerificationKeyFile FileDirection
Output Parser (SigningKeyFile -> GenesisCmd)
-> Parser SigningKeyFile -> Parser GenesisCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FileDirection -> Parser SigningKeyFile
pSigningKeyFile FileDirection
Output

    pGenesisKeyHash :: Parser GenesisCmd
    pGenesisKeyHash :: Parser GenesisCmd
pGenesisKeyHash =
      VerificationKeyFile -> GenesisCmd
GenesisCmdKeyHash (VerificationKeyFile -> GenesisCmd)
-> Parser VerificationKeyFile -> Parser GenesisCmd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileDirection -> Parser VerificationKeyFile
pVerificationKeyFile FileDirection
Input

    pGenesisVerKey :: Parser GenesisCmd
    pGenesisVerKey :: Parser GenesisCmd
pGenesisVerKey =
      VerificationKeyFile -> SigningKeyFile -> GenesisCmd
GenesisVerKey (VerificationKeyFile -> SigningKeyFile -> GenesisCmd)
-> Parser VerificationKeyFile
-> Parser (SigningKeyFile -> GenesisCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileDirection -> Parser VerificationKeyFile
pVerificationKeyFile FileDirection
Output Parser (SigningKeyFile -> GenesisCmd)
-> Parser SigningKeyFile -> Parser GenesisCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FileDirection -> Parser SigningKeyFile
pSigningKeyFile FileDirection
Output

    pGenesisAddr :: Parser GenesisCmd
    pGenesisAddr :: Parser GenesisCmd
pGenesisAddr =
      VerificationKeyFile -> NetworkId -> Maybe OutputFile -> GenesisCmd
GenesisAddr (VerificationKeyFile
 -> NetworkId -> Maybe OutputFile -> GenesisCmd)
-> Parser VerificationKeyFile
-> Parser (NetworkId -> Maybe OutputFile -> GenesisCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileDirection -> Parser VerificationKeyFile
pVerificationKeyFile FileDirection
Input Parser (NetworkId -> Maybe OutputFile -> GenesisCmd)
-> Parser NetworkId -> Parser (Maybe OutputFile -> GenesisCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser NetworkId
pNetworkId Parser (Maybe OutputFile -> GenesisCmd)
-> Parser (Maybe OutputFile) -> Parser GenesisCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe OutputFile)
pMaybeOutputFile

    pGenesisTxIn :: Parser GenesisCmd
    pGenesisTxIn :: Parser GenesisCmd
pGenesisTxIn =
      VerificationKeyFile -> NetworkId -> Maybe OutputFile -> GenesisCmd
GenesisTxIn (VerificationKeyFile
 -> NetworkId -> Maybe OutputFile -> GenesisCmd)
-> Parser VerificationKeyFile
-> Parser (NetworkId -> Maybe OutputFile -> GenesisCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileDirection -> Parser VerificationKeyFile
pVerificationKeyFile FileDirection
Input Parser (NetworkId -> Maybe OutputFile -> GenesisCmd)
-> Parser NetworkId -> Parser (Maybe OutputFile -> GenesisCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser NetworkId
pNetworkId Parser (Maybe OutputFile -> GenesisCmd)
-> Parser (Maybe OutputFile) -> Parser GenesisCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe OutputFile)
pMaybeOutputFile

    pGenesisCreate :: Parser GenesisCmd
    pGenesisCreate :: Parser GenesisCmd
pGenesisCreate =
      GenesisDir
-> Word
-> Word
-> Word
-> Maybe SystemStart
-> Maybe Entropic
-> NetworkId
-> GenesisCmd
GenesisCreate 
        (GenesisDir
 -> Word
 -> Word
 -> Word
 -> Maybe SystemStart
 -> Maybe Entropic
 -> NetworkId
 -> GenesisCmd)
-> Parser GenesisDir
-> Parser
     (Word
      -> Word
      -> Word
      -> Maybe SystemStart
      -> Maybe Entropic
      -> NetworkId
      -> GenesisCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser GenesisDir
pGenesisDir
        Parser
  (Word
   -> Word
   -> Word
   -> Maybe SystemStart
   -> Maybe Entropic
   -> NetworkId
   -> GenesisCmd)
-> Parser Word
-> Parser
     (Word
      -> Word
      -> Maybe SystemStart
      -> Maybe Entropic
      -> NetworkId
      -> GenesisCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word
pGenesisNumGenesisKeys
        Parser
  (Word
   -> Word
   -> Maybe SystemStart
   -> Maybe Entropic
   -> NetworkId
   -> GenesisCmd)
-> Parser Word
-> Parser
     (Word
      -> Maybe SystemStart -> Maybe Entropic -> NetworkId -> GenesisCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word
pGenesisNumVestedKeys
        Parser
  (Word
   -> Maybe SystemStart -> Maybe Entropic -> NetworkId -> GenesisCmd)
-> Parser Word
-> Parser
     (Maybe SystemStart -> Maybe Entropic -> NetworkId -> GenesisCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word
pGenesisNumUTxOKeys
        Parser
  (Maybe SystemStart -> Maybe Entropic -> NetworkId -> GenesisCmd)
-> Parser (Maybe SystemStart)
-> Parser (Maybe Entropic -> NetworkId -> GenesisCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe SystemStart)
pMaybeSystemStart
        Parser (Maybe Entropic -> NetworkId -> GenesisCmd)
-> Parser (Maybe Entropic) -> Parser (NetworkId -> GenesisCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Entropic)
pInitialSupplyNonDelegated
        Parser (NetworkId -> GenesisCmd)
-> Parser NetworkId -> Parser GenesisCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser NetworkId
pNetworkId

    pGenesisCreateStaked :: Parser GenesisCmd
    pGenesisCreateStaked :: Parser GenesisCmd
pGenesisCreateStaked =
      GenesisDir
-> Word
-> Word
-> Word
-> Word
-> Word
-> Maybe SystemStart
-> Maybe Entropic
-> Entropic
-> NetworkId
-> Word
-> Word
-> Word
-> GenesisCmd
GenesisCreateStaked
        (GenesisDir
 -> Word
 -> Word
 -> Word
 -> Word
 -> Word
 -> Maybe SystemStart
 -> Maybe Entropic
 -> Entropic
 -> NetworkId
 -> Word
 -> Word
 -> Word
 -> GenesisCmd)
-> Parser GenesisDir
-> Parser
     (Word
      -> Word
      -> Word
      -> Word
      -> Word
      -> Maybe SystemStart
      -> Maybe Entropic
      -> Entropic
      -> NetworkId
      -> Word
      -> Word
      -> Word
      -> GenesisCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser GenesisDir
pGenesisDir
        Parser
  (Word
   -> Word
   -> Word
   -> Word
   -> Word
   -> Maybe SystemStart
   -> Maybe Entropic
   -> Entropic
   -> NetworkId
   -> Word
   -> Word
   -> Word
   -> GenesisCmd)
-> Parser Word
-> Parser
     (Word
      -> Word
      -> Word
      -> Word
      -> Maybe SystemStart
      -> Maybe Entropic
      -> Entropic
      -> NetworkId
      -> Word
      -> Word
      -> Word
      -> GenesisCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word
pGenesisNumGenesisKeys
        Parser
  (Word
   -> Word
   -> Word
   -> Word
   -> Maybe SystemStart
   -> Maybe Entropic
   -> Entropic
   -> NetworkId
   -> Word
   -> Word
   -> Word
   -> GenesisCmd)
-> Parser Word
-> Parser
     (Word
      -> Word
      -> Word
      -> Maybe SystemStart
      -> Maybe Entropic
      -> Entropic
      -> NetworkId
      -> Word
      -> Word
      -> Word
      -> GenesisCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word
pGenesisNumVestedKeys
        Parser
  (Word
   -> Word
   -> Word
   -> Maybe SystemStart
   -> Maybe Entropic
   -> Entropic
   -> NetworkId
   -> Word
   -> Word
   -> Word
   -> GenesisCmd)
-> Parser Word
-> Parser
     (Word
      -> Word
      -> Maybe SystemStart
      -> Maybe Entropic
      -> Entropic
      -> NetworkId
      -> Word
      -> Word
      -> Word
      -> GenesisCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word
pGenesisNumUTxOKeys
        Parser
  (Word
   -> Word
   -> Maybe SystemStart
   -> Maybe Entropic
   -> Entropic
   -> NetworkId
   -> Word
   -> Word
   -> Word
   -> GenesisCmd)
-> Parser Word
-> Parser
     (Word
      -> Maybe SystemStart
      -> Maybe Entropic
      -> Entropic
      -> NetworkId
      -> Word
      -> Word
      -> Word
      -> GenesisCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word
pGenesisNumPools
        Parser
  (Word
   -> Maybe SystemStart
   -> Maybe Entropic
   -> Entropic
   -> NetworkId
   -> Word
   -> Word
   -> Word
   -> GenesisCmd)
-> Parser Word
-> Parser
     (Maybe SystemStart
      -> Maybe Entropic
      -> Entropic
      -> NetworkId
      -> Word
      -> Word
      -> Word
      -> GenesisCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word
pGenesisNumStDelegs
        Parser
  (Maybe SystemStart
   -> Maybe Entropic
   -> Entropic
   -> NetworkId
   -> Word
   -> Word
   -> Word
   -> GenesisCmd)
-> Parser (Maybe SystemStart)
-> Parser
     (Maybe Entropic
      -> Entropic -> NetworkId -> Word -> Word -> Word -> GenesisCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe SystemStart)
pMaybeSystemStart
        Parser
  (Maybe Entropic
   -> Entropic -> NetworkId -> Word -> Word -> Word -> GenesisCmd)
-> Parser (Maybe Entropic)
-> Parser
     (Entropic -> NetworkId -> Word -> Word -> Word -> GenesisCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Entropic)
pInitialSupplyNonDelegated
        Parser
  (Entropic -> NetworkId -> Word -> Word -> Word -> GenesisCmd)
-> Parser Entropic
-> Parser (NetworkId -> Word -> Word -> Word -> GenesisCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Entropic
pInitialSupplyDelegated
        Parser (NetworkId -> Word -> Word -> Word -> GenesisCmd)
-> Parser NetworkId -> Parser (Word -> Word -> Word -> GenesisCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser NetworkId
pNetworkId
        Parser (Word -> Word -> Word -> GenesisCmd)
-> Parser Word -> Parser (Word -> Word -> GenesisCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word
pBulkPoolCredFiles
        Parser (Word -> Word -> GenesisCmd)
-> Parser Word -> Parser (Word -> GenesisCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word
pBulkPoolsPerFile
        Parser (Word -> GenesisCmd) -> Parser Word -> Parser GenesisCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word
pStuffedUtxoCount

    pGenesisHash :: Parser GenesisCmd
    pGenesisHash :: Parser GenesisCmd
pGenesisHash =
      GenesisFile -> GenesisCmd
GenesisHashFile (GenesisFile -> GenesisCmd)
-> Parser GenesisFile -> Parser GenesisCmd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Parser GenesisFile
pGenesisFile String
"The genesis file."

    pGenesisDir :: Parser GenesisDir
    pGenesisDir :: Parser GenesisDir
pGenesisDir =
      String -> GenesisDir
GenesisDir (String -> GenesisDir) -> Parser String -> Parser GenesisDir
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
          (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"genesis-dir"
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"DIR"
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The genesis directory containing the genesis template and required genesis/delegation/spending keys."
          )

    pMaybeSystemStart :: Parser (Maybe SystemStart)
    pMaybeSystemStart :: Parser (Maybe SystemStart)
pMaybeSystemStart =
      Parser SystemStart -> Parser (Maybe SystemStart)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional (Parser SystemStart -> Parser (Maybe SystemStart))
-> Parser SystemStart -> Parser (Maybe SystemStart)
forall a b. (a -> b) -> a -> b
$
        UTCTime -> SystemStart
SystemStart (UTCTime -> SystemStart)
-> (String -> UTCTime) -> String -> SystemStart
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> UTCTime
convertTime (String -> SystemStart) -> Parser String -> Parser SystemStart
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
            (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"start-time"
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"UTC-TIME"
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The genesis start time in YYYY-MM-DDThh:mm:ssZ format. If unspecified, will be the current time +30 seconds."
            )

    pGenesisNumGenesisKeys :: Parser Word
    pGenesisNumGenesisKeys :: Parser Word
pGenesisNumGenesisKeys =
        ReadM Word -> Mod OptionFields Word -> Parser Word
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word
forall a. Read a => ReadM a
Opt.auto
          (  String -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"gen-genesis-keys"
          Mod OptionFields Word
-> Mod OptionFields Word -> Mod OptionFields Word
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"INT"
          Mod OptionFields Word
-> Mod OptionFields Word -> Mod OptionFields Word
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The number of genesis keys to make [default is 0]."
          Mod OptionFields Word
-> Mod OptionFields Word -> Mod OptionFields Word
forall a. Semigroup a => a -> a -> a
<> Word -> Mod OptionFields Word
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value Word
0
          )
          
    pGenesisNumVestedKeys :: Parser Word
    pGenesisNumVestedKeys :: Parser Word
pGenesisNumVestedKeys =
        ReadM Word -> Mod OptionFields Word -> Parser Word
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word
forall a. Read a => ReadM a
Opt.auto
          (  String -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"gen-vested-keys"
          Mod OptionFields Word
-> Mod OptionFields Word -> Mod OptionFields Word
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"INT"
          Mod OptionFields Word
-> Mod OptionFields Word -> Mod OptionFields Word
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The number of vested keys to make [default is 0]."
          Mod OptionFields Word
-> Mod OptionFields Word -> Mod OptionFields Word
forall a. Semigroup a => a -> a -> a
<> Word -> Mod OptionFields Word
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value Word
0
          )

    pGenesisNumUTxOKeys :: Parser Word
    pGenesisNumUTxOKeys :: Parser Word
pGenesisNumUTxOKeys =
        ReadM Word -> Mod OptionFields Word -> Parser Word
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word
forall a. Read a => ReadM a
Opt.auto
          (  String -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"gen-utxo-keys"
          Mod OptionFields Word
-> Mod OptionFields Word -> Mod OptionFields Word
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"INT"
          Mod OptionFields Word
-> Mod OptionFields Word -> Mod OptionFields Word
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The number of UTxO keys to make [default is 0]."
          Mod OptionFields Word
-> Mod OptionFields Word -> Mod OptionFields Word
forall a. Semigroup a => a -> a -> a
<> Word -> Mod OptionFields Word
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value Word
0
          )

    pGenesisNumPools :: Parser Word
    pGenesisNumPools :: Parser Word
pGenesisNumPools =
        ReadM Word -> Mod OptionFields Word -> Parser Word
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word
forall a. Read a => ReadM a
Opt.auto
          (  String -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"gen-pools"
          Mod OptionFields Word
-> Mod OptionFields Word -> Mod OptionFields Word
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"INT"
          Mod OptionFields Word
-> Mod OptionFields Word -> Mod OptionFields Word
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The number of stake pool credential sets to make [default is 0]."
          Mod OptionFields Word
-> Mod OptionFields Word -> Mod OptionFields Word
forall a. Semigroup a => a -> a -> a
<> Word -> Mod OptionFields Word
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value Word
0
          )

    pGenesisNumStDelegs :: Parser Word
    pGenesisNumStDelegs :: Parser Word
pGenesisNumStDelegs =
        ReadM Word -> Mod OptionFields Word -> Parser Word
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word
forall a. Read a => ReadM a
Opt.auto
          (  String -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"gen-stake-delegs"
          Mod OptionFields Word
-> Mod OptionFields Word -> Mod OptionFields Word
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"INT"
          Mod OptionFields Word
-> Mod OptionFields Word -> Mod OptionFields Word
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The number of stake delegator credential sets to make [default is 0]."
          Mod OptionFields Word
-> Mod OptionFields Word -> Mod OptionFields Word
forall a. Semigroup a => a -> a -> a
<> Word -> Mod OptionFields Word
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value Word
0
          )

    pStuffedUtxoCount :: Parser Word
    pStuffedUtxoCount :: Parser Word
pStuffedUtxoCount =
        ReadM Word -> Mod OptionFields Word -> Parser Word
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word
forall a. Read a => ReadM a
Opt.auto
          (  String -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"num-stuffed-utxo"
          Mod OptionFields Word
-> Mod OptionFields Word -> Mod OptionFields Word
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"INT"
          Mod OptionFields Word
-> Mod OptionFields Word -> Mod OptionFields Word
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The number of fake UTxO entries to generate [default is 0]."
          Mod OptionFields Word
-> Mod OptionFields Word -> Mod OptionFields Word
forall a. Semigroup a => a -> a -> a
<> Word -> Mod OptionFields Word
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value Word
0
          )

    convertTime :: String -> UTCTime
    convertTime :: String -> UTCTime
convertTime =
      Bool -> TimeLocale -> String -> String -> UTCTime
forall t.
ParseTime t =>
Bool -> TimeLocale -> String -> String -> t
parseTimeOrError Bool
False TimeLocale
defaultTimeLocale (Maybe String -> String
iso8601DateFormat (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
"%H:%M:%SZ")

    pInitialSupplyNonDelegated :: Parser (Maybe Entropic)
    pInitialSupplyNonDelegated :: Parser (Maybe Entropic)
pInitialSupplyNonDelegated =
      Parser Entropic -> Parser (Maybe Entropic)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional (Parser Entropic -> Parser (Maybe Entropic))
-> Parser Entropic -> Parser (Maybe Entropic)
forall a b. (a -> b) -> a -> b
$
      Integer -> Entropic
Entropic (Integer -> Entropic) -> Parser Integer -> Parser Entropic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        ReadM Integer -> Mod OptionFields Integer -> Parser Integer
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Integer
forall a. Read a => ReadM a
Opt.auto
          (  String -> Mod OptionFields Integer
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"supply"
          Mod OptionFields Integer
-> Mod OptionFields Integer -> Mod OptionFields Integer
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Integer
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"ENTROPIC"
          Mod OptionFields Integer
-> Mod OptionFields Integer -> Mod OptionFields Integer
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Integer
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The initial coin supply in Entropic which will be evenly distributed across initial, non-delegating stake holders."
          )

    pInitialSupplyDelegated :: Parser Entropic
    pInitialSupplyDelegated :: Parser Entropic
pInitialSupplyDelegated =
      (Maybe Integer -> Entropic)
-> Parser (Maybe Integer) -> Parser Entropic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> Entropic
Entropic (Integer -> Entropic)
-> (Maybe Integer -> Integer) -> Maybe Integer -> Entropic
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe Integer
0) (Parser (Maybe Integer) -> Parser Entropic)
-> Parser (Maybe Integer) -> Parser Entropic
forall a b. (a -> b) -> a -> b
$ Parser Integer -> Parser (Maybe Integer)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional (Parser Integer -> Parser (Maybe Integer))
-> Parser Integer -> Parser (Maybe Integer)
forall a b. (a -> b) -> a -> b
$
        ReadM Integer -> Mod OptionFields Integer -> Parser Integer
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Integer
forall a. Read a => ReadM a
Opt.auto
          (  String -> Mod OptionFields Integer
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"supply-delegated"
          Mod OptionFields Integer
-> Mod OptionFields Integer -> Mod OptionFields Integer
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Integer
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"ENTROPIC"
          Mod OptionFields Integer
-> Mod OptionFields Integer -> Mod OptionFields Integer
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Integer
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The initial coin supply in Entropic which will be evenly distributed across initial, delegating stake holders."
          Mod OptionFields Integer
-> Mod OptionFields Integer -> Mod OptionFields Integer
forall a. Semigroup a => a -> a -> a
<> Integer -> Mod OptionFields Integer
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value Integer
0
          )

    pBulkPoolCredFiles :: Parser Word
    pBulkPoolCredFiles :: Parser Word
pBulkPoolCredFiles =
        ReadM Word -> Mod OptionFields Word -> Parser Word
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word
forall a. Read a => ReadM a
Opt.auto
          (  String -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"bulk-pool-cred-files"
          Mod OptionFields Word
-> Mod OptionFields Word -> Mod OptionFields Word
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"INT"
          Mod OptionFields Word
-> Mod OptionFields Word -> Mod OptionFields Word
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Generate bulk pool credential files [default is 0]."
          Mod OptionFields Word
-> Mod OptionFields Word -> Mod OptionFields Word
forall a. Semigroup a => a -> a -> a
<> Word -> Mod OptionFields Word
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value Word
0
          )

    pBulkPoolsPerFile :: Parser Word
    pBulkPoolsPerFile :: Parser Word
pBulkPoolsPerFile =
        ReadM Word -> Mod OptionFields Word -> Parser Word
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word
forall a. Read a => ReadM a
Opt.auto
          (  String -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"bulk-pools-per-file"
          Mod OptionFields Word
-> Mod OptionFields Word -> Mod OptionFields Word
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"INT"
          Mod OptionFields Word
-> Mod OptionFields Word -> Mod OptionFields Word
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Each bulk pool to contain this many pool credential sets [default is 0]."
          Mod OptionFields Word
-> Mod OptionFields Word -> Mod OptionFields Word
forall a. Semigroup a => a -> a -> a
<> Word -> Mod OptionFields Word
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value Word
0
          )


--
-- Sophie CLI flag parsers
--

data FileDirection
  = Input
  | Output
  deriving (FileDirection -> FileDirection -> Bool
(FileDirection -> FileDirection -> Bool)
-> (FileDirection -> FileDirection -> Bool) -> Eq FileDirection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileDirection -> FileDirection -> Bool
$c/= :: FileDirection -> FileDirection -> Bool
== :: FileDirection -> FileDirection -> Bool
$c== :: FileDirection -> FileDirection -> Bool
Eq, Int -> FileDirection -> String -> String
[FileDirection] -> String -> String
FileDirection -> String
(Int -> FileDirection -> String -> String)
-> (FileDirection -> String)
-> ([FileDirection] -> String -> String)
-> Show FileDirection
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [FileDirection] -> String -> String
$cshowList :: [FileDirection] -> String -> String
show :: FileDirection -> String
$cshow :: FileDirection -> String
showsPrec :: Int -> FileDirection -> String -> String
$cshowsPrec :: Int -> FileDirection -> String -> String
Show)

pAddressKeyType :: Parser AddressKeyType
pAddressKeyType :: Parser AddressKeyType
pAddressKeyType =
    AddressKeyType
-> Mod FlagFields AddressKeyType -> Parser AddressKeyType
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' AddressKeyType
AddressKeySophie
      (  String -> Mod FlagFields AddressKeyType
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"normal-key"
      Mod FlagFields AddressKeyType
-> Mod FlagFields AddressKeyType -> Mod FlagFields AddressKeyType
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields AddressKeyType
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use a normal Sophie-era key (default)."
      )
  Parser AddressKeyType
-> Parser AddressKeyType -> Parser AddressKeyType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    AddressKeyType
-> Mod FlagFields AddressKeyType -> Parser AddressKeyType
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' AddressKeyType
AddressKeySophieExtended
      (  String -> Mod FlagFields AddressKeyType
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"extended-key"
      Mod FlagFields AddressKeyType
-> Mod FlagFields AddressKeyType -> Mod FlagFields AddressKeyType
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields AddressKeyType
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use an extended ed25519 Sophie-era key."
      )
  Parser AddressKeyType
-> Parser AddressKeyType -> Parser AddressKeyType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    AddressKeyType
-> Mod FlagFields AddressKeyType -> Parser AddressKeyType
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' AddressKeyType
AddressKeyCole
      (  String -> Mod FlagFields AddressKeyType
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"cole-key"
      Mod FlagFields AddressKeyType
-> Mod FlagFields AddressKeyType -> Mod FlagFields AddressKeyType
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields AddressKeyType
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use a Cole-era key."
      )
  Parser AddressKeyType
-> Parser AddressKeyType -> Parser AddressKeyType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    AddressKeyType -> Parser AddressKeyType
forall (f :: * -> *) a. Applicative f => a -> f a
pure AddressKeyType
AddressKeySophie


pProtocolParamsFile :: Parser ProtocolParamsFile
pProtocolParamsFile :: Parser ProtocolParamsFile
pProtocolParamsFile =
  String -> ProtocolParamsFile
ProtocolParamsFile (String -> ProtocolParamsFile)
-> Parser String -> Parser ProtocolParamsFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
      (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"protocol-params-file"
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Filepath of the JSON-encoded protocol parameters file"
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
      )

pCertificateFile
  :: BalanceTxExecUnits
  -> Parser (CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))
pCertificateFile :: BalanceTxExecUnits
-> Parser (CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))
pCertificateFile BalanceTxExecUnits
balanceExecUnits =
  (,) (CertificateFile
 -> Maybe (ScriptWitnessFiles WitCtxStake)
 -> (CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake)))
-> Parser CertificateFile
-> Parser
     (Maybe (ScriptWitnessFiles WitCtxStake)
      -> (CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> CertificateFile
CertificateFile
             (String -> CertificateFile)
-> Parser String -> Parser CertificateFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (  Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
                      (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"certificate-file"
                      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"CERTIFICATEFILE"
                      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
helpText
                      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
                      )
                  Parser String -> Parser String -> Parser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                     Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"certificate" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall (f :: * -> *) a. Mod f a
Opt.internal)
                  )
          )
      Parser
  (Maybe (ScriptWitnessFiles WitCtxStake)
   -> (CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake)))
-> Parser (Maybe (ScriptWitnessFiles WitCtxStake))
-> Parser (CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (ScriptWitnessFiles WitCtxStake)
-> Parser (Maybe (ScriptWitnessFiles WitCtxStake))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (WitCtx WitCtxStake
-> BalanceTxExecUnits
-> String
-> Maybe String
-> String
-> Parser (ScriptWitnessFiles WitCtxStake)
forall witctx.
WitCtx witctx
-> BalanceTxExecUnits
-> String
-> Maybe String
-> String
-> Parser (ScriptWitnessFiles witctx)
pScriptWitnessFiles
                      WitCtx WitCtxStake
WitCtxStake
                      BalanceTxExecUnits
balanceExecUnits
                      String
"certificate" Maybe String
forall a. Maybe a
Nothing
                      String
"the use of the certificate.")
 where
   helpText :: String
helpText = String
"Filepath of the certificate. This encompasses all \
              \types of certificates (stake pool certificates, \
              \stake key certificates etc). Optionally specify a script witness."



pPoolMetadataFile :: Parser PoolMetadataFile
pPoolMetadataFile :: Parser PoolMetadataFile
pPoolMetadataFile =
  String -> PoolMetadataFile
PoolMetadataFile (String -> PoolMetadataFile)
-> Parser String -> Parser PoolMetadataFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
      (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"pool-metadata-file"
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Filepath of the pool metadata."
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
      )

pTxMetadataJsonSchema :: Parser TxMetadataJsonSchema
pTxMetadataJsonSchema :: Parser TxMetadataJsonSchema
pTxMetadataJsonSchema =
    (  () -> Mod FlagFields () -> Parser ()
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' ()
        (  String -> Mod FlagFields ()
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"json-metadata-no-schema"
        Mod FlagFields () -> Mod FlagFields () -> Mod FlagFields ()
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields ()
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use the \"no schema\" conversion from JSON to tx metadata."
        )
    Parser ()
-> Parser TxMetadataJsonSchema -> Parser TxMetadataJsonSchema
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TxMetadataJsonSchema -> Parser TxMetadataJsonSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure TxMetadataJsonSchema
TxMetadataJsonNoSchema
    )
  Parser TxMetadataJsonSchema
-> Parser TxMetadataJsonSchema -> Parser TxMetadataJsonSchema
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    (  () -> Mod FlagFields () -> Parser ()
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' ()
        (  String -> Mod FlagFields ()
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"json-metadata-detailed-schema"
        Mod FlagFields () -> Mod FlagFields () -> Mod FlagFields ()
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields ()
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use the \"detailed schema\" conversion from JSON to tx metadata."
        )
    Parser ()
-> Parser TxMetadataJsonSchema -> Parser TxMetadataJsonSchema
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TxMetadataJsonSchema -> Parser TxMetadataJsonSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure TxMetadataJsonSchema
TxMetadataJsonDetailedSchema
    )
  Parser TxMetadataJsonSchema
-> Parser TxMetadataJsonSchema -> Parser TxMetadataJsonSchema
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    -- Default to the no-schema conversion.
    TxMetadataJsonSchema -> Parser TxMetadataJsonSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure TxMetadataJsonSchema
TxMetadataJsonNoSchema

pMetadataFile :: Parser MetadataFile
pMetadataFile :: Parser MetadataFile
pMetadataFile =
      String -> MetadataFile
MetadataFileJSON (String -> MetadataFile) -> Parser String -> Parser MetadataFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        ( Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
            (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"metadata-json-file"
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Filepath of the metadata file, in JSON format."
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
            )
        Parser String -> Parser String -> Parser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
          Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
            (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"metadata-file" -- backward compat name
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall (f :: * -> *) a. Mod f a
Opt.internal
            )
        )
  Parser MetadataFile -> Parser MetadataFile -> Parser MetadataFile
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      String -> MetadataFile
MetadataFileCBOR (String -> MetadataFile) -> Parser String -> Parser MetadataFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
          (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"metadata-cbor-file"
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Filepath of the metadata, in raw CBOR format."
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
          )

pWithdrawal
  :: BalanceTxExecUnits
  -> Parser (StakeAddress,
            Entropic,
            Maybe (ScriptWitnessFiles WitCtxStake))
pWithdrawal :: BalanceTxExecUnits
-> Parser
     (StakeAddress, Entropic, Maybe (ScriptWitnessFiles WitCtxStake))
pWithdrawal BalanceTxExecUnits
balance =
    (\(StakeAddress
stakeAddr,Entropic
entropic) Maybe (ScriptWitnessFiles WitCtxStake)
maybeScriptFp -> (StakeAddress
stakeAddr, Entropic
entropic, Maybe (ScriptWitnessFiles WitCtxStake)
maybeScriptFp))
      ((StakeAddress, Entropic)
 -> Maybe (ScriptWitnessFiles WitCtxStake)
 -> (StakeAddress, Entropic,
     Maybe (ScriptWitnessFiles WitCtxStake)))
-> Parser (StakeAddress, Entropic)
-> Parser
     (Maybe (ScriptWitnessFiles WitCtxStake)
      -> (StakeAddress, Entropic,
          Maybe (ScriptWitnessFiles WitCtxStake)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM (StakeAddress, Entropic)
-> Mod OptionFields (StakeAddress, Entropic)
-> Parser (StakeAddress, Entropic)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser (StakeAddress, Entropic) -> ReadM (StakeAddress, Entropic)
forall a. Parser a -> ReadM a
readerFromParsecParser Parser (StakeAddress, Entropic)
parseWithdrawal)
            (  String -> Mod OptionFields (StakeAddress, Entropic)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"withdrawal"
            Mod OptionFields (StakeAddress, Entropic)
-> Mod OptionFields (StakeAddress, Entropic)
-> Mod OptionFields (StakeAddress, Entropic)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (StakeAddress, Entropic)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"WITHDRAWAL"
            Mod OptionFields (StakeAddress, Entropic)
-> Mod OptionFields (StakeAddress, Entropic)
-> Mod OptionFields (StakeAddress, Entropic)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (StakeAddress, Entropic)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
helpText
            )
      Parser
  (Maybe (ScriptWitnessFiles WitCtxStake)
   -> (StakeAddress, Entropic,
       Maybe (ScriptWitnessFiles WitCtxStake)))
-> Parser (Maybe (ScriptWitnessFiles WitCtxStake))
-> Parser
     (StakeAddress, Entropic, Maybe (ScriptWitnessFiles WitCtxStake))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (ScriptWitnessFiles WitCtxStake)
-> Parser (Maybe (ScriptWitnessFiles WitCtxStake))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (WitCtx WitCtxStake
-> BalanceTxExecUnits
-> String
-> Maybe String
-> String
-> Parser (ScriptWitnessFiles WitCtxStake)
forall witctx.
WitCtx witctx
-> BalanceTxExecUnits
-> String
-> Maybe String
-> String
-> Parser (ScriptWitnessFiles witctx)
pScriptWitnessFiles
                      WitCtx WitCtxStake
WitCtxStake
                      BalanceTxExecUnits
balance
                      String
"withdrawal" Maybe String
forall a. Maybe a
Nothing
                      String
"the withdrawal of rewards.")
 where
   helpText :: String
helpText = String
"The reward withdrawal as StakeAddress+Entropic where \
              \StakeAddress is the Bech32-encoded stake address \
              \followed by the amount in Entropic. Optionally specify \
              \a script witness."

   parseWithdrawal :: Parsec.Parser (StakeAddress, Entropic)
   parseWithdrawal :: Parser (StakeAddress, Entropic)
parseWithdrawal =
     (,) (StakeAddress -> Entropic -> (StakeAddress, Entropic))
-> ParsecT String () Identity StakeAddress
-> ParsecT
     String () Identity (Entropic -> (StakeAddress, Entropic))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity StakeAddress
parseStakeAddress ParsecT String () Identity (Entropic -> (StakeAddress, Entropic))
-> ParsecT String () Identity Char
-> ParsecT
     String () Identity (Entropic -> (StakeAddress, Entropic))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'+' ParsecT String () Identity (Entropic -> (StakeAddress, Entropic))
-> Parser Entropic -> Parser (StakeAddress, Entropic)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Entropic
parseEntropic


pUpdateProposalFile :: Parser UpdateProposalFile
pUpdateProposalFile :: Parser UpdateProposalFile
pUpdateProposalFile =
  String -> UpdateProposalFile
UpdateProposalFile (String -> UpdateProposalFile)
-> Parser String -> Parser UpdateProposalFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ( Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
     (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"update-proposal-file"
     Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
     Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Filepath of the update proposal."
     Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
     )
  Parser String -> Parser String -> Parser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
      (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"update-proposal"
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall (f :: * -> *) a. Mod f a
Opt.internal
      )
  )


pColdSigningKeyFile :: Parser SigningKeyFile
pColdSigningKeyFile :: Parser SigningKeyFile
pColdSigningKeyFile =
  String -> SigningKeyFile
SigningKeyFile (String -> SigningKeyFile)
-> Parser String -> Parser SigningKeyFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ( Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
        (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"cold-signing-key-file"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Filepath of the cold signing key."
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
        )
    Parser String -> Parser String -> Parser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
      (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"signing-key-file"
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall (f :: * -> *) a. Mod f a
Opt.internal
      )
    )

pRequiredSigner :: Parser WitnessSigningData
pRequiredSigner :: Parser WitnessSigningData
pRequiredSigner =
    SigningKeyFile -> Maybe (Address ColeAddr) -> WitnessSigningData
KeyWitnessSigningData
      (SigningKeyFile -> Maybe (Address ColeAddr) -> WitnessSigningData)
-> Parser SigningKeyFile
-> Parser (Maybe (Address ColeAddr) -> WitnessSigningData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        ( String -> SigningKeyFile
SigningKeyFile (String -> SigningKeyFile)
-> Parser String -> Parser SigningKeyFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
              (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"required-signer"
              Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
              Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Input filepath of the signing key (zero or more) whose \
                          \signature is required."
              Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
              )
        )
      Parser (Maybe (Address ColeAddr) -> WitnessSigningData)
-> Parser (Maybe (Address ColeAddr)) -> Parser WitnessSigningData
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Address ColeAddr) -> Parser (Maybe (Address ColeAddr))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Address ColeAddr)
forall a. Maybe a
Nothing

pSomeWitnessSigningData :: Parser [WitnessSigningData]
pSomeWitnessSigningData :: Parser [WitnessSigningData]
pSomeWitnessSigningData =
  Parser WitnessSigningData -> Parser [WitnessSigningData]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (Parser WitnessSigningData -> Parser [WitnessSigningData])
-> Parser WitnessSigningData -> Parser [WitnessSigningData]
forall a b. (a -> b) -> a -> b
$
      SigningKeyFile -> Maybe (Address ColeAddr) -> WitnessSigningData
KeyWitnessSigningData
        (SigningKeyFile -> Maybe (Address ColeAddr) -> WitnessSigningData)
-> Parser SigningKeyFile
-> Parser (Maybe (Address ColeAddr) -> WitnessSigningData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          ( String -> SigningKeyFile
SigningKeyFile (String -> SigningKeyFile)
-> Parser String -> Parser SigningKeyFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
              Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
                (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"signing-key-file"
                Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
                Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Input filepath of the signing key (one or more)."
                Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
                )
          )
        Parser (Maybe (Address ColeAddr) -> WitnessSigningData)
-> Parser (Maybe (Address ColeAddr)) -> Parser WitnessSigningData
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
          Parser (Address ColeAddr) -> Parser (Maybe (Address ColeAddr))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser (Address ColeAddr)
pColeAddress

pSigningKeyFile :: FileDirection -> Parser SigningKeyFile
pSigningKeyFile :: FileDirection -> Parser SigningKeyFile
pSigningKeyFile FileDirection
fdir =
  String -> SigningKeyFile
SigningKeyFile (String -> SigningKeyFile)
-> Parser String -> Parser SigningKeyFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
      (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"signing-key-file"
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help (FileDirection -> String
forall a b. (Show a, ConvertText String b) => a -> b
show FileDirection
fdir String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" filepath of the signing key.")
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
      )

pWitnessSigningData :: Parser WitnessSigningData
pWitnessSigningData :: Parser WitnessSigningData
pWitnessSigningData =
    SigningKeyFile -> Maybe (Address ColeAddr) -> WitnessSigningData
KeyWitnessSigningData
      (SigningKeyFile -> Maybe (Address ColeAddr) -> WitnessSigningData)
-> Parser SigningKeyFile
-> Parser (Maybe (Address ColeAddr) -> WitnessSigningData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        ( String -> SigningKeyFile
SigningKeyFile (String -> SigningKeyFile)
-> Parser String -> Parser SigningKeyFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
              (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"signing-key-file"
              Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
              Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Filepath of the signing key to be used in witness construction."
              Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
              )
        )
      Parser (Maybe (Address ColeAddr) -> WitnessSigningData)
-> Parser (Maybe (Address ColeAddr)) -> Parser WitnessSigningData
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        Parser (Address ColeAddr) -> Parser (Maybe (Address ColeAddr))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser (Address ColeAddr)
pColeAddress

pKesPeriod :: Parser KESPeriod
pKesPeriod :: Parser KESPeriod
pKesPeriod =
  Word -> KESPeriod
KESPeriod (Word -> KESPeriod) -> Parser Word -> Parser KESPeriod
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ReadM Word -> Mod OptionFields Word -> Parser Word
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word
forall a. Read a => ReadM a
Opt.auto
      (  String -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"kes-period"
      Mod OptionFields Word
-> Mod OptionFields Word -> Mod OptionFields Word
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"NATURAL"
      Mod OptionFields Word
-> Mod OptionFields Word -> Mod OptionFields Word
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The start of the KES key validity period."
      )

pEpochNo :: Parser EpochNo
pEpochNo :: Parser EpochNo
pEpochNo =
  Word64 -> EpochNo
EpochNo (Word64 -> EpochNo) -> Parser Word64 -> Parser EpochNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ReadM Word64 -> Mod OptionFields Word64 -> Parser Word64
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word64
forall a. Read a => ReadM a
Opt.auto
      (  String -> Mod OptionFields Word64
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"epoch"
      Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word64
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"NATURAL"
      Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word64
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The epoch number."
      )


pEpochNoUpdateProp :: Parser EpochNo
pEpochNoUpdateProp :: Parser EpochNo
pEpochNoUpdateProp =
  Word64 -> EpochNo
EpochNo (Word64 -> EpochNo) -> Parser Word64 -> Parser EpochNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ReadM Word64 -> Mod OptionFields Word64 -> Parser Word64
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word64
forall a. Read a => ReadM a
Opt.auto
      (  String -> Mod OptionFields Word64
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"epoch"
      Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word64
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"NATURAL"
      Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word64
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The epoch number in which the update proposal is valid."
      )

pGenesisFile :: String -> Parser GenesisFile
pGenesisFile :: String -> Parser GenesisFile
pGenesisFile String
desc =
  String -> GenesisFile
GenesisFile (String -> GenesisFile) -> Parser String -> Parser GenesisFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
      (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"genesis"
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
desc
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
      )

pOperatorCertIssueCounterFile :: Parser OpCertCounterFile
pOperatorCertIssueCounterFile :: Parser OpCertCounterFile
pOperatorCertIssueCounterFile =
  String -> OpCertCounterFile
OpCertCounterFile (String -> OpCertCounterFile)
-> Parser String -> Parser OpCertCounterFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ( Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
        (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"operational-certificate-issue-counter-file"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The file with the issue counter for the operational certificate."
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
        )
    Parser String -> Parser String -> Parser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
        (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"operational-certificate-issue-counter"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall (f :: * -> *) a. Mod f a
Opt.internal
        )
    )


pOutputFormat :: Parser OutputFormat
pOutputFormat :: Parser OutputFormat
pOutputFormat =
  ReadM OutputFormat
-> Mod OptionFields OutputFormat -> Parser OutputFormat
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM OutputFormat
readOutputFormat
    (  String -> Mod OptionFields OutputFormat
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"output-format"
    Mod OptionFields OutputFormat
-> Mod OptionFields OutputFormat -> Mod OptionFields OutputFormat
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields OutputFormat
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
    Mod OptionFields OutputFormat
-> Mod OptionFields OutputFormat -> Mod OptionFields OutputFormat
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields OutputFormat
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Optional output format. Accepted output formats are \"hex\" \
                \and \"bech32\" (default is \"bech32\")."
    Mod OptionFields OutputFormat
-> Mod OptionFields OutputFormat -> Mod OptionFields OutputFormat
forall a. Semigroup a => a -> a -> a
<> OutputFormat -> Mod OptionFields OutputFormat
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value OutputFormat
OutputFormatBech32
    )


pMaybeOutputFile :: Parser (Maybe OutputFile)
pMaybeOutputFile :: Parser (Maybe OutputFile)
pMaybeOutputFile =
  Parser OutputFile -> Parser (Maybe OutputFile)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser OutputFile -> Parser (Maybe OutputFile))
-> Parser OutputFile -> Parser (Maybe OutputFile)
forall a b. (a -> b) -> a -> b
$
    String -> OutputFile
OutputFile (String -> OutputFile) -> Parser String -> Parser OutputFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
        (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"out-file"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Optional output file. Default is to write to stdout."
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
        )

pOutputFile :: Parser OutputFile
pOutputFile :: Parser OutputFile
pOutputFile =
  String -> OutputFile
OutputFile (String -> OutputFile) -> Parser String -> Parser OutputFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
      (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"out-file"
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The output file."
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
      )

pColdVerificationKeyOrFile :: Parser ColdVerificationKeyOrFile
pColdVerificationKeyOrFile :: Parser ColdVerificationKeyOrFile
pColdVerificationKeyOrFile =
  VerificationKey StakePoolKey -> ColdVerificationKeyOrFile
ColdStakePoolVerificationKey (VerificationKey StakePoolKey -> ColdVerificationKeyOrFile)
-> Parser (VerificationKey StakePoolKey)
-> Parser ColdVerificationKeyOrFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKey StakePoolKey)
pStakePoolVerificationKey
    Parser ColdVerificationKeyOrFile
-> Parser ColdVerificationKeyOrFile
-> Parser ColdVerificationKeyOrFile
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> VerificationKey GenesisDelegateKey -> ColdVerificationKeyOrFile
ColdGenesisDelegateVerificationKey (VerificationKey GenesisDelegateKey -> ColdVerificationKeyOrFile)
-> Parser (VerificationKey GenesisDelegateKey)
-> Parser ColdVerificationKeyOrFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKey GenesisDelegateKey)
pGenesisDelegateVerificationKey
    Parser ColdVerificationKeyOrFile
-> Parser ColdVerificationKeyOrFile
-> Parser ColdVerificationKeyOrFile
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> VerificationKey VestedDelegateKey -> ColdVerificationKeyOrFile
ColdVestedDelegateVerificationKey (VerificationKey VestedDelegateKey -> ColdVerificationKeyOrFile)
-> Parser (VerificationKey VestedDelegateKey)
-> Parser ColdVerificationKeyOrFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKey VestedDelegateKey)
pVestedDelegateVerificationKey
    Parser ColdVerificationKeyOrFile
-> Parser ColdVerificationKeyOrFile
-> Parser ColdVerificationKeyOrFile
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> VerificationKeyFile -> ColdVerificationKeyOrFile
ColdVerificationKeyFile (VerificationKeyFile -> ColdVerificationKeyOrFile)
-> Parser VerificationKeyFile -> Parser ColdVerificationKeyOrFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VerificationKeyFile
pColdVerificationKeyFile

pColdVerificationKeyFile :: Parser VerificationKeyFile
pColdVerificationKeyFile :: Parser VerificationKeyFile
pColdVerificationKeyFile =
  String -> VerificationKeyFile
VerificationKeyFile (String -> VerificationKeyFile)
-> Parser String -> Parser VerificationKeyFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ( Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
        (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"cold-verification-key-file"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Filepath of the cold verification key."
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
        )
    Parser String -> Parser String -> Parser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
        (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"verification-key-file"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall (f :: * -> *) a. Mod f a
Opt.internal
        )
    )

pVerificationKey
  :: forall keyrole. SerialiseAsBech32 (VerificationKey keyrole)
  => AsType keyrole
  -> Parser (VerificationKey keyrole)
pVerificationKey :: AsType keyrole -> Parser (VerificationKey keyrole)
pVerificationKey AsType keyrole
asType =
  ReadM (VerificationKey keyrole)
-> Mod OptionFields (VerificationKey keyrole)
-> Parser (VerificationKey keyrole)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
    (AsType keyrole -> ReadM (VerificationKey keyrole)
forall keyrole.
SerialiseAsBech32 (VerificationKey keyrole) =>
AsType keyrole -> ReadM (VerificationKey keyrole)
readVerificationKey AsType keyrole
asType)
      (  String -> Mod OptionFields (VerificationKey keyrole)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"verification-key"
      Mod OptionFields (VerificationKey keyrole)
-> Mod OptionFields (VerificationKey keyrole)
-> Mod OptionFields (VerificationKey keyrole)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (VerificationKey keyrole)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
      Mod OptionFields (VerificationKey keyrole)
-> Mod OptionFields (VerificationKey keyrole)
-> Mod OptionFields (VerificationKey keyrole)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (VerificationKey keyrole)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Verification key (Bech32 or hex-encoded)."
      )

pVerificationKeyOrFile
  :: SerialiseAsBech32 (VerificationKey keyrole)
  => AsType keyrole
  -> Parser (VerificationKeyOrFile keyrole)
pVerificationKeyOrFile :: AsType keyrole -> Parser (VerificationKeyOrFile keyrole)
pVerificationKeyOrFile AsType keyrole
asType =
  VerificationKey keyrole -> VerificationKeyOrFile keyrole
forall keyrole.
VerificationKey keyrole -> VerificationKeyOrFile keyrole
VerificationKeyValue (VerificationKey keyrole -> VerificationKeyOrFile keyrole)
-> Parser (VerificationKey keyrole)
-> Parser (VerificationKeyOrFile keyrole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsType keyrole -> Parser (VerificationKey keyrole)
forall keyrole.
SerialiseAsBech32 (VerificationKey keyrole) =>
AsType keyrole -> Parser (VerificationKey keyrole)
pVerificationKey AsType keyrole
asType
    Parser (VerificationKeyOrFile keyrole)
-> Parser (VerificationKeyOrFile keyrole)
-> Parser (VerificationKeyOrFile keyrole)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> VerificationKeyFile -> VerificationKeyOrFile keyrole
forall keyrole.
VerificationKeyFile -> VerificationKeyOrFile keyrole
VerificationKeyFilePath (VerificationKeyFile -> VerificationKeyOrFile keyrole)
-> Parser VerificationKeyFile
-> Parser (VerificationKeyOrFile keyrole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileDirection -> Parser VerificationKeyFile
pVerificationKeyFile FileDirection
Input

pVerificationKeyFile :: FileDirection -> Parser VerificationKeyFile
pVerificationKeyFile :: FileDirection -> Parser VerificationKeyFile
pVerificationKeyFile FileDirection
fdir =
  String -> VerificationKeyFile
VerificationKeyFile (String -> VerificationKeyFile)
-> Parser String -> Parser VerificationKeyFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
      (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"verification-key-file"
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help (FileDirection -> String
forall a b. (Show a, ConvertText String b) => a -> b
show FileDirection
fdir String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" filepath of the verification key.")
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
      )

pExtendedVerificationKeyFile :: FileDirection -> Parser VerificationKeyFile
pExtendedVerificationKeyFile :: FileDirection -> Parser VerificationKeyFile
pExtendedVerificationKeyFile FileDirection
fdir =
  String -> VerificationKeyFile
VerificationKeyFile (String -> VerificationKeyFile)
-> Parser String -> Parser VerificationKeyFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
      (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"extended-verification-key-file"
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help (FileDirection -> String
forall a b. (Show a, ConvertText String b) => a -> b
show FileDirection
fdir String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" filepath of the ed25519-bip32 verification key.")
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
      )

pGenesisVerificationKeyFile :: Parser VerificationKeyFile
pGenesisVerificationKeyFile :: Parser VerificationKeyFile
pGenesisVerificationKeyFile =
  String -> VerificationKeyFile
VerificationKeyFile (String -> VerificationKeyFile)
-> Parser String -> Parser VerificationKeyFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
      (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"genesis-verification-key-file"
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Filepath of the genesis verification key."
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
      )

pGenesisVerificationKeyHash :: Parser (Hash GenesisKey)
pGenesisVerificationKeyHash :: Parser (Hash GenesisKey)
pGenesisVerificationKeyHash =
    ReadM (Hash GenesisKey)
-> Mod OptionFields (Hash GenesisKey) -> Parser (Hash GenesisKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String (Hash GenesisKey))
-> ReadM (Hash GenesisKey)
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String (Hash GenesisKey)
deserialiseFromHex)
        (  String -> Mod OptionFields (Hash GenesisKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"genesis-verification-key-hash"
        Mod OptionFields (Hash GenesisKey)
-> Mod OptionFields (Hash GenesisKey)
-> Mod OptionFields (Hash GenesisKey)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Hash GenesisKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
        Mod OptionFields (Hash GenesisKey)
-> Mod OptionFields (Hash GenesisKey)
-> Mod OptionFields (Hash GenesisKey)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Hash GenesisKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Genesis verification key hash (hex-encoded)."
        )
  where
    deserialiseFromHex :: String -> Either String (Hash GenesisKey)
    deserialiseFromHex :: String -> Either String (Hash GenesisKey)
deserialiseFromHex =
      Either String (Hash GenesisKey)
-> (Hash GenesisKey -> Either String (Hash GenesisKey))
-> Maybe (Hash GenesisKey)
-> Either String (Hash GenesisKey)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String (Hash GenesisKey)
forall a b. a -> Either a b
Left String
"Invalid genesis verification key hash.") Hash GenesisKey -> Either String (Hash GenesisKey)
forall a b. b -> Either a b
Right
        (Maybe (Hash GenesisKey) -> Either String (Hash GenesisKey))
-> (String -> Maybe (Hash GenesisKey))
-> String
-> Either String (Hash GenesisKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AsType (Hash GenesisKey) -> ByteString -> Maybe (Hash GenesisKey)
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
deserialiseFromRawBytesHex (AsType GenesisKey -> AsType (Hash GenesisKey)
forall a. AsType a -> AsType (Hash a)
AsHash AsType GenesisKey
AsGenesisKey)
        (ByteString -> Maybe (Hash GenesisKey))
-> (String -> ByteString) -> String -> Maybe (Hash GenesisKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> ByteString
BSC.pack

pGenesisVerificationKey :: Parser (VerificationKey GenesisKey)
pGenesisVerificationKey :: Parser (VerificationKey GenesisKey)
pGenesisVerificationKey =
    ReadM (VerificationKey GenesisKey)
-> Mod OptionFields (VerificationKey GenesisKey)
-> Parser (VerificationKey GenesisKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String (VerificationKey GenesisKey))
-> ReadM (VerificationKey GenesisKey)
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String (VerificationKey GenesisKey)
deserialiseFromHex)
        (  String -> Mod OptionFields (VerificationKey GenesisKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"genesis-verification-key"
        Mod OptionFields (VerificationKey GenesisKey)
-> Mod OptionFields (VerificationKey GenesisKey)
-> Mod OptionFields (VerificationKey GenesisKey)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (VerificationKey GenesisKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
        Mod OptionFields (VerificationKey GenesisKey)
-> Mod OptionFields (VerificationKey GenesisKey)
-> Mod OptionFields (VerificationKey GenesisKey)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (VerificationKey GenesisKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Genesis verification key (hex-encoded)."
        )
  where
    deserialiseFromHex :: String -> Either String (VerificationKey GenesisKey)
    deserialiseFromHex :: String -> Either String (VerificationKey GenesisKey)
deserialiseFromHex =
      Either String (VerificationKey GenesisKey)
-> (VerificationKey GenesisKey
    -> Either String (VerificationKey GenesisKey))
-> Maybe (VerificationKey GenesisKey)
-> Either String (VerificationKey GenesisKey)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String (VerificationKey GenesisKey)
forall a b. a -> Either a b
Left String
"Invalid genesis verification key.") VerificationKey GenesisKey
-> Either String (VerificationKey GenesisKey)
forall a b. b -> Either a b
Right
        (Maybe (VerificationKey GenesisKey)
 -> Either String (VerificationKey GenesisKey))
-> (String -> Maybe (VerificationKey GenesisKey))
-> String
-> Either String (VerificationKey GenesisKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AsType (VerificationKey GenesisKey)
-> ByteString -> Maybe (VerificationKey GenesisKey)
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
deserialiseFromRawBytesHex (AsType GenesisKey -> AsType (VerificationKey GenesisKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType GenesisKey
AsGenesisKey)
        (ByteString -> Maybe (VerificationKey GenesisKey))
-> (String -> ByteString)
-> String
-> Maybe (VerificationKey GenesisKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> ByteString
BSC.pack

pGenesisVerificationKeyOrFile :: Parser (VerificationKeyOrFile GenesisKey)
pGenesisVerificationKeyOrFile :: Parser (VerificationKeyOrFile GenesisKey)
pGenesisVerificationKeyOrFile =
  VerificationKey GenesisKey -> VerificationKeyOrFile GenesisKey
forall keyrole.
VerificationKey keyrole -> VerificationKeyOrFile keyrole
VerificationKeyValue (VerificationKey GenesisKey -> VerificationKeyOrFile GenesisKey)
-> Parser (VerificationKey GenesisKey)
-> Parser (VerificationKeyOrFile GenesisKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKey GenesisKey)
pGenesisVerificationKey
    Parser (VerificationKeyOrFile GenesisKey)
-> Parser (VerificationKeyOrFile GenesisKey)
-> Parser (VerificationKeyOrFile GenesisKey)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> VerificationKeyFile -> VerificationKeyOrFile GenesisKey
forall keyrole.
VerificationKeyFile -> VerificationKeyOrFile keyrole
VerificationKeyFilePath (VerificationKeyFile -> VerificationKeyOrFile GenesisKey)
-> Parser VerificationKeyFile
-> Parser (VerificationKeyOrFile GenesisKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VerificationKeyFile
pGenesisVerificationKeyFile

pGenesisVerificationKeyOrHashOrFile :: Parser (VerificationKeyOrHashOrFile GenesisKey)
pGenesisVerificationKeyOrHashOrFile :: Parser (VerificationKeyOrHashOrFile GenesisKey)
pGenesisVerificationKeyOrHashOrFile =
  VerificationKeyOrFile GenesisKey
-> VerificationKeyOrHashOrFile GenesisKey
forall keyrole.
VerificationKeyOrFile keyrole
-> VerificationKeyOrHashOrFile keyrole
VerificationKeyOrFile (VerificationKeyOrFile GenesisKey
 -> VerificationKeyOrHashOrFile GenesisKey)
-> Parser (VerificationKeyOrFile GenesisKey)
-> Parser (VerificationKeyOrHashOrFile GenesisKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyOrFile GenesisKey)
pGenesisVerificationKeyOrFile
    Parser (VerificationKeyOrHashOrFile GenesisKey)
-> Parser (VerificationKeyOrHashOrFile GenesisKey)
-> Parser (VerificationKeyOrHashOrFile GenesisKey)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Hash GenesisKey -> VerificationKeyOrHashOrFile GenesisKey
forall keyrole. Hash keyrole -> VerificationKeyOrHashOrFile keyrole
VerificationKeyHash (Hash GenesisKey -> VerificationKeyOrHashOrFile GenesisKey)
-> Parser (Hash GenesisKey)
-> Parser (VerificationKeyOrHashOrFile GenesisKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Hash GenesisKey)
pGenesisVerificationKeyHash

pGenesisDelegateVerificationKeyFile :: Parser VerificationKeyFile
pGenesisDelegateVerificationKeyFile :: Parser VerificationKeyFile
pGenesisDelegateVerificationKeyFile =
  String -> VerificationKeyFile
VerificationKeyFile (String -> VerificationKeyFile)
-> Parser String -> Parser VerificationKeyFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
      (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"genesis-delegate-verification-key-file"
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Filepath of the genesis delegate verification key."
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
      )

pGenesisDelegateVerificationKeyHash :: Parser (Hash GenesisDelegateKey)
pGenesisDelegateVerificationKeyHash :: Parser (Hash GenesisDelegateKey)
pGenesisDelegateVerificationKeyHash =
    ReadM (Hash GenesisDelegateKey)
-> Mod OptionFields (Hash GenesisDelegateKey)
-> Parser (Hash GenesisDelegateKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String (Hash GenesisDelegateKey))
-> ReadM (Hash GenesisDelegateKey)
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String (Hash GenesisDelegateKey)
deserialiseFromHex)
        (  String -> Mod OptionFields (Hash GenesisDelegateKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"genesis-delegate-verification-key-hash"
        Mod OptionFields (Hash GenesisDelegateKey)
-> Mod OptionFields (Hash GenesisDelegateKey)
-> Mod OptionFields (Hash GenesisDelegateKey)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Hash GenesisDelegateKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
        Mod OptionFields (Hash GenesisDelegateKey)
-> Mod OptionFields (Hash GenesisDelegateKey)
-> Mod OptionFields (Hash GenesisDelegateKey)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Hash GenesisDelegateKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Genesis delegate verification key hash (hex-encoded)."
        )
  where
    deserialiseFromHex :: String -> Either String (Hash GenesisDelegateKey)
    deserialiseFromHex :: String -> Either String (Hash GenesisDelegateKey)
deserialiseFromHex =
      Either String (Hash GenesisDelegateKey)
-> (Hash GenesisDelegateKey
    -> Either String (Hash GenesisDelegateKey))
-> Maybe (Hash GenesisDelegateKey)
-> Either String (Hash GenesisDelegateKey)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String (Hash GenesisDelegateKey)
forall a b. a -> Either a b
Left String
"Invalid genesis delegate verification key hash.") Hash GenesisDelegateKey -> Either String (Hash GenesisDelegateKey)
forall a b. b -> Either a b
Right
        (Maybe (Hash GenesisDelegateKey)
 -> Either String (Hash GenesisDelegateKey))
-> (String -> Maybe (Hash GenesisDelegateKey))
-> String
-> Either String (Hash GenesisDelegateKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AsType (Hash GenesisDelegateKey)
-> ByteString -> Maybe (Hash GenesisDelegateKey)
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
deserialiseFromRawBytesHex (AsType GenesisDelegateKey -> AsType (Hash GenesisDelegateKey)
forall a. AsType a -> AsType (Hash a)
AsHash AsType GenesisDelegateKey
AsGenesisDelegateKey)
        (ByteString -> Maybe (Hash GenesisDelegateKey))
-> (String -> ByteString)
-> String
-> Maybe (Hash GenesisDelegateKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> ByteString
BSC.pack

pGenesisDelegateVerificationKey :: Parser (VerificationKey GenesisDelegateKey)
pGenesisDelegateVerificationKey :: Parser (VerificationKey GenesisDelegateKey)
pGenesisDelegateVerificationKey =
    ReadM (VerificationKey GenesisDelegateKey)
-> Mod OptionFields (VerificationKey GenesisDelegateKey)
-> Parser (VerificationKey GenesisDelegateKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String (VerificationKey GenesisDelegateKey))
-> ReadM (VerificationKey GenesisDelegateKey)
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String (VerificationKey GenesisDelegateKey)
deserialiseFromHex)
        (  String -> Mod OptionFields (VerificationKey GenesisDelegateKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"genesis-delegate-verification-key"
        Mod OptionFields (VerificationKey GenesisDelegateKey)
-> Mod OptionFields (VerificationKey GenesisDelegateKey)
-> Mod OptionFields (VerificationKey GenesisDelegateKey)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (VerificationKey GenesisDelegateKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
        Mod OptionFields (VerificationKey GenesisDelegateKey)
-> Mod OptionFields (VerificationKey GenesisDelegateKey)
-> Mod OptionFields (VerificationKey GenesisDelegateKey)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (VerificationKey GenesisDelegateKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Genesis delegate verification key (hex-encoded)."
        )
  where
    deserialiseFromHex
      :: String
      -> Either String (VerificationKey GenesisDelegateKey)
    deserialiseFromHex :: String -> Either String (VerificationKey GenesisDelegateKey)
deserialiseFromHex =
      Either String (VerificationKey GenesisDelegateKey)
-> (VerificationKey GenesisDelegateKey
    -> Either String (VerificationKey GenesisDelegateKey))
-> Maybe (VerificationKey GenesisDelegateKey)
-> Either String (VerificationKey GenesisDelegateKey)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String (VerificationKey GenesisDelegateKey)
forall a b. a -> Either a b
Left String
"Invalid genesis delegate verification key.") VerificationKey GenesisDelegateKey
-> Either String (VerificationKey GenesisDelegateKey)
forall a b. b -> Either a b
Right
        (Maybe (VerificationKey GenesisDelegateKey)
 -> Either String (VerificationKey GenesisDelegateKey))
-> (String -> Maybe (VerificationKey GenesisDelegateKey))
-> String
-> Either String (VerificationKey GenesisDelegateKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AsType (VerificationKey GenesisDelegateKey)
-> ByteString -> Maybe (VerificationKey GenesisDelegateKey)
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
deserialiseFromRawBytesHex (AsType GenesisDelegateKey
-> AsType (VerificationKey GenesisDelegateKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType GenesisDelegateKey
AsGenesisDelegateKey)
        (ByteString -> Maybe (VerificationKey GenesisDelegateKey))
-> (String -> ByteString)
-> String
-> Maybe (VerificationKey GenesisDelegateKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> ByteString
BSC.pack

pGenesisDelegateVerificationKeyOrFile
  :: Parser (VerificationKeyOrFile GenesisDelegateKey)
pGenesisDelegateVerificationKeyOrFile :: Parser (VerificationKeyOrFile GenesisDelegateKey)
pGenesisDelegateVerificationKeyOrFile =
  VerificationKey GenesisDelegateKey
-> VerificationKeyOrFile GenesisDelegateKey
forall keyrole.
VerificationKey keyrole -> VerificationKeyOrFile keyrole
VerificationKeyValue (VerificationKey GenesisDelegateKey
 -> VerificationKeyOrFile GenesisDelegateKey)
-> Parser (VerificationKey GenesisDelegateKey)
-> Parser (VerificationKeyOrFile GenesisDelegateKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKey GenesisDelegateKey)
pGenesisDelegateVerificationKey
    Parser (VerificationKeyOrFile GenesisDelegateKey)
-> Parser (VerificationKeyOrFile GenesisDelegateKey)
-> Parser (VerificationKeyOrFile GenesisDelegateKey)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> VerificationKeyFile -> VerificationKeyOrFile GenesisDelegateKey
forall keyrole.
VerificationKeyFile -> VerificationKeyOrFile keyrole
VerificationKeyFilePath (VerificationKeyFile -> VerificationKeyOrFile GenesisDelegateKey)
-> Parser VerificationKeyFile
-> Parser (VerificationKeyOrFile GenesisDelegateKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VerificationKeyFile
pGenesisDelegateVerificationKeyFile

pGenesisDelegateVerificationKeyOrHashOrFile
  :: Parser (VerificationKeyOrHashOrFile GenesisDelegateKey)
pGenesisDelegateVerificationKeyOrHashOrFile :: Parser (VerificationKeyOrHashOrFile GenesisDelegateKey)
pGenesisDelegateVerificationKeyOrHashOrFile =
  VerificationKeyOrFile GenesisDelegateKey
-> VerificationKeyOrHashOrFile GenesisDelegateKey
forall keyrole.
VerificationKeyOrFile keyrole
-> VerificationKeyOrHashOrFile keyrole
VerificationKeyOrFile (VerificationKeyOrFile GenesisDelegateKey
 -> VerificationKeyOrHashOrFile GenesisDelegateKey)
-> Parser (VerificationKeyOrFile GenesisDelegateKey)
-> Parser (VerificationKeyOrHashOrFile GenesisDelegateKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyOrFile GenesisDelegateKey)
pGenesisDelegateVerificationKeyOrFile
    Parser (VerificationKeyOrHashOrFile GenesisDelegateKey)
-> Parser (VerificationKeyOrHashOrFile GenesisDelegateKey)
-> Parser (VerificationKeyOrHashOrFile GenesisDelegateKey)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Hash GenesisDelegateKey
-> VerificationKeyOrHashOrFile GenesisDelegateKey
forall keyrole. Hash keyrole -> VerificationKeyOrHashOrFile keyrole
VerificationKeyHash (Hash GenesisDelegateKey
 -> VerificationKeyOrHashOrFile GenesisDelegateKey)
-> Parser (Hash GenesisDelegateKey)
-> Parser (VerificationKeyOrHashOrFile GenesisDelegateKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Hash GenesisDelegateKey)
pGenesisDelegateVerificationKeyHash

pVestedVerificationKeyFile :: Parser VerificationKeyFile
pVestedVerificationKeyFile :: Parser VerificationKeyFile
pVestedVerificationKeyFile =
  String -> VerificationKeyFile
VerificationKeyFile (String -> VerificationKeyFile)
-> Parser String -> Parser VerificationKeyFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
      (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"vested-verification-key-file"
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Filepath of the vested verification key."
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
      )

pVestedVerificationKeyHash :: Parser (Hash VestedKey)
pVestedVerificationKeyHash :: Parser (Hash VestedKey)
pVestedVerificationKeyHash =
    ReadM (Hash VestedKey)
-> Mod OptionFields (Hash VestedKey) -> Parser (Hash VestedKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String (Hash VestedKey))
-> ReadM (Hash VestedKey)
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String (Hash VestedKey)
deserialiseFromHex)
        (  String -> Mod OptionFields (Hash VestedKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"vested-verification-key-hash"
        Mod OptionFields (Hash VestedKey)
-> Mod OptionFields (Hash VestedKey)
-> Mod OptionFields (Hash VestedKey)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Hash VestedKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
        Mod OptionFields (Hash VestedKey)
-> Mod OptionFields (Hash VestedKey)
-> Mod OptionFields (Hash VestedKey)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Hash VestedKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Vested verification key hash (hex-encoded)."
        )
  where
    deserialiseFromHex :: String -> Either String (Hash VestedKey)
    deserialiseFromHex :: String -> Either String (Hash VestedKey)
deserialiseFromHex =
      Either String (Hash VestedKey)
-> (Hash VestedKey -> Either String (Hash VestedKey))
-> Maybe (Hash VestedKey)
-> Either String (Hash VestedKey)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String (Hash VestedKey)
forall a b. a -> Either a b
Left String
"Invalid vested verification key hash.") Hash VestedKey -> Either String (Hash VestedKey)
forall a b. b -> Either a b
Right
        (Maybe (Hash VestedKey) -> Either String (Hash VestedKey))
-> (String -> Maybe (Hash VestedKey))
-> String
-> Either String (Hash VestedKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AsType (Hash VestedKey) -> ByteString -> Maybe (Hash VestedKey)
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
deserialiseFromRawBytesHex (AsType VestedKey -> AsType (Hash VestedKey)
forall a. AsType a -> AsType (Hash a)
AsHash AsType VestedKey
AsVestedKey)
        (ByteString -> Maybe (Hash VestedKey))
-> (String -> ByteString) -> String -> Maybe (Hash VestedKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> ByteString
BSC.pack

pVestedVerificationKey :: Parser (VerificationKey VestedKey)
pVestedVerificationKey :: Parser (VerificationKey VestedKey)
pVestedVerificationKey =
    ReadM (VerificationKey VestedKey)
-> Mod OptionFields (VerificationKey VestedKey)
-> Parser (VerificationKey VestedKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String (VerificationKey VestedKey))
-> ReadM (VerificationKey VestedKey)
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String (VerificationKey VestedKey)
deserialiseFromHex)
        (  String -> Mod OptionFields (VerificationKey VestedKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"vested-verification-key"
        Mod OptionFields (VerificationKey VestedKey)
-> Mod OptionFields (VerificationKey VestedKey)
-> Mod OptionFields (VerificationKey VestedKey)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (VerificationKey VestedKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
        Mod OptionFields (VerificationKey VestedKey)
-> Mod OptionFields (VerificationKey VestedKey)
-> Mod OptionFields (VerificationKey VestedKey)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (VerificationKey VestedKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Vested verification key (hex-encoded)."
        )
  where
    deserialiseFromHex :: String -> Either String (VerificationKey VestedKey)
    deserialiseFromHex :: String -> Either String (VerificationKey VestedKey)
deserialiseFromHex =
      Either String (VerificationKey VestedKey)
-> (VerificationKey VestedKey
    -> Either String (VerificationKey VestedKey))
-> Maybe (VerificationKey VestedKey)
-> Either String (VerificationKey VestedKey)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String (VerificationKey VestedKey)
forall a b. a -> Either a b
Left String
"Invalid vested verification key.") VerificationKey VestedKey
-> Either String (VerificationKey VestedKey)
forall a b. b -> Either a b
Right
        (Maybe (VerificationKey VestedKey)
 -> Either String (VerificationKey VestedKey))
-> (String -> Maybe (VerificationKey VestedKey))
-> String
-> Either String (VerificationKey VestedKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AsType (VerificationKey VestedKey)
-> ByteString -> Maybe (VerificationKey VestedKey)
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
deserialiseFromRawBytesHex (AsType VestedKey -> AsType (VerificationKey VestedKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType VestedKey
AsVestedKey)
        (ByteString -> Maybe (VerificationKey VestedKey))
-> (String -> ByteString)
-> String
-> Maybe (VerificationKey VestedKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> ByteString
BSC.pack

pVestedVerificationKeyOrFile :: Parser (VerificationKeyOrFile VestedKey)
pVestedVerificationKeyOrFile :: Parser (VerificationKeyOrFile VestedKey)
pVestedVerificationKeyOrFile =
  VerificationKey VestedKey -> VerificationKeyOrFile VestedKey
forall keyrole.
VerificationKey keyrole -> VerificationKeyOrFile keyrole
VerificationKeyValue (VerificationKey VestedKey -> VerificationKeyOrFile VestedKey)
-> Parser (VerificationKey VestedKey)
-> Parser (VerificationKeyOrFile VestedKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKey VestedKey)
pVestedVerificationKey
    Parser (VerificationKeyOrFile VestedKey)
-> Parser (VerificationKeyOrFile VestedKey)
-> Parser (VerificationKeyOrFile VestedKey)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> VerificationKeyFile -> VerificationKeyOrFile VestedKey
forall keyrole.
VerificationKeyFile -> VerificationKeyOrFile keyrole
VerificationKeyFilePath (VerificationKeyFile -> VerificationKeyOrFile VestedKey)
-> Parser VerificationKeyFile
-> Parser (VerificationKeyOrFile VestedKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VerificationKeyFile
pVestedVerificationKeyFile

pVestedVerificationKeyOrHashOrFile :: Parser (VerificationKeyOrHashOrFile VestedKey)
pVestedVerificationKeyOrHashOrFile :: Parser (VerificationKeyOrHashOrFile VestedKey)
pVestedVerificationKeyOrHashOrFile =
  VerificationKeyOrFile VestedKey
-> VerificationKeyOrHashOrFile VestedKey
forall keyrole.
VerificationKeyOrFile keyrole
-> VerificationKeyOrHashOrFile keyrole
VerificationKeyOrFile (VerificationKeyOrFile VestedKey
 -> VerificationKeyOrHashOrFile VestedKey)
-> Parser (VerificationKeyOrFile VestedKey)
-> Parser (VerificationKeyOrHashOrFile VestedKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyOrFile VestedKey)
pVestedVerificationKeyOrFile
    Parser (VerificationKeyOrHashOrFile VestedKey)
-> Parser (VerificationKeyOrHashOrFile VestedKey)
-> Parser (VerificationKeyOrHashOrFile VestedKey)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Hash VestedKey -> VerificationKeyOrHashOrFile VestedKey
forall keyrole. Hash keyrole -> VerificationKeyOrHashOrFile keyrole
VerificationKeyHash (Hash VestedKey -> VerificationKeyOrHashOrFile VestedKey)
-> Parser (Hash VestedKey)
-> Parser (VerificationKeyOrHashOrFile VestedKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Hash VestedKey)
pVestedVerificationKeyHash

pVestedDelegateVerificationKeyFile :: Parser VerificationKeyFile
pVestedDelegateVerificationKeyFile :: Parser VerificationKeyFile
pVestedDelegateVerificationKeyFile =
  String -> VerificationKeyFile
VerificationKeyFile (String -> VerificationKeyFile)
-> Parser String -> Parser VerificationKeyFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
      (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"vested-delegate-verification-key-file"
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Filepath of the vested delegate verification key."
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
      )

pVestedDelegateVerificationKeyHash :: Parser (Hash VestedDelegateKey)
pVestedDelegateVerificationKeyHash :: Parser (Hash VestedDelegateKey)
pVestedDelegateVerificationKeyHash =
    ReadM (Hash VestedDelegateKey)
-> Mod OptionFields (Hash VestedDelegateKey)
-> Parser (Hash VestedDelegateKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String (Hash VestedDelegateKey))
-> ReadM (Hash VestedDelegateKey)
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String (Hash VestedDelegateKey)
deserialiseFromHex)
        (  String -> Mod OptionFields (Hash VestedDelegateKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"vested-delegate-verification-key-hash"
        Mod OptionFields (Hash VestedDelegateKey)
-> Mod OptionFields (Hash VestedDelegateKey)
-> Mod OptionFields (Hash VestedDelegateKey)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Hash VestedDelegateKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
        Mod OptionFields (Hash VestedDelegateKey)
-> Mod OptionFields (Hash VestedDelegateKey)
-> Mod OptionFields (Hash VestedDelegateKey)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Hash VestedDelegateKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Vested delegate verification key hash (hex-encoded)."
        )
  where
    deserialiseFromHex :: String -> Either String (Hash VestedDelegateKey)
    deserialiseFromHex :: String -> Either String (Hash VestedDelegateKey)
deserialiseFromHex =
      Either String (Hash VestedDelegateKey)
-> (Hash VestedDelegateKey
    -> Either String (Hash VestedDelegateKey))
-> Maybe (Hash VestedDelegateKey)
-> Either String (Hash VestedDelegateKey)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String (Hash VestedDelegateKey)
forall a b. a -> Either a b
Left String
"Invalid vested delegate verification key hash.") Hash VestedDelegateKey -> Either String (Hash VestedDelegateKey)
forall a b. b -> Either a b
Right
        (Maybe (Hash VestedDelegateKey)
 -> Either String (Hash VestedDelegateKey))
-> (String -> Maybe (Hash VestedDelegateKey))
-> String
-> Either String (Hash VestedDelegateKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AsType (Hash VestedDelegateKey)
-> ByteString -> Maybe (Hash VestedDelegateKey)
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
deserialiseFromRawBytesHex (AsType VestedDelegateKey -> AsType (Hash VestedDelegateKey)
forall a. AsType a -> AsType (Hash a)
AsHash AsType VestedDelegateKey
AsVestedDelegateKey)
        (ByteString -> Maybe (Hash VestedDelegateKey))
-> (String -> ByteString)
-> String
-> Maybe (Hash VestedDelegateKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> ByteString
BSC.pack

pVestedDelegateVerificationKey :: Parser (VerificationKey VestedDelegateKey)
pVestedDelegateVerificationKey :: Parser (VerificationKey VestedDelegateKey)
pVestedDelegateVerificationKey =
    ReadM (VerificationKey VestedDelegateKey)
-> Mod OptionFields (VerificationKey VestedDelegateKey)
-> Parser (VerificationKey VestedDelegateKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String (VerificationKey VestedDelegateKey))
-> ReadM (VerificationKey VestedDelegateKey)
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String (VerificationKey VestedDelegateKey)
deserialiseFromHex)
        (  String -> Mod OptionFields (VerificationKey VestedDelegateKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"vested-delegate-verification-key"
        Mod OptionFields (VerificationKey VestedDelegateKey)
-> Mod OptionFields (VerificationKey VestedDelegateKey)
-> Mod OptionFields (VerificationKey VestedDelegateKey)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (VerificationKey VestedDelegateKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
        Mod OptionFields (VerificationKey VestedDelegateKey)
-> Mod OptionFields (VerificationKey VestedDelegateKey)
-> Mod OptionFields (VerificationKey VestedDelegateKey)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (VerificationKey VestedDelegateKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Vested delegate verification key (hex-encoded)."
        )
  where
    deserialiseFromHex
      :: String
      -> Either String (VerificationKey VestedDelegateKey)
    deserialiseFromHex :: String -> Either String (VerificationKey VestedDelegateKey)
deserialiseFromHex =
      Either String (VerificationKey VestedDelegateKey)
-> (VerificationKey VestedDelegateKey
    -> Either String (VerificationKey VestedDelegateKey))
-> Maybe (VerificationKey VestedDelegateKey)
-> Either String (VerificationKey VestedDelegateKey)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String (VerificationKey VestedDelegateKey)
forall a b. a -> Either a b
Left String
"Invalid vested delegate verification key.") VerificationKey VestedDelegateKey
-> Either String (VerificationKey VestedDelegateKey)
forall a b. b -> Either a b
Right
        (Maybe (VerificationKey VestedDelegateKey)
 -> Either String (VerificationKey VestedDelegateKey))
-> (String -> Maybe (VerificationKey VestedDelegateKey))
-> String
-> Either String (VerificationKey VestedDelegateKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AsType (VerificationKey VestedDelegateKey)
-> ByteString -> Maybe (VerificationKey VestedDelegateKey)
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
deserialiseFromRawBytesHex (AsType VestedDelegateKey
-> AsType (VerificationKey VestedDelegateKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType VestedDelegateKey
AsVestedDelegateKey)
        (ByteString -> Maybe (VerificationKey VestedDelegateKey))
-> (String -> ByteString)
-> String
-> Maybe (VerificationKey VestedDelegateKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> ByteString
BSC.pack

pVestedDelegateVerificationKeyOrFile
  :: Parser (VerificationKeyOrFile VestedDelegateKey)
pVestedDelegateVerificationKeyOrFile :: Parser (VerificationKeyOrFile VestedDelegateKey)
pVestedDelegateVerificationKeyOrFile =
  VerificationKey VestedDelegateKey
-> VerificationKeyOrFile VestedDelegateKey
forall keyrole.
VerificationKey keyrole -> VerificationKeyOrFile keyrole
VerificationKeyValue (VerificationKey VestedDelegateKey
 -> VerificationKeyOrFile VestedDelegateKey)
-> Parser (VerificationKey VestedDelegateKey)
-> Parser (VerificationKeyOrFile VestedDelegateKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKey VestedDelegateKey)
pVestedDelegateVerificationKey
    Parser (VerificationKeyOrFile VestedDelegateKey)
-> Parser (VerificationKeyOrFile VestedDelegateKey)
-> Parser (VerificationKeyOrFile VestedDelegateKey)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> VerificationKeyFile -> VerificationKeyOrFile VestedDelegateKey
forall keyrole.
VerificationKeyFile -> VerificationKeyOrFile keyrole
VerificationKeyFilePath (VerificationKeyFile -> VerificationKeyOrFile VestedDelegateKey)
-> Parser VerificationKeyFile
-> Parser (VerificationKeyOrFile VestedDelegateKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VerificationKeyFile
pVestedDelegateVerificationKeyFile

pVestedDelegateVerificationKeyOrHashOrFile
  :: Parser (VerificationKeyOrHashOrFile VestedDelegateKey)
pVestedDelegateVerificationKeyOrHashOrFile :: Parser (VerificationKeyOrHashOrFile VestedDelegateKey)
pVestedDelegateVerificationKeyOrHashOrFile =
  VerificationKeyOrFile VestedDelegateKey
-> VerificationKeyOrHashOrFile VestedDelegateKey
forall keyrole.
VerificationKeyOrFile keyrole
-> VerificationKeyOrHashOrFile keyrole
VerificationKeyOrFile (VerificationKeyOrFile VestedDelegateKey
 -> VerificationKeyOrHashOrFile VestedDelegateKey)
-> Parser (VerificationKeyOrFile VestedDelegateKey)
-> Parser (VerificationKeyOrHashOrFile VestedDelegateKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyOrFile VestedDelegateKey)
pVestedDelegateVerificationKeyOrFile
    Parser (VerificationKeyOrHashOrFile VestedDelegateKey)
-> Parser (VerificationKeyOrHashOrFile VestedDelegateKey)
-> Parser (VerificationKeyOrHashOrFile VestedDelegateKey)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Hash VestedDelegateKey
-> VerificationKeyOrHashOrFile VestedDelegateKey
forall keyrole. Hash keyrole -> VerificationKeyOrHashOrFile keyrole
VerificationKeyHash (Hash VestedDelegateKey
 -> VerificationKeyOrHashOrFile VestedDelegateKey)
-> Parser (Hash VestedDelegateKey)
-> Parser (VerificationKeyOrHashOrFile VestedDelegateKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Hash VestedDelegateKey)
pVestedDelegateVerificationKeyHash

pKesVerificationKeyOrFile :: Parser (VerificationKeyOrFile KesKey)
pKesVerificationKeyOrFile :: Parser (VerificationKeyOrFile KesKey)
pKesVerificationKeyOrFile =
  VerificationKey KesKey -> VerificationKeyOrFile KesKey
forall keyrole.
VerificationKey keyrole -> VerificationKeyOrFile keyrole
VerificationKeyValue (VerificationKey KesKey -> VerificationKeyOrFile KesKey)
-> Parser (VerificationKey KesKey)
-> Parser (VerificationKeyOrFile KesKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKey KesKey)
pKesVerificationKey
    Parser (VerificationKeyOrFile KesKey)
-> Parser (VerificationKeyOrFile KesKey)
-> Parser (VerificationKeyOrFile KesKey)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> VerificationKeyFile -> VerificationKeyOrFile KesKey
forall keyrole.
VerificationKeyFile -> VerificationKeyOrFile keyrole
VerificationKeyFilePath (VerificationKeyFile -> VerificationKeyOrFile KesKey)
-> Parser VerificationKeyFile
-> Parser (VerificationKeyOrFile KesKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VerificationKeyFile
pKesVerificationKeyFile

pKesVerificationKey :: Parser (VerificationKey KesKey)
pKesVerificationKey :: Parser (VerificationKey KesKey)
pKesVerificationKey =
    ReadM (VerificationKey KesKey)
-> Mod OptionFields (VerificationKey KesKey)
-> Parser (VerificationKey KesKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String (VerificationKey KesKey))
-> ReadM (VerificationKey KesKey)
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String (VerificationKey KesKey)
deserialiseVerKey)
        (  String -> Mod OptionFields (VerificationKey KesKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"kes-verification-key"
        Mod OptionFields (VerificationKey KesKey)
-> Mod OptionFields (VerificationKey KesKey)
-> Mod OptionFields (VerificationKey KesKey)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (VerificationKey KesKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
        Mod OptionFields (VerificationKey KesKey)
-> Mod OptionFields (VerificationKey KesKey)
-> Mod OptionFields (VerificationKey KesKey)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (VerificationKey KesKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"A Bech32 or hex-encoded hot KES verification key."
        )
  where
    asType :: AsType (VerificationKey KesKey)
    asType :: AsType (VerificationKey KesKey)
asType = AsType KesKey -> AsType (VerificationKey KesKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType KesKey
AsKesKey

    deserialiseVerKey :: String -> Either String (VerificationKey KesKey)
    deserialiseVerKey :: String -> Either String (VerificationKey KesKey)
deserialiseVerKey String
str =
      case AsType (VerificationKey KesKey)
-> Text -> Either Bech32DecodeError (VerificationKey KesKey)
forall a.
SerialiseAsBech32 a =>
AsType a -> Text -> Either Bech32DecodeError a
deserialiseFromBech32 AsType (VerificationKey KesKey)
asType (String -> Text
Text.pack String
str) of
        Right VerificationKey KesKey
res -> VerificationKey KesKey -> Either String (VerificationKey KesKey)
forall a b. b -> Either a b
Right VerificationKey KesKey
res

        -- The input was valid Bech32, but some other error occurred.
        Left err :: Bech32DecodeError
err@(Bech32UnexpectedPrefix Text
_ Set Text
_) -> String -> Either String (VerificationKey KesKey)
forall a b. a -> Either a b
Left (Bech32DecodeError -> String
forall e. Error e => e -> String
displayError Bech32DecodeError
err)
        Left err :: Bech32DecodeError
err@(Bech32DataPartToBytesError Text
_) -> String -> Either String (VerificationKey KesKey)
forall a b. a -> Either a b
Left (Bech32DecodeError -> String
forall e. Error e => e -> String
displayError Bech32DecodeError
err)
        Left err :: Bech32DecodeError
err@(Bech32DeserialiseFromBytesError ByteString
_) -> String -> Either String (VerificationKey KesKey)
forall a b. a -> Either a b
Left (Bech32DecodeError -> String
forall e. Error e => e -> String
displayError Bech32DecodeError
err)
        Left err :: Bech32DecodeError
err@(Bech32WrongPrefix Text
_ Text
_) -> String -> Either String (VerificationKey KesKey)
forall a b. a -> Either a b
Left (Bech32DecodeError -> String
forall e. Error e => e -> String
displayError Bech32DecodeError
err)

        -- The input was not valid Bech32. Attempt to deserialise it as hex.
        Left (Bech32DecodingError DecodingError
_) ->
          case AsType (VerificationKey KesKey)
-> ByteString -> Maybe (VerificationKey KesKey)
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
deserialiseFromRawBytesHex AsType (VerificationKey KesKey)
asType (String -> ByteString
BSC.pack String
str) of
            Just VerificationKey KesKey
res' -> VerificationKey KesKey -> Either String (VerificationKey KesKey)
forall a b. b -> Either a b
Right VerificationKey KesKey
res'
            Maybe (VerificationKey KesKey)
Nothing -> String -> Either String (VerificationKey KesKey)
forall a b. a -> Either a b
Left String
"Invalid stake pool verification key."

pKesVerificationKeyFile :: Parser VerificationKeyFile
pKesVerificationKeyFile :: Parser VerificationKeyFile
pKesVerificationKeyFile =
  String -> VerificationKeyFile
VerificationKeyFile (String -> VerificationKeyFile)
-> Parser String -> Parser VerificationKeyFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ( Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
        (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"kes-verification-key-file"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Filepath of the hot KES verification key."
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
        )
    Parser String -> Parser String -> Parser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
        (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"hot-kes-verification-key-file"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall (f :: * -> *) a. Mod f a
Opt.internal
        )
    )

pNetworkId :: Parser NetworkId
pNetworkId :: Parser NetworkId
pNetworkId =
  Parser NetworkId
pMainnet Parser NetworkId -> Parser NetworkId -> Parser NetworkId
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (NetworkMagic -> NetworkId)
-> Parser NetworkMagic -> Parser NetworkId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NetworkMagic -> NetworkId
Testnet Parser NetworkMagic
pTestnetMagic
 where
   pMainnet :: Parser NetworkId
   pMainnet :: Parser NetworkId
pMainnet =
    NetworkId -> Mod FlagFields NetworkId -> Parser NetworkId
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' NetworkId
Mainnet
      (  String -> Mod FlagFields NetworkId
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"mainnet"
      Mod FlagFields NetworkId
-> Mod FlagFields NetworkId -> Mod FlagFields NetworkId
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields NetworkId
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use the mainnet magic id."
      )

pTestnetMagic :: Parser NetworkMagic
pTestnetMagic :: Parser NetworkMagic
pTestnetMagic =
  Word32 -> NetworkMagic
NetworkMagic (Word32 -> NetworkMagic) -> Parser Word32 -> Parser NetworkMagic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ReadM Word32 -> Mod OptionFields Word32 -> Parser Word32
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word32
forall a. Read a => ReadM a
Opt.auto
      (  String -> Mod OptionFields Word32
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"testnet-magic"
      Mod OptionFields Word32
-> Mod OptionFields Word32 -> Mod OptionFields Word32
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word32
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"NATURAL"
      Mod OptionFields Word32
-> Mod OptionFields Word32 -> Mod OptionFields Word32
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word32
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Specify a testnet magic id."
      )

pTxSubmitFile :: Parser FilePath
pTxSubmitFile :: Parser String
pTxSubmitFile =
  Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
    (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"tx-file"
    Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
    Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Filepath of the transaction you intend to submit."
    Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
    )

pBccEra :: Parser AnyBccEra
pBccEra :: Parser AnyBccEra
pBccEra = [Parser AnyBccEra] -> Parser AnyBccEra
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
  [ AnyBccEra -> Mod FlagFields AnyBccEra -> Parser AnyBccEra
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' (BccEra ColeEra -> AnyBccEra
forall era. IsBccEra era => BccEra era -> AnyBccEra
AnyBccEra BccEra ColeEra
ColeEra)
      (  String -> Mod FlagFields AnyBccEra
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"cole-era"
      Mod FlagFields AnyBccEra
-> Mod FlagFields AnyBccEra -> Mod FlagFields AnyBccEra
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields AnyBccEra
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Specify the Cole era"
      )
  , AnyBccEra -> Mod FlagFields AnyBccEra -> Parser AnyBccEra
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' (BccEra SophieEra -> AnyBccEra
forall era. IsBccEra era => BccEra era -> AnyBccEra
AnyBccEra BccEra SophieEra
SophieEra)
      (  String -> Mod FlagFields AnyBccEra
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"sophie-era"
      Mod FlagFields AnyBccEra
-> Mod FlagFields AnyBccEra -> Mod FlagFields AnyBccEra
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields AnyBccEra
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Specify the Sophie era"
      )
  , AnyBccEra -> Mod FlagFields AnyBccEra -> Parser AnyBccEra
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' (BccEra EvieEra -> AnyBccEra
forall era. IsBccEra era => BccEra era -> AnyBccEra
AnyBccEra BccEra EvieEra
EvieEra)
      (  String -> Mod FlagFields AnyBccEra
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"evie-era"
      Mod FlagFields AnyBccEra
-> Mod FlagFields AnyBccEra -> Mod FlagFields AnyBccEra
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields AnyBccEra
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Specify the Evie era"
      )
  , AnyBccEra -> Mod FlagFields AnyBccEra -> Parser AnyBccEra
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' (BccEra JenEra -> AnyBccEra
forall era. IsBccEra era => BccEra era -> AnyBccEra
AnyBccEra BccEra JenEra
JenEra)
      (  String -> Mod FlagFields AnyBccEra
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"jen-era"
      Mod FlagFields AnyBccEra
-> Mod FlagFields AnyBccEra -> Mod FlagFields AnyBccEra
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields AnyBccEra
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Specify the Jen era (default)"
      )
  , AnyBccEra -> Mod FlagFields AnyBccEra -> Parser AnyBccEra
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' (BccEra AurumEra -> AnyBccEra
forall era. IsBccEra era => BccEra era -> AnyBccEra
AnyBccEra BccEra AurumEra
AurumEra)
      (  String -> Mod FlagFields AnyBccEra
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"aurum-era"
      Mod FlagFields AnyBccEra
-> Mod FlagFields AnyBccEra -> Mod FlagFields AnyBccEra
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields AnyBccEra
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Specify the Aurum era"
      )

    -- Default for now:
  , AnyBccEra -> Parser AnyBccEra
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BccEra JenEra -> AnyBccEra
forall era. IsBccEra era => BccEra era -> AnyBccEra
AnyBccEra BccEra JenEra
JenEra)
  ]

pTxIn :: BalanceTxExecUnits
      -> Parser (TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))
pTxIn :: BalanceTxExecUnits
-> Parser (TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))
pTxIn BalanceTxExecUnits
balance =
     (,) (TxIn
 -> Maybe (ScriptWitnessFiles WitCtxTxIn)
 -> (TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn)))
-> Parser TxIn
-> Parser
     (Maybe (ScriptWitnessFiles WitCtxTxIn)
      -> (TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM TxIn -> Mod OptionFields TxIn -> Parser TxIn
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser TxIn -> ReadM TxIn
forall a. Parser a -> ReadM a
readerFromParsecParser Parser TxIn
parseTxIn)
               (  String -> Mod OptionFields TxIn
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"tx-in"
                Mod OptionFields TxIn
-> Mod OptionFields TxIn -> Mod OptionFields TxIn
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields TxIn
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"TX-IN"
               Mod OptionFields TxIn
-> Mod OptionFields TxIn -> Mod OptionFields TxIn
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields TxIn
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"TxId#TxIx"
               )
         Parser
  (Maybe (ScriptWitnessFiles WitCtxTxIn)
   -> (TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn)))
-> Parser (Maybe (ScriptWitnessFiles WitCtxTxIn))
-> Parser (TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (ScriptWitnessFiles WitCtxTxIn)
-> Parser (Maybe (ScriptWitnessFiles WitCtxTxIn))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (WitCtx WitCtxTxIn
-> BalanceTxExecUnits
-> String
-> Maybe String
-> String
-> Parser (ScriptWitnessFiles WitCtxTxIn)
forall witctx.
WitCtx witctx
-> BalanceTxExecUnits
-> String
-> Maybe String
-> String
-> Parser (ScriptWitnessFiles witctx)
pScriptWitnessFiles
                         WitCtx WitCtxTxIn
WitCtxTxIn
                         BalanceTxExecUnits
balance
                         String
"tx-in" (String -> Maybe String
forall a. a -> Maybe a
Just String
"txin")
                         String
"the spending of the transaction input.")

pTxInCollateral :: Parser TxIn
pTxInCollateral :: Parser TxIn
pTxInCollateral =
    ReadM TxIn -> Mod OptionFields TxIn -> Parser TxIn
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser TxIn -> ReadM TxIn
forall a. Parser a -> ReadM a
readerFromParsecParser Parser TxIn
parseTxIn)
      (  String -> Mod OptionFields TxIn
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"tx-in-collateral"
      Mod OptionFields TxIn
-> Mod OptionFields TxIn -> Mod OptionFields TxIn
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields TxIn
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"TX-IN"
      Mod OptionFields TxIn
-> Mod OptionFields TxIn -> Mod OptionFields TxIn
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields TxIn
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"TxId#TxIx"
      )

pWitnessOverride :: Parser Word
pWitnessOverride :: Parser Word
pWitnessOverride = ReadM Word -> Mod OptionFields Word -> Parser Word
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word
forall a. Read a => ReadM a
Opt.auto
  (  String -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"witness-override"
  Mod OptionFields Word
-> Mod OptionFields Word -> Mod OptionFields Word
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"WORD"
  Mod OptionFields Word
-> Mod OptionFields Word -> Mod OptionFields Word
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Specify and override the number of \
              \witnesses the transaction requires."
  )

parseTxIn :: Parsec.Parser TxIn
parseTxIn :: Parser TxIn
parseTxIn = TxId -> TxIx -> TxIn
TxIn (TxId -> TxIx -> TxIn)
-> ParsecT String () Identity TxId
-> ParsecT String () Identity (TxIx -> TxIn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity TxId
parseTxId ParsecT String () Identity (TxIx -> TxIn)
-> ParsecT String () Identity TxIx -> Parser TxIn
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'#' ParsecT String () Identity Char
-> ParsecT String () Identity TxIx
-> ParsecT String () Identity TxIx
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String () Identity TxIx
parseTxIx)

renderTxIn :: TxIn -> Text
renderTxIn :: TxIn -> Text
renderTxIn (TxIn TxId
txid (TxIx Word
txix)) =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
    [ TxId -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText TxId
txid
    , Text
"#"
    , String -> Text
Text.pack (Word -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Word
txix)
    ]

parseTxId :: Parsec.Parser TxId
parseTxId :: ParsecT String () Identity TxId
parseTxId = do
  String
str <- ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
Parsec.many1 ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
Parsec.hexDigit ParsecT String () Identity String
-> String -> ParsecT String () Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
Parsec.<?> String
"transaction id (hexadecimal)"
  case AsType TxId -> ByteString -> Maybe TxId
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
deserialiseFromRawBytesHex AsType TxId
AsTxId (String -> ByteString
BSC.pack String
str) of
    Just TxId
addr -> TxId -> ParsecT String () Identity TxId
forall (m :: * -> *) a. Monad m => a -> m a
return TxId
addr
    Maybe TxId
Nothing -> String -> ParsecT String () Identity TxId
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ParsecT String () Identity TxId)
-> String -> ParsecT String () Identity TxId
forall a b. (a -> b) -> a -> b
$ String
"Incorrect transaction id format:: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a b. (Show a, ConvertText String b) => a -> b
show String
str

parseTxIx :: Parsec.Parser TxIx
parseTxIx :: ParsecT String () Identity TxIx
parseTxIx = Word -> TxIx
TxIx (Word -> TxIx) -> (Integer -> Word) -> Integer -> TxIx
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Integer -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> TxIx)
-> ParsecT String () Identity Integer
-> ParsecT String () Identity TxIx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Integer
decimal


pTxOut :: Parser TxOutAnyEra
pTxOut :: Parser TxOutAnyEra
pTxOut =
        ReadM (Maybe (Hash ScriptData) -> TxOutAnyEra)
-> Mod OptionFields (Maybe (Hash ScriptData) -> TxOutAnyEra)
-> Parser (Maybe (Hash ScriptData) -> TxOutAnyEra)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser (Maybe (Hash ScriptData) -> TxOutAnyEra)
-> ReadM (Maybe (Hash ScriptData) -> TxOutAnyEra)
forall a. Parser a -> ReadM a
readerFromParsecParser Parser (Maybe (Hash ScriptData) -> TxOutAnyEra)
parseTxOutAnyEra)
          (  String -> Mod OptionFields (Maybe (Hash ScriptData) -> TxOutAnyEra)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"tx-out"
          Mod OptionFields (Maybe (Hash ScriptData) -> TxOutAnyEra)
-> Mod OptionFields (Maybe (Hash ScriptData) -> TxOutAnyEra)
-> Mod OptionFields (Maybe (Hash ScriptData) -> TxOutAnyEra)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Maybe (Hash ScriptData) -> TxOutAnyEra)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"ADDRESS VALUE"
          -- TODO aurum: Update the help text to describe the new syntax as well.
          Mod OptionFields (Maybe (Hash ScriptData) -> TxOutAnyEra)
-> Mod OptionFields (Maybe (Hash ScriptData) -> TxOutAnyEra)
-> Mod OptionFields (Maybe (Hash ScriptData) -> TxOutAnyEra)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Maybe (Hash ScriptData) -> TxOutAnyEra)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The transaction output as Address+Entropic where Address is \
                      \the Bech32-encoded address followed by the amount in \
                      \Entropic."
          )
    Parser (Maybe (Hash ScriptData) -> TxOutAnyEra)
-> Parser (Maybe (Hash ScriptData)) -> Parser TxOutAnyEra
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Hash ScriptData) -> Parser (Maybe (Hash ScriptData))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser (Hash ScriptData)
pDatumHash


pDatumHash :: Parser (Hash ScriptData)
pDatumHash :: Parser (Hash ScriptData)
pDatumHash  =
  ReadM (Hash ScriptData)
-> Mod OptionFields (Hash ScriptData) -> Parser (Hash ScriptData)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser (Hash ScriptData) -> ReadM (Hash ScriptData)
forall a. Parser a -> ReadM a
readerFromParsecParser Parser (Hash ScriptData)
parseHashScriptData)
    (  String -> Mod OptionFields (Hash ScriptData)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"tx-out-datum-hash"
    Mod OptionFields (Hash ScriptData)
-> Mod OptionFields (Hash ScriptData)
-> Mod OptionFields (Hash ScriptData)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Hash ScriptData)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"HASH"
    Mod OptionFields (Hash ScriptData)
-> Mod OptionFields (Hash ScriptData)
-> Mod OptionFields (Hash ScriptData)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Hash ScriptData)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Required datum hash for tx inputs intended \
               \to be utilizied by a Zerepoch script."
    )
  where
    parseHashScriptData :: Parsec.Parser (Hash ScriptData)
    parseHashScriptData :: Parser (Hash ScriptData)
parseHashScriptData = do
      String
str <- ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
Parsec.many1 ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
Parsec.hexDigit ParsecT String () Identity String
-> String -> ParsecT String () Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
Parsec.<?> String
"script data hash"
      case AsType (Hash ScriptData) -> ByteString -> Maybe (Hash ScriptData)
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
deserialiseFromRawBytesHex (AsType ScriptData -> AsType (Hash ScriptData)
forall a. AsType a -> AsType (Hash a)
AsHash AsType ScriptData
AsScriptData) (String -> ByteString
BSC.pack String
str) of
        Just Hash ScriptData
sdh -> Hash ScriptData -> Parser (Hash ScriptData)
forall (m :: * -> *) a. Monad m => a -> m a
return Hash ScriptData
sdh
        Maybe (Hash ScriptData)
Nothing  -> String -> Parser (Hash ScriptData)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (Hash ScriptData))
-> String -> Parser (Hash ScriptData)
forall a b. (a -> b) -> a -> b
$ String
"Invalid datum hash: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a b. (Show a, ConvertText String b) => a -> b
show String
str

pMintMultiAsset
  :: BalanceTxExecUnits
  -> Parser (Value, [ScriptWitnessFiles WitCtxMint])
pMintMultiAsset :: BalanceTxExecUnits
-> Parser (Value, [ScriptWitnessFiles WitCtxMint])
pMintMultiAsset BalanceTxExecUnits
balanceExecUnits =
  (,) (Value
 -> [ScriptWitnessFiles WitCtxMint]
 -> (Value, [ScriptWitnessFiles WitCtxMint]))
-> Parser Value
-> Parser
     ([ScriptWitnessFiles WitCtxMint]
      -> (Value, [ScriptWitnessFiles WitCtxMint]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Value -> Mod OptionFields Value -> Parser Value
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
            (Parser Value -> ReadM Value
forall a. Parser a -> ReadM a
readerFromParsecParser Parser Value
parseValue)
              (  String -> Mod OptionFields Value
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"mint"
              Mod OptionFields Value
-> Mod OptionFields Value -> Mod OptionFields Value
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Value
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"VALUE"
              Mod OptionFields Value
-> Mod OptionFields Value -> Mod OptionFields Value
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Value
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
helpText
              )
      Parser
  ([ScriptWitnessFiles WitCtxMint]
   -> (Value, [ScriptWitnessFiles WitCtxMint]))
-> Parser [ScriptWitnessFiles WitCtxMint]
-> Parser (Value, [ScriptWitnessFiles WitCtxMint])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (ScriptWitnessFiles WitCtxMint)
-> Parser [ScriptWitnessFiles WitCtxMint]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (WitCtx WitCtxMint
-> BalanceTxExecUnits
-> String
-> Maybe String
-> String
-> Parser (ScriptWitnessFiles WitCtxMint)
forall witctx.
WitCtx witctx
-> BalanceTxExecUnits
-> String
-> Maybe String
-> String
-> Parser (ScriptWitnessFiles witctx)
pScriptWitnessFiles
                  WitCtx WitCtxMint
WitCtxMint
                  BalanceTxExecUnits
balanceExecUnits
                  String
"mint" (String -> Maybe String
forall a. a -> Maybe a
Just String
"minting")
                  String
"the minting of assets for a particular policy Id."
               )
 where
   helpText :: String
helpText = String
"Mint multi-asset value(s) with the multi-asset cli syntax. \
               \You must specifiy a script witness."

pInvalidBefore :: Parser SlotNo
pInvalidBefore :: Parser SlotNo
pInvalidBefore =
  Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> Parser Word64 -> Parser SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ( ReadM Word64 -> Mod OptionFields Word64 -> Parser Word64
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word64
forall a. Read a => ReadM a
Opt.auto
       (  String -> Mod OptionFields Word64
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"invalid-before"
       Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word64
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"SLOT"
       Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word64
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Time that transaction is valid from (in slots)."
       )
    Parser Word64 -> Parser Word64 -> Parser Word64
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      ReadM Word64 -> Mod OptionFields Word64 -> Parser Word64
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word64
forall a. Read a => ReadM a
Opt.auto
        (  String -> Mod OptionFields Word64
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"lower-bound"
        Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word64
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"SLOT"
        Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word64
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Time that transaction is valid from (in slots) \
                    \(deprecated; use --invalid-before instead)."
        Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Word64
forall (f :: * -> *) a. Mod f a
Opt.internal
        )
    )

pInvalidHereafter :: Parser SlotNo
pInvalidHereafter :: Parser SlotNo
pInvalidHereafter =
  Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> Parser Word64 -> Parser SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ( ReadM Word64 -> Mod OptionFields Word64 -> Parser Word64
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word64
forall a. Read a => ReadM a
Opt.auto
        (  String -> Mod OptionFields Word64
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"invalid-hereafter"
        Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word64
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"SLOT"
        Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word64
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Time that transaction is valid until (in slots)."
        )
    Parser Word64 -> Parser Word64 -> Parser Word64
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      ReadM Word64 -> Mod OptionFields Word64 -> Parser Word64
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word64
forall a. Read a => ReadM a
Opt.auto
        (  String -> Mod OptionFields Word64
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"upper-bound"
        Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word64
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"SLOT"
        Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word64
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Time that transaction is valid until (in slots) \
                    \(deprecated; use --invalid-hereafter instead)."
       Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Word64
forall (f :: * -> *) a. Mod f a
Opt.internal
        )
    Parser Word64 -> Parser Word64 -> Parser Word64
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      ReadM Word64 -> Mod OptionFields Word64 -> Parser Word64
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word64
forall a. Read a => ReadM a
Opt.auto
        (  String -> Mod OptionFields Word64
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"ttl"
        Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word64
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"SLOT"
        Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word64
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Time to live (in slots) (deprecated; use --invalid-hereafter instead)."
        Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Word64
forall (f :: * -> *) a. Mod f a
Opt.internal
        )
    )

pTxFee :: Parser Entropic
pTxFee :: Parser Entropic
pTxFee =
  Integer -> Entropic
Entropic (Integer -> Entropic)
-> (Natural -> Integer) -> Natural -> Entropic
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Natural -> Integer) (Natural -> Entropic) -> Parser Natural -> Parser Entropic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ReadM Natural -> Mod OptionFields Natural -> Parser Natural
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Natural
forall a. Read a => ReadM a
Opt.auto
      (  String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"fee"
      Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"ENTROPIC"
      Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Natural
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The fee amount in Entropic."
      )

pWitnessFile :: Parser WitnessFile
pWitnessFile :: Parser WitnessFile
pWitnessFile =
  String -> WitnessFile
WitnessFile (String -> WitnessFile) -> Parser String -> Parser WitnessFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
      (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"witness-file"
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Filepath of the witness"
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
      )

pTxBodyFile :: FileDirection -> Parser TxBodyFile
pTxBodyFile :: FileDirection -> Parser TxBodyFile
pTxBodyFile FileDirection
fdir =
    String -> TxBodyFile
TxBodyFile (String -> TxBodyFile) -> Parser String -> Parser TxBodyFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      (  Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
           (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
optName
           Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
           Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help (FileDirection -> String
forall a b. (Show a, ConvertText String b) => a -> b
show FileDirection
fdir String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" filepath of the JSON TxBody.")
           Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
           )
      Parser String -> Parser String -> Parser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
         Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
           (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"tx-body-file"
           Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall (f :: * -> *) a. Mod f a
Opt.internal
           )
      )
  where
    optName :: String
optName =
      case FileDirection
fdir of
        FileDirection
Input -> String
"tx-body-file"
        FileDirection
Output -> String
"out-file"


pTxFile :: FileDirection -> Parser TxFile
pTxFile :: FileDirection -> Parser TxFile
pTxFile FileDirection
fdir =
    String -> TxFile
TxFile (String -> TxFile) -> Parser String -> Parser TxFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      (  Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
           (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
optName
           Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
           Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help (FileDirection -> String
forall a b. (Show a, ConvertText String b) => a -> b
show FileDirection
fdir String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" filepath of the JSON Tx.")
           Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
           )
      Parser String -> Parser String -> Parser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
         Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
           (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"tx-file"
           Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall (f :: * -> *) a. Mod f a
Opt.internal
           )
      )
  where
    optName :: String
optName =
      case FileDirection
fdir of
        FileDirection
Input -> String
"tx-file"
        FileDirection
Output -> String
"out-file"

pInputTxFile :: Parser InputTxFile
pInputTxFile :: Parser InputTxFile
pInputTxFile =
  TxBodyFile -> InputTxFile
InputTxBodyFile (TxBodyFile -> InputTxFile)
-> Parser TxBodyFile -> Parser InputTxFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileDirection -> Parser TxBodyFile
pTxBodyFile FileDirection
Input Parser InputTxFile -> Parser InputTxFile -> Parser InputTxFile
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TxFile -> InputTxFile
InputTxFile (TxFile -> InputTxFile) -> Parser TxFile -> Parser InputTxFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileDirection -> Parser TxFile
pTxFile FileDirection
Input

pTxInCount :: Parser TxInCount
pTxInCount :: Parser TxInCount
pTxInCount =
  Int -> TxInCount
TxInCount (Int -> TxInCount) -> Parser Int -> Parser TxInCount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Int
forall a. Read a => ReadM a
Opt.auto
      (  String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"tx-in-count"
      Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"NATURAL"
      Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The number of transaction inputs."
      )

pTxOutCount :: Parser TxOutCount
pTxOutCount :: Parser TxOutCount
pTxOutCount =
  Int -> TxOutCount
TxOutCount (Int -> TxOutCount) -> Parser Int -> Parser TxOutCount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Int
forall a. Read a => ReadM a
Opt.auto
      (  String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"tx-out-count"
      Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"NATURAL"
      Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The number of transaction outputs."
      )

pTxSophieWitnessCount :: Parser TxSophieWitnessCount
pTxSophieWitnessCount :: Parser TxSophieWitnessCount
pTxSophieWitnessCount =
  Int -> TxSophieWitnessCount
TxSophieWitnessCount (Int -> TxSophieWitnessCount)
-> Parser Int -> Parser TxSophieWitnessCount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Int
forall a. Read a => ReadM a
Opt.auto
      (  String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"witness-count"
      Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"NATURAL"
      Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The number of Sophie key witnesses."
      )

pTxColeWitnessCount :: Parser TxColeWitnessCount
pTxColeWitnessCount :: Parser TxColeWitnessCount
pTxColeWitnessCount =
  Int -> TxColeWitnessCount
TxColeWitnessCount (Int -> TxColeWitnessCount)
-> Parser Int -> Parser TxColeWitnessCount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Int
forall a. Read a => ReadM a
Opt.auto
      (  String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"cole-witness-count"
      Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"NATURAL"
      Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The number of Cole key witnesses (default is 0)."
      Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Int -> Mod OptionFields Int
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value Int
0
      )

pQueryUTxOFilter :: Parser QueryUTxOFilter
pQueryUTxOFilter :: Parser QueryUTxOFilter
pQueryUTxOFilter =
      Parser QueryUTxOFilter
pQueryUTxOWhole
  Parser QueryUTxOFilter
-> Parser QueryUTxOFilter -> Parser QueryUTxOFilter
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser QueryUTxOFilter
pQueryUTxOByAddress
  Parser QueryUTxOFilter
-> Parser QueryUTxOFilter -> Parser QueryUTxOFilter
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser QueryUTxOFilter
pQueryUTxOByTxIn
  where
    pQueryUTxOWhole :: Parser QueryUTxOFilter
pQueryUTxOWhole =
      QueryUTxOFilter
-> Mod FlagFields QueryUTxOFilter -> Parser QueryUTxOFilter
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' QueryUTxOFilter
QueryUTxOWhole
        (  String -> Mod FlagFields QueryUTxOFilter
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"whole-utxo"
        Mod FlagFields QueryUTxOFilter
-> Mod FlagFields QueryUTxOFilter -> Mod FlagFields QueryUTxOFilter
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields QueryUTxOFilter
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Return the whole UTxO (only appropriate on small testnets)."
        )

    pQueryUTxOByAddress :: Parser QueryUTxOFilter
    pQueryUTxOByAddress :: Parser QueryUTxOFilter
pQueryUTxOByAddress = Set AddressAny -> QueryUTxOFilter
QueryUTxOByAddress (Set AddressAny -> QueryUTxOFilter)
-> ([AddressAny] -> Set AddressAny)
-> [AddressAny]
-> QueryUTxOFilter
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [AddressAny] -> Set AddressAny
forall a. Ord a => [a] -> Set a
Set.fromList ([AddressAny] -> QueryUTxOFilter)
-> Parser [AddressAny] -> Parser QueryUTxOFilter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser AddressAny -> Parser [AddressAny]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser AddressAny
pByAddress

    pByAddress :: Parser AddressAny
    pByAddress :: Parser AddressAny
pByAddress =
        ReadM AddressAny
-> Mod OptionFields AddressAny -> Parser AddressAny
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser AddressAny -> ReadM AddressAny
forall a. Parser a -> ReadM a
readerFromParsecParser Parser AddressAny
parseAddressAny)
          (  String -> Mod OptionFields AddressAny
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"address"
          Mod OptionFields AddressAny
-> Mod OptionFields AddressAny -> Mod OptionFields AddressAny
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields AddressAny
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"ADDRESS"
          Mod OptionFields AddressAny
-> Mod OptionFields AddressAny -> Mod OptionFields AddressAny
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields AddressAny
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Filter by Bcc address(es) (Bech32-encoded)."
          )

    pQueryUTxOByTxIn :: Parser QueryUTxOFilter
    pQueryUTxOByTxIn :: Parser QueryUTxOFilter
pQueryUTxOByTxIn = Set TxIn -> QueryUTxOFilter
QueryUTxOByTxIn (Set TxIn -> QueryUTxOFilter)
-> ([TxIn] -> Set TxIn) -> [TxIn] -> QueryUTxOFilter
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList ([TxIn] -> QueryUTxOFilter)
-> Parser [TxIn] -> Parser QueryUTxOFilter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TxIn -> Parser [TxIn]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser TxIn
pByTxIn

    pByTxIn :: Parser TxIn
    pByTxIn :: Parser TxIn
pByTxIn =
      ReadM TxIn -> Mod OptionFields TxIn -> Parser TxIn
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser TxIn -> ReadM TxIn
forall a. Parser a -> ReadM a
readerFromParsecParser Parser TxIn
parseTxIn)
        (  String -> Mod OptionFields TxIn
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"tx-in"
        Mod OptionFields TxIn
-> Mod OptionFields TxIn -> Mod OptionFields TxIn
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields TxIn
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"TX-IN"
        Mod OptionFields TxIn
-> Mod OptionFields TxIn -> Mod OptionFields TxIn
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields TxIn
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Filter by transaction input (TxId#TxIx)."
        )

pFilterByStakeAddress :: Parser StakeAddress
pFilterByStakeAddress :: Parser StakeAddress
pFilterByStakeAddress =
    ReadM StakeAddress
-> Mod OptionFields StakeAddress -> Parser StakeAddress
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (ParsecT String () Identity StakeAddress -> ReadM StakeAddress
forall a. Parser a -> ReadM a
readerFromParsecParser ParsecT String () Identity StakeAddress
parseStakeAddress)
      (  String -> Mod OptionFields StakeAddress
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"address"
      Mod OptionFields StakeAddress
-> Mod OptionFields StakeAddress -> Mod OptionFields StakeAddress
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields StakeAddress
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"ADDRESS"
      Mod OptionFields StakeAddress
-> Mod OptionFields StakeAddress -> Mod OptionFields StakeAddress
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields StakeAddress
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Filter by Bcc stake address (Bech32-encoded)."
      )

pColeAddress :: Parser (Address ColeAddr)
pColeAddress :: Parser (Address ColeAddr)
pColeAddress =
    ReadM (Address ColeAddr)
-> Mod OptionFields (Address ColeAddr) -> Parser (Address ColeAddr)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String (Address ColeAddr))
-> ReadM (Address ColeAddr)
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String (Address ColeAddr)
deserialise)
        (  String -> Mod OptionFields (Address ColeAddr)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"address"
        Mod OptionFields (Address ColeAddr)
-> Mod OptionFields (Address ColeAddr)
-> Mod OptionFields (Address ColeAddr)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Address ColeAddr)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
        Mod OptionFields (Address ColeAddr)
-> Mod OptionFields (Address ColeAddr)
-> Mod OptionFields (Address ColeAddr)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Address ColeAddr)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Cole address (Base58-encoded)."
        )
  where
    deserialise :: String -> Either String (Address ColeAddr)
    deserialise :: String -> Either String (Address ColeAddr)
deserialise =
      Either String (Address ColeAddr)
-> (Address ColeAddr -> Either String (Address ColeAddr))
-> Maybe (Address ColeAddr)
-> Either String (Address ColeAddr)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String (Address ColeAddr)
forall a b. a -> Either a b
Left String
"Invalid Cole address.") Address ColeAddr -> Either String (Address ColeAddr)
forall a b. b -> Either a b
Right
        (Maybe (Address ColeAddr) -> Either String (Address ColeAddr))
-> (String -> Maybe (Address ColeAddr))
-> String
-> Either String (Address ColeAddr)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AsType (Address ColeAddr) -> Text -> Maybe (Address ColeAddr)
forall addr.
SerialiseAddress addr =>
AsType addr -> Text -> Maybe addr
deserialiseAddress AsType (Address ColeAddr)
AsColeAddress
        (Text -> Maybe (Address ColeAddr))
-> (String -> Text) -> String -> Maybe (Address ColeAddr)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
Text.pack

pAddress :: Parser Text
pAddress :: Parser Text
pAddress =
  String -> Text
Text.pack (String -> Text) -> Parser String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
      (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"address"
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"ADDRESS"
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"A Bcc address"
      )

pStakeAddress :: Parser StakeAddress
pStakeAddress :: Parser StakeAddress
pStakeAddress =
    ReadM StakeAddress
-> Mod OptionFields StakeAddress -> Parser StakeAddress
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (ParsecT String () Identity StakeAddress -> ReadM StakeAddress
forall a. Parser a -> ReadM a
readerFromParsecParser ParsecT String () Identity StakeAddress
parseStakeAddress)
      (  String -> Mod OptionFields StakeAddress
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"stake-address"
      Mod OptionFields StakeAddress
-> Mod OptionFields StakeAddress -> Mod OptionFields StakeAddress
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields StakeAddress
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"ADDRESS"
      Mod OptionFields StakeAddress
-> Mod OptionFields StakeAddress -> Mod OptionFields StakeAddress
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields StakeAddress
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Target stake address (bech32 format)."
      )

pStakeVerificationKeyOrFile :: Parser (VerificationKeyOrFile StakeKey)
pStakeVerificationKeyOrFile :: Parser (VerificationKeyOrFile StakeKey)
pStakeVerificationKeyOrFile =
  VerificationKey StakeKey -> VerificationKeyOrFile StakeKey
forall keyrole.
VerificationKey keyrole -> VerificationKeyOrFile keyrole
VerificationKeyValue (VerificationKey StakeKey -> VerificationKeyOrFile StakeKey)
-> Parser (VerificationKey StakeKey)
-> Parser (VerificationKeyOrFile StakeKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKey StakeKey)
pStakeVerificationKey
    Parser (VerificationKeyOrFile StakeKey)
-> Parser (VerificationKeyOrFile StakeKey)
-> Parser (VerificationKeyOrFile StakeKey)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> VerificationKeyFile -> VerificationKeyOrFile StakeKey
forall keyrole.
VerificationKeyFile -> VerificationKeyOrFile keyrole
VerificationKeyFilePath (VerificationKeyFile -> VerificationKeyOrFile StakeKey)
-> Parser VerificationKeyFile
-> Parser (VerificationKeyOrFile StakeKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VerificationKeyFile
pStakeVerificationKeyFile

pStakeVerificationKey :: Parser (VerificationKey StakeKey)
pStakeVerificationKey :: Parser (VerificationKey StakeKey)
pStakeVerificationKey =
  ReadM (VerificationKey StakeKey)
-> Mod OptionFields (VerificationKey StakeKey)
-> Parser (VerificationKey StakeKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
    (AsType StakeKey -> ReadM (VerificationKey StakeKey)
forall keyrole.
SerialiseAsBech32 (VerificationKey keyrole) =>
AsType keyrole -> ReadM (VerificationKey keyrole)
readVerificationKey AsType StakeKey
AsStakeKey)
      (  String -> Mod OptionFields (VerificationKey StakeKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"stake-verification-key"
      Mod OptionFields (VerificationKey StakeKey)
-> Mod OptionFields (VerificationKey StakeKey)
-> Mod OptionFields (VerificationKey StakeKey)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (VerificationKey StakeKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
      Mod OptionFields (VerificationKey StakeKey)
-> Mod OptionFields (VerificationKey StakeKey)
-> Mod OptionFields (VerificationKey StakeKey)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (VerificationKey StakeKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Stake verification key (Bech32 or hex-encoded)."
      )

pStakeVerificationKeyFile :: Parser VerificationKeyFile
pStakeVerificationKeyFile :: Parser VerificationKeyFile
pStakeVerificationKeyFile =
  String -> VerificationKeyFile
VerificationKeyFile (String -> VerificationKeyFile)
-> Parser String -> Parser VerificationKeyFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ( Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
        (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"stake-verification-key-file"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Filepath of the staking verification key."
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
        )
    Parser String -> Parser String -> Parser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
        (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"staking-verification-key-file"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall (f :: * -> *) a. Mod f a
Opt.internal
        )
    )


pStakePoolVerificationKeyFile :: Parser VerificationKeyFile
pStakePoolVerificationKeyFile :: Parser VerificationKeyFile
pStakePoolVerificationKeyFile =
  String -> VerificationKeyFile
VerificationKeyFile (String -> VerificationKeyFile)
-> Parser String -> Parser VerificationKeyFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    (  Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
         (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"cold-verification-key-file"
         Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
         Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Filepath of the stake pool verification key."
         Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
         )
    Parser String -> Parser String -> Parser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
       Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
         (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"stake-pool-verification-key-file"
         Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall (f :: * -> *) a. Mod f a
Opt.internal
         )
    )

pStakePoolVerificationKeyHash :: Parser (Hash StakePoolKey)
pStakePoolVerificationKeyHash :: Parser (Hash StakePoolKey)
pStakePoolVerificationKeyHash =
    ReadM (Hash StakePoolKey)
-> Mod OptionFields (Hash StakePoolKey)
-> Parser (Hash StakePoolKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Maybe (Hash StakePoolKey)) -> ReadM (Hash StakePoolKey)
forall a. (String -> Maybe a) -> ReadM a
Opt.maybeReader String -> Maybe (Hash StakePoolKey)
pBech32OrHexStakePoolId)
        (  String -> Mod OptionFields (Hash StakePoolKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"stake-pool-id"
        Mod OptionFields (Hash StakePoolKey)
-> Mod OptionFields (Hash StakePoolKey)
-> Mod OptionFields (Hash StakePoolKey)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Hash StakePoolKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STAKE-POOL-ID"
        Mod OptionFields (Hash StakePoolKey)
-> Mod OptionFields (Hash StakePoolKey)
-> Mod OptionFields (Hash StakePoolKey)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Hash StakePoolKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Stake pool ID/verification key hash (either \
                    \Bech32-encoded or hex-encoded)."
        )
  where
    pBech32OrHexStakePoolId :: String -> Maybe (Hash StakePoolKey)
    pBech32OrHexStakePoolId :: String -> Maybe (Hash StakePoolKey)
pBech32OrHexStakePoolId String
str =
      String -> Maybe (Hash StakePoolKey)
pBech32StakePoolId String
str Maybe (Hash StakePoolKey)
-> Maybe (Hash StakePoolKey) -> Maybe (Hash StakePoolKey)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Maybe (Hash StakePoolKey)
pHexStakePoolId String
str

    pHexStakePoolId :: String -> Maybe (Hash StakePoolKey)
    pHexStakePoolId :: String -> Maybe (Hash StakePoolKey)
pHexStakePoolId =
      AsType (Hash StakePoolKey)
-> ByteString -> Maybe (Hash StakePoolKey)
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
deserialiseFromRawBytesHex (AsType StakePoolKey -> AsType (Hash StakePoolKey)
forall a. AsType a -> AsType (Hash a)
AsHash AsType StakePoolKey
AsStakePoolKey) (ByteString -> Maybe (Hash StakePoolKey))
-> (String -> ByteString) -> String -> Maybe (Hash StakePoolKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> ByteString
BSC.pack

    pBech32StakePoolId :: String -> Maybe (Hash StakePoolKey)
    pBech32StakePoolId :: String -> Maybe (Hash StakePoolKey)
pBech32StakePoolId =
      (Bech32DecodeError -> Maybe (Hash StakePoolKey))
-> (Hash StakePoolKey -> Maybe (Hash StakePoolKey))
-> Either Bech32DecodeError (Hash StakePoolKey)
-> Maybe (Hash StakePoolKey)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (Hash StakePoolKey)
-> Bech32DecodeError -> Maybe (Hash StakePoolKey)
forall a b. a -> b -> a
const Maybe (Hash StakePoolKey)
forall a. Maybe a
Nothing) Hash StakePoolKey -> Maybe (Hash StakePoolKey)
forall a. a -> Maybe a
Just
        (Either Bech32DecodeError (Hash StakePoolKey)
 -> Maybe (Hash StakePoolKey))
-> (String -> Either Bech32DecodeError (Hash StakePoolKey))
-> String
-> Maybe (Hash StakePoolKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AsType (Hash StakePoolKey)
-> Text -> Either Bech32DecodeError (Hash StakePoolKey)
forall a.
SerialiseAsBech32 a =>
AsType a -> Text -> Either Bech32DecodeError a
deserialiseFromBech32 (AsType StakePoolKey -> AsType (Hash StakePoolKey)
forall a. AsType a -> AsType (Hash a)
AsHash AsType StakePoolKey
AsStakePoolKey)
        (Text -> Either Bech32DecodeError (Hash StakePoolKey))
-> (String -> Text)
-> String
-> Either Bech32DecodeError (Hash StakePoolKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
Text.pack

pStakePoolVerificationKey :: Parser (VerificationKey StakePoolKey)
pStakePoolVerificationKey :: Parser (VerificationKey StakePoolKey)
pStakePoolVerificationKey =
  ReadM (VerificationKey StakePoolKey)
-> Mod OptionFields (VerificationKey StakePoolKey)
-> Parser (VerificationKey StakePoolKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
    (AsType StakePoolKey -> ReadM (VerificationKey StakePoolKey)
forall keyrole.
SerialiseAsBech32 (VerificationKey keyrole) =>
AsType keyrole -> ReadM (VerificationKey keyrole)
readVerificationKey AsType StakePoolKey
AsStakePoolKey)
      (  String -> Mod OptionFields (VerificationKey StakePoolKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"stake-pool-verification-key"
      Mod OptionFields (VerificationKey StakePoolKey)
-> Mod OptionFields (VerificationKey StakePoolKey)
-> Mod OptionFields (VerificationKey StakePoolKey)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (VerificationKey StakePoolKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
      Mod OptionFields (VerificationKey StakePoolKey)
-> Mod OptionFields (VerificationKey StakePoolKey)
-> Mod OptionFields (VerificationKey StakePoolKey)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (VerificationKey StakePoolKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Stake pool verification key (Bech32 or hex-encoded)."
      )

pStakePoolVerificationKeyOrFile
  :: Parser (VerificationKeyOrFile StakePoolKey)
pStakePoolVerificationKeyOrFile :: Parser (VerificationKeyOrFile StakePoolKey)
pStakePoolVerificationKeyOrFile =
  VerificationKey StakePoolKey -> VerificationKeyOrFile StakePoolKey
forall keyrole.
VerificationKey keyrole -> VerificationKeyOrFile keyrole
VerificationKeyValue (VerificationKey StakePoolKey
 -> VerificationKeyOrFile StakePoolKey)
-> Parser (VerificationKey StakePoolKey)
-> Parser (VerificationKeyOrFile StakePoolKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKey StakePoolKey)
pStakePoolVerificationKey
    Parser (VerificationKeyOrFile StakePoolKey)
-> Parser (VerificationKeyOrFile StakePoolKey)
-> Parser (VerificationKeyOrFile StakePoolKey)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> VerificationKeyFile -> VerificationKeyOrFile StakePoolKey
forall keyrole.
VerificationKeyFile -> VerificationKeyOrFile keyrole
VerificationKeyFilePath (VerificationKeyFile -> VerificationKeyOrFile StakePoolKey)
-> Parser VerificationKeyFile
-> Parser (VerificationKeyOrFile StakePoolKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VerificationKeyFile
pStakePoolVerificationKeyFile

pStakePoolVerificationKeyOrHashOrFile
  :: Parser (VerificationKeyOrHashOrFile StakePoolKey)
pStakePoolVerificationKeyOrHashOrFile :: Parser (VerificationKeyOrHashOrFile StakePoolKey)
pStakePoolVerificationKeyOrHashOrFile =
  VerificationKeyOrFile StakePoolKey
-> VerificationKeyOrHashOrFile StakePoolKey
forall keyrole.
VerificationKeyOrFile keyrole
-> VerificationKeyOrHashOrFile keyrole
VerificationKeyOrFile (VerificationKeyOrFile StakePoolKey
 -> VerificationKeyOrHashOrFile StakePoolKey)
-> Parser (VerificationKeyOrFile StakePoolKey)
-> Parser (VerificationKeyOrHashOrFile StakePoolKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyOrFile StakePoolKey)
pStakePoolVerificationKeyOrFile
    Parser (VerificationKeyOrHashOrFile StakePoolKey)
-> Parser (VerificationKeyOrHashOrFile StakePoolKey)
-> Parser (VerificationKeyOrHashOrFile StakePoolKey)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Hash StakePoolKey -> VerificationKeyOrHashOrFile StakePoolKey
forall keyrole. Hash keyrole -> VerificationKeyOrHashOrFile keyrole
VerificationKeyHash (Hash StakePoolKey -> VerificationKeyOrHashOrFile StakePoolKey)
-> Parser (Hash StakePoolKey)
-> Parser (VerificationKeyOrHashOrFile StakePoolKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Hash StakePoolKey)
pStakePoolVerificationKeyHash

pVrfVerificationKeyFile :: Parser VerificationKeyFile
pVrfVerificationKeyFile :: Parser VerificationKeyFile
pVrfVerificationKeyFile =
  String -> VerificationKeyFile
VerificationKeyFile (String -> VerificationKeyFile)
-> Parser String -> Parser VerificationKeyFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
      (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"vrf-verification-key-file"
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Filepath of the VRF verification key."
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
      )

pVrfVerificationKeyHash :: Parser (Hash VrfKey)
pVrfVerificationKeyHash :: Parser (Hash VrfKey)
pVrfVerificationKeyHash =
    ReadM (Hash VrfKey)
-> Mod OptionFields (Hash VrfKey) -> Parser (Hash VrfKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Either String (Hash VrfKey)) -> ReadM (Hash VrfKey)
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String (Hash VrfKey)
deserialiseFromHex)
        (  String -> Mod OptionFields (Hash VrfKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"vrf-verification-key-hash"
        Mod OptionFields (Hash VrfKey)
-> Mod OptionFields (Hash VrfKey) -> Mod OptionFields (Hash VrfKey)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Hash VrfKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
        Mod OptionFields (Hash VrfKey)
-> Mod OptionFields (Hash VrfKey) -> Mod OptionFields (Hash VrfKey)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Hash VrfKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"VRF verification key hash (hex-encoded)."
        )
  where
    deserialiseFromHex :: String -> Either String (Hash VrfKey)
    deserialiseFromHex :: String -> Either String (Hash VrfKey)
deserialiseFromHex =
      Either String (Hash VrfKey)
-> (Hash VrfKey -> Either String (Hash VrfKey))
-> Maybe (Hash VrfKey)
-> Either String (Hash VrfKey)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String (Hash VrfKey)
forall a b. a -> Either a b
Left String
"Invalid VRF verification key hash.") Hash VrfKey -> Either String (Hash VrfKey)
forall a b. b -> Either a b
Right
        (Maybe (Hash VrfKey) -> Either String (Hash VrfKey))
-> (String -> Maybe (Hash VrfKey))
-> String
-> Either String (Hash VrfKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AsType (Hash VrfKey) -> ByteString -> Maybe (Hash VrfKey)
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
deserialiseFromRawBytesHex (AsType VrfKey -> AsType (Hash VrfKey)
forall a. AsType a -> AsType (Hash a)
AsHash AsType VrfKey
AsVrfKey)
        (ByteString -> Maybe (Hash VrfKey))
-> (String -> ByteString) -> String -> Maybe (Hash VrfKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> ByteString
BSC.pack

pVrfVerificationKey :: Parser (VerificationKey VrfKey)
pVrfVerificationKey :: Parser (VerificationKey VrfKey)
pVrfVerificationKey =
  ReadM (VerificationKey VrfKey)
-> Mod OptionFields (VerificationKey VrfKey)
-> Parser (VerificationKey VrfKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
    (AsType VrfKey -> ReadM (VerificationKey VrfKey)
forall keyrole.
SerialiseAsBech32 (VerificationKey keyrole) =>
AsType keyrole -> ReadM (VerificationKey keyrole)
readVerificationKey AsType VrfKey
AsVrfKey)
      (  String -> Mod OptionFields (VerificationKey VrfKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"vrf-verification-key"
      Mod OptionFields (VerificationKey VrfKey)
-> Mod OptionFields (VerificationKey VrfKey)
-> Mod OptionFields (VerificationKey VrfKey)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (VerificationKey VrfKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
      Mod OptionFields (VerificationKey VrfKey)
-> Mod OptionFields (VerificationKey VrfKey)
-> Mod OptionFields (VerificationKey VrfKey)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (VerificationKey VrfKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"VRF verification key (Bech32 or hex-encoded)."
      )

pVrfVerificationKeyOrFile :: Parser (VerificationKeyOrFile VrfKey)
pVrfVerificationKeyOrFile :: Parser (VerificationKeyOrFile VrfKey)
pVrfVerificationKeyOrFile =
  VerificationKey VrfKey -> VerificationKeyOrFile VrfKey
forall keyrole.
VerificationKey keyrole -> VerificationKeyOrFile keyrole
VerificationKeyValue (VerificationKey VrfKey -> VerificationKeyOrFile VrfKey)
-> Parser (VerificationKey VrfKey)
-> Parser (VerificationKeyOrFile VrfKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKey VrfKey)
pVrfVerificationKey
    Parser (VerificationKeyOrFile VrfKey)
-> Parser (VerificationKeyOrFile VrfKey)
-> Parser (VerificationKeyOrFile VrfKey)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> VerificationKeyFile -> VerificationKeyOrFile VrfKey
forall keyrole.
VerificationKeyFile -> VerificationKeyOrFile keyrole
VerificationKeyFilePath (VerificationKeyFile -> VerificationKeyOrFile VrfKey)
-> Parser VerificationKeyFile
-> Parser (VerificationKeyOrFile VrfKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VerificationKeyFile
pVrfVerificationKeyFile

pVrfVerificationKeyOrHashOrFile :: Parser (VerificationKeyOrHashOrFile VrfKey)
pVrfVerificationKeyOrHashOrFile :: Parser (VerificationKeyOrHashOrFile VrfKey)
pVrfVerificationKeyOrHashOrFile =
  VerificationKeyOrFile VrfKey -> VerificationKeyOrHashOrFile VrfKey
forall keyrole.
VerificationKeyOrFile keyrole
-> VerificationKeyOrHashOrFile keyrole
VerificationKeyOrFile (VerificationKeyOrFile VrfKey
 -> VerificationKeyOrHashOrFile VrfKey)
-> Parser (VerificationKeyOrFile VrfKey)
-> Parser (VerificationKeyOrHashOrFile VrfKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyOrFile VrfKey)
pVrfVerificationKeyOrFile
    Parser (VerificationKeyOrHashOrFile VrfKey)
-> Parser (VerificationKeyOrHashOrFile VrfKey)
-> Parser (VerificationKeyOrHashOrFile VrfKey)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Hash VrfKey -> VerificationKeyOrHashOrFile VrfKey
forall keyrole. Hash keyrole -> VerificationKeyOrHashOrFile keyrole
VerificationKeyHash (Hash VrfKey -> VerificationKeyOrHashOrFile VrfKey)
-> Parser (Hash VrfKey)
-> Parser (VerificationKeyOrHashOrFile VrfKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Hash VrfKey)
pVrfVerificationKeyHash

pRewardAcctVerificationKeyFile :: Parser VerificationKeyFile
pRewardAcctVerificationKeyFile :: Parser VerificationKeyFile
pRewardAcctVerificationKeyFile =
  String -> VerificationKeyFile
VerificationKeyFile (String -> VerificationKeyFile)
-> Parser String -> Parser VerificationKeyFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ( Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
        (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"pool-reward-account-verification-key-file"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Filepath of the reward account stake verification key."
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
        )
    Parser String -> Parser String -> Parser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
        (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"reward-account-verification-key-file"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall (f :: * -> *) a. Mod f a
Opt.internal
        )
    )

pRewardAcctVerificationKey :: Parser (VerificationKey StakeKey)
pRewardAcctVerificationKey :: Parser (VerificationKey StakeKey)
pRewardAcctVerificationKey =
  ReadM (VerificationKey StakeKey)
-> Mod OptionFields (VerificationKey StakeKey)
-> Parser (VerificationKey StakeKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
    (AsType StakeKey -> ReadM (VerificationKey StakeKey)
forall keyrole.
SerialiseAsBech32 (VerificationKey keyrole) =>
AsType keyrole -> ReadM (VerificationKey keyrole)
readVerificationKey AsType StakeKey
AsStakeKey)
      (  String -> Mod OptionFields (VerificationKey StakeKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"pool-reward-account-verification-key"
      Mod OptionFields (VerificationKey StakeKey)
-> Mod OptionFields (VerificationKey StakeKey)
-> Mod OptionFields (VerificationKey StakeKey)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (VerificationKey StakeKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
      Mod OptionFields (VerificationKey StakeKey)
-> Mod OptionFields (VerificationKey StakeKey)
-> Mod OptionFields (VerificationKey StakeKey)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (VerificationKey StakeKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Reward account stake verification key (Bech32 or hex-encoded)."
      )

pRewardAcctVerificationKeyOrFile :: Parser (VerificationKeyOrFile StakeKey)
pRewardAcctVerificationKeyOrFile :: Parser (VerificationKeyOrFile StakeKey)
pRewardAcctVerificationKeyOrFile =
  VerificationKey StakeKey -> VerificationKeyOrFile StakeKey
forall keyrole.
VerificationKey keyrole -> VerificationKeyOrFile keyrole
VerificationKeyValue (VerificationKey StakeKey -> VerificationKeyOrFile StakeKey)
-> Parser (VerificationKey StakeKey)
-> Parser (VerificationKeyOrFile StakeKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKey StakeKey)
pRewardAcctVerificationKey
    Parser (VerificationKeyOrFile StakeKey)
-> Parser (VerificationKeyOrFile StakeKey)
-> Parser (VerificationKeyOrFile StakeKey)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> VerificationKeyFile -> VerificationKeyOrFile StakeKey
forall keyrole.
VerificationKeyFile -> VerificationKeyOrFile keyrole
VerificationKeyFilePath (VerificationKeyFile -> VerificationKeyOrFile StakeKey)
-> Parser VerificationKeyFile
-> Parser (VerificationKeyOrFile StakeKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VerificationKeyFile
pRewardAcctVerificationKeyFile

pPoolOwnerVerificationKeyFile :: Parser VerificationKeyFile
pPoolOwnerVerificationKeyFile :: Parser VerificationKeyFile
pPoolOwnerVerificationKeyFile =
  String -> VerificationKeyFile
VerificationKeyFile (String -> VerificationKeyFile)
-> Parser String -> Parser VerificationKeyFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ( Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
        (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"pool-owner-stake-verification-key-file"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Filepath of the pool owner stake verification key."
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
        )
    Parser String -> Parser String -> Parser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
          (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"pool-owner-staking-verification-key"
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall (f :: * -> *) a. Mod f a
Opt.internal
          )
    )

pPoolOwnerVerificationKey :: Parser (VerificationKey StakeKey)
pPoolOwnerVerificationKey :: Parser (VerificationKey StakeKey)
pPoolOwnerVerificationKey =
  ReadM (VerificationKey StakeKey)
-> Mod OptionFields (VerificationKey StakeKey)
-> Parser (VerificationKey StakeKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
    (AsType StakeKey -> ReadM (VerificationKey StakeKey)
forall keyrole.
SerialiseAsBech32 (VerificationKey keyrole) =>
AsType keyrole -> ReadM (VerificationKey keyrole)
readVerificationKey AsType StakeKey
AsStakeKey)
      (  String -> Mod OptionFields (VerificationKey StakeKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"pool-owner-verification-key"
      Mod OptionFields (VerificationKey StakeKey)
-> Mod OptionFields (VerificationKey StakeKey)
-> Mod OptionFields (VerificationKey StakeKey)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (VerificationKey StakeKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
      Mod OptionFields (VerificationKey StakeKey)
-> Mod OptionFields (VerificationKey StakeKey)
-> Mod OptionFields (VerificationKey StakeKey)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (VerificationKey StakeKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Pool owner stake verification key (Bech32 or hex-encoded)."
      )

pPoolOwnerVerificationKeyOrFile :: Parser (VerificationKeyOrFile StakeKey)
pPoolOwnerVerificationKeyOrFile :: Parser (VerificationKeyOrFile StakeKey)
pPoolOwnerVerificationKeyOrFile =
  VerificationKey StakeKey -> VerificationKeyOrFile StakeKey
forall keyrole.
VerificationKey keyrole -> VerificationKeyOrFile keyrole
VerificationKeyValue (VerificationKey StakeKey -> VerificationKeyOrFile StakeKey)
-> Parser (VerificationKey StakeKey)
-> Parser (VerificationKeyOrFile StakeKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKey StakeKey)
pPoolOwnerVerificationKey
    Parser (VerificationKeyOrFile StakeKey)
-> Parser (VerificationKeyOrFile StakeKey)
-> Parser (VerificationKeyOrFile StakeKey)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> VerificationKeyFile -> VerificationKeyOrFile StakeKey
forall keyrole.
VerificationKeyFile -> VerificationKeyOrFile keyrole
VerificationKeyFilePath (VerificationKeyFile -> VerificationKeyOrFile StakeKey)
-> Parser VerificationKeyFile
-> Parser (VerificationKeyOrFile StakeKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VerificationKeyFile
pPoolOwnerVerificationKeyFile

pPoolPledge :: Parser Entropic
pPoolPledge :: Parser Entropic
pPoolPledge =
    ReadM Entropic -> Mod OptionFields Entropic -> Parser Entropic
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser Entropic -> ReadM Entropic
forall a. Parser a -> ReadM a
readerFromParsecParser Parser Entropic
parseEntropic)
      (  String -> Mod OptionFields Entropic
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"pool-pledge"
      Mod OptionFields Entropic
-> Mod OptionFields Entropic -> Mod OptionFields Entropic
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Entropic
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"ENTROPIC"
      Mod OptionFields Entropic
-> Mod OptionFields Entropic -> Mod OptionFields Entropic
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Entropic
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The stake pool's pledge."
      )


pPoolCost :: Parser Entropic
pPoolCost :: Parser Entropic
pPoolCost =
    ReadM Entropic -> Mod OptionFields Entropic -> Parser Entropic
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser Entropic -> ReadM Entropic
forall a. Parser a -> ReadM a
readerFromParsecParser Parser Entropic
parseEntropic)
      (  String -> Mod OptionFields Entropic
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"pool-cost"
      Mod OptionFields Entropic
-> Mod OptionFields Entropic -> Mod OptionFields Entropic
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Entropic
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"ENTROPIC"
      Mod OptionFields Entropic
-> Mod OptionFields Entropic -> Mod OptionFields Entropic
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Entropic
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The stake pool's cost."
      )

pPoolMargin :: Parser Rational
pPoolMargin :: Parser Rational
pPoolMargin =
    ReadM Rational -> Mod OptionFields Rational -> Parser Rational
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Rational
readRationalUnitInterval
      (  String -> Mod OptionFields Rational
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"pool-margin"
      Mod OptionFields Rational
-> Mod OptionFields Rational -> Mod OptionFields Rational
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Rational
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"DOUBLE"
      Mod OptionFields Rational
-> Mod OptionFields Rational -> Mod OptionFields Rational
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Rational
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The stake pool's margin."
      )

pPoolRelay :: Parser StakePoolRelay
pPoolRelay :: Parser StakePoolRelay
pPoolRelay = Parser StakePoolRelay
pSingleHostAddress Parser StakePoolRelay
-> Parser StakePoolRelay -> Parser StakePoolRelay
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser StakePoolRelay
pSingleHostName Parser StakePoolRelay
-> Parser StakePoolRelay -> Parser StakePoolRelay
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser StakePoolRelay
pMultiHostName

pMultiHostName :: Parser StakePoolRelay
pMultiHostName :: Parser StakePoolRelay
pMultiHostName =
  ByteString -> StakePoolRelay
StakePoolRelayDnsSrvRecord (ByteString -> StakePoolRelay)
-> Parser ByteString -> Parser StakePoolRelay
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
pDNSName
 where
  pDNSName :: Parser ByteString
  pDNSName :: Parser ByteString
pDNSName = ReadM ByteString
-> Mod OptionFields ByteString -> Parser ByteString
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ((String -> Either String ByteString) -> ReadM ByteString
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String ByteString
eDNSName)
               (  String -> Mod OptionFields ByteString
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"multi-host-pool-relay"
               Mod OptionFields ByteString
-> Mod OptionFields ByteString -> Mod OptionFields ByteString
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields ByteString
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
               Mod OptionFields ByteString
-> Mod OptionFields ByteString -> Mod OptionFields ByteString
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields ByteString
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The stake pool relay's DNS name that corresponds to \
                            \an SRV DNS record"
               )

pSingleHostName :: Parser StakePoolRelay
pSingleHostName :: Parser StakePoolRelay
pSingleHostName =
  ByteString -> Maybe PortNumber -> StakePoolRelay
StakePoolRelayDnsARecord (ByteString -> Maybe PortNumber -> StakePoolRelay)
-> Parser ByteString -> Parser (Maybe PortNumber -> StakePoolRelay)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
pDNSName Parser (Maybe PortNumber -> StakePoolRelay)
-> Parser (Maybe PortNumber) -> Parser StakePoolRelay
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser PortNumber -> Parser (Maybe PortNumber)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser PortNumber
pPort
 where
  pDNSName :: Parser ByteString
  pDNSName :: Parser ByteString
pDNSName = ReadM ByteString
-> Mod OptionFields ByteString -> Parser ByteString
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ((String -> Either String ByteString) -> ReadM ByteString
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String ByteString
eDNSName)
               (  String -> Mod OptionFields ByteString
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"single-host-pool-relay"
               Mod OptionFields ByteString
-> Mod OptionFields ByteString -> Mod OptionFields ByteString
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields ByteString
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
               Mod OptionFields ByteString
-> Mod OptionFields ByteString -> Mod OptionFields ByteString
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields ByteString
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The stake pool relay's DNS name that corresponds to an\
                            \ A or AAAA DNS record"
               )

eDNSName :: String -> Either String ByteString
eDNSName :: String -> Either String ByteString
eDNSName String
str =
  -- We're using 'Sophie.textToDns' to validate the string.
  case Text -> Maybe DnsName
Sophie.textToDns (String -> Text
forall a b. ConvertText a b => a -> b
toS String
str) of
    Maybe DnsName
Nothing -> String -> Either String ByteString
forall a b. a -> Either a b
Left String
"DNS name is more than 64 bytes"
    Just DnsName
dnsName -> ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (ByteString -> Either String ByteString)
-> (DnsName -> ByteString) -> DnsName -> Either String ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> ByteString
Text.encodeUtf8 (Text -> ByteString) -> (DnsName -> Text) -> DnsName -> ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. DnsName -> Text
Sophie.dnsToText (DnsName -> Either String ByteString)
-> DnsName -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ DnsName
dnsName

pSingleHostAddress :: Parser StakePoolRelay
pSingleHostAddress :: Parser StakePoolRelay
pSingleHostAddress = Maybe IPv4 -> Maybe IPv6 -> PortNumber -> StakePoolRelay
singleHostAddress
  (Maybe IPv4 -> Maybe IPv6 -> PortNumber -> StakePoolRelay)
-> Parser (Maybe IPv4)
-> Parser (Maybe IPv6 -> PortNumber -> StakePoolRelay)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser IPv4 -> Parser (Maybe IPv4)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser IPv4
pIpV4
  Parser (Maybe IPv6 -> PortNumber -> StakePoolRelay)
-> Parser (Maybe IPv6) -> Parser (PortNumber -> StakePoolRelay)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser IPv6 -> Parser (Maybe IPv6)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser IPv6
pIpV6
  Parser (PortNumber -> StakePoolRelay)
-> Parser PortNumber -> Parser StakePoolRelay
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser PortNumber
pPort
 where
  singleHostAddress :: Maybe IP.IPv4 -> Maybe IP.IPv6 -> PortNumber -> StakePoolRelay
  singleHostAddress :: Maybe IPv4 -> Maybe IPv6 -> PortNumber -> StakePoolRelay
singleHostAddress Maybe IPv4
ipv4 Maybe IPv6
ipv6 PortNumber
port =
    case (Maybe IPv4
ipv4, Maybe IPv6
ipv6) of
      (Maybe IPv4
Nothing, Maybe IPv6
Nothing) ->
        Text -> StakePoolRelay
forall a. HasCallStack => Text -> a
panic Text
"Please enter either an IPv4 or IPv6 address for the pool relay"
      (Just IPv4
i4, Maybe IPv6
Nothing) ->
        Maybe IPv4 -> Maybe IPv6 -> Maybe PortNumber -> StakePoolRelay
StakePoolRelayIp (IPv4 -> Maybe IPv4
forall a. a -> Maybe a
Just IPv4
i4) Maybe IPv6
forall a. Maybe a
Nothing (PortNumber -> Maybe PortNumber
forall a. a -> Maybe a
Just PortNumber
port)
      (Maybe IPv4
Nothing, Just IPv6
i6) ->
        Maybe IPv4 -> Maybe IPv6 -> Maybe PortNumber -> StakePoolRelay
StakePoolRelayIp Maybe IPv4
forall a. Maybe a
Nothing (IPv6 -> Maybe IPv6
forall a. a -> Maybe a
Just IPv6
i6) (PortNumber -> Maybe PortNumber
forall a. a -> Maybe a
Just PortNumber
port)
      (Just IPv4
i4, Just IPv6
i6) ->
        Maybe IPv4 -> Maybe IPv6 -> Maybe PortNumber -> StakePoolRelay
StakePoolRelayIp (IPv4 -> Maybe IPv4
forall a. a -> Maybe a
Just IPv4
i4) (IPv6 -> Maybe IPv6
forall a. a -> Maybe a
Just IPv6
i6) (PortNumber -> Maybe PortNumber
forall a. a -> Maybe a
Just PortNumber
port)



pIpV4 :: Parser IP.IPv4
pIpV4 :: Parser IPv4
pIpV4 = ReadM IPv4 -> Mod OptionFields IPv4 -> Parser IPv4
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ((String -> Maybe IPv4) -> ReadM IPv4
forall a. (String -> Maybe a) -> ReadM a
Opt.maybeReader String -> Maybe IPv4
forall a. Read a => String -> Maybe a
readMaybe :: Opt.ReadM IP.IPv4)
          (  String -> Mod OptionFields IPv4
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"pool-relay-ipv4"
          Mod OptionFields IPv4
-> Mod OptionFields IPv4 -> Mod OptionFields IPv4
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields IPv4
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
          Mod OptionFields IPv4
-> Mod OptionFields IPv4 -> Mod OptionFields IPv4
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields IPv4
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The stake pool relay's IPv4 address"
          )

pIpV6 :: Parser IP.IPv6
pIpV6 :: Parser IPv6
pIpV6 = ReadM IPv6 -> Mod OptionFields IPv6 -> Parser IPv6
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ((String -> Maybe IPv6) -> ReadM IPv6
forall a. (String -> Maybe a) -> ReadM a
Opt.maybeReader String -> Maybe IPv6
forall a. Read a => String -> Maybe a
readMaybe :: Opt.ReadM IP.IPv6)
           (  String -> Mod OptionFields IPv6
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"pool-relay-ipv6"
           Mod OptionFields IPv6
-> Mod OptionFields IPv6 -> Mod OptionFields IPv6
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields IPv6
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
           Mod OptionFields IPv6
-> Mod OptionFields IPv6 -> Mod OptionFields IPv6
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields IPv6
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The stake pool relay's IPv6 address"
           )

pPort :: Parser PortNumber
pPort :: Parser PortNumber
pPort = ReadM PortNumber
-> Mod OptionFields PortNumber -> Parser PortNumber
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Integer -> PortNumber
forall a. Num a => Integer -> a
fromInteger (Integer -> PortNumber) -> ReadM Integer -> ReadM PortNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Either String Integer) -> ReadM Integer
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String Integer
forall a. Read a => String -> Either String a
readEither)
           (  String -> Mod OptionFields PortNumber
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"pool-relay-port"
           Mod OptionFields PortNumber
-> Mod OptionFields PortNumber -> Mod OptionFields PortNumber
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields PortNumber
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"INT"
           Mod OptionFields PortNumber
-> Mod OptionFields PortNumber -> Mod OptionFields PortNumber
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields PortNumber
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The stake pool relay's port"
           )

pStakePoolMetadataReference :: Parser (Maybe StakePoolMetadataReference)
pStakePoolMetadataReference :: Parser (Maybe StakePoolMetadataReference)
pStakePoolMetadataReference =
  Parser StakePoolMetadataReference
-> Parser (Maybe StakePoolMetadataReference)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser StakePoolMetadataReference
 -> Parser (Maybe StakePoolMetadataReference))
-> Parser StakePoolMetadataReference
-> Parser (Maybe StakePoolMetadataReference)
forall a b. (a -> b) -> a -> b
$
    Text -> Hash StakePoolMetadata -> StakePoolMetadataReference
StakePoolMetadataReference
      (Text -> Hash StakePoolMetadata -> StakePoolMetadataReference)
-> Parser Text
-> Parser (Hash StakePoolMetadata -> StakePoolMetadataReference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
pStakePoolMetadataUrl
      Parser (Hash StakePoolMetadata -> StakePoolMetadataReference)
-> Parser (Hash StakePoolMetadata)
-> Parser StakePoolMetadataReference
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Hash StakePoolMetadata)
pStakePoolMetadataHash

pStakePoolMetadataUrl :: Parser Text
pStakePoolMetadataUrl :: Parser Text
pStakePoolMetadataUrl =
  ReadM Text -> Mod OptionFields Text -> Parser Text
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Int -> ReadM Text
readURIOfMaxLength Int
64)
    (  String -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"metadata-url"
    Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"URL"
    Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Pool metadata URL (maximum length of 64 characters)."
    )

pStakePoolMetadataHash :: Parser (Hash StakePoolMetadata)
pStakePoolMetadataHash :: Parser (Hash StakePoolMetadata)
pStakePoolMetadataHash =
    ReadM (Hash StakePoolMetadata)
-> Mod OptionFields (Hash StakePoolMetadata)
-> Parser (Hash StakePoolMetadata)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ((String -> Maybe (Hash StakePoolMetadata))
-> ReadM (Hash StakePoolMetadata)
forall a. (String -> Maybe a) -> ReadM a
Opt.maybeReader String -> Maybe (Hash StakePoolMetadata)
metadataHash)
        (  String -> Mod OptionFields (Hash StakePoolMetadata)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"metadata-hash"
        Mod OptionFields (Hash StakePoolMetadata)
-> Mod OptionFields (Hash StakePoolMetadata)
-> Mod OptionFields (Hash StakePoolMetadata)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Hash StakePoolMetadata)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"HASH"
        Mod OptionFields (Hash StakePoolMetadata)
-> Mod OptionFields (Hash StakePoolMetadata)
-> Mod OptionFields (Hash StakePoolMetadata)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Hash StakePoolMetadata)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Pool metadata hash."
        )
  where
    metadataHash :: String -> Maybe (Hash StakePoolMetadata)
    metadataHash :: String -> Maybe (Hash StakePoolMetadata)
metadataHash = AsType (Hash StakePoolMetadata)
-> ByteString -> Maybe (Hash StakePoolMetadata)
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
deserialiseFromRawBytesHex (AsType StakePoolMetadata -> AsType (Hash StakePoolMetadata)
forall a. AsType a -> AsType (Hash a)
AsHash AsType StakePoolMetadata
AsStakePoolMetadata)
                 (ByteString -> Maybe (Hash StakePoolMetadata))
-> (String -> ByteString)
-> String
-> Maybe (Hash StakePoolMetadata)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> ByteString
BSC.pack

pStakePoolRegistrationCert :: Parser PoolCmd
pStakePoolRegistrationCert :: Parser PoolCmd
pStakePoolRegistrationCert =
  VerificationKeyOrFile StakePoolKey
-> VerificationKeyOrFile VrfKey
-> Entropic
-> Entropic
-> Rational
-> VerificationKeyOrFile StakeKey
-> [VerificationKeyOrFile StakeKey]
-> [StakePoolRelay]
-> Maybe StakePoolMetadataReference
-> NetworkId
-> OutputFile
-> PoolCmd
PoolRegistrationCert
    (VerificationKeyOrFile StakePoolKey
 -> VerificationKeyOrFile VrfKey
 -> Entropic
 -> Entropic
 -> Rational
 -> VerificationKeyOrFile StakeKey
 -> [VerificationKeyOrFile StakeKey]
 -> [StakePoolRelay]
 -> Maybe StakePoolMetadataReference
 -> NetworkId
 -> OutputFile
 -> PoolCmd)
-> Parser (VerificationKeyOrFile StakePoolKey)
-> Parser
     (VerificationKeyOrFile VrfKey
      -> Entropic
      -> Entropic
      -> Rational
      -> VerificationKeyOrFile StakeKey
      -> [VerificationKeyOrFile StakeKey]
      -> [StakePoolRelay]
      -> Maybe StakePoolMetadataReference
      -> NetworkId
      -> OutputFile
      -> PoolCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyOrFile StakePoolKey)
pStakePoolVerificationKeyOrFile
    Parser
  (VerificationKeyOrFile VrfKey
   -> Entropic
   -> Entropic
   -> Rational
   -> VerificationKeyOrFile StakeKey
   -> [VerificationKeyOrFile StakeKey]
   -> [StakePoolRelay]
   -> Maybe StakePoolMetadataReference
   -> NetworkId
   -> OutputFile
   -> PoolCmd)
-> Parser (VerificationKeyOrFile VrfKey)
-> Parser
     (Entropic
      -> Entropic
      -> Rational
      -> VerificationKeyOrFile StakeKey
      -> [VerificationKeyOrFile StakeKey]
      -> [StakePoolRelay]
      -> Maybe StakePoolMetadataReference
      -> NetworkId
      -> OutputFile
      -> PoolCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (VerificationKeyOrFile VrfKey)
pVrfVerificationKeyOrFile
    Parser
  (Entropic
   -> Entropic
   -> Rational
   -> VerificationKeyOrFile StakeKey
   -> [VerificationKeyOrFile StakeKey]
   -> [StakePoolRelay]
   -> Maybe StakePoolMetadataReference
   -> NetworkId
   -> OutputFile
   -> PoolCmd)
-> Parser Entropic
-> Parser
     (Entropic
      -> Rational
      -> VerificationKeyOrFile StakeKey
      -> [VerificationKeyOrFile StakeKey]
      -> [StakePoolRelay]
      -> Maybe StakePoolMetadataReference
      -> NetworkId
      -> OutputFile
      -> PoolCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Entropic
pPoolPledge
    Parser
  (Entropic
   -> Rational
   -> VerificationKeyOrFile StakeKey
   -> [VerificationKeyOrFile StakeKey]
   -> [StakePoolRelay]
   -> Maybe StakePoolMetadataReference
   -> NetworkId
   -> OutputFile
   -> PoolCmd)
-> Parser Entropic
-> Parser
     (Rational
      -> VerificationKeyOrFile StakeKey
      -> [VerificationKeyOrFile StakeKey]
      -> [StakePoolRelay]
      -> Maybe StakePoolMetadataReference
      -> NetworkId
      -> OutputFile
      -> PoolCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Entropic
pPoolCost
    Parser
  (Rational
   -> VerificationKeyOrFile StakeKey
   -> [VerificationKeyOrFile StakeKey]
   -> [StakePoolRelay]
   -> Maybe StakePoolMetadataReference
   -> NetworkId
   -> OutputFile
   -> PoolCmd)
-> Parser Rational
-> Parser
     (VerificationKeyOrFile StakeKey
      -> [VerificationKeyOrFile StakeKey]
      -> [StakePoolRelay]
      -> Maybe StakePoolMetadataReference
      -> NetworkId
      -> OutputFile
      -> PoolCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Rational
pPoolMargin
    Parser
  (VerificationKeyOrFile StakeKey
   -> [VerificationKeyOrFile StakeKey]
   -> [StakePoolRelay]
   -> Maybe StakePoolMetadataReference
   -> NetworkId
   -> OutputFile
   -> PoolCmd)
-> Parser (VerificationKeyOrFile StakeKey)
-> Parser
     ([VerificationKeyOrFile StakeKey]
      -> [StakePoolRelay]
      -> Maybe StakePoolMetadataReference
      -> NetworkId
      -> OutputFile
      -> PoolCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (VerificationKeyOrFile StakeKey)
pRewardAcctVerificationKeyOrFile
    Parser
  ([VerificationKeyOrFile StakeKey]
   -> [StakePoolRelay]
   -> Maybe StakePoolMetadataReference
   -> NetworkId
   -> OutputFile
   -> PoolCmd)
-> Parser [VerificationKeyOrFile StakeKey]
-> Parser
     ([StakePoolRelay]
      -> Maybe StakePoolMetadataReference
      -> NetworkId
      -> OutputFile
      -> PoolCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (VerificationKeyOrFile StakeKey)
-> Parser [VerificationKeyOrFile StakeKey]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser (VerificationKeyOrFile StakeKey)
pPoolOwnerVerificationKeyOrFile
    Parser
  ([StakePoolRelay]
   -> Maybe StakePoolMetadataReference
   -> NetworkId
   -> OutputFile
   -> PoolCmd)
-> Parser [StakePoolRelay]
-> Parser
     (Maybe StakePoolMetadataReference
      -> NetworkId -> OutputFile -> PoolCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser StakePoolRelay -> Parser [StakePoolRelay]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser StakePoolRelay
pPoolRelay
    Parser
  (Maybe StakePoolMetadataReference
   -> NetworkId -> OutputFile -> PoolCmd)
-> Parser (Maybe StakePoolMetadataReference)
-> Parser (NetworkId -> OutputFile -> PoolCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe StakePoolMetadataReference)
pStakePoolMetadataReference
    Parser (NetworkId -> OutputFile -> PoolCmd)
-> Parser NetworkId -> Parser (OutputFile -> PoolCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser NetworkId
pNetworkId
    Parser (OutputFile -> PoolCmd)
-> Parser OutputFile -> Parser PoolCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser OutputFile
pOutputFile

pStakePoolRetirementCert :: Parser PoolCmd
pStakePoolRetirementCert :: Parser PoolCmd
pStakePoolRetirementCert =
  VerificationKeyOrFile StakePoolKey
-> EpochNo -> OutputFile -> PoolCmd
PoolRetirementCert
    (VerificationKeyOrFile StakePoolKey
 -> EpochNo -> OutputFile -> PoolCmd)
-> Parser (VerificationKeyOrFile StakePoolKey)
-> Parser (EpochNo -> OutputFile -> PoolCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyOrFile StakePoolKey)
pStakePoolVerificationKeyOrFile
    Parser (EpochNo -> OutputFile -> PoolCmd)
-> Parser EpochNo -> Parser (OutputFile -> PoolCmd)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser EpochNo
pEpochNo
    Parser (OutputFile -> PoolCmd)
-> Parser OutputFile -> Parser PoolCmd
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser OutputFile
pOutputFile


pProtocolParametersUpdate :: Parser ProtocolParametersUpdate
pProtocolParametersUpdate :: Parser ProtocolParametersUpdate
pProtocolParametersUpdate =
  Maybe (Natural, Natural)
-> Maybe Rational
-> Maybe (Maybe OptimumNonce)
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Entropic
-> Maybe Entropic
-> Maybe Entropic
-> Maybe Entropic
-> Maybe EpochNo
-> Maybe Natural
-> Maybe Rational
-> Maybe Rational
-> Maybe Rational
-> Maybe Entropic
-> Map AnyZerepochScriptVersion CostModel
-> Maybe ExecutionUnitPrices
-> Maybe ExecutionUnits
-> Maybe ExecutionUnits
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> ProtocolParametersUpdate
ProtocolParametersUpdate
    (Maybe (Natural, Natural)
 -> Maybe Rational
 -> Maybe (Maybe OptimumNonce)
 -> Maybe Natural
 -> Maybe Natural
 -> Maybe Natural
 -> Maybe Natural
 -> Maybe Natural
 -> Maybe Entropic
 -> Maybe Entropic
 -> Maybe Entropic
 -> Maybe Entropic
 -> Maybe EpochNo
 -> Maybe Natural
 -> Maybe Rational
 -> Maybe Rational
 -> Maybe Rational
 -> Maybe Entropic
 -> Map AnyZerepochScriptVersion CostModel
 -> Maybe ExecutionUnitPrices
 -> Maybe ExecutionUnits
 -> Maybe ExecutionUnits
 -> Maybe Natural
 -> Maybe Natural
 -> Maybe Natural
 -> ProtocolParametersUpdate)
-> Parser (Maybe (Natural, Natural))
-> Parser
     (Maybe Rational
      -> Maybe (Maybe OptimumNonce)
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Entropic
      -> Maybe Entropic
      -> Maybe Entropic
      -> Maybe Entropic
      -> Maybe EpochNo
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Entropic
      -> Map AnyZerepochScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Natural, Natural) -> Parser (Maybe (Natural, Natural))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser (Natural, Natural)
pProtocolVersion
    Parser
  (Maybe Rational
   -> Maybe (Maybe OptimumNonce)
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Entropic
   -> Maybe Entropic
   -> Maybe Entropic
   -> Maybe Entropic
   -> Maybe EpochNo
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Entropic
   -> Map AnyZerepochScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> ProtocolParametersUpdate)
-> Parser (Maybe Rational)
-> Parser
     (Maybe (Maybe OptimumNonce)
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Entropic
      -> Maybe Entropic
      -> Maybe Entropic
      -> Maybe Entropic
      -> Maybe EpochNo
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Entropic
      -> Map AnyZerepochScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Rational -> Parser (Maybe Rational)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Rational
pDecentralParam
    Parser
  (Maybe (Maybe OptimumNonce)
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Entropic
   -> Maybe Entropic
   -> Maybe Entropic
   -> Maybe Entropic
   -> Maybe EpochNo
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Entropic
   -> Map AnyZerepochScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> ProtocolParametersUpdate)
-> Parser (Maybe (Maybe OptimumNonce))
-> Parser
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Entropic
      -> Maybe Entropic
      -> Maybe Entropic
      -> Maybe Entropic
      -> Maybe EpochNo
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Entropic
      -> Map AnyZerepochScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe OptimumNonce) -> Parser (Maybe (Maybe OptimumNonce))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser (Maybe OptimumNonce)
pExtraEntropy
    Parser
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Entropic
   -> Maybe Entropic
   -> Maybe Entropic
   -> Maybe Entropic
   -> Maybe EpochNo
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Entropic
   -> Map AnyZerepochScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> ProtocolParametersUpdate)
-> Parser (Maybe Natural)
-> Parser
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Entropic
      -> Maybe Entropic
      -> Maybe Entropic
      -> Maybe Entropic
      -> Maybe EpochNo
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Entropic
      -> Map AnyZerepochScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Natural -> Parser (Maybe Natural)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Natural
pMaxBlockHeaderSize
    Parser
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Entropic
   -> Maybe Entropic
   -> Maybe Entropic
   -> Maybe Entropic
   -> Maybe EpochNo
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Entropic
   -> Map AnyZerepochScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> ProtocolParametersUpdate)
-> Parser (Maybe Natural)
-> Parser
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Entropic
      -> Maybe Entropic
      -> Maybe Entropic
      -> Maybe Entropic
      -> Maybe EpochNo
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Entropic
      -> Map AnyZerepochScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Natural -> Parser (Maybe Natural)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Natural
pMaxBodySize
    Parser
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Entropic
   -> Maybe Entropic
   -> Maybe Entropic
   -> Maybe Entropic
   -> Maybe EpochNo
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Entropic
   -> Map AnyZerepochScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> ProtocolParametersUpdate)
-> Parser (Maybe Natural)
-> Parser
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Entropic
      -> Maybe Entropic
      -> Maybe Entropic
      -> Maybe Entropic
      -> Maybe EpochNo
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Entropic
      -> Map AnyZerepochScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Natural -> Parser (Maybe Natural)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Natural
pMaxTransactionSize
    Parser
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Entropic
   -> Maybe Entropic
   -> Maybe Entropic
   -> Maybe Entropic
   -> Maybe EpochNo
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Entropic
   -> Map AnyZerepochScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> ProtocolParametersUpdate)
-> Parser (Maybe Natural)
-> Parser
     (Maybe Natural
      -> Maybe Entropic
      -> Maybe Entropic
      -> Maybe Entropic
      -> Maybe Entropic
      -> Maybe EpochNo
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Entropic
      -> Map AnyZerepochScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Natural -> Parser (Maybe Natural)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Natural
pMinFeeConstantFactor
    Parser
  (Maybe Natural
   -> Maybe Entropic
   -> Maybe Entropic
   -> Maybe Entropic
   -> Maybe Entropic
   -> Maybe EpochNo
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Entropic
   -> Map AnyZerepochScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> ProtocolParametersUpdate)
-> Parser (Maybe Natural)
-> Parser
     (Maybe Entropic
      -> Maybe Entropic
      -> Maybe Entropic
      -> Maybe Entropic
      -> Maybe EpochNo
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Entropic
      -> Map AnyZerepochScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Natural -> Parser (Maybe Natural)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Natural
pMinFeeLinearFactor
    Parser
  (Maybe Entropic
   -> Maybe Entropic
   -> Maybe Entropic
   -> Maybe Entropic
   -> Maybe EpochNo
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Entropic
   -> Map AnyZerepochScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> ProtocolParametersUpdate)
-> Parser (Maybe Entropic)
-> Parser
     (Maybe Entropic
      -> Maybe Entropic
      -> Maybe Entropic
      -> Maybe EpochNo
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Entropic
      -> Map AnyZerepochScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Entropic -> Parser (Maybe Entropic)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Entropic
pMinUTxOValue
    Parser
  (Maybe Entropic
   -> Maybe Entropic
   -> Maybe Entropic
   -> Maybe EpochNo
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Entropic
   -> Map AnyZerepochScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> ProtocolParametersUpdate)
-> Parser (Maybe Entropic)
-> Parser
     (Maybe Entropic
      -> Maybe Entropic
      -> Maybe EpochNo
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Entropic
      -> Map AnyZerepochScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Entropic -> Parser (Maybe Entropic)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Entropic
pKeyRegistDeposit
    Parser
  (Maybe Entropic
   -> Maybe Entropic
   -> Maybe EpochNo
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Entropic
   -> Map AnyZerepochScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> ProtocolParametersUpdate)
-> Parser (Maybe Entropic)
-> Parser
     (Maybe Entropic
      -> Maybe EpochNo
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Entropic
      -> Map AnyZerepochScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Entropic -> Parser (Maybe Entropic)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Entropic
pPoolDeposit
    Parser
  (Maybe Entropic
   -> Maybe EpochNo
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Entropic
   -> Map AnyZerepochScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> ProtocolParametersUpdate)
-> Parser (Maybe Entropic)
-> Parser
     (Maybe EpochNo
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Entropic
      -> Map AnyZerepochScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Entropic -> Parser (Maybe Entropic)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Entropic
pMinPoolCost
    Parser
  (Maybe EpochNo
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Entropic
   -> Map AnyZerepochScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> ProtocolParametersUpdate)
-> Parser (Maybe EpochNo)
-> Parser
     (Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Entropic
      -> Map AnyZerepochScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser EpochNo -> Parser (Maybe EpochNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser EpochNo
pEpochBoundRetirement
    Parser
  (Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Entropic
   -> Map AnyZerepochScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> ProtocolParametersUpdate)
-> Parser (Maybe Natural)
-> Parser
     (Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Entropic
      -> Map AnyZerepochScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Natural -> Parser (Maybe Natural)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Natural
pNumberOfPools
    Parser
  (Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Entropic
   -> Map AnyZerepochScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> ProtocolParametersUpdate)
-> Parser (Maybe Rational)
-> Parser
     (Maybe Rational
      -> Maybe Rational
      -> Maybe Entropic
      -> Map AnyZerepochScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Rational -> Parser (Maybe Rational)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Rational
pPoolInfluence
    Parser
  (Maybe Rational
   -> Maybe Rational
   -> Maybe Entropic
   -> Map AnyZerepochScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> ProtocolParametersUpdate)
-> Parser (Maybe Rational)
-> Parser
     (Maybe Rational
      -> Maybe Entropic
      -> Map AnyZerepochScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Rational -> Parser (Maybe Rational)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Rational
pMonetaryExpansion
    Parser
  (Maybe Rational
   -> Maybe Entropic
   -> Map AnyZerepochScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> ProtocolParametersUpdate)
-> Parser (Maybe Rational)
-> Parser
     (Maybe Entropic
      -> Map AnyZerepochScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Rational -> Parser (Maybe Rational)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Rational
pTreasuryExpansion
    Parser
  (Maybe Entropic
   -> Map AnyZerepochScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> ProtocolParametersUpdate)
-> Parser (Maybe Entropic)
-> Parser
     (Map AnyZerepochScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Entropic -> Parser (Maybe Entropic)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Entropic
pUTxOCostPerWord
    Parser
  (Map AnyZerepochScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> ProtocolParametersUpdate)
-> Parser (Map AnyZerepochScriptVersion CostModel)
-> Parser
     (Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map AnyZerepochScriptVersion CostModel
-> Parser (Map AnyZerepochScriptVersion CostModel)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map AnyZerepochScriptVersion CostModel
forall a. Monoid a => a
mempty -- TODO aurum: separate support for cost model files
    Parser
  (Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> ProtocolParametersUpdate)
-> Parser (Maybe ExecutionUnitPrices)
-> Parser
     (Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ExecutionUnitPrices -> Parser (Maybe ExecutionUnitPrices)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ExecutionUnitPrices
pExecutionUnitPrices
    Parser
  (Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> ProtocolParametersUpdate)
-> Parser (Maybe ExecutionUnits)
-> Parser
     (Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ExecutionUnits -> Parser (Maybe ExecutionUnits)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ExecutionUnits
pMaxTxExecutionUnits
    Parser
  (Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> ProtocolParametersUpdate)
-> Parser (Maybe ExecutionUnits)
-> Parser
     (Maybe Natural
      -> Maybe Natural -> Maybe Natural -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ExecutionUnits -> Parser (Maybe ExecutionUnits)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ExecutionUnits
pMaxBlockExecutionUnits
    Parser
  (Maybe Natural
   -> Maybe Natural -> Maybe Natural -> ProtocolParametersUpdate)
-> Parser (Maybe Natural)
-> Parser
     (Maybe Natural -> Maybe Natural -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Natural -> Parser (Maybe Natural)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Natural
pMaxValueSize
    Parser (Maybe Natural -> Maybe Natural -> ProtocolParametersUpdate)
-> Parser (Maybe Natural)
-> Parser (Maybe Natural -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Natural -> Parser (Maybe Natural)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Natural
pCollateralPercent
    Parser (Maybe Natural -> ProtocolParametersUpdate)
-> Parser (Maybe Natural) -> Parser ProtocolParametersUpdate
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Natural -> Parser (Maybe Natural)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Natural
pMaxCollateralInputs

pMinFeeLinearFactor :: Parser Natural
pMinFeeLinearFactor :: Parser Natural
pMinFeeLinearFactor =
    ReadM Natural -> Mod OptionFields Natural -> Parser Natural
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Natural
forall a. Read a => ReadM a
Opt.auto
      (  String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"min-fee-linear"
      Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"NATURAL"
      Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Natural
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The linear factor for the minimum fee calculation."
      )

pMinFeeConstantFactor :: Parser Natural
pMinFeeConstantFactor :: Parser Natural
pMinFeeConstantFactor =
    ReadM Natural -> Mod OptionFields Natural -> Parser Natural
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Natural
forall a. Read a => ReadM a
Opt.auto
      (  String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"min-fee-constant"
      Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"ENTROPIC"
      Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Natural
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The constant factor for the minimum fee calculation."
      )

pMinUTxOValue :: Parser Entropic
pMinUTxOValue :: Parser Entropic
pMinUTxOValue =
    ReadM Entropic -> Mod OptionFields Entropic -> Parser Entropic
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser Entropic -> ReadM Entropic
forall a. Parser a -> ReadM a
readerFromParsecParser Parser Entropic
parseEntropic)
      (  String -> Mod OptionFields Entropic
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"min-utxo-value"
      Mod OptionFields Entropic
-> Mod OptionFields Entropic -> Mod OptionFields Entropic
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Entropic
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"NATURAL"
      Mod OptionFields Entropic
-> Mod OptionFields Entropic -> Mod OptionFields Entropic
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Entropic
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The minimum allowed UTxO value (Sophie to Jen eras)."
      )

pMinPoolCost :: Parser Entropic
pMinPoolCost :: Parser Entropic
pMinPoolCost =
    ReadM Entropic -> Mod OptionFields Entropic -> Parser Entropic
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser Entropic -> ReadM Entropic
forall a. Parser a -> ReadM a
readerFromParsecParser Parser Entropic
parseEntropic)
      (  String -> Mod OptionFields Entropic
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"min-pool-cost"
      Mod OptionFields Entropic
-> Mod OptionFields Entropic -> Mod OptionFields Entropic
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Entropic
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"NATURAL"
      Mod OptionFields Entropic
-> Mod OptionFields Entropic -> Mod OptionFields Entropic
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Entropic
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The minimum allowed cost parameter for stake pools."
      )

pMaxBodySize :: Parser Natural
pMaxBodySize :: Parser Natural
pMaxBodySize =
    ReadM Natural -> Mod OptionFields Natural -> Parser Natural
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Natural
forall a. Read a => ReadM a
Opt.auto
      (  String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"max-block-body-size"
      Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"NATURAL"
      Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Natural
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Maximal block body size."
      )

pMaxTransactionSize :: Parser Natural
pMaxTransactionSize :: Parser Natural
pMaxTransactionSize =
    ReadM Natural -> Mod OptionFields Natural -> Parser Natural
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Natural
forall a. Read a => ReadM a
Opt.auto
      (  String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"max-tx-size"
      Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"NATURAL"
      Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Natural
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Maximum transaction size."
      )

pMaxBlockHeaderSize :: Parser Natural
pMaxBlockHeaderSize :: Parser Natural
pMaxBlockHeaderSize =
    ReadM Natural -> Mod OptionFields Natural -> Parser Natural
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Natural
forall a. Read a => ReadM a
Opt.auto
      (  String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"max-block-header-size"
      Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"NATURAL"
      Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Natural
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Maximum block header size."
      )

pKeyRegistDeposit :: Parser Entropic
pKeyRegistDeposit :: Parser Entropic
pKeyRegistDeposit =
    ReadM Entropic -> Mod OptionFields Entropic -> Parser Entropic
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser Entropic -> ReadM Entropic
forall a. Parser a -> ReadM a
readerFromParsecParser Parser Entropic
parseEntropic)
      (  String -> Mod OptionFields Entropic
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"key-reg-deposit-amt"
      Mod OptionFields Entropic
-> Mod OptionFields Entropic -> Mod OptionFields Entropic
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Entropic
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"NATURAL"
      Mod OptionFields Entropic
-> Mod OptionFields Entropic -> Mod OptionFields Entropic
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Entropic
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Key registration deposit amount."
      )

pPoolDeposit :: Parser Entropic
pPoolDeposit :: Parser Entropic
pPoolDeposit =
    ReadM Entropic -> Mod OptionFields Entropic -> Parser Entropic
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser Entropic -> ReadM Entropic
forall a. Parser a -> ReadM a
readerFromParsecParser Parser Entropic
parseEntropic)
      (  String -> Mod OptionFields Entropic
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"pool-reg-deposit"
      Mod OptionFields Entropic
-> Mod OptionFields Entropic -> Mod OptionFields Entropic
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Entropic
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"NATURAL"
      Mod OptionFields Entropic
-> Mod OptionFields Entropic -> Mod OptionFields Entropic
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Entropic
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The amount of a pool registration deposit."
      )

pEpochBoundRetirement :: Parser EpochNo
pEpochBoundRetirement :: Parser EpochNo
pEpochBoundRetirement =
    Word64 -> EpochNo
EpochNo (Word64 -> EpochNo) -> Parser Word64 -> Parser EpochNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ReadM Word64 -> Mod OptionFields Word64 -> Parser Word64
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word64
forall a. Read a => ReadM a
Opt.auto
      (  String -> Mod OptionFields Word64
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"pool-retirement-epoch-boundary"
      Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word64
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"INT"
      Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word64
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Epoch bound on pool retirement."
      )

pNumberOfPools :: Parser Natural
pNumberOfPools :: Parser Natural
pNumberOfPools =
    ReadM Natural -> Mod OptionFields Natural -> Parser Natural
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Natural
forall a. Read a => ReadM a
Opt.auto
      (  String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"number-of-pools"
      Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"NATURAL"
      Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Natural
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Desired number of pools."
      )

pPoolInfluence :: Parser Rational
pPoolInfluence :: Parser Rational
pPoolInfluence =
    ReadM Rational -> Mod OptionFields Rational -> Parser Rational
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Rational
readRational
      (  String -> Mod OptionFields Rational
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"pool-influence"
      Mod OptionFields Rational
-> Mod OptionFields Rational -> Mod OptionFields Rational
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Rational
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"DOUBLE"
      Mod OptionFields Rational
-> Mod OptionFields Rational -> Mod OptionFields Rational
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Rational
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Pool influence."
      )

pTreasuryExpansion :: Parser Rational
pTreasuryExpansion :: Parser Rational
pTreasuryExpansion =
    ReadM Rational -> Mod OptionFields Rational -> Parser Rational
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Rational
readRationalUnitInterval
      (  String -> Mod OptionFields Rational
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"treasury-expansion"
      Mod OptionFields Rational
-> Mod OptionFields Rational -> Mod OptionFields Rational
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Rational
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"DOUBLE"
      Mod OptionFields Rational
-> Mod OptionFields Rational -> Mod OptionFields Rational
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Rational
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Treasury expansion."
      )

pMonetaryExpansion :: Parser Rational
pMonetaryExpansion :: Parser Rational
pMonetaryExpansion =
    ReadM Rational -> Mod OptionFields Rational -> Parser Rational
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Rational
readRationalUnitInterval
      (  String -> Mod OptionFields Rational
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"monetary-expansion"
      Mod OptionFields Rational
-> Mod OptionFields Rational -> Mod OptionFields Rational
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Rational
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"DOUBLE"
      Mod OptionFields Rational
-> Mod OptionFields Rational -> Mod OptionFields Rational
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Rational
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Monetary expansion."
      )

pDecentralParam :: Parser Rational
pDecentralParam :: Parser Rational
pDecentralParam =
    ReadM Rational -> Mod OptionFields Rational -> Parser Rational
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Rational
readRationalUnitInterval
      (  String -> Mod OptionFields Rational
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"decentralization-parameter"
      Mod OptionFields Rational
-> Mod OptionFields Rational -> Mod OptionFields Rational
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Rational
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"DOUBLE"
      Mod OptionFields Rational
-> Mod OptionFields Rational -> Mod OptionFields Rational
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Rational
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Decentralization parameter."
      )

pExtraEntropy :: Parser (Maybe OptimumNonce)
pExtraEntropy :: Parser (Maybe OptimumNonce)
pExtraEntropy =
      ReadM (Maybe OptimumNonce)
-> Mod OptionFields (Maybe OptimumNonce)
-> Parser (Maybe OptimumNonce)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (OptimumNonce -> Maybe OptimumNonce
forall a. a -> Maybe a
Just (OptimumNonce -> Maybe OptimumNonce)
-> ReadM OptimumNonce -> ReadM (Maybe OptimumNonce)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser OptimumNonce -> ReadM OptimumNonce
forall a. Parser a -> ReadM a
readerFromParsecParser Parser OptimumNonce
parseOptimumNonce)
        (  String -> Mod OptionFields (Maybe OptimumNonce)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"extra-entropy"
        Mod OptionFields (Maybe OptimumNonce)
-> Mod OptionFields (Maybe OptimumNonce)
-> Mod OptionFields (Maybe OptimumNonce)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Maybe OptimumNonce)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"HEX"
        Mod OptionFields (Maybe OptimumNonce)
-> Mod OptionFields (Maybe OptimumNonce)
-> Mod OptionFields (Maybe OptimumNonce)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Maybe OptimumNonce)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Optimum extra entropy, as a hex byte string."
        )
  Parser (Maybe OptimumNonce)
-> Parser (Maybe OptimumNonce) -> Parser (Maybe OptimumNonce)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe OptimumNonce
-> Mod FlagFields (Maybe OptimumNonce)
-> Parser (Maybe OptimumNonce)
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' Maybe OptimumNonce
forall a. Maybe a
Nothing
        (  String -> Mod FlagFields (Maybe OptimumNonce)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"reset-extra-entropy"
        Mod FlagFields (Maybe OptimumNonce)
-> Mod FlagFields (Maybe OptimumNonce)
-> Mod FlagFields (Maybe OptimumNonce)
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields (Maybe OptimumNonce)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Reset the Optimum extra entropy to none."
        )
  where
    parseOptimumNonce :: Parsec.Parser OptimumNonce
    parseOptimumNonce :: Parser OptimumNonce
parseOptimumNonce = ByteString -> OptimumNonce
makeOptimumNonce (ByteString -> OptimumNonce)
-> ParsecT String () Identity ByteString -> Parser OptimumNonce
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity ByteString
parseEntropyBytes

    parseEntropyBytes :: Parsec.Parser ByteString
    parseEntropyBytes :: ParsecT String () Identity ByteString
parseEntropyBytes = (String -> ParsecT String () Identity ByteString)
-> (ByteString -> ParsecT String () Identity ByteString)
-> Either String ByteString
-> ParsecT String () Identity ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> ParsecT String () Identity ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ByteString -> ParsecT String () Identity ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return
                      (Either String ByteString -> ParsecT String () Identity ByteString)
-> (String -> Either String ByteString)
-> String
-> ParsecT String () Identity ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Either String ByteString
B16.decode (ByteString -> Either String ByteString)
-> (String -> ByteString) -> String -> Either String ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> ByteString
BSC.pack
                    (String -> ParsecT String () Identity ByteString)
-> ParsecT String () Identity String
-> ParsecT String () Identity ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
Parsec.many1 ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
Parsec.hexDigit

pUTxOCostPerWord :: Parser Entropic
pUTxOCostPerWord :: Parser Entropic
pUTxOCostPerWord =
    ReadM Entropic -> Mod OptionFields Entropic -> Parser Entropic
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser Entropic -> ReadM Entropic
forall a. Parser a -> ReadM a
readerFromParsecParser Parser Entropic
parseEntropic)
      (  String -> Mod OptionFields Entropic
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"utxo-cost-per-word"
      Mod OptionFields Entropic
-> Mod OptionFields Entropic -> Mod OptionFields Entropic
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Entropic
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"ENTROPIC"
      Mod OptionFields Entropic
-> Mod OptionFields Entropic -> Mod OptionFields Entropic
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Entropic
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Cost in entropic per unit of UTxO storage (from Aurum era)."
      )

pExecutionUnitPrices :: Parser ExecutionUnitPrices
pExecutionUnitPrices :: Parser ExecutionUnitPrices
pExecutionUnitPrices = Rational -> Rational -> ExecutionUnitPrices
ExecutionUnitPrices
  (Rational -> Rational -> ExecutionUnitPrices)
-> Parser Rational -> Parser (Rational -> ExecutionUnitPrices)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Rational -> Mod OptionFields Rational -> Parser Rational
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Rational
readRational
      (  String -> Mod OptionFields Rational
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"price-execution-steps"
      Mod OptionFields Rational
-> Mod OptionFields Rational -> Mod OptionFields Rational
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Rational
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"RATIONAL"
      Mod OptionFields Rational
-> Mod OptionFields Rational -> Mod OptionFields Rational
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Rational
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Step price of execution units for script languages that use \
                  \them (from Aurum era).  (Examples: '1.1', '11/10')"
      )
  Parser (Rational -> ExecutionUnitPrices)
-> Parser Rational -> Parser ExecutionUnitPrices
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM Rational -> Mod OptionFields Rational -> Parser Rational
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Rational
readRational
      (  String -> Mod OptionFields Rational
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"price-execution-memory"
      Mod OptionFields Rational
-> Mod OptionFields Rational -> Mod OptionFields Rational
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Rational
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"RATIONAL"
      Mod OptionFields Rational
-> Mod OptionFields Rational -> Mod OptionFields Rational
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Rational
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Memory price of execution units for script languages that \
                  \use them (from Aurum era).  (Examples: '1.1', '11/10')"
      )

pMaxTxExecutionUnits :: Parser ExecutionUnits
pMaxTxExecutionUnits :: Parser ExecutionUnits
pMaxTxExecutionUnits =
  (Word64 -> Word64 -> ExecutionUnits)
-> (Word64, Word64) -> ExecutionUnits
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Word64 -> Word64 -> ExecutionUnits
ExecutionUnits ((Word64, Word64) -> ExecutionUnits)
-> Parser (Word64, Word64) -> Parser ExecutionUnits
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ReadM (Word64, Word64)
-> Mod OptionFields (Word64, Word64) -> Parser (Word64, Word64)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM (Word64, Word64)
forall a. Read a => ReadM a
Opt.auto
    (  String -> Mod OptionFields (Word64, Word64)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"max-tx-execution-units"
    Mod OptionFields (Word64, Word64)
-> Mod OptionFields (Word64, Word64)
-> Mod OptionFields (Word64, Word64)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Word64, Word64)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"(INT, INT)"
    Mod OptionFields (Word64, Word64)
-> Mod OptionFields (Word64, Word64)
-> Mod OptionFields (Word64, Word64)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Word64, Word64)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Max total script execution resources units allowed per tx \
                \(from Aurum era)."
    )

pMaxBlockExecutionUnits :: Parser ExecutionUnits
pMaxBlockExecutionUnits :: Parser ExecutionUnits
pMaxBlockExecutionUnits =
  (Word64 -> Word64 -> ExecutionUnits)
-> (Word64, Word64) -> ExecutionUnits
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Word64 -> Word64 -> ExecutionUnits
ExecutionUnits ((Word64, Word64) -> ExecutionUnits)
-> Parser (Word64, Word64) -> Parser ExecutionUnits
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ReadM (Word64, Word64)
-> Mod OptionFields (Word64, Word64) -> Parser (Word64, Word64)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM (Word64, Word64)
forall a. Read a => ReadM a
Opt.auto
    (  String -> Mod OptionFields (Word64, Word64)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"max-block-execution-units"
    Mod OptionFields (Word64, Word64)
-> Mod OptionFields (Word64, Word64)
-> Mod OptionFields (Word64, Word64)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Word64, Word64)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"(INT, INT)"
    Mod OptionFields (Word64, Word64)
-> Mod OptionFields (Word64, Word64)
-> Mod OptionFields (Word64, Word64)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Word64, Word64)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Max total script execution resources units allowed per block \
                \(from Aurum era)."
    )

pMaxValueSize :: Parser Natural
pMaxValueSize :: Parser Natural
pMaxValueSize =
  ReadM Natural -> Mod OptionFields Natural -> Parser Natural
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Natural
forall a. Read a => ReadM a
Opt.auto
    (  String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"max-value-size"
    Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"INT"
    Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Natural
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Max size of a multi-asset value in a tx output (from Aurum \
                \era)."
    )

pCollateralPercent :: Parser Natural
pCollateralPercent :: Parser Natural
pCollateralPercent =
  ReadM Natural -> Mod OptionFields Natural -> Parser Natural
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Natural
forall a. Read a => ReadM a
Opt.auto
    (  String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"collateral-percent"
    Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"INT"
    Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Natural
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The percentage of the script contribution to the txfee that \
                \must be provided as collateral inputs when including Zerepoch \
                \scripts (from Aurum era)."
    )

pMaxCollateralInputs :: Parser Natural
pMaxCollateralInputs :: Parser Natural
pMaxCollateralInputs =
  ReadM Natural -> Mod OptionFields Natural -> Parser Natural
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Natural
forall a. Read a => ReadM a
Opt.auto
    (  String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"max-collateral-inputs"
    Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"INT"
    Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Natural
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The maximum number of collateral inputs allowed in a \
                \transaction (from Aurum era)."
    )

pConsensusModeParams :: Parser AnyConsensusModeParams
pConsensusModeParams :: Parser AnyConsensusModeParams
pConsensusModeParams = [Parser AnyConsensusModeParams] -> Parser AnyConsensusModeParams
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
  [ AnyConsensusModeParams
-> Mod FlagFields AnyConsensusModeParams
-> Parser AnyConsensusModeParams
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' (ConsensusModeParams SophieMode -> AnyConsensusModeParams
forall mode. ConsensusModeParams mode -> AnyConsensusModeParams
AnyConsensusModeParams ConsensusModeParams SophieMode
SophieModeParams)
      (  String -> Mod FlagFields AnyConsensusModeParams
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"sophie-mode"
      Mod FlagFields AnyConsensusModeParams
-> Mod FlagFields AnyConsensusModeParams
-> Mod FlagFields AnyConsensusModeParams
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields AnyConsensusModeParams
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"For talking to a node running in Sophie-only mode."
      )
  , () -> Mod FlagFields () -> Parser ()
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' ()
      (  String -> Mod FlagFields ()
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"cole-mode"
      Mod FlagFields () -> Mod FlagFields () -> Mod FlagFields ()
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields ()
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"For talking to a node running in Cole-only mode."
      )
       Parser ()
-> Parser AnyConsensusModeParams -> Parser AnyConsensusModeParams
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser AnyConsensusModeParams
pColeConsensusMode
  , () -> Mod FlagFields () -> Parser ()
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' ()
      (  String -> Mod FlagFields ()
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"bcc-mode"
      Mod FlagFields () -> Mod FlagFields () -> Mod FlagFields ()
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields ()
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"For talking to a node running in full Bcc mode (default)."
      )
       Parser ()
-> Parser AnyConsensusModeParams -> Parser AnyConsensusModeParams
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser AnyConsensusModeParams
pBccConsensusMode
  , -- Default to the Bcc consensus mode.
    AnyConsensusModeParams -> Parser AnyConsensusModeParams
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnyConsensusModeParams -> Parser AnyConsensusModeParams)
-> (EpochSlots -> AnyConsensusModeParams)
-> EpochSlots
-> Parser AnyConsensusModeParams
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ConsensusModeParams BccMode -> AnyConsensusModeParams
forall mode. ConsensusModeParams mode -> AnyConsensusModeParams
AnyConsensusModeParams (ConsensusModeParams BccMode -> AnyConsensusModeParams)
-> (EpochSlots -> ConsensusModeParams BccMode)
-> EpochSlots
-> AnyConsensusModeParams
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. EpochSlots -> ConsensusModeParams BccMode
BccModeParams (EpochSlots -> Parser AnyConsensusModeParams)
-> EpochSlots -> Parser AnyConsensusModeParams
forall a b. (a -> b) -> a -> b
$ Word64 -> EpochSlots
EpochSlots Word64
defaultColeEpochSlots
  ]
 where
   pBccConsensusMode :: Parser AnyConsensusModeParams
   pBccConsensusMode :: Parser AnyConsensusModeParams
pBccConsensusMode = ConsensusModeParams BccMode -> AnyConsensusModeParams
forall mode. ConsensusModeParams mode -> AnyConsensusModeParams
AnyConsensusModeParams (ConsensusModeParams BccMode -> AnyConsensusModeParams)
-> (EpochSlots -> ConsensusModeParams BccMode)
-> EpochSlots
-> AnyConsensusModeParams
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. EpochSlots -> ConsensusModeParams BccMode
BccModeParams (EpochSlots -> AnyConsensusModeParams)
-> Parser EpochSlots -> Parser AnyConsensusModeParams
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser EpochSlots
pEpochSlots
   pColeConsensusMode :: Parser AnyConsensusModeParams
   pColeConsensusMode :: Parser AnyConsensusModeParams
pColeConsensusMode = ConsensusModeParams ColeMode -> AnyConsensusModeParams
forall mode. ConsensusModeParams mode -> AnyConsensusModeParams
AnyConsensusModeParams (ConsensusModeParams ColeMode -> AnyConsensusModeParams)
-> (EpochSlots -> ConsensusModeParams ColeMode)
-> EpochSlots
-> AnyConsensusModeParams
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. EpochSlots -> ConsensusModeParams ColeMode
ColeModeParams (EpochSlots -> AnyConsensusModeParams)
-> Parser EpochSlots -> Parser AnyConsensusModeParams
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser EpochSlots
pEpochSlots

defaultColeEpochSlots :: Word64
defaultColeEpochSlots :: Word64
defaultColeEpochSlots = Word64
21600

pEpochSlots :: Parser EpochSlots
pEpochSlots :: Parser EpochSlots
pEpochSlots =
  Word64 -> EpochSlots
EpochSlots (Word64 -> EpochSlots) -> Parser Word64 -> Parser EpochSlots
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ReadM Word64 -> Mod OptionFields Word64 -> Parser Word64
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word64
forall a. Read a => ReadM a
Opt.auto
      (  String -> Mod OptionFields Word64
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"epoch-slots"
      Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word64
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"NATURAL"
      Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word64
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The number of slots per epoch for the Cole era."
      Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> Word64 -> Mod OptionFields Word64
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value Word64
defaultColeEpochSlots -- Default to the mainnet value.
      Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Word64
forall a (f :: * -> *). Show a => Mod f a
Opt.showDefault
      )

pProtocolVersion :: Parser (Natural, Natural)
pProtocolVersion :: Parser (Natural, Natural)
pProtocolVersion =
    (,) (Natural -> Natural -> (Natural, Natural))
-> Parser Natural -> Parser (Natural -> (Natural, Natural))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Natural
pProtocolMajorVersion Parser (Natural -> (Natural, Natural))
-> Parser Natural -> Parser (Natural, Natural)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Natural
pProtocolSentryVersion
  where
    pProtocolMajorVersion :: Parser Natural
pProtocolMajorVersion =
      ReadM Natural -> Mod OptionFields Natural -> Parser Natural
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Natural
forall a. Read a => ReadM a
Opt.auto
        (  String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"protocol-major-version"
        Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"NATURAL"
        Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Natural
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Major protocol version. An increase indicates a hard fork."
        )
    pProtocolSentryVersion :: Parser Natural
pProtocolSentryVersion =
      ReadM Natural -> Mod OptionFields Natural -> Parser Natural
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Natural
forall a. Read a => ReadM a
Opt.auto
        (  String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"protocol-sentry-version"
        Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"NATURAL"
        Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Natural
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Sentry protocol version. An increase indicates a soft fork\
                    \ (old software canvalidate but not produce new blocks)."
        )

--
-- Sophie CLI flag field parsers
--

parseEntropic :: Parsec.Parser Entropic
parseEntropic :: Parser Entropic
parseEntropic = do
  Integer
i <- ParsecT String () Identity Integer
decimal
  if Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64
forall a. Bounded a => a
maxBound :: Word64)
  then String -> Parser Entropic
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Entropic) -> String -> Parser Entropic
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Integer
i String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" entropic exceeds the Word64 upper bound"
  else Entropic -> Parser Entropic
forall (m :: * -> *) a. Monad m => a -> m a
return (Entropic -> Parser Entropic) -> Entropic -> Parser Entropic
forall a b. (a -> b) -> a -> b
$ Integer -> Entropic
Entropic Integer
i

parseAddressAny :: Parsec.Parser AddressAny
parseAddressAny :: Parser AddressAny
parseAddressAny = do
    Text
str <- Parser Text
lexPlausibleAddressString
    case AsType AddressAny -> Text -> Maybe AddressAny
forall addr.
SerialiseAddress addr =>
AsType addr -> Text -> Maybe addr
deserialiseAddress AsType AddressAny
AsAddressAny Text
str of
      Maybe AddressAny
Nothing   -> String -> Parser AddressAny
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid address"
      Just AddressAny
addr -> AddressAny -> Parser AddressAny
forall (f :: * -> *) a. Applicative f => a -> f a
pure AddressAny
addr

parseStakeAddress :: Parsec.Parser StakeAddress
parseStakeAddress :: ParsecT String () Identity StakeAddress
parseStakeAddress = do
    Text
str <- Parser Text
lexPlausibleAddressString
    case AsType StakeAddress -> Text -> Maybe StakeAddress
forall addr.
SerialiseAddress addr =>
AsType addr -> Text -> Maybe addr
deserialiseAddress AsType StakeAddress
AsStakeAddress Text
str of
      Maybe StakeAddress
Nothing   -> String -> ParsecT String () Identity StakeAddress
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ParsecT String () Identity StakeAddress)
-> String -> ParsecT String () Identity StakeAddress
forall a b. (a -> b) -> a -> b
$ String
"invalid address: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
str
      Just StakeAddress
addr -> StakeAddress -> ParsecT String () Identity StakeAddress
forall (f :: * -> *) a. Applicative f => a -> f a
pure StakeAddress
addr

parseTxOutAnyEra :: Parsec.Parser (Maybe (Hash ScriptData) -> TxOutAnyEra)
parseTxOutAnyEra :: Parser (Maybe (Hash ScriptData) -> TxOutAnyEra)
parseTxOutAnyEra = do
    AddressAny
addr <- Parser AddressAny
parseAddressAny
    ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
Parsec.spaces
    -- Accept the old style of separating the address and value in a
    -- transaction output:
    ()
-> ParsecT String () Identity () -> ParsecT String () Identity ()
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
Parsec.option () (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'+' ParsecT String () Identity Char
-> ParsecT String () Identity () -> ParsecT String () Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
Parsec.spaces)
    Value
val <- Parser Value
parseValue
    (Maybe (Hash ScriptData) -> TxOutAnyEra)
-> Parser (Maybe (Hash ScriptData) -> TxOutAnyEra)
forall (m :: * -> *) a. Monad m => a -> m a
return (AddressAny -> Value -> Maybe (Hash ScriptData) -> TxOutAnyEra
TxOutAnyEra AddressAny
addr Value
val)

lexPlausibleAddressString :: Parsec.Parser Text
lexPlausibleAddressString :: Parser Text
lexPlausibleAddressString =
    String -> Text
Text.pack (String -> Text)
-> ParsecT String () Identity String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
Parsec.many1 ((Char -> Bool) -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
Parsec.satisfy Char -> Bool
isPlausibleAddressChar)
  where
    -- Covers both base58 and bech32 (with constrained prefixes)
    isPlausibleAddressChar :: Char -> Bool
isPlausibleAddressChar Char
c =
         (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z')
      Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Z')
      Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9')
      Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'

decimal :: Parsec.Parser Integer
Parsec.TokenParser { decimal :: forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m Integer
Parsec.decimal = ParsecT String () Identity Integer
decimal } = GenTokenParser String () Identity
forall st. TokenParser st
Parsec.haskell

--------------------------------------------------------------------------------
-- Helpers
--------------------------------------------------------------------------------

-- | Read a Bech32 or hex-encoded verification key.
readVerificationKey
  :: forall keyrole. SerialiseAsBech32 (VerificationKey keyrole)
  => AsType keyrole
  -> Opt.ReadM (VerificationKey keyrole)
readVerificationKey :: AsType keyrole -> ReadM (VerificationKey keyrole)
readVerificationKey AsType keyrole
asType =
    (String -> Either String (VerificationKey keyrole))
-> ReadM (VerificationKey keyrole)
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String (VerificationKey keyrole)
deserialiseFromBech32OrHex
  where
    keyFormats :: NonEmpty (InputFormat (VerificationKey keyrole))
    keyFormats :: NonEmpty (InputFormat (VerificationKey keyrole))
keyFormats = [InputFormat (VerificationKey keyrole)]
-> NonEmpty (InputFormat (VerificationKey keyrole))
forall a. [a] -> NonEmpty a
NE.fromList [InputFormat (VerificationKey keyrole)
forall a. SerialiseAsBech32 a => InputFormat a
InputFormatBech32, InputFormat (VerificationKey keyrole)
forall a. SerialiseAsRawBytes a => InputFormat a
InputFormatHex]

    deserialiseFromBech32OrHex
      :: String
      -> Either String (VerificationKey keyrole)
    deserialiseFromBech32OrHex :: String -> Either String (VerificationKey keyrole)
deserialiseFromBech32OrHex String
str =
      (InputDecodeError -> String)
-> Either InputDecodeError (VerificationKey keyrole)
-> Either String (VerificationKey keyrole)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> String
Text.unpack (Text -> String)
-> (InputDecodeError -> Text) -> InputDecodeError -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. InputDecodeError -> Text
renderInputDecodeError) (Either InputDecodeError (VerificationKey keyrole)
 -> Either String (VerificationKey keyrole))
-> Either InputDecodeError (VerificationKey keyrole)
-> Either String (VerificationKey keyrole)
forall a b. (a -> b) -> a -> b
$
        AsType (VerificationKey keyrole)
-> NonEmpty (InputFormat (VerificationKey keyrole))
-> ByteString
-> Either InputDecodeError (VerificationKey keyrole)
forall a.
AsType a
-> NonEmpty (InputFormat a)
-> ByteString
-> Either InputDecodeError a
deserialiseInput (AsType keyrole -> AsType (VerificationKey keyrole)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType keyrole
asType) NonEmpty (InputFormat (VerificationKey keyrole))
keyFormats (String -> ByteString
BSC.pack String
str)

readOutputFormat :: Opt.ReadM OutputFormat
readOutputFormat :: ReadM OutputFormat
readOutputFormat = do
  String
s <- ReadM String
forall s. IsString s => ReadM s
Opt.str
  case String
s of
    String
"hex" -> OutputFormat -> ReadM OutputFormat
forall (f :: * -> *) a. Applicative f => a -> f a
pure OutputFormat
OutputFormatHex
    String
"bech32" -> OutputFormat -> ReadM OutputFormat
forall (f :: * -> *) a. Applicative f => a -> f a
pure OutputFormat
OutputFormatBech32
    String
_ ->
      String -> ReadM OutputFormat
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ReadM OutputFormat) -> String -> ReadM OutputFormat
forall a b. (a -> b) -> a -> b
$ String
"Invalid output format: \""
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
s
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\". Accepted output formats are \"hex\" and \"bech32\"."

readURIOfMaxLength :: Int -> Opt.ReadM Text
readURIOfMaxLength :: Int -> ReadM Text
readURIOfMaxLength Int
maxLen =
  String -> Text
Text.pack (String -> Text) -> ReadM String -> ReadM Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ReadM String
readStringOfMaxLength Int
maxLen

readStringOfMaxLength :: Int -> Opt.ReadM String
readStringOfMaxLength :: Int -> ReadM String
readStringOfMaxLength Int
maxLen = do
  String
s <- ReadM String
forall s. IsString s => ReadM s
Opt.str
  let strLen :: Int
strLen = String -> Int
forall a. HasLength a => a -> Int
length String
s
  if Int
strLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxLen
    then String -> ReadM String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
s
    else String -> ReadM String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ReadM String) -> String -> ReadM String
forall a b. (a -> b) -> a -> b
$
      String
"The provided string must have at most 64 characters, but it has "
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Int
strLen
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" characters."

readRationalUnitInterval :: Opt.ReadM Rational
readRationalUnitInterval :: ReadM Rational
readRationalUnitInterval = ReadM Rational
readRational ReadM Rational -> (Rational -> ReadM Rational) -> ReadM Rational
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Rational -> ReadM Rational
checkUnitInterval
  where
   checkUnitInterval :: Rational -> Opt.ReadM Rational
   checkUnitInterval :: Rational -> ReadM Rational
checkUnitInterval Rational
q
     | Rational
q Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>= Rational
0 Bool -> Bool -> Bool
&& Rational
q Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
<= Rational
1 = Rational -> ReadM Rational
forall (m :: * -> *) a. Monad m => a -> m a
return Rational
q
     | Bool
otherwise        = String -> ReadM Rational
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Please enter a value in the range [0,1]"

readFractionAsRational :: Opt.ReadM Rational
readFractionAsRational :: ReadM Rational
readFractionAsRational = Parser Rational -> ReadM Rational
forall a. Parser a -> ReadM a
readerFromAttoParser Parser Rational
fractionalAsRational
  where fractionalAsRational :: Atto.Parser Rational
        fractionalAsRational :: Parser Rational
fractionalAsRational = Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
(%) (Integer -> Integer -> Rational)
-> Parser ByteString Integer
-> Parser ByteString (Integer -> Rational)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integral Integer => Parser ByteString Integer
forall a. Integral a => Parser a
Atto.decimal @Integer Parser ByteString Integer
-> Parser ByteString Char -> Parser ByteString Integer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
Atto.char Char
'/') Parser ByteString (Integer -> Rational)
-> Parser ByteString Integer -> Parser Rational
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Integral Integer => Parser ByteString Integer
forall a. Integral a => Parser a
Atto.decimal @Integer

readRational :: Opt.ReadM Rational
readRational :: ReadM Rational
readRational =
      (Scientific -> Rational
forall a. Real a => a -> Rational
toRational (Scientific -> Rational) -> ReadM Scientific -> ReadM Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Scientific -> ReadM Scientific
forall a. Parser a -> ReadM a
readerFromAttoParser Parser Scientific
Atto.scientific)
  ReadM Rational -> ReadM Rational -> ReadM Rational
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ReadM Rational
readFractionAsRational

readerJSON :: Opt.ReadM Aeson.Value
readerJSON :: ReadM Value
readerJSON = Parser Value -> ReadM Value
forall a. Parser a -> ReadM a
readerFromAttoParser Parser Value
Aeson.Parser.json

readerFromAttoParser :: Atto.Parser a -> Opt.ReadM a
readerFromAttoParser :: Parser a -> ReadM a
readerFromAttoParser Parser a
p =
    (String -> Either String a) -> ReadM a
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader (Parser a -> ByteString -> Either String a
forall a. Parser a -> ByteString -> Either String a
Atto.parseOnly (Parser a
p Parser a -> Parser ByteString () -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
Atto.endOfInput) (ByteString -> Either String a)
-> (String -> ByteString) -> String -> Either String a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> ByteString
BSC.pack)

readerFromParsecParser :: Parsec.Parser a -> Opt.ReadM a
readerFromParsecParser :: Parser a -> ReadM a
readerFromParsecParser Parser a
p =
    (String -> Either String a) -> ReadM a
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader ((ParseError -> String) -> Either ParseError a -> Either String a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseError -> String
formatError (Either ParseError a -> Either String a)
-> (String -> Either ParseError a) -> String -> Either String a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Parser a -> String -> String -> Either ParseError a
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
Parsec.parse (Parser a
p Parser a -> ParsecT String () Identity () -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
Parsec.eof) String
"")
  where
    --TODO: the default parsec error formatting is quite good, but we could
    -- customise it somewhat:
    formatError :: ParseError -> String
formatError ParseError
err =
      String
-> String -> String -> String -> String -> [Message] -> String
Parsec.showErrorMessages String
"or" String
"unknown parse error"
                               String
"expecting" String
"unexpected" String
"end of input"
                               (ParseError -> [Message]
Parsec.errorMessages ParseError
err)

subParser :: String -> ParserInfo a -> Parser a
subParser :: String -> ParserInfo a -> Parser a
subParser String
availableCommand ParserInfo a
pInfo =
  Mod CommandFields a -> Parser a
forall a. Mod CommandFields a -> Parser a
Opt.hsubparser (Mod CommandFields a -> Parser a)
-> Mod CommandFields a -> Parser a
forall a b. (a -> b) -> a -> b
$ String -> ParserInfo a -> Mod CommandFields a
forall a. String -> ParserInfo a -> Mod CommandFields a
Opt.command String
availableCommand ParserInfo a
pInfo Mod CommandFields a -> Mod CommandFields a -> Mod CommandFields a
forall a. Semigroup a => a -> a -> a
<> String -> Mod CommandFields a
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
availableCommand