{-# LANGUAGE DataKinds #-}

module Cardano.CLI.Byron.Parsers
  ( ByronCommand (..)
  , NodeCmds (..)
  , backwardsCompatibilityCommands
  , parseByronCommands
  , parseHeavyDelThd
  , parseInstallerHash
  , parseMaxBlockSize
  , parseMaxHeaderSize
  , parseMaxTxSize
  , parseMaxProposalSize
  , parseMpcThd
  , parseScriptVersion
  , parseSlotDuration
  , parseSoftforkRule
  , parseSystemTag
  , parseTxFeePolicy
  , parseUpdateProposalThd
  , parseUpdateProposalTTL
  , parseUnlockStakeEpoch
  , parseUpdateVoteThd
  )
where

import           Cardano.Api hiding (GenesisParameters, UpdateProposal, parseFilePath)
import           Cardano.Api.Byron (Address (..), ByronProtocolParametersUpdate (..),
                   toByronLovelace)
import qualified Cardano.Api.Ledger as L
import           Cardano.Api.Shelley (ReferenceScript (ReferenceScriptNone))

import           Cardano.Chain.Common (BlockCount (..), TxFeePolicy (..), TxSizeLinear (..),
                   decodeAddressBase58, rationalToLovelacePortion)
import qualified Cardano.Chain.Common as Byron
import           Cardano.Chain.Genesis (FakeAvvmOptions (..), TestnetBalanceOptions (..))
import           Cardano.Chain.Slotting (EpochNumber (..), SlotNumber (..))
import           Cardano.Chain.Update (ApplicationName (..), InstallerHash (..), NumSoftwareVersion,
                   ProtocolVersion (..), SoftforkRule (..), SoftwareVersion (..), SystemTag (..),
                   checkApplicationName, checkSystemTag)
import           Cardano.CLI.Byron.Commands
import           Cardano.CLI.Byron.Genesis
import           Cardano.CLI.Byron.Key
import           Cardano.CLI.Byron.Tx
import           Cardano.CLI.Environment (EnvCli (..))
import           Cardano.CLI.EraBased.Options.Common hiding (parseLovelace, parseTxIn)
import           Cardano.CLI.Run (ClientCommand (ByronCommand))
import           Cardano.CLI.Types.Common
import           Cardano.Crypto (RequiresNetworkMagic (..))
import           Cardano.Crypto.Hashing (hashRaw)
import           Cardano.Crypto.ProtocolMagic (AProtocolMagic (..), ProtocolMagic,
                   ProtocolMagicId (..))

import           Control.Monad (when)
import qualified Data.Attoparsec.ByteString.Char8 as Atto
import           Data.Attoparsec.Combinator ((<?>))
import qualified Data.ByteString.Char8 as BSC
import qualified Data.ByteString.Lazy.Char8 as C8
import qualified Data.Char as Char
import           Data.Foldable
import           Data.Text (Text)
import qualified Data.Text as Text
import           Data.Time (UTCTime)
import           Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import           Data.Word (Word16, Word64)
import           Formatting (build, sformat)
import           GHC.Natural (Natural)
import           GHC.Word (Word8)
import           Options.Applicative
import qualified Options.Applicative as Opt

backwardsCompatibilityCommands :: EnvCli -> Parser ClientCommand
backwardsCompatibilityCommands :: EnvCli -> Parser ClientCommand
backwardsCompatibilityCommands EnvCli
envCli =
  [Parser ClientCommand] -> Parser ClientCommand
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [Parser ClientCommand]
hiddenCmds
 where
  convertToByronCommand :: Mod CommandFields ByronCommand -> Parser ClientCommand
  convertToByronCommand :: Mod CommandFields ByronCommand -> Parser ClientCommand
convertToByronCommand Mod CommandFields ByronCommand
p = ByronCommand -> ClientCommand
ByronCommand (ByronCommand -> ClientCommand)
-> Parser ByronCommand -> Parser ClientCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod CommandFields ByronCommand -> Parser ByronCommand
forall a. Mod CommandFields a -> Parser a
Opt.subparser (Mod CommandFields ByronCommand
p Mod CommandFields ByronCommand
-> Mod CommandFields ByronCommand -> Mod CommandFields ByronCommand
forall a. Semigroup a => a -> a -> a
<> Mod CommandFields ByronCommand
forall (f :: * -> *) a. Mod f a
Opt.internal)

  hiddenCmds :: [Parser ClientCommand]
  hiddenCmds :: [Parser ClientCommand]
hiddenCmds =
    ([Mod CommandFields ByronCommand] -> [Parser ClientCommand])
-> [[Mod CommandFields ByronCommand]] -> [Parser ClientCommand]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
      ((Mod CommandFields ByronCommand -> Parser ClientCommand)
-> [Mod CommandFields ByronCommand] -> [Parser ClientCommand]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Mod CommandFields ByronCommand -> Parser ClientCommand
convertToByronCommand)
      [ [Mod CommandFields ByronCommand]
parseGenesisRelatedValues
      , EnvCli -> [Mod CommandFields ByronCommand]
parseKeyRelatedValues EnvCli
envCli
      , EnvCli -> [Mod CommandFields ByronCommand]
parseTxRelatedValues EnvCli
envCli
      , [Mod CommandFields ByronCommand]
parseMiscellaneous
      ]

-- Implemented with asum so all commands don't get hidden when trying to hide
-- the 'pNodeCmdBackwardCompatible' parser.
parseByronCommands :: EnvCli -> Parser ByronCommand
parseByronCommands :: EnvCli -> Parser ByronCommand
parseByronCommands EnvCli
envCli =
  [Parser ByronCommand] -> Parser ByronCommand
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ [Char] -> ParserInfo ByronCommand -> Parser ByronCommand
subParser'
        [Char]
"key"
        ( Parser ByronCommand
-> InfoMod ByronCommand -> ParserInfo ByronCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info ([Parser ByronCommand] -> Parser ByronCommand
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([Parser ByronCommand] -> Parser ByronCommand)
-> [Parser ByronCommand] -> Parser ByronCommand
forall a b. (a -> b) -> a -> b
$ (Mod CommandFields ByronCommand -> Parser ByronCommand)
-> [Mod CommandFields ByronCommand] -> [Parser ByronCommand]
forall a b. (a -> b) -> [a] -> [b]
map Mod CommandFields ByronCommand -> Parser ByronCommand
forall a. Mod CommandFields a -> Parser a
Opt.subparser (EnvCli -> [Mod CommandFields ByronCommand]
parseKeyRelatedValues EnvCli
envCli)) (InfoMod ByronCommand -> ParserInfo ByronCommand)
-> InfoMod ByronCommand -> ParserInfo ByronCommand
forall a b. (a -> b) -> a -> b
$
            [Char] -> InfoMod ByronCommand
forall a. [Char] -> InfoMod a
Opt.progDesc [Char]
"Byron key utility commands"
        )
    , [Char] -> ParserInfo ByronCommand -> Parser ByronCommand
subParser'
        [Char]
"transaction"
        ( Parser ByronCommand
-> InfoMod ByronCommand -> ParserInfo ByronCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info ([Parser ByronCommand] -> Parser ByronCommand
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([Parser ByronCommand] -> Parser ByronCommand)
-> [Parser ByronCommand] -> Parser ByronCommand
forall a b. (a -> b) -> a -> b
$ (Mod CommandFields ByronCommand -> Parser ByronCommand)
-> [Mod CommandFields ByronCommand] -> [Parser ByronCommand]
forall a b. (a -> b) -> [a] -> [b]
map Mod CommandFields ByronCommand -> Parser ByronCommand
forall a. Mod CommandFields a -> Parser a
Opt.subparser (EnvCli -> [Mod CommandFields ByronCommand]
parseTxRelatedValues EnvCli
envCli)) (InfoMod ByronCommand -> ParserInfo ByronCommand)
-> InfoMod ByronCommand -> ParserInfo ByronCommand
forall a b. (a -> b) -> a -> b
$
            [Char] -> InfoMod ByronCommand
forall a. [Char] -> InfoMod a
Opt.progDesc [Char]
"Byron transaction commands"
        )
    , [Char] -> ParserInfo ByronCommand -> Parser ByronCommand
subParser'
        [Char]
"genesis"
        ( Parser ByronCommand
-> InfoMod ByronCommand -> ParserInfo ByronCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info ([Parser ByronCommand] -> Parser ByronCommand
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([Parser ByronCommand] -> Parser ByronCommand)
-> [Parser ByronCommand] -> Parser ByronCommand
forall a b. (a -> b) -> a -> b
$ (Mod CommandFields ByronCommand -> Parser ByronCommand)
-> [Mod CommandFields ByronCommand] -> [Parser ByronCommand]
forall a b. (a -> b) -> [a] -> [b]
map Mod CommandFields ByronCommand -> Parser ByronCommand
forall a. Mod CommandFields a -> Parser a
Opt.subparser [Mod CommandFields ByronCommand]
parseGenesisRelatedValues) (InfoMod ByronCommand -> ParserInfo ByronCommand)
-> InfoMod ByronCommand -> ParserInfo ByronCommand
forall a b. (a -> b) -> a -> b
$
            [Char] -> InfoMod ByronCommand
forall a. [Char] -> InfoMod a
Opt.progDesc [Char]
"Byron genesis block commands"
        )
    , [Char] -> ParserInfo ByronCommand -> Parser ByronCommand
subParser'
        [Char]
"governance"
        ( Parser ByronCommand
-> InfoMod ByronCommand -> ParserInfo ByronCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (NodeCmds -> ByronCommand
NodeCmds (NodeCmds -> ByronCommand)
-> Parser NodeCmds -> Parser ByronCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod CommandFields NodeCmds -> Parser NodeCmds
forall a. Mod CommandFields a -> Parser a
Opt.subparser (EnvCli -> Mod CommandFields NodeCmds
pNodeCmds EnvCli
envCli)) (InfoMod ByronCommand -> ParserInfo ByronCommand)
-> InfoMod ByronCommand -> ParserInfo ByronCommand
forall a b. (a -> b) -> a -> b
$
            [Char] -> InfoMod ByronCommand
forall a. [Char] -> InfoMod a
Opt.progDesc [Char]
"Byron governance commands"
        )
    , [Char] -> ParserInfo ByronCommand -> Parser ByronCommand
subParser'
        [Char]
"miscellaneous"
        ( Parser ByronCommand
-> InfoMod ByronCommand -> ParserInfo ByronCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info ([Parser ByronCommand] -> Parser ByronCommand
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([Parser ByronCommand] -> Parser ByronCommand)
-> [Parser ByronCommand] -> Parser ByronCommand
forall a b. (a -> b) -> a -> b
$ (Mod CommandFields ByronCommand -> Parser ByronCommand)
-> [Mod CommandFields ByronCommand] -> [Parser ByronCommand]
forall a b. (a -> b) -> [a] -> [b]
map Mod CommandFields ByronCommand -> Parser ByronCommand
forall a. Mod CommandFields a -> Parser a
Opt.subparser [Mod CommandFields ByronCommand]
parseMiscellaneous) (InfoMod ByronCommand -> ParserInfo ByronCommand)
-> InfoMod ByronCommand -> ParserInfo ByronCommand
forall a b. (a -> b) -> a -> b
$
            [Char] -> InfoMod ByronCommand
forall a. [Char] -> InfoMod a
Opt.progDesc [Char]
"Byron miscellaneous commands"
        )
    , NodeCmds -> ByronCommand
NodeCmds (NodeCmds -> ByronCommand)
-> Parser NodeCmds -> Parser ByronCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnvCli -> Parser NodeCmds
pNodeCmdBackwardCompatible EnvCli
envCli
    ]
 where
  subParser' :: String -> ParserInfo ByronCommand -> Parser ByronCommand
  subParser' :: [Char] -> ParserInfo ByronCommand -> Parser ByronCommand
subParser' [Char]
name ParserInfo ByronCommand
pInfo = Mod CommandFields ByronCommand -> Parser ByronCommand
forall a. Mod CommandFields a -> Parser a
Opt.subparser (Mod CommandFields ByronCommand -> Parser ByronCommand)
-> Mod CommandFields ByronCommand -> Parser ByronCommand
forall a b. (a -> b) -> a -> b
$ [Char] -> ParserInfo ByronCommand -> Mod CommandFields ByronCommand
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
Opt.command [Char]
name ParserInfo ByronCommand
pInfo Mod CommandFields ByronCommand
-> Mod CommandFields ByronCommand -> Mod CommandFields ByronCommand
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod CommandFields ByronCommand
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
Opt.metavar [Char]
name

