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

module Cardano.CLI.Legacy.Options
  ( -- * CLI command parser
    parseLegacyCmds

    -- * CLI command and flag types
  , module Cardano.CLI.Legacy.Commands

    -- * Field parser and renderers
  , parseTxIn
  , pKeyRegistDeposit
  , pStakePoolRegistrationParserRequirements
  , pStakePoolVerificationKeyOrHashOrFile
  )
where

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

import           Cardano.Chain.Common (BlockCount (BlockCount))
import           Cardano.CLI.Environment
import           Cardano.CLI.EraBased.Options.Common
import           Cardano.CLI.Legacy.Commands
import           Cardano.CLI.Legacy.Commands.Genesis
import           Cardano.CLI.Legacy.Commands.Governance
import           Cardano.CLI.Parser
import           Cardano.CLI.Types.Common

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

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

--
-- Shelley CLI command parsers
--
-- This is necessary for QA to create update proposals pre-Conway
parseLegacyCmds :: EnvCli -> Parser LegacyCmds
parseLegacyCmds :: EnvCli -> Parser LegacyCmds
parseLegacyCmds EnvCli
envCli =
  Mod CommandFields LegacyCmds -> Parser LegacyCmds
forall a. Mod CommandFields a -> Parser a
Opt.hsubparser (Mod CommandFields LegacyCmds -> Parser LegacyCmds)
-> Mod CommandFields LegacyCmds -> Parser LegacyCmds
forall a b. (a -> b) -> a -> b
$
    [Mod CommandFields LegacyCmds] -> Mod CommandFields LegacyCmds
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod CommandFields LegacyCmds
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"Legacy commands"
      , String -> Mod CommandFields LegacyCmds
forall a. String -> Mod CommandFields a
Opt.commandGroup String
"Legacy commands"
      , String -> ParserInfo LegacyCmds -> Mod CommandFields LegacyCmds
forall a. String -> ParserInfo a -> Mod CommandFields a
Opt.command String
"genesis" (ParserInfo LegacyCmds -> Mod CommandFields LegacyCmds)
-> ParserInfo LegacyCmds -> Mod CommandFields LegacyCmds
forall a b. (a -> b) -> a -> b
$
          Parser LegacyCmds -> InfoMod LegacyCmds -> ParserInfo LegacyCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (LegacyGenesisCmds -> LegacyCmds
LegacyGenesisCmds (LegacyGenesisCmds -> LegacyCmds)
-> Parser LegacyGenesisCmds -> Parser LegacyCmds
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnvCli -> Parser LegacyGenesisCmds
pGenesisCmds EnvCli
envCli) (InfoMod LegacyCmds -> ParserInfo LegacyCmds)
-> InfoMod LegacyCmds -> ParserInfo LegacyCmds
forall a b. (a -> b) -> a -> b
$
            String -> InfoMod LegacyCmds
forall a. String -> InfoMod a
Opt.progDesc String
"Genesis block commands"
      , String -> ParserInfo LegacyCmds -> Mod CommandFields LegacyCmds
forall a. String -> ParserInfo a -> Mod CommandFields a
Opt.command String
"governance" (ParserInfo LegacyCmds -> Mod CommandFields LegacyCmds)
-> ParserInfo LegacyCmds -> Mod CommandFields LegacyCmds
forall a b. (a -> b) -> a -> b
$
          Parser LegacyCmds -> InfoMod LegacyCmds -> ParserInfo LegacyCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (LegacyGovernanceCmds -> LegacyCmds
LegacyGovernanceCmds (LegacyGovernanceCmds -> LegacyCmds)
-> Parser LegacyGovernanceCmds -> Parser LegacyCmds
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnvCli -> Parser LegacyGovernanceCmds
pGovernanceCmds EnvCli
envCli) (InfoMod LegacyCmds -> ParserInfo LegacyCmds)
-> InfoMod LegacyCmds -> ParserInfo LegacyCmds
forall a b. (a -> b) -> a -> b
$
            String -> InfoMod LegacyCmds
forall a. String -> InfoMod a
Opt.progDesc String
"Governance commands"
      ]

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

  pLegacyMIRPayStakeAddresses :: Parser LegacyGovernanceCmds
  pLegacyMIRPayStakeAddresses :: Parser LegacyGovernanceCmds
pLegacyMIRPayStakeAddresses =
    EraInEon ShelleyToBabbageEra
-> MIRPot
-> [StakeAddress]
-> [Coin]
-> File () 'Out
-> LegacyGovernanceCmds
GovernanceCreateMirCertificateStakeAddressesCmd
      (EraInEon ShelleyToBabbageEra
 -> MIRPot
 -> [StakeAddress]
 -> [Coin]
 -> File () 'Out
 -> LegacyGovernanceCmds)
-> Parser (EraInEon ShelleyToBabbageEra)
-> Parser
     (MIRPot
      -> [StakeAddress]
      -> [Coin]
      -> File () 'Out
      -> LegacyGovernanceCmds)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnvCli -> Parser (EraInEon ShelleyToBabbageEra)
pAnyShelleyToBabbageEra EnvCli
envCli
      Parser
  (MIRPot
   -> [StakeAddress]
   -> [Coin]
   -> File () 'Out
   -> LegacyGovernanceCmds)
