{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.CLI.EraBased.Genesis.Option
  ( pGenesisCmds
  )
where

import Cardano.Api hiding (QueryInShelleyBasedEra (..))
import Cardano.Api.Experimental qualified as Exp

import Cardano.CLI.Environment (EnvCli (..))
import Cardano.CLI.EraBased.Common.Option
import Cardano.CLI.EraBased.Genesis.Command
import Cardano.CLI.Parser
import Cardano.CLI.Type.Common
import Cardano.Ledger.BaseTypes (NonZero, knownNonZeroBounded)

import Data.Maybe
import Data.Word (Word64)
import Options.Applicative hiding (help, str)
import Options.Applicative qualified as Opt

pGenesisCmds
  :: Exp.IsEra era
  => EnvCli
  -> Maybe (Parser (GenesisCmds era))
pGenesisCmds :: forall era. IsEra era => EnvCli -> Maybe (Parser (GenesisCmds era))
pGenesisCmds EnvCli
envCli =
  FilePath
-> InfoMod (GenesisCmds era)
-> [Maybe (Parser (GenesisCmds era))]
-> Maybe (Parser (GenesisCmds era))
forall a.
FilePath -> InfoMod a -> [Maybe (Parser a)] -> Maybe (Parser a)
subInfoParser
    FilePath
"genesis"
    ( FilePath -> InfoMod (GenesisCmds era)
forall a. FilePath -> InfoMod a
Opt.progDesc (FilePath -> InfoMod (GenesisCmds era))
-> FilePath -> InfoMod (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
        [FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat
          [ FilePath
"Genesis block commands."
          ]
    )
    ([Maybe (Parser (GenesisCmds era))]
 -> Maybe (Parser (GenesisCmds era)))
-> [Maybe (Parser (GenesisCmds era))]
-> Maybe (Parser (GenesisCmds era))
forall a b. (a -> b) -> a -> b
$ (Parser (GenesisCmds era) -> Maybe (Parser (GenesisCmds era)))
-> [Parser (GenesisCmds era)] -> [Maybe (Parser (GenesisCmds era))]
forall a b. (a -> b) -> [a] -> [b]
map
      Parser (GenesisCmds era) -> Maybe (Parser (GenesisCmds era))
forall a. a -> Maybe a
Just
      [ Mod CommandFields (GenesisCmds era) -> Parser (GenesisCmds era)
forall a. Mod CommandFields a -> Parser a
Opt.hsubparser (Mod CommandFields (GenesisCmds era) -> Parser (GenesisCmds era))
-> Mod CommandFields (GenesisCmds era) -> Parser (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
          FilePath
-> ParserInfo (GenesisCmds era)
-> Mod CommandFields (GenesisCmds era)
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
commandWithMetavar FilePath
"key-gen-genesis" (ParserInfo (GenesisCmds era)
 -> Mod CommandFields (GenesisCmds era))
-> ParserInfo (GenesisCmds era)
-> Mod CommandFields (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
            Parser (GenesisCmds era)
-> InfoMod (GenesisCmds era) -> ParserInfo (GenesisCmds era)
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser (GenesisCmds era)
forall era. Parser (GenesisCmds era)
pGenesisKeyGen (InfoMod (GenesisCmds era) -> ParserInfo (GenesisCmds era))
-> InfoMod (GenesisCmds era) -> ParserInfo (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
              FilePath -> InfoMod (GenesisCmds era)
forall a. FilePath -> InfoMod a
Opt.progDesc FilePath
"Create a Shelley genesis key pair"
      , Mod CommandFields (GenesisCmds era) -> Parser (GenesisCmds era)
forall a. Mod CommandFields a -> Parser a
Opt.hsubparser (Mod CommandFields (GenesisCmds era) -> Parser (GenesisCmds era))
-> Mod CommandFields (GenesisCmds era) -> Parser (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
          FilePath
-> ParserInfo (GenesisCmds era)
-> Mod CommandFields (GenesisCmds era)
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
commandWithMetavar FilePath
"key-gen-delegate" (ParserInfo (GenesisCmds era)
 -> Mod CommandFields (GenesisCmds era))
-> ParserInfo (GenesisCmds era)
-> Mod CommandFields (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
            Parser (GenesisCmds era)
-> InfoMod (GenesisCmds era) -> ParserInfo (GenesisCmds era)
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser (GenesisCmds era)
forall era. Parser (GenesisCmds era)
pGenesisDelegateKeyGen (InfoMod (GenesisCmds era) -> ParserInfo (GenesisCmds era))
-> InfoMod (GenesisCmds era) -> ParserInfo (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
              FilePath -> InfoMod (GenesisCmds era)
forall a. FilePath -> InfoMod a
Opt.progDesc FilePath
"Create a Shelley genesis delegate key pair"
      , Mod CommandFields (GenesisCmds era) -> Parser (GenesisCmds era)
forall a. Mod CommandFields a -> Parser a
Opt.hsubparser (Mod CommandFields (GenesisCmds era) -> Parser (GenesisCmds era))
-> Mod CommandFields (GenesisCmds era) -> Parser (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
          FilePath
-> ParserInfo (GenesisCmds era)
-> Mod CommandFields (GenesisCmds era)
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
commandWithMetavar FilePath
"key-gen-utxo" (ParserInfo (GenesisCmds era)
 -> Mod CommandFields (GenesisCmds era))
-> ParserInfo (GenesisCmds era)
-> Mod CommandFields (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
            Parser (GenesisCmds era)
-> InfoMod (GenesisCmds era) -> ParserInfo (GenesisCmds era)
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser (GenesisCmds era)
forall era. Parser (GenesisCmds era)
pGenesisUTxOKeyGen (InfoMod (GenesisCmds era) -> ParserInfo (GenesisCmds era))
-> InfoMod (GenesisCmds era) -> ParserInfo (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
              FilePath -> InfoMod (GenesisCmds era)
forall a. FilePath -> InfoMod a
Opt.progDesc FilePath
"Create a Shelley genesis UTxO key pair"
      , Mod CommandFields (GenesisCmds era) -> Parser (GenesisCmds era)
forall a. Mod CommandFields a -> Parser a
Opt.hsubparser (Mod CommandFields (GenesisCmds era) -> Parser (GenesisCmds era))
-> Mod CommandFields (GenesisCmds era) -> Parser (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
          FilePath
-> ParserInfo (GenesisCmds era)
-> Mod CommandFields (GenesisCmds era)
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
commandWithMetavar FilePath
"key-hash" (ParserInfo (GenesisCmds era)
 -> Mod CommandFields (GenesisCmds era))
-> ParserInfo (GenesisCmds era)
-> Mod CommandFields (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
            Parser (GenesisCmds era)
-> InfoMod (GenesisCmds era) -> ParserInfo (GenesisCmds era)
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser (GenesisCmds era)
forall era. Parser (GenesisCmds era)
pGenesisKeyHash (InfoMod (GenesisCmds era) -> ParserInfo (GenesisCmds era))
-> InfoMod (GenesisCmds era) -> ParserInfo (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
              FilePath -> InfoMod (GenesisCmds era)
forall a. FilePath -> InfoMod a
Opt.progDesc FilePath
"Print the identifier (hash) of a public key"
      , Mod CommandFields (GenesisCmds era) -> Parser (GenesisCmds era)
forall a. Mod CommandFields a -> Parser a
Opt.hsubparser (Mod CommandFields (GenesisCmds era) -> Parser (GenesisCmds era))
-> Mod CommandFields (GenesisCmds era) -> Parser (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
          FilePath
-> ParserInfo (GenesisCmds era)
-> Mod CommandFields (GenesisCmds era)
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
commandWithMetavar FilePath
"get-ver-key" (ParserInfo (GenesisCmds era)
 -> Mod CommandFields (GenesisCmds era))
-> ParserInfo (GenesisCmds era)
-> Mod CommandFields (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
            Parser (GenesisCmds era)
-> InfoMod (GenesisCmds era) -> ParserInfo (GenesisCmds era)
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser (GenesisCmds era)
forall era. Parser (GenesisCmds era)
pGenesisVerKey (InfoMod (GenesisCmds era) -> ParserInfo (GenesisCmds era))
-> InfoMod (GenesisCmds era) -> ParserInfo (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
              FilePath -> InfoMod (GenesisCmds era)
forall a. FilePath -> InfoMod a
Opt.progDesc FilePath
"Derive the verification key from a signing key"
      , Mod CommandFields (GenesisCmds era) -> Parser (GenesisCmds era)
forall a. Mod CommandFields a -> Parser a
Opt.hsubparser (Mod CommandFields (GenesisCmds era) -> Parser (GenesisCmds era))
-> Mod CommandFields (GenesisCmds era) -> Parser (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
          FilePath
-> ParserInfo (GenesisCmds era)
-> Mod CommandFields (GenesisCmds era)
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
commandWithMetavar FilePath
"initial-addr" (ParserInfo (GenesisCmds era)
 -> Mod CommandFields (GenesisCmds era))
-> ParserInfo (GenesisCmds era)
-> Mod CommandFields (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
            Parser (GenesisCmds era)
-> InfoMod (GenesisCmds era) -> ParserInfo (GenesisCmds era)
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (EnvCli -> Parser (GenesisCmds era)
forall era. EnvCli -> Parser (GenesisCmds era)
pGenesisAddr EnvCli
envCli) (InfoMod (GenesisCmds era) -> ParserInfo (GenesisCmds era))
-> InfoMod (GenesisCmds era) -> ParserInfo (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
              FilePath -> InfoMod (GenesisCmds era)
forall a. FilePath -> InfoMod a
Opt.progDesc FilePath
"Get the address for an initial UTxO based on the verification key"
      , Mod CommandFields (GenesisCmds era) -> Parser (GenesisCmds era)
forall a. Mod CommandFields a -> Parser a
Opt.hsubparser (Mod CommandFields (GenesisCmds era) -> Parser (GenesisCmds era))
-> Mod CommandFields (GenesisCmds era) -> Parser (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
          FilePath
-> ParserInfo (GenesisCmds era)
-> Mod CommandFields (GenesisCmds era)
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
commandWithMetavar FilePath
"initial-txin" (ParserInfo (GenesisCmds era)
 -> Mod CommandFields (GenesisCmds era))
-> ParserInfo (GenesisCmds era)
-> Mod CommandFields (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
            Parser (GenesisCmds era)
-> InfoMod (GenesisCmds era) -> ParserInfo (GenesisCmds era)
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (EnvCli -> Parser (GenesisCmds era)
forall era. EnvCli -> Parser (GenesisCmds era)
pGenesisTxIn EnvCli
envCli) (InfoMod (GenesisCmds era) -> ParserInfo (GenesisCmds era))
-> InfoMod (GenesisCmds era) -> ParserInfo (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
              FilePath -> InfoMod (GenesisCmds era)
forall a. FilePath -> InfoMod a
Opt.progDesc FilePath
"Get the TxIn for an initial UTxO based on the verification key"
      , Mod CommandFields (GenesisCmds era) -> Parser (GenesisCmds era)
forall a. Mod CommandFields a -> Parser a
Opt.hsubparser (Mod CommandFields (GenesisCmds era) -> Parser (GenesisCmds era))
-> Mod CommandFields (GenesisCmds era) -> Parser (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
          FilePath
-> ParserInfo (GenesisCmds era)
-> Mod CommandFields (GenesisCmds era)
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
commandWithMetavar FilePath
"create-cardano" (ParserInfo (GenesisCmds era)
 -> Mod CommandFields (GenesisCmds era))
-> ParserInfo (GenesisCmds era)
-> Mod CommandFields (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
            Parser (GenesisCmds era)
-> InfoMod (GenesisCmds era) -> ParserInfo (GenesisCmds era)
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (EnvCli -> Parser (GenesisCmds era)
forall era. IsEra era => EnvCli -> Parser (GenesisCmds era)
pGenesisCreateCardano EnvCli
envCli) (InfoMod (GenesisCmds era) -> ParserInfo (GenesisCmds era))
-> InfoMod (GenesisCmds era) -> ParserInfo (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
              FilePath -> InfoMod (GenesisCmds era)
forall a. FilePath -> InfoMod a
Opt.progDesc (FilePath -> InfoMod (GenesisCmds era))
-> FilePath -> InfoMod (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
                [FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat
                  [ FilePath
"Create a Byron and Shelley genesis file from a genesis "
                  , FilePath
"template and genesis/delegation/spending keys."
                  ]
      , Mod CommandFields (GenesisCmds era) -> Parser (GenesisCmds era)
forall a. Mod CommandFields a -> Parser a
Opt.hsubparser (Mod CommandFields (GenesisCmds era) -> Parser (GenesisCmds era))
-> Mod CommandFields (GenesisCmds era) -> Parser (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
          FilePath
-> ParserInfo (GenesisCmds era)
-> Mod CommandFields (GenesisCmds era)
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
commandWithMetavar FilePath
"create" (ParserInfo (GenesisCmds era)
 -> Mod CommandFields (GenesisCmds era))
-> ParserInfo (GenesisCmds era)
-> Mod CommandFields (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
            Parser (GenesisCmds era)
-> InfoMod (GenesisCmds era) -> ParserInfo (GenesisCmds era)
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (EnvCli -> Parser (GenesisCmds era)
forall era. IsEra era => EnvCli -> Parser (GenesisCmds era)
pGenesisCreate EnvCli
envCli) (InfoMod (GenesisCmds era) -> ParserInfo (GenesisCmds era))
-> InfoMod (GenesisCmds era) -> ParserInfo (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
              FilePath -> InfoMod (GenesisCmds era)
forall a. FilePath -> InfoMod a
Opt.progDesc (FilePath -> InfoMod (GenesisCmds era))
-> FilePath -> InfoMod (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
                [FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat
                  [ FilePath
"Create a Shelley genesis file from a genesis "
                  , FilePath
"template and genesis/delegation/spending keys."
                  ]
      , Mod CommandFields (GenesisCmds era) -> Parser (GenesisCmds era)
forall a. Mod CommandFields a -> Parser a
Opt.hsubparser (Mod CommandFields (GenesisCmds era) -> Parser (GenesisCmds era))
-> Mod CommandFields (GenesisCmds era) -> Parser (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
          FilePath
-> ParserInfo (GenesisCmds era)
-> Mod CommandFields (GenesisCmds era)
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
commandWithMetavar FilePath
"create-staked" (ParserInfo (GenesisCmds era)
 -> Mod CommandFields (GenesisCmds era))
-> ParserInfo (GenesisCmds era)
-> Mod CommandFields (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
            Parser (GenesisCmds era)
-> InfoMod (GenesisCmds era) -> ParserInfo (GenesisCmds era)
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (EnvCli -> Parser (GenesisCmds era)
forall era. IsEra era => EnvCli -> Parser (GenesisCmds era)
pGenesisCreateStaked EnvCli
envCli) (InfoMod (GenesisCmds era) -> ParserInfo (GenesisCmds era))
-> InfoMod (GenesisCmds era) -> ParserInfo (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
              FilePath -> InfoMod (GenesisCmds era)
forall a. FilePath -> InfoMod a
Opt.progDesc (FilePath -> InfoMod (GenesisCmds era))
-> FilePath -> InfoMod (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
                [FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat
                  [ FilePath
"Create a staked Shelley genesis file from a genesis "
                  , FilePath
"template and genesis/delegation/spending keys."
                  ]
      , Mod CommandFields (GenesisCmds era) -> Parser (GenesisCmds era)
forall a. Mod CommandFields a -> Parser a
Opt.hsubparser (Mod CommandFields (GenesisCmds era) -> Parser (GenesisCmds era))
-> Mod CommandFields (GenesisCmds era) -> Parser (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
          FilePath
-> ParserInfo (GenesisCmds era)
-> Mod CommandFields (GenesisCmds era)
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
commandWithMetavar FilePath
"create-testnet-data" (ParserInfo (GenesisCmds era)
 -> Mod CommandFields (GenesisCmds era))
-> ParserInfo (GenesisCmds era)
-> Mod CommandFields (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
            Parser (GenesisCmds era)
-> InfoMod (GenesisCmds era) -> ParserInfo (GenesisCmds era)
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (EnvCli -> Parser (GenesisCmds era)
forall era. IsEra era => EnvCli -> Parser (GenesisCmds era)
pGenesisCreateTestNetData EnvCli
envCli) (InfoMod (GenesisCmds era) -> ParserInfo (GenesisCmds era))
-> InfoMod (GenesisCmds era) -> ParserInfo (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
              FilePath -> InfoMod (GenesisCmds era)
forall a. FilePath -> InfoMod a
Opt.progDesc (FilePath -> InfoMod (GenesisCmds era))
-> FilePath -> InfoMod (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
                [FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat
                  [ FilePath
"Create data to use for starting a testnet."
                  ]
      , Mod CommandFields (GenesisCmds era) -> Parser (GenesisCmds era)
forall a. Mod CommandFields a -> Parser a
Opt.hsubparser (Mod CommandFields (GenesisCmds era) -> Parser (GenesisCmds era))
-> Mod CommandFields (GenesisCmds era) -> Parser (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
          FilePath
-> ParserInfo (GenesisCmds era)
-> Mod CommandFields (GenesisCmds era)
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
commandWithMetavar FilePath
"hash" (ParserInfo (GenesisCmds era)
 -> Mod CommandFields (GenesisCmds era))
-> ParserInfo (GenesisCmds era)
-> Mod CommandFields (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
            Parser (GenesisCmds era)
-> InfoMod (GenesisCmds era) -> ParserInfo (GenesisCmds era)
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser (GenesisCmds era)
forall era. Parser (GenesisCmds era)
pGenesisHash (InfoMod (GenesisCmds era) -> ParserInfo (GenesisCmds era))
-> InfoMod (GenesisCmds era) -> ParserInfo (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
              FilePath -> InfoMod (GenesisCmds era)
forall a. FilePath -> InfoMod a
Opt.progDesc (FilePath -> InfoMod (GenesisCmds era))
-> FilePath -> InfoMod (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
                [FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat
                  [ FilePath
"DEPRECATION WARNING! This command is deprecated and will be "
                  , FilePath
"removed in a future release. Please use hash genesis-file "
                  , FilePath
"instead. "
                  , FilePath
"Compute the hash of a genesis file."
                  ]
      ]

pGenesisKeyGen :: Parser (GenesisCmds era)
pGenesisKeyGen :: forall era. Parser (GenesisCmds era)
pGenesisKeyGen =
  (GenesisKeyGenGenesisCmdArgs -> GenesisCmds era)
-> Parser GenesisKeyGenGenesisCmdArgs -> Parser (GenesisCmds era)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenesisKeyGenGenesisCmdArgs -> GenesisCmds era
forall era. GenesisKeyGenGenesisCmdArgs -> GenesisCmds era
GenesisKeyGenGenesis (Parser GenesisKeyGenGenesisCmdArgs -> Parser (GenesisCmds era))
-> Parser GenesisKeyGenGenesisCmdArgs -> Parser (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
    VerificationKeyFile 'Out
-> SigningKeyFile 'Out -> GenesisKeyGenGenesisCmdArgs
GenesisKeyGenGenesisCmdArgs
      (VerificationKeyFile 'Out
 -> SigningKeyFile 'Out -> GenesisKeyGenGenesisCmdArgs)
-> Parser (VerificationKeyFile 'Out)
-> Parser (SigningKeyFile 'Out -> GenesisKeyGenGenesisCmdArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyFile 'Out)
forall keyrole. Parser (File (VerificationKey keyrole) 'Out)
pVerificationKeyFileOut
      Parser (SigningKeyFile 'Out -> GenesisKeyGenGenesisCmdArgs)
-> Parser (SigningKeyFile 'Out)
-> Parser GenesisKeyGenGenesisCmdArgs
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (SigningKeyFile 'Out)
forall keyrole. Parser (File (SigningKey keyrole) 'Out)
pSigningKeyFileOut

pGenesisDelegateKeyGen :: Parser (GenesisCmds era)
pGenesisDelegateKeyGen :: forall era. Parser (GenesisCmds era)
pGenesisDelegateKeyGen =
  (GenesisKeyGenDelegateCmdArgs -> GenesisCmds era)
-> Parser GenesisKeyGenDelegateCmdArgs -> Parser (GenesisCmds era)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenesisKeyGenDelegateCmdArgs -> GenesisCmds era
forall era. GenesisKeyGenDelegateCmdArgs -> GenesisCmds era
GenesisKeyGenDelegate (Parser GenesisKeyGenDelegateCmdArgs -> Parser (GenesisCmds era))
-> Parser GenesisKeyGenDelegateCmdArgs -> Parser (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
    VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> OpCertCounterFile 'Out
-> GenesisKeyGenDelegateCmdArgs
GenesisKeyGenDelegateCmdArgs
      (VerificationKeyFile 'Out
 -> SigningKeyFile 'Out
 -> OpCertCounterFile 'Out
 -> GenesisKeyGenDelegateCmdArgs)
-> Parser (VerificationKeyFile 'Out)
-> Parser
     (SigningKeyFile 'Out
      -> OpCertCounterFile 'Out -> GenesisKeyGenDelegateCmdArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyFile 'Out)
forall keyrole. Parser (File (VerificationKey keyrole) 'Out)
pVerificationKeyFileOut
      Parser
  (SigningKeyFile 'Out
   -> OpCertCounterFile 'Out -> GenesisKeyGenDelegateCmdArgs)
-> Parser (SigningKeyFile 'Out)
-> Parser (OpCertCounterFile 'Out -> GenesisKeyGenDelegateCmdArgs)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (SigningKeyFile 'Out)
forall keyrole. Parser (File (SigningKey keyrole) 'Out)
pSigningKeyFileOut
      Parser (OpCertCounterFile 'Out -> GenesisKeyGenDelegateCmdArgs)
-> Parser (OpCertCounterFile 'Out)
-> Parser GenesisKeyGenDelegateCmdArgs
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (OpCertCounterFile 'Out)
forall (direction :: FileDirection).
Parser (File OpCertCounter direction)
pOperatorCertIssueCounterFile

pGenesisUTxOKeyGen :: Parser (GenesisCmds era)
pGenesisUTxOKeyGen :: forall era. Parser (GenesisCmds era)
pGenesisUTxOKeyGen =
  (GenesisKeyGenUTxOCmdArgs -> GenesisCmds era)
-> Parser GenesisKeyGenUTxOCmdArgs -> Parser (GenesisCmds era)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenesisKeyGenUTxOCmdArgs -> GenesisCmds era
forall era. GenesisKeyGenUTxOCmdArgs -> GenesisCmds era
GenesisKeyGenUTxO (Parser GenesisKeyGenUTxOCmdArgs -> Parser (GenesisCmds era))
-> Parser GenesisKeyGenUTxOCmdArgs -> Parser (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
    VerificationKeyFile 'Out
-> SigningKeyFile 'Out -> GenesisKeyGenUTxOCmdArgs
GenesisKeyGenUTxOCmdArgs
      (VerificationKeyFile 'Out
 -> SigningKeyFile 'Out -> GenesisKeyGenUTxOCmdArgs)
-> Parser (VerificationKeyFile 'Out)
-> Parser (SigningKeyFile 'Out -> GenesisKeyGenUTxOCmdArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyFile 'Out)
forall keyrole. Parser (File (VerificationKey keyrole) 'Out)
pVerificationKeyFileOut
      Parser (SigningKeyFile 'Out -> GenesisKeyGenUTxOCmdArgs)
-> Parser (SigningKeyFile 'Out) -> Parser GenesisKeyGenUTxOCmdArgs
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (SigningKeyFile 'Out)
forall keyrole. Parser (File (SigningKey keyrole) 'Out)
pSigningKeyFileOut

pGenesisKeyHash :: Parser (GenesisCmds era)
pGenesisKeyHash :: forall era. Parser (GenesisCmds era)
pGenesisKeyHash =
  VerificationKeyFile 'In -> GenesisCmds era
forall era. VerificationKeyFile 'In -> GenesisCmds era
GenesisCmdKeyHash
    (VerificationKeyFile 'In -> GenesisCmds era)
-> Parser (VerificationKeyFile 'In) -> Parser (GenesisCmds era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyFile 'In)
pVerificationKeyFileIn

pGenesisVerKey :: Parser (GenesisCmds era)
pGenesisVerKey :: forall era. Parser (GenesisCmds era)
pGenesisVerKey =
  (GenesisVerKeyCmdArgs -> GenesisCmds era)
-> Parser GenesisVerKeyCmdArgs -> Parser (GenesisCmds era)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenesisVerKeyCmdArgs -> GenesisCmds era
forall era. GenesisVerKeyCmdArgs -> GenesisCmds era
GenesisVerKey (Parser GenesisVerKeyCmdArgs -> Parser (GenesisCmds era))
-> Parser GenesisVerKeyCmdArgs -> Parser (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
    VerificationKeyFile 'Out
-> SigningKeyFile 'In -> GenesisVerKeyCmdArgs
GenesisVerKeyCmdArgs
      (VerificationKeyFile 'Out
 -> SigningKeyFile 'In -> GenesisVerKeyCmdArgs)
-> Parser (VerificationKeyFile 'Out)
-> Parser (SigningKeyFile 'In -> GenesisVerKeyCmdArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyFile 'Out)
forall keyrole. Parser (File (VerificationKey keyrole) 'Out)
pVerificationKeyFileOut
      Parser (SigningKeyFile 'In -> GenesisVerKeyCmdArgs)
-> Parser (SigningKeyFile 'In) -> Parser GenesisVerKeyCmdArgs
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (SigningKeyFile 'In)
pSigningKeyFileIn

pGenesisAddr :: EnvCli -> Parser (GenesisCmds era)
pGenesisAddr :: forall era. EnvCli -> Parser (GenesisCmds era)
pGenesisAddr EnvCli
envCli =
  (GenesisAddrCmdArgs -> GenesisCmds era)
-> Parser GenesisAddrCmdArgs -> Parser (GenesisCmds era)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenesisAddrCmdArgs -> GenesisCmds era
forall era. GenesisAddrCmdArgs -> GenesisCmds era
GenesisAddr (Parser GenesisAddrCmdArgs -> Parser (GenesisCmds era))
-> Parser GenesisAddrCmdArgs -> Parser (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
    VerificationKeyFile 'In
-> NetworkId -> Maybe (File () 'Out) -> GenesisAddrCmdArgs
GenesisAddrCmdArgs
      (VerificationKeyFile 'In
 -> NetworkId -> Maybe (File () 'Out) -> GenesisAddrCmdArgs)
-> Parser (VerificationKeyFile 'In)
-> Parser (NetworkId -> Maybe (File () 'Out) -> GenesisAddrCmdArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyFile 'In)
pVerificationKeyFileIn
      Parser (NetworkId -> Maybe (File () 'Out) -> GenesisAddrCmdArgs)
-> Parser NetworkId
-> Parser (Maybe (File () 'Out) -> GenesisAddrCmdArgs)
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 (Maybe (File () 'Out) -> GenesisAddrCmdArgs)
-> Parser (Maybe (File () 'Out)) -> Parser GenesisAddrCmdArgs
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe (File () 'Out))
forall content. Parser (Maybe (File content 'Out))
pMaybeOutputFile

pGenesisTxIn :: EnvCli -> Parser (GenesisCmds era)
pGenesisTxIn :: forall era. EnvCli -> Parser (GenesisCmds era)
pGenesisTxIn EnvCli
envCli =
  (GenesisTxInCmdArgs -> GenesisCmds era)
-> Parser GenesisTxInCmdArgs -> Parser (GenesisCmds era)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenesisTxInCmdArgs -> GenesisCmds era
forall era. GenesisTxInCmdArgs -> GenesisCmds era
GenesisTxIn (Parser GenesisTxInCmdArgs -> Parser (GenesisCmds era))
-> Parser GenesisTxInCmdArgs -> Parser (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
    VerificationKeyFile 'In
-> NetworkId -> Maybe (File () 'Out) -> GenesisTxInCmdArgs
GenesisTxInCmdArgs
      (VerificationKeyFile 'In
 -> NetworkId -> Maybe (File () 'Out) -> GenesisTxInCmdArgs)
-> Parser (VerificationKeyFile 'In)
-> Parser (NetworkId -> Maybe (File () 'Out) -> GenesisTxInCmdArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyFile 'In)
pVerificationKeyFileIn
      Parser (NetworkId -> Maybe (File () 'Out) -> GenesisTxInCmdArgs)
-> Parser NetworkId
-> Parser (Maybe (File () 'Out) -> GenesisTxInCmdArgs)
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 (Maybe (File () 'Out) -> GenesisTxInCmdArgs)
-> Parser (Maybe (File () 'Out)) -> Parser GenesisTxInCmdArgs
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe (File () 'Out))
forall content. Parser (Maybe (File content 'Out))
pMaybeOutputFile

pGenesisCreateCardano :: Exp.IsEra era => EnvCli -> Parser (GenesisCmds era)
pGenesisCreateCardano :: forall era. IsEra era => EnvCli -> Parser (GenesisCmds era)
pGenesisCreateCardano EnvCli
envCli =
  (GenesisCreateCardanoCmdArgs era -> GenesisCmds era)
-> Parser (GenesisCreateCardanoCmdArgs era)
-> Parser (GenesisCmds era)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenesisCreateCardanoCmdArgs era -> GenesisCmds era
forall era. GenesisCreateCardanoCmdArgs era -> GenesisCmds era
GenesisCreateCardano (Parser (GenesisCreateCardanoCmdArgs era)
 -> Parser (GenesisCmds era))
-> Parser (GenesisCreateCardanoCmdArgs era)
-> Parser (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
    Era era
-> GenesisDir
-> Word
-> Word
-> Maybe SystemStart
-> Maybe Coin
-> NonZero Word64
-> Word
-> Rational
-> NetworkId
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> Maybe FilePath
-> GenesisCreateCardanoCmdArgs era
forall era.
Era era
-> GenesisDir
-> Word
-> Word
-> Maybe SystemStart
-> Maybe Coin
-> NonZero Word64
-> Word
-> Rational
-> NetworkId
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> Maybe FilePath
-> GenesisCreateCardanoCmdArgs era
GenesisCreateCardanoCmdArgs (Era era -> Era era
forall era. Era era -> Era era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
forall era. IsEra era => Era era
Exp.useEra)
      (GenesisDir
 -> Word
 -> Word
 -> Maybe SystemStart
 -> Maybe Coin
 -> NonZero Word64
 -> Word
 -> Rational
 -> NetworkId
 -> FilePath
 -> FilePath
 -> FilePath
 -> FilePath
 -> Maybe FilePath
 -> GenesisCreateCardanoCmdArgs era)
-> Parser GenesisDir
-> Parser
     (Word
      -> Word
      -> Maybe SystemStart
      -> Maybe Coin
      -> NonZero Word64
      -> Word
      -> Rational
      -> NetworkId
      -> FilePath
      -> FilePath
      -> FilePath
      -> FilePath
      -> Maybe FilePath
      -> GenesisCreateCardanoCmdArgs era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser GenesisDir
pGenesisDir
      Parser
  (Word
   -> Word
   -> Maybe SystemStart
   -> Maybe Coin
   -> NonZero Word64
   -> Word
   -> Rational
   -> NetworkId
   -> FilePath
   -> FilePath
   -> FilePath
   -> FilePath
   -> Maybe FilePath
   -> GenesisCreateCardanoCmdArgs era)
-> Parser Word
-> Parser
     (Word
      -> Maybe SystemStart
      -> Maybe Coin
      -> NonZero Word64
      -> Word
      -> Rational
      -> NetworkId
      -> FilePath
      -> FilePath
      -> FilePath
      -> FilePath
      -> Maybe FilePath
      -> GenesisCreateCardanoCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word
pGenesisNumGenesisKeys
      Parser
  (Word
   -> Maybe SystemStart
   -> Maybe Coin
   -> NonZero Word64
   -> Word
   -> Rational
   -> NetworkId
   -> FilePath
   -> FilePath
   -> FilePath
   -> FilePath
   -> Maybe FilePath
   -> GenesisCreateCardanoCmdArgs era)
-> Parser Word
-> Parser
     (Maybe SystemStart
      -> Maybe Coin
      -> NonZero Word64
      -> Word
      -> Rational
      -> NetworkId
      -> FilePath
      -> FilePath
      -> FilePath
      -> FilePath
      -> Maybe FilePath
      -> GenesisCreateCardanoCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word
pGenesisNumUTxOKeys
      Parser
  (Maybe SystemStart
   -> Maybe Coin
   -> NonZero Word64
   -> Word
   -> Rational
   -> NetworkId
   -> FilePath
   -> FilePath
   -> FilePath
   -> FilePath
   -> Maybe FilePath
   -> GenesisCreateCardanoCmdArgs era)
-> Parser (Maybe SystemStart)
-> Parser
     (Maybe Coin
      -> NonZero Word64
      -> Word
      -> Rational
      -> NetworkId
      -> FilePath
      -> FilePath
      -> FilePath
      -> FilePath
      -> Maybe FilePath
      -> GenesisCreateCardanoCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe SystemStart)
pMaybeSystemStart
      Parser
  (Maybe Coin
   -> NonZero Word64
   -> Word
   -> Rational
   -> NetworkId
   -> FilePath
   -> FilePath
   -> FilePath
   -> FilePath
   -> Maybe FilePath
   -> GenesisCreateCardanoCmdArgs era)
-> Parser (Maybe Coin)
-> Parser
     (NonZero Word64
      -> Word
      -> Rational
      -> NetworkId
      -> FilePath
      -> FilePath
      -> FilePath
      -> FilePath
      -> Maybe FilePath
      -> GenesisCreateCardanoCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Coin)
pInitialSupplyNonDelegated
      Parser
  (NonZero Word64
   -> Word
   -> Rational
   -> NetworkId
   -> FilePath
   -> FilePath
   -> FilePath
   -> FilePath
   -> Maybe FilePath
   -> GenesisCreateCardanoCmdArgs era)
-> Parser (NonZero Word64)
-> Parser
     (Word
      -> Rational
      -> NetworkId
      -> FilePath
      -> FilePath
      -> FilePath
      -> FilePath
      -> Maybe FilePath
      -> GenesisCreateCardanoCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (NonZero Word64)
pSecurityParam
      Parser
  (Word
   -> Rational
   -> NetworkId
   -> FilePath
   -> FilePath
   -> FilePath
   -> FilePath
   -> Maybe FilePath
   -> GenesisCreateCardanoCmdArgs era)
-> Parser Word
-> Parser
     (Rational
      -> NetworkId
      -> FilePath
      -> FilePath
      -> FilePath
      -> FilePath
      -> Maybe FilePath
      -> GenesisCreateCardanoCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word
pSlotLength
      Parser
  (Rational
   -> NetworkId
   -> FilePath
   -> FilePath
   -> FilePath
   -> FilePath
   -> Maybe FilePath
   -> GenesisCreateCardanoCmdArgs era)
-> Parser Rational
-> Parser
     (NetworkId
      -> FilePath
      -> FilePath
      -> FilePath
      -> FilePath
      -> Maybe FilePath
      -> GenesisCreateCardanoCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Rational
pSlotCoefficient
      Parser
  (NetworkId
   -> FilePath
   -> FilePath
   -> FilePath
   -> FilePath
   -> Maybe FilePath
   -> GenesisCreateCardanoCmdArgs era)
-> Parser NetworkId
-> Parser
     (FilePath
      -> FilePath
      -> FilePath
      -> FilePath
      -> Maybe FilePath
      -> GenesisCreateCardanoCmdArgs era)
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
  (FilePath
   -> FilePath
   -> FilePath
   -> FilePath
   -> Maybe FilePath
   -> GenesisCreateCardanoCmdArgs era)
-> Parser FilePath
-> Parser
     (FilePath
      -> FilePath
      -> FilePath
      -> Maybe FilePath
      -> GenesisCreateCardanoCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> FilePath -> Parser FilePath
parseFilePath
        FilePath
"byron-template"
        FilePath
"JSON file with genesis defaults for each byron."
      Parser
  (FilePath
   -> FilePath
   -> FilePath
   -> Maybe FilePath
   -> GenesisCreateCardanoCmdArgs era)
-> Parser FilePath
-> Parser
     (FilePath
      -> FilePath -> Maybe FilePath -> GenesisCreateCardanoCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> FilePath -> Parser FilePath
parseFilePath
        FilePath
"shelley-template"
        FilePath
"JSON file with genesis defaults for each shelley."
      Parser
  (FilePath
   -> FilePath -> Maybe FilePath -> GenesisCreateCardanoCmdArgs era)
-> Parser FilePath
-> Parser
     (FilePath -> Maybe FilePath -> GenesisCreateCardanoCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> FilePath -> Parser FilePath
parseFilePath
        FilePath
"alonzo-template"
        FilePath
"JSON file with genesis defaults for alonzo."
      Parser
  (FilePath -> Maybe FilePath -> GenesisCreateCardanoCmdArgs era)
-> Parser FilePath
-> Parser (Maybe FilePath -> GenesisCreateCardanoCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> FilePath -> Parser FilePath
parseFilePath
        FilePath
"conway-template"
        FilePath
"JSON file with genesis defaults for conway."
      Parser (Maybe FilePath -> GenesisCreateCardanoCmdArgs era)
-> Parser (Maybe FilePath)
-> Parser (GenesisCreateCardanoCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe FilePath)
pNodeConfigTemplate

pGenesisCreate :: forall era. Exp.IsEra era => EnvCli -> Parser (GenesisCmds era)
pGenesisCreate :: forall era. IsEra era => EnvCli -> Parser (GenesisCmds era)
pGenesisCreate EnvCli
envCli =
  let ShelleyBasedEra era
sbe :: ShelleyBasedEra era = Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
forall era. IsEra era => Era era
Exp.useEra
   in (GenesisCreateCmdArgs era -> GenesisCmds era)
-> Parser (GenesisCreateCmdArgs era) -> Parser (GenesisCmds era)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenesisCreateCmdArgs era -> GenesisCmds era
forall era. GenesisCreateCmdArgs era -> GenesisCmds era
GenesisCreate (Parser (GenesisCreateCmdArgs era) -> Parser (GenesisCmds era))
-> Parser (GenesisCreateCmdArgs era) -> Parser (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
        AnyShelleyBasedEra
-> Vary '[FormatBech32, FormatTextEnvelope]
-> GenesisDir
-> Word
-> Word
-> Maybe SystemStart
-> Maybe Coin
-> NetworkId
-> GenesisCreateCmdArgs era
forall era.
AnyShelleyBasedEra
-> Vary '[FormatBech32, FormatTextEnvelope]
-> GenesisDir
-> Word
-> Word
-> Maybe SystemStart
-> Maybe Coin
-> NetworkId
-> GenesisCreateCmdArgs era
GenesisCreateCmdArgs (ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => AnyShelleyBasedEra)
-> AnyShelleyBasedEra
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era => AnyShelleyBasedEra)
 -> AnyShelleyBasedEra)
-> (ShelleyBasedEraConstraints era => AnyShelleyBasedEra)
-> AnyShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra era
sbe)
          (Vary '[FormatBech32, FormatTextEnvelope]
 -> GenesisDir
 -> Word
 -> Word
 -> Maybe SystemStart
 -> Maybe Coin
 -> NetworkId
 -> GenesisCreateCmdArgs era)
-> Parser (Vary '[FormatBech32, FormatTextEnvelope])
-> Parser
     (GenesisDir
      -> Word
      -> Word
      -> Maybe SystemStart
      -> Maybe Coin
      -> NetworkId
      -> GenesisCreateCmdArgs era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Vary '[FormatBech32, FormatTextEnvelope])
pKeyOutputFormat
          Parser
  (GenesisDir
   -> Word
   -> Word
   -> Maybe SystemStart
   -> Maybe Coin
   -> NetworkId
   -> GenesisCreateCmdArgs era)
-> Parser GenesisDir
-> Parser
     (Word
      -> Word
      -> Maybe SystemStart
      -> Maybe Coin
      -> NetworkId
      -> GenesisCreateCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser GenesisDir
pGenesisDir
          Parser
  (Word
   -> Word
   -> Maybe SystemStart
   -> Maybe Coin
   -> NetworkId
   -> GenesisCreateCmdArgs era)
-> Parser Word
-> Parser
     (Word
      -> Maybe SystemStart
      -> Maybe Coin
      -> NetworkId
      -> GenesisCreateCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word
pGenesisNumGenesisKeys
          Parser
  (Word
   -> Maybe SystemStart
   -> Maybe Coin
   -> NetworkId
   -> GenesisCreateCmdArgs era)
-> Parser Word
-> Parser
     (Maybe SystemStart
      -> Maybe Coin -> NetworkId -> GenesisCreateCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word
pGenesisNumUTxOKeys
          Parser
  (Maybe SystemStart
   -> Maybe Coin -> NetworkId -> GenesisCreateCmdArgs era)
-> Parser (Maybe SystemStart)
-> Parser (Maybe Coin -> NetworkId -> GenesisCreateCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe SystemStart)
pMaybeSystemStart
          Parser (Maybe Coin -> NetworkId -> GenesisCreateCmdArgs era)
-> Parser (Maybe Coin)
-> Parser (NetworkId -> GenesisCreateCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Coin)
pInitialSupplyNonDelegated
          Parser (NetworkId -> GenesisCreateCmdArgs era)
-> Parser NetworkId -> Parser (GenesisCreateCmdArgs era)
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

pGenesisCreateStaked :: Exp.IsEra era => EnvCli -> Parser (GenesisCmds era)
pGenesisCreateStaked :: forall era. IsEra era => EnvCli -> Parser (GenesisCmds era)
pGenesisCreateStaked EnvCli
envCli =
  (GenesisCreateStakedCmdArgs era -> GenesisCmds era)
-> Parser (GenesisCreateStakedCmdArgs era)
-> Parser (GenesisCmds era)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenesisCreateStakedCmdArgs era -> GenesisCmds era
forall era. GenesisCreateStakedCmdArgs era -> GenesisCmds era
GenesisCreateStaked (Parser (GenesisCreateStakedCmdArgs era)
 -> Parser (GenesisCmds era))
-> Parser (GenesisCreateStakedCmdArgs era)
-> Parser (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
    Era era
-> Vary '[FormatBech32, FormatTextEnvelope]
-> GenesisDir
-> Word
-> Word
-> Word
-> Word
-> Maybe SystemStart
-> Maybe Coin
-> Coin
-> NetworkId
-> Word
-> Word
-> Word
-> Maybe FilePath
-> GenesisCreateStakedCmdArgs era
forall era.
Era era
-> Vary '[FormatBech32, FormatTextEnvelope]
-> GenesisDir
-> Word
-> Word
-> Word
-> Word
-> Maybe SystemStart
-> Maybe Coin
-> Coin
-> NetworkId
-> Word
-> Word
-> Word
-> Maybe FilePath
-> GenesisCreateStakedCmdArgs era
GenesisCreateStakedCmdArgs (Era era -> Era era
forall era. Era era -> Era era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
forall era. IsEra era => Era era
Exp.useEra)
      (Vary '[FormatBech32, FormatTextEnvelope]
 -> GenesisDir
 -> Word
 -> Word
 -> Word
 -> Word
 -> Maybe SystemStart
 -> Maybe Coin
 -> Coin
 -> NetworkId
 -> Word
 -> Word
 -> Word
 -> Maybe FilePath
 -> GenesisCreateStakedCmdArgs era)
-> Parser (Vary '[FormatBech32, FormatTextEnvelope])
-> Parser
     (GenesisDir
      -> Word
      -> Word
      -> Word
      -> Word
      -> Maybe SystemStart
      -> Maybe Coin
      -> Coin
      -> NetworkId
      -> Word
      -> Word
      -> Word
      -> Maybe FilePath
      -> GenesisCreateStakedCmdArgs era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Vary '[FormatBech32, FormatTextEnvelope])
pKeyOutputFormat
      Parser
  (GenesisDir
   -> Word
   -> Word
   -> Word
   -> Word
   -> Maybe SystemStart
   -> Maybe Coin
   -> Coin
   -> NetworkId
   -> Word
   -> Word
   -> Word
   -> Maybe FilePath
   -> GenesisCreateStakedCmdArgs era)
-> Parser GenesisDir
-> Parser
     (Word
      -> Word
      -> Word
      -> Word
      -> Maybe SystemStart
      -> Maybe Coin
      -> Coin
      -> NetworkId
      -> Word
      -> Word
      -> Word
      -> Maybe FilePath
      -> GenesisCreateStakedCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser GenesisDir
pGenesisDir
      Parser
  (Word
   -> Word
   -> Word
   -> Word
   -> Maybe SystemStart
   -> Maybe Coin
   -> Coin
   -> NetworkId
   -> Word
   -> Word
   -> Word
   -> Maybe FilePath
   -> GenesisCreateStakedCmdArgs era)
-> Parser Word
-> Parser
     (Word
      -> Word
      -> Word
      -> Maybe SystemStart
      -> Maybe Coin
      -> Coin
      -> NetworkId
      -> Word
      -> Word
      -> Word
      -> Maybe FilePath
      -> GenesisCreateStakedCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word
pGenesisNumGenesisKeys
      Parser
  (Word
   -> Word
   -> Word
   -> Maybe SystemStart
   -> Maybe Coin
   -> Coin
   -> NetworkId
   -> Word
   -> Word
   -> Word
   -> Maybe FilePath
   -> GenesisCreateStakedCmdArgs era)
-> Parser Word
-> Parser
     (Word
      -> Word
      -> Maybe SystemStart
      -> Maybe Coin
      -> Coin
      -> NetworkId
      -> Word
      -> Word
      -> Word
      -> Maybe FilePath
      -> GenesisCreateStakedCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word
pGenesisNumUTxOKeys
      Parser
  (Word
   -> Word
   -> Maybe SystemStart
   -> Maybe Coin
   -> Coin
   -> NetworkId
   -> Word
   -> Word
   -> Word
   -> Maybe FilePath
   -> GenesisCreateStakedCmdArgs era)
-> Parser Word
-> Parser
     (Word
      -> Maybe SystemStart
      -> Maybe Coin
      -> Coin
      -> NetworkId
      -> Word
      -> Word
      -> Word
      -> Maybe FilePath
      -> GenesisCreateStakedCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word
pGenesisNumPools
      Parser
  (Word
   -> Maybe SystemStart
   -> Maybe Coin
   -> Coin
   -> NetworkId
   -> Word
   -> Word
   -> Word
   -> Maybe FilePath
   -> GenesisCreateStakedCmdArgs era)
-> Parser Word
-> Parser
     (Maybe SystemStart
      -> Maybe Coin
      -> Coin
      -> NetworkId
      -> Word
      -> Word
      -> Word
      -> Maybe FilePath
      -> GenesisCreateStakedCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word
pGenesisNumStDelegs
      Parser
  (Maybe SystemStart
   -> Maybe Coin
   -> Coin
   -> NetworkId
   -> Word
   -> Word
   -> Word
   -> Maybe FilePath
   -> GenesisCreateStakedCmdArgs era)
-> Parser (Maybe SystemStart)
-> Parser
     (Maybe Coin
      -> Coin
      -> NetworkId
      -> Word
      -> Word
      -> Word
      -> Maybe FilePath
      -> GenesisCreateStakedCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe SystemStart)
pMaybeSystemStart
      Parser
  (Maybe Coin
   -> Coin
   -> NetworkId
   -> Word
   -> Word
   -> Word
   -> Maybe FilePath
   -> GenesisCreateStakedCmdArgs era)
-> Parser (Maybe Coin)
-> Parser
     (Coin
      -> NetworkId
      -> Word
      -> Word
      -> Word
      -> Maybe FilePath
      -> GenesisCreateStakedCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Coin)
pInitialSupplyNonDelegated
      Parser
  (Coin
   -> NetworkId
   -> Word
   -> Word
   -> Word
   -> Maybe FilePath
   -> GenesisCreateStakedCmdArgs era)
-> Parser Coin
-> Parser
     (NetworkId
      -> Word
      -> Word
      -> Word
      -> Maybe FilePath
      -> GenesisCreateStakedCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Coin
pInitialSupplyDelegated
      Parser
  (NetworkId
   -> Word
   -> Word
   -> Word
   -> Maybe FilePath
   -> GenesisCreateStakedCmdArgs era)
-> Parser NetworkId
-> Parser
     (Word
      -> Word
      -> Word
      -> Maybe FilePath
      -> GenesisCreateStakedCmdArgs era)
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
  (Word
   -> Word
   -> Word
   -> Maybe FilePath
   -> GenesisCreateStakedCmdArgs era)
-> Parser Word
-> Parser
     (Word -> Word -> Maybe FilePath -> GenesisCreateStakedCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word
pBulkPoolCredFiles
      Parser
  (Word -> Word -> Maybe FilePath -> GenesisCreateStakedCmdArgs era)
-> Parser Word
-> Parser
     (Word -> Maybe FilePath -> GenesisCreateStakedCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word
pBulkPoolsPerFile
      Parser (Word -> Maybe FilePath -> GenesisCreateStakedCmdArgs era)
-> Parser Word
-> Parser (Maybe FilePath -> GenesisCreateStakedCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word
pStuffedUtxoCount
      Parser (Maybe FilePath -> GenesisCreateStakedCmdArgs era)
-> Parser (Maybe FilePath)
-> Parser (GenesisCreateStakedCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional Parser FilePath
pRelayJsonFp
 where
  pRelayJsonFp :: Parser FilePath
  pRelayJsonFp :: Parser FilePath
pRelayJsonFp =
    FilePath -> FilePath -> Parser FilePath
parseFilePath FilePath
"relay-specification-file" FilePath
"JSON file that specifies the relays of each stake pool."

pGenesisCreateTestNetData :: forall era. Exp.IsEra era => EnvCli -> Parser (GenesisCmds era)
pGenesisCreateTestNetData :: forall era. IsEra era => EnvCli -> Parser (GenesisCmds era)
pGenesisCreateTestNetData EnvCli
envCli =
  (GenesisCreateTestNetDataCmdArgs -> GenesisCmds era)
-> Parser GenesisCreateTestNetDataCmdArgs
-> Parser (GenesisCmds era)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenesisCreateTestNetDataCmdArgs -> GenesisCmds era
forall era. GenesisCreateTestNetDataCmdArgs -> GenesisCmds era
GenesisCreateTestNetData (Parser GenesisCreateTestNetDataCmdArgs
 -> Parser (GenesisCmds era))
-> Parser GenesisCreateTestNetDataCmdArgs
-> Parser (GenesisCmds era)
forall a b. (a -> b) -> a -> b
$
    Era era
-> Maybe FilePath
-> Maybe FilePath
-> Maybe FilePath
-> Maybe FilePath
-> Word
-> Word
-> StakeDelegators
-> Word
-> DRepCredentials
-> Word
-> Word
-> Maybe Coin
-> Maybe Coin
-> Maybe NetworkId
-> Maybe FilePath
-> Maybe SystemStart
-> FilePath
-> GenesisCreateTestNetDataCmdArgs
forall era.
Era era
-> Maybe FilePath
-> Maybe FilePath
-> Maybe FilePath
-> Maybe FilePath
-> Word
-> Word
-> StakeDelegators
-> Word
-> DRepCredentials
-> Word
-> Word
-> Maybe Coin
-> Maybe Coin
-> Maybe NetworkId
-> Maybe FilePath
-> Maybe SystemStart
-> FilePath
-> GenesisCreateTestNetDataCmdArgs
GenesisCreateTestNetDataCmdArgs (Era era -> Era era
forall era. Era era -> Era era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert (Era era -> Era era) -> Era era -> Era era
forall a b. (a -> b) -> a -> b
$ forall era. IsEra era => Era era
Exp.useEra @era)
      (Maybe FilePath
 -> Maybe FilePath
 -> Maybe FilePath
 -> Maybe FilePath
 -> Word
 -> Word
 -> StakeDelegators
 -> Word
 -> DRepCredentials
 -> Word
 -> Word
 -> Maybe Coin
 -> Maybe Coin
 -> Maybe NetworkId
 -> Maybe FilePath
 -> Maybe SystemStart
 -> FilePath
 -> GenesisCreateTestNetDataCmdArgs)
-> Parser (Maybe FilePath)
-> Parser
     (Maybe FilePath
      -> Maybe FilePath
      -> Maybe FilePath
      -> Word
      -> Word
      -> StakeDelegators
      -> Word
      -> DRepCredentials
      -> Word
      -> Word
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe NetworkId
      -> Maybe FilePath
      -> Maybe SystemStart
      -> FilePath
      -> GenesisCreateTestNetDataCmdArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields FilePath -> FilePath -> Parser FilePath
pSpecFile Mod OptionFields FilePath
forall m. Monoid m => m
idm FilePath
"shelley")
      Parser
  (Maybe FilePath
   -> Maybe FilePath
   -> Maybe FilePath
   -> Word
   -> Word
   -> StakeDelegators
   -> Word
   -> DRepCredentials
   -> Word
   -> Word
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe NetworkId
   -> Maybe FilePath
   -> Maybe SystemStart
   -> FilePath
   -> GenesisCreateTestNetDataCmdArgs)
-> Parser (Maybe FilePath)
-> Parser
     (Maybe FilePath
      -> Maybe FilePath
      -> Word
      -> Word
      -> StakeDelegators
      -> Word
      -> DRepCredentials
      -> Word
      -> Word
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe NetworkId
      -> Maybe FilePath
      -> Maybe SystemStart
      -> FilePath
      -> GenesisCreateTestNetDataCmdArgs)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields FilePath -> FilePath -> Parser FilePath
pSpecFile Mod OptionFields FilePath
forall m. Monoid m => m
idm FilePath
"alonzo")
      Parser
  (Maybe FilePath
   -> Maybe FilePath
   -> Word
   -> Word
   -> StakeDelegators
   -> Word
   -> DRepCredentials
   -> Word
   -> Word
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe NetworkId
   -> Maybe FilePath
   -> Maybe SystemStart
   -> FilePath
   -> GenesisCreateTestNetDataCmdArgs)
-> Parser (Maybe FilePath)
-> Parser
     (Maybe FilePath
      -> Word
      -> Word
      -> StakeDelegators
      -> Word
      -> DRepCredentials
      -> Word
      -> Word
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe NetworkId
      -> Maybe FilePath
      -> Maybe SystemStart
      -> FilePath
      -> GenesisCreateTestNetDataCmdArgs)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields FilePath -> FilePath -> Parser FilePath
pSpecFile Mod OptionFields FilePath
forall m. Monoid m => m
idm FilePath
"conway")
      Parser
  (Maybe FilePath
   -> Word
   -> Word
   -> StakeDelegators
   -> Word
   -> DRepCredentials
   -> Word
   -> Word
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe NetworkId
   -> Maybe FilePath
   -> Maybe SystemStart
   -> FilePath
   -> GenesisCreateTestNetDataCmdArgs)
-> Parser (Maybe FilePath)
-> Parser
     (Word
      -> Word
      -> StakeDelegators
      -> Word
      -> DRepCredentials
      -> Word
      -> Word
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe NetworkId
      -> Maybe FilePath
      -> Maybe SystemStart
      -> FilePath
      -> GenesisCreateTestNetDataCmdArgs)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields FilePath -> FilePath -> Parser FilePath
pSpecFile Mod OptionFields FilePath
forall (f :: * -> *) a. Mod f a
Opt.internal FilePath
"dijkstra")
      Parser
  (Word
   -> Word
   -> StakeDelegators
   -> Word
   -> DRepCredentials
   -> Word
   -> Word
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe NetworkId
   -> Maybe FilePath
   -> Maybe SystemStart
   -> FilePath
   -> GenesisCreateTestNetDataCmdArgs)
-> Parser Word
-> Parser
     (Word
      -> StakeDelegators
      -> Word
      -> DRepCredentials
      -> Word
      -> Word
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe NetworkId
      -> Maybe FilePath
      -> Maybe SystemStart
      -> FilePath
      -> GenesisCreateTestNetDataCmdArgs)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word
pNumGenesisKeys
      Parser
  (Word
   -> StakeDelegators
   -> Word
   -> DRepCredentials
   -> Word
   -> Word
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe NetworkId
   -> Maybe FilePath
   -> Maybe SystemStart
   -> FilePath
   -> GenesisCreateTestNetDataCmdArgs)
-> Parser Word
-> Parser
     (StakeDelegators
      -> Word
      -> DRepCredentials
      -> Word
      -> Word
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe NetworkId
      -> Maybe FilePath
      -> Maybe SystemStart
      -> FilePath
      -> GenesisCreateTestNetDataCmdArgs)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word
pNumPools
      Parser
  (StakeDelegators
   -> Word
   -> DRepCredentials
   -> Word
   -> Word
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe NetworkId
   -> Maybe FilePath
   -> Maybe SystemStart
   -> FilePath
   -> GenesisCreateTestNetDataCmdArgs)
-> Parser StakeDelegators
-> Parser
     (Word
      -> DRepCredentials
      -> Word
      -> Word
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe NetworkId
      -> Maybe FilePath
      -> Maybe SystemStart
      -> FilePath
      -> GenesisCreateTestNetDataCmdArgs)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser StakeDelegators
pNumStakeDelegs
      Parser
  (Word
   -> DRepCredentials
   -> Word
   -> Word
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe NetworkId
   -> Maybe FilePath
   -> Maybe SystemStart
   -> FilePath
   -> GenesisCreateTestNetDataCmdArgs)
-> Parser Word
-> Parser
     (DRepCredentials
      -> Word
      -> Word
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe NetworkId
      -> Maybe FilePath
      -> Maybe SystemStart
      -> FilePath
      -> GenesisCreateTestNetDataCmdArgs)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word
pNumCommittee
      Parser
  (DRepCredentials
   -> Word
   -> Word
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe NetworkId
   -> Maybe FilePath
   -> Maybe SystemStart
   -> FilePath
   -> GenesisCreateTestNetDataCmdArgs)
-> Parser DRepCredentials
-> Parser
     (Word
      -> Word
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe NetworkId
      -> Maybe FilePath
      -> Maybe SystemStart
      -> FilePath
      -> GenesisCreateTestNetDataCmdArgs)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DRepCredentials
pNumDReps
      Parser
  (Word
   -> Word
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe NetworkId
   -> Maybe FilePath
   -> Maybe SystemStart
   -> FilePath
   -> GenesisCreateTestNetDataCmdArgs)
-> Parser Word
-> Parser
     (Word
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe NetworkId
      -> Maybe FilePath
      -> Maybe SystemStart
      -> FilePath
      -> GenesisCreateTestNetDataCmdArgs)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word
pNumStuffedUtxoCount
      Parser
  (Word
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe NetworkId
   -> Maybe FilePath
   -> Maybe SystemStart
   -> FilePath
   -> GenesisCreateTestNetDataCmdArgs)
-> Parser Word
-> Parser
     (Maybe Coin
      -> Maybe Coin
      -> Maybe NetworkId
      -> Maybe FilePath
      -> Maybe SystemStart
      -> FilePath
      -> GenesisCreateTestNetDataCmdArgs)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word
pNumUtxoKeys
      Parser
  (Maybe Coin
   -> Maybe Coin
   -> Maybe NetworkId
   -> Maybe FilePath
   -> Maybe SystemStart
   -> FilePath
   -> GenesisCreateTestNetDataCmdArgs)
-> Parser (Maybe Coin)
-> Parser
     (Maybe Coin
      -> Maybe NetworkId
      -> Maybe FilePath
      -> Maybe SystemStart
      -> FilePath
      -> GenesisCreateTestNetDataCmdArgs)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Coin)
pSupply
      Parser
  (Maybe Coin
   -> Maybe NetworkId
   -> Maybe FilePath
   -> Maybe SystemStart
   -> FilePath
   -> GenesisCreateTestNetDataCmdArgs)
-> Parser (Maybe Coin)
-> Parser
     (Maybe NetworkId
      -> Maybe FilePath
      -> Maybe SystemStart
      -> FilePath
      -> GenesisCreateTestNetDataCmdArgs)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Coin)
pSupplyDelegated
      Parser
  (Maybe NetworkId
   -> Maybe FilePath
   -> Maybe SystemStart
   -> FilePath
   -> GenesisCreateTestNetDataCmdArgs)
-> Parser (Maybe NetworkId)
-> Parser
     (Maybe FilePath
      -> Maybe SystemStart
      -> FilePath
      -> GenesisCreateTestNetDataCmdArgs)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser NetworkId -> Parser (Maybe NetworkId)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (EnvCli -> Parser NetworkId
pNetworkIdForTestnetData EnvCli
envCli)
      Parser
  (Maybe FilePath
   -> Maybe SystemStart
   -> FilePath
   -> GenesisCreateTestNetDataCmdArgs)
-> Parser (Maybe FilePath)
-> Parser
     (Maybe SystemStart -> FilePath -> GenesisCreateTestNetDataCmdArgs)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional Parser FilePath
pRelays
      Parser
  (Maybe SystemStart -> FilePath -> GenesisCreateTestNetDataCmdArgs)
-> Parser (Maybe SystemStart)
-> Parser (FilePath -> GenesisCreateTestNetDataCmdArgs)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe SystemStart)
pMaybeSystemStart
      Parser (FilePath -> GenesisCreateTestNetDataCmdArgs)
-> Parser FilePath -> Parser GenesisCreateTestNetDataCmdArgs
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FilePath
pOutputDir
 where
  pSpecFile :: Mod OptionFields FilePath -> FilePath -> Parser FilePath
pSpecFile Mod OptionFields FilePath
mod' FilePath
eraStr =
    FilePath
-> FilePath -> Mod OptionFields FilePath -> Parser FilePath
parseFilePathWithMod
      (FilePath
"spec-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
eraStr)
      (FilePath
"The " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
eraStr FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" specification file to use as input. A default one is generated if omitted.")
      Mod OptionFields FilePath
mod'
  pNumGenesisKeys :: Parser Word
pNumGenesisKeys =
    ReadM Word -> Mod OptionFields Word -> Parser Word
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader (Mod OptionFields Word -> Parser Word)
-> Mod OptionFields Word -> Parser Word
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields Word] -> Mod OptionFields Word
forall a. Monoid a => [a] -> a
mconcat
        [ FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
"genesis-keys"
        , FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"INT"
        , FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help FilePath
"The number of genesis keys to make (default is 3)."
        , Word -> Mod OptionFields Word
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value Word
3
        ]
  pNumPools :: Parser Word
  pNumPools :: Parser Word
pNumPools =
    ReadM Word -> Mod OptionFields Word -> Parser Word
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader (Mod OptionFields Word -> Parser Word)
-> Mod OptionFields Word -> Parser Word
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields Word] -> Mod OptionFields Word
forall a. Monoid a => [a] -> a
mconcat
        [ FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
"pools"
        , FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"INT"
        , FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help FilePath
"The number of stake pool credential sets to make (default is 0)."
        , Word -> Mod OptionFields Word
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value Word
0
        ]
  pNumCommittee :: Parser Word
  pNumCommittee :: Parser Word
pNumCommittee =
    ReadM Word -> Mod OptionFields Word -> Parser Word
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader (Mod OptionFields Word -> Parser Word)
-> Mod OptionFields Word -> Parser Word
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields Word] -> Mod OptionFields Word
forall a. Monoid a => [a] -> a
mconcat
        [ FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
"committee-keys"
        , FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"INT"
        , FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help FilePath
"The number of constitutional committee credentials to make (default is 0)."
        , Word -> Mod OptionFields Word
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value Word
0
        ]
  pNumDReps :: Parser DRepCredentials
  pNumDReps :: Parser DRepCredentials
pNumDReps =
    CredentialGenerationMode
-> FilePath -> FilePath -> Parser DRepCredentials
pDReps CredentialGenerationMode
OnDisk FilePath
"drep-keys" FilePath
"Credentials are written to disk."
      Parser DRepCredentials
-> Parser DRepCredentials -> Parser DRepCredentials
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CredentialGenerationMode
-> FilePath -> FilePath -> Parser DRepCredentials
pDReps CredentialGenerationMode
Transient FilePath
"transient-drep-keys" FilePath
"The credentials are NOT written to disk."
   where
    pDReps :: CredentialGenerationMode -> String -> String -> Parser DRepCredentials
    pDReps :: CredentialGenerationMode
-> FilePath -> FilePath -> Parser DRepCredentials
pDReps CredentialGenerationMode
mode FilePath
modeOptionName FilePath
modeExplanation =
      CredentialGenerationMode -> Word -> DRepCredentials
DRepCredentials CredentialGenerationMode
mode
        (Word -> DRepCredentials) -> Parser Word -> Parser DRepCredentials
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Word -> Mod OptionFields Word -> Parser Word
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
          ReadM Word
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader
          ( [Mod OptionFields Word] -> Mod OptionFields Word
forall a. Monoid a => [a] -> a
mconcat
              [ FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
modeOptionName
              , FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help (FilePath -> Mod OptionFields Word)
-> FilePath -> Mod OptionFields Word
forall a b. (a -> b) -> a -> b
$ FilePath
"The number of DRep credentials to make (default is 0). " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
modeExplanation
              , FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"INT"
              , Word -> Mod OptionFields Word
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value Word
0
              ]
          )
  pNumStakeDelegs :: Parser StakeDelegators
  pNumStakeDelegs :: Parser StakeDelegators
pNumStakeDelegs =
    CredentialGenerationMode
-> FilePath -> FilePath -> Parser StakeDelegators
pStakeDelegators CredentialGenerationMode
OnDisk FilePath
"stake-delegators" FilePath
"Credentials are written to disk."
      Parser StakeDelegators
-> Parser StakeDelegators -> Parser StakeDelegators
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CredentialGenerationMode
-> FilePath -> FilePath -> Parser StakeDelegators
pStakeDelegators CredentialGenerationMode
Transient FilePath
"transient-stake-delegators" FilePath
"The credentials are NOT written to disk."
   where
    pStakeDelegators :: CredentialGenerationMode -> String -> String -> Parser StakeDelegators
    pStakeDelegators :: CredentialGenerationMode
-> FilePath -> FilePath -> Parser StakeDelegators
pStakeDelegators CredentialGenerationMode
mode FilePath
modeOptionName FilePath
modeExplanation =
      CredentialGenerationMode -> Word -> StakeDelegators
StakeDelegators CredentialGenerationMode
mode
        (Word -> StakeDelegators) -> Parser Word -> Parser StakeDelegators
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Word -> Mod OptionFields Word -> Parser Word
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
          ReadM Word
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader
          ( [Mod OptionFields Word] -> Mod OptionFields Word
forall a. Monoid a => [a] -> a
mconcat
              [ FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
modeOptionName
              , FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help (FilePath -> Mod OptionFields Word)
-> FilePath -> Mod OptionFields Word
forall a b. (a -> b) -> a -> b
$
                  FilePath
"The number of stake delegator credential sets to make (default is 0). " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
modeExplanation
              , FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"INT"
              , Word -> Mod OptionFields Word
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value Word
0
              ]
          )
  pNumStuffedUtxoCount :: Parser Word
  pNumStuffedUtxoCount :: Parser Word
pNumStuffedUtxoCount =
    ReadM Word -> Mod OptionFields Word -> Parser Word
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader (Mod OptionFields Word -> Parser Word)
-> Mod OptionFields Word -> Parser Word
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields Word] -> Mod OptionFields Word
forall a. Monoid a => [a] -> a
mconcat
        [ FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
"stuffed-utxo"
        , FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"INT"
        , FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help FilePath
"The number of fake UTxO entries to generate (default is 0)."
        , Word -> Mod OptionFields Word
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value Word
0
        ]
  pNumUtxoKeys :: Parser Word
  pNumUtxoKeys :: Parser Word
pNumUtxoKeys =
    ReadM Word -> Mod OptionFields Word -> Parser Word
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader (Mod OptionFields Word -> Parser Word)
-> Mod OptionFields Word -> Parser Word
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields Word] -> Mod OptionFields Word
forall a. Monoid a => [a] -> a
mconcat
        [ FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
"utxo-keys"
        , FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"INT"
        , FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help FilePath
"The number of UTxO keys to make (default is 0)."
        , Word -> Mod OptionFields Word
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value Word
0
        ]
  pSupply :: Parser (Maybe Coin)
  pSupply :: Parser (Maybe Coin)
pSupply =
    Parser Coin -> Parser (Maybe Coin)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional (Parser Coin -> Parser (Maybe Coin))
-> Parser Coin -> Parser (Maybe Coin)
forall a b. (a -> b) -> a -> b
$
      (Integer -> Coin) -> Parser Integer -> Parser Coin
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Coin
Coin (Parser Integer -> Parser Coin) -> Parser Integer -> Parser Coin
forall a b. (a -> b) -> a -> b
$
        ReadM Integer -> Mod OptionFields Integer -> Parser Integer
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Integer
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader (Mod OptionFields Integer -> Parser Integer)
-> Mod OptionFields Integer -> Parser Integer
forall a b. (a -> b) -> a -> b
$
          [Mod OptionFields Integer] -> Mod OptionFields Integer
forall a. Monoid a => [a] -> a
mconcat
            [ FilePath -> Mod OptionFields Integer
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
"total-supply"
            , FilePath -> Mod OptionFields Integer
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"LOVELACE"
            , FilePath -> Mod OptionFields Integer
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help (FilePath -> Mod OptionFields Integer)
-> FilePath -> Mod OptionFields Integer
forall a b. (a -> b) -> a -> b
$
                [FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat
                  [ FilePath
"The maximum possible amount of Lovelace, which is evenly distributed across stake holders. Overrides the value from the shelley genesis."
                  , FilePath
" If --delegated-supply is specified, a part of this amount will be delegated."
                  ]
            ]
  pSupplyDelegated :: Parser (Maybe Coin)
  pSupplyDelegated :: Parser (Maybe Coin)
pSupplyDelegated =
    Parser Coin -> Parser (Maybe Coin)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional (Parser Coin -> Parser (Maybe Coin))
-> Parser Coin -> Parser (Maybe Coin)
forall a b. (a -> b) -> a -> b
$
      (Integer -> Coin) -> Parser Integer -> Parser Coin
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Coin
Coin (Parser Integer -> Parser Coin) -> Parser Integer -> Parser Coin
forall a b. (a -> b) -> a -> b
$
        ReadM Integer -> Mod OptionFields Integer -> Parser Integer
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Integer
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader (Mod OptionFields Integer -> Parser Integer)
-> Mod OptionFields Integer -> Parser Integer
forall a b. (a -> b) -> a -> b
$
          [Mod OptionFields Integer] -> Mod OptionFields Integer
forall a. Monoid a => [a] -> a
mconcat
            [ FilePath -> Mod OptionFields Integer
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
"delegated-supply"
            , FilePath -> Mod OptionFields Integer
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"LOVELACE"
            , FilePath -> Mod OptionFields Integer
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help (FilePath -> Mod OptionFields Integer)
-> FilePath -> Mod OptionFields Integer
forall a b. (a -> b) -> a -> b
$
                [FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat
                  [ FilePath
"The amount of the total supply which is evenly delegated. Defaulted to half of the total supply."
                  , FilePath
" Cannot be more than the amount specified with --total-supply."
                  ]
            ]
  pRelays :: Parser FilePath
  pRelays :: Parser FilePath
pRelays =
    FilePath -> FilePath -> Parser FilePath
parseFilePath FilePath
"relays" FilePath
"JSON file specifying the relays of each stake pool."
  pOutputDir :: Parser FilePath
pOutputDir =
    Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields FilePath] -> Mod OptionFields FilePath
forall a. Monoid a => [a] -> a
mconcat
        [ FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
"out-dir"
        , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"DIR"
        , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help FilePath
"The directory where to generate the data. Created if not existing."
        ]

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

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

pMaybeSystemStart :: Parser (Maybe SystemStart)
pMaybeSystemStart :: Parser (Maybe SystemStart)
pMaybeSystemStart =
  Parser SystemStart -> Parser (Maybe SystemStart)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional (Parser SystemStart -> Parser (Maybe SystemStart))
-> Parser SystemStart -> Parser (Maybe SystemStart)
forall a b. (a -> b) -> a -> b
$
    (UTCTime -> SystemStart) -> Parser UTCTime -> Parser SystemStart
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UTCTime -> SystemStart
SystemStart (Parser UTCTime -> Parser SystemStart)
-> Parser UTCTime -> Parser SystemStart
forall a b. (a -> b) -> a -> b
$
      ReadM UTCTime -> Mod OptionFields UTCTime -> Parser UTCTime
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM UTCTime
timeReader (Mod OptionFields UTCTime -> Parser UTCTime)
-> Mod OptionFields UTCTime -> Parser UTCTime
forall a b. (a -> b) -> a -> b
$
        [Mod OptionFields UTCTime] -> Mod OptionFields UTCTime
forall a. Monoid a => [a] -> a
mconcat
          [ FilePath -> Mod OptionFields UTCTime
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
"start-time"
          , FilePath -> Mod OptionFields UTCTime
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"UTC_TIME"
          , FilePath -> Mod OptionFields UTCTime
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help
              FilePath
"The genesis start time in YYYY-MM-DDThh:mm:ssZ format. If unspecified, will be the current time +30 seconds."
          ]

pGenesisNumGenesisKeys :: Parser Word
pGenesisNumGenesisKeys :: Parser Word
pGenesisNumGenesisKeys =
  ReadM Word -> Mod OptionFields Word -> Parser Word
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader (Mod OptionFields Word -> Parser Word)
-> Mod OptionFields Word -> Parser Word
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Word] -> Mod OptionFields Word
forall a. Monoid a => [a] -> a
mconcat
      [ FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
"gen-genesis-keys"
      , FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"INT"
      , FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help FilePath
"The number of genesis keys to make [default is 3]."
      , Word -> Mod OptionFields Word
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value Word
3
      ]

pNodeConfigTemplate :: Parser (Maybe FilePath)
pNodeConfigTemplate :: Parser (Maybe FilePath)
pNodeConfigTemplate = Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser FilePath -> Parser (Maybe FilePath))
-> Parser FilePath -> Parser (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> Parser FilePath
parseFilePath FilePath
"node-config-template" FilePath
"the node config template"

pGenesisNumUTxOKeys :: Parser Word
pGenesisNumUTxOKeys :: Parser Word
pGenesisNumUTxOKeys =
  ReadM Word -> Mod OptionFields Word -> Parser Word
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader (Mod OptionFields Word -> Parser Word)
-> Mod OptionFields Word -> Parser Word
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Word] -> Mod OptionFields Word
forall a. Monoid a => [a] -> a
mconcat
      [ FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
"gen-utxo-keys"
      , FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"INT"
      , FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help FilePath
"The number of UTxO keys to make [default is 0]."
      , Word -> Mod OptionFields Word
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value Word
0
      ]

pGenesisNumPools :: Parser Word
pGenesisNumPools :: Parser Word
pGenesisNumPools =
  ReadM Word -> Mod OptionFields Word -> Parser Word
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader (Mod OptionFields Word -> Parser Word)
-> Mod OptionFields Word -> Parser Word
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Word] -> Mod OptionFields Word
forall a. Monoid a => [a] -> a
mconcat
      [ FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
"gen-pools"
      , FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"INT"
      , FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help FilePath
"The number of stake pool credential sets to make [default is 0]."
      , Word -> Mod OptionFields Word
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value Word
0
      ]

pGenesisNumStDelegs :: Parser Word
pGenesisNumStDelegs :: Parser Word
pGenesisNumStDelegs =
  ReadM Word -> Mod OptionFields Word -> Parser Word
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader (Mod OptionFields Word -> Parser Word)
-> Mod OptionFields Word -> Parser Word
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Word] -> Mod OptionFields Word
forall a. Monoid a => [a] -> a
mconcat
      [ FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
"gen-stake-delegs"
      , FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"INT"
      , FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help FilePath
"The number of stake delegator credential sets to make [default is 0]."
      , Word -> Mod OptionFields Word
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value Word
0
      ]

pStuffedUtxoCount :: Parser Word
pStuffedUtxoCount :: Parser Word
pStuffedUtxoCount =
  ReadM Word -> Mod OptionFields Word -> Parser Word
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader (Mod OptionFields Word -> Parser Word)
-> Mod OptionFields Word -> Parser Word
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Word] -> Mod OptionFields Word
forall a. Monoid a => [a] -> a
mconcat
      [ FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
"num-stuffed-utxo"
      , FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"INT"
      , FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help FilePath
"The number of fake UTxO entries to generate [default is 0]."
      , Word -> Mod OptionFields Word
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value Word
0
      ]

pInitialSupplyNonDelegated :: Parser (Maybe Coin)
pInitialSupplyNonDelegated :: Parser (Maybe Coin)
pInitialSupplyNonDelegated =
  Parser Coin -> Parser (Maybe Coin)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional (Parser Coin -> Parser (Maybe Coin))
-> Parser Coin -> Parser (Maybe Coin)
forall a b. (a -> b) -> a -> b
$
    (Integer -> Coin) -> Parser Integer -> Parser Coin
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Coin
Coin (Parser Integer -> Parser Coin) -> Parser Integer -> Parser Coin
forall a b. (a -> b) -> a -> b
$
      ReadM Integer -> Mod OptionFields Integer -> Parser Integer
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Integer
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader (Mod OptionFields Integer -> Parser Integer)
-> Mod OptionFields Integer -> Parser Integer
forall a b. (a -> b) -> a -> b
$
        [Mod OptionFields Integer] -> Mod OptionFields Integer
forall a. Monoid a => [a] -> a
mconcat
          [ FilePath -> Mod OptionFields Integer
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
"supply"
          , FilePath -> Mod OptionFields Integer
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"LOVELACE"
          , FilePath -> Mod OptionFields Integer
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help
              FilePath
"The initial coin supply in Lovelace which will be evenly distributed across initial, non-delegating stake holders."
          ]

pInitialSupplyDelegated :: Parser Coin
pInitialSupplyDelegated :: Parser Coin
pInitialSupplyDelegated =
  (Maybe Integer -> Coin) -> Parser (Maybe Integer) -> Parser Coin
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> Coin
Coin (Integer -> Coin)
-> (Maybe Integer -> Integer) -> Maybe Integer -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe Integer
0) (Parser (Maybe Integer) -> Parser Coin)
-> Parser (Maybe Integer) -> Parser Coin
forall a b. (a -> b) -> a -> b
$
    Parser Integer -> Parser (Maybe Integer)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional (Parser Integer -> Parser (Maybe Integer))
-> Parser Integer -> Parser (Maybe Integer)
forall a b. (a -> b) -> a -> b
$
      ReadM Integer -> Mod OptionFields Integer -> Parser Integer
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Integer
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader (Mod OptionFields Integer -> Parser Integer)
-> Mod OptionFields Integer -> Parser Integer
forall a b. (a -> b) -> a -> b
$
        [Mod OptionFields Integer] -> Mod OptionFields Integer
forall a. Monoid a => [a] -> a
mconcat
          [ FilePath -> Mod OptionFields Integer
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
"supply-delegated"
          , FilePath -> Mod OptionFields Integer
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"LOVELACE"
          , FilePath -> Mod OptionFields Integer
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help
              FilePath
"The initial coin supply in Lovelace which will be evenly distributed across initial, delegating stake holders."
          , Integer -> Mod OptionFields Integer
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value Integer
0
          ]

pSecurityParam :: Parser (NonZero Word64)
pSecurityParam :: Parser (NonZero Word64)
pSecurityParam =
  ReadM (NonZero Word64)
-> Mod OptionFields (NonZero Word64) -> Parser (NonZero Word64)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM (NonZero Word64)
nonZeroReader (Mod OptionFields (NonZero Word64) -> Parser (NonZero Word64))
-> Mod OptionFields (NonZero Word64) -> Parser (NonZero Word64)
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields (NonZero Word64)]
-> Mod OptionFields (NonZero Word64)
forall a. Monoid a => [a] -> a
mconcat
      [ FilePath -> Mod OptionFields (NonZero Word64)
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
"security-param"
      , FilePath -> Mod OptionFields (NonZero Word64)
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"NON_ZERO_WORD64"
      , FilePath -> Mod OptionFields (NonZero Word64)
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help FilePath
"Security parameter for genesis file [default is 108]."
      , NonZero Word64 -> Mod OptionFields (NonZero Word64)
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value (NonZero Word64 -> Mod OptionFields (NonZero Word64))
-> NonZero Word64 -> Mod OptionFields (NonZero Word64)
forall a b. (a -> b) -> a -> b
$ forall (n :: Natural) a.
(KnownNat n, 1 <= n, WithinBounds n a, Num a) =>
NonZero a
knownNonZeroBounded @108
      ]

pSlotLength :: Parser Word
pSlotLength :: Parser Word
pSlotLength =
  ReadM Word -> Mod OptionFields Word -> Parser Word
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader (Mod OptionFields Word -> Parser Word)
-> Mod OptionFields Word -> Parser Word
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Word] -> Mod OptionFields Word
forall a. Monoid a => [a] -> a
mconcat
      [ FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
"slot-length"
      , FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"INT"
      , FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help FilePath
"slot length (ms) parameter for genesis file [default is 1000]."
      , Word -> Mod OptionFields Word
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value Word
1_000
      ]

pSlotCoefficient :: Parser Rational
pSlotCoefficient :: Parser Rational
pSlotCoefficient =
  ReadM Rational -> Mod OptionFields Rational -> Parser Rational
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Rational
readRationalUnitInterval (Mod OptionFields Rational -> Parser Rational)
-> Mod OptionFields Rational -> Parser Rational
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Rational] -> Mod OptionFields Rational
forall a. Monoid a => [a] -> a
mconcat
      [ FilePath -> Mod OptionFields Rational
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
"slot-coefficient"
      , FilePath -> Mod OptionFields Rational
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"RATIONAL"
      , FilePath -> Mod OptionFields Rational
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help FilePath
"Slot Coefficient for genesis file [default is .05]."
      , Rational -> Mod OptionFields Rational
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value Rational
0.05
      ]

pBulkPoolCredFiles :: Parser Word
pBulkPoolCredFiles :: Parser Word
pBulkPoolCredFiles =
  ReadM Word -> Mod OptionFields Word -> Parser Word
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader (Mod OptionFields Word -> Parser Word)
-> Mod OptionFields Word -> Parser Word
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Word] -> Mod OptionFields Word
forall a. Monoid a => [a] -> a
mconcat
      [ FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
"bulk-pool-cred-files"
      , FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"INT"
      , FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help FilePath
"Generate bulk pool credential files [default is 0]."
      , Word -> Mod OptionFields Word
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value Word
0
      ]

pBulkPoolsPerFile :: Parser Word
pBulkPoolsPerFile :: Parser Word
pBulkPoolsPerFile =
  ReadM Word -> Mod OptionFields Word -> Parser Word
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader (Mod OptionFields Word -> Parser Word)
-> Mod OptionFields Word -> Parser Word
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Word] -> Mod OptionFields Word
forall a. Monoid a => [a] -> a
mconcat
      [ FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
"bulk-pools-per-file"
      , FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"INT"
      , FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help FilePath
"Each bulk pool to contain this many pool credential sets [default is 0]."
      , Word -> Mod OptionFields Word
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value Word
0
      ]