pNodeCmdBackwardCompatible :: EnvCli -> Parser NodeCmds
pNodeCmdBackwardCompatible :: EnvCli -> Parser NodeCmds
pNodeCmdBackwardCompatible EnvCli
envCli = Mod CommandFields NodeCmds -> Parser NodeCmds
forall a. Mod CommandFields a -> Parser a
Opt.subparser (Mod CommandFields NodeCmds -> Parser NodeCmds)
-> Mod CommandFields NodeCmds -> Parser NodeCmds
forall a b. (a -> b) -> a -> b
$ EnvCli -> Mod CommandFields NodeCmds
pNodeCmds EnvCli
envCli Mod CommandFields NodeCmds
-> Mod CommandFields NodeCmds -> Mod CommandFields NodeCmds
forall a. Semigroup a => a -> a -> a
<> Mod CommandFields NodeCmds
forall (f :: * -> *) a. Mod f a
Opt.internal

parseCBORObject :: Parser CBORObject
parseCBORObject :: Parser CBORObject
parseCBORObject =
  [Parser CBORObject] -> Parser CBORObject
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ EpochSlots -> CBORObject
CBORBlockByron
        (EpochSlots -> CBORObject)
-> Parser EpochSlots -> Parser CBORObject
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM EpochSlots
-> Mod OptionFields EpochSlots -> Parser EpochSlots
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
          ReadM EpochSlots
forall a. Read a => ReadM a
auto
          ( [Char] -> Mod OptionFields EpochSlots
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"byron-block"
              Mod OptionFields EpochSlots
-> Mod OptionFields EpochSlots -> Mod OptionFields EpochSlots
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields EpochSlots
forall (f :: * -> *) a. [Char] -> Mod f a
help
                ( [Char]
"The CBOR file is a byron era block."
                    [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" Enter the number of slots in an epoch. The default value is 21600"
                )
              Mod OptionFields EpochSlots
-> Mod OptionFields EpochSlots -> Mod OptionFields EpochSlots
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields EpochSlots
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"INT"
              Mod OptionFields EpochSlots
-> Mod OptionFields EpochSlots -> Mod OptionFields EpochSlots
forall a. Semigroup a => a -> a -> a
<> EpochSlots -> Mod OptionFields EpochSlots
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value (Word64 -> EpochSlots
EpochSlots Word64
21600)
          )
    , CBORObject -> Mod FlagFields CBORObject -> Parser CBORObject
forall a. a -> Mod FlagFields a -> Parser a
flag' CBORObject
CBORDelegationCertificateByron (Mod FlagFields CBORObject -> Parser CBORObject)
-> Mod FlagFields CBORObject -> Parser CBORObject
forall a b. (a -> b) -> a -> b
$
        [Char] -> Mod FlagFields CBORObject
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"byron-delegation-certificate"
          Mod FlagFields CBORObject
-> Mod FlagFields CBORObject -> Mod FlagFields CBORObject
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields CBORObject
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"The CBOR file is a byron era delegation certificate"
    , CBORObject -> Mod FlagFields CBORObject -> Parser CBORObject
forall a. a -> Mod FlagFields a -> Parser a
flag' CBORObject
CBORTxByron (Mod FlagFields CBORObject -> Parser CBORObject)
-> Mod FlagFields CBORObject -> Parser CBORObject
forall a b. (a -> b) -> a -> b
$
        [Char] -> Mod FlagFields CBORObject
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"byron-tx"
          Mod FlagFields CBORObject
-> Mod FlagFields CBORObject -> Mod FlagFields CBORObject
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields CBORObject
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"The CBOR file is a byron era tx"
    , CBORObject -> Mod FlagFields CBORObject -> Parser CBORObject
forall a. a -> Mod FlagFields a -> Parser a
flag' CBORObject
CBORUpdateProposalByron (Mod FlagFields CBORObject -> Parser CBORObject)
-> Mod FlagFields CBORObject -> Parser CBORObject
forall a b. (a -> b) -> a -> b
$
        [Char] -> Mod FlagFields CBORObject
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"byron-update-proposal"
          Mod FlagFields CBORObject
-> Mod FlagFields CBORObject -> Mod FlagFields CBORObject
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields CBORObject
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"The CBOR file is a byron era update proposal"
    , CBORObject -> Mod FlagFields CBORObject -> Parser CBORObject
forall a. a -> Mod FlagFields a -> Parser a
flag' CBORObject
CBORVoteByron (Mod FlagFields CBORObject -> Parser CBORObject)
-> Mod FlagFields CBORObject -> Parser CBORObject
forall a b. (a -> b) -> a -> b
$
        [Char] -> Mod FlagFields CBORObject
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"byron-vote"
          Mod FlagFields CBORObject
-> Mod FlagFields CBORObject -> Mod FlagFields CBORObject
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields CBORObject
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"The CBOR file is a byron era vote"
    ]

-- | Values required to create genesis.
parseGenesisParameters :: Parser GenesisParameters
parseGenesisParameters :: Parser GenesisParameters
parseGenesisParameters =
  UTCTime
-> [Char]
-> BlockCount
-> ProtocolMagic
-> TestnetBalanceOptions
-> FakeAvvmOptions
-> LovelacePortion
-> Maybe Integer
-> GenesisParameters
GenesisParameters
    (UTCTime
 -> [Char]
 -> BlockCount
 -> ProtocolMagic
 -> TestnetBalanceOptions
 -> FakeAvvmOptions
 -> LovelacePortion
 -> Maybe Integer
 -> GenesisParameters)
-> Parser UTCTime
-> Parser
     ([Char]
      -> BlockCount
      -> ProtocolMagic
      -> TestnetBalanceOptions
      -> FakeAvvmOptions
      -> LovelacePortion
      -> Maybe Integer
      -> GenesisParameters)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [Char] -> Parser UTCTime
parseUTCTime
      [Char]
"start-time"
      [Char]
"Start time of the new cluster to be enshrined in the new genesis."
    Parser
  ([Char]
   -> BlockCount
   -> ProtocolMagic
   -> TestnetBalanceOptions
   -> FakeAvvmOptions
   -> LovelacePortion
   -> Maybe Integer
   -> GenesisParameters)
-> Parser [Char]
-> Parser
     (BlockCount
      -> ProtocolMagic
      -> TestnetBalanceOptions
      -> FakeAvvmOptions
      -> LovelacePortion
      -> Maybe Integer
      -> GenesisParameters)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> [Char] -> Parser [Char]
parseFilePath
      [Char]
"protocol-parameters-file"
      [Char]
"JSON file with protocol parameters."
    Parser
  (BlockCount
   -> ProtocolMagic
   -> TestnetBalanceOptions
   -> FakeAvvmOptions
   -> LovelacePortion
   -> Maybe Integer
   -> GenesisParameters)
-> Parser BlockCount
-> Parser
     (ProtocolMagic
      -> TestnetBalanceOptions
      -> FakeAvvmOptions
      -> LovelacePortion
      -> Maybe Integer
      -> GenesisParameters)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser BlockCount
parseK
    Parser
  (ProtocolMagic
   -> TestnetBalanceOptions
   -> FakeAvvmOptions
   -> LovelacePortion
   -> Maybe Integer
   -> GenesisParameters)
-> Parser ProtocolMagic
-> Parser
     (TestnetBalanceOptions
      -> FakeAvvmOptions
      -> LovelacePortion
      -> Maybe Integer
      -> GenesisParameters)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ProtocolMagic
parseProtocolMagic
    Parser
  (TestnetBalanceOptions
   -> FakeAvvmOptions
   -> LovelacePortion
   -> Maybe Integer
   -> GenesisParameters)
-> Parser TestnetBalanceOptions
-> Parser
     (FakeAvvmOptions
      -> LovelacePortion -> Maybe Integer -> GenesisParameters)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TestnetBalanceOptions
parseTestnetBalanceOptions
    Parser
  (FakeAvvmOptions
   -> LovelacePortion -> Maybe Integer -> GenesisParameters)
-> Parser FakeAvvmOptions
-> Parser (LovelacePortion -> Maybe Integer -> GenesisParameters)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FakeAvvmOptions
parseFakeAvvmOptions
    Parser (LovelacePortion -> Maybe Integer -> GenesisParameters)
-> Parser LovelacePortion
-> Parser (Maybe Integer -> GenesisParameters)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Rational -> LovelacePortion
rationalToLovelacePortion
            (Rational -> LovelacePortion)
-> Parser Rational -> Parser LovelacePortion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [Char] -> Double -> Parser Rational
parseFractionWithDefault
              [Char]
"avvm-balance-factor"
              [Char]
"AVVM balances will be multiplied by this factor (defaults to 1)."
              Double
1
        )
    Parser (Maybe Integer -> GenesisParameters)
-> Parser (Maybe Integer) -> Parser GenesisParameters
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Integer -> Parser (Maybe Integer)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
      ( [Char] -> [Char] -> Parser Integer
forall a. Integral a => [Char] -> [Char] -> Parser a
parseIntegral
          [Char]
"secret-seed"
          [Char]
"Optionally specify the seed of generation."
      )