-> Parser MIRPot
-> Parser
     ([StakeAddress] -> [Coin] -> File () 'Out -> LegacyGovernanceCmds)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser MIRPot
pMIRPot
      Parser
  ([StakeAddress] -> [Coin] -> File () 'Out -> LegacyGovernanceCmds)
-> Parser [StakeAddress]
-> Parser ([Coin] -> File () 'Out -> LegacyGovernanceCmds)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser StakeAddress -> Parser [StakeAddress]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (Maybe String -> Parser StakeAddress
pStakeAddress Maybe String
forall a. Maybe a
Nothing)
      Parser ([Coin] -> File () 'Out -> LegacyGovernanceCmds)
-> Parser [Coin] -> Parser (File () 'Out -> LegacyGovernanceCmds)
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 -> Parser [Coin]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser Coin
pRewardAmt
      Parser (File () 'Out -> LegacyGovernanceCmds)
-> Parser (File () 'Out) -> Parser LegacyGovernanceCmds
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (File () 'Out)
forall content. Parser (File content 'Out)
pOutputFile

  pLegacyMIRTransferToTreasury :: Parser LegacyGovernanceCmds
  pLegacyMIRTransferToTreasury :: Parser LegacyGovernanceCmds
pLegacyMIRTransferToTreasury =
    EraInEon ShelleyToBabbageEra
-> Coin -> File () 'Out -> LegacyGovernanceCmds
GovernanceCreateMirCertificateTransferToTreasuryCmd
      (EraInEon ShelleyToBabbageEra
 -> Coin -> File () 'Out -> LegacyGovernanceCmds)
-> Parser (EraInEon ShelleyToBabbageEra)
-> Parser (Coin -> File () 'Out -> LegacyGovernanceCmds)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnvCli -> Parser (EraInEon ShelleyToBabbageEra)
pAnyShelleyToBabbageEra EnvCli
envCli
      Parser (Coin -> File () 'Out -> LegacyGovernanceCmds)
-> Parser Coin -> Parser (File () 'Out -> LegacyGovernanceCmds)
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
pTransferAmt
      Parser (File () 'Out -> LegacyGovernanceCmds)
-> Parser (File () 'Out) -> Parser LegacyGovernanceCmds
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (File () 'Out)
forall content. Parser (File content 'Out)
pOutputFile

  pLegacyMIRTransferToReserves :: Parser LegacyGovernanceCmds
  pLegacyMIRTransferToReserves :: Parser LegacyGovernanceCmds
pLegacyMIRTransferToReserves =
    EraInEon ShelleyToBabbageEra
-> Coin -> File () 'Out -> LegacyGovernanceCmds
GovernanceCreateMirCertificateTransferToReservesCmd
      (EraInEon ShelleyToBabbageEra
 -> Coin -> File () 'Out -> LegacyGovernanceCmds)
-> Parser (EraInEon ShelleyToBabbageEra)
-> Parser (Coin -> File () 'Out -> LegacyGovernanceCmds)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnvCli -> Parser (EraInEon ShelleyToBabbageEra)
pAnyShelleyToBabbageEra EnvCli
envCli
      Parser (Coin -> File () 'Out -> LegacyGovernanceCmds)
-> Parser Coin -> Parser (File () 'Out -> LegacyGovernanceCmds)
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
pTransferAmt
      Parser (File () 'Out -> LegacyGovernanceCmds)
-> Parser (File () 'Out) -> Parser LegacyGovernanceCmds
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (File () 'Out)
forall content. Parser (File content 'Out)
pOutputFile

  pGovernanceGenesisKeyDelegationCertificate :: Parser LegacyGovernanceCmds
  pGovernanceGenesisKeyDelegationCertificate :: Parser LegacyGovernanceCmds
pGovernanceGenesisKeyDelegationCertificate =
    EraInEon ShelleyToBabbageEra
-> VerificationKeyOrHashOrFile GenesisKey
-> VerificationKeyOrHashOrFile GenesisDelegateKey
-> VerificationKeyOrHashOrFile VrfKey
-> File () 'Out
-> LegacyGovernanceCmds
GovernanceGenesisKeyDelegationCertificate
      (EraInEon ShelleyToBabbageEra
 -> VerificationKeyOrHashOrFile GenesisKey
 -> VerificationKeyOrHashOrFile GenesisDelegateKey
 -> VerificationKeyOrHashOrFile VrfKey
 -> File () 'Out
 -> LegacyGovernanceCmds)
-> Parser (EraInEon ShelleyToBabbageEra)
-> Parser
     (VerificationKeyOrHashOrFile GenesisKey
      -> VerificationKeyOrHashOrFile GenesisDelegateKey
      -> VerificationKeyOrHashOrFile VrfKey
      -> File () 'Out
      -> LegacyGovernanceCmds)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnvCli -> Parser (EraInEon ShelleyToBabbageEra)
pAnyShelleyToBabbageEra EnvCli
envCli
      Parser
  (VerificationKeyOrHashOrFile GenesisKey
   -> VerificationKeyOrHashOrFile GenesisDelegateKey
   -> VerificationKeyOrHashOrFile VrfKey
   -> File () 'Out
   -> LegacyGovernanceCmds)
-> Parser (VerificationKeyOrHashOrFile GenesisKey)
-> Parser
     (VerificationKeyOrHashOrFile GenesisDelegateKey
      -> VerificationKeyOrHashOrFile VrfKey
      -> File () 'Out
      -> LegacyGovernanceCmds)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (VerificationKeyOrHashOrFile GenesisKey)
pGenesisVerificationKeyOrHashOrFile
      Parser
  (VerificationKeyOrHashOrFile GenesisDelegateKey
   -> VerificationKeyOrHashOrFile VrfKey
   -> File () 'Out
   -> LegacyGovernanceCmds)
-> Parser (VerificationKeyOrHashOrFile GenesisDelegateKey)
-> Parser
     (VerificationKeyOrHashOrFile VrfKey
      -> File () 'Out -> LegacyGovernanceCmds)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (VerificationKeyOrHashOrFile GenesisDelegateKey)
pGenesisDelegateVerificationKeyOrHashOrFile
      Parser
  (VerificationKeyOrHashOrFile VrfKey
   -> File () 'Out -> LegacyGovernanceCmds)
-> Parser (VerificationKeyOrHashOrFile VrfKey)
-> Parser (File () 'Out -> LegacyGovernanceCmds)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (VerificationKeyOrHashOrFile VrfKey)
pVrfVerificationKeyOrHashOrFile
      Parser (File () 'Out -> LegacyGovernanceCmds)
-> Parser (File () 'Out) -> Parser LegacyGovernanceCmds
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (File () 'Out)
forall content. Parser (File content 'Out)
pOutputFile

  pUpdateProposal :: Parser LegacyGovernanceCmds
  pUpdateProposal :: Parser LegacyGovernanceCmds
pUpdateProposal =
    File () 'Out
-> EpochNo
-> [VerificationKeyFile 'In]
-> ProtocolParametersUpdate
-> Maybe String
-> LegacyGovernanceCmds
GovernanceUpdateProposal
      (File () 'Out
 -> EpochNo
 -> [VerificationKeyFile 'In]
 -> ProtocolParametersUpdate
 -> Maybe String
 -> LegacyGovernanceCmds)
-> Parser (File () 'Out)
-> Parser
     (EpochNo
      -> [VerificationKeyFile 'In]
      -> ProtocolParametersUpdate
      -> Maybe String
      -> LegacyGovernanceCmds)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (File () 'Out)
forall content. Parser (File content 'Out)
pOutputFile
      Parser
  (EpochNo
   -> [VerificationKeyFile 'In]
   -> ProtocolParametersUpdate
   -> Maybe String
   -> LegacyGovernanceCmds)
-> Parser EpochNo
-> Parser
     ([VerificationKeyFile 'In]
      -> ProtocolParametersUpdate
      -> Maybe String
      -> LegacyGovernanceCmds)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser EpochNo
pEpochNoUpdateProp
      Parser
  ([VerificationKeyFile 'In]
   -> ProtocolParametersUpdate
   -> Maybe String
   -> LegacyGovernanceCmds)
-> Parser [VerificationKeyFile 'In]
-> Parser
     (ProtocolParametersUpdate -> Maybe String -> LegacyGovernanceCmds)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (VerificationKeyFile 'In)
-> Parser [VerificationKeyFile 'In]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser (VerificationKeyFile 'In)
pGenesisVerificationKeyFile
      Parser
  (ProtocolParametersUpdate -> Maybe String -> LegacyGovernanceCmds)
-> Parser ProtocolParametersUpdate
-> Parser (Maybe String -> LegacyGovernanceCmds)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ProtocolParametersUpdate
pProtocolParametersUpdate
      Parser (Maybe String -> LegacyGovernanceCmds)
-> Parser (Maybe String) -> Parser LegacyGovernanceCmds
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser String
pCostModels

pGenesisCmds :: EnvCli -> Parser LegacyGenesisCmds
pGenesisCmds :: EnvCli -> Parser LegacyGenesisCmds
pGenesisCmds EnvCli
envCli =
  [Parser LegacyGenesisCmds] -> Parser LegacyGenesisCmds
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ String -> ParserInfo LegacyGenesisCmds -> Parser LegacyGenesisCmds
forall a. String -> ParserInfo a -> Parser a
subParser String
"key-gen-genesis" (ParserInfo LegacyGenesisCmds -> Parser LegacyGenesisCmds)
-> ParserInfo LegacyGenesisCmds -> Parser LegacyGenesisCmds
forall a b. (a -> b) -> a -> b
$
        Parser LegacyGenesisCmds
-> InfoMod LegacyGenesisCmds -> ParserInfo LegacyGenesisCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser LegacyGenesisCmds
pGenesisKeyGen (InfoMod LegacyGenesisCmds -> ParserInfo LegacyGenesisCmds)
-> InfoMod LegacyGenesisCmds -> ParserInfo LegacyGenesisCmds
forall a b. (a -> b) -> a -> b
$
          String -> InfoMod LegacyGenesisCmds
forall a. String -> InfoMod a
Opt.progDesc String
"Create a Shelley genesis key pair"
    , String -> ParserInfo LegacyGenesisCmds -> Parser LegacyGenesisCmds
forall a. String -> ParserInfo a -> Parser a
subParser String
"key-gen-delegate" (ParserInfo LegacyGenesisCmds -> Parser LegacyGenesisCmds)
-> ParserInfo LegacyGenesisCmds -> Parser LegacyGenesisCmds
forall a b. (a -> b) -> a -> b
$
        Parser LegacyGenesisCmds
-> InfoMod LegacyGenesisCmds -> ParserInfo LegacyGenesisCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser LegacyGenesisCmds
pGenesisDelegateKeyGen (InfoMod LegacyGenesisCmds -> ParserInfo LegacyGenesisCmds)
-> InfoMod LegacyGenesisCmds -> ParserInfo LegacyGenesisCmds
forall a b. (a -> b) -> a -> b
$
          String -> InfoMod LegacyGenesisCmds
forall a. String -> InfoMod a
Opt.progDesc String
"Create a Shelley genesis delegate key pair"
    , String -> ParserInfo LegacyGenesisCmds -> Parser LegacyGenesisCmds
forall a. String -> ParserInfo a -> Parser a
subParser String
"key-gen-utxo" (ParserInfo LegacyGenesisCmds -> Parser LegacyGenesisCmds)
-> ParserInfo LegacyGenesisCmds -> Parser LegacyGenesisCmds
forall a b. (a -> b) -> a -> b
$
        Parser LegacyGenesisCmds
-> InfoMod LegacyGenesisCmds -> ParserInfo LegacyGenesisCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser LegacyGenesisCmds
pGenesisUTxOKeyGen (InfoMod LegacyGenesisCmds -> ParserInfo LegacyGenesisCmds)
-> InfoMod LegacyGenesisCmds -> ParserInfo LegacyGenesisCmds
forall a b. (a -> b) -> a -> b
$
          String -> InfoMod LegacyGenesisCmds
forall a. String -> InfoMod a
Opt.progDesc String
"Create a Shelley genesis UTxO key pair"
    , String -> ParserInfo LegacyGenesisCmds -> Parser LegacyGenesisCmds
forall a. String -> ParserInfo a -> Parser a
subParser String
"key-hash" (ParserInfo LegacyGenesisCmds -> Parser LegacyGenesisCmds)
-> ParserInfo LegacyGenesisCmds -> Parser LegacyGenesisCmds
forall a b. (a -> b) -> a -> b
$
        Parser LegacyGenesisCmds
-> InfoMod LegacyGenesisCmds -> ParserInfo LegacyGenesisCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser LegacyGenesisCmds
pGenesisKeyHash (InfoMod LegacyGenesisCmds -> ParserInfo LegacyGenesisCmds)
-> InfoMod LegacyGenesisCmds -> ParserInfo LegacyGenesisCmds
forall a b. (a -> b) -> a -> b
$
          String -> InfoMod LegacyGenesisCmds
forall a. String -> InfoMod a
Opt.progDesc String
"Print the identifier (hash) of a public key"
    , String -> ParserInfo LegacyGenesisCmds -> Parser LegacyGenesisCmds
forall a. String -> ParserInfo a -> Parser a
subParser String
"get-ver-key" (ParserInfo LegacyGenesisCmds -> Parser LegacyGenesisCmds)
-> ParserInfo LegacyGenesisCmds -> Parser LegacyGenesisCmds
forall a b. (a -> b) -> a -> b
$
        Parser LegacyGenesisCmds
-> InfoMod LegacyGenesisCmds -> ParserInfo LegacyGenesisCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser LegacyGenesisCmds
pGenesisVerKey (InfoMod LegacyGenesisCmds -> ParserInfo LegacyGenesisCmds)
-> InfoMod LegacyGenesisCmds -> ParserInfo LegacyGenesisCmds
forall a b. (a -> b) -> a -> b
$
          String -> InfoMod LegacyGenesisCmds
forall a. String -> InfoMod a
Opt.progDesc String
"Derive the verification key from a signing key"
    , String -> ParserInfo LegacyGenesisCmds -> Parser LegacyGenesisCmds
forall a. String -> ParserInfo a -> Parser a
subParser String
"initial-addr" (ParserInfo LegacyGenesisCmds -> Parser LegacyGenesisCmds)
-> ParserInfo LegacyGenesisCmds -> Parser LegacyGenesisCmds
forall a b. (a -> b) -> a -> b
$
        Parser LegacyGenesisCmds
-> InfoMod LegacyGenesisCmds -> ParserInfo LegacyGenesisCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser LegacyGenesisCmds
pGenesisAddr (InfoMod LegacyGenesisCmds -> ParserInfo LegacyGenesisCmds)
-> InfoMod LegacyGenesisCmds -> ParserInfo LegacyGenesisCmds
forall a b. (a -> b) -> a -> b
$
          String -> InfoMod LegacyGenesisCmds
forall a. String -> InfoMod a
Opt.progDesc String
"Get the address for an initial UTxO based on the verification key"
    , String -> ParserInfo LegacyGenesisCmds -> Parser LegacyGenesisCmds
forall a. String -> ParserInfo a -> Parser a
subParser String
"initial-txin" (ParserInfo LegacyGenesisCmds -> Parser LegacyGenesisCmds)
-> ParserInfo LegacyGenesisCmds -> Parser LegacyGenesisCmds
forall a b. (a -> b) -> a -> b
$
        Parser LegacyGenesisCmds
-> InfoMod LegacyGenesisCmds -> ParserInfo LegacyGenesisCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser LegacyGenesisCmds
pGenesisTxIn (InfoMod LegacyGenesisCmds -> ParserInfo LegacyGenesisCmds)
-> InfoMod LegacyGenesisCmds -> ParserInfo LegacyGenesisCmds
forall a b. (a -> b) -> a -> b
$
          String -> InfoMod LegacyGenesisCmds
forall a. String -> InfoMod a
Opt.progDesc String
"Get the TxIn for an initial UTxO based on the verification key"
    , String -> ParserInfo LegacyGenesisCmds -> Parser LegacyGenesisCmds
forall a. String -> ParserInfo a -> Parser a
subParser String
"create-cardano" (ParserInfo LegacyGenesisCmds -> Parser LegacyGenesisCmds)
-> ParserInfo LegacyGenesisCmds -> Parser LegacyGenesisCmds
forall a b. (a -> b) -> a -> b
$
        Parser LegacyGenesisCmds
-> InfoMod LegacyGenesisCmds -> ParserInfo LegacyGenesisCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser LegacyGenesisCmds
pGenesisCreateCardano (InfoMod LegacyGenesisCmds -> ParserInfo LegacyGenesisCmds)
-> InfoMod LegacyGenesisCmds -> ParserInfo LegacyGenesisCmds
forall a b. (a -> b) -> a -> b
$
          String -> InfoMod LegacyGenesisCmds
forall a. String -> InfoMod a
Opt.progDesc (String -> InfoMod LegacyGenesisCmds)
-> String -> InfoMod LegacyGenesisCmds
forall a b. (a -> b) -> a -> b
$
            [String] -> String
forall a. Monoid a => [a] -> a
mconcat
              [ String
"Create a Byron and Shelley genesis file from a genesis "
              , String
"template and genesis/delegation/spending keys."
              ]
    , String -> ParserInfo LegacyGenesisCmds -> Parser LegacyGenesisCmds
forall a. String -> ParserInfo a -> Parser a
subParser String
"create" (ParserInfo LegacyGenesisCmds -> Parser LegacyGenesisCmds)
-> ParserInfo LegacyGenesisCmds -> Parser LegacyGenesisCmds
forall a b. (a -> b) -> a -> b
$
        Parser LegacyGenesisCmds
-> InfoMod LegacyGenesisCmds -> ParserInfo LegacyGenesisCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser LegacyGenesisCmds
pGenesisCreate (InfoMod LegacyGenesisCmds -> ParserInfo LegacyGenesisCmds)
-> InfoMod LegacyGenesisCmds -> ParserInfo LegacyGenesisCmds
forall a b. (a -> b) -> a -> b
$
          String -> InfoMod LegacyGenesisCmds
forall a. String -> InfoMod a
Opt.progDesc (String -> InfoMod LegacyGenesisCmds)
-> String -> InfoMod LegacyGenesisCmds
forall a b. (a -> b) -> a -> b
$
            [String] -> String
forall a. Monoid a => [a] -> a
mconcat
              [ String
"Create a Shelley genesis file from a genesis "
              , String
"template and genesis/delegation/spending keys."
              ]
    , String -> ParserInfo LegacyGenesisCmds -> Parser LegacyGenesisCmds
forall a. String -> ParserInfo a -> Parser a
subParser String
"create-staked" (ParserInfo LegacyGenesisCmds -> Parser LegacyGenesisCmds)
-> ParserInfo LegacyGenesisCmds -> Parser LegacyGenesisCmds
forall a b. (a -> b) -> a -> b
$
        Parser LegacyGenesisCmds
-> InfoMod LegacyGenesisCmds -> ParserInfo LegacyGenesisCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser LegacyGenesisCmds
pGenesisCreateStaked (InfoMod LegacyGenesisCmds -> ParserInfo LegacyGenesisCmds)
-> InfoMod LegacyGenesisCmds -> ParserInfo LegacyGenesisCmds
forall a b. (a -> b) -> a -> b
$
          String -> InfoMod LegacyGenesisCmds
forall a. String -> InfoMod a
Opt.progDesc (String -> InfoMod LegacyGenesisCmds)
-> String -> InfoMod LegacyGenesisCmds
forall a b. (a -> b) -> a -> b
$
            [String] -> String
forall a. Monoid a => [a] -> a
mconcat
              [ String
"Create a staked Shelley genesis file from a genesis "
              , String
"template and genesis/delegation/spending keys."
              ]
    , String -> ParserInfo LegacyGenesisCmds -> Parser LegacyGenesisCmds
forall a. String -> ParserInfo a -> Parser a
subParser String
"hash" (ParserInfo LegacyGenesisCmds -> Parser LegacyGenesisCmds)
-> ParserInfo LegacyGenesisCmds -> Parser LegacyGenesisCmds
forall a b. (a -> b) -> a -> b
$
        Parser LegacyGenesisCmds
-> InfoMod LegacyGenesisCmds -> ParserInfo LegacyGenesisCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser LegacyGenesisCmds
pGenesisHash (InfoMod LegacyGenesisCmds -> ParserInfo LegacyGenesisCmds)
-> InfoMod LegacyGenesisCmds -> ParserInfo LegacyGenesisCmds
forall a b. (a -> b) -> a -> b
$
          String -> InfoMod LegacyGenesisCmds
forall a. String -> InfoMod a
Opt.progDesc String
"Compute the hash of a genesis file"
    ]
 where
  pGenesisKeyGen :: Parser LegacyGenesisCmds
  pGenesisKeyGen :: Parser LegacyGenesisCmds
pGenesisKeyGen =
    VerificationKeyFile 'Out
-> SigningKeyFile 'Out -> LegacyGenesisCmds
GenesisKeyGenGenesis
      (VerificationKeyFile 'Out
 -> SigningKeyFile 'Out -> LegacyGenesisCmds)
-> Parser (VerificationKeyFile 'Out)
-> Parser (SigningKeyFile 'Out -> LegacyGenesisCmds)
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 -> LegacyGenesisCmds)
-> Parser (SigningKeyFile 'Out) -> Parser LegacyGenesisCmds
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 LegacyGenesisCmds
  pGenesisDelegateKeyGen :: Parser LegacyGenesisCmds
pGenesisDelegateKeyGen =
    VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> OpCertCounterFile 'Out
-> LegacyGenesisCmds
GenesisKeyGenDelegate
      (VerificationKeyFile 'Out
 -> SigningKeyFile 'Out
 -> OpCertCounterFile 'Out
 -> LegacyGenesisCmds)
-> Parser (VerificationKeyFile 'Out)
-> Parser
     (SigningKeyFile 'Out
      -> OpCertCounterFile 'Out -> LegacyGenesisCmds)
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 -> LegacyGenesisCmds)
-> Parser (SigningKeyFile 'Out)
-> Parser (OpCertCounterFile 'Out -> LegacyGenesisCmds)
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 -> LegacyGenesisCmds)
-> Parser (OpCertCounterFile 'Out) -> Parser LegacyGenesisCmds
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 LegacyGenesisCmds
  pGenesisUTxOKeyGen :: Parser LegacyGenesisCmds
pGenesisUTxOKeyGen =
    VerificationKeyFile 'Out
-> SigningKeyFile 'Out -> LegacyGenesisCmds
GenesisKeyGenUTxO
      (VerificationKeyFile 'Out
 -> SigningKeyFile 'Out -> LegacyGenesisCmds)
-> Parser (VerificationKeyFile 'Out)
-> Parser (SigningKeyFile 'Out -> LegacyGenesisCmds)
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 -> LegacyGenesisCmds)
-> Parser (SigningKeyFile 'Out) -> Parser LegacyGenesisCmds
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 LegacyGenesisCmds
  pGenesisKeyHash :: Parser LegacyGenesisCmds
pGenesisKeyHash =
    VerificationKeyFile 'In -> LegacyGenesisCmds
GenesisCmdKeyHash
      (VerificationKeyFile 'In -> LegacyGenesisCmds)
-> Parser (VerificationKeyFile 'In) -> Parser LegacyGenesisCmds
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyFile 'In)
pVerificationKeyFileIn

  pGenesisVerKey :: Parser LegacyGenesisCmds
  pGenesisVerKey :: Parser LegacyGenesisCmds
pGenesisVerKey =
    VerificationKeyFile 'Out -> SigningKeyFile 'In -> LegacyGenesisCmds
GenesisVerKey
      (VerificationKeyFile 'Out
 -> SigningKeyFile 'In -> LegacyGenesisCmds)
-> Parser (VerificationKeyFile 'Out)
-> Parser (SigningKeyFile 'In -> LegacyGenesisCmds)
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 -> LegacyGenesisCmds)
-> Parser (SigningKeyFile 'In) -> Parser LegacyGenesisCmds
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 :: Parser LegacyGenesisCmds
  pGenesisAddr :: Parser LegacyGenesisCmds
pGenesisAddr =
    VerificationKeyFile 'In
-> NetworkId -> Maybe (File () 'Out) -> LegacyGenesisCmds
GenesisAddr
      (VerificationKeyFile 'In
 -> NetworkId -> Maybe (File () 'Out) -> LegacyGenesisCmds)
-> Parser (VerificationKeyFile 'In)
-> Parser (NetworkId -> Maybe (File () 'Out) -> LegacyGenesisCmds)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyFile 'In)
pVerificationKeyFileIn
      Parser (NetworkId -> Maybe (File () 'Out) -> LegacyGenesisCmds)
-> Parser NetworkId
-> Parser (Maybe (File () 'Out) -> LegacyGenesisCmds)
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) -> LegacyGenesisCmds)
-> Parser (Maybe (File () 'Out)) -> Parser LegacyGenesisCmds
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 :: Parser LegacyGenesisCmds
  pGenesisTxIn :: Parser LegacyGenesisCmds
pGenesisTxIn =
    VerificationKeyFile 'In
-> NetworkId -> Maybe (File () 'Out) -> LegacyGenesisCmds
GenesisTxIn
      (VerificationKeyFile 'In
 -> NetworkId -> Maybe (File () 'Out) -> LegacyGenesisCmds)
-> Parser (VerificationKeyFile 'In)
-> Parser (NetworkId -> Maybe (File () 'Out) -> LegacyGenesisCmds)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyFile 'In)
pVerificationKeyFileIn
      Parser (NetworkId -> Maybe (File () 'Out) -> LegacyGenesisCmds)
-> Parser NetworkId
-> Parser (Maybe (File () 'Out) -> LegacyGenesisCmds)
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) -> LegacyGenesisCmds)
-> Parser (Maybe (File () 'Out)) -> Parser LegacyGenesisCmds
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 :: Parser LegacyGenesisCmds
  pGenesisCreateCardano :: Parser LegacyGenesisCmds
pGenesisCreateCardano =
    EraInEon ShelleyBasedEra
-> GenesisDir
-> Word
-> Word
-> Maybe SystemStart
-> Maybe Coin
-> BlockCount
-> Word
-> Rational
-> NetworkId
-> String
-> String
-> String
-> String
-> Maybe String
-> LegacyGenesisCmds
GenesisCreateCardano
      (EraInEon ShelleyBasedEra
 -> GenesisDir
 -> Word
 -> Word
 -> Maybe SystemStart
 -> Maybe Coin
 -> BlockCount
 -> Word
 -> Rational
 -> NetworkId
 -> String
 -> String
 -> String
 -> String
 -> Maybe String
 -> LegacyGenesisCmds)
-> Parser (EraInEon ShelleyBasedEra)
-> Parser
     (GenesisDir
      -> Word
      -> Word
      -> Maybe SystemStart
      -> Maybe Coin
      -> BlockCount
      -> Word
      -> Rational
      -> NetworkId
      -> String
      -> String
      -> String
      -> String
      -> Maybe String
      -> LegacyGenesisCmds)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnvCli -> Parser (EraInEon ShelleyBasedEra)
pAnyShelleyBasedEra EnvCli
envCli
      Parser
  (GenesisDir
   -> Word
   -> Word
   -> Maybe SystemStart
   -> Maybe Coin
   -> BlockCount
   -> Word
   -> Rational
   -> NetworkId
   -> String
   -> String
   -> String
   -> String
   -> Maybe String
   -> LegacyGenesisCmds)
-> Parser GenesisDir
-> Parser
     (Word
      -> Word
      -> Maybe SystemStart
      -> Maybe Coin
      -> BlockCount
      -> Word
      -> Rational
      -> NetworkId
      -> String
      -> String
      -> String
      -> String
      -> Maybe String
      -> LegacyGenesisCmds)
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
   -> BlockCount
   -> Word
   -> Rational
   -> NetworkId
   -> String
   -> String
   -> String
   -> String
   -> Maybe String
   -> LegacyGenesisCmds)
-> Parser Word
-> Parser
     (Word
      -> Maybe SystemStart
      -> Maybe Coin
      -> BlockCount
      -> Word
      -> Rational
      -> NetworkId
      -> String
      -> String
      -> String
      -> String
      -> Maybe String
      -> LegacyGenesisCmds)
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
   -> BlockCount
   -> Word
   -> Rational
   -> NetworkId
   -> String
   -> String
   -> String
   -> String
   -> Maybe String
   -> LegacyGenesisCmds)
-> Parser Word
-> Parser
     (Maybe SystemStart
      -> Maybe Coin
      -> BlockCount
      -> Word
      -> Rational
      -> NetworkId
      -> String
      -> String
      -> String
      -> String
      -> Maybe String
      -> LegacyGenesisCmds)
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
   -> BlockCount
   -> Word
   -> Rational
   -> NetworkId
   -> String
   -> String
   -> String
   -> String
   -> Maybe String
   -> LegacyGenesisCmds)
-> Parser (Maybe SystemStart)
-> Parser
     (Maybe Coin
      -> BlockCount
      -> Word
      -> Rational
      -> NetworkId
      -> String
      -> String
      -> String
      -> String
      -> Maybe String
      -> LegacyGenesisCmds)
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
   -> BlockCount
   -> Word
   -> Rational
   -> NetworkId
   -> String
   -> String
   -> String
   -> String
   -> Maybe String
   -> LegacyGenesisCmds)
-> Parser (Maybe Coin)
-> Parser
     (BlockCount
      -> Word
      -> Rational
      -> NetworkId
      -> String
      -> String
      -> String
      -> String
      -> Maybe String
      -> LegacyGenesisCmds)
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
  (BlockCount
   -> Word
   -> Rational
   -> NetworkId
   -> String
   -> String
   -> String
   -> String
   -> Maybe String
   -> LegacyGenesisCmds)
-> Parser BlockCount
-> Parser
     (Word
      -> Rational
      -> NetworkId
      -> String
      -> String
      -> String
      -> String
      -> Maybe String
      -> LegacyGenesisCmds)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word64 -> BlockCount
BlockCount (Word64 -> BlockCount) -> Parser Word64 -> Parser BlockCount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word64
pSecurityParam)
      Parser
  (Word
   -> Rational
   -> NetworkId
   -> String
   -> String
   -> String
   -> String
   -> Maybe String
   -> LegacyGenesisCmds)
-> Parser Word
-> Parser
     (Rational
      -> NetworkId
      -> String
      -> String
      -> String
      -> String
      -> Maybe String
      -> LegacyGenesisCmds)
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
   -> String
   -> String
   -> String
   -> String
   -> Maybe String
   -> LegacyGenesisCmds)
-> Parser Rational
-> Parser
     (NetworkId
      -> String
      -> String
      -> String
      -> String
      -> Maybe String
      -> LegacyGenesisCmds)
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
   -> String
   -> String
   -> String
   -> String
   -> Maybe String
   -> LegacyGenesisCmds)
-> Parser NetworkId
-> Parser
     (String
      -> String -> String -> String -> Maybe String -> LegacyGenesisCmds)
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
  (String
   -> String -> String -> String -> Maybe String -> LegacyGenesisCmds)
-> Parser String
-> Parser
     (String -> String -> String -> Maybe String -> LegacyGenesisCmds)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> Parser String
parseFilePath
        String
"byron-template"
        String
"JSON file with genesis defaults for each byron."
      Parser
  (String -> String -> String -> Maybe String -> LegacyGenesisCmds)
-> Parser String
-> Parser (String -> String -> Maybe String -> LegacyGenesisCmds)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> Parser String
parseFilePath
        String
"shelley-template"
        String
"JSON file with genesis defaults for each shelley."
      Parser (String -> String -> Maybe String -> LegacyGenesisCmds)
-> Parser String
-> Parser (String -> Maybe String -> LegacyGenesisCmds)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> Parser String
parseFilePath
        String
"alonzo-template"
        String
"JSON file with genesis defaults for alonzo."
      Parser (String -> Maybe String -> LegacyGenesisCmds)
-> Parser String -> Parser (Maybe String -> LegacyGenesisCmds)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> Parser String
parseFilePath
        String
"conway-template"
        String
"JSON file with genesis defaults for conway."
      Parser (Maybe String -> LegacyGenesisCmds)
-> Parser (Maybe String) -> Parser LegacyGenesisCmds
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 String)
pNodeConfigTemplate

  pGenesisCreate :: Parser LegacyGenesisCmds
  pGenesisCreate :: Parser LegacyGenesisCmds
pGenesisCreate =
    EraInEon ShelleyBasedEra
-> KeyOutputFormat
-> GenesisDir
-> Word
-> Word
-> Maybe SystemStart
-> Maybe Coin
-> NetworkId
-> LegacyGenesisCmds
GenesisCreate
      (EraInEon ShelleyBasedEra
 -> KeyOutputFormat
 -> GenesisDir
 -> Word
 -> Word
 -> Maybe SystemStart
 -> Maybe Coin
 -> NetworkId
 -> LegacyGenesisCmds)
-> Parser (EraInEon ShelleyBasedEra)
-> Parser
     (KeyOutputFormat
      -> GenesisDir
      -> Word
      -> Word
      -> Maybe SystemStart
      -> Maybe Coin
      -> NetworkId
      -> LegacyGenesisCmds)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnvCli -> Parser (EraInEon ShelleyBasedEra)
pAnyShelleyBasedEra EnvCli
envCli
      Parser
  (KeyOutputFormat
   -> GenesisDir
   -> Word
   -> Word
   -> Maybe SystemStart
   -> Maybe Coin
   -> NetworkId
   -> LegacyGenesisCmds)
-> Parser KeyOutputFormat
-> Parser
     (GenesisDir
      -> Word
      -> Word
      -> Maybe SystemStart
      -> Maybe Coin
      -> NetworkId
      -> LegacyGenesisCmds)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser KeyOutputFormat
pKeyOutputFormat
      Parser
  (GenesisDir
   -> Word
   -> Word
   -> Maybe SystemStart
   -> Maybe Coin
   -> NetworkId
   -> LegacyGenesisCmds)
-> Parser GenesisDir
-> Parser
     (Word
      -> Word
      -> Maybe SystemStart
      -> Maybe Coin
      -> NetworkId
      -> LegacyGenesisCmds)
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
   -> LegacyGenesisCmds)
-> Parser Word
-> Parser
     (Word
      -> Maybe SystemStart
      -> Maybe Coin
      -> NetworkId
      -> LegacyGenesisCmds)
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
   -> LegacyGenesisCmds)
-> Parser Word
-> Parser
     (Maybe SystemStart -> Maybe Coin -> NetworkId -> LegacyGenesisCmds)
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 -> LegacyGenesisCmds)
-> Parser (Maybe SystemStart)
-> Parser (Maybe Coin -> NetworkId -> LegacyGenesisCmds)
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 -> LegacyGenesisCmds)
-> Parser (Maybe Coin) -> Parser (NetworkId -> LegacyGenesisCmds)
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 -> LegacyGenesisCmds)
-> Parser NetworkId -> Parser LegacyGenesisCmds
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 :: Parser LegacyGenesisCmds
  pGenesisCreateStaked :: Parser LegacyGenesisCmds
pGenesisCreateStaked =
    EraInEon ShelleyBasedEra
-> KeyOutputFormat
-> GenesisDir
-> Word
-> Word
-> Word
-> Word
-> Maybe SystemStart
-> Maybe Coin
-> Coin
-> NetworkId
-> Word
-> Word
-> Word
-> Maybe String
-> LegacyGenesisCmds
GenesisCreateStaked
      (EraInEon ShelleyBasedEra
 -> KeyOutputFormat
 -> GenesisDir
 -> Word
 -> Word
 -> Word
 -> Word
 -> Maybe SystemStart
 -> Maybe Coin
 -> Coin
 -> NetworkId
 -> Word
 -> Word
 -> Word
 -> Maybe String
 -> LegacyGenesisCmds)
-> Parser (EraInEon ShelleyBasedEra)
-> Parser
     (KeyOutputFormat
      -> GenesisDir
      -> Word
      -> Word
      -> Word
      -> Word
      -> Maybe SystemStart
      -> Maybe Coin
      -> Coin
      -> NetworkId
      -> Word
      -> Word
      -> Word
      -> Maybe String
      -> LegacyGenesisCmds)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnvCli -> Parser (EraInEon ShelleyBasedEra)
pAnyShelleyBasedEra EnvCli
envCli
      Parser
  (KeyOutputFormat
   -> GenesisDir
   -> Word
   -> Word
   -> Word
   -> Word
   -> Maybe SystemStart
   -> Maybe Coin
   -> Coin
   -> NetworkId
   -> Word
   -> Word
   -> Word
   -> Maybe String
   -> LegacyGenesisCmds)
-> Parser KeyOutputFormat
-> Parser
     (GenesisDir
      -> Word
      -> Word
      -> Word
      -> Word
      -> Maybe SystemStart
      -> Maybe Coin
      -> Coin
      -> NetworkId
      -> Word
      -> Word
      -> Word
      -> Maybe String
      -> LegacyGenesisCmds)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser KeyOutputFormat
pKeyOutputFormat
      Parser
  (GenesisDir
   -> Word
   -> Word
   -> Word
   -> Word
   -> Maybe SystemStart
   -> Maybe Coin
   -> Coin
   -> NetworkId
   -> Word
   -> Word
   -> Word
   -> Maybe String
   -> LegacyGenesisCmds)
-> Parser GenesisDir
-> Parser
     (Word
      -> Word
      -> Word
      -> Word
      -> Maybe SystemStart
      -> Maybe Coin
      -> Coin
      -> NetworkId
      -> Word
      -> Word
      -> Word
      -> Maybe String
      -> LegacyGenesisCmds)
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 String
   -> LegacyGenesisCmds)
-> Parser Word
-> Parser
     (Word
      -> Word
      -> Word
      -> Maybe SystemStart
      -> Maybe Coin
      -> Coin
      -> NetworkId
      -> Word
      -> Word
      -> Word
      -> Maybe String
      -> LegacyGenesisCmds)
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 String
   -> LegacyGenesisCmds)
-> Parser Word
-> Parser
     (Word
      -> Word
      -> Maybe SystemStart
      -> Maybe Coin
      -> Coin
      -> NetworkId
      -> Word
      -> Word
      -> Word
      -> Maybe String
      -> LegacyGenesisCmds)
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 String
   -> LegacyGenesisCmds)
-> Parser Word
-> Parser
     (Word
      -> Maybe SystemStart
      -> Maybe Coin
      -> Coin
      -> NetworkId
      -> Word
      -> Word
      -> Word
      -> Maybe String
      -> LegacyGenesisCmds)
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 String
   -> LegacyGenesisCmds)
-> Parser Word
-> Parser
     (Maybe SystemStart
      -> Maybe Coin
      -> Coin
      -> NetworkId
      -> Word
      -> Word
      -> Word
      -> Maybe String
      -> LegacyGenesisCmds)
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 String
   -> LegacyGenesisCmds)
-> Parser (Maybe SystemStart)
-> Parser
     (Maybe Coin
      -> Coin
      -> NetworkId
      -> Word
      -> Word
      -> Word
      -> Maybe String
      -> LegacyGenesisCmds)
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 String
   -> LegacyGenesisCmds)
-> Parser (Maybe Coin)
-> Parser
     (Coin
      -> NetworkId
      -> Word
      -> Word
      -> Word
      -> Maybe String
      -> LegacyGenesisCmds)
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 String
   -> LegacyGenesisCmds)
-> Parser Coin
-> Parser
     (NetworkId
      -> Word -> Word -> Word -> Maybe String -> LegacyGenesisCmds)
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 String -> LegacyGenesisCmds)
-> Parser NetworkId
-> Parser
     (Word -> Word -> Word -> Maybe String -> LegacyGenesisCmds)
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 String -> LegacyGenesisCmds)
-> Parser Word
-> Parser (Word -> Word -> Maybe String -> LegacyGenesisCmds)
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 String -> LegacyGenesisCmds)
-> Parser Word
-> Parser (Word -> Maybe String -> LegacyGenesisCmds)
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 String -> LegacyGenesisCmds)
-> Parser Word -> Parser (Maybe String -> LegacyGenesisCmds)
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 String -> LegacyGenesisCmds)
-> Parser (Maybe String) -> Parser LegacyGenesisCmds
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional Parser String
pRelayJsonFp

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

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

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

  pGenesisNumGenesisKeys :: Parser Word
  pGenesisNumGenesisKeys :: Parser Word
pGenesisNumGenesisKeys =
    ReadM Word -> Mod OptionFields Word -> Parser Word
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word
forall a. (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
        [ String -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"gen-genesis-keys"
        , String -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"INT"
        , String -> Mod OptionFields Word
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"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 String)
pNodeConfigTemplate = Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser String -> Parser (Maybe String))
-> Parser String -> Parser (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> String -> Parser String
parseFilePath String
"node-config-template" String
"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
        [ String -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"gen-utxo-keys"
        , String -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"INT"
        , String -> Mod OptionFields Word
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"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
        [ String -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"gen-pools"
        , String -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"INT"
        , String -> Mod OptionFields Word
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The number of stake pool credential sets to make [default is 0]."
        , 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
        [ String -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"gen-stake-delegs"
        , String -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"INT"
        , String -> Mod OptionFields Word
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The number of stake delegator credential sets to make [default is 0]."
        , 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
        [ String -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"num-stuffed-utxo"
        , String -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"INT"
        , String -> Mod OptionFields Word
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The number of fake UTxO entries to generate [default is 0]."
        , Word -> Mod OptionFields Word
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value Word
0
        ]

  pRelayJsonFp :: Parser FilePath
  pRelayJsonFp :: Parser String
pRelayJsonFp =
    String -> String -> Parser String
parseFilePath String
"relay-specification-file" String
"JSON file specified the relays of each stake pool."

  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
            [ String -> Mod OptionFields Integer
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"supply"
            , String -> Mod OptionFields Integer
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"LOVELACE"
            , String -> Mod OptionFields Integer
forall (f :: * -> *) a. String -> Mod f a
Opt.help
                String
"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
            [ String -> Mod OptionFields Integer
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"supply-delegated"
            , String -> Mod OptionFields Integer
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"LOVELACE"
            , String -> Mod OptionFields Integer
forall (f :: * -> *) a. String -> Mod f a
Opt.help
                String
"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 Word64
  pSecurityParam :: Parser Word64
pSecurityParam =
    ReadM Word64 -> Mod OptionFields Word64 -> Parser Word64
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word64
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader (Mod OptionFields Word64 -> Parser Word64)
-> Mod OptionFields Word64 -> Parser Word64
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields Word64] -> Mod OptionFields Word64
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod OptionFields Word64
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"security-param"
        , String -> Mod OptionFields Word64
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"INT"
        , String -> Mod OptionFields Word64
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Security parameter for genesis file [default is 108]."
        , Word64 -> Mod OptionFields Word64
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value Word64
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
        [ String -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"slot-length"
        , String -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"INT"
        , String -> Mod OptionFields Word
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"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
1000
        ]

  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
        [ String -> Mod OptionFields Rational
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"slot-coefficient"
        , String -> Mod OptionFields Rational
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"RATIONAL"
        , String -> Mod OptionFields Rational
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"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
        [ String -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"bulk-pool-cred-files"
        , String -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"INT"
        , String -> Mod OptionFields Word
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"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
        [ String -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"bulk-pools-per-file"
        , String -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"INT"
        , String -> Mod OptionFields Word
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Each bulk pool to contain this many pool credential sets [default is 0]."
        , Word -> Mod OptionFields Word
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value Word
0
        ]