parseGenesisRelatedValues :: [Mod CommandFields ByronCommand]
parseGenesisRelatedValues :: [Mod CommandFields ByronCommand]
parseGenesisRelatedValues =
  [ [Char]
-> [Char] -> Parser ByronCommand -> Mod CommandFields ByronCommand
forall a. [Char] -> [Char] -> Parser a -> Mod CommandFields a
command' [Char]
"genesis" [Char]
"Create genesis." (Parser ByronCommand -> Mod CommandFields ByronCommand)
-> Parser ByronCommand -> Mod CommandFields ByronCommand
forall a b. (a -> b) -> a -> b
$
      NewDirectory -> GenesisParameters -> ByronCommand
Genesis
        (NewDirectory -> GenesisParameters -> ByronCommand)
-> Parser NewDirectory
-> Parser (GenesisParameters -> ByronCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [Char] -> Parser NewDirectory
parseNewDirectory
          [Char]
"genesis-output-dir"
          [Char]
"Non-existent directory where genesis JSON file and secrets shall be placed."
        Parser (GenesisParameters -> ByronCommand)
-> Parser GenesisParameters -> Parser ByronCommand
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser GenesisParameters
parseGenesisParameters
  , [Char]
-> [Char] -> Parser ByronCommand -> Mod CommandFields ByronCommand
forall a. [Char] -> [Char] -> Parser a -> Mod CommandFields a
command' [Char]
"print-genesis-hash" [Char]
"Compute hash of a genesis file." (Parser ByronCommand -> Mod CommandFields ByronCommand)
-> Parser ByronCommand -> Mod CommandFields ByronCommand
forall a b. (a -> b) -> a -> b
$
      GenesisFile -> ByronCommand
PrintGenesisHash
        (GenesisFile -> ByronCommand)
-> Parser GenesisFile -> Parser ByronCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Parser GenesisFile
parseGenesisFile [Char]
"genesis-json"
  ]

-- | Values required to create keys and perform
-- transformation on keys.
parseKeyRelatedValues :: EnvCli -> [Mod CommandFields ByronCommand]
parseKeyRelatedValues :: EnvCli -> [Mod CommandFields ByronCommand]
parseKeyRelatedValues EnvCli
envCli =
  [ [Char]
-> [Char] -> Parser ByronCommand -> Mod CommandFields ByronCommand
forall a. [Char] -> [Char] -> Parser a -> Mod CommandFields a
command' [Char]
"keygen" [Char]
"Generate a signing key." (Parser ByronCommand -> Mod CommandFields ByronCommand)
-> Parser ByronCommand -> Mod CommandFields ByronCommand
forall a b. (a -> b) -> a -> b
$
      NewSigningKeyFile -> ByronCommand
Keygen
        (NewSigningKeyFile -> ByronCommand)
-> Parser NewSigningKeyFile -> Parser ByronCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Parser NewSigningKeyFile
parseNewSigningKeyFile [Char]
"secret"
  , [Char]
-> [Char] -> Parser ByronCommand -> Mod CommandFields ByronCommand
forall a. [Char] -> [Char] -> Parser a -> Mod CommandFields a
command'
      [Char]
"to-verification"
      [Char]
"Extract a verification key in its base64 form."
      (Parser ByronCommand -> Mod CommandFields ByronCommand)
-> Parser ByronCommand -> Mod CommandFields ByronCommand
forall a b. (a -> b) -> a -> b
$ ByronKeyFormat
-> SigningKeyFile 'In -> NewVerificationKeyFile -> ByronCommand
ToVerification
        (ByronKeyFormat
 -> SigningKeyFile 'In -> NewVerificationKeyFile -> ByronCommand)
-> Parser ByronKeyFormat
-> Parser
     (SigningKeyFile 'In -> NewVerificationKeyFile -> ByronCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByronKeyFormat
parseByronKeyFormat
        Parser
  (SigningKeyFile 'In -> NewVerificationKeyFile -> ByronCommand)
-> Parser (SigningKeyFile 'In)
-> Parser (NewVerificationKeyFile -> ByronCommand)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> [Char] -> Parser (SigningKeyFile 'In)
parseSigningKeyFile
          [Char]
"secret"
          [Char]
"Signing key file to extract the verification part from."
        Parser (NewVerificationKeyFile -> ByronCommand)
-> Parser NewVerificationKeyFile -> Parser ByronCommand
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> Parser NewVerificationKeyFile
parseNewVerificationKeyFile [Char]
"to"
  , [Char]
-> [Char] -> Parser ByronCommand -> Mod CommandFields ByronCommand
forall a. [Char] -> [Char] -> Parser a -> Mod CommandFields a
command'
      [Char]
"signing-key-public"
      [Char]
"Pretty-print a signing key's verification key (not a secret)."
      (Parser ByronCommand -> Mod CommandFields ByronCommand)
-> Parser ByronCommand -> Mod CommandFields ByronCommand
forall a b. (a -> b) -> a -> b
$ ByronKeyFormat -> SigningKeyFile 'In -> ByronCommand
PrettySigningKeyPublic
        (ByronKeyFormat -> SigningKeyFile 'In -> ByronCommand)
-> Parser ByronKeyFormat
-> Parser (SigningKeyFile 'In -> ByronCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByronKeyFormat
parseByronKeyFormat
        Parser (SigningKeyFile 'In -> ByronCommand)
-> Parser (SigningKeyFile 'In) -> Parser ByronCommand
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> [Char] -> Parser (SigningKeyFile 'In)
parseSigningKeyFile
          [Char]
"secret"
          [Char]
"Signing key to pretty-print."
  , [Char]
-> [Char] -> Parser ByronCommand -> Mod CommandFields ByronCommand
forall a. [Char] -> [Char] -> Parser a -> Mod CommandFields a
command'
      [Char]
"signing-key-address"
      [Char]
"Print address of a signing key."
      (Parser ByronCommand -> Mod CommandFields ByronCommand)
-> Parser ByronCommand -> Mod CommandFields ByronCommand
forall a b. (a -> b) -> a -> b
$ ByronKeyFormat -> NetworkId -> SigningKeyFile 'In -> ByronCommand
PrintSigningKeyAddress
        (ByronKeyFormat -> NetworkId -> SigningKeyFile 'In -> ByronCommand)
-> Parser ByronKeyFormat
-> Parser (NetworkId -> SigningKeyFile 'In -> ByronCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByronKeyFormat
parseByronKeyFormat
        Parser (NetworkId -> SigningKeyFile 'In -> ByronCommand)
-> Parser NetworkId -> Parser (SigningKeyFile 'In -> ByronCommand)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EnvCli -> Parser NetworkId
pNetworkId EnvCli
envCli
        Parser (SigningKeyFile 'In -> ByronCommand)
-> Parser (SigningKeyFile 'In) -> Parser ByronCommand
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> [Char] -> Parser (SigningKeyFile 'In)
parseSigningKeyFile
          [Char]
"secret"
          [Char]
"Signing key, whose address is to be printed."
  , [Char]
-> [Char] -> Parser ByronCommand -> Mod CommandFields ByronCommand
forall a. [Char] -> [Char] -> Parser a -> Mod CommandFields a
command'
      [Char]
"migrate-delegate-key-from"
      [Char]
"Migrate a delegate key from an older version."
      (Parser ByronCommand -> Mod CommandFields ByronCommand)
-> Parser ByronCommand -> Mod CommandFields ByronCommand
forall a b. (a -> b) -> a -> b
$ SigningKeyFile 'In -> NewSigningKeyFile -> ByronCommand
MigrateDelegateKeyFrom
        (SigningKeyFile 'In -> NewSigningKeyFile -> ByronCommand)
-> Parser (SigningKeyFile 'In)
-> Parser (NewSigningKeyFile -> ByronCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [Char] -> Parser (SigningKeyFile 'In)
parseSigningKeyFile [Char]
"from" [Char]
"Legacy signing key file to migrate."
        Parser (NewSigningKeyFile -> ByronCommand)
-> Parser NewSigningKeyFile -> Parser ByronCommand
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> Parser NewSigningKeyFile
parseNewSigningKeyFile [Char]
"to"
  ]

parseMiscellaneous :: [Mod CommandFields ByronCommand]
parseMiscellaneous :: [Mod CommandFields ByronCommand]
parseMiscellaneous =
  [ [Char]
-> [Char] -> Parser ByronCommand -> Mod CommandFields ByronCommand
forall a. [Char] -> [Char] -> Parser a -> Mod CommandFields a
command'
      [Char]
"validate-cbor"
      [Char]
"Validate a CBOR blockchain object."
      (Parser ByronCommand -> Mod CommandFields ByronCommand)
-> Parser ByronCommand -> Mod CommandFields ByronCommand
forall a b. (a -> b) -> a -> b
$ CBORObject -> [Char] -> ByronCommand
ValidateCBOR
        (CBORObject -> [Char] -> ByronCommand)
-> Parser CBORObject -> Parser ([Char] -> ByronCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser CBORObject
parseCBORObject
        Parser ([Char] -> ByronCommand)
-> Parser [Char] -> Parser ByronCommand
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> [Char] -> Parser [Char]
parseFilePath [Char]
"filepath" [Char]
"Filepath of CBOR file."
  , [Char]
-> [Char] -> Parser ByronCommand -> Mod CommandFields ByronCommand
forall a. [Char] -> [Char] -> Parser a -> Mod CommandFields a
command'
      [Char]
"pretty-print-cbor"
      [Char]
"Pretty print a CBOR file."
      (Parser ByronCommand -> Mod CommandFields ByronCommand)
-> Parser ByronCommand -> Mod CommandFields ByronCommand
forall a b. (a -> b) -> a -> b
$ [Char] -> ByronCommand
PrettyPrintCBOR
        ([Char] -> ByronCommand) -> Parser [Char] -> Parser ByronCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [Char] -> Parser [Char]
parseFilePath [Char]
"filepath" [Char]
"Filepath of CBOR file."
  ]

parseTestnetBalanceOptions :: Parser TestnetBalanceOptions
parseTestnetBalanceOptions :: Parser TestnetBalanceOptions
parseTestnetBalanceOptions =
  Word -> Word -> Lovelace -> Rational -> TestnetBalanceOptions
TestnetBalanceOptions
    (Word -> Word -> Lovelace -> Rational -> TestnetBalanceOptions)
-> Parser Word
-> Parser (Word -> Lovelace -> Rational -> TestnetBalanceOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [Char] -> Parser Word
forall a. Integral a => [Char] -> [Char] -> Parser a
parseIntegral
      [Char]
"n-poor-addresses"
      [Char]
"Number of poor nodes (with small balance)."
    Parser (Word -> Lovelace -> Rational -> TestnetBalanceOptions)
-> Parser Word
-> Parser (Lovelace -> Rational -> TestnetBalanceOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> [Char] -> Parser Word
forall a. Integral a => [Char] -> [Char] -> Parser a
parseIntegral
      [Char]
"n-delegate-addresses"
      [Char]
"Number of delegate nodes (with huge balance)."
    Parser (Lovelace -> Rational -> TestnetBalanceOptions)
-> Parser Lovelace -> Parser (Rational -> TestnetBalanceOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> [Char] -> Parser Lovelace
parseLovelace
      [Char]
"total-balance"
      [Char]
"Total balance owned by these nodes."
    Parser (Rational -> TestnetBalanceOptions)
-> Parser Rational -> Parser TestnetBalanceOptions
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> [Char] -> Parser Rational
parseFraction
      [Char]
"delegate-share"
      [Char]
"Portion of stake owned by all delegates together."

parseTxIn :: Parser TxIn
parseTxIn :: Parser TxIn
parseTxIn =
  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
readerFromAttoParser Parser TxIn
parseTxInAtto)
    (Mod OptionFields TxIn -> Parser TxIn)
-> Mod OptionFields TxIn -> Parser TxIn
forall a b. (a -> b) -> a -> b
$ [Char] -> Mod OptionFields TxIn
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"txin"
      Mod OptionFields TxIn
-> Mod OptionFields TxIn -> Mod OptionFields TxIn
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields TxIn
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"(TXID,INDEX)"
      Mod OptionFields TxIn
-> Mod OptionFields TxIn -> Mod OptionFields TxIn
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields TxIn
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Transaction input is a pair of an UTxO TxId and a zero-based output index."

parseTxInAtto :: Atto.Parser TxIn
parseTxInAtto :: Parser TxIn
parseTxInAtto =
  TxId -> TxIx -> TxIn
TxIn
    (TxId -> TxIx -> TxIn)
-> Parser ByteString TxId -> Parser ByteString (TxIx -> TxIn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser Char
Atto.char Char
'(' Parser Char -> Parser ByteString TxId -> Parser ByteString TxId
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString TxId
parseTxIdAtto Parser ByteString TxId -> Parser Char -> Parser ByteString TxId
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
Atto.char Char
',')
    Parser ByteString (TxIx -> TxIn)
-> Parser ByteString TxIx -> Parser TxIn
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString TxIx
parseTxIxAtto Parser ByteString TxIx -> Parser Char -> Parser ByteString TxIx
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
Atto.char Char
')')

parseTxIdAtto :: Atto.Parser TxId
parseTxIdAtto :: Parser ByteString TxId
parseTxIdAtto = (Parser ByteString TxId -> [Char] -> Parser ByteString TxId
forall i a. Parser i a -> [Char] -> Parser i a
<?> [Char]
"Transaction ID (hexadecimal)") (Parser ByteString TxId -> Parser ByteString TxId)
-> Parser ByteString TxId -> Parser ByteString TxId
forall a b. (a -> b) -> a -> b
$ do
  ByteString
bstr <- (Char -> Bool) -> Parser ByteString
Atto.takeWhile1 Char -> Bool
Char.isHexDigit
  case AsType TxId -> ByteString -> Either RawBytesHexError TxId
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either RawBytesHexError a
deserialiseFromRawBytesHex AsType TxId
AsTxId ByteString
bstr of
    Right TxId
addr -> TxId -> Parser ByteString TxId
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return TxId
addr
    Left RawBytesHexError
e -> [Char] -> Parser ByteString TxId
forall a. [Char] -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser ByteString TxId)
-> [Char] -> Parser ByteString TxId
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle -> [Char]
docToString (Doc AnsiStyle -> [Char]) -> Doc AnsiStyle -> [Char]
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Incorrect transaction id format: " Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> RawBytesHexError -> Doc AnsiStyle
forall e ann. Error e => e -> Doc ann
forall ann. RawBytesHexError -> Doc ann
prettyError RawBytesHexError
e

parseTxIxAtto :: Atto.Parser TxIx
parseTxIxAtto :: Parser ByteString TxIx
parseTxIxAtto = Int -> TxIx
forall a. Enum a => Int -> a
toEnum (Int -> TxIx) -> Parser ByteString Int -> Parser ByteString TxIx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int
forall a. Integral a => Parser a
Atto.decimal

parseTxOut :: Parser (TxOut CtxTx ByronEra)
parseTxOut :: Parser (TxOut CtxTx ByronEra)
parseTxOut =
  ReadM (TxOut CtxTx ByronEra)
-> Mod OptionFields (TxOut CtxTx ByronEra)
-> Parser (TxOut CtxTx ByronEra)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
    ( ( \(Text
addr, Word64
lovelace) ->
          AddressInEra ByronEra
-> TxOutValue ByronEra
-> TxOutDatum CtxTx ByronEra
-> ReferenceScript ByronEra
-> TxOut CtxTx ByronEra
forall ctx era.
AddressInEra era
-> TxOutValue era
-> TxOutDatum ctx era
-> ReferenceScript era
-> TxOut ctx era
TxOut
            (Text -> AddressInEra ByronEra
pAddressInEra Text
addr)
            (Word64 -> TxOutValue ByronEra
pLovelaceTxOut Word64
lovelace)
            TxOutDatum CtxTx ByronEra
forall ctx era. TxOutDatum ctx era
TxOutDatumNone
            ReferenceScript ByronEra
forall era. ReferenceScript era
ReferenceScriptNone
      )
        ((Text, Word64) -> TxOut CtxTx ByronEra)
-> ReadM (Text, Word64) -> ReadM (TxOut CtxTx ByronEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM (Text, Word64)
forall a. Read a => ReadM a
auto
    )
    (Mod OptionFields (TxOut CtxTx ByronEra)
 -> Parser (TxOut CtxTx ByronEra))
-> Mod OptionFields (TxOut CtxTx ByronEra)
-> Parser (TxOut CtxTx ByronEra)
forall a b. (a -> b) -> a -> b
$ [Char] -> Mod OptionFields (TxOut CtxTx ByronEra)
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"txout"
      Mod OptionFields (TxOut CtxTx ByronEra)
-> Mod OptionFields (TxOut CtxTx ByronEra)
-> Mod OptionFields (TxOut CtxTx ByronEra)
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields (TxOut CtxTx ByronEra)
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"'(\"ADDR\", LOVELACE)'"
      Mod OptionFields (TxOut CtxTx ByronEra)
-> Mod OptionFields (TxOut CtxTx ByronEra)
-> Mod OptionFields (TxOut CtxTx ByronEra)
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields (TxOut CtxTx ByronEra)
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Specify a transaction output, as a pair of an address and lovelace."
 where
  pAddressInEra :: Text -> AddressInEra ByronEra
  pAddressInEra :: Text -> AddressInEra ByronEra
pAddressInEra Text
t =
    case Text -> Either DecoderError Address
decodeAddressBase58 Text
t of
      Left DecoderError
err -> [Char] -> AddressInEra ByronEra
forall a. HasCallStack => [Char] -> a
error ([Char] -> AddressInEra ByronEra)
-> [Char] -> AddressInEra ByronEra
forall a b. (a -> b) -> a -> b
$ [Char]
"Bad Base58 address: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> DecoderError -> [Char]
forall a. Show a => a -> [Char]
show DecoderError
err
      Right Address
byronAddress -> AddressTypeInEra ByronAddr ByronEra
-> Address ByronAddr -> AddressInEra ByronEra
forall addrtype era.
AddressTypeInEra addrtype era
-> Address addrtype -> AddressInEra era
AddressInEra AddressTypeInEra ByronAddr ByronEra
forall era. AddressTypeInEra ByronAddr era
ByronAddressInAnyEra (Address ByronAddr -> AddressInEra ByronEra)
-> Address ByronAddr -> AddressInEra ByronEra
forall a b. (a -> b) -> a -> b
$ Address -> Address ByronAddr
ByronAddress Address
byronAddress

  pLovelaceTxOut :: Word64 -> TxOutValue ByronEra
  pLovelaceTxOut :: Word64 -> TxOutValue ByronEra
pLovelaceTxOut Word64
l =
    if Word64
l Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> (Word64
forall a. Bounded a => a
maxBound :: Word64)
      then [Char] -> TxOutValue ByronEra
forall a. HasCallStack => [Char] -> a
error ([Char] -> TxOutValue ByronEra) -> [Char] -> TxOutValue ByronEra
forall a b. (a -> b) -> a -> b
$ Word64 -> [Char]
forall a. Show a => a -> [Char]
show Word64
l [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" lovelace exceeds the Word64 upper bound"
      else Coin -> TxOutValue ByronEra
forall era. Coin -> TxOutValue era
TxOutValueByron (Coin -> TxOutValue ByronEra) -> Coin -> TxOutValue ByronEra
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
L.Coin (Integer -> Coin) -> Integer -> Coin
forall a b. (a -> b) -> a -> b
$ Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger Word64
l

readerFromAttoParser :: Atto.Parser a -> Opt.ReadM a
readerFromAttoParser :: forall a. Parser a -> ReadM a
readerFromAttoParser Parser a
p =
  ([Char] -> Either [Char] a) -> ReadM a
forall a. ([Char] -> Either [Char] a) -> ReadM a
Opt.eitherReader (Parser a -> ByteString -> Either [Char] a
forall a. Parser a -> ByteString -> Either [Char] a
Atto.parseOnly (Parser a
p Parser a -> Parser ByteString () -> Parser a
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString 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 [Char] a)
-> ([Char] -> ByteString) -> [Char] -> Either [Char] a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ByteString
BSC.pack)

parseTxRelatedValues :: EnvCli -> [Mod CommandFields ByronCommand]
parseTxRelatedValues :: EnvCli -> [Mod CommandFields ByronCommand]
parseTxRelatedValues EnvCli
envCli =
  [ [Char]
-> [Char] -> Parser ByronCommand -> Mod CommandFields ByronCommand
forall a. [Char] -> [Char] -> Parser a -> Mod CommandFields a
command'
      [Char]
"submit-tx"
      [Char]
"Submit a raw, signed transaction, in its on-wire representation."
      (Parser ByronCommand -> Mod CommandFields ByronCommand)
-> Parser ByronCommand -> Mod CommandFields ByronCommand
forall a b. (a -> b) -> a -> b
$ SocketPath -> NetworkId -> TxFile 'In -> ByronCommand
SubmitTx
        (SocketPath -> NetworkId -> TxFile 'In -> ByronCommand)
-> Parser SocketPath
-> Parser (NetworkId -> TxFile 'In -> ByronCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnvCli -> Parser SocketPath
pSocketPath EnvCli
envCli
        Parser (NetworkId -> TxFile 'In -> ByronCommand)
-> Parser NetworkId -> Parser (TxFile 'In -> ByronCommand)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EnvCli -> Parser NetworkId
pNetworkId EnvCli
envCli
        Parser (TxFile 'In -> ByronCommand)
-> Parser (TxFile 'In) -> Parser ByronCommand
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> Parser (TxFile 'In)
parseTxFile [Char]
"tx"
  , [Char]
-> [Char] -> Parser ByronCommand -> Mod CommandFields ByronCommand
forall a. [Char] -> [Char] -> Parser a -> Mod CommandFields a
command'
      [Char]
"issue-genesis-utxo-expenditure"
      [Char]
"Write a file with a signed transaction, spending genesis UTxO."
      (Parser ByronCommand -> Mod CommandFields ByronCommand)
-> Parser ByronCommand -> Mod CommandFields ByronCommand
forall a b. (a -> b) -> a -> b
$ GenesisFile
-> NetworkId
-> ByronKeyFormat
-> NewTxFile
-> SigningKeyFile 'In
-> Address ByronAddr
-> [TxOut CtxTx ByronEra]
-> ByronCommand
SpendGenesisUTxO
        (GenesisFile
 -> NetworkId
 -> ByronKeyFormat
 -> NewTxFile
 -> SigningKeyFile 'In
 -> Address ByronAddr
 -> [TxOut CtxTx ByronEra]
 -> ByronCommand)
-> Parser GenesisFile
-> Parser
     (NetworkId
      -> ByronKeyFormat
      -> NewTxFile
      -> SigningKeyFile 'In
      -> Address ByronAddr
      -> [TxOut CtxTx ByronEra]
      -> ByronCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Parser GenesisFile
parseGenesisFile [Char]
"genesis-json"
        Parser
  (NetworkId
   -> ByronKeyFormat
   -> NewTxFile
   -> SigningKeyFile 'In
   -> Address ByronAddr
   -> [TxOut CtxTx ByronEra]
   -> ByronCommand)
-> Parser NetworkId
-> Parser
     (ByronKeyFormat
      -> NewTxFile
      -> SigningKeyFile 'In
      -> Address ByronAddr
      -> [TxOut CtxTx ByronEra]
      -> ByronCommand)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EnvCli -> Parser NetworkId
pNetworkId EnvCli
envCli
        Parser
  (ByronKeyFormat
   -> NewTxFile
   -> SigningKeyFile 'In
   -> Address ByronAddr
   -> [TxOut CtxTx ByronEra]
   -> ByronCommand)
-> Parser ByronKeyFormat
-> Parser
     (NewTxFile
      -> SigningKeyFile 'In
      -> Address ByronAddr
      -> [TxOut CtxTx ByronEra]
      -> ByronCommand)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByronKeyFormat
parseByronKeyFormat
        Parser
  (NewTxFile
   -> SigningKeyFile 'In
   -> Address ByronAddr
   -> [TxOut CtxTx ByronEra]
   -> ByronCommand)
-> Parser NewTxFile
-> Parser
     (SigningKeyFile 'In
      -> Address ByronAddr -> [TxOut CtxTx ByronEra] -> ByronCommand)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> Parser NewTxFile
parseNewTxFile [Char]
"tx"
        Parser
  (SigningKeyFile 'In
   -> Address ByronAddr -> [TxOut CtxTx ByronEra] -> ByronCommand)
-> Parser (SigningKeyFile 'In)
-> Parser
     (Address ByronAddr -> [TxOut CtxTx ByronEra] -> ByronCommand)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> [Char] -> Parser (SigningKeyFile 'In)
parseSigningKeyFile
          [Char]
"wallet-key"
          [Char]
"Key that has access to all mentioned genesis UTxO inputs."
        Parser
  (Address ByronAddr -> [TxOut CtxTx ByronEra] -> ByronCommand)
-> Parser (Address ByronAddr)
-> Parser ([TxOut CtxTx ByronEra] -> ByronCommand)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> [Char] -> Parser (Address ByronAddr)
parseAddress
          [Char]
"rich-addr-from"
          [Char]
"Tx source: genesis UTxO richman address (non-HD)."
        Parser ([TxOut CtxTx ByronEra] -> ByronCommand)
-> Parser [TxOut CtxTx ByronEra] -> Parser ByronCommand
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (TxOut CtxTx ByronEra) -> Parser [TxOut CtxTx ByronEra]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser (TxOut CtxTx ByronEra)
parseTxOut
  , [Char]
-> [Char] -> Parser ByronCommand -> Mod CommandFields ByronCommand
forall a. [Char] -> [Char] -> Parser a -> Mod CommandFields a
command'
      [Char]
"issue-utxo-expenditure"
      [Char]
"Write a file with a signed transaction, spending normal UTxO."
      (Parser ByronCommand -> Mod CommandFields ByronCommand)
-> Parser ByronCommand -> Mod CommandFields ByronCommand
forall a b. (a -> b) -> a -> b
$ NetworkId
-> ByronKeyFormat
-> NewTxFile
-> SigningKeyFile 'In
-> [TxIn]
-> [TxOut CtxTx ByronEra]
-> ByronCommand
SpendUTxO
        (NetworkId
 -> ByronKeyFormat
 -> NewTxFile
 -> SigningKeyFile 'In
 -> [TxIn]
 -> [TxOut CtxTx ByronEra]
 -> ByronCommand)
-> Parser NetworkId
-> Parser
     (ByronKeyFormat
      -> NewTxFile
      -> SigningKeyFile 'In
      -> [TxIn]
      -> [TxOut CtxTx ByronEra]
      -> ByronCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnvCli -> Parser NetworkId
pNetworkId EnvCli
envCli
        Parser
  (ByronKeyFormat
   -> NewTxFile
   -> SigningKeyFile 'In
   -> [TxIn]
   -> [TxOut CtxTx ByronEra]
   -> ByronCommand)
-> Parser ByronKeyFormat
-> Parser
     (NewTxFile
      -> SigningKeyFile 'In
      -> [TxIn]
      -> [TxOut CtxTx ByronEra]
      -> ByronCommand)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByronKeyFormat
parseByronKeyFormat
        Parser
  (NewTxFile
   -> SigningKeyFile 'In
   -> [TxIn]
   -> [TxOut CtxTx ByronEra]
   -> ByronCommand)
-> Parser NewTxFile
-> Parser
     (SigningKeyFile 'In
      -> [TxIn] -> [TxOut CtxTx ByronEra] -> ByronCommand)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> Parser NewTxFile
parseNewTxFile [Char]
"tx"
        Parser
  (SigningKeyFile 'In
   -> [TxIn] -> [TxOut CtxTx ByronEra] -> ByronCommand)
-> Parser (SigningKeyFile 'In)
-> Parser ([TxIn] -> [TxOut CtxTx ByronEra] -> ByronCommand)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> [Char] -> Parser (SigningKeyFile 'In)
parseSigningKeyFile
          [Char]
"wallet-key"
          [Char]
"Key that has access to all mentioned genesis UTxO inputs."
        Parser ([TxIn] -> [TxOut CtxTx ByronEra] -> ByronCommand)
-> Parser [TxIn] -> Parser ([TxOut CtxTx ByronEra] -> ByronCommand)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TxIn -> Parser [TxIn]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser TxIn
parseTxIn
        Parser ([TxOut CtxTx ByronEra] -> ByronCommand)
-> Parser [TxOut CtxTx ByronEra] -> Parser ByronCommand
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (TxOut CtxTx ByronEra) -> Parser [TxOut CtxTx ByronEra]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser (TxOut CtxTx ByronEra)
parseTxOut
  , [Char]
-> [Char] -> Parser ByronCommand -> Mod CommandFields ByronCommand
forall a. [Char] -> [Char] -> Parser a -> Mod CommandFields a
command'
      [Char]
"txid"
      [Char]
"Print the txid of a raw, signed transaction."
      (Parser ByronCommand -> Mod CommandFields ByronCommand)
-> Parser ByronCommand -> Mod CommandFields ByronCommand
forall a b. (a -> b) -> a -> b
$ TxFile 'In -> ByronCommand
GetTxId
        (TxFile 'In -> ByronCommand)
-> Parser (TxFile 'In) -> Parser ByronCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Parser (TxFile 'In)
parseTxFile [Char]
"tx"
  ]

pNodeCmds :: EnvCli -> Mod CommandFields NodeCmds
pNodeCmds :: EnvCli -> Mod CommandFields NodeCmds
pNodeCmds EnvCli
envCli =
  [Mod CommandFields NodeCmds] -> Mod CommandFields NodeCmds
forall a. Monoid a => [a] -> a
mconcat
    [ [Char] -> ParserInfo NodeCmds -> Mod CommandFields NodeCmds
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
Opt.command [Char]
"create-update-proposal" (ParserInfo NodeCmds -> Mod CommandFields NodeCmds)
-> ParserInfo NodeCmds -> Mod CommandFields NodeCmds
forall a b. (a -> b) -> a -> b
$
        Parser NodeCmds -> InfoMod NodeCmds -> ParserInfo NodeCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (EnvCli -> Parser NodeCmds
parseByronUpdateProposal EnvCli
envCli) (InfoMod NodeCmds -> ParserInfo NodeCmds)
-> InfoMod NodeCmds -> ParserInfo NodeCmds
forall a b. (a -> b) -> a -> b
$
          [Char] -> InfoMod NodeCmds
forall a. [Char] -> InfoMod a
Opt.progDesc [Char]
"Create an update proposal."
    , [Char] -> ParserInfo NodeCmds -> Mod CommandFields NodeCmds
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
Opt.command [Char]
"create-proposal-vote" (ParserInfo NodeCmds -> Mod CommandFields NodeCmds)
-> ParserInfo NodeCmds -> Mod CommandFields NodeCmds
forall a b. (a -> b) -> a -> b
$
        Parser NodeCmds -> InfoMod NodeCmds -> ParserInfo NodeCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (EnvCli -> Parser NodeCmds
parseByronVote EnvCli
envCli) (InfoMod NodeCmds -> ParserInfo NodeCmds)
-> InfoMod NodeCmds -> ParserInfo NodeCmds
forall a b. (a -> b) -> a -> b
$
          [Char] -> InfoMod NodeCmds
forall a. [Char] -> InfoMod a
Opt.progDesc [Char]
"Create an update proposal vote."
    , [Char] -> ParserInfo NodeCmds -> Mod CommandFields NodeCmds
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
Opt.command [Char]
"submit-update-proposal" (ParserInfo NodeCmds -> Mod CommandFields NodeCmds)
-> ParserInfo NodeCmds -> Mod CommandFields NodeCmds
forall a b. (a -> b) -> a -> b
$
        Parser NodeCmds -> InfoMod NodeCmds -> ParserInfo NodeCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (EnvCli -> Parser NodeCmds
parseByronUpdateProposalSubmission EnvCli
envCli) (InfoMod NodeCmds -> ParserInfo NodeCmds)
-> InfoMod NodeCmds -> ParserInfo NodeCmds
forall a b. (a -> b) -> a -> b
$
          [Char] -> InfoMod NodeCmds
forall a. [Char] -> InfoMod a
Opt.progDesc [Char]
"Submit an update proposal."
    , [Char] -> ParserInfo NodeCmds -> Mod CommandFields NodeCmds
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
Opt.command [Char]
"submit-proposal-vote" (ParserInfo NodeCmds -> Mod CommandFields NodeCmds)
-> ParserInfo NodeCmds -> Mod CommandFields NodeCmds
forall a b. (a -> b) -> a -> b
$
        Parser NodeCmds -> InfoMod NodeCmds -> ParserInfo NodeCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (EnvCli -> Parser NodeCmds
parseByronVoteSubmission EnvCli
envCli) (InfoMod NodeCmds -> ParserInfo NodeCmds)
-> InfoMod NodeCmds -> ParserInfo NodeCmds
forall a b. (a -> b) -> a -> b
$
          [Char] -> InfoMod NodeCmds
forall a. [Char] -> InfoMod a
Opt.progDesc [Char]
"Submit a proposal vote."
    ]

parseByronUpdateProposal :: EnvCli -> Parser NodeCmds
parseByronUpdateProposal :: EnvCli -> Parser NodeCmds
parseByronUpdateProposal EnvCli
envCli = do
  NetworkId
-> SigningKeyFile 'In
-> ProtocolVersion
-> SoftwareVersion
-> SystemTag
-> InstallerHash
-> [Char]
-> ByronProtocolParametersUpdate
-> NodeCmds
UpdateProposal
    (NetworkId
 -> SigningKeyFile 'In
 -> ProtocolVersion
 -> SoftwareVersion
 -> SystemTag
 -> InstallerHash
 -> [Char]
 -> ByronProtocolParametersUpdate
 -> NodeCmds)
-> Parser NetworkId
-> Parser
     (SigningKeyFile 'In
      -> ProtocolVersion
      -> SoftwareVersion
      -> SystemTag
      -> InstallerHash
      -> [Char]
      -> ByronProtocolParametersUpdate
      -> NodeCmds)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnvCli -> Parser NetworkId
pNetworkId EnvCli
envCli
    Parser
  (SigningKeyFile 'In
   -> ProtocolVersion
   -> SoftwareVersion
   -> SystemTag
   -> InstallerHash
   -> [Char]
   -> ByronProtocolParametersUpdate
   -> NodeCmds)
-> Parser (SigningKeyFile 'In)
-> Parser
     (ProtocolVersion
      -> SoftwareVersion
      -> SystemTag
      -> InstallerHash
      -> [Char]
      -> ByronProtocolParametersUpdate
      -> NodeCmds)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> [Char] -> Parser (SigningKeyFile 'In)
parseSigningKeyFile [Char]
"signing-key" [Char]
"Path to signing key."
    Parser
  (ProtocolVersion
   -> SoftwareVersion
   -> SystemTag
   -> InstallerHash
   -> [Char]
   -> ByronProtocolParametersUpdate
   -> NodeCmds)
-> Parser ProtocolVersion
-> Parser
     (SoftwareVersion
      -> SystemTag
      -> InstallerHash
      -> [Char]
      -> ByronProtocolParametersUpdate
      -> NodeCmds)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ProtocolVersion
parseProtocolVersion
    Parser
  (SoftwareVersion
   -> SystemTag
   -> InstallerHash
   -> [Char]
   -> ByronProtocolParametersUpdate
   -> NodeCmds)
-> Parser SoftwareVersion
-> Parser
     (SystemTag
      -> InstallerHash
      -> [Char]
      -> ByronProtocolParametersUpdate
      -> NodeCmds)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SoftwareVersion
parseSoftwareVersion
    Parser
  (SystemTag
   -> InstallerHash
   -> [Char]
   -> ByronProtocolParametersUpdate
   -> NodeCmds)
-> Parser SystemTag
-> Parser
     (InstallerHash
      -> [Char] -> ByronProtocolParametersUpdate -> NodeCmds)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SystemTag
parseSystemTag
    Parser
  (InstallerHash
   -> [Char] -> ByronProtocolParametersUpdate -> NodeCmds)
-> Parser InstallerHash
-> Parser ([Char] -> ByronProtocolParametersUpdate -> NodeCmds)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser InstallerHash
parseInstallerHash
    Parser ([Char] -> ByronProtocolParametersUpdate -> NodeCmds)
-> Parser [Char]
-> Parser (ByronProtocolParametersUpdate -> NodeCmds)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> [Char] -> Parser [Char]
parseFilePath [Char]
"filepath" [Char]
"Byron proposal output filepath."
    Parser (ByronProtocolParametersUpdate -> NodeCmds)
-> Parser ByronProtocolParametersUpdate -> Parser NodeCmds
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByronProtocolParametersUpdate
pByronProtocolParametersUpdate

parseByronVoteSubmission :: EnvCli -> Parser NodeCmds
parseByronVoteSubmission :: EnvCli -> Parser NodeCmds
parseByronVoteSubmission EnvCli
envCli = do
  SocketPath -> NetworkId -> [Char] -> NodeCmds
SubmitVote
    (SocketPath -> NetworkId -> [Char] -> NodeCmds)
-> Parser SocketPath -> Parser (NetworkId -> [Char] -> NodeCmds)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnvCli -> Parser SocketPath
pSocketPath EnvCli
envCli
    Parser (NetworkId -> [Char] -> NodeCmds)
-> Parser NetworkId -> Parser ([Char] -> NodeCmds)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EnvCli -> Parser NetworkId
pNetworkId EnvCli
envCli
    Parser ([Char] -> NodeCmds) -> Parser [Char] -> Parser NodeCmds
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> [Char] -> Parser [Char]
parseFilePath [Char]
"filepath" [Char]
"Filepath of Byron update proposal vote."

pByronProtocolParametersUpdate :: Parser ByronProtocolParametersUpdate
pByronProtocolParametersUpdate :: Parser ByronProtocolParametersUpdate
pByronProtocolParametersUpdate =
  Maybe Word16
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe LovelacePortion
-> Maybe LovelacePortion
-> Maybe LovelacePortion
-> Maybe LovelacePortion
-> Maybe SlotNumber
-> Maybe SoftforkRule
-> Maybe TxFeePolicy
-> Maybe EpochNumber
-> ByronProtocolParametersUpdate
ByronProtocolParametersUpdate
    (Maybe Word16
 -> Maybe Natural
 -> Maybe Natural
 -> Maybe Natural
 -> Maybe Natural
 -> Maybe Natural
 -> Maybe LovelacePortion
 -> Maybe LovelacePortion
 -> Maybe LovelacePortion
 -> Maybe LovelacePortion
 -> Maybe SlotNumber
 -> Maybe SoftforkRule
 -> Maybe TxFeePolicy
 -> Maybe EpochNumber
 -> ByronProtocolParametersUpdate)
-> Parser (Maybe Word16)
-> Parser
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> ByronProtocolParametersUpdate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word16 -> Parser (Maybe Word16)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Word16
parseScriptVersion
    Parser
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> ByronProtocolParametersUpdate)
-> Parser (Maybe Natural)
-> Parser
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> ByronProtocolParametersUpdate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
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
parseSlotDuration
    Parser
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> ByronProtocolParametersUpdate)
-> Parser (Maybe Natural)
-> Parser
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> ByronProtocolParametersUpdate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
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
parseMaxBlockSize
    Parser
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> ByronProtocolParametersUpdate)
-> Parser (Maybe Natural)
-> Parser
     (Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> ByronProtocolParametersUpdate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
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
parseMaxHeaderSize
    Parser
  (Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> ByronProtocolParametersUpdate)
-> Parser (Maybe Natural)
-> Parser
     (Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> ByronProtocolParametersUpdate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
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
parseMaxTxSize
    Parser
  (Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> ByronProtocolParametersUpdate)
-> Parser (Maybe Natural)
-> Parser
     (Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> ByronProtocolParametersUpdate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
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
parseMaxProposalSize
    Parser
  (Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> ByronProtocolParametersUpdate)
-> Parser (Maybe LovelacePortion)
-> Parser
     (Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> ByronProtocolParametersUpdate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser LovelacePortion -> Parser (Maybe LovelacePortion)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser LovelacePortion
parseMpcThd
    Parser
  (Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> ByronProtocolParametersUpdate)
-> Parser (Maybe LovelacePortion)
-> Parser
     (Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> ByronProtocolParametersUpdate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser LovelacePortion -> Parser (Maybe LovelacePortion)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser LovelacePortion
parseHeavyDelThd
    Parser
  (Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> ByronProtocolParametersUpdate)
-> Parser (Maybe LovelacePortion)
-> Parser
     (Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> ByronProtocolParametersUpdate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser LovelacePortion -> Parser (Maybe LovelacePortion)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser LovelacePortion
parseUpdateVoteThd
    Parser
  (Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> ByronProtocolParametersUpdate)
-> Parser (Maybe LovelacePortion)
-> Parser
     (Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> ByronProtocolParametersUpdate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser LovelacePortion -> Parser (Maybe LovelacePortion)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser LovelacePortion
parseUpdateProposalThd
    Parser
  (Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> ByronProtocolParametersUpdate)
-> Parser (Maybe SlotNumber)
-> Parser
     (Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> ByronProtocolParametersUpdate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SlotNumber -> Parser (Maybe SlotNumber)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser SlotNumber
parseUpdateProposalTTL
    Parser
  (Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> ByronProtocolParametersUpdate)
-> Parser (Maybe SoftforkRule)
-> Parser
     (Maybe TxFeePolicy
      -> Maybe EpochNumber -> ByronProtocolParametersUpdate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SoftforkRule -> Parser (Maybe SoftforkRule)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser SoftforkRule
parseSoftforkRule
    Parser
  (Maybe TxFeePolicy
   -> Maybe EpochNumber -> ByronProtocolParametersUpdate)
-> Parser (Maybe TxFeePolicy)
-> Parser (Maybe EpochNumber -> ByronProtocolParametersUpdate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TxFeePolicy -> Parser (Maybe TxFeePolicy)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser TxFeePolicy
parseTxFeePolicy
    Parser (Maybe EpochNumber -> ByronProtocolParametersUpdate)
-> Parser (Maybe EpochNumber)
-> Parser ByronProtocolParametersUpdate
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser EpochNumber -> Parser (Maybe EpochNumber)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser EpochNumber
parseUnlockStakeEpoch

parseByronUpdateProposalSubmission :: EnvCli -> Parser NodeCmds
parseByronUpdateProposalSubmission :: EnvCli -> Parser NodeCmds
parseByronUpdateProposalSubmission EnvCli
envCli =
  SocketPath -> NetworkId -> [Char] -> NodeCmds
SubmitUpdateProposal
    (SocketPath -> NetworkId -> [Char] -> NodeCmds)
-> Parser SocketPath -> Parser (NetworkId -> [Char] -> NodeCmds)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnvCli -> Parser SocketPath
pSocketPath EnvCli
envCli
    Parser (NetworkId -> [Char] -> NodeCmds)
-> Parser NetworkId -> Parser ([Char] -> NodeCmds)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EnvCli -> Parser NetworkId
pNetworkId EnvCli
envCli
    Parser ([Char] -> NodeCmds) -> Parser [Char] -> Parser NodeCmds
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> [Char] -> Parser [Char]
parseFilePath [Char]
"filepath" [Char]
"Filepath of Byron update proposal."

parseByronVote :: EnvCli -> Parser NodeCmds
parseByronVote :: EnvCli -> Parser NodeCmds
parseByronVote EnvCli
envCli =
  NetworkId
-> SigningKeyFile 'In -> [Char] -> Bool -> [Char] -> NodeCmds
CreateVote
    (NetworkId
 -> SigningKeyFile 'In -> [Char] -> Bool -> [Char] -> NodeCmds)
-> Parser NetworkId
-> Parser
     (SigningKeyFile 'In -> [Char] -> Bool -> [Char] -> NodeCmds)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnvCli -> Parser NetworkId
pNetworkId EnvCli
envCli
    Parser (SigningKeyFile 'In -> [Char] -> Bool -> [Char] -> NodeCmds)
-> Parser (SigningKeyFile 'In)
-> Parser ([Char] -> Bool -> [Char] -> NodeCmds)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Char] -> SigningKeyFile 'In
forall content (direction :: FileDirection).
[Char] -> File content direction
File ([Char] -> SigningKeyFile 'In)
-> Parser [Char] -> Parser (SigningKeyFile 'In)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [Char] -> Parser [Char]
parseFilePath [Char]
"signing-key" [Char]
"Filepath of signing key.")
    Parser ([Char] -> Bool -> [Char] -> NodeCmds)
-> Parser [Char] -> Parser (Bool -> [Char] -> NodeCmds)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> [Char] -> Parser [Char]
parseFilePath [Char]
"proposal-filepath" [Char]
"Filepath of Byron update proposal."
    Parser (Bool -> [Char] -> NodeCmds)
-> Parser Bool -> Parser ([Char] -> NodeCmds)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
parseVoteBool
    Parser ([Char] -> NodeCmds) -> Parser [Char] -> Parser NodeCmds
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> [Char] -> Parser [Char]
parseFilePath [Char]
"output-filepath" [Char]
"Byron vote output filepath."

--------------------------------------------------------------------------------
-- CLI Parsers
--------------------------------------------------------------------------------

parseScriptVersion :: Parser Word16
parseScriptVersion :: Parser Word16
parseScriptVersion =
  ReadM Word16 -> Mod OptionFields Word16 -> Parser Word16
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
    ReadM Word16
forall a. Read a => ReadM a
auto
    ( [Char] -> Mod OptionFields Word16
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"script-version"
        Mod OptionFields Word16
-> Mod OptionFields Word16 -> Mod OptionFields Word16
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields Word16
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"WORD16"
        Mod OptionFields Word16
-> Mod OptionFields Word16 -> Mod OptionFields Word16
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields Word16
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Proposed script version."
    )

parseSlotDuration :: Parser Natural
parseSlotDuration :: Parser Natural
parseSlotDuration =
  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
auto
    ( [Char] -> Mod OptionFields Natural
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"slot-duration"
        Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields Natural
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"NATURAL"
        Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields Natural
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Proposed slot duration."
    )

parseSystemTag :: Parser SystemTag
parseSystemTag :: Parser SystemTag
parseSystemTag =
  ReadM SystemTag -> Mod OptionFields SystemTag -> Parser SystemTag
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
    (([Char] -> Either [Char] SystemTag) -> ReadM SystemTag
forall a. ([Char] -> Either [Char] a) -> ReadM a
eitherReader [Char] -> Either [Char] SystemTag
checkSysTag)
    ( [Char] -> Mod OptionFields SystemTag
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"system-tag"
        Mod OptionFields SystemTag
-> Mod OptionFields SystemTag -> Mod OptionFields SystemTag
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields SystemTag
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"STRING"
        Mod OptionFields SystemTag
-> Mod OptionFields SystemTag -> Mod OptionFields SystemTag
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields SystemTag
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Identify which system (linux, win64, etc) the update proposal is for."
    )
 where
  checkSysTag :: String -> Either String SystemTag
  checkSysTag :: [Char] -> Either [Char] SystemTag
checkSysTag [Char]
name =
    let tag :: SystemTag
tag = Text -> SystemTag
SystemTag (Text -> SystemTag) -> Text -> SystemTag
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
Text.pack [Char]
name
     in case SystemTag -> Either SystemTagError ()
forall (m :: * -> *).
MonadError SystemTagError m =>
SystemTag -> m ()
checkSystemTag SystemTag
tag of
          Left SystemTagError
err -> [Char] -> Either [Char] SystemTag
forall a b. a -> Either a b
Left ([Char] -> Either [Char] SystemTag)
-> (Text -> [Char]) -> Text -> Either [Char] SystemTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
Text.unpack (Text -> Either [Char] SystemTag)
-> Text -> Either [Char] SystemTag
forall a b. (a -> b) -> a -> b
$ Format Text (SystemTagError -> Text) -> SystemTagError -> Text
forall a. Format Text a -> a
sformat Format Text (SystemTagError -> Text)
forall a r. Buildable a => Format r (a -> r)
build SystemTagError
err
          Right () -> SystemTag -> Either [Char] SystemTag
forall a b. b -> Either a b
Right SystemTag
tag

parseInstallerHash :: Parser InstallerHash
parseInstallerHash :: Parser InstallerHash
parseInstallerHash =
  Hash Raw -> InstallerHash
InstallerHash (Hash Raw -> InstallerHash)
-> ([Char] -> Hash Raw) -> [Char] -> InstallerHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Hash Raw
hashRaw (ByteString -> Hash Raw)
-> ([Char] -> ByteString) -> [Char] -> Hash Raw
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ByteString
C8.pack
    ([Char] -> InstallerHash) -> Parser [Char] -> Parser InstallerHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields [Char] -> Parser [Char]
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
      ( [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"installer-hash"
          Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"HASH"
          Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Software hash."
      )

parseMaxBlockSize :: Parser Natural
parseMaxBlockSize :: Parser Natural
parseMaxBlockSize =
  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
auto
    ( [Char] -> Mod OptionFields Natural
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"max-block-size"
        Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields Natural
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"NATURAL"
        Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields Natural
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Proposed max block size."
    )

parseMaxHeaderSize :: Parser Natural
parseMaxHeaderSize :: Parser Natural
parseMaxHeaderSize =
  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
auto
    ( [Char] -> Mod OptionFields Natural
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"max-header-size"
        Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields Natural
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"NATURAL"
        Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields Natural
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Proposed max block header size."
    )

parseMaxTxSize :: Parser Natural
parseMaxTxSize :: Parser Natural
parseMaxTxSize =
  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
auto
    ( [Char] -> Mod OptionFields Natural
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"max-tx-size"
        Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields Natural
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"NATURAL"
        Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields Natural
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Proposed max transaction size."
    )

parseMaxProposalSize :: Parser Natural
parseMaxProposalSize :: Parser Natural
parseMaxProposalSize =
  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
auto
    ( [Char] -> Mod OptionFields Natural
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"max-proposal-size"
        Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields Natural
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"NATURAL"
        Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields Natural
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Proposed max update proposal size."
    )

parseMpcThd :: Parser Byron.LovelacePortion
parseMpcThd :: Parser LovelacePortion
parseMpcThd =
  Rational -> LovelacePortion
rationalToLovelacePortion
    (Rational -> LovelacePortion)
-> Parser Rational -> Parser LovelacePortion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [Char] -> Parser Rational
parseFraction [Char]
"max-mpc-thd" [Char]
"Proposed max mpc threshold."

parseProtocolVersion :: Parser ProtocolVersion
parseProtocolVersion :: Parser ProtocolVersion
parseProtocolVersion =
  Word16 -> Word16 -> Word8 -> ProtocolVersion
ProtocolVersion
    (Word16 -> Word16 -> Word8 -> ProtocolVersion)
-> Parser Word16 -> Parser (Word16 -> Word8 -> ProtocolVersion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> [Char] -> [Char] -> Parser Word16
forall a. Integral a => [Char] -> [Char] -> [Char] -> Parser a
parseWord [Char]
"protocol-version-major" [Char]
"Protocol version major." [Char]
"WORD16" :: Parser Word16)
    Parser (Word16 -> Word8 -> ProtocolVersion)
-> Parser Word16 -> Parser (Word8 -> ProtocolVersion)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Char] -> [Char] -> [Char] -> Parser Word16
forall a. Integral a => [Char] -> [Char] -> [Char] -> Parser a
parseWord [Char]
"protocol-version-minor" [Char]
"Protocol version minor." [Char]
"WORD16" :: Parser Word16)
    Parser (Word8 -> ProtocolVersion)
-> Parser Word8 -> Parser ProtocolVersion
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Char] -> [Char] -> [Char] -> Parser Word8
forall a. Integral a => [Char] -> [Char] -> [Char] -> Parser a
parseWord [Char]
"protocol-version-alt" [Char]
"Protocol version alt." [Char]
"WORD8" :: Parser Word8)

parseHeavyDelThd :: Parser Byron.LovelacePortion
parseHeavyDelThd :: Parser LovelacePortion
parseHeavyDelThd =
  Rational -> LovelacePortion
rationalToLovelacePortion
    (Rational -> LovelacePortion)
-> Parser Rational -> Parser LovelacePortion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [Char] -> Parser Rational
parseFraction [Char]
"heavy-del-thd" [Char]
"Proposed heavy delegation threshold."

parseUpdateVoteThd :: Parser Byron.LovelacePortion
parseUpdateVoteThd :: Parser LovelacePortion
parseUpdateVoteThd =
  Rational -> LovelacePortion
rationalToLovelacePortion
    (Rational -> LovelacePortion)
-> Parser Rational -> Parser LovelacePortion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [Char] -> Parser Rational
parseFraction [Char]
"update-vote-thd" [Char]
"Propose update vote threshold."

parseUpdateProposalThd :: Parser Byron.LovelacePortion
parseUpdateProposalThd :: Parser LovelacePortion
parseUpdateProposalThd =
  Rational -> LovelacePortion
rationalToLovelacePortion
    (Rational -> LovelacePortion)
-> Parser Rational -> Parser LovelacePortion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [Char] -> Parser Rational
parseFraction [Char]
"update-proposal-thd" [Char]
"Propose update proposal threshold."

parseUpdateProposalTTL :: Parser SlotNumber
parseUpdateProposalTTL :: Parser SlotNumber
parseUpdateProposalTTL =
  Word64 -> SlotNumber
SlotNumber
    (Word64 -> SlotNumber) -> Parser Word64 -> Parser SlotNumber
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
auto
      ( [Char] -> Mod OptionFields Word64
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"time-to-live"
          Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields Word64
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"WORD64"
          Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields Word64
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Proposed time for an update proposal to live."
      )

parseSoftforkRule :: Parser SoftforkRule
parseSoftforkRule :: Parser SoftforkRule
parseSoftforkRule =
  ( LovelacePortion
-> LovelacePortion -> LovelacePortion -> SoftforkRule
SoftforkRule (LovelacePortion
 -> LovelacePortion -> LovelacePortion -> SoftforkRule)
-> (Rational -> LovelacePortion)
-> Rational
-> LovelacePortion
-> LovelacePortion
-> SoftforkRule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> LovelacePortion
rationalToLovelacePortion
      (Rational -> LovelacePortion -> LovelacePortion -> SoftforkRule)
-> Parser Rational
-> Parser (LovelacePortion -> LovelacePortion -> SoftforkRule)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [Char] -> Parser Rational
parseFraction
        [Char]
"softfork-init-thd"
        [Char]
"Propose initial threshold (right after proposal is confirmed)."
  )
    Parser (LovelacePortion -> LovelacePortion -> SoftforkRule)
-> Parser LovelacePortion
-> Parser (LovelacePortion -> SoftforkRule)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Rational -> LovelacePortion
rationalToLovelacePortion
            (Rational -> LovelacePortion)
-> Parser Rational -> Parser LovelacePortion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [Char] -> Parser Rational
parseFraction [Char]
"softfork-min-thd" [Char]
"Propose minimum threshold (threshold can't be less than this)."
        )
    Parser (LovelacePortion -> SoftforkRule)
-> Parser LovelacePortion -> Parser SoftforkRule
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Rational -> LovelacePortion
rationalToLovelacePortion
            (Rational -> LovelacePortion)
-> Parser Rational -> Parser LovelacePortion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [Char] -> Parser Rational
parseFraction
              [Char]
"softfork-thd-dec"
              [Char]
"Propose threshold decrement (threshold will decrease by this amount after each epoch)."
        )

parseSoftwareVersion :: Parser SoftwareVersion
parseSoftwareVersion :: Parser SoftwareVersion
parseSoftwareVersion =
  ApplicationName -> Word32 -> SoftwareVersion
SoftwareVersion (ApplicationName -> Word32 -> SoftwareVersion)
-> Parser ApplicationName -> Parser (Word32 -> SoftwareVersion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ApplicationName
parseApplicationName Parser (Word32 -> SoftwareVersion)
-> Parser Word32 -> Parser SoftwareVersion
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word32
parseNumSoftwareVersion

parseApplicationName :: Parser ApplicationName
parseApplicationName :: Parser ApplicationName
parseApplicationName =
  ReadM ApplicationName
-> Mod OptionFields ApplicationName -> Parser ApplicationName
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
    (([Char] -> Either [Char] ApplicationName) -> ReadM ApplicationName
forall a. ([Char] -> Either [Char] a) -> ReadM a
eitherReader [Char] -> Either [Char] ApplicationName
checkAppNameLength)
    ( [Char] -> Mod OptionFields ApplicationName
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"application-name"
        Mod OptionFields ApplicationName
-> Mod OptionFields ApplicationName
-> Mod OptionFields ApplicationName
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields ApplicationName
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"STRING"
        Mod OptionFields ApplicationName
-> Mod OptionFields ApplicationName
-> Mod OptionFields ApplicationName
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields ApplicationName
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"The name of the application."
    )
 where
  checkAppNameLength :: String -> Either String ApplicationName
  checkAppNameLength :: [Char] -> Either [Char] ApplicationName
checkAppNameLength [Char]
name =
    let appName :: ApplicationName
appName = Text -> ApplicationName
ApplicationName (Text -> ApplicationName) -> Text -> ApplicationName
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
Text.pack [Char]
name
     in case ApplicationName -> Either ApplicationNameError ()
forall (m :: * -> *).
MonadError ApplicationNameError m =>
ApplicationName -> m ()
checkApplicationName ApplicationName
appName of
          Left ApplicationNameError
err -> [Char] -> Either [Char] ApplicationName
forall a b. a -> Either a b
Left ([Char] -> Either [Char] ApplicationName)
-> (Text -> [Char]) -> Text -> Either [Char] ApplicationName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
Text.unpack (Text -> Either [Char] ApplicationName)
-> Text -> Either [Char] ApplicationName
forall a b. (a -> b) -> a -> b
$ Format Text (ApplicationNameError -> Text)
-> ApplicationNameError -> Text
forall a. Format Text a -> a
sformat Format Text (ApplicationNameError -> Text)
forall a r. Buildable a => Format r (a -> r)
build ApplicationNameError
err
          Right () -> ApplicationName -> Either [Char] ApplicationName
forall a b. b -> Either a b
Right ApplicationName
appName

parseNumSoftwareVersion :: Parser NumSoftwareVersion
parseNumSoftwareVersion :: Parser Word32
parseNumSoftwareVersion =
  [Char] -> [Char] -> [Char] -> Parser Word32
forall a. Integral a => [Char] -> [Char] -> [Char] -> Parser a
parseWord
    [Char]
"software-version-num"
    [Char]
"Numeric software version associated with application name."
    [Char]
"WORD32"

parseTxFeePolicy :: Parser TxFeePolicy
parseTxFeePolicy :: Parser TxFeePolicy
parseTxFeePolicy =
  TxSizeLinear -> TxFeePolicy
TxFeePolicyTxSizeLinear
    (TxSizeLinear -> TxFeePolicy)
-> Parser TxSizeLinear -> Parser TxFeePolicy
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Lovelace -> Rational -> TxSizeLinear
TxSizeLinear
            (Lovelace -> Rational -> TxSizeLinear)
-> Parser Lovelace -> Parser (Rational -> TxSizeLinear)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [Char] -> Parser Lovelace
parseLovelace [Char]
"tx-fee-a-constant" [Char]
"Propose the constant a for txfee = a + b*s where s is the size."
            Parser (Rational -> TxSizeLinear)
-> Parser Rational -> Parser TxSizeLinear
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> [Char] -> Parser Rational
parseFraction [Char]
"tx-fee-b-constant" [Char]
"Propose the constant b for txfee = a + b*s where s is the size."
        )

parseVoteBool :: Parser Bool
parseVoteBool :: Parser Bool
parseVoteBool =
  Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> Mod FlagFields a -> Parser a
flag' Bool
True ([Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"vote-yes" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Vote yes with respect to an update proposal.")
    Parser Bool -> Parser Bool -> Parser Bool
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> Mod FlagFields a -> Parser a
flag' Bool
False ([Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"vote-no" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Vote no with respect to an update proposal.")

parseUnlockStakeEpoch :: Parser EpochNumber
parseUnlockStakeEpoch :: Parser EpochNumber
parseUnlockStakeEpoch =
  Word64 -> EpochNumber
EpochNumber
    (Word64 -> EpochNumber) -> Parser Word64 -> Parser EpochNumber
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
auto
      ( [Char] -> Mod OptionFields Word64
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"unlock-stake-epoch"
          Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields Word64
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"WORD64"
          Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields Word64
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Proposed epoch to unlock all stake."
      )

parseWord :: Integral a => String -> String -> String -> Parser a
parseWord :: forall a. Integral a => [Char] -> [Char] -> [Char] -> Parser a
parseWord [Char]
optname [Char]
desc [Char]
metvar =
  ReadM a -> Mod OptionFields a -> Parser a
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer -> a) -> ReadM Integer -> ReadM a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Integer
forall a. Read a => ReadM a
auto) (Mod OptionFields a -> Parser a) -> Mod OptionFields a -> Parser a
forall a b. (a -> b) -> a -> b
$
    [Char] -> Mod OptionFields a
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
optname Mod OptionFields a -> Mod OptionFields a -> Mod OptionFields a
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields a
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
metvar Mod OptionFields a -> Mod OptionFields a -> Mod OptionFields a
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields a
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
desc

parseAddress :: String -> String -> Parser (Address ByronAddr)
parseAddress :: [Char] -> [Char] -> Parser (Address ByronAddr)
parseAddress [Char]
opt [Char]
desc =
  ReadM (Address ByronAddr)
-> Mod OptionFields (Address ByronAddr)
-> Parser (Address ByronAddr)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Text -> Address ByronAddr
cliParseBase58Address (Text -> Address ByronAddr)
-> ReadM Text -> ReadM (Address ByronAddr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Text
forall s. IsString s => ReadM s
str) (Mod OptionFields (Address ByronAddr)
 -> Parser (Address ByronAddr))
-> Mod OptionFields (Address ByronAddr)
-> Parser (Address ByronAddr)
forall a b. (a -> b) -> a -> b
$
    [Char] -> Mod OptionFields (Address ByronAddr)
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
opt Mod OptionFields (Address ByronAddr)
-> Mod OptionFields (Address ByronAddr)
-> Mod OptionFields (Address ByronAddr)
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields (Address ByronAddr)
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"ADDR" Mod OptionFields (Address ByronAddr)
-> Mod OptionFields (Address ByronAddr)
-> Mod OptionFields (Address ByronAddr)
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields (Address ByronAddr)
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
desc

parseByronKeyFormat :: Parser ByronKeyFormat
parseByronKeyFormat :: Parser ByronKeyFormat
parseByronKeyFormat =
  [Parser ByronKeyFormat] -> Parser ByronKeyFormat
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ ByronKeyFormat
-> Mod FlagFields ByronKeyFormat -> Parser ByronKeyFormat
forall a. a -> Mod FlagFields a -> Parser a
flag' ByronKeyFormat
LegacyByronKeyFormat (Mod FlagFields ByronKeyFormat -> Parser ByronKeyFormat)
-> Mod FlagFields ByronKeyFormat -> Parser ByronKeyFormat
forall a b. (a -> b) -> a -> b
$
        [Char] -> Mod FlagFields ByronKeyFormat
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"byron-legacy-formats"
          Mod FlagFields ByronKeyFormat
-> Mod FlagFields ByronKeyFormat -> Mod FlagFields ByronKeyFormat
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields ByronKeyFormat
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Byron/cardano-sl formats and compatibility"
    , ByronKeyFormat
-> Mod FlagFields ByronKeyFormat -> Parser ByronKeyFormat
forall a. a -> Mod FlagFields a -> Parser a
flag' ByronKeyFormat
NonLegacyByronKeyFormat (Mod FlagFields ByronKeyFormat -> Parser ByronKeyFormat)
-> Mod FlagFields ByronKeyFormat -> Parser ByronKeyFormat
forall a b. (a -> b) -> a -> b
$
        [Char] -> Mod FlagFields ByronKeyFormat
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"byron-formats"
          Mod FlagFields ByronKeyFormat
-> Mod FlagFields ByronKeyFormat -> Mod FlagFields ByronKeyFormat
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields ByronKeyFormat
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Byron era formats and compatibility"
    , -- And hidden compatibility flag aliases that should be deprecated:
      ByronKeyFormat
-> Mod FlagFields ByronKeyFormat -> Parser ByronKeyFormat
forall a. a -> Mod FlagFields a -> Parser a
flag' ByronKeyFormat
LegacyByronKeyFormat (Mod FlagFields ByronKeyFormat -> Parser ByronKeyFormat)
-> Mod FlagFields ByronKeyFormat -> Parser ByronKeyFormat
forall a b. (a -> b) -> a -> b
$ Mod FlagFields ByronKeyFormat
forall (f :: * -> *) a. Mod f a
hidden Mod FlagFields ByronKeyFormat
-> Mod FlagFields ByronKeyFormat -> Mod FlagFields ByronKeyFormat
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields ByronKeyFormat
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"byron-legacy"
    , ByronKeyFormat
-> Mod FlagFields ByronKeyFormat -> Parser ByronKeyFormat
forall a. a -> Mod FlagFields a -> Parser a
flag' ByronKeyFormat
NonLegacyByronKeyFormat (Mod FlagFields ByronKeyFormat -> Parser ByronKeyFormat)
-> Mod FlagFields ByronKeyFormat -> Parser ByronKeyFormat
forall a b. (a -> b) -> a -> b
$ Mod FlagFields ByronKeyFormat
forall (f :: * -> *) a. Mod f a
hidden Mod FlagFields ByronKeyFormat
-> Mod FlagFields ByronKeyFormat -> Mod FlagFields ByronKeyFormat
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields ByronKeyFormat
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"real-pbft"
    , -- Default Byron key format
      ByronKeyFormat -> Parser ByronKeyFormat
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByronKeyFormat
NonLegacyByronKeyFormat
    ]

parseFakeAvvmOptions :: Parser FakeAvvmOptions
parseFakeAvvmOptions :: Parser FakeAvvmOptions
parseFakeAvvmOptions =
  Word -> Lovelace -> FakeAvvmOptions
FakeAvvmOptions
    (Word -> Lovelace -> FakeAvvmOptions)
-> Parser Word -> Parser (Lovelace -> FakeAvvmOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [Char] -> Parser Word
forall a. Integral a => [Char] -> [Char] -> Parser a
parseIntegral [Char]
"avvm-entry-count" [Char]
"Number of AVVM addresses."
    Parser (Lovelace -> FakeAvvmOptions)
-> Parser Lovelace -> Parser FakeAvvmOptions
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> [Char] -> Parser Lovelace
parseLovelace [Char]
"avvm-entry-balance" [Char]
"AVVM address."

parseK :: Parser BlockCount
parseK :: Parser BlockCount
parseK =
  Word64 -> BlockCount
BlockCount
    (Word64 -> BlockCount) -> Parser Word64 -> Parser BlockCount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [Char] -> Parser Word64
forall a. Integral a => [Char] -> [Char] -> Parser a
parseIntegral [Char]
"k" [Char]
"The security parameter of the Ouroboros protocol."

parseNewDirectory :: String -> String -> Parser NewDirectory
parseNewDirectory :: [Char] -> [Char] -> Parser NewDirectory
parseNewDirectory [Char]
opt [Char]
desc = [Char] -> NewDirectory
NewDirectory ([Char] -> NewDirectory) -> Parser [Char] -> Parser NewDirectory
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [Char] -> Parser [Char]
parseFilePath [Char]
opt [Char]
desc

parseFractionWithDefault
  :: String
  -> String
  -> Double
  -> Parser Rational
parseFractionWithDefault :: [Char] -> [Char] -> Double -> Parser Rational
parseFractionWithDefault [Char]
optname [Char]
desc Double
w =
  Double -> Rational
forall a. Real a => a -> Rational
toRational
    (Double -> Rational) -> Parser Double -> Parser Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Double -> Mod OptionFields Double -> Parser Double
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ReadM Double
readDouble
      ( [Char] -> Mod OptionFields Double
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
optname
          Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields Double
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"DOUBLE"
          Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields Double
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
desc
          Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> Double -> Mod OptionFields Double
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Double
w
      )

parseNewSigningKeyFile :: String -> Parser NewSigningKeyFile
parseNewSigningKeyFile :: [Char] -> Parser NewSigningKeyFile
parseNewSigningKeyFile [Char]
opt =
  [Char] -> NewSigningKeyFile
NewSigningKeyFile
    ([Char] -> NewSigningKeyFile)
-> Parser [Char] -> Parser NewSigningKeyFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [Char] -> Parser [Char]
parseFilePath [Char]
opt [Char]
"Non-existent file to write the signing key to."

parseNewTxFile :: String -> Parser NewTxFile
parseNewTxFile :: [Char] -> Parser NewTxFile
parseNewTxFile [Char]
opt =
  [Char] -> NewTxFile
NewTxFile
    ([Char] -> NewTxFile) -> Parser [Char] -> Parser NewTxFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [Char] -> Parser [Char]
parseFilePath [Char]
opt [Char]
"Non-existent file to write the signed transaction to."

parseNewVerificationKeyFile :: String -> Parser NewVerificationKeyFile
parseNewVerificationKeyFile :: [Char] -> Parser NewVerificationKeyFile
parseNewVerificationKeyFile [Char]
opt =
  [Char] -> NewVerificationKeyFile
NewVerificationKeyFile
    ([Char] -> NewVerificationKeyFile)
-> Parser [Char] -> Parser NewVerificationKeyFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [Char] -> Parser [Char]
parseFilePath [Char]
opt [Char]
"Non-existent file to write the verification key to."

parseProtocolMagicId :: String -> Parser ProtocolMagicId
parseProtocolMagicId :: [Char] -> Parser ProtocolMagicId
parseProtocolMagicId [Char]
arg =
  Word32 -> ProtocolMagicId
ProtocolMagicId
    (Word32 -> ProtocolMagicId)
-> Parser Word32 -> Parser ProtocolMagicId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [Char] -> Parser Word32
forall a. Integral a => [Char] -> [Char] -> Parser a
parseIntegral [Char]
arg [Char]
"The magic number unique to any instance of Cardano."

parseProtocolMagic :: Parser ProtocolMagic
parseProtocolMagic :: Parser ProtocolMagic
parseProtocolMagic =
  (Annotated ProtocolMagicId ()
 -> RequiresNetworkMagic -> ProtocolMagic)
-> RequiresNetworkMagic
-> Annotated ProtocolMagicId ()
-> ProtocolMagic
forall a b c. (a -> b -> c) -> b -> a -> c
flip Annotated ProtocolMagicId ()
-> RequiresNetworkMagic -> ProtocolMagic
forall a.
Annotated ProtocolMagicId a
-> RequiresNetworkMagic -> AProtocolMagic a
AProtocolMagic RequiresNetworkMagic
RequiresMagic (Annotated ProtocolMagicId () -> ProtocolMagic)
-> (ProtocolMagicId -> Annotated ProtocolMagicId ())
-> ProtocolMagicId
-> ProtocolMagic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtocolMagicId -> () -> Annotated ProtocolMagicId ())
-> () -> ProtocolMagicId -> Annotated ProtocolMagicId ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ProtocolMagicId -> () -> Annotated ProtocolMagicId ()
forall b a. b -> a -> Annotated b a
L.Annotated ()
    (ProtocolMagicId -> ProtocolMagic)
-> Parser ProtocolMagicId -> Parser ProtocolMagic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Parser ProtocolMagicId
parseProtocolMagicId [Char]
"protocol-magic"

parseTxFile :: String -> Parser (TxFile In)
parseTxFile :: [Char] -> Parser (TxFile 'In)
parseTxFile [Char]
opt =
  [Char] -> TxFile 'In
forall content (direction :: FileDirection).
[Char] -> File content direction
File
    ([Char] -> TxFile 'In) -> Parser [Char] -> Parser (TxFile 'In)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [Char] -> Parser [Char]
parseFilePath [Char]
opt [Char]
"File containing the signed transaction."

parseUTCTime :: String -> String -> Parser UTCTime
parseUTCTime :: [Char] -> [Char] -> Parser UTCTime
parseUTCTime [Char]
optname [Char]
desc =
  ReadM UTCTime -> Mod OptionFields UTCTime -> Parser UTCTime
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime)
-> (Integer -> POSIXTime) -> Integer -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> POSIXTime
forall a. Num a => Integer -> a
fromInteger (Integer -> UTCTime) -> ReadM Integer -> ReadM UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Integer
forall a. Read a => ReadM a
auto) (Mod OptionFields UTCTime -> Parser UTCTime)
-> Mod OptionFields UTCTime -> Parser UTCTime
forall a b. (a -> b) -> a -> b
$
    [Char] -> Mod OptionFields UTCTime
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
optname Mod OptionFields UTCTime
-> Mod OptionFields UTCTime -> Mod OptionFields UTCTime
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields UTCTime
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"POSIXSECONDS" Mod OptionFields UTCTime
-> Mod OptionFields UTCTime -> Mod OptionFields UTCTime
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields UTCTime
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
desc

cliParseBase58Address :: Text -> Address ByronAddr
cliParseBase58Address :: Text -> Address ByronAddr
cliParseBase58Address Text
t =
  case Text -> Either DecoderError Address
decodeAddressBase58 Text
t of
    Left DecoderError
err -> [Char] -> Address ByronAddr
forall a. HasCallStack => [Char] -> a
error ([Char] -> Address ByronAddr) -> [Char] -> Address ByronAddr
forall a b. (a -> b) -> a -> b
$ [Char]
"Bad Base58 address: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> DecoderError -> [Char]
forall a. Show a => a -> [Char]
show DecoderError
err
    Right Address
byronAddress -> Address -> Address ByronAddr
ByronAddress Address
byronAddress

parseFraction :: String -> String -> Parser Rational
parseFraction :: [Char] -> [Char] -> Parser Rational
parseFraction [Char]
optname [Char]
desc =
  ReadM Rational -> Mod OptionFields Rational -> Parser Rational
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> Rational) -> ReadM Double -> ReadM Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Double
readDouble) (Mod OptionFields Rational -> Parser Rational)
-> Mod OptionFields Rational -> Parser Rational
forall a b. (a -> b) -> a -> b
$
    [Char] -> Mod OptionFields Rational
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
optname
      Mod OptionFields Rational
-> Mod OptionFields Rational -> Mod OptionFields Rational
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields Rational
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"DOUBLE"
      Mod OptionFields Rational
-> Mod OptionFields Rational -> Mod OptionFields Rational
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields Rational
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
desc

parseIntegral :: Integral a => String -> String -> Parser a
parseIntegral :: forall a. Integral a => [Char] -> [Char] -> Parser a
parseIntegral [Char]
optname [Char]
desc =
  ReadM a -> Mod OptionFields a -> Parser a
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer -> a) -> ReadM Integer -> ReadM a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Integer
forall a. Read a => ReadM a
auto) (Mod OptionFields a -> Parser a) -> Mod OptionFields a -> Parser a
forall a b. (a -> b) -> a -> b
$
    [Char] -> Mod OptionFields a
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
optname Mod OptionFields a -> Mod OptionFields a -> Mod OptionFields a
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields a
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"INT" Mod OptionFields a -> Mod OptionFields a -> Mod OptionFields a
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields a
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
desc

parseLovelace :: String -> String -> Parser Byron.Lovelace
parseLovelace :: [Char] -> [Char] -> Parser Lovelace
parseLovelace [Char]
optname [Char]
desc =
  ReadM Lovelace -> Mod OptionFields Lovelace -> Parser Lovelace
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
    (Parser Lovelace -> ReadM Lovelace
forall a. Parser a -> ReadM a
readerFromAttoParser Parser Lovelace
parseLovelaceAtto)
    ( [Char] -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
optname
        Mod OptionFields Lovelace
-> Mod OptionFields Lovelace -> Mod OptionFields Lovelace
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"INT"
        Mod OptionFields Lovelace
-> Mod OptionFields Lovelace -> Mod OptionFields Lovelace
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields Lovelace
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
desc
    )
 where
  parseLovelaceAtto :: Atto.Parser Byron.Lovelace
  parseLovelaceAtto :: Parser Lovelace
parseLovelaceAtto = do
    Integer
i <- Parser Integer
forall a. Integral a => Parser a
Atto.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 [Char] -> Parser Lovelace
forall a. [Char] -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser Lovelace) -> [Char] -> Parser Lovelace
forall a b. (a -> b) -> a -> b
$ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
i [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" lovelace exceeds the Word64 upper bound"
      else case Coin -> Maybe Lovelace
toByronLovelace (Coin -> Maybe Lovelace) -> Coin -> Maybe Lovelace
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
L.Coin Integer
i of
        Just Lovelace
byronLovelace -> Lovelace -> Parser Lovelace
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return Lovelace
byronLovelace
        Maybe Lovelace
Nothing -> [Char] -> Parser Lovelace
forall a. HasCallStack => [Char] -> a
error ([Char] -> Parser Lovelace) -> [Char] -> Parser Lovelace
forall a b. (a -> b) -> a -> b
$ [Char]
"Error converting lovelace: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
i

readDouble :: ReadM Double
readDouble :: ReadM Double
readDouble = do
  Double
f <- ReadM Double
forall a. Read a => ReadM a
auto
  Bool -> ReadM () -> ReadM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
f Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0) (ReadM () -> ReadM ()) -> ReadM () -> ReadM ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ReadM ()
forall a. [Char] -> ReadM a
readerError [Char]
"fraction must be >= 0"
  Bool -> ReadM () -> ReadM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
f Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
1) (ReadM () -> ReadM ()) -> ReadM () -> ReadM ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ReadM ()
forall a. [Char] -> ReadM a
readerError [Char]
"fraction must be <= 1"
  Double -> ReadM Double
forall a. a -> ReadM a
forall (m :: * -> *) a. Monad m => a -> m a
return Double
f

parseSigningKeyFile :: String -> String -> Parser (SigningKeyFile In)
parseSigningKeyFile :: [Char] -> [Char] -> Parser (SigningKeyFile 'In)
parseSigningKeyFile [Char]
opt [Char]
desc = [Char] -> SigningKeyFile 'In
forall content (direction :: FileDirection).
[Char] -> File content direction
File ([Char] -> SigningKeyFile 'In)
-> Parser [Char] -> Parser (SigningKeyFile 'In)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [Char] -> Parser [Char]
parseFilePath [Char]
opt [Char]
desc

parseGenesisFile :: String -> Parser GenesisFile
parseGenesisFile :: [Char] -> Parser GenesisFile
parseGenesisFile [Char]
opt =
  [Char] -> GenesisFile
GenesisFile ([Char] -> GenesisFile) -> Parser [Char] -> Parser GenesisFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [Char] -> Parser [Char]
parseFilePath [Char]
opt [Char]
"Genesis JSON file."