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

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

module Cardano.CLI.EraBased.Options.Common where

import           Cardano.Api hiding (bounded, parseFilePath)
import qualified Cardano.Api.Ledger as L
import           Cardano.Api.Shelley hiding (bounded, parseFilePath)

import           Cardano.CLI.Environment (EnvCli (..), envCliAnyEon)
import           Cardano.CLI.Parser
import           Cardano.CLI.Read
import           Cardano.CLI.Types.Common
import           Cardano.CLI.Types.Governance
import           Cardano.CLI.Types.Key
import           Cardano.CLI.Types.Key.VerificationKey
import qualified Ouroboros.Network.Protocol.LocalStateQuery.Type as Consensus

import           Control.Monad (void, when)
import qualified Data.Aeson as Aeson
import           Data.Bifunctor
import           Data.Bits (Bits, toIntegralSized)
import           Data.ByteString (ByteString)
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Char8 as BSC
import           Data.Data (Proxy (..), Typeable, typeRep)
import           Data.Foldable
import           Data.Functor (($>))
import qualified Data.IP as IP
import           Data.List.NonEmpty (NonEmpty)
import           Data.Maybe
import           Data.Text (Text)
import qualified Data.Text as Text
import           Data.Time.Clock (UTCTime)
import           Data.Time.Format (defaultTimeLocale, parseTimeOrError)
import           Data.Word
import           GHC.Exts (IsList (..))
import           GHC.Natural (Natural)
import           Network.Socket (PortNumber)
import           Options.Applicative hiding (help, str)
import qualified Options.Applicative as Opt
import qualified Text.Parsec as Parsec
import           Text.Parsec ((<?>))
import qualified Text.Parsec.Error as Parsec
import qualified Text.Parsec.Language as Parsec
import qualified Text.Parsec.String as Parsec
import qualified Text.Parsec.Token as Parsec
import qualified Text.Read as Read
import           Text.Read (readEither, readMaybe)

command' :: String -> String -> Parser a -> Mod CommandFields a
command' :: forall a. String -> String -> Parser a -> Mod CommandFields a
command' String
c String
descr Parser a
p =
  [Mod CommandFields a] -> Mod CommandFields a
forall a. Monoid a => [a] -> a
mconcat
    [ String -> ParserInfo a -> Mod CommandFields a
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
c (Parser a -> InfoMod a -> ParserInfo a
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser a
p Parser a -> Parser (a -> a) -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (a -> a)
forall a. Parser (a -> a)
helper) (InfoMod a -> ParserInfo a) -> InfoMod a -> ParserInfo a
forall a b. (a -> b) -> a -> b
$ [InfoMod a] -> InfoMod a
forall a. Monoid a => [a] -> a
mconcat [String -> InfoMod a
forall a. String -> InfoMod a
progDesc String
descr])
    , String -> Mod CommandFields a
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
c
    ]

-- | @prefixFlag Nothing bar@ is @bar@, while @prefixFlag (Just "foo") bar@ is @foo-bar@.
-- This function is used to optionally prefix some long flags
prefixFlag :: Maybe String -> String -> String
prefixFlag :: Maybe String -> String -> String
prefixFlag Maybe String
prefix String
longFlag =
  case Maybe String
prefix of
    Maybe String
Nothing -> String
longFlag
    Just String
prefix' -> String
prefix' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"-" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
longFlag

bounded :: forall a. (Bounded a, Integral a, Show a) => String -> Opt.ReadM a
bounded :: forall a. (Bounded a, Integral a, Show a) => String -> ReadM a
bounded String
t = (String -> Either String a) -> ReadM a
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader ((String -> Either String a) -> ReadM a)
-> (String -> Either String a) -> ReadM a
forall a b. (a -> b) -> a -> b
$ \String
s -> do
  Integer
i <- forall a. Read a => String -> Either String a
Read.readEither @Integer String
s
  Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
minBound @a)) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$ String -> Either String ()
forall a b. a -> Either a b
Left (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$ String
t String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" must not be less than " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show (forall a. Bounded a => a
minBound @a)
  Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound @a)) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$ String -> Either String ()
forall a b. a -> Either a b
Left (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$ String
t String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" must not greater than " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show (forall a. Bounded a => a
maxBound @a)
  a -> Either String a
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i)

parseFilePath :: String -> String -> Opt.Parser FilePath
parseFilePath :: String -> String -> Parser String
parseFilePath String
optname String
desc =
  Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
    ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
optname
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILEPATH"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
desc
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
    )

pNetworkIdDeprecated :: Parser NetworkId
pNetworkIdDeprecated :: Parser NetworkId
pNetworkIdDeprecated =
  [Parser NetworkId] -> Parser NetworkId
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ NetworkId -> Mod FlagFields NetworkId -> Parser NetworkId
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' NetworkId
Mainnet (Mod FlagFields NetworkId -> Parser NetworkId)
-> Mod FlagFields NetworkId -> Parser NetworkId
forall a b. (a -> b) -> a -> b
$
        [Mod FlagFields NetworkId] -> Mod FlagFields NetworkId
forall a. Monoid a => [a] -> a
mconcat
          [ String -> Mod FlagFields NetworkId
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"mainnet"
          , String -> Mod FlagFields NetworkId
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"DEPRECATED. This argument has no effect."
          ]
    , (Word32 -> NetworkId) -> Parser Word32 -> Parser NetworkId
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NetworkMagic -> NetworkId
Testnet (NetworkMagic -> NetworkId)
-> (Word32 -> NetworkMagic) -> Word32 -> NetworkId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> NetworkMagic
NetworkMagic) (Parser Word32 -> Parser NetworkId)
-> Parser Word32 -> Parser NetworkId
forall a b. (a -> b) -> a -> b
$
        ReadM Word32 -> Mod OptionFields Word32 -> Parser Word32
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (String -> ReadM Word32
forall a. (Bounded a, Integral a, Show a) => String -> ReadM a
bounded String
"TESTNET_MAGIC") (Mod OptionFields Word32 -> Parser Word32)
-> Mod OptionFields Word32 -> Parser Word32
forall a b. (a -> b) -> a -> b
$
          [Mod OptionFields Word32] -> Mod OptionFields Word32
forall a. Monoid a => [a] -> a
mconcat
            [ String -> Mod OptionFields Word32
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"testnet-magic"
            , String -> Mod OptionFields Word32
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"NATURAL"
            , String -> Mod OptionFields Word32
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"DEPRECATED. This argument has no effect."
            ]
    ]

pNetworkId :: EnvCli -> Parser NetworkId
pNetworkId :: EnvCli -> Parser NetworkId
pNetworkId EnvCli
envCli =
  [Parser NetworkId] -> Parser NetworkId
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([Parser NetworkId] -> Parser NetworkId)
-> [Parser NetworkId] -> Parser NetworkId
forall a b. (a -> b) -> a -> b
$
    [[Parser NetworkId]] -> [Parser NetworkId]
forall a. Monoid a => [a] -> a
mconcat
      [
        [ NetworkId -> Mod FlagFields NetworkId -> Parser NetworkId
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' NetworkId
Mainnet (Mod FlagFields NetworkId -> Parser NetworkId)
-> Mod FlagFields NetworkId -> Parser NetworkId
forall a b. (a -> b) -> a -> b
$
            [Mod FlagFields NetworkId] -> Mod FlagFields NetworkId
forall a. Monoid a => [a] -> a
mconcat
              [ String -> Mod FlagFields NetworkId
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"mainnet"
              , String -> Mod FlagFields NetworkId
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod FlagFields NetworkId)
-> String -> Mod FlagFields NetworkId
forall a b. (a -> b) -> a -> b
$
                  [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                    [ String
"Use the mainnet magic id. This overrides the CARDANO_NODE_NETWORK_ID "
                    , String
"environment variable"
                    ]
              ]
        , (Word32 -> NetworkId) -> Parser Word32 -> Parser NetworkId
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NetworkMagic -> NetworkId
Testnet (NetworkMagic -> NetworkId)
-> (Word32 -> NetworkMagic) -> Word32 -> NetworkId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> NetworkMagic
NetworkMagic) (Parser Word32 -> Parser NetworkId)
-> Parser Word32 -> Parser NetworkId
forall a b. (a -> b) -> a -> b
$
            ReadM Word32 -> Mod OptionFields Word32 -> Parser Word32
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (String -> ReadM Word32
forall a. (Bounded a, Integral a, Show a) => String -> ReadM a
bounded String
"TESTNET_MAGIC") (Mod OptionFields Word32 -> Parser Word32)
-> Mod OptionFields Word32 -> Parser Word32
forall a b. (a -> b) -> a -> b
$
              [Mod OptionFields Word32] -> Mod OptionFields Word32
forall a. Monoid a => [a] -> a
mconcat
                [ String -> Mod OptionFields Word32
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"testnet-magic"
                , String -> Mod OptionFields Word32
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"NATURAL"
                , String -> Mod OptionFields Word32
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod OptionFields Word32)
-> String -> Mod OptionFields Word32
forall a b. (a -> b) -> a -> b
$
                    [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                      [ String
"Specify a testnet magic id. This overrides the CARDANO_NODE_NETWORK_ID "
                      , String
"environment variable"
                      ]
                ]
        ]
      , -- Default to the network id specified by the environment variable if it is available.
        NetworkId -> Parser NetworkId
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NetworkId -> Parser NetworkId)
-> [NetworkId] -> [Parser NetworkId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe NetworkId -> [NetworkId]
forall a. Maybe a -> [a]
maybeToList (EnvCli -> Maybe NetworkId
envCliNetworkId EnvCli
envCli)
      ]

pTarget :: ShelleyBasedEra era -> Parser (Consensus.Target ChainPoint)
pTarget :: forall era. ShelleyBasedEra era -> Parser (Target ChainPoint)
pTarget ShelleyBasedEra era
sbe =
  Parser (Target ChainPoint)
-> (ConwayEraOnwards era -> Parser (Target ChainPoint))
-> Maybe (ConwayEraOnwards era)
-> Parser (Target ChainPoint)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Target ChainPoint -> Parser (Target ChainPoint)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Target ChainPoint
forall point. Target point
Consensus.VolatileTip) ConwayEraOnwards era -> Parser (Target ChainPoint)
forall era. ConwayEraOnwards era -> Parser (Target ChainPoint)
pTargetFromConway (ShelleyBasedEra era -> Maybe (ConwayEraOnwards era)
forall (eon :: * -> *) era.
Eon eon =>
ShelleyBasedEra era -> Maybe (eon era)
forShelleyBasedEraMaybeEon ShelleyBasedEra era
sbe)
 where
  pTargetFromConway :: ConwayEraOnwards era -> Parser (Consensus.Target ChainPoint)
  pTargetFromConway :: forall era. ConwayEraOnwards era -> Parser (Target ChainPoint)
pTargetFromConway ConwayEraOnwards era
_ =
    [Parser (Target ChainPoint)] -> Parser (Target ChainPoint)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([Parser (Target ChainPoint)] -> Parser (Target ChainPoint))
-> [Parser (Target ChainPoint)] -> Parser (Target ChainPoint)
forall a b. (a -> b) -> a -> b
$
      [[Parser (Target ChainPoint)]] -> [Parser (Target ChainPoint)]
forall a. Monoid a => [a] -> a
mconcat
        [
          [ Target ChainPoint
-> Mod FlagFields (Target ChainPoint) -> Parser (Target ChainPoint)
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' Target ChainPoint
forall point. Target point
Consensus.VolatileTip (Mod FlagFields (Target ChainPoint) -> Parser (Target ChainPoint))
-> Mod FlagFields (Target ChainPoint) -> Parser (Target ChainPoint)
forall a b. (a -> b) -> a -> b
$
              [Mod FlagFields (Target ChainPoint)]
-> Mod FlagFields (Target ChainPoint)
forall a. Monoid a => [a] -> a
mconcat
                [ String -> Mod FlagFields (Target ChainPoint)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"volatile-tip"
                , String -> Mod FlagFields (Target ChainPoint)
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod FlagFields (Target ChainPoint))
-> String -> Mod FlagFields (Target ChainPoint)
forall a b. (a -> b) -> a -> b
$
                    [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                      [ String
"Use the volatile tip as a target. (This is the default)"
                      ]
                ]
          , Target ChainPoint
-> Mod FlagFields (Target ChainPoint) -> Parser (Target ChainPoint)
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' Target ChainPoint
forall point. Target point
Consensus.ImmutableTip (Mod FlagFields (Target ChainPoint) -> Parser (Target ChainPoint))
-> Mod FlagFields (Target ChainPoint) -> Parser (Target ChainPoint)
forall a b. (a -> b) -> a -> b
$
              [Mod FlagFields (Target ChainPoint)]
-> Mod FlagFields (Target ChainPoint)
forall a. Monoid a => [a] -> a
mconcat
                [ String -> Mod FlagFields (Target ChainPoint)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"immutable-tip"
                , String -> Mod FlagFields (Target ChainPoint)
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod FlagFields (Target ChainPoint))
-> String -> Mod FlagFields (Target ChainPoint)
forall a b. (a -> b) -> a -> b
$
                    [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                      [ String
"Use the immutable tip as a target."
                      ]
                ]
          ]
        , -- Default to volatile tip if not specified
          [Target ChainPoint -> Parser (Target ChainPoint)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Target ChainPoint
forall point. Target point
Consensus.VolatileTip]
        ]

toUnitIntervalOrErr :: Rational -> L.UnitInterval
toUnitIntervalOrErr :: Rational -> UnitInterval
toUnitIntervalOrErr Rational
r = case Rational -> Maybe UnitInterval
forall r. BoundedRational r => Rational -> Maybe r
L.boundRational Rational
r of
  Maybe UnitInterval
Nothing ->
    String -> UnitInterval
forall a. HasCallStack => String -> a
error (String -> UnitInterval) -> String -> UnitInterval
forall a b. (a -> b) -> a -> b
$
      [String] -> String
forall a. Monoid a => [a] -> a
mconcat
        [ String
"toUnitIntervalOrErr: "
        , String
"rational out of bounds " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Rational -> String
forall a. Show a => a -> String
show Rational
r
        ]
  Just UnitInterval
n -> UnitInterval
n

pConsensusModeParams :: Parser ConsensusModeParams
pConsensusModeParams :: Parser ConsensusModeParams
pConsensusModeParams =
  [Parser ConsensusModeParams] -> Parser ConsensusModeParams
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ Parser ()
pCardanoMode Parser ()
-> Parser ConsensusModeParams -> Parser ConsensusModeParams
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ConsensusModeParams
pCardanoConsensusMode
    , Parser ConsensusModeParams
pDefaultConsensusMode
    ]
 where
  pCardanoMode :: Parser ()
  pCardanoMode :: Parser ()
pCardanoMode =
    () -> Mod FlagFields () -> Parser ()
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' () (Mod FlagFields () -> Parser ()) -> Mod FlagFields () -> Parser ()
forall a b. (a -> b) -> a -> b
$
      [Mod FlagFields ()] -> Mod FlagFields ()
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod FlagFields ()
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"cardano-mode"
        , String -> Mod FlagFields ()
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"For talking to a node running in full Cardano mode (default)."
        ]

  pCardanoConsensusMode :: Parser ConsensusModeParams
  pCardanoConsensusMode :: Parser ConsensusModeParams
pCardanoConsensusMode = EpochSlots -> ConsensusModeParams
CardanoModeParams (EpochSlots -> ConsensusModeParams)
-> Parser EpochSlots -> Parser ConsensusModeParams
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser EpochSlots
pEpochSlots

  pDefaultConsensusMode :: Parser ConsensusModeParams
  pDefaultConsensusMode :: Parser ConsensusModeParams
pDefaultConsensusMode =
    ConsensusModeParams -> Parser ConsensusModeParams
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConsensusModeParams -> Parser ConsensusModeParams)
-> (EpochSlots -> ConsensusModeParams)
-> EpochSlots
-> Parser ConsensusModeParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochSlots -> ConsensusModeParams
CardanoModeParams (EpochSlots -> Parser ConsensusModeParams)
-> EpochSlots -> Parser ConsensusModeParams
forall a b. (a -> b) -> a -> b
$ Word64 -> EpochSlots
EpochSlots Word64
defaultByronEpochSlots

defaultByronEpochSlots :: Word64
defaultByronEpochSlots :: Word64
defaultByronEpochSlots = Word64
21600

pEpochSlots :: Parser EpochSlots
pEpochSlots :: Parser EpochSlots
pEpochSlots =
  (Word64 -> EpochSlots) -> Parser Word64 -> Parser EpochSlots
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> EpochSlots
EpochSlots (Parser Word64 -> Parser EpochSlots)
-> Parser Word64 -> Parser EpochSlots
forall a b. (a -> b) -> a -> b
$
    ReadM Word64 -> Mod OptionFields Word64 -> Parser Word64
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (String -> ReadM Word64
forall a. (Bounded a, Integral a, Show a) => String -> ReadM a
bounded String
"SLOTS") (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
"epoch-slots"
        , String -> Mod OptionFields Word64
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"SLOTS"
        , String -> Mod OptionFields Word64
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The number of slots per epoch for the Byron era."
        , Word64 -> Mod OptionFields Word64
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value Word64
defaultByronEpochSlots -- Default to the mainnet value.
        , Mod OptionFields Word64
forall a (f :: * -> *). Show a => Mod f a
Opt.showDefault
        ]

pSocketPath :: EnvCli -> Parser SocketPath
pSocketPath :: EnvCli -> Parser SocketPath
pSocketPath EnvCli
envCli =
  [Parser SocketPath] -> Parser SocketPath
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([Parser SocketPath] -> Parser SocketPath)
-> [Parser SocketPath] -> Parser SocketPath
forall a b. (a -> b) -> a -> b
$
    [[Parser SocketPath]] -> [Parser SocketPath]
forall a. Monoid a => [a] -> a
mconcat
      [
        [ (String -> SocketPath) -> Parser String -> Parser SocketPath
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> SocketPath
forall content (direction :: FileDirection).
String -> File content direction
File (Parser String -> Parser SocketPath)
-> Parser String -> Parser SocketPath
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
"socket-path"
                , String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"SOCKET_PATH"
                , String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod OptionFields String)
-> String -> Mod OptionFields String
forall a b. (a -> b) -> a -> b
$
                    [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                      [ String
"Path to the node socket.  This overrides the CARDANO_NODE_SOCKET_PATH "
                      , String
"environment variable.  The argument is optional if CARDANO_NODE_SOCKET_PATH "
                      , String
"is defined and mandatory otherwise."
                      ]
                , Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
                ]
        ]
      , -- Default to the socket path specified by the environment variable if it is available.
        SocketPath -> Parser SocketPath
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SocketPath -> Parser SocketPath)
-> (String -> SocketPath) -> String -> Parser SocketPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SocketPath
forall content (direction :: FileDirection).
String -> File content direction
File (String -> Parser SocketPath) -> [String] -> [Parser SocketPath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList (EnvCli -> Maybe String
envCliSocketPath EnvCli
envCli)
      ]

readerFromParsecParser :: Parsec.Parser a -> Opt.ReadM a
readerFromParsecParser :: forall a. Parser a -> ReadM a
readerFromParsecParser Parser a
p =
  (String -> Either String a) -> ReadM a
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader ((ParseError -> String) -> Either ParseError a -> Either String a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseError -> String
formatError (Either ParseError a -> Either String a)
-> (String -> Either ParseError a) -> String -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> String -> String -> Either ParseError a
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
Parsec.parse (Parser a
p Parser a -> ParsecT String () Identity () -> Parser a
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
Parsec.eof) String
"")
 where
  formatError :: ParseError -> String
formatError ParseError
err =
    String
-> String -> String -> String -> String -> [Message] -> String
Parsec.showErrorMessages
      String
"or"
      String
"unknown parse error"
      String
"expecting"
      String
"unexpected"
      String
"end of input"
      (ParseError -> [Message]
Parsec.errorMessages ParseError
err)

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

parseTxId :: Parsec.Parser TxId
parseTxId :: ParsecT String () Identity TxId
parseTxId = do
  String
str' <- ParsecT String () Identity Char
-> ParsecT String () Identity String
forall a.
ParsecT String () Identity a -> ParsecT String () Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
Parsec.hexDigit ParsecT String () Identity String
-> String -> ParsecT String () Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"transaction id (hexadecimal)"
  case AsType TxId -> ByteString -> Either RawBytesHexError TxId
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either RawBytesHexError a
deserialiseFromRawBytesHex AsType TxId
AsTxId (String -> ByteString
BSC.pack String
str') of
    Right TxId
addr -> TxId -> ParsecT String () Identity TxId
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return TxId
addr
    Left RawBytesHexError
e -> String -> ParsecT String () Identity TxId
forall a. String -> ParsecT String () Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ParsecT String () Identity TxId)
-> String -> ParsecT String () Identity TxId
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle -> String
docToString (Doc AnsiStyle -> String) -> Doc AnsiStyle -> String
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Incorrect transaction id format: " Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> RawBytesHexError -> Doc AnsiStyle
forall e ann. Error e => e -> Doc ann
forall ann. RawBytesHexError -> Doc ann
prettyError RawBytesHexError
e

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

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

pStakeIdentifier :: Maybe String -> Parser StakeIdentifier
pStakeIdentifier :: Maybe String -> Parser StakeIdentifier
pStakeIdentifier Maybe String
prefix =
  [Parser StakeIdentifier] -> Parser StakeIdentifier
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ StakeVerifier -> StakeIdentifier
StakeIdentifierVerifier (StakeVerifier -> StakeIdentifier)
-> Parser StakeVerifier -> Parser StakeIdentifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String -> Parser StakeVerifier
pStakeVerifier Maybe String
prefix
    , StakeAddress -> StakeIdentifier
StakeIdentifierAddress (StakeAddress -> StakeIdentifier)
-> Parser StakeAddress -> Parser StakeIdentifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String -> Parser StakeAddress
pStakeAddress Maybe String
prefix
    ]

pStakeVerifier :: Maybe String -> Parser StakeVerifier
pStakeVerifier :: Maybe String -> Parser StakeVerifier
pStakeVerifier Maybe String
prefix =
  [Parser StakeVerifier] -> Parser StakeVerifier
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ VerificationKeyOrHashOrFile StakeKey -> StakeVerifier
StakeVerifierKey (VerificationKeyOrHashOrFile StakeKey -> StakeVerifier)
-> Parser (VerificationKeyOrHashOrFile StakeKey)
-> Parser StakeVerifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String -> Parser (VerificationKeyOrHashOrFile StakeKey)
pStakeVerificationKeyOrHashOrFile Maybe String
prefix
    , ScriptFile -> StakeVerifier
StakeVerifierScriptFile
        (ScriptFile -> StakeVerifier)
-> Parser ScriptFile -> Parser StakeVerifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe String -> String -> Parser ScriptFile
pScriptFor (Maybe String -> String -> String
prefixFlag Maybe String
prefix String
"stake-script-file") Maybe String
forall a. Maybe a
Nothing String
"Filepath of the staking script."
    ]

pStakeAddress :: Maybe String -> Parser StakeAddress
pStakeAddress :: Maybe String -> Parser StakeAddress
pStakeAddress Maybe String
prefix =
  ReadM StakeAddress
-> Mod OptionFields StakeAddress -> Parser StakeAddress
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser StakeAddress -> ReadM StakeAddress
forall a. Parser a -> ReadM a
readerFromParsecParser Parser StakeAddress
parseStakeAddress) (Mod OptionFields StakeAddress -> Parser StakeAddress)
-> Mod OptionFields StakeAddress -> Parser StakeAddress
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields StakeAddress] -> Mod OptionFields StakeAddress
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields StakeAddress
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long (String -> Mod OptionFields StakeAddress)
-> String -> Mod OptionFields StakeAddress
forall a b. (a -> b) -> a -> b
$ Maybe String -> String -> String
prefixFlag Maybe String
prefix String
"stake-address"
      , String -> Mod OptionFields StakeAddress
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"ADDRESS"
      , String -> Mod OptionFields StakeAddress
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Target stake address (bech32 format)."
      ]

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

-- | First argument is the optional prefix
pStakeVerificationKeyOrFile :: Maybe String -> Parser (VerificationKeyOrFile StakeKey)
pStakeVerificationKeyOrFile :: Maybe String -> Parser (VerificationKeyOrFile StakeKey)
pStakeVerificationKeyOrFile Maybe String
prefix =
  VerificationKey StakeKey -> VerificationKeyOrFile StakeKey
forall keyrole.
VerificationKey keyrole -> VerificationKeyOrFile keyrole
VerificationKeyValue
    (VerificationKey StakeKey -> VerificationKeyOrFile StakeKey)
-> Parser (VerificationKey StakeKey)
-> Parser (VerificationKeyOrFile StakeKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String -> Parser (VerificationKey StakeKey)
pStakeVerificationKey Maybe String
prefix
      Parser (VerificationKeyOrFile StakeKey)
-> Parser (VerificationKeyOrFile StakeKey)
-> Parser (VerificationKeyOrFile StakeKey)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> VerificationKeyFile 'In -> VerificationKeyOrFile StakeKey
forall keyrole.
VerificationKeyFile 'In -> VerificationKeyOrFile keyrole
VerificationKeyFilePath
    (VerificationKeyFile 'In -> VerificationKeyOrFile StakeKey)
-> Parser (VerificationKeyFile 'In)
-> Parser (VerificationKeyOrFile StakeKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String -> Parser (VerificationKeyFile 'In)
pStakeVerificationKeyFile Maybe String
prefix

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

-- | The first argument is the optional prefix.
pStakeVerificationKey :: Maybe String -> Parser (VerificationKey StakeKey)
pStakeVerificationKey :: Maybe String -> Parser (VerificationKey StakeKey)
pStakeVerificationKey Maybe String
prefix =
  ReadM (VerificationKey StakeKey)
-> Mod OptionFields (VerificationKey StakeKey)
-> Parser (VerificationKey StakeKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (AsType StakeKey -> ReadM (VerificationKey StakeKey)
forall keyrole.
SerialiseAsBech32 (VerificationKey keyrole) =>
AsType keyrole -> ReadM (VerificationKey keyrole)
readVerificationKey AsType StakeKey
AsStakeKey) (Mod OptionFields (VerificationKey StakeKey)
 -> Parser (VerificationKey StakeKey))
-> Mod OptionFields (VerificationKey StakeKey)
-> Parser (VerificationKey StakeKey)
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields (VerificationKey StakeKey)]
-> Mod OptionFields (VerificationKey StakeKey)
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields (VerificationKey StakeKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long (String -> Mod OptionFields (VerificationKey StakeKey))
-> String -> Mod OptionFields (VerificationKey StakeKey)
forall a b. (a -> b) -> a -> b
$ Maybe String -> String -> String
prefixFlag Maybe String
prefix String
"stake-verification-key"
      , String -> Mod OptionFields (VerificationKey StakeKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
      , String -> Mod OptionFields (VerificationKey StakeKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Stake verification key (Bech32 or hex-encoded)."
      ]

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

  deserialiseFromBech32OrHex
    :: String
    -> Either String (VerificationKey keyrole)
  deserialiseFromBech32OrHex :: String -> Either String (VerificationKey keyrole)
deserialiseFromBech32OrHex String
str' =
    (InputDecodeError -> String)
-> Either InputDecodeError (VerificationKey keyrole)
-> Either String (VerificationKey keyrole)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Doc AnsiStyle -> String
docToString (Doc AnsiStyle -> String)
-> (InputDecodeError -> Doc AnsiStyle)
-> InputDecodeError
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputDecodeError -> Doc AnsiStyle
forall ann. InputDecodeError -> Doc ann
renderInputDecodeError) (Either InputDecodeError (VerificationKey keyrole)
 -> Either String (VerificationKey keyrole))
-> Either InputDecodeError (VerificationKey keyrole)
-> Either String (VerificationKey keyrole)
forall a b. (a -> b) -> a -> b
$
      AsType (VerificationKey keyrole)
-> NonEmpty (InputFormat (VerificationKey keyrole))
-> ByteString
-> Either InputDecodeError (VerificationKey keyrole)
forall a.
AsType a
-> NonEmpty (InputFormat a)
-> ByteString
-> Either InputDecodeError a
deserialiseInput (AsType keyrole -> AsType (VerificationKey keyrole)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType keyrole
asType) NonEmpty (InputFormat (VerificationKey keyrole))
keyFormats (String -> ByteString
BSC.pack String
str')

-- | The first argument is the optional prefix.
pStakeVerificationKeyFile :: Maybe String -> Parser (VerificationKeyFile In)
pStakeVerificationKeyFile :: Maybe String -> Parser (VerificationKeyFile 'In)
pStakeVerificationKeyFile Maybe String
prefix =
  String -> VerificationKeyFile 'In
forall content (direction :: FileDirection).
String -> File content direction
File
    (String -> VerificationKeyFile 'In)
-> Parser String -> Parser (VerificationKeyFile 'In)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Parser String] -> Parser String
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
      [ String -> String -> Parser String
parseFilePath
          (Maybe String -> String -> String
prefixFlag Maybe String
prefix String
"stake-verification-key-file")
          String
"Filepath of the staking verification key."
      , 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 -> Mod OptionFields String)
-> String -> Mod OptionFields String
forall a b. (a -> b) -> a -> b
$ Maybe String -> String -> String
prefixFlag Maybe String
prefix String
"staking-verification-key-file"
            , Mod OptionFields String
forall (f :: * -> *) a. Mod f a
Opt.internal
            ]
      ]

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

subInfoParser :: String -> InfoMod a -> [Maybe (Parser a)] -> Maybe (Parser a)
subInfoParser :: forall a.
String -> InfoMod a -> [Maybe (Parser a)] -> Maybe (Parser a)
subInfoParser String
name InfoMod a
i [Maybe (Parser a)]
mps = case [Maybe (Parser a)] -> [Parser a]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (Parser a)]
mps of
  [] -> Maybe (Parser a)
forall a. Maybe a
Nothing
  [Parser a]
parsers -> Parser a -> Maybe (Parser a)
forall a. a -> Maybe a
Just (Parser a -> Maybe (Parser a)) -> Parser a -> Maybe (Parser a)
forall a b. (a -> b) -> a -> b
$ String -> ParserInfo a -> Parser a
forall a. String -> ParserInfo a -> Parser a
subParser String
name (ParserInfo a -> Parser a) -> ParserInfo a -> Parser a
forall a b. (a -> b) -> a -> b
$ Parser a -> InfoMod a -> ParserInfo a
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info ([Parser a] -> Parser a
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [Parser a]
parsers) InfoMod a
i

pAnyShelleyBasedEra :: EnvCli -> Parser (EraInEon ShelleyBasedEra)
pAnyShelleyBasedEra :: EnvCli -> Parser (EraInEon ShelleyBasedEra)
pAnyShelleyBasedEra EnvCli
envCli =
  [Parser (EraInEon ShelleyBasedEra)]
-> Parser (EraInEon ShelleyBasedEra)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([Parser (EraInEon ShelleyBasedEra)]
 -> Parser (EraInEon ShelleyBasedEra))
-> [Parser (EraInEon ShelleyBasedEra)]
-> Parser (EraInEon ShelleyBasedEra)
forall a b. (a -> b) -> a -> b
$
    [[Parser (EraInEon ShelleyBasedEra)]]
-> [Parser (EraInEon ShelleyBasedEra)]
forall a. Monoid a => [a] -> a
mconcat
      [
        [ EraInEon ShelleyBasedEra
-> Mod FlagFields (EraInEon ShelleyBasedEra)
-> Parser (EraInEon ShelleyBasedEra)
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' (ShelleyBasedEra ShelleyEra -> EraInEon ShelleyBasedEra
forall era (eon :: * -> *).
(Typeable era, Typeable (eon era), Eon eon) =>
eon era -> EraInEon eon
EraInEon ShelleyBasedEra ShelleyEra
ShelleyBasedEraShelley) (Mod FlagFields (EraInEon ShelleyBasedEra)
 -> Parser (EraInEon ShelleyBasedEra))
-> Mod FlagFields (EraInEon ShelleyBasedEra)
-> Parser (EraInEon ShelleyBasedEra)
forall a b. (a -> b) -> a -> b
$
            [Mod FlagFields (EraInEon ShelleyBasedEra)]
-> Mod FlagFields (EraInEon ShelleyBasedEra)
forall a. Monoid a => [a] -> a
mconcat [String -> Mod FlagFields (EraInEon ShelleyBasedEra)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"shelley-era", String -> Mod FlagFields (EraInEon ShelleyBasedEra)
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod FlagFields (EraInEon ShelleyBasedEra))
-> String -> Mod FlagFields (EraInEon ShelleyBasedEra)
forall a b. (a -> b) -> a -> b
$ String
"Specify the Shelley era" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
deprecationText]
        , EraInEon ShelleyBasedEra
-> Mod FlagFields (EraInEon ShelleyBasedEra)
-> Parser (EraInEon ShelleyBasedEra)
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' (ShelleyBasedEra AllegraEra -> EraInEon ShelleyBasedEra
forall era (eon :: * -> *).
(Typeable era, Typeable (eon era), Eon eon) =>
eon era -> EraInEon eon
EraInEon ShelleyBasedEra AllegraEra
ShelleyBasedEraAllegra) (Mod FlagFields (EraInEon ShelleyBasedEra)
 -> Parser (EraInEon ShelleyBasedEra))
-> Mod FlagFields (EraInEon ShelleyBasedEra)
-> Parser (EraInEon ShelleyBasedEra)
forall a b. (a -> b) -> a -> b
$
            [Mod FlagFields (EraInEon ShelleyBasedEra)]
-> Mod FlagFields (EraInEon ShelleyBasedEra)
forall a. Monoid a => [a] -> a
mconcat [String -> Mod FlagFields (EraInEon ShelleyBasedEra)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"allegra-era", String -> Mod FlagFields (EraInEon ShelleyBasedEra)
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod FlagFields (EraInEon ShelleyBasedEra))
-> String -> Mod FlagFields (EraInEon ShelleyBasedEra)
forall a b. (a -> b) -> a -> b
$ String
"Specify the Allegra era" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
deprecationText]
        , EraInEon ShelleyBasedEra
-> Mod FlagFields (EraInEon ShelleyBasedEra)
-> Parser (EraInEon ShelleyBasedEra)
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' (ShelleyBasedEra MaryEra -> EraInEon ShelleyBasedEra
forall era (eon :: * -> *).
(Typeable era, Typeable (eon era), Eon eon) =>
eon era -> EraInEon eon
EraInEon ShelleyBasedEra MaryEra
ShelleyBasedEraMary) (Mod FlagFields (EraInEon ShelleyBasedEra)
 -> Parser (EraInEon ShelleyBasedEra))
-> Mod FlagFields (EraInEon ShelleyBasedEra)
-> Parser (EraInEon ShelleyBasedEra)
forall a b. (a -> b) -> a -> b
$
            [Mod FlagFields (EraInEon ShelleyBasedEra)]
-> Mod FlagFields (EraInEon ShelleyBasedEra)
forall a. Monoid a => [a] -> a
mconcat [String -> Mod FlagFields (EraInEon ShelleyBasedEra)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"mary-era", String -> Mod FlagFields (EraInEon ShelleyBasedEra)
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod FlagFields (EraInEon ShelleyBasedEra))
-> String -> Mod FlagFields (EraInEon ShelleyBasedEra)
forall a b. (a -> b) -> a -> b
$ String
"Specify the Mary era" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
deprecationText]
        , EraInEon ShelleyBasedEra
-> Mod FlagFields (EraInEon ShelleyBasedEra)
-> Parser (EraInEon ShelleyBasedEra)
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' (ShelleyBasedEra AlonzoEra -> EraInEon ShelleyBasedEra
forall era (eon :: * -> *).
(Typeable era, Typeable (eon era), Eon eon) =>
eon era -> EraInEon eon
EraInEon ShelleyBasedEra AlonzoEra
ShelleyBasedEraAlonzo) (Mod FlagFields (EraInEon ShelleyBasedEra)
 -> Parser (EraInEon ShelleyBasedEra))
-> Mod FlagFields (EraInEon ShelleyBasedEra)
-> Parser (EraInEon ShelleyBasedEra)
forall a b. (a -> b) -> a -> b
$
            [Mod FlagFields (EraInEon ShelleyBasedEra)]
-> Mod FlagFields (EraInEon ShelleyBasedEra)
forall a. Monoid a => [a] -> a
mconcat [String -> Mod FlagFields (EraInEon ShelleyBasedEra)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"alonzo-era", String -> Mod FlagFields (EraInEon ShelleyBasedEra)
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod FlagFields (EraInEon ShelleyBasedEra))
-> String -> Mod FlagFields (EraInEon ShelleyBasedEra)
forall a b. (a -> b) -> a -> b
$ String
"Specify the Alonzo era" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
deprecationText]
        , EraInEon ShelleyBasedEra
-> Mod FlagFields (EraInEon ShelleyBasedEra)
-> Parser (EraInEon ShelleyBasedEra)
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' (ShelleyBasedEra BabbageEra -> EraInEon ShelleyBasedEra
forall era (eon :: * -> *).
(Typeable era, Typeable (eon era), Eon eon) =>
eon era -> EraInEon eon
EraInEon ShelleyBasedEra BabbageEra
ShelleyBasedEraBabbage) (Mod FlagFields (EraInEon ShelleyBasedEra)
 -> Parser (EraInEon ShelleyBasedEra))
-> Mod FlagFields (EraInEon ShelleyBasedEra)
-> Parser (EraInEon ShelleyBasedEra)
forall a b. (a -> b) -> a -> b
$
            [Mod FlagFields (EraInEon ShelleyBasedEra)]
-> Mod FlagFields (EraInEon ShelleyBasedEra)
forall a. Monoid a => [a] -> a
mconcat [String -> Mod FlagFields (EraInEon ShelleyBasedEra)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"babbage-era", String -> Mod FlagFields (EraInEon ShelleyBasedEra)
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod FlagFields (EraInEon ShelleyBasedEra))
-> String -> Mod FlagFields (EraInEon ShelleyBasedEra)
forall a b. (a -> b) -> a -> b
$ String
"Specify the Babbage era (default)" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
deprecationText]
        , EraInEon ShelleyBasedEra
-> Mod FlagFields (EraInEon ShelleyBasedEra)
-> Parser (EraInEon ShelleyBasedEra)
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' (ShelleyBasedEra ConwayEra -> EraInEon ShelleyBasedEra
forall era (eon :: * -> *).
(Typeable era, Typeable (eon era), Eon eon) =>
eon era -> EraInEon eon
EraInEon ShelleyBasedEra ConwayEra
ShelleyBasedEraConway) (Mod FlagFields (EraInEon ShelleyBasedEra)
 -> Parser (EraInEon ShelleyBasedEra))
-> Mod FlagFields (EraInEon ShelleyBasedEra)
-> Parser (EraInEon ShelleyBasedEra)
forall a b. (a -> b) -> a -> b
$
            [Mod FlagFields (EraInEon ShelleyBasedEra)]
-> Mod FlagFields (EraInEon ShelleyBasedEra)
forall a. Monoid a => [a] -> a
mconcat [String -> Mod FlagFields (EraInEon ShelleyBasedEra)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"conway-era", String -> Mod FlagFields (EraInEon ShelleyBasedEra)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Specify the Conway era"]
        ]
      , Maybe (Parser (EraInEon ShelleyBasedEra))
-> [Parser (EraInEon ShelleyBasedEra)]
forall a. Maybe a -> [a]
maybeToList (Maybe (Parser (EraInEon ShelleyBasedEra))
 -> [Parser (EraInEon ShelleyBasedEra)])
-> Maybe (Parser (EraInEon ShelleyBasedEra))
-> [Parser (EraInEon ShelleyBasedEra)]
forall a b. (a -> b) -> a -> b
$ EraInEon ShelleyBasedEra -> Parser (EraInEon ShelleyBasedEra)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EraInEon ShelleyBasedEra -> Parser (EraInEon ShelleyBasedEra))
-> Maybe (EraInEon ShelleyBasedEra)
-> Maybe (Parser (EraInEon ShelleyBasedEra))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnvCli -> Maybe (EraInEon ShelleyBasedEra)
forall (eon :: * -> *).
(Typeable eon, Eon eon) =>
EnvCli -> Maybe (EraInEon eon)
envCliAnyEon EnvCli
envCli
      , Parser (EraInEon ShelleyBasedEra)
-> [Parser (EraInEon ShelleyBasedEra)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser (EraInEon ShelleyBasedEra)
 -> [Parser (EraInEon ShelleyBasedEra)])
-> Parser (EraInEon ShelleyBasedEra)
-> [Parser (EraInEon ShelleyBasedEra)]
forall a b. (a -> b) -> a -> b
$ EraInEon ShelleyBasedEra -> Parser (EraInEon ShelleyBasedEra)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EraInEon ShelleyBasedEra -> Parser (EraInEon ShelleyBasedEra))
-> EraInEon ShelleyBasedEra -> Parser (EraInEon ShelleyBasedEra)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra BabbageEra -> EraInEon ShelleyBasedEra
forall era (eon :: * -> *).
(Typeable era, Typeable (eon era), Eon eon) =>
eon era -> EraInEon eon
EraInEon ShelleyBasedEra BabbageEra
ShelleyBasedEraBabbage
      ]

deprecationText :: String
deprecationText :: String
deprecationText = String
" - DEPRECATED - will be removed in the future"

pAnyShelleyToBabbageEra :: EnvCli -> Parser (EraInEon ShelleyToBabbageEra)
pAnyShelleyToBabbageEra :: EnvCli -> Parser (EraInEon ShelleyToBabbageEra)
pAnyShelleyToBabbageEra EnvCli
envCli =
  [Parser (EraInEon ShelleyToBabbageEra)]
-> Parser (EraInEon ShelleyToBabbageEra)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([Parser (EraInEon ShelleyToBabbageEra)]
 -> Parser (EraInEon ShelleyToBabbageEra))
-> [Parser (EraInEon ShelleyToBabbageEra)]
-> Parser (EraInEon ShelleyToBabbageEra)
forall a b. (a -> b) -> a -> b
$
    [[Parser (EraInEon ShelleyToBabbageEra)]]
-> [Parser (EraInEon ShelleyToBabbageEra)]
forall a. Monoid a => [a] -> a
mconcat
      [
        [ EraInEon ShelleyToBabbageEra
-> Mod FlagFields (EraInEon ShelleyToBabbageEra)
-> Parser (EraInEon ShelleyToBabbageEra)
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' (ShelleyToBabbageEra ShelleyEra -> EraInEon ShelleyToBabbageEra
forall era (eon :: * -> *).
(Typeable era, Typeable (eon era), Eon eon) =>
eon era -> EraInEon eon
EraInEon ShelleyToBabbageEra ShelleyEra
ShelleyToBabbageEraShelley) (Mod FlagFields (EraInEon ShelleyToBabbageEra)
 -> Parser (EraInEon ShelleyToBabbageEra))
-> Mod FlagFields (EraInEon ShelleyToBabbageEra)
-> Parser (EraInEon ShelleyToBabbageEra)
forall a b. (a -> b) -> a -> b
$
            [Mod FlagFields (EraInEon ShelleyToBabbageEra)]
-> Mod FlagFields (EraInEon ShelleyToBabbageEra)
forall a. Monoid a => [a] -> a
mconcat [String -> Mod FlagFields (EraInEon ShelleyToBabbageEra)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"shelley-era", String -> Mod FlagFields (EraInEon ShelleyToBabbageEra)
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod FlagFields (EraInEon ShelleyToBabbageEra))
-> String -> Mod FlagFields (EraInEon ShelleyToBabbageEra)
forall a b. (a -> b) -> a -> b
$ String
"Specify the Shelley era" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
deprecationText]
        , EraInEon ShelleyToBabbageEra
-> Mod FlagFields (EraInEon ShelleyToBabbageEra)
-> Parser (EraInEon ShelleyToBabbageEra)
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' (ShelleyToBabbageEra AllegraEra -> EraInEon ShelleyToBabbageEra
forall era (eon :: * -> *).
(Typeable era, Typeable (eon era), Eon eon) =>
eon era -> EraInEon eon
EraInEon ShelleyToBabbageEra AllegraEra
ShelleyToBabbageEraAllegra) (Mod FlagFields (EraInEon ShelleyToBabbageEra)
 -> Parser (EraInEon ShelleyToBabbageEra))
-> Mod FlagFields (EraInEon ShelleyToBabbageEra)
-> Parser (EraInEon ShelleyToBabbageEra)
forall a b. (a -> b) -> a -> b
$
            [Mod FlagFields (EraInEon ShelleyToBabbageEra)]
-> Mod FlagFields (EraInEon ShelleyToBabbageEra)
forall a. Monoid a => [a] -> a
mconcat [String -> Mod FlagFields (EraInEon ShelleyToBabbageEra)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"allegra-era", String -> Mod FlagFields (EraInEon ShelleyToBabbageEra)
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod FlagFields (EraInEon ShelleyToBabbageEra))
-> String -> Mod FlagFields (EraInEon ShelleyToBabbageEra)
forall a b. (a -> b) -> a -> b
$ String
"Specify the Allegra era" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
deprecationText]
        , EraInEon ShelleyToBabbageEra
-> Mod FlagFields (EraInEon ShelleyToBabbageEra)
-> Parser (EraInEon ShelleyToBabbageEra)
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' (ShelleyToBabbageEra MaryEra -> EraInEon ShelleyToBabbageEra
forall era (eon :: * -> *).
(Typeable era, Typeable (eon era), Eon eon) =>
eon era -> EraInEon eon
EraInEon ShelleyToBabbageEra MaryEra
ShelleyToBabbageEraMary) (Mod FlagFields (EraInEon ShelleyToBabbageEra)
 -> Parser (EraInEon ShelleyToBabbageEra))
-> Mod FlagFields (EraInEon ShelleyToBabbageEra)
-> Parser (EraInEon ShelleyToBabbageEra)
forall a b. (a -> b) -> a -> b
$
            [Mod FlagFields (EraInEon ShelleyToBabbageEra)]
-> Mod FlagFields (EraInEon ShelleyToBabbageEra)
forall a. Monoid a => [a] -> a
mconcat [String -> Mod FlagFields (EraInEon ShelleyToBabbageEra)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"mary-era", String -> Mod FlagFields (EraInEon ShelleyToBabbageEra)
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod FlagFields (EraInEon ShelleyToBabbageEra))
-> String -> Mod FlagFields (EraInEon ShelleyToBabbageEra)
forall a b. (a -> b) -> a -> b
$ String
"Specify the Mary era" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
deprecationText]
        , EraInEon ShelleyToBabbageEra
-> Mod FlagFields (EraInEon ShelleyToBabbageEra)
-> Parser (EraInEon ShelleyToBabbageEra)
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' (ShelleyToBabbageEra AlonzoEra -> EraInEon ShelleyToBabbageEra
forall era (eon :: * -> *).
(Typeable era, Typeable (eon era), Eon eon) =>
eon era -> EraInEon eon
EraInEon ShelleyToBabbageEra AlonzoEra
ShelleyToBabbageEraAlonzo) (Mod FlagFields (EraInEon ShelleyToBabbageEra)
 -> Parser (EraInEon ShelleyToBabbageEra))
-> Mod FlagFields (EraInEon ShelleyToBabbageEra)
-> Parser (EraInEon ShelleyToBabbageEra)
forall a b. (a -> b) -> a -> b
$
            [Mod FlagFields (EraInEon ShelleyToBabbageEra)]
-> Mod FlagFields (EraInEon ShelleyToBabbageEra)
forall a. Monoid a => [a] -> a
mconcat [String -> Mod FlagFields (EraInEon ShelleyToBabbageEra)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"alonzo-era", String -> Mod FlagFields (EraInEon ShelleyToBabbageEra)
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod FlagFields (EraInEon ShelleyToBabbageEra))
-> String -> Mod FlagFields (EraInEon ShelleyToBabbageEra)
forall a b. (a -> b) -> a -> b
$ String
"Specify the Alonzo era" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
deprecationText]
        , EraInEon ShelleyToBabbageEra
-> Mod FlagFields (EraInEon ShelleyToBabbageEra)
-> Parser (EraInEon ShelleyToBabbageEra)
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' (ShelleyToBabbageEra BabbageEra -> EraInEon ShelleyToBabbageEra
forall era (eon :: * -> *).
(Typeable era, Typeable (eon era), Eon eon) =>
eon era -> EraInEon eon
EraInEon ShelleyToBabbageEra BabbageEra
ShelleyToBabbageEraBabbage) (Mod FlagFields (EraInEon ShelleyToBabbageEra)
 -> Parser (EraInEon ShelleyToBabbageEra))
-> Mod FlagFields (EraInEon ShelleyToBabbageEra)
-> Parser (EraInEon ShelleyToBabbageEra)
forall a b. (a -> b) -> a -> b
$
            [Mod FlagFields (EraInEon ShelleyToBabbageEra)]
-> Mod FlagFields (EraInEon ShelleyToBabbageEra)
forall a. Monoid a => [a] -> a
mconcat [String -> Mod FlagFields (EraInEon ShelleyToBabbageEra)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"babbage-era", String -> Mod FlagFields (EraInEon ShelleyToBabbageEra)
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod FlagFields (EraInEon ShelleyToBabbageEra))
-> String -> Mod FlagFields (EraInEon ShelleyToBabbageEra)
forall a b. (a -> b) -> a -> b
$ String
"Specify the Babbage era (default)" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
deprecationText]
        ]
      , Maybe (Parser (EraInEon ShelleyToBabbageEra))
-> [Parser (EraInEon ShelleyToBabbageEra)]
forall a. Maybe a -> [a]
maybeToList (Maybe (Parser (EraInEon ShelleyToBabbageEra))
 -> [Parser (EraInEon ShelleyToBabbageEra)])
-> Maybe (Parser (EraInEon ShelleyToBabbageEra))
-> [Parser (EraInEon ShelleyToBabbageEra)]
forall a b. (a -> b) -> a -> b
$ EraInEon ShelleyToBabbageEra
-> Parser (EraInEon ShelleyToBabbageEra)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EraInEon ShelleyToBabbageEra
 -> Parser (EraInEon ShelleyToBabbageEra))
-> Maybe (EraInEon ShelleyToBabbageEra)
-> Maybe (Parser (EraInEon ShelleyToBabbageEra))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnvCli -> Maybe (EraInEon ShelleyToBabbageEra)
forall (eon :: * -> *).
(Typeable eon, Eon eon) =>
EnvCli -> Maybe (EraInEon eon)
envCliAnyEon EnvCli
envCli
      , Parser (EraInEon ShelleyToBabbageEra)
-> [Parser (EraInEon ShelleyToBabbageEra)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser (EraInEon ShelleyToBabbageEra)
 -> [Parser (EraInEon ShelleyToBabbageEra)])
-> (EraInEon ShelleyToBabbageEra
    -> Parser (EraInEon ShelleyToBabbageEra))
-> EraInEon ShelleyToBabbageEra
-> [Parser (EraInEon ShelleyToBabbageEra)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EraInEon ShelleyToBabbageEra
-> Parser (EraInEon ShelleyToBabbageEra)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EraInEon ShelleyToBabbageEra
 -> [Parser (EraInEon ShelleyToBabbageEra)])
-> EraInEon ShelleyToBabbageEra
-> [Parser (EraInEon ShelleyToBabbageEra)]
forall a b. (a -> b) -> a -> b
$ ShelleyToBabbageEra BabbageEra -> EraInEon ShelleyToBabbageEra
forall era (eon :: * -> *).
(Typeable era, Typeable (eon era), Eon eon) =>
eon era -> EraInEon eon
EraInEon ShelleyToBabbageEra BabbageEra
ShelleyToBabbageEraBabbage
      ]

pFileOutDirection :: String -> String -> Parser (File a Out)
pFileOutDirection :: forall a. String -> String -> Parser (File a 'Out)
pFileOutDirection String
l String
h = String -> File a 'Out
forall content (direction :: FileDirection).
String -> File content direction
File (String -> File a 'Out) -> Parser String -> Parser (File a 'Out)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser String
parseFilePath String
l String
h

pFileInDirection :: String -> String -> Parser (File a In)
pFileInDirection :: forall a. String -> String -> Parser (File a 'In)
pFileInDirection String
l String
h = String -> File a 'In
forall content (direction :: FileDirection).
String -> File content direction
File (String -> File a 'In) -> Parser String -> Parser (File a 'In)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser String
parseFilePath String
l String
h

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

-- | The first argument is the optional prefix.
pStakePoolVerificationKeyOrFile :: Maybe String -> Parser (VerificationKeyOrFile StakePoolKey)
pStakePoolVerificationKeyOrFile :: Maybe String -> Parser (VerificationKeyOrFile StakePoolKey)
pStakePoolVerificationKeyOrFile Maybe String
prefix =
  [Parser (VerificationKeyOrFile StakePoolKey)]
-> Parser (VerificationKeyOrFile StakePoolKey)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ VerificationKey StakePoolKey -> VerificationKeyOrFile StakePoolKey
forall keyrole.
VerificationKey keyrole -> VerificationKeyOrFile keyrole
VerificationKeyValue (VerificationKey StakePoolKey
 -> VerificationKeyOrFile StakePoolKey)
-> Parser (VerificationKey StakePoolKey)
-> Parser (VerificationKeyOrFile StakePoolKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String -> Parser (VerificationKey StakePoolKey)
pStakePoolVerificationKey Maybe String
prefix
    , VerificationKeyFile 'In -> VerificationKeyOrFile StakePoolKey
forall keyrole.
VerificationKeyFile 'In -> VerificationKeyOrFile keyrole
VerificationKeyFilePath (VerificationKeyFile 'In -> VerificationKeyOrFile StakePoolKey)
-> Parser (VerificationKeyFile 'In)
-> Parser (VerificationKeyOrFile StakePoolKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String -> Parser (VerificationKeyFile 'In)
pStakePoolVerificationKeyFile Maybe String
prefix
    ]

-- | The first argument is the optional prefix.
pStakePoolVerificationKey :: Maybe String -> Parser (VerificationKey StakePoolKey)
pStakePoolVerificationKey :: Maybe String -> Parser (VerificationKey StakePoolKey)
pStakePoolVerificationKey Maybe String
prefix =
  ReadM (VerificationKey StakePoolKey)
-> Mod OptionFields (VerificationKey StakePoolKey)
-> Parser (VerificationKey StakePoolKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (AsType StakePoolKey -> ReadM (VerificationKey StakePoolKey)
forall keyrole.
SerialiseAsBech32 (VerificationKey keyrole) =>
AsType keyrole -> ReadM (VerificationKey keyrole)
readVerificationKey AsType StakePoolKey
AsStakePoolKey) (Mod OptionFields (VerificationKey StakePoolKey)
 -> Parser (VerificationKey StakePoolKey))
-> Mod OptionFields (VerificationKey StakePoolKey)
-> Parser (VerificationKey StakePoolKey)
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields (VerificationKey StakePoolKey)]
-> Mod OptionFields (VerificationKey StakePoolKey)
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields (VerificationKey StakePoolKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long (String -> Mod OptionFields (VerificationKey StakePoolKey))
-> String -> Mod OptionFields (VerificationKey StakePoolKey)
forall a b. (a -> b) -> a -> b
$ Maybe String -> String -> String
prefixFlag Maybe String
prefix String
"stake-pool-verification-key"
      , String -> Mod OptionFields (VerificationKey StakePoolKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
      , String -> Mod OptionFields (VerificationKey StakePoolKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Stake pool verification key (Bech32 or hex-encoded)."
      ]

-- | The first argument is the optional prefix.
pStakePoolVerificationKeyFile :: Maybe String -> Parser (VerificationKeyFile In)
pStakePoolVerificationKeyFile :: Maybe String -> Parser (VerificationKeyFile 'In)
pStakePoolVerificationKeyFile Maybe String
prefix =
  String -> VerificationKeyFile 'In
forall content (direction :: FileDirection).
String -> File content direction
File
    (String -> VerificationKeyFile 'In)
-> Parser String -> Parser (VerificationKeyFile 'In)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Parser String] -> Parser String
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
      [ String -> String -> Parser String
parseFilePath String
"cold-verification-key-file" String
"Filepath of the stake pool verification key."
      , 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 -> Mod OptionFields String)
-> String -> Mod OptionFields String
forall a b. (a -> b) -> a -> b
$ Maybe String -> String -> String
prefixFlag Maybe String
prefix String
"stake-pool-verification-key-file"
            , Mod OptionFields String
forall (f :: * -> *) a. Mod f a
Opt.internal
            ]
      ]

pOutputFile :: Parser (File content Out)
pOutputFile :: forall content. Parser (File content 'Out)
pOutputFile = String -> File content 'Out
forall content (direction :: FileDirection).
String -> File content direction
File (String -> File content 'Out)
-> Parser String -> Parser (File content 'Out)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser String
parseFilePath String
"out-file" String
"The output file."

pMIRPot :: Parser L.MIRPot
pMIRPot :: Parser MIRPot
pMIRPot =
  [Parser MIRPot] -> Parser MIRPot
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ MIRPot -> Mod FlagFields MIRPot -> Parser MIRPot
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' MIRPot
L.ReservesMIR (Mod FlagFields MIRPot -> Parser MIRPot)
-> Mod FlagFields MIRPot -> Parser MIRPot
forall a b. (a -> b) -> a -> b
$
        [Mod FlagFields MIRPot] -> Mod FlagFields MIRPot
forall a. Monoid a => [a] -> a
mconcat
          [ String -> Mod FlagFields MIRPot
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"reserves"
          , String -> Mod FlagFields MIRPot
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use the reserves pot."
          ]
    , MIRPot -> Mod FlagFields MIRPot -> Parser MIRPot
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' MIRPot
L.TreasuryMIR (Mod FlagFields MIRPot -> Parser MIRPot)
-> Mod FlagFields MIRPot -> Parser MIRPot
forall a b. (a -> b) -> a -> b
$
        [Mod FlagFields MIRPot] -> Mod FlagFields MIRPot
forall a. Monoid a => [a] -> a
mconcat
          [ String -> Mod FlagFields MIRPot
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"treasury"
          , String -> Mod FlagFields MIRPot
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use the treasury pot."
          ]
    ]

pRewardAmt :: Parser Lovelace
pRewardAmt :: Parser Lovelace
pRewardAmt =
  ReadM Lovelace -> Mod OptionFields Lovelace -> Parser Lovelace
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser Lovelace -> ReadM Lovelace
forall a. Parser a -> ReadM a
readerFromParsecParser Parser Lovelace
parseLovelace) (Mod OptionFields Lovelace -> Parser Lovelace)
-> Mod OptionFields Lovelace -> Parser Lovelace
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Lovelace] -> Mod OptionFields Lovelace
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"reward"
      , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"LOVELACE"
      , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The reward for the relevant reward account."
      ]

pTransferAmt :: Parser Lovelace
pTransferAmt :: Parser Lovelace
pTransferAmt =
  ReadM Lovelace -> Mod OptionFields Lovelace -> Parser Lovelace
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser Lovelace -> ReadM Lovelace
forall a. Parser a -> ReadM a
readerFromParsecParser Parser Lovelace
parseLovelace) (Mod OptionFields Lovelace -> Parser Lovelace)
-> Mod OptionFields Lovelace -> Parser Lovelace
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Lovelace] -> Mod OptionFields Lovelace
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"transfer"
      , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"LOVELACE"
      , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The amount to transfer."
      ]

pTreasuryWithdrawalAmt :: Parser Lovelace
pTreasuryWithdrawalAmt :: Parser Lovelace
pTreasuryWithdrawalAmt =
  ReadM Lovelace -> Mod OptionFields Lovelace -> Parser Lovelace
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser Lovelace -> ReadM Lovelace
forall a. Parser a -> ReadM a
readerFromParsecParser Parser Lovelace
parseLovelace) (Mod OptionFields Lovelace -> Parser Lovelace)
-> Mod OptionFields Lovelace -> Parser Lovelace
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Lovelace] -> Mod OptionFields Lovelace
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"transfer"
      , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"LOVELACE"
      , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod OptionFields Lovelace)
-> String -> Mod OptionFields Lovelace
forall a b. (a -> b) -> a -> b
$
          [String] -> String
forall a. Monoid a => [a] -> a
mconcat
            [ String
"The amount of lovelace the proposal intends to withdraw from the Treasury. "
            , String
"Multiple withdrawals can be proposed in a single governance action "
            , String
"by repeating the --funds-receiving-stake and --transfer options as many times as needed."
            ]
      ]

rHexHash
  :: ()
  => SerialiseAsRawBytes (Hash a)
  => AsType a
  -> Maybe String
  -- ^ Optional prefix to the error message
  -> ReadM (Hash a)
rHexHash :: forall a.
SerialiseAsRawBytes (Hash a) =>
AsType a -> Maybe String -> ReadM (Hash a)
rHexHash AsType a
a Maybe String
mErrPrefix =
  (String -> Either String (Hash a)) -> ReadM (Hash a)
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader ((String -> Either String (Hash a)) -> ReadM (Hash a))
-> (String -> Either String (Hash a)) -> ReadM (Hash a)
forall a b. (a -> b) -> a -> b
$
    (RawBytesHexError -> String)
-> Either RawBytesHexError (Hash a) -> Either String (Hash a)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (\RawBytesHexError
e -> String
errPrefix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Doc AnsiStyle -> String
docToString (Doc AnsiStyle -> String) -> Doc AnsiStyle -> String
forall a b. (a -> b) -> a -> b
$ RawBytesHexError -> Doc AnsiStyle
forall e ann. Error e => e -> Doc ann
forall ann. RawBytesHexError -> Doc ann
prettyError RawBytesHexError
e))
      (Either RawBytesHexError (Hash a) -> Either String (Hash a))
-> (String -> Either RawBytesHexError (Hash a))
-> String
-> Either String (Hash a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsType (Hash a) -> ByteString -> Either RawBytesHexError (Hash a)
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either RawBytesHexError a
deserialiseFromRawBytesHex (AsType a -> AsType (Hash a)
forall a. AsType a -> AsType (Hash a)
AsHash AsType a
a)
      (ByteString -> Either RawBytesHexError (Hash a))
-> (String -> ByteString)
-> String
-> Either RawBytesHexError (Hash a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BSC.pack
 where
  errPrefix :: String
errPrefix = String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) Maybe String
mErrPrefix

rBech32KeyHash :: SerialiseAsBech32 (Hash a) => AsType a -> ReadM (Hash a)
rBech32KeyHash :: forall a. SerialiseAsBech32 (Hash a) => AsType a -> ReadM (Hash a)
rBech32KeyHash AsType a
a =
  (String -> Either String (Hash a)) -> ReadM (Hash a)
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader ((String -> Either String (Hash a)) -> ReadM (Hash a))
-> (String -> Either String (Hash a)) -> ReadM (Hash a)
forall a b. (a -> b) -> a -> b
$
    (Bech32DecodeError -> String)
-> Either Bech32DecodeError (Hash a) -> Either String (Hash a)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Doc AnsiStyle -> String
docToString (Doc AnsiStyle -> String)
-> (Bech32DecodeError -> Doc AnsiStyle)
-> Bech32DecodeError
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bech32DecodeError -> Doc AnsiStyle
forall e ann. Error e => e -> Doc ann
forall ann. Bech32DecodeError -> Doc ann
prettyError)
      (Either Bech32DecodeError (Hash a) -> Either String (Hash a))
-> (String -> Either Bech32DecodeError (Hash a))
-> String
-> Either String (Hash a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsType (Hash a) -> Text -> Either Bech32DecodeError (Hash a)
forall a.
SerialiseAsBech32 a =>
AsType a -> Text -> Either Bech32DecodeError a
deserialiseFromBech32 (AsType a -> AsType (Hash a)
forall a. AsType a -> AsType (Hash a)
AsHash AsType a
a)
      (Text -> Either Bech32DecodeError (Hash a))
-> (String -> Text) -> String -> Either Bech32DecodeError (Hash a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

pGenesisDelegateVerificationKey :: Parser (VerificationKey GenesisDelegateKey)
pGenesisDelegateVerificationKey :: Parser (VerificationKey GenesisDelegateKey)
pGenesisDelegateVerificationKey =
  ReadM (VerificationKey GenesisDelegateKey)
-> Mod OptionFields (VerificationKey GenesisDelegateKey)
-> Parser (VerificationKey GenesisDelegateKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM (VerificationKey GenesisDelegateKey)
deserialiseFromHex (Mod OptionFields (VerificationKey GenesisDelegateKey)
 -> Parser (VerificationKey GenesisDelegateKey))
-> Mod OptionFields (VerificationKey GenesisDelegateKey)
-> Parser (VerificationKey GenesisDelegateKey)
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields (VerificationKey GenesisDelegateKey)]
-> Mod OptionFields (VerificationKey GenesisDelegateKey)
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields (VerificationKey GenesisDelegateKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"genesis-delegate-verification-key"
      , String -> Mod OptionFields (VerificationKey GenesisDelegateKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
      , String -> Mod OptionFields (VerificationKey GenesisDelegateKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Genesis delegate verification key (hex-encoded)."
      ]
 where
  deserialiseFromHex :: ReadM (VerificationKey GenesisDelegateKey)
deserialiseFromHex =
    AsType GenesisDelegateKey
-> Maybe String -> ReadM (VerificationKey GenesisDelegateKey)
forall a.
SerialiseAsRawBytes (VerificationKey a) =>
AsType a -> Maybe String -> ReadM (VerificationKey a)
rVerificationKey AsType GenesisDelegateKey
AsGenesisDelegateKey (String -> Maybe String
forall a. a -> Maybe a
Just String
"Invalid genesis delegate verification key")

-- | Reader for verification keys
rVerificationKey
  :: ()
  => SerialiseAsRawBytes (VerificationKey a)
  => AsType a
  -- ^ Singleton value identifying the kind of verification keys
  -> Maybe String
  -- ^ Optional prefix to the error message
  -> ReadM (VerificationKey a)
rVerificationKey :: forall a.
SerialiseAsRawBytes (VerificationKey a) =>
AsType a -> Maybe String -> ReadM (VerificationKey a)
rVerificationKey AsType a
a Maybe String
mErrPrefix =
  (String -> Either String (VerificationKey a))
-> ReadM (VerificationKey a)
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader ((String -> Either String (VerificationKey a))
 -> ReadM (VerificationKey a))
-> (String -> Either String (VerificationKey a))
-> ReadM (VerificationKey a)
forall a b. (a -> b) -> a -> b
$
    (RawBytesHexError -> String)
-> Either RawBytesHexError (VerificationKey a)
-> Either String (VerificationKey a)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
      (\RawBytesHexError
e -> String
errPrefix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Doc AnsiStyle -> String
docToString (Doc AnsiStyle -> String) -> Doc AnsiStyle -> String
forall a b. (a -> b) -> a -> b
$ RawBytesHexError -> Doc AnsiStyle
forall e ann. Error e => e -> Doc ann
forall ann. RawBytesHexError -> Doc ann
prettyError RawBytesHexError
e))
      (Either RawBytesHexError (VerificationKey a)
 -> Either String (VerificationKey a))
-> (String -> Either RawBytesHexError (VerificationKey a))
-> String
-> Either String (VerificationKey a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsType (VerificationKey a)
-> ByteString -> Either RawBytesHexError (VerificationKey a)
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either RawBytesHexError a
deserialiseFromRawBytesHex (AsType a -> AsType (VerificationKey a)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType a
a)
      (ByteString -> Either RawBytesHexError (VerificationKey a))
-> (String -> ByteString)
-> String
-> Either RawBytesHexError (VerificationKey a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BSC.pack
 where
  errPrefix :: String
errPrefix = String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) Maybe String
mErrPrefix

-- | The first argument is the optional prefix.
pColdVerificationKeyOrFile :: Maybe String -> Parser ColdVerificationKeyOrFile
pColdVerificationKeyOrFile :: Maybe String -> Parser ColdVerificationKeyOrFile
pColdVerificationKeyOrFile Maybe String
prefix =
  [Parser ColdVerificationKeyOrFile]
-> Parser ColdVerificationKeyOrFile
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ VerificationKey StakePoolKey -> ColdVerificationKeyOrFile
ColdStakePoolVerificationKey (VerificationKey StakePoolKey -> ColdVerificationKeyOrFile)
-> Parser (VerificationKey StakePoolKey)
-> Parser ColdVerificationKeyOrFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String -> Parser (VerificationKey StakePoolKey)
pStakePoolVerificationKey Maybe String
prefix
    , VerificationKey GenesisDelegateKey -> ColdVerificationKeyOrFile
ColdGenesisDelegateVerificationKey (VerificationKey GenesisDelegateKey -> ColdVerificationKeyOrFile)
-> Parser (VerificationKey GenesisDelegateKey)
-> Parser ColdVerificationKeyOrFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKey GenesisDelegateKey)
pGenesisDelegateVerificationKey
    , VerificationKeyFile 'In -> ColdVerificationKeyOrFile
ColdVerificationKeyFile (VerificationKeyFile 'In -> ColdVerificationKeyOrFile)
-> Parser (VerificationKeyFile 'In)
-> Parser ColdVerificationKeyOrFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyFile 'In)
forall (direction :: FileDirection).
Parser (VerificationKeyFile direction)
pColdVerificationKeyFile
    ]

pColdVerificationKeyFile :: Parser (VerificationKeyFile direction)
pColdVerificationKeyFile :: forall (direction :: FileDirection).
Parser (VerificationKeyFile direction)
pColdVerificationKeyFile =
  (String -> VerificationKeyFile direction)
-> Parser String -> Parser (VerificationKeyFile direction)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> VerificationKeyFile direction
forall content (direction :: FileDirection).
String -> File content direction
File (Parser String -> Parser (VerificationKeyFile direction))
-> Parser String -> Parser (VerificationKeyFile direction)
forall a b. (a -> b) -> a -> b
$
    [Parser String] -> Parser String
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
      [ String -> String -> Parser String
parseFilePath String
"cold-verification-key-file" String
"Filepath of the cold verification key."
      , 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
"verification-key-file"
            , Mod OptionFields String
forall (f :: * -> *) a. Mod f a
Opt.internal
            ]
      ]

pColdSigningKeyFile :: Parser (File (SigningKey keyrole) direction)
pColdSigningKeyFile :: forall keyrole (direction :: FileDirection).
Parser (File (SigningKey keyrole) direction)
pColdSigningKeyFile =
  (String -> File (SigningKey keyrole) direction)
-> Parser String -> Parser (File (SigningKey keyrole) direction)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> File (SigningKey keyrole) direction
forall content (direction :: FileDirection).
String -> File content direction
File (Parser String -> Parser (File (SigningKey keyrole) direction))
-> Parser String -> Parser (File (SigningKey keyrole) direction)
forall a b. (a -> b) -> a -> b
$
    [Parser String] -> Parser String
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
      [ String -> String -> Parser String
parseFilePath String
"cold-signing-key-file" String
"Filepath of the cold signing key."
      , 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
"signing-key-file"
            , Mod OptionFields String
forall (f :: * -> *) a. Mod f a
Opt.internal
            ]
      ]

pVerificationKeyFileOut :: Parser (File (VerificationKey keyrole) Out)
pVerificationKeyFileOut :: forall keyrole. Parser (File (VerificationKey keyrole) 'Out)
pVerificationKeyFileOut =
  String -> File (VerificationKey keyrole) 'Out
forall content (direction :: FileDirection).
String -> File content direction
File (String -> File (VerificationKey keyrole) 'Out)
-> Parser String -> Parser (File (VerificationKey keyrole) 'Out)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser String
parseFilePath String
"verification-key-file" String
"Output filepath of the verification key."

pSigningKeyFileOut :: Parser (File (SigningKey keyrole) Out)
pSigningKeyFileOut :: forall keyrole. Parser (File (SigningKey keyrole) 'Out)
pSigningKeyFileOut =
  String -> File (SigningKey keyrole) 'Out
forall content (direction :: FileDirection).
String -> File content direction
File (String -> File (SigningKey keyrole) 'Out)
-> Parser String -> Parser (File (SigningKey keyrole) 'Out)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser String
parseFilePath String
"signing-key-file" String
"Output filepath of the signing key."

pOperatorCertIssueCounterFile :: Parser (File OpCertCounter direction)
pOperatorCertIssueCounterFile :: forall (direction :: FileDirection).
Parser (File OpCertCounter direction)
pOperatorCertIssueCounterFile =
  (String -> File OpCertCounter direction)
-> Parser String -> Parser (File OpCertCounter direction)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> File OpCertCounter direction
forall content (direction :: FileDirection).
String -> File content direction
File (Parser String -> Parser (File OpCertCounter direction))
-> Parser String -> Parser (File OpCertCounter direction)
forall a b. (a -> b) -> a -> b
$
    [Parser String] -> Parser String
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
      [ String -> String -> Parser String
parseFilePath
          String
"operational-certificate-issue-counter-file"
          String
"The file with the issue counter for the operational certificate."
      , 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
"operational-certificate-issue-counter"
            , Mod OptionFields String
forall (f :: * -> *) a. Mod f a
Opt.internal
            ]
      ]

---

pAddCommitteeColdVerificationKeySource
  :: Parser (VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey)
pAddCommitteeColdVerificationKeySource :: Parser (VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey)
pAddCommitteeColdVerificationKeySource =
  [Parser (VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey)]
-> Parser
     (VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ VerificationKeyOrHashOrFile CommitteeColdKey
-> VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
forall keyrole.
VerificationKeyOrHashOrFile keyrole
-> VerificationKeyOrHashOrFileOrScriptHash keyrole
VkhfshKeyHashFile (VerificationKeyOrHashOrFile CommitteeColdKey
 -> VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey)
-> (VerificationKeyOrFile CommitteeColdKey
    -> VerificationKeyOrHashOrFile CommitteeColdKey)
-> VerificationKeyOrFile CommitteeColdKey
-> VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationKeyOrFile CommitteeColdKey
-> VerificationKeyOrHashOrFile CommitteeColdKey
forall keyrole.
VerificationKeyOrFile keyrole
-> VerificationKeyOrHashOrFile keyrole
VerificationKeyOrFile (VerificationKeyOrFile CommitteeColdKey
 -> VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey)
-> Parser (VerificationKeyOrFile CommitteeColdKey)
-> Parser
     (VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyOrFile CommitteeColdKey)
pAddCommitteeColdVerificationKeyOrFile
    , VerificationKeyOrHashOrFile CommitteeColdKey
-> VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
forall keyrole.
VerificationKeyOrHashOrFile keyrole
-> VerificationKeyOrHashOrFileOrScriptHash keyrole
VkhfshKeyHashFile (VerificationKeyOrHashOrFile CommitteeColdKey
 -> VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey)
-> (Hash CommitteeColdKey
    -> VerificationKeyOrHashOrFile CommitteeColdKey)
-> Hash CommitteeColdKey
-> VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash CommitteeColdKey
-> VerificationKeyOrHashOrFile CommitteeColdKey
forall keyrole. Hash keyrole -> VerificationKeyOrHashOrFile keyrole
VerificationKeyHash (Hash CommitteeColdKey
 -> VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey)
-> Parser (Hash CommitteeColdKey)
-> Parser
     (VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Hash CommitteeColdKey)
pAddCommitteeColdVerificationKeyHash
    , ScriptHash
-> VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
forall keyrole.
ScriptHash -> VerificationKeyOrHashOrFileOrScriptHash keyrole
VkhfshScriptHash
        (ScriptHash
 -> VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey)
-> Parser ScriptHash
-> Parser
     (VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser ScriptHash
pScriptHash
          String
"add-cc-cold-script-hash"
          String
"Cold Native or Plutus script file hash (hex-encoded). Obtain it with \"cardano-cli hash script ...\"."
    ]

pAddCommitteeColdVerificationKeyHash :: Parser (Hash CommitteeColdKey)
pAddCommitteeColdVerificationKeyHash :: Parser (Hash CommitteeColdKey)
pAddCommitteeColdVerificationKeyHash =
  ReadM (Hash CommitteeColdKey)
-> Mod OptionFields (Hash CommitteeColdKey)
-> Parser (Hash CommitteeColdKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM (Hash CommitteeColdKey)
deserialiseColdCCKeyHashFromHex (Mod OptionFields (Hash CommitteeColdKey)
 -> Parser (Hash CommitteeColdKey))
-> Mod OptionFields (Hash CommitteeColdKey)
-> Parser (Hash CommitteeColdKey)
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields (Hash CommitteeColdKey)]
-> Mod OptionFields (Hash CommitteeColdKey)
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields (Hash CommitteeColdKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"add-cc-cold-verification-key-hash"
      , String -> Mod OptionFields (Hash CommitteeColdKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
      , String -> Mod OptionFields (Hash CommitteeColdKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Constitutional Committee key hash (hex-encoded)."
      ]

pAddCommitteeColdVerificationKeyOrFile :: Parser (VerificationKeyOrFile CommitteeColdKey)
pAddCommitteeColdVerificationKeyOrFile :: Parser (VerificationKeyOrFile CommitteeColdKey)
pAddCommitteeColdVerificationKeyOrFile =
  [Parser (VerificationKeyOrFile CommitteeColdKey)]
-> Parser (VerificationKeyOrFile CommitteeColdKey)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ VerificationKey CommitteeColdKey
-> VerificationKeyOrFile CommitteeColdKey
forall keyrole.
VerificationKey keyrole -> VerificationKeyOrFile keyrole
VerificationKeyValue (VerificationKey CommitteeColdKey
 -> VerificationKeyOrFile CommitteeColdKey)
-> Parser (VerificationKey CommitteeColdKey)
-> Parser (VerificationKeyOrFile CommitteeColdKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKey CommitteeColdKey)
pAddCommitteeColdVerificationKey
    , VerificationKeyFile 'In -> VerificationKeyOrFile CommitteeColdKey
forall keyrole.
VerificationKeyFile 'In -> VerificationKeyOrFile keyrole
VerificationKeyFilePath (VerificationKeyFile 'In -> VerificationKeyOrFile CommitteeColdKey)
-> Parser (VerificationKeyFile 'In)
-> Parser (VerificationKeyOrFile CommitteeColdKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyFile 'In)
forall keyrole. Parser (File (VerificationKey keyrole) 'In)
pAddCommitteeColdVerificationKeyFile
    ]

pAddCommitteeColdVerificationKey :: Parser (VerificationKey CommitteeColdKey)
pAddCommitteeColdVerificationKey :: Parser (VerificationKey CommitteeColdKey)
pAddCommitteeColdVerificationKey =
  ReadM (VerificationKey CommitteeColdKey)
-> Mod OptionFields (VerificationKey CommitteeColdKey)
-> Parser (VerificationKey CommitteeColdKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM (VerificationKey CommitteeColdKey)
deserialiseFromHex (Mod OptionFields (VerificationKey CommitteeColdKey)
 -> Parser (VerificationKey CommitteeColdKey))
-> Mod OptionFields (VerificationKey CommitteeColdKey)
-> Parser (VerificationKey CommitteeColdKey)
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields (VerificationKey CommitteeColdKey)]
-> Mod OptionFields (VerificationKey CommitteeColdKey)
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields (VerificationKey CommitteeColdKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"add-cc-cold-verification-key"
      , String -> Mod OptionFields (VerificationKey CommitteeColdKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
      , String -> Mod OptionFields (VerificationKey CommitteeColdKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Constitutional Committee cold key (hex-encoded)."
      ]
 where
  deserialiseFromHex :: ReadM (VerificationKey CommitteeColdKey)
deserialiseFromHex =
    AsType CommitteeColdKey
-> Maybe String -> ReadM (VerificationKey CommitteeColdKey)
forall a.
SerialiseAsRawBytes (VerificationKey a) =>
AsType a -> Maybe String -> ReadM (VerificationKey a)
rVerificationKey AsType CommitteeColdKey
AsCommitteeColdKey (String -> Maybe String
forall a. a -> Maybe a
Just String
"Invalid Constitutional Committee cold key")

pAddCommitteeColdVerificationKeyFile :: Parser (File (VerificationKey keyrole) In)
pAddCommitteeColdVerificationKeyFile :: forall keyrole. Parser (File (VerificationKey keyrole) 'In)
pAddCommitteeColdVerificationKeyFile =
  String -> File (VerificationKey keyrole) 'In
forall content (direction :: FileDirection).
String -> File content direction
File
    (String -> File (VerificationKey keyrole) 'In)
-> Parser String -> Parser (File (VerificationKey keyrole) 'In)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser String
parseFilePath
      String
"add-cc-cold-verification-key-file"
      String
"Filepath of the Constitutional Committee cold key."

---
pRemoveCommitteeColdVerificationKeySource
  :: Parser (VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey)
pRemoveCommitteeColdVerificationKeySource :: Parser (VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey)
pRemoveCommitteeColdVerificationKeySource =
  [Parser (VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey)]
-> Parser
     (VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ VerificationKeyOrHashOrFile CommitteeColdKey
-> VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
forall keyrole.
VerificationKeyOrHashOrFile keyrole
-> VerificationKeyOrHashOrFileOrScriptHash keyrole
VkhfshKeyHashFile (VerificationKeyOrHashOrFile CommitteeColdKey
 -> VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey)
-> (VerificationKeyOrFile CommitteeColdKey
    -> VerificationKeyOrHashOrFile CommitteeColdKey)
-> VerificationKeyOrFile CommitteeColdKey
-> VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationKeyOrFile CommitteeColdKey
-> VerificationKeyOrHashOrFile CommitteeColdKey
forall keyrole.
VerificationKeyOrFile keyrole
-> VerificationKeyOrHashOrFile keyrole
VerificationKeyOrFile (VerificationKeyOrFile CommitteeColdKey
 -> VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey)
-> Parser (VerificationKeyOrFile CommitteeColdKey)
-> Parser
     (VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyOrFile CommitteeColdKey)
pRemoveCommitteeColdVerificationKeyOrFile
    , VerificationKeyOrHashOrFile CommitteeColdKey
-> VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
forall keyrole.
VerificationKeyOrHashOrFile keyrole
-> VerificationKeyOrHashOrFileOrScriptHash keyrole
VkhfshKeyHashFile (VerificationKeyOrHashOrFile CommitteeColdKey
 -> VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey)
-> (Hash CommitteeColdKey
    -> VerificationKeyOrHashOrFile CommitteeColdKey)
-> Hash CommitteeColdKey
-> VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash CommitteeColdKey
-> VerificationKeyOrHashOrFile CommitteeColdKey
forall keyrole. Hash keyrole -> VerificationKeyOrHashOrFile keyrole
VerificationKeyHash (Hash CommitteeColdKey
 -> VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey)
-> Parser (Hash CommitteeColdKey)
-> Parser
     (VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Hash CommitteeColdKey)
pRemoveCommitteeColdVerificationKeyHash
    , ScriptHash
-> VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
forall keyrole.
ScriptHash -> VerificationKeyOrHashOrFileOrScriptHash keyrole
VkhfshScriptHash
        (ScriptHash
 -> VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey)
-> Parser ScriptHash
-> Parser
     (VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser ScriptHash
pScriptHash
          String
"remove-cc-cold-script-hash"
          String
"Cold Native or Plutus script file hash (hex-encoded). Obtain it with \"cardano-cli hash script ...\"."
    ]

pScriptHash
  :: String
  -- ^ long option name
  -> String
  -- ^ help text
  -> Parser ScriptHash
pScriptHash :: String -> String -> Parser ScriptHash
pScriptHash String
longOptionName String
helpText =
  ReadM ScriptHash
-> Mod OptionFields ScriptHash -> Parser ScriptHash
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM ScriptHash
scriptHashReader (Mod OptionFields ScriptHash -> Parser ScriptHash)
-> Mod OptionFields ScriptHash -> Parser ScriptHash
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields ScriptHash] -> Mod OptionFields ScriptHash
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields ScriptHash
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
longOptionName
      , String -> Mod OptionFields ScriptHash
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"HASH"
      , String -> Mod OptionFields ScriptHash
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
helpText
      ]

pRemoveCommitteeColdVerificationKeyHash :: Parser (Hash CommitteeColdKey)
pRemoveCommitteeColdVerificationKeyHash :: Parser (Hash CommitteeColdKey)
pRemoveCommitteeColdVerificationKeyHash =
  ReadM (Hash CommitteeColdKey)
-> Mod OptionFields (Hash CommitteeColdKey)
-> Parser (Hash CommitteeColdKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM (Hash CommitteeColdKey)
deserialiseColdCCKeyHashFromHex (Mod OptionFields (Hash CommitteeColdKey)
 -> Parser (Hash CommitteeColdKey))
-> Mod OptionFields (Hash CommitteeColdKey)
-> Parser (Hash CommitteeColdKey)
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields (Hash CommitteeColdKey)]
-> Mod OptionFields (Hash CommitteeColdKey)
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields (Hash CommitteeColdKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"remove-cc-cold-verification-key-hash"
      , String -> Mod OptionFields (Hash CommitteeColdKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
      , String -> Mod OptionFields (Hash CommitteeColdKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Constitutional Committee key hash (hex-encoded)."
      ]

pRemoveCommitteeColdVerificationKeyOrFile :: Parser (VerificationKeyOrFile CommitteeColdKey)
pRemoveCommitteeColdVerificationKeyOrFile :: Parser (VerificationKeyOrFile CommitteeColdKey)
pRemoveCommitteeColdVerificationKeyOrFile =
  [Parser (VerificationKeyOrFile CommitteeColdKey)]
-> Parser (VerificationKeyOrFile CommitteeColdKey)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ VerificationKey CommitteeColdKey
-> VerificationKeyOrFile CommitteeColdKey
forall keyrole.
VerificationKey keyrole -> VerificationKeyOrFile keyrole
VerificationKeyValue (VerificationKey CommitteeColdKey
 -> VerificationKeyOrFile CommitteeColdKey)
-> Parser (VerificationKey CommitteeColdKey)
-> Parser (VerificationKeyOrFile CommitteeColdKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKey CommitteeColdKey)
pRemoveCommitteeColdVerificationKey
    , VerificationKeyFile 'In -> VerificationKeyOrFile CommitteeColdKey
forall keyrole.
VerificationKeyFile 'In -> VerificationKeyOrFile keyrole
VerificationKeyFilePath (VerificationKeyFile 'In -> VerificationKeyOrFile CommitteeColdKey)
-> Parser (VerificationKeyFile 'In)
-> Parser (VerificationKeyOrFile CommitteeColdKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyFile 'In)
forall keyrole. Parser (File (VerificationKey keyrole) 'In)
pRemoveCommitteeColdVerificationKeyFile
    ]

pRemoveCommitteeColdVerificationKey :: Parser (VerificationKey CommitteeColdKey)
pRemoveCommitteeColdVerificationKey :: Parser (VerificationKey CommitteeColdKey)
pRemoveCommitteeColdVerificationKey =
  ReadM (VerificationKey CommitteeColdKey)
-> Mod OptionFields (VerificationKey CommitteeColdKey)
-> Parser (VerificationKey CommitteeColdKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM (VerificationKey CommitteeColdKey)
deserialiseColdCCKeyFromHex (Mod OptionFields (VerificationKey CommitteeColdKey)
 -> Parser (VerificationKey CommitteeColdKey))
-> Mod OptionFields (VerificationKey CommitteeColdKey)
-> Parser (VerificationKey CommitteeColdKey)
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields (VerificationKey CommitteeColdKey)]
-> Mod OptionFields (VerificationKey CommitteeColdKey)
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields (VerificationKey CommitteeColdKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"remove-cc-cold-verification-key"
      , String -> Mod OptionFields (VerificationKey CommitteeColdKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
      , String -> Mod OptionFields (VerificationKey CommitteeColdKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Constitutional Committee cold key (hex-encoded)."
      ]

deserialiseColdCCKeyFromHex :: ReadM (VerificationKey CommitteeColdKey)
deserialiseColdCCKeyFromHex :: ReadM (VerificationKey CommitteeColdKey)
deserialiseColdCCKeyFromHex =
  AsType CommitteeColdKey
-> Maybe String -> ReadM (VerificationKey CommitteeColdKey)
forall a.
SerialiseAsRawBytes (VerificationKey a) =>
AsType a -> Maybe String -> ReadM (VerificationKey a)
rVerificationKey AsType CommitteeColdKey
AsCommitteeColdKey (String -> Maybe String
forall a. a -> Maybe a
Just String
"Invalid Constitutional Committee cold key")

deserialiseColdCCKeyHashFromHex :: ReadM (Hash CommitteeColdKey)
deserialiseColdCCKeyHashFromHex :: ReadM (Hash CommitteeColdKey)
deserialiseColdCCKeyHashFromHex =
  AsType CommitteeColdKey
-> Maybe String -> ReadM (Hash CommitteeColdKey)
forall a.
SerialiseAsRawBytes (Hash a) =>
AsType a -> Maybe String -> ReadM (Hash a)
rHexHash AsType CommitteeColdKey
AsCommitteeColdKey (String -> Maybe String
forall a. a -> Maybe a
Just String
"Invalid Constitutional Committee cold key hash")

pRemoveCommitteeColdVerificationKeyFile :: Parser (File (VerificationKey keyrole) In)
pRemoveCommitteeColdVerificationKeyFile :: forall keyrole. Parser (File (VerificationKey keyrole) 'In)
pRemoveCommitteeColdVerificationKeyFile =
  String -> File (VerificationKey keyrole) 'In
forall content (direction :: FileDirection).
String -> File content direction
File
    (String -> File (VerificationKey keyrole) 'In)
-> Parser String -> Parser (File (VerificationKey keyrole) 'In)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser String
parseFilePath
      String
"remove-cc-cold-verification-key-file"
      String
"Filepath of the Constitutional Committee cold key."

---

pCommitteeColdVerificationKeyOrHashOrFile :: Parser (VerificationKeyOrHashOrFile CommitteeColdKey)
pCommitteeColdVerificationKeyOrHashOrFile :: Parser (VerificationKeyOrHashOrFile CommitteeColdKey)
pCommitteeColdVerificationKeyOrHashOrFile =
  [Parser (VerificationKeyOrHashOrFile CommitteeColdKey)]
-> Parser (VerificationKeyOrHashOrFile CommitteeColdKey)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ VerificationKeyOrFile CommitteeColdKey
-> VerificationKeyOrHashOrFile CommitteeColdKey
forall keyrole.
VerificationKeyOrFile keyrole
-> VerificationKeyOrHashOrFile keyrole
VerificationKeyOrFile (VerificationKeyOrFile CommitteeColdKey
 -> VerificationKeyOrHashOrFile CommitteeColdKey)
-> Parser (VerificationKeyOrFile CommitteeColdKey)
-> Parser (VerificationKeyOrHashOrFile CommitteeColdKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyOrFile CommitteeColdKey)
pCommitteeColdVerificationKeyOrFile
    , Hash CommitteeColdKey
-> VerificationKeyOrHashOrFile CommitteeColdKey
forall keyrole. Hash keyrole -> VerificationKeyOrHashOrFile keyrole
VerificationKeyHash (Hash CommitteeColdKey
 -> VerificationKeyOrHashOrFile CommitteeColdKey)
-> Parser (Hash CommitteeColdKey)
-> Parser (VerificationKeyOrHashOrFile CommitteeColdKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Hash CommitteeColdKey)
pCommitteeColdVerificationKeyHash
    ]

pCommitteeColdVerificationKeyOrFile :: Parser (VerificationKeyOrFile CommitteeColdKey)
pCommitteeColdVerificationKeyOrFile :: Parser (VerificationKeyOrFile CommitteeColdKey)
pCommitteeColdVerificationKeyOrFile =
  [Parser (VerificationKeyOrFile CommitteeColdKey)]
-> Parser (VerificationKeyOrFile CommitteeColdKey)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ VerificationKey CommitteeColdKey
-> VerificationKeyOrFile CommitteeColdKey
forall keyrole.
VerificationKey keyrole -> VerificationKeyOrFile keyrole
VerificationKeyValue (VerificationKey CommitteeColdKey
 -> VerificationKeyOrFile CommitteeColdKey)
-> Parser (VerificationKey CommitteeColdKey)
-> Parser (VerificationKeyOrFile CommitteeColdKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKey CommitteeColdKey)
pCommitteeColdVerificationKey
    , VerificationKeyFile 'In -> VerificationKeyOrFile CommitteeColdKey
forall keyrole.
VerificationKeyFile 'In -> VerificationKeyOrFile keyrole
VerificationKeyFilePath (VerificationKeyFile 'In -> VerificationKeyOrFile CommitteeColdKey)
-> Parser (VerificationKeyFile 'In)
-> Parser (VerificationKeyOrFile CommitteeColdKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyFile 'In)
forall keyrole. Parser (File (VerificationKey keyrole) 'In)
pCommitteeColdVerificationKeyFile
    ]

pCommitteeColdVerificationKey :: Parser (VerificationKey CommitteeColdKey)
pCommitteeColdVerificationKey :: Parser (VerificationKey CommitteeColdKey)
pCommitteeColdVerificationKey =
  ReadM (VerificationKey CommitteeColdKey)
-> Mod OptionFields (VerificationKey CommitteeColdKey)
-> Parser (VerificationKey CommitteeColdKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM (VerificationKey CommitteeColdKey)
deserialiseColdCCKeyFromHex (Mod OptionFields (VerificationKey CommitteeColdKey)
 -> Parser (VerificationKey CommitteeColdKey))
-> Mod OptionFields (VerificationKey CommitteeColdKey)
-> Parser (VerificationKey CommitteeColdKey)
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields (VerificationKey CommitteeColdKey)]
-> Mod OptionFields (VerificationKey CommitteeColdKey)
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields (VerificationKey CommitteeColdKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"cold-verification-key"
      , String -> Mod OptionFields (VerificationKey CommitteeColdKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
      , String -> Mod OptionFields (VerificationKey CommitteeColdKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Constitutional Committee cold key (hex-encoded)."
      ]

pCommitteeColdVerificationKeyHash :: Parser (Hash CommitteeColdKey)
pCommitteeColdVerificationKeyHash :: Parser (Hash CommitteeColdKey)
pCommitteeColdVerificationKeyHash =
  ReadM (Hash CommitteeColdKey)
-> Mod OptionFields (Hash CommitteeColdKey)
-> Parser (Hash CommitteeColdKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM (Hash CommitteeColdKey)
deserialiseColdCCKeyHashFromHex (Mod OptionFields (Hash CommitteeColdKey)
 -> Parser (Hash CommitteeColdKey))
-> Mod OptionFields (Hash CommitteeColdKey)
-> Parser (Hash CommitteeColdKey)
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields (Hash CommitteeColdKey)]
-> Mod OptionFields (Hash CommitteeColdKey)
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields (Hash CommitteeColdKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"cold-verification-key-hash"
      , String -> Mod OptionFields (Hash CommitteeColdKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
      , String -> Mod OptionFields (Hash CommitteeColdKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Constitutional Committee key hash (hex-encoded)."
      ]

pCommitteeColdVerificationKeyFile :: Parser (File (VerificationKey keyrole) In)
pCommitteeColdVerificationKeyFile :: forall keyrole. Parser (File (VerificationKey keyrole) 'In)
pCommitteeColdVerificationKeyFile =
  String -> File (VerificationKey keyrole) 'In
forall content (direction :: FileDirection).
String -> File content direction
File
    (String -> File (VerificationKey keyrole) 'In)
-> Parser String -> Parser (File (VerificationKey keyrole) 'In)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser String
parseFilePath String
"cold-verification-key-file" String
"Filepath of the Constitutional Committee cold key."

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

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

pAnyVerificationKeyText :: String -> Parser AnyVerificationKeyText
pAnyVerificationKeyText :: String -> Parser AnyVerificationKeyText
pAnyVerificationKeyText String
helpText =
  (String -> AnyVerificationKeyText)
-> Parser String -> Parser AnyVerificationKeyText
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> AnyVerificationKeyText
AnyVerificationKeyText (Text -> AnyVerificationKeyText)
-> (String -> Text) -> String -> AnyVerificationKeyText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack) (Parser String -> Parser AnyVerificationKeyText)
-> Parser String -> Parser AnyVerificationKeyText
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
"verification-key"
        , String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
        , String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod OptionFields String)
-> String -> Mod OptionFields String
forall a b. (a -> b) -> a -> b
$ String
helpText String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" (Bech32-encoded)"
        ]

pAnyVerificationKeySource :: String -> Parser AnyVerificationKeySource
pAnyVerificationKeySource :: String -> Parser AnyVerificationKeySource
pAnyVerificationKeySource String
helpText =
  [Parser AnyVerificationKeySource]
-> Parser AnyVerificationKeySource
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ AnyVerificationKeyText -> AnyVerificationKeySource
AnyVerificationKeySourceOfText (AnyVerificationKeyText -> AnyVerificationKeySource)
-> Parser AnyVerificationKeyText -> Parser AnyVerificationKeySource
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Parser AnyVerificationKeyText
pAnyVerificationKeyText String
helpText
    , VerificationKeyFile 'In -> AnyVerificationKeySource
AnyVerificationKeySourceOfFile (VerificationKeyFile 'In -> AnyVerificationKeySource)
-> Parser (VerificationKeyFile 'In)
-> Parser AnyVerificationKeySource
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Parser (VerificationKeyFile 'In)
pAnyVerificationKeyFileIn String
helpText
    ]

pCommitteeHotKey :: Parser (VerificationKey CommitteeHotKey)
pCommitteeHotKey :: Parser (VerificationKey CommitteeHotKey)
pCommitteeHotKey = String -> Parser (VerificationKey CommitteeHotKey)
pCommitteeHotVerificationKey String
"hot-key"

pCommitteeHotVerificationKeyOrFile :: Parser (VerificationKeyOrFile CommitteeHotKey)
pCommitteeHotVerificationKeyOrFile :: Parser (VerificationKeyOrFile CommitteeHotKey)
pCommitteeHotVerificationKeyOrFile =
  [Parser (VerificationKeyOrFile CommitteeHotKey)]
-> Parser (VerificationKeyOrFile CommitteeHotKey)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ VerificationKey CommitteeHotKey
-> VerificationKeyOrFile CommitteeHotKey
forall keyrole.
VerificationKey keyrole -> VerificationKeyOrFile keyrole
VerificationKeyValue (VerificationKey CommitteeHotKey
 -> VerificationKeyOrFile CommitteeHotKey)
-> Parser (VerificationKey CommitteeHotKey)
-> Parser (VerificationKeyOrFile CommitteeHotKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Parser (VerificationKey CommitteeHotKey)
pCommitteeHotVerificationKey String
"hot-verification-key"
    , VerificationKeyFile 'In -> VerificationKeyOrFile CommitteeHotKey
forall keyrole.
VerificationKeyFile 'In -> VerificationKeyOrFile keyrole
VerificationKeyFilePath (VerificationKeyFile 'In -> VerificationKeyOrFile CommitteeHotKey)
-> Parser (VerificationKeyFile 'In)
-> Parser (VerificationKeyOrFile CommitteeHotKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Parser (VerificationKeyFile 'In)
pCommitteeHotVerificationKeyFile String
"hot-verification-key-file"
    ]

pCommitteeHotVerificationKeyHash :: Parser (Hash CommitteeHotKey)
pCommitteeHotVerificationKeyHash :: Parser (Hash CommitteeHotKey)
pCommitteeHotVerificationKeyHash =
  ReadM (Hash CommitteeHotKey)
-> Mod OptionFields (Hash CommitteeHotKey)
-> Parser (Hash CommitteeHotKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM (Hash CommitteeHotKey)
deserialiseHotCCKeyHashFromHex (Mod OptionFields (Hash CommitteeHotKey)
 -> Parser (Hash CommitteeHotKey))
-> Mod OptionFields (Hash CommitteeHotKey)
-> Parser (Hash CommitteeHotKey)
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields (Hash CommitteeHotKey)]
-> Mod OptionFields (Hash CommitteeHotKey)
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields (Hash CommitteeHotKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"hot-verification-key-hash"
      , String -> Mod OptionFields (Hash CommitteeHotKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
      , String -> Mod OptionFields (Hash CommitteeHotKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Constitutional Committee key hash (hex-encoded)."
      ]

pCommitteeHotVerificationKey :: String -> Parser (VerificationKey CommitteeHotKey)
pCommitteeHotVerificationKey :: String -> Parser (VerificationKey CommitteeHotKey)
pCommitteeHotVerificationKey String
longFlag =
  ReadM (VerificationKey CommitteeHotKey)
-> Mod OptionFields (VerificationKey CommitteeHotKey)
-> Parser (VerificationKey CommitteeHotKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM (VerificationKey CommitteeHotKey)
deserialiseHotCCKeyFromHex (Mod OptionFields (VerificationKey CommitteeHotKey)
 -> Parser (VerificationKey CommitteeHotKey))
-> Mod OptionFields (VerificationKey CommitteeHotKey)
-> Parser (VerificationKey CommitteeHotKey)
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields (VerificationKey CommitteeHotKey)]
-> Mod OptionFields (VerificationKey CommitteeHotKey)
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields (VerificationKey CommitteeHotKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
longFlag
      , String -> Mod OptionFields (VerificationKey CommitteeHotKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
      , String -> Mod OptionFields (VerificationKey CommitteeHotKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Constitutional Committee hot key (hex-encoded)."
      ]

deserialiseHotCCKeyFromHex :: ReadM (VerificationKey CommitteeHotKey)
deserialiseHotCCKeyFromHex :: ReadM (VerificationKey CommitteeHotKey)
deserialiseHotCCKeyFromHex =
  AsType CommitteeHotKey
-> Maybe String -> ReadM (VerificationKey CommitteeHotKey)
forall a.
SerialiseAsRawBytes (VerificationKey a) =>
AsType a -> Maybe String -> ReadM (VerificationKey a)
rVerificationKey AsType CommitteeHotKey
AsCommitteeHotKey (String -> Maybe String
forall a. a -> Maybe a
Just String
"Invalid Constitutional Committee hot key")

deserialiseHotCCKeyHashFromHex :: ReadM (Hash CommitteeHotKey)
deserialiseHotCCKeyHashFromHex :: ReadM (Hash CommitteeHotKey)
deserialiseHotCCKeyHashFromHex =
  AsType CommitteeHotKey
-> Maybe String -> ReadM (Hash CommitteeHotKey)
forall a.
SerialiseAsRawBytes (Hash a) =>
AsType a -> Maybe String -> ReadM (Hash a)
rHexHash AsType CommitteeHotKey
AsCommitteeHotKey (String -> Maybe String
forall a. a -> Maybe a
Just String
"Invalid Constitutional Committee hot key hash")

pCommitteeHotVerificationKeyFile :: String -> Parser (VerificationKeyFile In)
pCommitteeHotVerificationKeyFile :: String -> Parser (VerificationKeyFile 'In)
pCommitteeHotVerificationKeyFile String
longFlag =
  String -> VerificationKeyFile 'In
forall content (direction :: FileDirection).
String -> File content direction
File (String -> VerificationKeyFile 'In)
-> Parser String -> Parser (VerificationKeyFile 'In)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser String
parseFilePath String
longFlag String
"Filepath of the Constitutional Committee hot key."

-- | The first argument is the optional prefix.
pCommitteeHotKeyHash :: Maybe String -> Parser (Hash CommitteeHotKey)
pCommitteeHotKeyHash :: Maybe String -> Parser (Hash CommitteeHotKey)
pCommitteeHotKeyHash Maybe String
prefix =
  ReadM (Hash CommitteeHotKey)
-> Mod OptionFields (Hash CommitteeHotKey)
-> Parser (Hash CommitteeHotKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM (Hash CommitteeHotKey)
deserialiseHotCCKeyHashFromHex (Mod OptionFields (Hash CommitteeHotKey)
 -> Parser (Hash CommitteeHotKey))
-> Mod OptionFields (Hash CommitteeHotKey)
-> Parser (Hash CommitteeHotKey)
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields (Hash CommitteeHotKey)]
-> Mod OptionFields (Hash CommitteeHotKey)
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields (Hash CommitteeHotKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long (String -> Mod OptionFields (Hash CommitteeHotKey))
-> String -> Mod OptionFields (Hash CommitteeHotKey)
forall a b. (a -> b) -> a -> b
$ Maybe String -> String -> String
prefixFlag Maybe String
prefix String
"hot-key-hash"
      , String -> Mod OptionFields (Hash CommitteeHotKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
      , String -> Mod OptionFields (Hash CommitteeHotKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Constitutional Committee key hash (hex-encoded)."
      ]

pCommitteeHotKeyOrHashOrFile :: Parser (VerificationKeyOrHashOrFile CommitteeHotKey)
pCommitteeHotKeyOrHashOrFile :: Parser (VerificationKeyOrHashOrFile CommitteeHotKey)
pCommitteeHotKeyOrHashOrFile =
  [Parser (VerificationKeyOrHashOrFile CommitteeHotKey)]
-> Parser (VerificationKeyOrHashOrFile CommitteeHotKey)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ VerificationKeyOrFile CommitteeHotKey
-> VerificationKeyOrHashOrFile CommitteeHotKey
forall keyrole.
VerificationKeyOrFile keyrole
-> VerificationKeyOrHashOrFile keyrole
VerificationKeyOrFile (VerificationKeyOrFile CommitteeHotKey
 -> VerificationKeyOrHashOrFile CommitteeHotKey)
-> (VerificationKey CommitteeHotKey
    -> VerificationKeyOrFile CommitteeHotKey)
-> VerificationKey CommitteeHotKey
-> VerificationKeyOrHashOrFile CommitteeHotKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationKey CommitteeHotKey
-> VerificationKeyOrFile CommitteeHotKey
forall keyrole.
VerificationKey keyrole -> VerificationKeyOrFile keyrole
VerificationKeyValue (VerificationKey CommitteeHotKey
 -> VerificationKeyOrHashOrFile CommitteeHotKey)
-> Parser (VerificationKey CommitteeHotKey)
-> Parser (VerificationKeyOrHashOrFile CommitteeHotKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKey CommitteeHotKey)
pCommitteeHotKey
    , VerificationKeyOrFile CommitteeHotKey
-> VerificationKeyOrHashOrFile CommitteeHotKey
forall keyrole.
VerificationKeyOrFile keyrole
-> VerificationKeyOrHashOrFile keyrole
VerificationKeyOrFile (VerificationKeyOrFile CommitteeHotKey
 -> VerificationKeyOrHashOrFile CommitteeHotKey)
-> (VerificationKeyFile 'In
    -> VerificationKeyOrFile CommitteeHotKey)
-> VerificationKeyFile 'In
-> VerificationKeyOrHashOrFile CommitteeHotKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationKeyFile 'In -> VerificationKeyOrFile CommitteeHotKey
forall keyrole.
VerificationKeyFile 'In -> VerificationKeyOrFile keyrole
VerificationKeyFilePath (VerificationKeyFile 'In
 -> VerificationKeyOrHashOrFile CommitteeHotKey)
-> Parser (VerificationKeyFile 'In)
-> Parser (VerificationKeyOrHashOrFile CommitteeHotKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Parser (VerificationKeyFile 'In)
pCommitteeHotVerificationKeyFile String
"hot-key-file"
    , Hash CommitteeHotKey -> VerificationKeyOrHashOrFile CommitteeHotKey
forall keyrole. Hash keyrole -> VerificationKeyOrHashOrFile keyrole
VerificationKeyHash (Hash CommitteeHotKey
 -> VerificationKeyOrHashOrFile CommitteeHotKey)
-> Parser (Hash CommitteeHotKey)
-> Parser (VerificationKeyOrHashOrFile CommitteeHotKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String -> Parser (Hash CommitteeHotKey)
pCommitteeHotKeyHash Maybe String
forall a. Maybe a
Nothing
    ]

pCommitteeHotVerificationKeyOrHashOrVerificationFile
  :: Parser (VerificationKeyOrHashOrFile CommitteeHotKey)
pCommitteeHotVerificationKeyOrHashOrVerificationFile :: Parser (VerificationKeyOrHashOrFile CommitteeHotKey)
pCommitteeHotVerificationKeyOrHashOrVerificationFile =
  [Parser (VerificationKeyOrHashOrFile CommitteeHotKey)]
-> Parser (VerificationKeyOrHashOrFile CommitteeHotKey)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ VerificationKeyOrFile CommitteeHotKey
-> VerificationKeyOrHashOrFile CommitteeHotKey
forall keyrole.
VerificationKeyOrFile keyrole
-> VerificationKeyOrHashOrFile keyrole
VerificationKeyOrFile (VerificationKeyOrFile CommitteeHotKey
 -> VerificationKeyOrHashOrFile CommitteeHotKey)
-> (VerificationKey CommitteeHotKey
    -> VerificationKeyOrFile CommitteeHotKey)
-> VerificationKey CommitteeHotKey
-> VerificationKeyOrHashOrFile CommitteeHotKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationKey CommitteeHotKey
-> VerificationKeyOrFile CommitteeHotKey
forall keyrole.
VerificationKey keyrole -> VerificationKeyOrFile keyrole
VerificationKeyValue
        (VerificationKey CommitteeHotKey
 -> VerificationKeyOrHashOrFile CommitteeHotKey)
-> Parser (VerificationKey CommitteeHotKey)
-> Parser (VerificationKeyOrHashOrFile CommitteeHotKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Parser (VerificationKey CommitteeHotKey)
pCommitteeHotVerificationKey String
"cc-hot-verification-key"
    , VerificationKeyOrFile CommitteeHotKey
-> VerificationKeyOrHashOrFile CommitteeHotKey
forall keyrole.
VerificationKeyOrFile keyrole
-> VerificationKeyOrHashOrFile keyrole
VerificationKeyOrFile (VerificationKeyOrFile CommitteeHotKey
 -> VerificationKeyOrHashOrFile CommitteeHotKey)
-> (VerificationKeyFile 'In
    -> VerificationKeyOrFile CommitteeHotKey)
-> VerificationKeyFile 'In
-> VerificationKeyOrHashOrFile CommitteeHotKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationKeyFile 'In -> VerificationKeyOrFile CommitteeHotKey
forall keyrole.
VerificationKeyFile 'In -> VerificationKeyOrFile keyrole
VerificationKeyFilePath
        (VerificationKeyFile 'In
 -> VerificationKeyOrHashOrFile CommitteeHotKey)
-> Parser (VerificationKeyFile 'In)
-> Parser (VerificationKeyOrHashOrFile CommitteeHotKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Parser (VerificationKeyFile 'In)
pCommitteeHotVerificationKeyFile String
"cc-hot-verification-key-file"
    , Hash CommitteeHotKey -> VerificationKeyOrHashOrFile CommitteeHotKey
forall keyrole. Hash keyrole -> VerificationKeyOrHashOrFile keyrole
VerificationKeyHash (Hash CommitteeHotKey
 -> VerificationKeyOrHashOrFile CommitteeHotKey)
-> Parser (Hash CommitteeHotKey)
-> Parser (VerificationKeyOrHashOrFile CommitteeHotKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String -> Parser (Hash CommitteeHotKey)
pCommitteeHotKeyHash (String -> Maybe String
forall a. a -> Maybe a
Just String
"cc")
    ]

pCommitteeHotVerificationKeyOrHashOrVerificationFileOrScriptHash
  :: Parser (VerificationKeyOrHashOrFileOrScriptHash CommitteeHotKey)
pCommitteeHotVerificationKeyOrHashOrVerificationFileOrScriptHash :: Parser (VerificationKeyOrHashOrFileOrScriptHash CommitteeHotKey)
pCommitteeHotVerificationKeyOrHashOrVerificationFileOrScriptHash =
  [Parser (VerificationKeyOrHashOrFileOrScriptHash CommitteeHotKey)]
-> Parser (VerificationKeyOrHashOrFileOrScriptHash CommitteeHotKey)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ VerificationKeyOrHashOrFile CommitteeHotKey
-> VerificationKeyOrHashOrFileOrScriptHash CommitteeHotKey
forall keyrole.
VerificationKeyOrHashOrFile keyrole
-> VerificationKeyOrHashOrFileOrScriptHash keyrole
VkhfshKeyHashFile (VerificationKeyOrHashOrFile CommitteeHotKey
 -> VerificationKeyOrHashOrFileOrScriptHash CommitteeHotKey)
-> Parser (VerificationKeyOrHashOrFile CommitteeHotKey)
-> Parser (VerificationKeyOrHashOrFileOrScriptHash CommitteeHotKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyOrHashOrFile CommitteeHotKey)
pCommitteeHotVerificationKeyOrHashOrVerificationFile
    , ScriptHash
-> VerificationKeyOrHashOrFileOrScriptHash CommitteeHotKey
forall keyrole.
ScriptHash -> VerificationKeyOrHashOrFileOrScriptHash keyrole
VkhfshScriptHash
        (ScriptHash
 -> VerificationKeyOrHashOrFileOrScriptHash CommitteeHotKey)
-> Parser ScriptHash
-> Parser (VerificationKeyOrHashOrFileOrScriptHash CommitteeHotKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser ScriptHash
pScriptHash
          String
"cc-hot-script-hash"
          String
"Cold Native or Plutus script file hash (hex-encoded). Obtain it with \"cardano-cli hash script ...\"."
    ]

catCommands :: [Parser a] -> Maybe (Parser a)
catCommands :: forall a. [Parser a] -> Maybe (Parser a)
catCommands = \case
  [] -> Maybe (Parser a)
forall a. Maybe a
Nothing
  [Parser a]
ps -> Parser a -> Maybe (Parser a)
forall a. a -> Maybe a
Just (Parser a -> Maybe (Parser a)) -> Parser a -> Maybe (Parser a)
forall a b. (a -> b) -> a -> b
$ [Parser a] -> Parser a
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [Parser a]
ps

pConstitutionUrl :: Parser ConstitutionUrl
pConstitutionUrl :: Parser ConstitutionUrl
pConstitutionUrl =
  Url -> ConstitutionUrl
ConstitutionUrl
    (Url -> ConstitutionUrl) -> Parser Url -> Parser ConstitutionUrl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser Url
pUrl String
"constitution-url" String
"Constitution URL."

pConstitutionHash :: Parser (L.SafeHash L.StandardCrypto L.AnchorData)
pConstitutionHash :: Parser (SafeHash StandardCrypto AnchorData)
pConstitutionHash =
  ReadM (SafeHash StandardCrypto AnchorData)
-> Mod OptionFields (SafeHash StandardCrypto AnchorData)
-> Parser (SafeHash StandardCrypto AnchorData)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM (SafeHash StandardCrypto AnchorData)
readSafeHash (Mod OptionFields (SafeHash StandardCrypto AnchorData)
 -> Parser (SafeHash StandardCrypto AnchorData))
-> Mod OptionFields (SafeHash StandardCrypto AnchorData)
-> Parser (SafeHash StandardCrypto AnchorData)
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields (SafeHash StandardCrypto AnchorData)]
-> Mod OptionFields (SafeHash StandardCrypto AnchorData)
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields (SafeHash StandardCrypto AnchorData)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"constitution-hash"
      , String -> Mod OptionFields (SafeHash StandardCrypto AnchorData)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"HASH"
      , String -> Mod OptionFields (SafeHash StandardCrypto AnchorData)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Hash of the constitution data (obtain it with \"cardano-cli hash anchor-data ...\")."
      ]

pUrl :: String -> String -> Parser L.Url
pUrl :: String -> String -> Parser Url
pUrl String
l String
h =
  let toUrl :: Text -> Url
toUrl Text
urlText =
        Url -> Maybe Url -> Url
forall a. a -> Maybe a -> a
fromMaybe (String -> Url
forall a. HasCallStack => String -> a
error String
"Url longer than 64 bytes") (Maybe Url -> Url) -> Maybe Url -> Url
forall a b. (a -> b) -> a -> b
$
          Int -> Text -> Maybe Url
forall (m :: * -> *). MonadFail m => Int -> Text -> m Url
L.textToUrl (Text -> Int
Text.length Text
urlText) Text
urlText
   in (Text -> Url) -> Parser Text -> Parser Url
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Url
toUrl (Parser Text -> Parser Url)
-> (Mod OptionFields Text -> Parser Text)
-> Mod OptionFields Text
-> Parser Url
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption (Mod OptionFields Text -> Parser Url)
-> Mod OptionFields Text -> Parser Url
forall a b. (a -> b) -> a -> b
$
        [Mod OptionFields Text] -> Mod OptionFields Text
forall a. Monoid a => [a] -> a
mconcat
          [ String -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
l
          , String -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"TEXT"
          , String -> Mod OptionFields Text
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
h
          ]

pGovActionDeposit :: Parser Lovelace
pGovActionDeposit :: Parser Lovelace
pGovActionDeposit =
  ReadM Lovelace -> Mod OptionFields Lovelace -> Parser Lovelace
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser Lovelace -> ReadM Lovelace
forall a. Parser a -> ReadM a
readerFromParsecParser Parser Lovelace
parseLovelace) (Mod OptionFields Lovelace -> Parser Lovelace)
-> Mod OptionFields Lovelace -> Parser Lovelace
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Lovelace] -> Mod OptionFields Lovelace
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"governance-action-deposit"
      , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"NATURAL"
      , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Deposit required to submit a governance action."
      ]

pNewGovActionDeposit :: Parser Lovelace
pNewGovActionDeposit :: Parser Lovelace
pNewGovActionDeposit =
  ReadM Lovelace -> Mod OptionFields Lovelace -> Parser Lovelace
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser Lovelace -> ReadM Lovelace
forall a. Parser a -> ReadM a
readerFromParsecParser Parser Lovelace
parseLovelace) (Mod OptionFields Lovelace -> Parser Lovelace)
-> Mod OptionFields Lovelace -> Parser Lovelace
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Lovelace] -> Mod OptionFields Lovelace
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"new-governance-action-deposit"
      , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"NATURAL"
      , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Proposed new value of the deposit required to submit a governance action."
      ]

-- | First argument is the optional prefix
pStakeVerificationKeyOrHashOrFile :: Maybe String -> Parser (VerificationKeyOrHashOrFile StakeKey)
pStakeVerificationKeyOrHashOrFile :: Maybe String -> Parser (VerificationKeyOrHashOrFile StakeKey)
pStakeVerificationKeyOrHashOrFile Maybe String
prefix =
  [Parser (VerificationKeyOrHashOrFile StakeKey)]
-> Parser (VerificationKeyOrHashOrFile StakeKey)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ VerificationKeyOrFile StakeKey
-> VerificationKeyOrHashOrFile StakeKey
forall keyrole.
VerificationKeyOrFile keyrole
-> VerificationKeyOrHashOrFile keyrole
VerificationKeyOrFile (VerificationKeyOrFile StakeKey
 -> VerificationKeyOrHashOrFile StakeKey)
-> Parser (VerificationKeyOrFile StakeKey)
-> Parser (VerificationKeyOrHashOrFile StakeKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String -> Parser (VerificationKeyOrFile StakeKey)
pStakeVerificationKeyOrFile Maybe String
prefix
    , Hash StakeKey -> VerificationKeyOrHashOrFile StakeKey
forall keyrole. Hash keyrole -> VerificationKeyOrHashOrFile keyrole
VerificationKeyHash (Hash StakeKey -> VerificationKeyOrHashOrFile StakeKey)
-> Parser (Hash StakeKey)
-> Parser (VerificationKeyOrHashOrFile StakeKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String -> Parser (Hash StakeKey)
pStakeVerificationKeyHash Maybe String
prefix
    ]

-- | First argument is the optional prefix
pStakeVerificationKeyHash :: Maybe String -> Parser (Hash StakeKey)
pStakeVerificationKeyHash :: Maybe String -> Parser (Hash StakeKey)
pStakeVerificationKeyHash Maybe String
prefix =
  ReadM (Hash StakeKey)
-> Mod OptionFields (Hash StakeKey) -> Parser (Hash StakeKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (AsType StakeKey -> Maybe String -> ReadM (Hash StakeKey)
forall a.
SerialiseAsRawBytes (Hash a) =>
AsType a -> Maybe String -> ReadM (Hash a)
rHexHash AsType StakeKey
AsStakeKey Maybe String
forall a. Maybe a
Nothing) (Mod OptionFields (Hash StakeKey) -> Parser (Hash StakeKey))
-> Mod OptionFields (Hash StakeKey) -> Parser (Hash StakeKey)
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields (Hash StakeKey)]
-> Mod OptionFields (Hash StakeKey)
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields (Hash StakeKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long (String -> Mod OptionFields (Hash StakeKey))
-> String -> Mod OptionFields (Hash StakeKey)
forall a b. (a -> b) -> a -> b
$ Maybe String -> String -> String
prefixFlag Maybe String
prefix String
"stake-key-hash"
      , String -> Mod OptionFields (Hash StakeKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"HASH"
      , String -> Mod OptionFields (Hash StakeKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Stake verification key hash (hex-encoded)."
      ]

-- | The first argument is the optional prefix.
pStakePoolVerificationKeyOrHashOrFile
  :: Maybe String -> Parser (VerificationKeyOrHashOrFile StakePoolKey)
pStakePoolVerificationKeyOrHashOrFile :: Maybe String -> Parser (VerificationKeyOrHashOrFile StakePoolKey)
pStakePoolVerificationKeyOrHashOrFile Maybe String
prefix =
  [Parser (VerificationKeyOrHashOrFile StakePoolKey)]
-> Parser (VerificationKeyOrHashOrFile StakePoolKey)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ VerificationKeyOrFile StakePoolKey
-> VerificationKeyOrHashOrFile StakePoolKey
forall keyrole.
VerificationKeyOrFile keyrole
-> VerificationKeyOrHashOrFile keyrole
VerificationKeyOrFile (VerificationKeyOrFile StakePoolKey
 -> VerificationKeyOrHashOrFile StakePoolKey)
-> Parser (VerificationKeyOrFile StakePoolKey)
-> Parser (VerificationKeyOrHashOrFile StakePoolKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String -> Parser (VerificationKeyOrFile StakePoolKey)
pStakePoolVerificationKeyOrFile Maybe String
prefix
    , Hash StakePoolKey -> VerificationKeyOrHashOrFile StakePoolKey
forall keyrole. Hash keyrole -> VerificationKeyOrHashOrFile keyrole
VerificationKeyHash (Hash StakePoolKey -> VerificationKeyOrHashOrFile StakePoolKey)
-> Parser (Hash StakePoolKey)
-> Parser (VerificationKeyOrHashOrFile StakePoolKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String -> Parser (Hash StakePoolKey)
pStakePoolVerificationKeyHash Maybe String
prefix
    ]

--------------------------------------------------------------------------------

pCBORInFile :: Parser FilePath
pCBORInFile :: Parser String
pCBORInFile =
  [Parser String] -> Parser String
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ String -> String -> Parser String
parseFilePath String
"in-file" String
"CBOR input file."
    , 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
"file"
          , Mod OptionFields String
forall (f :: * -> *) a. Mod f a
Opt.internal
          ]
    ]

--------------------------------------------------------------------------------

pPollQuestion :: Parser Text
pPollQuestion :: Parser Text
pPollQuestion =
  Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption (Mod OptionFields Text -> Parser Text)
-> Mod OptionFields Text -> Parser Text
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Text] -> Mod OptionFields Text
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"question"
      , String -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
      , String -> Mod OptionFields Text
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The question for the poll."
      ]

pPollAnswer :: Parser Text
pPollAnswer :: Parser Text
pPollAnswer =
  Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption (Mod OptionFields Text -> Parser Text)
-> Mod OptionFields Text -> Parser Text
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Text] -> Mod OptionFields Text
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"answer"
      , String -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
      , String -> Mod OptionFields Text
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"A possible choice for the poll. The option is repeatable."
      ]

pPollAnswerIndex :: Parser Word
pPollAnswerIndex :: Parser Word
pPollAnswerIndex =
  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
"answer"
      , 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 index of the chosen answer in the poll. Optional. Asked interactively if omitted."
      ]

pPollFile :: Parser (File GovernancePoll In)
pPollFile :: Parser (File GovernancePoll 'In)
pPollFile = String -> File GovernancePoll 'In
forall content (direction :: FileDirection).
String -> File content direction
File (String -> File GovernancePoll 'In)
-> Parser String -> Parser (File GovernancePoll 'In)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser String
parseFilePath String
"poll-file" String
"Filepath to the ongoing poll."

pPollTxFile :: Parser (TxFile In)
pPollTxFile :: Parser (TxFile 'In)
pPollTxFile =
  String -> TxFile 'In
forall content (direction :: FileDirection).
String -> File content direction
File
    (String -> TxFile 'In) -> Parser String -> Parser (TxFile 'In)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser String
parseFilePath String
"tx-file" String
"Filepath to the JSON TxBody or JSON Tx carrying a valid poll answer."

pPollNonce :: Parser Word
pPollNonce :: Parser Word
pPollNonce =
  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
"nonce"
      , String -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"UINT"
      , String -> Mod OptionFields Word
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"An (optional) nonce for non-replayability."
      ]

--------------------------------------------------------------------------------

pScriptWitnessFiles
  :: forall witctx era
   . ShelleyBasedEra era
  -> WitCtx witctx
  -> BalanceTxExecUnits
  -- ^ Use the @execution-units@ flag.
  -> String
  -- ^ Script flag prefix
  -> Maybe String
  -> String
  -> Parser (ScriptWitnessFiles witctx)
pScriptWitnessFiles :: forall witctx era.
ShelleyBasedEra era
-> WitCtx witctx
-> BalanceTxExecUnits
-> String
-> Maybe String
-> String
-> Parser (ScriptWitnessFiles witctx)
pScriptWitnessFiles ShelleyBasedEra era
sbe WitCtx witctx
witctx BalanceTxExecUnits
autoBalanceExecUnits String
scriptFlagPrefix Maybe String
scriptFlagPrefixDeprecated String
help =
  ScriptFile
-> Maybe
     (ScriptDatumOrFile witctx, ScriptRedeemerOrFile, ExecutionUnits)
-> ScriptWitnessFiles witctx
toScriptWitnessFiles
    (ScriptFile
 -> Maybe
      (ScriptDatumOrFile witctx, ScriptRedeemerOrFile, ExecutionUnits)
 -> ScriptWitnessFiles witctx)
-> Parser ScriptFile
-> Parser
     (Maybe
        (ScriptDatumOrFile witctx, ScriptRedeemerOrFile, ExecutionUnits)
      -> ScriptWitnessFiles witctx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe String -> String -> Parser ScriptFile
pScriptFor
      (String
scriptFlagPrefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-script-file")
      ((String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-script-file") (String -> String) -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
scriptFlagPrefixDeprecated)
      (String
"The file containing the script to witness " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
help)
    Parser
  (Maybe
     (ScriptDatumOrFile witctx, ScriptRedeemerOrFile, ExecutionUnits)
   -> ScriptWitnessFiles witctx)
-> Parser
     (Maybe
        (ScriptDatumOrFile witctx, ScriptRedeemerOrFile, ExecutionUnits))
-> Parser (ScriptWitnessFiles witctx)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser
  (ScriptDatumOrFile witctx, ScriptRedeemerOrFile, ExecutionUnits)
-> Parser
     (Maybe
        (ScriptDatumOrFile witctx, ScriptRedeemerOrFile, ExecutionUnits))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
      ( (,,)
          (ScriptDatumOrFile witctx
 -> ScriptRedeemerOrFile
 -> ExecutionUnits
 -> (ScriptDatumOrFile witctx, ScriptRedeemerOrFile,
     ExecutionUnits))
-> Parser (ScriptDatumOrFile witctx)
-> Parser
     (ScriptRedeemerOrFile
      -> ExecutionUnits
      -> (ScriptDatumOrFile witctx, ScriptRedeemerOrFile,
          ExecutionUnits))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ShelleyBasedEra era -> Parser (ScriptDatumOrFile witctx)
cip69Modification ShelleyBasedEra era
sbe
          Parser
  (ScriptRedeemerOrFile
   -> ExecutionUnits
   -> (ScriptDatumOrFile witctx, ScriptRedeemerOrFile,
       ExecutionUnits))
-> Parser ScriptRedeemerOrFile
-> Parser
     (ExecutionUnits
      -> (ScriptDatumOrFile witctx, ScriptRedeemerOrFile,
          ExecutionUnits))
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Parser ScriptRedeemerOrFile
pScriptRedeemerOrFile String
scriptFlagPrefix
          Parser
  (ExecutionUnits
   -> (ScriptDatumOrFile witctx, ScriptRedeemerOrFile,
       ExecutionUnits))
-> Parser ExecutionUnits
-> Parser
     (ScriptDatumOrFile witctx, ScriptRedeemerOrFile, ExecutionUnits)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( case BalanceTxExecUnits
autoBalanceExecUnits of
                  BalanceTxExecUnits
AutoBalance -> ExecutionUnits -> Parser ExecutionUnits
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> Natural -> ExecutionUnits
ExecutionUnits Natural
0 Natural
0)
                  BalanceTxExecUnits
ManualBalance -> String -> Parser ExecutionUnits
pExecutionUnits String
scriptFlagPrefix
              )
      )
 where
  cip69Modification :: ShelleyBasedEra era -> Parser (ScriptDatumOrFile witctx)
  cip69Modification :: ShelleyBasedEra era -> Parser (ScriptDatumOrFile witctx)
cip69Modification =
    (ShelleyToBabbageEraConstraints era =>
 ShelleyToBabbageEra era -> Parser (ScriptDatumOrFile witctx))
-> (ConwayEraOnwardsConstraints era =>
    ConwayEraOnwards era -> Parser (ScriptDatumOrFile witctx))
-> ShelleyBasedEra era
-> Parser (ScriptDatumOrFile witctx)
forall era a.
(ShelleyToBabbageEraConstraints era =>
 ShelleyToBabbageEra era -> a)
-> (ConwayEraOnwardsConstraints era => ConwayEraOnwards era -> a)
-> ShelleyBasedEra era
-> a
caseShelleyToBabbageOrConwayEraOnwards
      (Parser (ScriptDatumOrFile witctx)
-> ShelleyToBabbageEra era -> Parser (ScriptDatumOrFile witctx)
forall a b. a -> b -> a
const (Parser (ScriptDatumOrFile witctx)
 -> ShelleyToBabbageEra era -> Parser (ScriptDatumOrFile witctx))
-> Parser (ScriptDatumOrFile witctx)
-> ShelleyToBabbageEra era
-> Parser (ScriptDatumOrFile witctx)
forall a b. (a -> b) -> a -> b
$ String -> WitCtx witctx -> Parser (ScriptDatumOrFile witctx)
forall witctx.
String -> WitCtx witctx -> Parser (ScriptDatumOrFile witctx)
pScriptDatumOrFile String
scriptFlagPrefix WitCtx witctx
witctx)
      (Parser (ScriptDatumOrFile witctx)
-> ConwayEraOnwards era -> Parser (ScriptDatumOrFile witctx)
forall a b. a -> b -> a
const (Parser (ScriptDatumOrFile witctx)
 -> ConwayEraOnwards era -> Parser (ScriptDatumOrFile witctx))
-> Parser (ScriptDatumOrFile witctx)
-> ConwayEraOnwards era
-> Parser (ScriptDatumOrFile witctx)
forall a b. (a -> b) -> a -> b
$ String -> WitCtx witctx -> Parser (ScriptDatumOrFile witctx)
forall witctx.
String -> WitCtx witctx -> Parser (ScriptDatumOrFile witctx)
pScriptDatumOrFileCip69 String
scriptFlagPrefix WitCtx witctx
witctx)

  toScriptWitnessFiles
    :: ScriptFile
    -> Maybe
        ( ScriptDatumOrFile witctx
        , ScriptRedeemerOrFile
        , ExecutionUnits
        )
    -> ScriptWitnessFiles witctx
  toScriptWitnessFiles :: ScriptFile
-> Maybe
     (ScriptDatumOrFile witctx, ScriptRedeemerOrFile, ExecutionUnits)
-> ScriptWitnessFiles witctx
toScriptWitnessFiles ScriptFile
sf Maybe
  (ScriptDatumOrFile witctx, ScriptRedeemerOrFile, ExecutionUnits)
Nothing = ScriptFile -> ScriptWitnessFiles witctx
forall witctx. ScriptFile -> ScriptWitnessFiles witctx
SimpleScriptWitnessFile ScriptFile
sf
  toScriptWitnessFiles ScriptFile
sf (Just (ScriptDatumOrFile witctx
d, ScriptRedeemerOrFile
r, ExecutionUnits
e)) = ScriptFile
-> ScriptDatumOrFile witctx
-> ScriptRedeemerOrFile
-> ExecutionUnits
-> ScriptWitnessFiles witctx
forall witctx.
ScriptFile
-> ScriptDatumOrFile witctx
-> ScriptRedeemerOrFile
-> ExecutionUnits
-> ScriptWitnessFiles witctx
PlutusScriptWitnessFiles ScriptFile
sf ScriptDatumOrFile witctx
d ScriptRedeemerOrFile
r ExecutionUnits
e

pExecutionUnits :: String -> Parser ExecutionUnits
pExecutionUnits :: String -> Parser ExecutionUnits
pExecutionUnits String
scriptFlagPrefix =
  ((Natural, Natural) -> ExecutionUnits)
-> Parser (Natural, Natural) -> Parser ExecutionUnits
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Natural -> Natural -> ExecutionUnits)
-> (Natural, Natural) -> ExecutionUnits
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Natural -> Natural -> ExecutionUnits
ExecutionUnits) (Parser (Natural, Natural) -> Parser ExecutionUnits)
-> Parser (Natural, Natural) -> Parser ExecutionUnits
forall a b. (a -> b) -> a -> b
$
    ReadM (Natural, Natural)
-> Mod OptionFields (Natural, Natural) -> Parser (Natural, Natural)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM (Natural, Natural)
forall a. (Typeable a, Integral a, Bits a) => ReadM (a, a)
pairIntegralReader (Mod OptionFields (Natural, Natural) -> Parser (Natural, Natural))
-> Mod OptionFields (Natural, Natural) -> Parser (Natural, Natural)
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields (Natural, Natural)]
-> Mod OptionFields (Natural, Natural)
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod OptionFields (Natural, Natural)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long (String
scriptFlagPrefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-execution-units")
        , String -> Mod OptionFields (Natural, Natural)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"(INT, INT)"
        , String -> Mod OptionFields (Natural, Natural)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The time and space units needed by the script."
        ]

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

pScriptDatumOrFileCip69 :: String -> WitCtx witctx -> Parser (ScriptDatumOrFile witctx)
pScriptDatumOrFileCip69 :: forall witctx.
String -> WitCtx witctx -> Parser (ScriptDatumOrFile witctx)
pScriptDatumOrFileCip69 String
scriptFlagPrefix WitCtx witctx
witctx =
  case WitCtx witctx
witctx of
    WitCtx witctx
WitCtxTxIn ->
      [Parser (ScriptDatumOrFile witctx)]
-> Parser (ScriptDatumOrFile witctx)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
        [ Maybe ScriptRedeemerOrFile -> ScriptDatumOrFile witctx
Maybe ScriptRedeemerOrFile -> ScriptDatumOrFile WitCtxTxIn
ScriptDatumOrFileForTxIn
            (Maybe ScriptRedeemerOrFile -> ScriptDatumOrFile witctx)
-> Parser (Maybe ScriptRedeemerOrFile)
-> Parser (ScriptDatumOrFile witctx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ScriptRedeemerOrFile -> Parser (Maybe ScriptRedeemerOrFile)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
              ( String -> String -> String -> Parser ScriptRedeemerOrFile
pScriptDataOrFile
                  (String
scriptFlagPrefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-datum")
                  String
"The script datum."
                  String
"The script datum file."
              )
        , Parser (ScriptDatumOrFile witctx)
Parser (ScriptDatumOrFile WitCtxTxIn)
pInlineDatumPresent
        ]
    WitCtx witctx
WitCtxMint -> ScriptDatumOrFile witctx -> Parser (ScriptDatumOrFile witctx)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScriptDatumOrFile witctx
ScriptDatumOrFile WitCtxMint
NoScriptDatumOrFileForMint
    WitCtx witctx
WitCtxStake -> ScriptDatumOrFile witctx -> Parser (ScriptDatumOrFile witctx)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScriptDatumOrFile witctx
ScriptDatumOrFile WitCtxStake
NoScriptDatumOrFileForStake
 where
  pInlineDatumPresent :: Parser (ScriptDatumOrFile WitCtxTxIn)
  pInlineDatumPresent :: Parser (ScriptDatumOrFile WitCtxTxIn)
pInlineDatumPresent =
    ScriptDatumOrFile WitCtxTxIn
-> Mod FlagFields (ScriptDatumOrFile WitCtxTxIn)
-> Parser (ScriptDatumOrFile WitCtxTxIn)
forall a. a -> Mod FlagFields a -> Parser a
flag' ScriptDatumOrFile WitCtxTxIn
InlineDatumPresentAtTxIn (Mod FlagFields (ScriptDatumOrFile WitCtxTxIn)
 -> Parser (ScriptDatumOrFile WitCtxTxIn))
-> Mod FlagFields (ScriptDatumOrFile WitCtxTxIn)
-> Parser (ScriptDatumOrFile WitCtxTxIn)
forall a b. (a -> b) -> a -> b
$
      [Mod FlagFields (ScriptDatumOrFile WitCtxTxIn)]
-> Mod FlagFields (ScriptDatumOrFile WitCtxTxIn)
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod FlagFields (ScriptDatumOrFile WitCtxTxIn)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String
scriptFlagPrefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-inline-datum-present")
        , String -> Mod FlagFields (ScriptDatumOrFile WitCtxTxIn)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Inline datum present at transaction input."
        ]

pScriptDatumOrFile :: String -> WitCtx witctx -> Parser (ScriptDatumOrFile witctx)
pScriptDatumOrFile :: forall witctx.
String -> WitCtx witctx -> Parser (ScriptDatumOrFile witctx)
pScriptDatumOrFile String
scriptFlagPrefix WitCtx witctx
witctx =
  case WitCtx witctx
witctx of
    WitCtx witctx
WitCtxTxIn ->
      [Parser (ScriptDatumOrFile witctx)]
-> Parser (ScriptDatumOrFile witctx)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
        [ Maybe ScriptRedeemerOrFile -> ScriptDatumOrFile witctx
Maybe ScriptRedeemerOrFile -> ScriptDatumOrFile WitCtxTxIn
ScriptDatumOrFileForTxIn (Maybe ScriptRedeemerOrFile -> ScriptDatumOrFile witctx)
-> (ScriptRedeemerOrFile -> Maybe ScriptRedeemerOrFile)
-> ScriptRedeemerOrFile
-> ScriptDatumOrFile witctx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptRedeemerOrFile -> Maybe ScriptRedeemerOrFile
forall a. a -> Maybe a
Just
            (ScriptRedeemerOrFile -> ScriptDatumOrFile witctx)
-> Parser ScriptRedeemerOrFile -> Parser (ScriptDatumOrFile witctx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> String -> Parser ScriptRedeemerOrFile
pScriptDataOrFile
              (String
scriptFlagPrefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-datum")
              String
"The script datum."
              String
"The script datum file."
        , Parser (ScriptDatumOrFile witctx)
Parser (ScriptDatumOrFile WitCtxTxIn)
pInlineDatumPresent
        ]
    WitCtx witctx
WitCtxMint -> ScriptDatumOrFile witctx -> Parser (ScriptDatumOrFile witctx)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScriptDatumOrFile witctx
ScriptDatumOrFile WitCtxMint
NoScriptDatumOrFileForMint
    WitCtx witctx
WitCtxStake -> ScriptDatumOrFile witctx -> Parser (ScriptDatumOrFile witctx)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScriptDatumOrFile witctx
ScriptDatumOrFile WitCtxStake
NoScriptDatumOrFileForStake
 where
  pInlineDatumPresent :: Parser (ScriptDatumOrFile WitCtxTxIn)
  pInlineDatumPresent :: Parser (ScriptDatumOrFile WitCtxTxIn)
pInlineDatumPresent =
    ScriptDatumOrFile WitCtxTxIn
-> Mod FlagFields (ScriptDatumOrFile WitCtxTxIn)
-> Parser (ScriptDatumOrFile WitCtxTxIn)
forall a. a -> Mod FlagFields a -> Parser a
flag' ScriptDatumOrFile WitCtxTxIn
InlineDatumPresentAtTxIn (Mod FlagFields (ScriptDatumOrFile WitCtxTxIn)
 -> Parser (ScriptDatumOrFile WitCtxTxIn))
-> Mod FlagFields (ScriptDatumOrFile WitCtxTxIn)
-> Parser (ScriptDatumOrFile WitCtxTxIn)
forall a b. (a -> b) -> a -> b
$
      [Mod FlagFields (ScriptDatumOrFile WitCtxTxIn)]
-> Mod FlagFields (ScriptDatumOrFile WitCtxTxIn)
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod FlagFields (ScriptDatumOrFile WitCtxTxIn)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String
scriptFlagPrefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-inline-datum-present")
        , String -> Mod FlagFields (ScriptDatumOrFile WitCtxTxIn)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Inline datum present at transaction input."
        ]

pScriptDataOrFile
  :: String
  -- ^ data flag prefix
  -> String
  -- ^ value help text
  -> String
  -- ^ file help text
  -> Parser ScriptDataOrFile
pScriptDataOrFile :: String -> String -> String -> Parser ScriptRedeemerOrFile
pScriptDataOrFile String
dataFlagPrefix String
helpTextForValue String
helpTextForFile =
  [Parser ScriptRedeemerOrFile] -> Parser ScriptRedeemerOrFile
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ Parser ScriptRedeemerOrFile
pScriptDataCborFile
    , Parser ScriptRedeemerOrFile
pScriptDataFile
    , Parser ScriptRedeemerOrFile
pScriptDataValue
    ]
 where
  pScriptDataCborFile :: Parser ScriptRedeemerOrFile
pScriptDataCborFile =
    (String -> ScriptRedeemerOrFile)
-> Parser String -> Parser ScriptRedeemerOrFile
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> ScriptRedeemerOrFile
ScriptDataCborFile (Parser String -> Parser ScriptRedeemerOrFile)
-> (Mod OptionFields String -> Parser String)
-> Mod OptionFields String
-> Parser ScriptRedeemerOrFile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption (Mod OptionFields String -> Parser ScriptRedeemerOrFile)
-> Mod OptionFields String -> Parser ScriptRedeemerOrFile
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
dataFlagPrefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-cbor-file")
        , String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"CBOR_FILE"
        , String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod OptionFields String)
-> String -> Mod OptionFields String
forall a b. (a -> b) -> a -> b
$
            [String] -> String
forall a. Monoid a => [a] -> a
mconcat
              [ String
helpTextForFile
              , String
" The file has to be in CBOR format."
              ]
        ]

  pScriptDataFile :: Parser ScriptRedeemerOrFile
pScriptDataFile =
    (String -> ScriptRedeemerOrFile)
-> Parser String -> Parser ScriptRedeemerOrFile
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> ScriptRedeemerOrFile
ScriptDataJsonFile (Parser String -> Parser ScriptRedeemerOrFile)
-> (Mod OptionFields String -> Parser String)
-> Mod OptionFields String
-> Parser ScriptRedeemerOrFile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption (Mod OptionFields String -> Parser ScriptRedeemerOrFile)
-> Mod OptionFields String -> Parser ScriptRedeemerOrFile
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
dataFlagPrefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-file")
        , String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"JSON_FILE"
        , String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod OptionFields String)
-> String -> Mod OptionFields String
forall a b. (a -> b) -> a -> b
$
            [String] -> String
forall a. Monoid a => [a] -> a
mconcat
              [ String
helpTextForFile
              , String
" The file must follow the detailed JSON schema for script data."
              ]
        ]

  pScriptDataValue :: Parser ScriptRedeemerOrFile
pScriptDataValue =
    (HashableScriptData -> ScriptRedeemerOrFile)
-> Parser HashableScriptData -> Parser ScriptRedeemerOrFile
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HashableScriptData -> ScriptRedeemerOrFile
ScriptDataValue (Parser HashableScriptData -> Parser ScriptRedeemerOrFile)
-> (Mod OptionFields HashableScriptData
    -> Parser HashableScriptData)
-> Mod OptionFields HashableScriptData
-> Parser ScriptRedeemerOrFile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadM HashableScriptData
-> Mod OptionFields HashableScriptData -> Parser HashableScriptData
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM HashableScriptData
readerScriptData (Mod OptionFields HashableScriptData
 -> Parser ScriptRedeemerOrFile)
-> Mod OptionFields HashableScriptData
-> Parser ScriptRedeemerOrFile
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields HashableScriptData]
-> Mod OptionFields HashableScriptData
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod OptionFields HashableScriptData
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long (String
dataFlagPrefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-value")
        , String -> Mod OptionFields HashableScriptData
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"JSON_VALUE"
        , String -> Mod OptionFields HashableScriptData
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod OptionFields HashableScriptData)
-> String -> Mod OptionFields HashableScriptData
forall a b. (a -> b) -> a -> b
$
            [String] -> String
forall a. Monoid a => [a] -> a
mconcat
              [ String
helpTextForValue
              , String
" There is no schema: (almost) any JSON value is supported, including "
              , String
"top-level strings and numbers."
              ]
        ]

  readerScriptData :: ReadM HashableScriptData
  readerScriptData :: ReadM HashableScriptData
readerScriptData = do
    ByteString
v <- ReadM ByteString
forall s. IsString s => ReadM s
Opt.str
    Value
sDataValue <-
      (String -> String) -> Either String Value -> ReadM Value
forall {m :: * -> *} {a} {a}.
MonadFail m =>
(a -> String) -> Either a a -> m a
liftWith (String
"readerScriptData: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) (Either String Value -> ReadM Value)
-> Either String Value -> ReadM Value
forall a b. (a -> b) -> a -> b
$
        ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode ByteString
v
    (ScriptDataJsonBytesError -> String)
-> Either ScriptDataJsonBytesError HashableScriptData
-> ReadM HashableScriptData
forall {m :: * -> *} {a} {a}.
MonadFail m =>
(a -> String) -> Either a a -> m a
liftWith (Doc AnsiStyle -> String
docToString (Doc AnsiStyle -> String)
-> (ScriptDataJsonBytesError -> Doc AnsiStyle)
-> ScriptDataJsonBytesError
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptDataJsonBytesError -> Doc AnsiStyle
forall e ann. Error e => e -> Doc ann
forall ann. ScriptDataJsonBytesError -> Doc ann
prettyError) (Either ScriptDataJsonBytesError HashableScriptData
 -> ReadM HashableScriptData)
-> Either ScriptDataJsonBytesError HashableScriptData
-> ReadM HashableScriptData
forall a b. (a -> b) -> a -> b
$
      ScriptDataJsonSchema
-> Value -> Either ScriptDataJsonBytesError HashableScriptData
scriptDataJsonToHashable ScriptDataJsonSchema
ScriptDataJsonNoSchema Value
sDataValue
   where
    liftWith :: (a -> String) -> Either a a -> m a
liftWith a -> String
f = (a -> m a) -> (a -> m a) -> Either a a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> (a -> String) -> a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
f) a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

pVoteFiles
  :: ShelleyBasedEra era
  -> BalanceTxExecUnits
  -> Parser [(VoteFile In, Maybe (ScriptWitnessFiles WitCtxStake))]
pVoteFiles :: forall era.
ShelleyBasedEra era
-> BalanceTxExecUnits
-> Parser [(VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))]
pVoteFiles ShelleyBasedEra era
sbe BalanceTxExecUnits
bExUnits =
  (ShelleyToBabbageEraConstraints era =>
 ShelleyToBabbageEra era
 -> Parser [(VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))])
-> (ConwayEraOnwardsConstraints era =>
    ConwayEraOnwards era
    -> Parser [(VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))])
-> ShelleyBasedEra era
-> Parser [(VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))]
forall era a.
(ShelleyToBabbageEraConstraints era =>
 ShelleyToBabbageEra era -> a)
-> (ConwayEraOnwardsConstraints era => ConwayEraOnwards era -> a)
-> ShelleyBasedEra era
-> a
caseShelleyToBabbageOrConwayEraOnwards
    (Parser [(VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))]
-> ShelleyToBabbageEra era
-> Parser [(VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))]
forall a b. a -> b -> a
const (Parser [(VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))]
 -> ShelleyToBabbageEra era
 -> Parser [(VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))])
-> Parser [(VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))]
-> ShelleyToBabbageEra era
-> Parser [(VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))]
forall a b. (a -> b) -> a -> b
$ [(VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))]
-> Parser [(VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))]
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
    (Parser [(VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))]
-> ConwayEraOnwards era
-> Parser [(VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))]
forall a b. a -> b -> a
const (Parser [(VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))]
 -> ConwayEraOnwards era
 -> Parser [(VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))])
-> (Parser (VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))
    -> Parser [(VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))])
-> Parser (VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))
-> ConwayEraOnwards era
-> Parser [(VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))
-> Parser [(VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser (VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))
 -> ConwayEraOnwards era
 -> Parser [(VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))])
-> Parser (VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))
-> ConwayEraOnwards era
-> Parser [(VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))]
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> BalanceTxExecUnits
-> Parser (VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))
forall era.
ShelleyBasedEra era
-> BalanceTxExecUnits
-> Parser (VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))
pVoteFile ShelleyBasedEra era
sbe BalanceTxExecUnits
bExUnits)
    ShelleyBasedEra era
sbe

pVoteFile
  :: ShelleyBasedEra era
  -> BalanceTxExecUnits
  -> Parser (VoteFile In, Maybe (ScriptWitnessFiles WitCtxStake))
pVoteFile :: forall era.
ShelleyBasedEra era
-> BalanceTxExecUnits
-> Parser (VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))
pVoteFile ShelleyBasedEra era
sbe BalanceTxExecUnits
balExUnits =
  (,)
    (VoteFile 'In
 -> Maybe (ScriptWitnessFiles WitCtxStake)
 -> (VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake)))
-> Parser (VoteFile 'In)
-> Parser
     (Maybe (ScriptWitnessFiles WitCtxStake)
      -> (VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser (VoteFile 'In)
forall a. String -> String -> Parser (File a 'In)
pFileInDirection String
"vote-file" String
"Filepath of the vote."
    Parser
  (Maybe (ScriptWitnessFiles WitCtxStake)
   -> (VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake)))
-> Parser (Maybe (ScriptWitnessFiles WitCtxStake))
-> Parser (VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (ScriptWitnessFiles WitCtxStake)
-> Parser (Maybe (ScriptWitnessFiles WitCtxStake))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxStake)
pVoteScriptOrReferenceScriptWitness BalanceTxExecUnits
balExUnits)
 where
  pVoteScriptOrReferenceScriptWitness
    :: BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxStake)
  pVoteScriptOrReferenceScriptWitness :: BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxStake)
pVoteScriptOrReferenceScriptWitness BalanceTxExecUnits
bExUnits =
    ShelleyBasedEra era
-> WitCtx WitCtxStake
-> BalanceTxExecUnits
-> String
-> Maybe String
-> String
-> Parser (ScriptWitnessFiles WitCtxStake)
forall witctx era.
ShelleyBasedEra era
-> WitCtx witctx
-> BalanceTxExecUnits
-> String
-> Maybe String
-> String
-> Parser (ScriptWitnessFiles witctx)
pScriptWitnessFiles
      ShelleyBasedEra era
sbe
      WitCtx WitCtxStake
WitCtxStake
      BalanceTxExecUnits
bExUnits
      String
"vote"
      Maybe String
forall a. Maybe a
Nothing
      String
"a vote"
      Parser (ScriptWitnessFiles WitCtxStake)
-> Parser (ScriptWitnessFiles WitCtxStake)
-> Parser (ScriptWitnessFiles WitCtxStake)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String
-> BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxStake)
pPlutusStakeReferenceScriptWitnessFilesVotingProposing String
"vote-" BalanceTxExecUnits
balExUnits

pProposalFiles
  :: ShelleyBasedEra era
  -> BalanceTxExecUnits
  -> Parser [(ProposalFile In, Maybe (ScriptWitnessFiles WitCtxStake))]
pProposalFiles :: forall era.
ShelleyBasedEra era
-> BalanceTxExecUnits
-> Parser [(File () 'In, Maybe (ScriptWitnessFiles WitCtxStake))]
pProposalFiles ShelleyBasedEra era
sbe BalanceTxExecUnits
balExUnits =
  (ShelleyToBabbageEraConstraints era =>
 ShelleyToBabbageEra era
 -> Parser [(File () 'In, Maybe (ScriptWitnessFiles WitCtxStake))])
-> (ConwayEraOnwardsConstraints era =>
    ConwayEraOnwards era
    -> Parser [(File () 'In, Maybe (ScriptWitnessFiles WitCtxStake))])
-> ShelleyBasedEra era
-> Parser [(File () 'In, Maybe (ScriptWitnessFiles WitCtxStake))]
forall era a.
(ShelleyToBabbageEraConstraints era =>
 ShelleyToBabbageEra era -> a)
-> (ConwayEraOnwardsConstraints era => ConwayEraOnwards era -> a)
-> ShelleyBasedEra era
-> a
caseShelleyToBabbageOrConwayEraOnwards
    (Parser [(File () 'In, Maybe (ScriptWitnessFiles WitCtxStake))]
-> ShelleyToBabbageEra era
-> Parser [(File () 'In, Maybe (ScriptWitnessFiles WitCtxStake))]
forall a b. a -> b -> a
const (Parser [(File () 'In, Maybe (ScriptWitnessFiles WitCtxStake))]
 -> ShelleyToBabbageEra era
 -> Parser [(File () 'In, Maybe (ScriptWitnessFiles WitCtxStake))])
-> Parser [(File () 'In, Maybe (ScriptWitnessFiles WitCtxStake))]
-> ShelleyToBabbageEra era
-> Parser [(File () 'In, Maybe (ScriptWitnessFiles WitCtxStake))]
forall a b. (a -> b) -> a -> b
$ [(File () 'In, Maybe (ScriptWitnessFiles WitCtxStake))]
-> Parser [(File () 'In, Maybe (ScriptWitnessFiles WitCtxStake))]
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
    (Parser [(File () 'In, Maybe (ScriptWitnessFiles WitCtxStake))]
-> ConwayEraOnwards era
-> Parser [(File () 'In, Maybe (ScriptWitnessFiles WitCtxStake))]
forall a b. a -> b -> a
const (Parser [(File () 'In, Maybe (ScriptWitnessFiles WitCtxStake))]
 -> ConwayEraOnwards era
 -> Parser [(File () 'In, Maybe (ScriptWitnessFiles WitCtxStake))])
-> Parser [(File () 'In, Maybe (ScriptWitnessFiles WitCtxStake))]
-> ConwayEraOnwards era
-> Parser [(File () 'In, Maybe (ScriptWitnessFiles WitCtxStake))]
forall a b. (a -> b) -> a -> b
$ Parser (File () 'In, Maybe (ScriptWitnessFiles WitCtxStake))
-> Parser [(File () 'In, Maybe (ScriptWitnessFiles WitCtxStake))]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ShelleyBasedEra era
-> BalanceTxExecUnits
-> Parser (File () 'In, Maybe (ScriptWitnessFiles WitCtxStake))
forall era.
ShelleyBasedEra era
-> BalanceTxExecUnits
-> Parser (File () 'In, Maybe (ScriptWitnessFiles WitCtxStake))
pProposalFile ShelleyBasedEra era
sbe BalanceTxExecUnits
balExUnits))
    ShelleyBasedEra era
sbe

pProposalFile
  :: ShelleyBasedEra era
  -> BalanceTxExecUnits
  -> Parser (ProposalFile In, Maybe (ScriptWitnessFiles WitCtxStake))
pProposalFile :: forall era.
ShelleyBasedEra era
-> BalanceTxExecUnits
-> Parser (File () 'In, Maybe (ScriptWitnessFiles WitCtxStake))
pProposalFile ShelleyBasedEra era
sbe BalanceTxExecUnits
balExUnits =
  (,)
    (File () 'In
 -> Maybe (ScriptWitnessFiles WitCtxStake)
 -> (File () 'In, Maybe (ScriptWitnessFiles WitCtxStake)))
-> Parser (File () 'In)
-> Parser
     (Maybe (ScriptWitnessFiles WitCtxStake)
      -> (File () 'In, Maybe (ScriptWitnessFiles WitCtxStake)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser (File () 'In)
forall a. String -> String -> Parser (File a 'In)
pFileInDirection String
"proposal-file" String
"Filepath of the proposal."
    Parser
  (Maybe (ScriptWitnessFiles WitCtxStake)
   -> (File () 'In, Maybe (ScriptWitnessFiles WitCtxStake)))
-> Parser (Maybe (ScriptWitnessFiles WitCtxStake))
-> Parser (File () 'In, Maybe (ScriptWitnessFiles WitCtxStake))
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (ScriptWitnessFiles WitCtxStake)
-> Parser (Maybe (ScriptWitnessFiles WitCtxStake))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxStake)
pProposingScriptOrReferenceScriptWitness BalanceTxExecUnits
balExUnits)
 where
  pProposingScriptOrReferenceScriptWitness
    :: BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxStake)
  pProposingScriptOrReferenceScriptWitness :: BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxStake)
pProposingScriptOrReferenceScriptWitness BalanceTxExecUnits
bExUnits =
    ShelleyBasedEra era
-> WitCtx WitCtxStake
-> BalanceTxExecUnits
-> String
-> Maybe String
-> String
-> Parser (ScriptWitnessFiles WitCtxStake)
forall witctx era.
ShelleyBasedEra era
-> WitCtx witctx
-> BalanceTxExecUnits
-> String
-> Maybe String
-> String
-> Parser (ScriptWitnessFiles witctx)
pScriptWitnessFiles
      ShelleyBasedEra era
sbe
      WitCtx WitCtxStake
WitCtxStake
      BalanceTxExecUnits
bExUnits
      String
"proposal"
      Maybe String
forall a. Maybe a
Nothing
      String
"a proposal"
      Parser (ScriptWitnessFiles WitCtxStake)
-> Parser (ScriptWitnessFiles WitCtxStake)
-> Parser (ScriptWitnessFiles WitCtxStake)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String
-> BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxStake)
pPlutusStakeReferenceScriptWitnessFilesVotingProposing String
"proposal-" BalanceTxExecUnits
balExUnits

pCurrentTreasuryValueAndDonation
  :: ShelleyBasedEra era -> Parser (Maybe (TxCurrentTreasuryValue, TxTreasuryDonation))
pCurrentTreasuryValueAndDonation :: forall era.
ShelleyBasedEra era
-> Parser (Maybe (TxCurrentTreasuryValue, TxTreasuryDonation))
pCurrentTreasuryValueAndDonation =
  (ShelleyToBabbageEraConstraints era =>
 ShelleyToBabbageEra era
 -> Parser (Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)))
-> (ConwayEraOnwardsConstraints era =>
    ConwayEraOnwards era
    -> Parser (Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)))
-> ShelleyBasedEra era
-> Parser (Maybe (TxCurrentTreasuryValue, TxTreasuryDonation))
forall era a.
(ShelleyToBabbageEraConstraints era =>
 ShelleyToBabbageEra era -> a)
-> (ConwayEraOnwardsConstraints era => ConwayEraOnwards era -> a)
-> ShelleyBasedEra era
-> a
caseShelleyToBabbageOrConwayEraOnwards
    (Parser (Maybe (TxCurrentTreasuryValue, TxTreasuryDonation))
-> ShelleyToBabbageEra era
-> Parser (Maybe (TxCurrentTreasuryValue, TxTreasuryDonation))
forall a b. a -> b -> a
const (Parser (Maybe (TxCurrentTreasuryValue, TxTreasuryDonation))
 -> ShelleyToBabbageEra era
 -> Parser (Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)))
-> Parser (Maybe (TxCurrentTreasuryValue, TxTreasuryDonation))
-> ShelleyToBabbageEra era
-> Parser (Maybe (TxCurrentTreasuryValue, TxTreasuryDonation))
forall a b. (a -> b) -> a -> b
$ Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
-> Parser (Maybe (TxCurrentTreasuryValue, TxTreasuryDonation))
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
forall a. Maybe a
Nothing)
    ( Parser (Maybe (TxCurrentTreasuryValue, TxTreasuryDonation))
-> ConwayEraOnwards era
-> Parser (Maybe (TxCurrentTreasuryValue, TxTreasuryDonation))
forall a b. a -> b -> a
const (Parser (Maybe (TxCurrentTreasuryValue, TxTreasuryDonation))
 -> ConwayEraOnwards era
 -> Parser (Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)))
-> Parser (Maybe (TxCurrentTreasuryValue, TxTreasuryDonation))
-> ConwayEraOnwards era
-> Parser (Maybe (TxCurrentTreasuryValue, TxTreasuryDonation))
forall a b. (a -> b) -> a -> b
$
        Parser (TxCurrentTreasuryValue, TxTreasuryDonation)
-> Parser (Maybe (TxCurrentTreasuryValue, TxTreasuryDonation))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ((,) (TxCurrentTreasuryValue
 -> TxTreasuryDonation
 -> (TxCurrentTreasuryValue, TxTreasuryDonation))
-> Parser TxCurrentTreasuryValue
-> Parser
     (TxTreasuryDonation
      -> (TxCurrentTreasuryValue, TxTreasuryDonation))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TxCurrentTreasuryValue
pCurrentTreasuryValue' Parser
  (TxTreasuryDonation
   -> (TxCurrentTreasuryValue, TxTreasuryDonation))
-> Parser TxTreasuryDonation
-> Parser (TxCurrentTreasuryValue, TxTreasuryDonation)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TxTreasuryDonation
pTreasuryDonation')
    )

pCurrentTreasuryValue' :: Parser TxCurrentTreasuryValue
pCurrentTreasuryValue' :: Parser TxCurrentTreasuryValue
pCurrentTreasuryValue' =
  Lovelace -> TxCurrentTreasuryValue
TxCurrentTreasuryValue
    (Lovelace -> TxCurrentTreasuryValue)
-> Parser Lovelace -> Parser TxCurrentTreasuryValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( ReadM Lovelace -> Mod OptionFields Lovelace -> Parser Lovelace
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser Lovelace -> ReadM Lovelace
forall a. Parser a -> ReadM a
readerFromParsecParser Parser Lovelace
parseLovelace) (Mod OptionFields Lovelace -> Parser Lovelace)
-> Mod OptionFields Lovelace -> Parser Lovelace
forall a b. (a -> b) -> a -> b
$
            [Mod OptionFields Lovelace] -> Mod OptionFields Lovelace
forall a. Monoid a => [a] -> a
mconcat
              [ String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"current-treasury-value"
              , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"LOVELACE"
              , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The current treasury value."
              ]
        )

pTreasuryDonation :: ShelleyBasedEra era -> Parser (Maybe TxTreasuryDonation)
pTreasuryDonation :: forall era.
ShelleyBasedEra era -> Parser (Maybe TxTreasuryDonation)
pTreasuryDonation =
  (ShelleyToBabbageEraConstraints era =>
 ShelleyToBabbageEra era -> Parser (Maybe TxTreasuryDonation))
-> (ConwayEraOnwardsConstraints era =>
    ConwayEraOnwards era -> Parser (Maybe TxTreasuryDonation))
-> ShelleyBasedEra era
-> Parser (Maybe TxTreasuryDonation)
forall era a.
(ShelleyToBabbageEraConstraints era =>
 ShelleyToBabbageEra era -> a)
-> (ConwayEraOnwardsConstraints era => ConwayEraOnwards era -> a)
-> ShelleyBasedEra era
-> a
caseShelleyToBabbageOrConwayEraOnwards
    (Parser (Maybe TxTreasuryDonation)
-> ShelleyToBabbageEra era -> Parser (Maybe TxTreasuryDonation)
forall a b. a -> b -> a
const (Parser (Maybe TxTreasuryDonation)
 -> ShelleyToBabbageEra era -> Parser (Maybe TxTreasuryDonation))
-> Parser (Maybe TxTreasuryDonation)
-> ShelleyToBabbageEra era
-> Parser (Maybe TxTreasuryDonation)
forall a b. (a -> b) -> a -> b
$ Maybe TxTreasuryDonation -> Parser (Maybe TxTreasuryDonation)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe TxTreasuryDonation
forall a. Maybe a
Nothing)
    (Parser (Maybe TxTreasuryDonation)
-> ConwayEraOnwards era -> Parser (Maybe TxTreasuryDonation)
forall a b. a -> b -> a
const (Parser (Maybe TxTreasuryDonation)
 -> ConwayEraOnwards era -> Parser (Maybe TxTreasuryDonation))
-> Parser (Maybe TxTreasuryDonation)
-> ConwayEraOnwards era
-> Parser (Maybe TxTreasuryDonation)
forall a b. (a -> b) -> a -> b
$ Parser TxTreasuryDonation -> Parser (Maybe TxTreasuryDonation)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser TxTreasuryDonation
pTreasuryDonation')

pTreasuryDonation' :: Parser TxTreasuryDonation
pTreasuryDonation' :: Parser TxTreasuryDonation
pTreasuryDonation' =
  Lovelace -> TxTreasuryDonation
TxTreasuryDonation
    (Lovelace -> TxTreasuryDonation)
-> Parser Lovelace -> Parser TxTreasuryDonation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( ReadM Lovelace -> Mod OptionFields Lovelace -> Parser Lovelace
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser Lovelace -> ReadM Lovelace
forall a. Parser a -> ReadM a
readerFromParsecParser Parser Lovelace
parseLovelace) (Mod OptionFields Lovelace -> Parser Lovelace)
-> Mod OptionFields Lovelace -> Parser Lovelace
forall a b. (a -> b) -> a -> b
$
            [Mod OptionFields Lovelace] -> Mod OptionFields Lovelace
forall a. Monoid a => [a] -> a
mconcat
              [ String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"treasury-donation"
              , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"LOVELACE"
              , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The donation to the treasury to perform."
              ]
        )

--------------------------------------------------------------------------------

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

pPaymentVerificationKeyTextOrFile :: Parser VerificationKeyTextOrFile
pPaymentVerificationKeyTextOrFile :: Parser VerificationKeyTextOrFile
pPaymentVerificationKeyTextOrFile =
  [Parser VerificationKeyTextOrFile]
-> Parser VerificationKeyTextOrFile
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ Text -> VerificationKeyTextOrFile
VktofVerificationKeyText (Text -> VerificationKeyTextOrFile)
-> Parser Text -> Parser VerificationKeyTextOrFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
pPaymentVerificationKeyText
    , VerificationKeyFile 'In -> VerificationKeyTextOrFile
VktofVerificationKeyFile (VerificationKeyFile 'In -> VerificationKeyTextOrFile)
-> Parser (VerificationKeyFile 'In)
-> Parser VerificationKeyTextOrFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyFile 'In)
pPaymentVerificationKeyFile
    ]

pPaymentVerificationKeyText :: Parser Text
pPaymentVerificationKeyText :: Parser Text
pPaymentVerificationKeyText =
  (String -> Text) -> Parser String -> Parser Text
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
Text.pack (Parser String -> Parser Text) -> Parser String -> Parser Text
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
"payment-verification-key"
        , String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
        , String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Payment verification key (Bech32-encoded)"
        ]

pPaymentVerificationKeyFile :: Parser (VerificationKeyFile In)
pPaymentVerificationKeyFile :: Parser (VerificationKeyFile 'In)
pPaymentVerificationKeyFile =
  (String -> VerificationKeyFile 'In)
-> Parser String -> Parser (VerificationKeyFile 'In)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> VerificationKeyFile 'In
forall content (direction :: FileDirection).
String -> File content direction
File (Parser String -> Parser (VerificationKeyFile 'In))
-> Parser String -> Parser (VerificationKeyFile 'In)
forall a b. (a -> b) -> a -> b
$
    [Parser String] -> Parser String
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
      [ String -> String -> Parser String
parseFilePath String
"payment-verification-key-file" String
"Filepath of the payment verification key."
      , 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
"verification-key-file"
            , Mod OptionFields String
forall (f :: * -> *) a. Mod f a
Opt.internal
            ]
      ]

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

pReferenceTxIn :: String -> String -> Parser TxIn
pReferenceTxIn :: String -> String -> Parser TxIn
pReferenceTxIn String
prefix String
scriptType =
  ReadM TxIn -> Mod OptionFields TxIn -> Parser TxIn
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser TxIn -> ReadM TxIn
forall a. Parser a -> ReadM a
readerFromParsecParser Parser TxIn
parseTxIn) (Mod OptionFields TxIn -> Parser TxIn)
-> Mod OptionFields TxIn -> Parser TxIn
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields TxIn] -> Mod OptionFields TxIn
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields TxIn
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long (String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"tx-in-reference")
      , String -> Mod OptionFields TxIn
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"TX-IN"
      , String -> Mod OptionFields TxIn
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod OptionFields TxIn)
-> String -> Mod OptionFields TxIn
forall a b. (a -> b) -> a -> b
$
          [String] -> String
forall a. Monoid a => [a] -> a
mconcat
            [ String
"TxId#TxIx - Specify a reference input. The reference input must have"
            , String
" a " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
scriptType String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" reference script attached."
            ]
      ]

pReadOnlyReferenceTxIn :: Parser TxIn
pReadOnlyReferenceTxIn :: Parser TxIn
pReadOnlyReferenceTxIn =
  ReadM TxIn -> Mod OptionFields TxIn -> Parser TxIn
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser TxIn -> ReadM TxIn
forall a. Parser a -> ReadM a
readerFromParsecParser Parser TxIn
parseTxIn) (Mod OptionFields TxIn -> Parser TxIn)
-> Mod OptionFields TxIn -> Parser TxIn
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields TxIn] -> Mod OptionFields TxIn
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields TxIn
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"read-only-tx-in-reference"
      , String -> Mod OptionFields TxIn
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"TX-IN"
      , String -> Mod OptionFields TxIn
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod OptionFields TxIn)
-> String -> Mod OptionFields TxIn
forall a b. (a -> b) -> a -> b
$
          [String] -> String
forall a. Monoid a => [a] -> a
mconcat
            [ String
"Specify a read only reference input. This reference input is not witnessing anything "
            , String
"it is simply provided in the plutus script context."
            ]
      ]

--------------------------------------------------------------------------------

pAddressKeyType :: Parser AddressKeyType
pAddressKeyType :: Parser AddressKeyType
pAddressKeyType =
  [Parser AddressKeyType] -> Parser AddressKeyType
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ AddressKeyType
-> Mod FlagFields AddressKeyType -> Parser AddressKeyType
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' AddressKeyType
AddressKeyShelley (Mod FlagFields AddressKeyType -> Parser AddressKeyType)
-> Mod FlagFields AddressKeyType -> Parser AddressKeyType
forall a b. (a -> b) -> a -> b
$
        [Mod FlagFields AddressKeyType] -> Mod FlagFields AddressKeyType
forall a. Monoid a => [a] -> a
mconcat
          [ String -> Mod FlagFields AddressKeyType
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"normal-key"
          , String -> Mod FlagFields AddressKeyType
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use a normal Shelley-era key (default)."
          ]
    , AddressKeyType
-> Mod FlagFields AddressKeyType -> Parser AddressKeyType
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' AddressKeyType
AddressKeyShelleyExtended (Mod FlagFields AddressKeyType -> Parser AddressKeyType)
-> Mod FlagFields AddressKeyType -> Parser AddressKeyType
forall a b. (a -> b) -> a -> b
$
        [Mod FlagFields AddressKeyType] -> Mod FlagFields AddressKeyType
forall a. Monoid a => [a] -> a
mconcat
          [ String -> Mod FlagFields AddressKeyType
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"extended-key"
          , String -> Mod FlagFields AddressKeyType
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use an extended ed25519 Shelley-era key."
          ]
    , AddressKeyType
-> Mod FlagFields AddressKeyType -> Parser AddressKeyType
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' AddressKeyType
AddressKeyByron (Mod FlagFields AddressKeyType -> Parser AddressKeyType)
-> Mod FlagFields AddressKeyType -> Parser AddressKeyType
forall a b. (a -> b) -> a -> b
$
        [Mod FlagFields AddressKeyType] -> Mod FlagFields AddressKeyType
forall a. Monoid a => [a] -> a
mconcat
          [ String -> Mod FlagFields AddressKeyType
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"byron-key"
          , String -> Mod FlagFields AddressKeyType
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Use a Byron-era key."
          ]
    , AddressKeyType -> Parser AddressKeyType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AddressKeyType
AddressKeyShelley
    ]

pProtocolParamsFile :: Parser ProtocolParamsFile
pProtocolParamsFile :: Parser ProtocolParamsFile
pProtocolParamsFile =
  String -> ProtocolParamsFile
ProtocolParamsFile
    (String -> ProtocolParamsFile)
-> Parser String -> Parser ProtocolParamsFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser String
parseFilePath String
"protocol-params-file" String
"Filepath of the JSON-encoded protocol parameters file"

pTxBuildOutputOptions :: Parser TxBuildOutputOptions
pTxBuildOutputOptions :: Parser TxBuildOutputOptions
pTxBuildOutputOptions =
  (TxBodyFile 'Out -> TxBuildOutputOptions
OutputTxBodyOnly (TxBodyFile 'Out -> TxBuildOutputOptions)
-> Parser (TxBodyFile 'Out) -> Parser TxBuildOutputOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (TxBodyFile 'Out)
pTxBodyFileOut) Parser TxBuildOutputOptions
-> Parser TxBuildOutputOptions -> Parser TxBuildOutputOptions
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TxBuildOutputOptions
pCalculatePlutusScriptCost
 where
  pCalculatePlutusScriptCost :: Parser TxBuildOutputOptions
  pCalculatePlutusScriptCost :: Parser TxBuildOutputOptions
pCalculatePlutusScriptCost =
    File () 'Out -> TxBuildOutputOptions
OutputScriptCostOnly (File () 'Out -> TxBuildOutputOptions)
-> (String -> File () 'Out) -> String -> TxBuildOutputOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> File () 'Out
forall content (direction :: FileDirection).
String -> File content direction
File
      (String -> TxBuildOutputOptions)
-> Parser String -> Parser TxBuildOutputOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser String
parseFilePath
        String
"calculate-plutus-script-cost"
        String
"Where to write the script cost information."

pCertificateFile
  :: ShelleyBasedEra era
  -> BalanceTxExecUnits
  -> Parser (CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))
pCertificateFile :: forall era.
ShelleyBasedEra era
-> BalanceTxExecUnits
-> Parser (CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))
pCertificateFile ShelleyBasedEra era
sbe BalanceTxExecUnits
balanceExecUnits =
  (,)
    (CertificateFile
 -> Maybe (ScriptWitnessFiles WitCtxStake)
 -> (CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake)))
-> Parser CertificateFile
-> Parser
     (Maybe (ScriptWitnessFiles WitCtxStake)
      -> (CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( (String -> CertificateFile)
-> Parser String -> Parser CertificateFile
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> CertificateFile
CertificateFile (Parser String -> Parser CertificateFile)
-> Parser String -> Parser CertificateFile
forall a b. (a -> b) -> a -> b
$
            [Parser String] -> Parser String
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
              [ String -> String -> Parser String
parseFilePath String
"certificate-file" String
helpText
              , Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"certificate" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall (f :: * -> *) a. Mod f a
Opt.internal)
              ]
        )
    Parser
  (Maybe (ScriptWitnessFiles WitCtxStake)
   -> (CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake)))
-> Parser (Maybe (ScriptWitnessFiles WitCtxStake))
-> Parser (CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (ScriptWitnessFiles WitCtxStake)
-> Parser (Maybe (ScriptWitnessFiles WitCtxStake))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxStake)
pCertifyingScriptOrReferenceScriptWit BalanceTxExecUnits
balanceExecUnits)
 where
  pCertifyingScriptOrReferenceScriptWit
    :: BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxStake)
  pCertifyingScriptOrReferenceScriptWit :: BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxStake)
pCertifyingScriptOrReferenceScriptWit BalanceTxExecUnits
bExecUnits =
    ShelleyBasedEra era
-> WitCtx WitCtxStake
-> BalanceTxExecUnits
-> String
-> Maybe String
-> String
-> Parser (ScriptWitnessFiles WitCtxStake)
forall witctx era.
ShelleyBasedEra era
-> WitCtx witctx
-> BalanceTxExecUnits
-> String
-> Maybe String
-> String
-> Parser (ScriptWitnessFiles witctx)
pScriptWitnessFiles
      ShelleyBasedEra era
sbe
      WitCtx WitCtxStake
WitCtxStake
      BalanceTxExecUnits
balanceExecUnits
      String
"certificate"
      Maybe String
forall a. Maybe a
Nothing
      String
"the use of the certificate."
      Parser (ScriptWitnessFiles WitCtxStake)
-> Parser (ScriptWitnessFiles WitCtxStake)
-> Parser (ScriptWitnessFiles WitCtxStake)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String
-> BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxStake)
pPlutusStakeReferenceScriptWitnessFiles String
"certificate-" BalanceTxExecUnits
bExecUnits

  helpText :: String
helpText =
    [String] -> String
forall a. Monoid a => [a] -> a
mconcat
      [ String
"Filepath of the certificate. This encompasses all "
      , String
"types of certificates (stake pool certificates, "
      , String
"stake key certificates etc). Optionally specify a script witness."
      ]

pPoolMetadataFile :: Parser (StakePoolMetadataFile In)
pPoolMetadataFile :: Parser (StakePoolMetadataFile 'In)
pPoolMetadataFile =
  String -> StakePoolMetadataFile 'In
forall content (direction :: FileDirection).
String -> File content direction
File (String -> StakePoolMetadataFile 'In)
-> Parser String -> Parser (StakePoolMetadataFile 'In)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser String
parseFilePath String
"pool-metadata-file" String
"Filepath of the pool metadata."

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

convertTime :: String -> UTCTime
convertTime :: String -> UTCTime
convertTime =
  Bool -> TimeLocale -> String -> String -> UTCTime
forall t.
ParseTime t =>
Bool -> TimeLocale -> String -> String -> t
parseTimeOrError Bool
False TimeLocale
defaultTimeLocale String
"%Y-%m-%dT%H:%M:%SZ"

pMetadataFile :: Parser MetadataFile
pMetadataFile :: Parser MetadataFile
pMetadataFile =
  [Parser MetadataFile] -> Parser MetadataFile
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ (File () 'In -> MetadataFile)
-> Parser (File () 'In) -> Parser MetadataFile
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap File () 'In -> MetadataFile
MetadataFileJSON (Parser (File () 'In) -> Parser MetadataFile)
-> Parser (File () 'In) -> Parser MetadataFile
forall a b. (a -> b) -> a -> b
$
        [Parser (File () 'In)] -> Parser (File () 'In)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
          [ String -> File () 'In
forall content (direction :: FileDirection).
String -> File content direction
File (String -> File () 'In) -> Parser String -> Parser (File () 'In)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser String
parseFilePath String
"metadata-json-file" String
"Filepath of the metadata file, in JSON format."
          , Mod OptionFields (File () 'In) -> Parser (File () 'In)
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption (Mod OptionFields (File () 'In) -> Parser (File () 'In))
-> Mod OptionFields (File () 'In) -> Parser (File () 'In)
forall a b. (a -> b) -> a -> b
$
              [Mod OptionFields (File () 'In)] -> Mod OptionFields (File () 'In)
forall a. Monoid a => [a] -> a
mconcat
                [ String -> Mod OptionFields (File () 'In)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"metadata-file" -- backward compat name
                , Mod OptionFields (File () 'In)
forall (f :: * -> *) a. Mod f a
Opt.internal
                ]
          ]
    , (File () 'In -> MetadataFile)
-> Parser (File () 'In) -> Parser MetadataFile
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap File () 'In -> MetadataFile
MetadataFileCBOR (Parser (File () 'In) -> Parser MetadataFile)
-> Parser (File () 'In) -> Parser MetadataFile
forall a b. (a -> b) -> a -> b
$
        String -> File () 'In
forall content (direction :: FileDirection).
String -> File content direction
File (String -> File () 'In) -> Parser String -> Parser (File () 'In)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser String
parseFilePath String
"metadata-cbor-file" String
"Filepath of the metadata, in raw CBOR format."
    ]

pWithdrawal
  :: ShelleyBasedEra era
  -> BalanceTxExecUnits
  -> Parser
      ( StakeAddress
      , Lovelace
      , Maybe (ScriptWitnessFiles WitCtxStake)
      )
pWithdrawal :: forall era.
ShelleyBasedEra era
-> BalanceTxExecUnits
-> Parser
     (StakeAddress, Lovelace, Maybe (ScriptWitnessFiles WitCtxStake))
pWithdrawal ShelleyBasedEra era
sbe BalanceTxExecUnits
balance =
  (\(StakeAddress
stakeAddr, Lovelace
lovelace) Maybe (ScriptWitnessFiles WitCtxStake)
maybeScriptFp -> (StakeAddress
stakeAddr, Lovelace
lovelace, Maybe (ScriptWitnessFiles WitCtxStake)
maybeScriptFp))
    ((StakeAddress, Lovelace)
 -> Maybe (ScriptWitnessFiles WitCtxStake)
 -> (StakeAddress, Lovelace,
     Maybe (ScriptWitnessFiles WitCtxStake)))
-> Parser (StakeAddress, Lovelace)
-> Parser
     (Maybe (ScriptWitnessFiles WitCtxStake)
      -> (StakeAddress, Lovelace,
          Maybe (ScriptWitnessFiles WitCtxStake)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM (StakeAddress, Lovelace)
-> Mod OptionFields (StakeAddress, Lovelace)
-> Parser (StakeAddress, Lovelace)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      (Parser (StakeAddress, Lovelace) -> ReadM (StakeAddress, Lovelace)
forall a. Parser a -> ReadM a
readerFromParsecParser Parser (StakeAddress, Lovelace)
parseWithdrawal)
      ( String -> Mod OptionFields (StakeAddress, Lovelace)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"withdrawal"
          Mod OptionFields (StakeAddress, Lovelace)
-> Mod OptionFields (StakeAddress, Lovelace)
-> Mod OptionFields (StakeAddress, Lovelace)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (StakeAddress, Lovelace)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"WITHDRAWAL"
          Mod OptionFields (StakeAddress, Lovelace)
-> Mod OptionFields (StakeAddress, Lovelace)
-> Mod OptionFields (StakeAddress, Lovelace)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (StakeAddress, Lovelace)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
helpText
      )
    Parser
  (Maybe (ScriptWitnessFiles WitCtxStake)
   -> (StakeAddress, Lovelace,
       Maybe (ScriptWitnessFiles WitCtxStake)))
-> Parser (Maybe (ScriptWitnessFiles WitCtxStake))
-> Parser
     (StakeAddress, Lovelace, Maybe (ScriptWitnessFiles WitCtxStake))
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (ScriptWitnessFiles WitCtxStake)
-> Parser (Maybe (ScriptWitnessFiles WitCtxStake))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser (ScriptWitnessFiles WitCtxStake)
pWithdrawalScriptOrReferenceScriptWit
 where
  pWithdrawalScriptOrReferenceScriptWit :: Parser (ScriptWitnessFiles WitCtxStake)
  pWithdrawalScriptOrReferenceScriptWit :: Parser (ScriptWitnessFiles WitCtxStake)
pWithdrawalScriptOrReferenceScriptWit =
    ShelleyBasedEra era
-> WitCtx WitCtxStake
-> BalanceTxExecUnits
-> String
-> Maybe String
-> String
-> Parser (ScriptWitnessFiles WitCtxStake)
forall witctx era.
ShelleyBasedEra era
-> WitCtx witctx
-> BalanceTxExecUnits
-> String
-> Maybe String
-> String
-> Parser (ScriptWitnessFiles witctx)
pScriptWitnessFiles
      ShelleyBasedEra era
sbe
      WitCtx WitCtxStake
WitCtxStake
      BalanceTxExecUnits
balance
      String
"withdrawal"
      Maybe String
forall a. Maybe a
Nothing
      String
"the withdrawal of rewards."
      Parser (ScriptWitnessFiles WitCtxStake)
-> Parser (ScriptWitnessFiles WitCtxStake)
-> Parser (ScriptWitnessFiles WitCtxStake)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String
-> BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxStake)
pPlutusStakeReferenceScriptWitnessFiles String
"withdrawal-" BalanceTxExecUnits
balance

  helpText :: String
helpText =
    [String] -> String
forall a. Monoid a => [a] -> a
mconcat
      [ String
"The reward withdrawal as StakeAddress+Lovelace where "
      , String
"StakeAddress is the Bech32-encoded stake address "
      , String
"followed by the amount in Lovelace. Optionally specify "
      , String
"a script witness."
      ]

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

pPlutusStakeReferenceScriptWitnessFilesVotingProposing
  :: String
  -> BalanceTxExecUnits
  -- ^ Use the @execution-units@ flag.
  -> Parser (ScriptWitnessFiles WitCtxStake)
pPlutusStakeReferenceScriptWitnessFilesVotingProposing :: String
-> BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxStake)
pPlutusStakeReferenceScriptWitnessFilesVotingProposing String
prefix BalanceTxExecUnits
autoBalanceExecUnits =
  TxIn
-> AnyScriptLanguage
-> ScriptDatumOrFile WitCtxStake
-> ScriptRedeemerOrFile
-> ExecutionUnits
-> Maybe PolicyId
-> ScriptWitnessFiles WitCtxStake
forall witctx.
TxIn
-> AnyScriptLanguage
-> ScriptDatumOrFile witctx
-> ScriptRedeemerOrFile
-> ExecutionUnits
-> Maybe PolicyId
-> ScriptWitnessFiles witctx
PlutusReferenceScriptWitnessFiles
    (TxIn
 -> AnyScriptLanguage
 -> ScriptDatumOrFile WitCtxStake
 -> ScriptRedeemerOrFile
 -> ExecutionUnits
 -> Maybe PolicyId
 -> ScriptWitnessFiles WitCtxStake)
-> Parser TxIn
-> Parser
     (AnyScriptLanguage
      -> ScriptDatumOrFile WitCtxStake
      -> ScriptRedeemerOrFile
      -> ExecutionUnits
      -> Maybe PolicyId
      -> ScriptWitnessFiles WitCtxStake)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser TxIn
pReferenceTxIn String
prefix String
"plutus"
    Parser
  (AnyScriptLanguage
   -> ScriptDatumOrFile WitCtxStake
   -> ScriptRedeemerOrFile
   -> ExecutionUnits
   -> Maybe PolicyId
   -> ScriptWitnessFiles WitCtxStake)
-> Parser AnyScriptLanguage
-> Parser
     (ScriptDatumOrFile WitCtxStake
      -> ScriptRedeemerOrFile
      -> ExecutionUnits
      -> Maybe PolicyId
      -> ScriptWitnessFiles WitCtxStake)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> PlutusScriptVersion PlutusScriptV3
-> String
-> Parser AnyScriptLanguage
forall lang.
String
-> PlutusScriptVersion lang -> String -> Parser AnyScriptLanguage
plutusP String
prefix PlutusScriptVersion PlutusScriptV3
PlutusScriptV3 String
"v3"
    Parser
  (ScriptDatumOrFile WitCtxStake
   -> ScriptRedeemerOrFile
   -> ExecutionUnits
   -> Maybe PolicyId
   -> ScriptWitnessFiles WitCtxStake)
-> Parser (ScriptDatumOrFile WitCtxStake)
-> Parser
     (ScriptRedeemerOrFile
      -> ExecutionUnits
      -> Maybe PolicyId
      -> ScriptWitnessFiles WitCtxStake)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ScriptDatumOrFile WitCtxStake
-> Parser (ScriptDatumOrFile WitCtxStake)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScriptDatumOrFile WitCtxStake
NoScriptDatumOrFileForStake
    Parser
  (ScriptRedeemerOrFile
   -> ExecutionUnits
   -> Maybe PolicyId
   -> ScriptWitnessFiles WitCtxStake)
-> Parser ScriptRedeemerOrFile
-> Parser
     (ExecutionUnits
      -> Maybe PolicyId -> ScriptWitnessFiles WitCtxStake)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Parser ScriptRedeemerOrFile
pScriptRedeemerOrFile (String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"reference-tx-in")
    Parser
  (ExecutionUnits
   -> Maybe PolicyId -> ScriptWitnessFiles WitCtxStake)
-> Parser ExecutionUnits
-> Parser (Maybe PolicyId -> ScriptWitnessFiles WitCtxStake)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( case BalanceTxExecUnits
autoBalanceExecUnits of
            BalanceTxExecUnits
AutoBalance -> ExecutionUnits -> Parser ExecutionUnits
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> Natural -> ExecutionUnits
ExecutionUnits Natural
0 Natural
0)
            BalanceTxExecUnits
ManualBalance -> String -> Parser ExecutionUnits
pExecutionUnits (String -> Parser ExecutionUnits)
-> String -> Parser ExecutionUnits
forall a b. (a -> b) -> a -> b
$ String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"reference-tx-in"
        )
    Parser (Maybe PolicyId -> ScriptWitnessFiles WitCtxStake)
-> Parser (Maybe PolicyId)
-> Parser (ScriptWitnessFiles WitCtxStake)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe PolicyId -> Parser (Maybe PolicyId)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PolicyId
forall a. Maybe a
Nothing

pPlutusStakeReferenceScriptWitnessFiles
  :: String
  -> BalanceTxExecUnits
  -- ^ Use the @execution-units@ flag.
  -> Parser (ScriptWitnessFiles WitCtxStake)
pPlutusStakeReferenceScriptWitnessFiles :: String
-> BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxStake)
pPlutusStakeReferenceScriptWitnessFiles String
prefix BalanceTxExecUnits
autoBalanceExecUnits =
  TxIn
-> AnyScriptLanguage
-> ScriptDatumOrFile WitCtxStake
-> ScriptRedeemerOrFile
-> ExecutionUnits
-> Maybe PolicyId
-> ScriptWitnessFiles WitCtxStake
forall witctx.
TxIn
-> AnyScriptLanguage
-> ScriptDatumOrFile witctx
-> ScriptRedeemerOrFile
-> ExecutionUnits
-> Maybe PolicyId
-> ScriptWitnessFiles witctx
PlutusReferenceScriptWitnessFiles
    (TxIn
 -> AnyScriptLanguage
 -> ScriptDatumOrFile WitCtxStake
 -> ScriptRedeemerOrFile
 -> ExecutionUnits
 -> Maybe PolicyId
 -> ScriptWitnessFiles WitCtxStake)
-> Parser TxIn
-> Parser
     (AnyScriptLanguage
      -> ScriptDatumOrFile WitCtxStake
      -> ScriptRedeemerOrFile
      -> ExecutionUnits
      -> Maybe PolicyId
      -> ScriptWitnessFiles WitCtxStake)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser TxIn
pReferenceTxIn String
prefix String
"plutus"
    Parser
  (AnyScriptLanguage
   -> ScriptDatumOrFile WitCtxStake
   -> ScriptRedeemerOrFile
   -> ExecutionUnits
   -> Maybe PolicyId
   -> ScriptWitnessFiles WitCtxStake)
-> Parser AnyScriptLanguage
-> Parser
     (ScriptDatumOrFile WitCtxStake
      -> ScriptRedeemerOrFile
      -> ExecutionUnits
      -> Maybe PolicyId
      -> ScriptWitnessFiles WitCtxStake)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Parser AnyScriptLanguage
pPlutusScriptLanguage String
prefix
    Parser
  (ScriptDatumOrFile WitCtxStake
   -> ScriptRedeemerOrFile
   -> ExecutionUnits
   -> Maybe PolicyId
   -> ScriptWitnessFiles WitCtxStake)
-> Parser (ScriptDatumOrFile WitCtxStake)
-> Parser
     (ScriptRedeemerOrFile
      -> ExecutionUnits
      -> Maybe PolicyId
      -> ScriptWitnessFiles WitCtxStake)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ScriptDatumOrFile WitCtxStake
-> Parser (ScriptDatumOrFile WitCtxStake)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScriptDatumOrFile WitCtxStake
NoScriptDatumOrFileForStake
    Parser
  (ScriptRedeemerOrFile
   -> ExecutionUnits
   -> Maybe PolicyId
   -> ScriptWitnessFiles WitCtxStake)
-> Parser ScriptRedeemerOrFile
-> Parser
     (ExecutionUnits
      -> Maybe PolicyId -> ScriptWitnessFiles WitCtxStake)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Parser ScriptRedeemerOrFile
pScriptRedeemerOrFile (String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"reference-tx-in")
    Parser
  (ExecutionUnits
   -> Maybe PolicyId -> ScriptWitnessFiles WitCtxStake)
-> Parser ExecutionUnits
-> Parser (Maybe PolicyId -> ScriptWitnessFiles WitCtxStake)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( case BalanceTxExecUnits
autoBalanceExecUnits of
            BalanceTxExecUnits
AutoBalance -> ExecutionUnits -> Parser ExecutionUnits
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> Natural -> ExecutionUnits
ExecutionUnits Natural
0 Natural
0)
            BalanceTxExecUnits
ManualBalance -> String -> Parser ExecutionUnits
pExecutionUnits (String -> Parser ExecutionUnits)
-> String -> Parser ExecutionUnits
forall a b. (a -> b) -> a -> b
$ String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"reference-tx-in"
        )
    Parser (Maybe PolicyId -> ScriptWitnessFiles WitCtxStake)
-> Parser (Maybe PolicyId)
-> Parser (ScriptWitnessFiles WitCtxStake)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe PolicyId -> Parser (Maybe PolicyId)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PolicyId
forall a. Maybe a
Nothing

pPlutusScriptLanguage :: String -> Parser AnyScriptLanguage
pPlutusScriptLanguage :: String -> Parser AnyScriptLanguage
pPlutusScriptLanguage String
prefix = String
-> PlutusScriptVersion PlutusScriptV2
-> String
-> Parser AnyScriptLanguage
forall lang.
String
-> PlutusScriptVersion lang -> String -> Parser AnyScriptLanguage
plutusP String
prefix PlutusScriptVersion PlutusScriptV2
PlutusScriptV2 String
"v2" Parser AnyScriptLanguage
-> Parser AnyScriptLanguage -> Parser AnyScriptLanguage
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String
-> PlutusScriptVersion PlutusScriptV3
-> String
-> Parser AnyScriptLanguage
forall lang.
String
-> PlutusScriptVersion lang -> String -> Parser AnyScriptLanguage
plutusP String
prefix PlutusScriptVersion PlutusScriptV3
PlutusScriptV3 String
"v3"

plutusP :: String -> PlutusScriptVersion lang -> String -> Parser AnyScriptLanguage
plutusP :: forall lang.
String
-> PlutusScriptVersion lang -> String -> Parser AnyScriptLanguage
plutusP String
prefix PlutusScriptVersion lang
plutusVersion String
versionString =
  AnyScriptLanguage
-> Mod FlagFields AnyScriptLanguage -> Parser AnyScriptLanguage
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag'
    (ScriptLanguage lang -> AnyScriptLanguage
forall lang. ScriptLanguage lang -> AnyScriptLanguage
AnyScriptLanguage (ScriptLanguage lang -> AnyScriptLanguage)
-> ScriptLanguage lang -> AnyScriptLanguage
forall a b. (a -> b) -> a -> b
$ PlutusScriptVersion lang -> ScriptLanguage lang
forall lang. PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion lang
plutusVersion)
    ( String -> Mod FlagFields AnyScriptLanguage
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long (String
prefix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"plutus-script-" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
versionString)
        Mod FlagFields AnyScriptLanguage
-> Mod FlagFields AnyScriptLanguage
-> Mod FlagFields AnyScriptLanguage
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields AnyScriptLanguage
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String
"Specify a plutus script " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
versionString String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" reference script.")
    )

pUpdateProposalFile :: Parser UpdateProposalFile
pUpdateProposalFile :: Parser UpdateProposalFile
pUpdateProposalFile =
  (String -> UpdateProposalFile)
-> Parser String -> Parser UpdateProposalFile
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> UpdateProposalFile
UpdateProposalFile (Parser String -> Parser UpdateProposalFile)
-> Parser String -> Parser UpdateProposalFile
forall a b. (a -> b) -> a -> b
$
    [Parser String] -> Parser String
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
      [ String -> String -> Parser String
parseFilePath String
"update-proposal-file" String
"Filepath of the update proposal."
      , 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
"update-proposal"
            , Mod OptionFields String
forall (f :: * -> *) a. Mod f a
Opt.internal
            ]
      ]

pRequiredSigner :: Parser RequiredSigner
pRequiredSigner :: Parser RequiredSigner
pRequiredSigner =
  SigningKeyFile 'In -> RequiredSigner
RequiredSignerSkeyFile
    (SigningKeyFile 'In -> RequiredSigner)
-> Parser (SigningKeyFile 'In) -> Parser RequiredSigner
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (SigningKeyFile 'In)
sKeyFile
      Parser RequiredSigner
-> Parser RequiredSigner -> Parser RequiredSigner
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Hash PaymentKey -> RequiredSigner
RequiredSignerHash
    (Hash PaymentKey -> RequiredSigner)
-> Parser (Hash PaymentKey) -> Parser RequiredSigner
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Hash PaymentKey)
sPayKeyHash
 where
  sKeyFile :: Parser (SigningKeyFile In)
  sKeyFile :: Parser (SigningKeyFile 'In)
sKeyFile =
    String -> SigningKeyFile 'In
forall content (direction :: FileDirection).
String -> File content direction
File
      (String -> SigningKeyFile 'In)
-> Parser String -> Parser (SigningKeyFile 'In)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser String
parseFilePath
        String
"required-signer"
        String
"Input filepath of the signing key (zero or more) whose signature is required."
  sPayKeyHash :: Parser (Hash PaymentKey)
  sPayKeyHash :: Parser (Hash PaymentKey)
sPayKeyHash =
    ReadM (Hash PaymentKey)
-> Mod OptionFields (Hash PaymentKey) -> Parser (Hash PaymentKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser (Hash PaymentKey) -> ReadM (Hash PaymentKey)
forall a. Parser a -> ReadM a
readerFromParsecParser (Parser (Hash PaymentKey) -> ReadM (Hash PaymentKey))
-> Parser (Hash PaymentKey) -> ReadM (Hash PaymentKey)
forall a b. (a -> b) -> a -> b
$ AsType (Hash PaymentKey) -> Parser (Hash PaymentKey)
forall a.
SerialiseAsRawBytes (Hash a) =>
AsType (Hash a) -> Parser (Hash a)
parseHash (AsType PaymentKey -> AsType (Hash PaymentKey)
forall a. AsType a -> AsType (Hash a)
AsHash AsType PaymentKey
AsPaymentKey)) (Mod OptionFields (Hash PaymentKey) -> Parser (Hash PaymentKey))
-> Mod OptionFields (Hash PaymentKey) -> Parser (Hash PaymentKey)
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields (Hash PaymentKey)]
-> Mod OptionFields (Hash PaymentKey)
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod OptionFields (Hash PaymentKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"required-signer-hash"
        , String -> Mod OptionFields (Hash PaymentKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"HASH"
        , String -> Mod OptionFields (Hash PaymentKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod OptionFields (Hash PaymentKey))
-> String -> Mod OptionFields (Hash PaymentKey)
forall a b. (a -> b) -> a -> b
$
            [String] -> String
forall a. Monoid a => [a] -> a
mconcat
              [ String
"Hash of the verification key (zero or more) whose "
              , String
"signature is required."
              ]
        ]

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

pWhichLeadershipSchedule :: Parser EpochLeadershipSchedule
pWhichLeadershipSchedule :: Parser EpochLeadershipSchedule
pWhichLeadershipSchedule = Parser EpochLeadershipSchedule
pCurrent Parser EpochLeadershipSchedule
-> Parser EpochLeadershipSchedule -> Parser EpochLeadershipSchedule
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser EpochLeadershipSchedule
pNext
 where
  pCurrent :: Parser EpochLeadershipSchedule
  pCurrent :: Parser EpochLeadershipSchedule
pCurrent =
    EpochLeadershipSchedule
-> Mod FlagFields EpochLeadershipSchedule
-> Parser EpochLeadershipSchedule
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' EpochLeadershipSchedule
CurrentEpoch (Mod FlagFields EpochLeadershipSchedule
 -> Parser EpochLeadershipSchedule)
-> Mod FlagFields EpochLeadershipSchedule
-> Parser EpochLeadershipSchedule
forall a b. (a -> b) -> a -> b
$
      [Mod FlagFields EpochLeadershipSchedule]
-> Mod FlagFields EpochLeadershipSchedule
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod FlagFields EpochLeadershipSchedule
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"current"
        , String -> Mod FlagFields EpochLeadershipSchedule
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Get the leadership schedule for the current epoch."
        ]

  pNext :: Parser EpochLeadershipSchedule
  pNext :: Parser EpochLeadershipSchedule
pNext =
    EpochLeadershipSchedule
-> Mod FlagFields EpochLeadershipSchedule
-> Parser EpochLeadershipSchedule
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' EpochLeadershipSchedule
NextEpoch (Mod FlagFields EpochLeadershipSchedule
 -> Parser EpochLeadershipSchedule)
-> Mod FlagFields EpochLeadershipSchedule
-> Parser EpochLeadershipSchedule
forall a b. (a -> b) -> a -> b
$
      [Mod FlagFields EpochLeadershipSchedule]
-> Mod FlagFields EpochLeadershipSchedule
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod FlagFields EpochLeadershipSchedule
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"next"
        , String -> Mod FlagFields EpochLeadershipSchedule
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Get the leadership schedule for the following epoch."
        ]

pWitnessSigningData :: Parser WitnessSigningData
pWitnessSigningData :: Parser WitnessSigningData
pWitnessSigningData =
  SigningKeyFile 'In
-> Maybe (Address ByronAddr) -> WitnessSigningData
KeyWitnessSigningData (SigningKeyFile 'In
 -> Maybe (Address ByronAddr) -> WitnessSigningData)
-> (String -> SigningKeyFile 'In)
-> String
-> Maybe (Address ByronAddr)
-> WitnessSigningData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SigningKeyFile 'In
forall content (direction :: FileDirection).
String -> File content direction
File
    (String -> Maybe (Address ByronAddr) -> WitnessSigningData)
-> Parser String
-> Parser (Maybe (Address ByronAddr) -> WitnessSigningData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser String
parseFilePath String
"signing-key-file" String
"Input filepath of the signing key (one or more)."
    Parser (Maybe (Address ByronAddr) -> WitnessSigningData)
-> Parser (Maybe (Address ByronAddr)) -> Parser WitnessSigningData
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Address ByronAddr) -> Parser (Maybe (Address ByronAddr))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser (Address ByronAddr)
pByronAddress

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

pKesPeriod :: Parser KESPeriod
pKesPeriod :: Parser KESPeriod
pKesPeriod =
  (Word -> KESPeriod) -> Parser Word -> Parser KESPeriod
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word -> KESPeriod
KESPeriod (Parser Word -> Parser KESPeriod)
-> Parser Word -> Parser KESPeriod
forall a b. (a -> b) -> a -> b
$
    ReadM Word -> Mod OptionFields Word -> Parser Word
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (String -> ReadM Word
forall a. (Bounded a, Integral a, Show a) => String -> ReadM a
bounded String
"KES_PERIOD") (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
"kes-period"
        , String -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"NATURAL"
        , String -> Mod OptionFields Word
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The start of the KES key validity period."
        ]

pEpochNo :: String -> Parser EpochNo
pEpochNo :: String -> Parser EpochNo
pEpochNo String
h =
  (Word64 -> EpochNo) -> Parser Word64 -> Parser EpochNo
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> EpochNo
EpochNo (Parser Word64 -> Parser EpochNo)
-> Parser Word64 -> Parser EpochNo
forall a b. (a -> b) -> a -> b
$
    ReadM Word64 -> Mod OptionFields Word64 -> Parser Word64
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (String -> ReadM Word64
forall a. (Bounded a, Integral a, Show a) => String -> ReadM a
bounded String
"EPOCH") (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
"epoch"
        , String -> Mod OptionFields Word64
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"NATURAL"
        , String -> Mod OptionFields Word64
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
h
        ]

pEpochNoUpdateProp :: Parser EpochNo
pEpochNoUpdateProp :: Parser EpochNo
pEpochNoUpdateProp = String -> Parser EpochNo
pEpochNo String
"The epoch number in which the update proposal is valid."

pGenesisFile :: String -> Parser GenesisFile
pGenesisFile :: String -> Parser GenesisFile
pGenesisFile String
desc = String -> GenesisFile
GenesisFile (String -> GenesisFile) -> Parser String -> Parser GenesisFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser String
parseFilePath String
"genesis" String
desc

pOperationalCertificateFile :: Parser (File () direction)
pOperationalCertificateFile :: forall (direction :: FileDirection). Parser (File () direction)
pOperationalCertificateFile =
  String -> File () direction
forall content (direction :: FileDirection).
String -> File content direction
File (String -> File () direction)
-> Parser String -> Parser (File () direction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser String
parseFilePath String
"op-cert-file" String
"Filepath of the node's operational certificate."

pKeyOutputFormat :: Parser KeyOutputFormat
pKeyOutputFormat :: Parser KeyOutputFormat
pKeyOutputFormat =
  ReadM KeyOutputFormat
-> Mod OptionFields KeyOutputFormat -> Parser KeyOutputFormat
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM KeyOutputFormat
readKeyOutputFormat (Mod OptionFields KeyOutputFormat -> Parser KeyOutputFormat)
-> Mod OptionFields KeyOutputFormat -> Parser KeyOutputFormat
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields KeyOutputFormat]
-> Mod OptionFields KeyOutputFormat
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields KeyOutputFormat
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"key-output-format"
      , String -> Mod OptionFields KeyOutputFormat
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
      , String -> Mod OptionFields KeyOutputFormat
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod OptionFields KeyOutputFormat)
-> String -> Mod OptionFields KeyOutputFormat
forall a b. (a -> b) -> a -> b
$
          [String] -> String
forall a. Monoid a => [a] -> a
mconcat
            [ String
"Optional key output format. Accepted output formats are \"text-envelope\" "
            , String
"and \"bech32\" (default is \"text-envelope\")."
            ]
      , KeyOutputFormat -> Mod OptionFields KeyOutputFormat
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value KeyOutputFormat
KeyOutputFormatTextEnvelope
      ]

pPoolIdOutputFormat :: Parser IdOutputFormat
pPoolIdOutputFormat :: Parser IdOutputFormat
pPoolIdOutputFormat =
  ReadM IdOutputFormat
-> Mod OptionFields IdOutputFormat -> Parser IdOutputFormat
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM IdOutputFormat
readIdOutputFormat (Mod OptionFields IdOutputFormat -> Parser IdOutputFormat)
-> Mod OptionFields IdOutputFormat -> Parser IdOutputFormat
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields IdOutputFormat]
-> Mod OptionFields IdOutputFormat
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields IdOutputFormat
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"output-format"
      , String -> Mod OptionFields IdOutputFormat
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
      , String -> Mod OptionFields IdOutputFormat
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod OptionFields IdOutputFormat)
-> String -> Mod OptionFields IdOutputFormat
forall a b. (a -> b) -> a -> b
$
          [String] -> String
forall a. Monoid a => [a] -> a
mconcat
            [ String
"Optional pool id output format. Accepted output formats are \"hex\" "
            , String
"and \"bech32\" (default is \"bech32\")."
            ]
      , IdOutputFormat -> Mod OptionFields IdOutputFormat
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value IdOutputFormat
IdOutputFormatBech32
      ]

-- | @pOutputFormatJsonOrText kind@ is a parser to specify in which format
-- to view some data (json or text). @kind@ is the kind of data considered.
pOutputFormatJsonOrText :: String -> Parser OutputFormatJsonOrText
pOutputFormatJsonOrText :: String -> Parser OutputFormatJsonOrText
pOutputFormatJsonOrText String
kind =
  [Parser OutputFormatJsonOrText] -> Parser OutputFormatJsonOrText
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ OutputFormatJsonOrText
-> String
-> String
-> Maybe String
-> Parser OutputFormatJsonOrText
make OutputFormatJsonOrText
OutputFormatJson String
"JSON" String
"json" (String -> Maybe String
forall a. a -> Maybe a
Just String
" Default format when writing to a file")
    , OutputFormatJsonOrText
-> String
-> String
-> Maybe String
-> Parser OutputFormatJsonOrText
make OutputFormatJsonOrText
OutputFormatText String
"TEXT" String
"text" (String -> Maybe String
forall a. a -> Maybe a
Just String
" Default format when writing to stdout")
    ]
 where
  make :: OutputFormatJsonOrText
-> String
-> String
-> Maybe String
-> Parser OutputFormatJsonOrText
make OutputFormatJsonOrText
format String
desc String
flag_ Maybe String
extraHelp =
    -- Not using Opt.flag, because there is no default. We can't have
    -- a default and preserve the historical behavior (that differed whether
    -- an output file was specified or not).
    OutputFormatJsonOrText
-> Mod FlagFields OutputFormatJsonOrText
-> Parser OutputFormatJsonOrText
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' OutputFormatJsonOrText
format (Mod FlagFields OutputFormatJsonOrText
 -> Parser OutputFormatJsonOrText)
-> Mod FlagFields OutputFormatJsonOrText
-> Parser OutputFormatJsonOrText
forall a b. (a -> b) -> a -> b
$
      [Mod FlagFields OutputFormatJsonOrText]
-> Mod FlagFields OutputFormatJsonOrText
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod FlagFields OutputFormatJsonOrText
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod FlagFields OutputFormatJsonOrText)
-> String -> Mod FlagFields OutputFormatJsonOrText
forall a b. (a -> b) -> a -> b
$
            String
"Format "
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
kind
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" query output to "
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
desc
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"."
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" Maybe String
extraHelp
        , String -> Mod FlagFields OutputFormatJsonOrText
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long (String
"output-" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
flag_)
        ]

pTxViewOutputFormat :: Parser ViewOutputFormat
pTxViewOutputFormat :: Parser ViewOutputFormat
pTxViewOutputFormat = String -> Parser ViewOutputFormat
pViewOutputFormat String
"transaction"

pGovernanceActionViewOutputFormat :: Parser ViewOutputFormat
pGovernanceActionViewOutputFormat :: Parser ViewOutputFormat
pGovernanceActionViewOutputFormat = String -> Parser ViewOutputFormat
pViewOutputFormat String
"governance action"

pGovernanceVoteViewOutputFormat :: Parser ViewOutputFormat
pGovernanceVoteViewOutputFormat :: Parser ViewOutputFormat
pGovernanceVoteViewOutputFormat = String -> Parser ViewOutputFormat
pViewOutputFormat String
"governance vote"

-- | @pViewOutputFormat kind@ is a parser to specify in which format
-- to view some data (json or yaml). @what@ is the kind of data considered.
pViewOutputFormat :: String -> Parser ViewOutputFormat
pViewOutputFormat :: String -> Parser ViewOutputFormat
pViewOutputFormat String
kind =
  [Parser ViewOutputFormat] -> Parser ViewOutputFormat
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ ViewOutputFormat
-> String -> String -> Maybe String -> Parser ViewOutputFormat
make ViewOutputFormat
ViewOutputFormatJson String
"JSON" String
"json" Maybe String
forall a. Maybe a
Nothing
    , ViewOutputFormat
-> String -> String -> Maybe String -> Parser ViewOutputFormat
make ViewOutputFormat
ViewOutputFormatYaml String
"YAML" String
"yaml" (String -> Maybe String
forall a. a -> Maybe a
Just String
" Defaults to JSON if unspecified.")
    ]
 where
  make :: ViewOutputFormat
-> String -> String -> Maybe String -> Parser ViewOutputFormat
make ViewOutputFormat
format String
desc String
flag_ Maybe String
extraHelp =
    ViewOutputFormat
-> ViewOutputFormat
-> Mod FlagFields ViewOutputFormat
-> Parser ViewOutputFormat
forall a. a -> a -> Mod FlagFields a -> Parser a
Opt.flag ViewOutputFormat
ViewOutputFormatJson ViewOutputFormat
format (Mod FlagFields ViewOutputFormat -> Parser ViewOutputFormat)
-> Mod FlagFields ViewOutputFormat -> Parser ViewOutputFormat
forall a b. (a -> b) -> a -> b
$
      [Mod FlagFields ViewOutputFormat]
-> Mod FlagFields ViewOutputFormat
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod FlagFields ViewOutputFormat
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod FlagFields ViewOutputFormat)
-> String -> Mod FlagFields ViewOutputFormat
forall a b. (a -> b) -> a -> b
$
            String
"Format "
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
kind
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" view output to "
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
desc
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"."
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" Maybe String
extraHelp
        , String -> Mod FlagFields ViewOutputFormat
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long (String
"output-" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
flag_)
        ]

pMaybeOutputFile :: Parser (Maybe (File content Out))
pMaybeOutputFile :: forall content. Parser (Maybe (File content 'Out))
pMaybeOutputFile =
  Parser (File content 'Out) -> Parser (Maybe (File content 'Out))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser (File content 'Out) -> Parser (Maybe (File content 'Out)))
-> Parser (File content 'Out) -> Parser (Maybe (File content 'Out))
forall a b. (a -> b) -> a -> b
$
    String -> File content 'Out
forall content (direction :: FileDirection).
String -> File content direction
File (String -> File content 'Out)
-> Parser String -> Parser (File content 'Out)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser String
parseFilePath String
"out-file" String
"Optional output file. Default is to write to stdout."

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

pVerificationKeyOrFileIn
  :: SerialiseAsBech32 (VerificationKey keyrole)
  => AsType keyrole
  -> Parser (VerificationKeyOrFile keyrole)
pVerificationKeyOrFileIn :: forall keyrole.
SerialiseAsBech32 (VerificationKey keyrole) =>
AsType keyrole -> Parser (VerificationKeyOrFile keyrole)
pVerificationKeyOrFileIn AsType keyrole
asType =
  [Parser (VerificationKeyOrFile keyrole)]
-> Parser (VerificationKeyOrFile keyrole)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ VerificationKey keyrole -> VerificationKeyOrFile keyrole
forall keyrole.
VerificationKey keyrole -> VerificationKeyOrFile keyrole
VerificationKeyValue (VerificationKey keyrole -> VerificationKeyOrFile keyrole)
-> Parser (VerificationKey keyrole)
-> Parser (VerificationKeyOrFile keyrole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsType keyrole -> Parser (VerificationKey keyrole)
forall keyrole.
SerialiseAsBech32 (VerificationKey keyrole) =>
AsType keyrole -> Parser (VerificationKey keyrole)
pVerificationKey AsType keyrole
asType
    , VerificationKeyFile 'In -> VerificationKeyOrFile keyrole
forall keyrole.
VerificationKeyFile 'In -> VerificationKeyOrFile keyrole
VerificationKeyFilePath (VerificationKeyFile 'In -> VerificationKeyOrFile keyrole)
-> Parser (VerificationKeyFile 'In)
-> Parser (VerificationKeyOrFile keyrole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyFile 'In)
pVerificationKeyFileIn
    ]

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

pGenesisVerificationKeyFile :: Parser (VerificationKeyFile In)
pGenesisVerificationKeyFile :: Parser (VerificationKeyFile 'In)
pGenesisVerificationKeyFile =
  String -> VerificationKeyFile 'In
forall content (direction :: FileDirection).
String -> File content direction
File (String -> VerificationKeyFile 'In)
-> Parser String -> Parser (VerificationKeyFile 'In)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser String
parseFilePath String
"genesis-verification-key-file" String
"Filepath of the genesis verification key."

pGenesisVerificationKeyHash :: Parser (Hash GenesisKey)
pGenesisVerificationKeyHash :: Parser (Hash GenesisKey)
pGenesisVerificationKeyHash =
  ReadM (Hash GenesisKey)
-> Mod OptionFields (Hash GenesisKey) -> Parser (Hash GenesisKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM (Hash GenesisKey)
deserialiseFromHex (Mod OptionFields (Hash GenesisKey) -> Parser (Hash GenesisKey))
-> Mod OptionFields (Hash GenesisKey) -> Parser (Hash GenesisKey)
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields (Hash GenesisKey)]
-> Mod OptionFields (Hash GenesisKey)
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields (Hash GenesisKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"genesis-verification-key-hash"
      , String -> Mod OptionFields (Hash GenesisKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
      , String -> Mod OptionFields (Hash GenesisKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Genesis verification key hash (hex-encoded)."
      ]
 where
  deserialiseFromHex :: ReadM (Hash GenesisKey)
  deserialiseFromHex :: ReadM (Hash GenesisKey)
deserialiseFromHex =
    AsType GenesisKey -> Maybe String -> ReadM (Hash GenesisKey)
forall a.
SerialiseAsRawBytes (Hash a) =>
AsType a -> Maybe String -> ReadM (Hash a)
rHexHash AsType GenesisKey
AsGenesisKey (String -> Maybe String
forall a. a -> Maybe a
Just String
"Invalid genesis verification key hash")

pGenesisVerificationKey :: Parser (VerificationKey GenesisKey)
pGenesisVerificationKey :: Parser (VerificationKey GenesisKey)
pGenesisVerificationKey =
  ReadM (VerificationKey GenesisKey)
-> Mod OptionFields (VerificationKey GenesisKey)
-> Parser (VerificationKey GenesisKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM (VerificationKey GenesisKey)
deserialiseFromHex (Mod OptionFields (VerificationKey GenesisKey)
 -> Parser (VerificationKey GenesisKey))
-> Mod OptionFields (VerificationKey GenesisKey)
-> Parser (VerificationKey GenesisKey)
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields (VerificationKey GenesisKey)]
-> Mod OptionFields (VerificationKey GenesisKey)
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields (VerificationKey GenesisKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"genesis-verification-key"
      , String -> Mod OptionFields (VerificationKey GenesisKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
      , String -> Mod OptionFields (VerificationKey GenesisKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Genesis verification key (hex-encoded)."
      ]
 where
  deserialiseFromHex :: ReadM (VerificationKey GenesisKey)
deserialiseFromHex =
    AsType GenesisKey
-> Maybe String -> ReadM (VerificationKey GenesisKey)
forall a.
SerialiseAsRawBytes (VerificationKey a) =>
AsType a -> Maybe String -> ReadM (VerificationKey a)
rVerificationKey AsType GenesisKey
AsGenesisKey (String -> Maybe String
forall a. a -> Maybe a
Just String
"Invalid genesis verification key")

pGenesisVerificationKeyOrFile :: Parser (VerificationKeyOrFile GenesisKey)
pGenesisVerificationKeyOrFile :: Parser (VerificationKeyOrFile GenesisKey)
pGenesisVerificationKeyOrFile =
  [Parser (VerificationKeyOrFile GenesisKey)]
-> Parser (VerificationKeyOrFile GenesisKey)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ VerificationKey GenesisKey -> VerificationKeyOrFile GenesisKey
forall keyrole.
VerificationKey keyrole -> VerificationKeyOrFile keyrole
VerificationKeyValue (VerificationKey GenesisKey -> VerificationKeyOrFile GenesisKey)
-> Parser (VerificationKey GenesisKey)
-> Parser (VerificationKeyOrFile GenesisKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKey GenesisKey)
pGenesisVerificationKey
    , VerificationKeyFile 'In -> VerificationKeyOrFile GenesisKey
forall keyrole.
VerificationKeyFile 'In -> VerificationKeyOrFile keyrole
VerificationKeyFilePath (VerificationKeyFile 'In -> VerificationKeyOrFile GenesisKey)
-> Parser (VerificationKeyFile 'In)
-> Parser (VerificationKeyOrFile GenesisKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyFile 'In)
pGenesisVerificationKeyFile
    ]

pGenesisVerificationKeyOrHashOrFile :: Parser (VerificationKeyOrHashOrFile GenesisKey)
pGenesisVerificationKeyOrHashOrFile :: Parser (VerificationKeyOrHashOrFile GenesisKey)
pGenesisVerificationKeyOrHashOrFile =
  [Parser (VerificationKeyOrHashOrFile GenesisKey)]
-> Parser (VerificationKeyOrHashOrFile GenesisKey)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ VerificationKeyOrFile GenesisKey
-> VerificationKeyOrHashOrFile GenesisKey
forall keyrole.
VerificationKeyOrFile keyrole
-> VerificationKeyOrHashOrFile keyrole
VerificationKeyOrFile (VerificationKeyOrFile GenesisKey
 -> VerificationKeyOrHashOrFile GenesisKey)
-> Parser (VerificationKeyOrFile GenesisKey)
-> Parser (VerificationKeyOrHashOrFile GenesisKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyOrFile GenesisKey)
pGenesisVerificationKeyOrFile
    , Hash GenesisKey -> VerificationKeyOrHashOrFile GenesisKey
forall keyrole. Hash keyrole -> VerificationKeyOrHashOrFile keyrole
VerificationKeyHash (Hash GenesisKey -> VerificationKeyOrHashOrFile GenesisKey)
-> Parser (Hash GenesisKey)
-> Parser (VerificationKeyOrHashOrFile GenesisKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Hash GenesisKey)
pGenesisVerificationKeyHash
    ]

pGenesisDelegateVerificationKeyFile :: Parser (VerificationKeyFile In)
pGenesisDelegateVerificationKeyFile :: Parser (VerificationKeyFile 'In)
pGenesisDelegateVerificationKeyFile =
  String -> VerificationKeyFile 'In
forall content (direction :: FileDirection).
String -> File content direction
File
    (String -> VerificationKeyFile 'In)
-> Parser String -> Parser (VerificationKeyFile 'In)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser String
parseFilePath
      String
"genesis-delegate-verification-key-file"
      String
"Filepath of the genesis delegate verification key."

pGenesisDelegateVerificationKeyHash :: Parser (Hash GenesisDelegateKey)
pGenesisDelegateVerificationKeyHash :: Parser (Hash GenesisDelegateKey)
pGenesisDelegateVerificationKeyHash =
  ReadM (Hash GenesisDelegateKey)
-> Mod OptionFields (Hash GenesisDelegateKey)
-> Parser (Hash GenesisDelegateKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM (Hash GenesisDelegateKey)
deserialiseFromHex (Mod OptionFields (Hash GenesisDelegateKey)
 -> Parser (Hash GenesisDelegateKey))
-> Mod OptionFields (Hash GenesisDelegateKey)
-> Parser (Hash GenesisDelegateKey)
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields (Hash GenesisDelegateKey)]
-> Mod OptionFields (Hash GenesisDelegateKey)
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields (Hash GenesisDelegateKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"genesis-delegate-verification-key-hash"
      , String -> Mod OptionFields (Hash GenesisDelegateKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
      , String -> Mod OptionFields (Hash GenesisDelegateKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Genesis delegate verification key hash (hex-encoded)."
      ]
 where
  deserialiseFromHex :: ReadM (Hash GenesisDelegateKey)
  deserialiseFromHex :: ReadM (Hash GenesisDelegateKey)
deserialiseFromHex =
    AsType GenesisDelegateKey
-> Maybe String -> ReadM (Hash GenesisDelegateKey)
forall a.
SerialiseAsRawBytes (Hash a) =>
AsType a -> Maybe String -> ReadM (Hash a)
rHexHash AsType GenesisDelegateKey
AsGenesisDelegateKey (String -> Maybe String
forall a. a -> Maybe a
Just String
"Invalid genesis delegate verification key hash")

pGenesisDelegateVerificationKeyOrFile
  :: Parser (VerificationKeyOrFile GenesisDelegateKey)
pGenesisDelegateVerificationKeyOrFile :: Parser (VerificationKeyOrFile GenesisDelegateKey)
pGenesisDelegateVerificationKeyOrFile =
  [Parser (VerificationKeyOrFile GenesisDelegateKey)]
-> Parser (VerificationKeyOrFile GenesisDelegateKey)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ VerificationKey GenesisDelegateKey
-> VerificationKeyOrFile GenesisDelegateKey
forall keyrole.
VerificationKey keyrole -> VerificationKeyOrFile keyrole
VerificationKeyValue (VerificationKey GenesisDelegateKey
 -> VerificationKeyOrFile GenesisDelegateKey)
-> Parser (VerificationKey GenesisDelegateKey)
-> Parser (VerificationKeyOrFile GenesisDelegateKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKey GenesisDelegateKey)
pGenesisDelegateVerificationKey
    , VerificationKeyFile 'In -> VerificationKeyOrFile GenesisDelegateKey
forall keyrole.
VerificationKeyFile 'In -> VerificationKeyOrFile keyrole
VerificationKeyFilePath (VerificationKeyFile 'In
 -> VerificationKeyOrFile GenesisDelegateKey)
-> Parser (VerificationKeyFile 'In)
-> Parser (VerificationKeyOrFile GenesisDelegateKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyFile 'In)
pGenesisDelegateVerificationKeyFile
    ]

pGenesisDelegateVerificationKeyOrHashOrFile
  :: Parser (VerificationKeyOrHashOrFile GenesisDelegateKey)
pGenesisDelegateVerificationKeyOrHashOrFile :: Parser (VerificationKeyOrHashOrFile GenesisDelegateKey)
pGenesisDelegateVerificationKeyOrHashOrFile =
  [Parser (VerificationKeyOrHashOrFile GenesisDelegateKey)]
-> Parser (VerificationKeyOrHashOrFile GenesisDelegateKey)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ VerificationKeyOrFile GenesisDelegateKey
-> VerificationKeyOrHashOrFile GenesisDelegateKey
forall keyrole.
VerificationKeyOrFile keyrole
-> VerificationKeyOrHashOrFile keyrole
VerificationKeyOrFile (VerificationKeyOrFile GenesisDelegateKey
 -> VerificationKeyOrHashOrFile GenesisDelegateKey)
-> Parser (VerificationKeyOrFile GenesisDelegateKey)
-> Parser (VerificationKeyOrHashOrFile GenesisDelegateKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyOrFile GenesisDelegateKey)
pGenesisDelegateVerificationKeyOrFile
    , Hash GenesisDelegateKey
-> VerificationKeyOrHashOrFile GenesisDelegateKey
forall keyrole. Hash keyrole -> VerificationKeyOrHashOrFile keyrole
VerificationKeyHash (Hash GenesisDelegateKey
 -> VerificationKeyOrHashOrFile GenesisDelegateKey)
-> Parser (Hash GenesisDelegateKey)
-> Parser (VerificationKeyOrHashOrFile GenesisDelegateKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Hash GenesisDelegateKey)
pGenesisDelegateVerificationKeyHash
    ]

pKesVerificationKeyOrFile :: Parser (VerificationKeyOrFile KesKey)
pKesVerificationKeyOrFile :: Parser (VerificationKeyOrFile KesKey)
pKesVerificationKeyOrFile =
  [Parser (VerificationKeyOrFile KesKey)]
-> Parser (VerificationKeyOrFile KesKey)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ VerificationKey KesKey -> VerificationKeyOrFile KesKey
forall keyrole.
VerificationKey keyrole -> VerificationKeyOrFile keyrole
VerificationKeyValue (VerificationKey KesKey -> VerificationKeyOrFile KesKey)
-> Parser (VerificationKey KesKey)
-> Parser (VerificationKeyOrFile KesKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKey KesKey)
pKesVerificationKey
    , VerificationKeyFile 'In -> VerificationKeyOrFile KesKey
forall keyrole.
VerificationKeyFile 'In -> VerificationKeyOrFile keyrole
VerificationKeyFilePath (VerificationKeyFile 'In -> VerificationKeyOrFile KesKey)
-> Parser (VerificationKeyFile 'In)
-> Parser (VerificationKeyOrFile KesKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyFile 'In)
pKesVerificationKeyFile
    ]

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

  deserialiseVerKey :: String -> Either String (VerificationKey KesKey)
  deserialiseVerKey :: String -> Either String (VerificationKey KesKey)
deserialiseVerKey String
str =
    case AsType (VerificationKey KesKey)
-> Text -> Either Bech32DecodeError (VerificationKey KesKey)
forall a.
SerialiseAsBech32 a =>
AsType a -> Text -> Either Bech32DecodeError a
deserialiseFromBech32 AsType (VerificationKey KesKey)
asType (String -> Text
Text.pack String
str) of
      Right VerificationKey KesKey
res -> VerificationKey KesKey -> Either String (VerificationKey KesKey)
forall a b. b -> Either a b
Right VerificationKey KesKey
res
      -- The input was valid Bech32, but some other error occurred.
      Left err :: Bech32DecodeError
err@(Bech32UnexpectedPrefix Text
_ Set Text
_) -> String -> Either String (VerificationKey KesKey)
forall a b. a -> Either a b
Left (Doc AnsiStyle -> String
docToString (Doc AnsiStyle -> String) -> Doc AnsiStyle -> String
forall a b. (a -> b) -> a -> b
$ Bech32DecodeError -> Doc AnsiStyle
forall e ann. Error e => e -> Doc ann
forall ann. Bech32DecodeError -> Doc ann
prettyError Bech32DecodeError
err)
      Left err :: Bech32DecodeError
err@(Bech32DataPartToBytesError Text
_) -> String -> Either String (VerificationKey KesKey)
forall a b. a -> Either a b
Left (Doc AnsiStyle -> String
docToString (Doc AnsiStyle -> String) -> Doc AnsiStyle -> String
forall a b. (a -> b) -> a -> b
$ Bech32DecodeError -> Doc AnsiStyle
forall e ann. Error e => e -> Doc ann
forall ann. Bech32DecodeError -> Doc ann
prettyError Bech32DecodeError
err)
      Left err :: Bech32DecodeError
err@(Bech32DeserialiseFromBytesError ByteString
_) -> String -> Either String (VerificationKey KesKey)
forall a b. a -> Either a b
Left (Doc AnsiStyle -> String
docToString (Doc AnsiStyle -> String) -> Doc AnsiStyle -> String
forall a b. (a -> b) -> a -> b
$ Bech32DecodeError -> Doc AnsiStyle
forall e ann. Error e => e -> Doc ann
forall ann. Bech32DecodeError -> Doc ann
prettyError Bech32DecodeError
err)
      Left err :: Bech32DecodeError
err@(Bech32WrongPrefix Text
_ Text
_) -> String -> Either String (VerificationKey KesKey)
forall a b. a -> Either a b
Left (Doc AnsiStyle -> String
docToString (Doc AnsiStyle -> String) -> Doc AnsiStyle -> String
forall a b. (a -> b) -> a -> b
$ Bech32DecodeError -> Doc AnsiStyle
forall e ann. Error e => e -> Doc ann
forall ann. Bech32DecodeError -> Doc ann
prettyError Bech32DecodeError
err)
      -- The input was not valid Bech32. Attempt to deserialise it as hex.
      Left (Bech32DecodingError DecodingError
_) ->
        (RawBytesHexError -> String)
-> Either RawBytesHexError (VerificationKey KesKey)
-> Either String (VerificationKey KesKey)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
          (\RawBytesHexError
e -> Doc AnsiStyle -> String
docToString (Doc AnsiStyle -> String) -> Doc AnsiStyle -> String
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Invalid stake pool verification key: " Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> RawBytesHexError -> Doc AnsiStyle
forall e ann. Error e => e -> Doc ann
forall ann. RawBytesHexError -> Doc ann
prettyError RawBytesHexError
e)
          (Either RawBytesHexError (VerificationKey KesKey)
 -> Either String (VerificationKey KesKey))
-> Either RawBytesHexError (VerificationKey KesKey)
-> Either String (VerificationKey KesKey)
forall a b. (a -> b) -> a -> b
$ AsType (VerificationKey KesKey)
-> ByteString -> Either RawBytesHexError (VerificationKey KesKey)
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either RawBytesHexError a
deserialiseFromRawBytesHex AsType (VerificationKey KesKey)
asType (String -> ByteString
BSC.pack String
str)

pKesVerificationKeyFile :: Parser (VerificationKeyFile In)
pKesVerificationKeyFile :: Parser (VerificationKeyFile 'In)
pKesVerificationKeyFile =
  (String -> VerificationKeyFile 'In)
-> Parser String -> Parser (VerificationKeyFile 'In)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> VerificationKeyFile 'In
forall content (direction :: FileDirection).
String -> File content direction
File (Parser String -> Parser (VerificationKeyFile 'In))
-> Parser String -> Parser (VerificationKeyFile 'In)
forall a b. (a -> b) -> a -> b
$
    [Parser String] -> Parser String
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
      [ String -> String -> Parser String
parseFilePath String
"kes-verification-key-file" String
"Filepath of the hot KES verification key."
      , 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
"hot-kes-verification-key-file"
            , Mod OptionFields String
forall (f :: * -> *) a. Mod f a
Opt.internal
            ]
      ]

pTxSubmitFile :: Parser FilePath
pTxSubmitFile :: Parser String
pTxSubmitFile = String -> String -> Parser String
parseFilePath String
"tx-file" String
"Filepath of the transaction you intend to submit."

pTxIn
  :: ShelleyBasedEra era
  -> BalanceTxExecUnits
  -> Parser (TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))
pTxIn :: forall era.
ShelleyBasedEra era
-> BalanceTxExecUnits
-> Parser (TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))
pTxIn ShelleyBasedEra era
sbe BalanceTxExecUnits
balance =
  (,)
    (TxIn
 -> Maybe (ScriptWitnessFiles WitCtxTxIn)
 -> (TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn)))
-> Parser TxIn
-> Parser
     (Maybe (ScriptWitnessFiles WitCtxTxIn)
      -> (TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM TxIn -> Mod OptionFields TxIn -> Parser TxIn
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      (Parser TxIn -> ReadM TxIn
forall a. Parser a -> ReadM a
readerFromParsecParser Parser TxIn
parseTxIn)
      ( String -> Mod OptionFields TxIn
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"tx-in"
          Mod OptionFields TxIn
-> Mod OptionFields TxIn -> Mod OptionFields TxIn
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields TxIn
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"TX-IN"
          Mod OptionFields TxIn
-> Mod OptionFields TxIn -> Mod OptionFields TxIn
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields TxIn
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"TxId#TxIx"
      )
    Parser
  (Maybe (ScriptWitnessFiles WitCtxTxIn)
   -> (TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn)))
-> Parser (Maybe (ScriptWitnessFiles WitCtxTxIn))
-> Parser (TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (ScriptWitnessFiles WitCtxTxIn)
-> Parser (Maybe (ScriptWitnessFiles WitCtxTxIn))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
      ( ShelleyBasedEra era
-> BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxTxIn)
forall era.
ShelleyBasedEra era
-> BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxTxIn)
pPlutusReferenceScriptWitness ShelleyBasedEra era
sbe BalanceTxExecUnits
balance
          Parser (ScriptWitnessFiles WitCtxTxIn)
-> Parser (ScriptWitnessFiles WitCtxTxIn)
-> Parser (ScriptWitnessFiles WitCtxTxIn)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (ScriptWitnessFiles WitCtxTxIn)
pSimpleReferenceSpendingScriptWitess
          Parser (ScriptWitnessFiles WitCtxTxIn)
-> Parser (ScriptWitnessFiles WitCtxTxIn)
-> Parser (ScriptWitnessFiles WitCtxTxIn)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (ScriptWitnessFiles WitCtxTxIn)
pEmbeddedPlutusScriptWitness
      )
 where
  pSimpleReferenceSpendingScriptWitess :: Parser (ScriptWitnessFiles WitCtxTxIn)
  pSimpleReferenceSpendingScriptWitess :: Parser (ScriptWitnessFiles WitCtxTxIn)
pSimpleReferenceSpendingScriptWitess =
    TxIn -> ScriptWitnessFiles WitCtxTxIn
createSimpleReferenceScriptWitnessFiles
      (TxIn -> ScriptWitnessFiles WitCtxTxIn)
-> Parser TxIn -> Parser (ScriptWitnessFiles WitCtxTxIn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser TxIn
pReferenceTxIn String
"simple-script-" String
"simple"
   where
    createSimpleReferenceScriptWitnessFiles
      :: TxIn
      -> ScriptWitnessFiles WitCtxTxIn
    createSimpleReferenceScriptWitnessFiles :: TxIn -> ScriptWitnessFiles WitCtxTxIn
createSimpleReferenceScriptWitnessFiles TxIn
refTxIn =
      let simpleLang :: AnyScriptLanguage
simpleLang = ScriptLanguage SimpleScript' -> AnyScriptLanguage
forall lang. ScriptLanguage lang -> AnyScriptLanguage
AnyScriptLanguage ScriptLanguage SimpleScript'
SimpleScriptLanguage
       in TxIn
-> AnyScriptLanguage
-> Maybe PolicyId
-> ScriptWitnessFiles WitCtxTxIn
forall witctx.
TxIn
-> AnyScriptLanguage -> Maybe PolicyId -> ScriptWitnessFiles witctx
SimpleReferenceScriptWitnessFiles TxIn
refTxIn AnyScriptLanguage
simpleLang Maybe PolicyId
forall a. Maybe a
Nothing

  pPlutusReferenceScriptWitness
    :: ShelleyBasedEra era -> BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxTxIn)
  pPlutusReferenceScriptWitness :: forall era.
ShelleyBasedEra era
-> BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxTxIn)
pPlutusReferenceScriptWitness ShelleyBasedEra era
sbe' BalanceTxExecUnits
autoBalanceExecUnits =
    (ShelleyToBabbageEraConstraints era =>
 ShelleyToBabbageEra era -> Parser (ScriptWitnessFiles WitCtxTxIn))
-> (ConwayEraOnwardsConstraints era =>
    ConwayEraOnwards era -> Parser (ScriptWitnessFiles WitCtxTxIn))
-> ShelleyBasedEra era
-> Parser (ScriptWitnessFiles WitCtxTxIn)
forall era a.
(ShelleyToBabbageEraConstraints era =>
 ShelleyToBabbageEra era -> a)
-> (ConwayEraOnwardsConstraints era => ConwayEraOnwards era -> a)
-> ShelleyBasedEra era
-> a
caseShelleyToBabbageOrConwayEraOnwards
      ( Parser (ScriptWitnessFiles WitCtxTxIn)
-> ShelleyToBabbageEra era
-> Parser (ScriptWitnessFiles WitCtxTxIn)
forall a b. a -> b -> a
const (Parser (ScriptWitnessFiles WitCtxTxIn)
 -> ShelleyToBabbageEra era
 -> Parser (ScriptWitnessFiles WitCtxTxIn))
-> Parser (ScriptWitnessFiles WitCtxTxIn)
-> ShelleyToBabbageEra era
-> Parser (ScriptWitnessFiles WitCtxTxIn)
forall a b. (a -> b) -> a -> b
$
          TxIn
-> AnyScriptLanguage
-> ScriptDatumOrFile WitCtxTxIn
-> ScriptRedeemerOrFile
-> ExecutionUnits
-> ScriptWitnessFiles WitCtxTxIn
createPlutusReferenceScriptWitnessFiles
            (TxIn
 -> AnyScriptLanguage
 -> ScriptDatumOrFile WitCtxTxIn
 -> ScriptRedeemerOrFile
 -> ExecutionUnits
 -> ScriptWitnessFiles WitCtxTxIn)
-> Parser TxIn
-> Parser
     (AnyScriptLanguage
      -> ScriptDatumOrFile WitCtxTxIn
      -> ScriptRedeemerOrFile
      -> ExecutionUnits
      -> ScriptWitnessFiles WitCtxTxIn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser TxIn
pReferenceTxIn String
"spending-" String
"plutus"
            Parser
  (AnyScriptLanguage
   -> ScriptDatumOrFile WitCtxTxIn
   -> ScriptRedeemerOrFile
   -> ExecutionUnits
   -> ScriptWitnessFiles WitCtxTxIn)
-> Parser AnyScriptLanguage
-> Parser
     (ScriptDatumOrFile WitCtxTxIn
      -> ScriptRedeemerOrFile
      -> ExecutionUnits
      -> ScriptWitnessFiles WitCtxTxIn)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Parser AnyScriptLanguage
pPlutusScriptLanguage String
"spending-"
            Parser
  (ScriptDatumOrFile WitCtxTxIn
   -> ScriptRedeemerOrFile
   -> ExecutionUnits
   -> ScriptWitnessFiles WitCtxTxIn)
-> Parser (ScriptDatumOrFile WitCtxTxIn)
-> Parser
     (ScriptRedeemerOrFile
      -> ExecutionUnits -> ScriptWitnessFiles WitCtxTxIn)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> WitCtx WitCtxTxIn -> Parser (ScriptDatumOrFile WitCtxTxIn)
forall witctx.
String -> WitCtx witctx -> Parser (ScriptDatumOrFile witctx)
pScriptDatumOrFile String
"spending-reference-tx-in" WitCtx WitCtxTxIn
WitCtxTxIn
            Parser
  (ScriptRedeemerOrFile
   -> ExecutionUnits -> ScriptWitnessFiles WitCtxTxIn)
-> Parser ScriptRedeemerOrFile
-> Parser (ExecutionUnits -> ScriptWitnessFiles WitCtxTxIn)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Parser ScriptRedeemerOrFile
pScriptRedeemerOrFile String
"spending-reference-tx-in"
            Parser (ExecutionUnits -> ScriptWitnessFiles WitCtxTxIn)
-> Parser ExecutionUnits -> Parser (ScriptWitnessFiles WitCtxTxIn)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( case BalanceTxExecUnits
autoBalanceExecUnits of
                    BalanceTxExecUnits
AutoBalance -> ExecutionUnits -> Parser ExecutionUnits
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> Natural -> ExecutionUnits
ExecutionUnits Natural
0 Natural
0)
                    BalanceTxExecUnits
ManualBalance -> String -> Parser ExecutionUnits
pExecutionUnits String
"spending-reference-tx-in"
                )
      )
      ( Parser (ScriptWitnessFiles WitCtxTxIn)
-> ConwayEraOnwards era -> Parser (ScriptWitnessFiles WitCtxTxIn)
forall a b. a -> b -> a
const (Parser (ScriptWitnessFiles WitCtxTxIn)
 -> ConwayEraOnwards era -> Parser (ScriptWitnessFiles WitCtxTxIn))
-> Parser (ScriptWitnessFiles WitCtxTxIn)
-> ConwayEraOnwards era
-> Parser (ScriptWitnessFiles WitCtxTxIn)
forall a b. (a -> b) -> a -> b
$
          TxIn
-> AnyScriptLanguage
-> ScriptDatumOrFile WitCtxTxIn
-> ScriptRedeemerOrFile
-> ExecutionUnits
-> ScriptWitnessFiles WitCtxTxIn
createPlutusReferenceScriptWitnessFiles
            (TxIn
 -> AnyScriptLanguage
 -> ScriptDatumOrFile WitCtxTxIn
 -> ScriptRedeemerOrFile
 -> ExecutionUnits
 -> ScriptWitnessFiles WitCtxTxIn)
-> Parser TxIn
-> Parser
     (AnyScriptLanguage
      -> ScriptDatumOrFile WitCtxTxIn
      -> ScriptRedeemerOrFile
      -> ExecutionUnits
      -> ScriptWitnessFiles WitCtxTxIn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser TxIn
pReferenceTxIn String
"spending-" String
"plutus"
            Parser
  (AnyScriptLanguage
   -> ScriptDatumOrFile WitCtxTxIn
   -> ScriptRedeemerOrFile
   -> ExecutionUnits
   -> ScriptWitnessFiles WitCtxTxIn)
-> Parser AnyScriptLanguage
-> Parser
     (ScriptDatumOrFile WitCtxTxIn
      -> ScriptRedeemerOrFile
      -> ExecutionUnits
      -> ScriptWitnessFiles WitCtxTxIn)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Parser AnyScriptLanguage
pPlutusScriptLanguage String
"spending-"
            Parser
  (ScriptDatumOrFile WitCtxTxIn
   -> ScriptRedeemerOrFile
   -> ExecutionUnits
   -> ScriptWitnessFiles WitCtxTxIn)
-> Parser (ScriptDatumOrFile WitCtxTxIn)
-> Parser
     (ScriptRedeemerOrFile
      -> ExecutionUnits -> ScriptWitnessFiles WitCtxTxIn)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> WitCtx WitCtxTxIn -> Parser (ScriptDatumOrFile WitCtxTxIn)
forall witctx.
String -> WitCtx witctx -> Parser (ScriptDatumOrFile witctx)
pScriptDatumOrFileCip69 String
"spending-reference-tx-in" WitCtx WitCtxTxIn
WitCtxTxIn
            Parser
  (ScriptRedeemerOrFile
   -> ExecutionUnits -> ScriptWitnessFiles WitCtxTxIn)
-> Parser ScriptRedeemerOrFile
-> Parser (ExecutionUnits -> ScriptWitnessFiles WitCtxTxIn)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Parser ScriptRedeemerOrFile
pScriptRedeemerOrFile String
"spending-reference-tx-in"
            Parser (ExecutionUnits -> ScriptWitnessFiles WitCtxTxIn)
-> Parser ExecutionUnits -> Parser (ScriptWitnessFiles WitCtxTxIn)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( case BalanceTxExecUnits
autoBalanceExecUnits of
                    BalanceTxExecUnits
AutoBalance -> ExecutionUnits -> Parser ExecutionUnits
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> Natural -> ExecutionUnits
ExecutionUnits Natural
0 Natural
0)
                    BalanceTxExecUnits
ManualBalance -> String -> Parser ExecutionUnits
pExecutionUnits String
"spending-reference-tx-in"
                )
      )
      ShelleyBasedEra era
sbe'
   where
    createPlutusReferenceScriptWitnessFiles
      :: TxIn
      -> AnyScriptLanguage
      -> ScriptDatumOrFile WitCtxTxIn
      -> ScriptRedeemerOrFile
      -> ExecutionUnits
      -> ScriptWitnessFiles WitCtxTxIn
    createPlutusReferenceScriptWitnessFiles :: TxIn
-> AnyScriptLanguage
-> ScriptDatumOrFile WitCtxTxIn
-> ScriptRedeemerOrFile
-> ExecutionUnits
-> ScriptWitnessFiles WitCtxTxIn
createPlutusReferenceScriptWitnessFiles TxIn
refIn AnyScriptLanguage
sLang ScriptDatumOrFile WitCtxTxIn
sDatum ScriptRedeemerOrFile
sRedeemer ExecutionUnits
execUnits =
      TxIn
-> AnyScriptLanguage
-> ScriptDatumOrFile WitCtxTxIn
-> ScriptRedeemerOrFile
-> ExecutionUnits
-> Maybe PolicyId
-> ScriptWitnessFiles WitCtxTxIn
forall witctx.
TxIn
-> AnyScriptLanguage
-> ScriptDatumOrFile witctx
-> ScriptRedeemerOrFile
-> ExecutionUnits
-> Maybe PolicyId
-> ScriptWitnessFiles witctx
PlutusReferenceScriptWitnessFiles TxIn
refIn AnyScriptLanguage
sLang ScriptDatumOrFile WitCtxTxIn
sDatum ScriptRedeemerOrFile
sRedeemer ExecutionUnits
execUnits Maybe PolicyId
forall a. Maybe a
Nothing

  pEmbeddedPlutusScriptWitness :: Parser (ScriptWitnessFiles WitCtxTxIn)
  pEmbeddedPlutusScriptWitness :: Parser (ScriptWitnessFiles WitCtxTxIn)
pEmbeddedPlutusScriptWitness =
    ShelleyBasedEra era
-> WitCtx WitCtxTxIn
-> BalanceTxExecUnits
-> String
-> Maybe String
-> String
-> Parser (ScriptWitnessFiles WitCtxTxIn)
forall witctx era.
ShelleyBasedEra era
-> WitCtx witctx
-> BalanceTxExecUnits
-> String
-> Maybe String
-> String
-> Parser (ScriptWitnessFiles witctx)
pScriptWitnessFiles
      ShelleyBasedEra era
sbe
      WitCtx WitCtxTxIn
WitCtxTxIn
      BalanceTxExecUnits
balance
      String
"tx-in"
      (String -> Maybe String
forall a. a -> Maybe a
Just String
"txin")
      String
"the spending of the transaction input."

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

pReturnCollateral :: Parser TxOutShelleyBasedEra
pReturnCollateral :: Parser TxOutShelleyBasedEra
pReturnCollateral =
  ReadM
  (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutShelleyBasedEra)
-> Mod
     OptionFields
     (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutShelleyBasedEra)
-> Parser
     (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutShelleyBasedEra)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
    (Parser
  (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutShelleyBasedEra)
-> ReadM
     (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutShelleyBasedEra)
forall a. Parser a -> ReadM a
readerFromParsecParser Parser
  (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutShelleyBasedEra)
parseTxOutShelleyBasedEra)
    ( [Mod
   OptionFields
   (TxOutDatumAnyEra
    -> ReferenceScriptAnyEra -> TxOutShelleyBasedEra)]
-> Mod
     OptionFields
     (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutShelleyBasedEra)
forall a. Monoid a => [a] -> a
mconcat
        [ String
-> Mod
     OptionFields
     (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutShelleyBasedEra)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"tx-out-return-collateral"
        , String
-> Mod
     OptionFields
     (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutShelleyBasedEra)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"ADDRESS VALUE"
        , -- TODO alonzo: Update the help text to describe the new syntax as well.
          String
-> Mod
     OptionFields
     (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutShelleyBasedEra)
forall (f :: * -> *) a. String -> Mod f a
Opt.help
            ( String
"The transaction output as ADDRESS VALUE where ADDRESS is "
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"the Bech32-encoded address followed by the value in "
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"Lovelace. In the situation where your collateral txin "
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"over collateralizes the transaction, you can optionally "
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"specify a tx out of your choosing to return the excess Lovelace."
            )
        ]
    )
    Parser
  (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutShelleyBasedEra)
-> Parser TxOutDatumAnyEra
-> Parser (ReferenceScriptAnyEra -> TxOutShelleyBasedEra)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TxOutDatumAnyEra -> Parser TxOutDatumAnyEra
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TxOutDatumAnyEra
TxOutDatumByNone -- TODO: Babbage era - we should be able to return these
    Parser (ReferenceScriptAnyEra -> TxOutShelleyBasedEra)
-> Parser ReferenceScriptAnyEra -> Parser TxOutShelleyBasedEra
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReferenceScriptAnyEra -> Parser ReferenceScriptAnyEra
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReferenceScriptAnyEra
ReferenceScriptAnyEraNone -- TODO: Babbage era - we should be able to return these

pTotalCollateral :: Parser Lovelace
pTotalCollateral :: Parser Lovelace
pTotalCollateral =
  ReadM Lovelace -> Mod OptionFields Lovelace -> Parser Lovelace
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Integer -> Lovelace
L.Coin (Integer -> Lovelace) -> ReadM Integer -> ReadM Lovelace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Integer -> ReadM Integer
forall a. Parser a -> ReadM a
readerFromParsecParser ParsecT String () Identity Integer
decimal) (Mod OptionFields Lovelace -> Parser Lovelace)
-> Mod OptionFields Lovelace -> Parser Lovelace
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Lovelace] -> Mod OptionFields Lovelace
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"tx-total-collateral"
      , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"INTEGER"
      , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod OptionFields Lovelace)
-> String -> Mod OptionFields Lovelace
forall a b. (a -> b) -> a -> b
$
          [String] -> String
forall a. Monoid a => [a] -> a
mconcat
            [ String
"The total amount of collateral that will be collected "
            , String
"as fees in the event of a Plutus script failure. Must be used "
            , String
"in conjuction with \"--tx-out-return-collateral\"."
            ]
      ]

pWitnessOverride :: Parser Word
pWitnessOverride :: Parser Word
pWitnessOverride =
  ReadM Word -> Mod OptionFields Word -> Parser Word
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word
forall a. (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
"witness-override"
      , String -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"WORD"
      , String -> Mod OptionFields Word
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Specify and override the number of witnesses the transaction requires."
      ]

pNumberOfShelleyKeyWitnesses :: Parser Int
pNumberOfShelleyKeyWitnesses :: Parser Int
pNumberOfShelleyKeyWitnesses =
  ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Int
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader (Mod OptionFields Int -> Parser Int)
-> Mod OptionFields Int -> Parser Int
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Int] -> Mod OptionFields Int
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"shelley-key-witnesses"
      , String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"INT"
      , String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Specify the number of Shelley key witnesses the transaction requires."
      ]

pNumberOfByronKeyWitnesses :: Parser Int
pNumberOfByronKeyWitnesses :: Parser Int
pNumberOfByronKeyWitnesses =
  ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Int
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader (Mod OptionFields Int -> Parser Int)
-> Mod OptionFields Int -> Parser Int
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Int] -> Mod OptionFields Int
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"byron-key-witnesses"
      , String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"Int"
      , String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Specify the number of Byron key witnesses the transaction requires."
      ]

pTotalUTxOValue :: Parser Value
pTotalUTxOValue :: Parser Value
pTotalUTxOValue =
  ReadM Value -> Mod OptionFields Value -> Parser Value
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser Value -> ReadM Value
forall a. Parser a -> ReadM a
readerFromParsecParser Parser Value
parseValue) (Mod OptionFields Value -> Parser Value)
-> Mod OptionFields Value -> Parser Value
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Value] -> Mod OptionFields Value
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields Value
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"total-utxo-value"
      , String -> Mod OptionFields Value
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"VALUE"
      , String -> Mod OptionFields Value
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The total value of the UTxO that exists at the tx inputs being spent."
      ]

pTxOut :: Parser TxOutAnyEra
pTxOut :: Parser TxOutAnyEra
pTxOut =
  ReadM (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutAnyEra)
-> Mod
     OptionFields
     (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutAnyEra)
-> Parser
     (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutAnyEra)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
    (Parser (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutAnyEra)
-> ReadM (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutAnyEra)
forall a. Parser a -> ReadM a
readerFromParsecParser Parser (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutAnyEra)
parseTxOutAnyEra)
    ( String
-> Mod
     OptionFields
     (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutAnyEra)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"tx-out"
        Mod
  OptionFields
  (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutAnyEra)
-> Mod
     OptionFields
     (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutAnyEra)
-> Mod
     OptionFields
     (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutAnyEra)
forall a. Semigroup a => a -> a -> a
<> String
-> Mod
     OptionFields
     (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutAnyEra)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"ADDRESS VALUE"
        -- TODO alonzo: Update the help text to describe the new syntax as well.
        Mod
  OptionFields
  (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutAnyEra)
-> Mod
     OptionFields
     (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutAnyEra)
-> Mod
     OptionFields
     (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutAnyEra)
forall a. Semigroup a => a -> a -> a
<> String
-> Mod
     OptionFields
     (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutAnyEra)
forall (f :: * -> *) a. String -> Mod f a
Opt.help
          String
"The transaction output as ADDRESS VALUE where ADDRESS is \
          \the Bech32-encoded address followed by the value in \
          \the multi-asset syntax (including simply Lovelace)."
    )
    Parser (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutAnyEra)
-> Parser TxOutDatumAnyEra
-> Parser (ReferenceScriptAnyEra -> TxOutAnyEra)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TxOutDatumAnyEra
pTxOutDatum
    Parser (ReferenceScriptAnyEra -> TxOutAnyEra)
-> Parser ReferenceScriptAnyEra -> Parser TxOutAnyEra
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ReferenceScriptAnyEra
pRefScriptFp

pTxOutShelleyBased :: Parser TxOutShelleyBasedEra
pTxOutShelleyBased :: Parser TxOutShelleyBasedEra
pTxOutShelleyBased =
  ReadM
  (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutShelleyBasedEra)
-> Mod
     OptionFields
     (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutShelleyBasedEra)
-> Parser
     (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutShelleyBasedEra)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
    (Parser
  (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutShelleyBasedEra)
-> ReadM
     (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutShelleyBasedEra)
forall a. Parser a -> ReadM a
readerFromParsecParser Parser
  (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutShelleyBasedEra)
parseTxOutShelleyBasedEra)
    ( String
-> Mod
     OptionFields
     (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutShelleyBasedEra)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"tx-out"
        Mod
  OptionFields
  (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutShelleyBasedEra)
-> Mod
     OptionFields
     (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutShelleyBasedEra)
-> Mod
     OptionFields
     (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutShelleyBasedEra)
forall a. Semigroup a => a -> a -> a
<> String
-> Mod
     OptionFields
     (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutShelleyBasedEra)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"ADDRESS VALUE"
        -- TODO alonzo: Update the help text to describe the new syntax as well.
        Mod
  OptionFields
  (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutShelleyBasedEra)
-> Mod
     OptionFields
     (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutShelleyBasedEra)
-> Mod
     OptionFields
     (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutShelleyBasedEra)
forall a. Semigroup a => a -> a -> a
<> String
-> Mod
     OptionFields
     (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutShelleyBasedEra)
forall (f :: * -> *) a. String -> Mod f a
Opt.help
          String
"The transaction output as ADDRESS VALUE where ADDRESS is \
          \the Bech32-encoded address followed by the value in \
          \the multi-asset syntax (including simply Lovelace)."
    )
    Parser
  (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutShelleyBasedEra)
-> Parser TxOutDatumAnyEra
-> Parser (ReferenceScriptAnyEra -> TxOutShelleyBasedEra)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TxOutDatumAnyEra
pTxOutDatum
    Parser (ReferenceScriptAnyEra -> TxOutShelleyBasedEra)
-> Parser ReferenceScriptAnyEra -> Parser TxOutShelleyBasedEra
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ReferenceScriptAnyEra
pRefScriptFp

pTxOutDatum :: Parser TxOutDatumAnyEra
pTxOutDatum :: Parser TxOutDatumAnyEra
pTxOutDatum =
  Parser TxOutDatumAnyEra
pTxOutDatumByHashOnly
    Parser TxOutDatumAnyEra
-> Parser TxOutDatumAnyEra -> Parser TxOutDatumAnyEra
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TxOutDatumAnyEra
pTxOutDatumByHashOf
    Parser TxOutDatumAnyEra
-> Parser TxOutDatumAnyEra -> Parser TxOutDatumAnyEra
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TxOutDatumAnyEra
pTxOutDatumByValue
    Parser TxOutDatumAnyEra
-> Parser TxOutDatumAnyEra -> Parser TxOutDatumAnyEra
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TxOutDatumAnyEra
pTxOutInlineDatumByValue
    Parser TxOutDatumAnyEra
-> Parser TxOutDatumAnyEra -> Parser TxOutDatumAnyEra
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TxOutDatumAnyEra -> Parser TxOutDatumAnyEra
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TxOutDatumAnyEra
TxOutDatumByNone
 where
  pTxOutDatumByHashOnly :: Parser TxOutDatumAnyEra
pTxOutDatumByHashOnly =
    (Hash ScriptData -> TxOutDatumAnyEra)
-> Parser (Hash ScriptData) -> Parser TxOutDatumAnyEra
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Hash ScriptData -> TxOutDatumAnyEra
TxOutDatumByHashOnly (Parser (Hash ScriptData) -> Parser TxOutDatumAnyEra)
-> Parser (Hash ScriptData) -> Parser TxOutDatumAnyEra
forall a b. (a -> b) -> a -> b
$
      ReadM (Hash ScriptData)
-> Mod OptionFields (Hash ScriptData) -> Parser (Hash ScriptData)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser (Hash ScriptData) -> ReadM (Hash ScriptData)
forall a. Parser a -> ReadM a
readerFromParsecParser (Parser (Hash ScriptData) -> ReadM (Hash ScriptData))
-> Parser (Hash ScriptData) -> ReadM (Hash ScriptData)
forall a b. (a -> b) -> a -> b
$ AsType (Hash ScriptData) -> Parser (Hash ScriptData)
forall a.
SerialiseAsRawBytes (Hash a) =>
AsType (Hash a) -> Parser (Hash a)
parseHash (AsType ScriptData -> AsType (Hash ScriptData)
forall a. AsType a -> AsType (Hash a)
AsHash AsType ScriptData
AsScriptData)) (Mod OptionFields (Hash ScriptData) -> Parser (Hash ScriptData))
-> Mod OptionFields (Hash ScriptData) -> Parser (Hash ScriptData)
forall a b. (a -> b) -> a -> b
$
        [Mod OptionFields (Hash ScriptData)]
-> Mod OptionFields (Hash ScriptData)
forall a. Monoid a => [a] -> a
mconcat
          [ String -> Mod OptionFields (Hash ScriptData)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"tx-out-datum-hash"
          , String -> Mod OptionFields (Hash ScriptData)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"HASH"
          , String -> Mod OptionFields (Hash ScriptData)
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod OptionFields (Hash ScriptData))
-> String -> Mod OptionFields (Hash ScriptData)
forall a b. (a -> b) -> a -> b
$
              [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                [ String
"The script datum hash for this tx output, as "
                , String
"the raw datum hash (in hex)."
                ]
          ]

  pTxOutDatumByHashOf :: Parser TxOutDatumAnyEra
pTxOutDatumByHashOf =
    ScriptRedeemerOrFile -> TxOutDatumAnyEra
TxOutDatumByHashOf
      (ScriptRedeemerOrFile -> TxOutDatumAnyEra)
-> Parser ScriptRedeemerOrFile -> Parser TxOutDatumAnyEra
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> String -> Parser ScriptRedeemerOrFile
pScriptDataOrFile
        String
"tx-out-datum-hash"
        String
"The script datum hash for this tx output, by hashing the script datum given here."
        String
"The script datum hash for this tx output, by hashing the script datum in the file."

  pTxOutDatumByValue :: Parser TxOutDatumAnyEra
pTxOutDatumByValue =
    ScriptRedeemerOrFile -> TxOutDatumAnyEra
TxOutDatumByValue
      (ScriptRedeemerOrFile -> TxOutDatumAnyEra)
-> Parser ScriptRedeemerOrFile -> Parser TxOutDatumAnyEra
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> String -> Parser ScriptRedeemerOrFile
pScriptDataOrFile
        String
"tx-out-datum-embed"
        String
"The script datum to embed in the tx for this output, given here."
        String
"The script datum to embed in the tx for this output, in the given file."

  pTxOutInlineDatumByValue :: Parser TxOutDatumAnyEra
pTxOutInlineDatumByValue =
    ScriptRedeemerOrFile -> TxOutDatumAnyEra
TxOutInlineDatumByValue
      (ScriptRedeemerOrFile -> TxOutDatumAnyEra)
-> Parser ScriptRedeemerOrFile -> Parser TxOutDatumAnyEra
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> String -> Parser ScriptRedeemerOrFile
pScriptDataOrFile
        String
"tx-out-inline-datum"
        String
"The script datum to embed in the tx output as an inline datum, given here."
        String
"The script datum to embed in the tx output as an inline datum, in the given file."

pRefScriptFp :: Parser ReferenceScriptAnyEra
pRefScriptFp :: Parser ReferenceScriptAnyEra
pRefScriptFp =
  String -> ReferenceScriptAnyEra
ReferenceScriptAnyEra
    (String -> ReferenceScriptAnyEra)
-> Parser String -> Parser ReferenceScriptAnyEra
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser String
parseFilePath String
"tx-out-reference-script-file" String
"Reference script input file."
      Parser ReferenceScriptAnyEra
-> Parser ReferenceScriptAnyEra -> Parser ReferenceScriptAnyEra
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ReferenceScriptAnyEra -> Parser ReferenceScriptAnyEra
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReferenceScriptAnyEra
ReferenceScriptAnyEraNone

pMintMultiAsset
  :: ShelleyBasedEra era
  -> BalanceTxExecUnits
  -> Parser (Value, [ScriptWitnessFiles WitCtxMint])
pMintMultiAsset :: forall era.
ShelleyBasedEra era
-> BalanceTxExecUnits
-> Parser (Value, [ScriptWitnessFiles WitCtxMint])
pMintMultiAsset ShelleyBasedEra era
sbe BalanceTxExecUnits
balanceExecUnits =
  (,)
    (Value
 -> [ScriptWitnessFiles WitCtxMint]
 -> (Value, [ScriptWitnessFiles WitCtxMint]))
-> Parser Value
-> Parser
     ([ScriptWitnessFiles WitCtxMint]
      -> (Value, [ScriptWitnessFiles WitCtxMint]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Value -> Mod OptionFields Value -> Parser Value
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      (Parser Value -> ReadM Value
forall a. Parser a -> ReadM a
readerFromParsecParser Parser Value
parseValue)
      ( String -> Mod OptionFields Value
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"mint"
          Mod OptionFields Value
-> Mod OptionFields Value -> Mod OptionFields Value
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Value
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"VALUE"
          Mod OptionFields Value
-> Mod OptionFields Value -> Mod OptionFields Value
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Value
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
helpText
      )
    Parser
  ([ScriptWitnessFiles WitCtxMint]
   -> (Value, [ScriptWitnessFiles WitCtxMint]))
-> Parser [ScriptWitnessFiles WitCtxMint]
-> Parser (Value, [ScriptWitnessFiles WitCtxMint])
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (ScriptWitnessFiles WitCtxMint)
-> Parser [ScriptWitnessFiles WitCtxMint]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some
      ( BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxMint)
pMintingScriptOrReferenceScriptWit BalanceTxExecUnits
balanceExecUnits
          Parser (ScriptWitnessFiles WitCtxMint)
-> Parser (ScriptWitnessFiles WitCtxMint)
-> Parser (ScriptWitnessFiles WitCtxMint)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (ScriptWitnessFiles WitCtxMint)
pSimpleReferenceMintingScriptWitness
          Parser (ScriptWitnessFiles WitCtxMint)
-> Parser (ScriptWitnessFiles WitCtxMint)
-> Parser (ScriptWitnessFiles WitCtxMint)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxMint)
pPlutusMintReferenceScriptWitnessFiles BalanceTxExecUnits
balanceExecUnits
      )
 where
  pMintingScriptOrReferenceScriptWit
    :: BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxMint)
  pMintingScriptOrReferenceScriptWit :: BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxMint)
pMintingScriptOrReferenceScriptWit BalanceTxExecUnits
bExecUnits =
    ShelleyBasedEra era
-> WitCtx WitCtxMint
-> BalanceTxExecUnits
-> String
-> Maybe String
-> String
-> Parser (ScriptWitnessFiles WitCtxMint)
forall witctx era.
ShelleyBasedEra era
-> WitCtx witctx
-> BalanceTxExecUnits
-> String
-> Maybe String
-> String
-> Parser (ScriptWitnessFiles witctx)
pScriptWitnessFiles
      ShelleyBasedEra era
sbe
      WitCtx WitCtxMint
WitCtxMint
      BalanceTxExecUnits
bExecUnits
      String
"mint"
      (String -> Maybe String
forall a. a -> Maybe a
Just String
"minting")
      String
"the minting of assets for a particular policy Id."

  pSimpleReferenceMintingScriptWitness :: Parser (ScriptWitnessFiles WitCtxMint)
  pSimpleReferenceMintingScriptWitness :: Parser (ScriptWitnessFiles WitCtxMint)
pSimpleReferenceMintingScriptWitness =
    TxIn -> PolicyId -> ScriptWitnessFiles WitCtxMint
createSimpleMintingReferenceScriptWitnessFiles
      (TxIn -> PolicyId -> ScriptWitnessFiles WitCtxMint)
-> Parser TxIn
-> Parser (PolicyId -> ScriptWitnessFiles WitCtxMint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser TxIn
pReferenceTxIn String
"simple-minting-script-" String
"simple"
      Parser (PolicyId -> ScriptWitnessFiles WitCtxMint)
-> Parser PolicyId -> Parser (ScriptWitnessFiles WitCtxMint)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser PolicyId
pPolicyId
   where
    createSimpleMintingReferenceScriptWitnessFiles
      :: TxIn
      -> PolicyId
      -> ScriptWitnessFiles WitCtxMint
    createSimpleMintingReferenceScriptWitnessFiles :: TxIn -> PolicyId -> ScriptWitnessFiles WitCtxMint
createSimpleMintingReferenceScriptWitnessFiles TxIn
refTxIn PolicyId
pid =
      let simpleLang :: AnyScriptLanguage
simpleLang = ScriptLanguage SimpleScript' -> AnyScriptLanguage
forall lang. ScriptLanguage lang -> AnyScriptLanguage
AnyScriptLanguage ScriptLanguage SimpleScript'
SimpleScriptLanguage
       in TxIn
-> AnyScriptLanguage
-> Maybe PolicyId
-> ScriptWitnessFiles WitCtxMint
forall witctx.
TxIn
-> AnyScriptLanguage -> Maybe PolicyId -> ScriptWitnessFiles witctx
SimpleReferenceScriptWitnessFiles TxIn
refTxIn AnyScriptLanguage
simpleLang (PolicyId -> Maybe PolicyId
forall a. a -> Maybe a
Just PolicyId
pid)

  pPlutusMintReferenceScriptWitnessFiles
    :: BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxMint)
  pPlutusMintReferenceScriptWitnessFiles :: BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxMint)
pPlutusMintReferenceScriptWitnessFiles BalanceTxExecUnits
autoBalanceExecUnits =
    TxIn
-> AnyScriptLanguage
-> ScriptDatumOrFile WitCtxMint
-> ScriptRedeemerOrFile
-> ExecutionUnits
-> Maybe PolicyId
-> ScriptWitnessFiles WitCtxMint
forall witctx.
TxIn
-> AnyScriptLanguage
-> ScriptDatumOrFile witctx
-> ScriptRedeemerOrFile
-> ExecutionUnits
-> Maybe PolicyId
-> ScriptWitnessFiles witctx
PlutusReferenceScriptWitnessFiles
      (TxIn
 -> AnyScriptLanguage
 -> ScriptDatumOrFile WitCtxMint
 -> ScriptRedeemerOrFile
 -> ExecutionUnits
 -> Maybe PolicyId
 -> ScriptWitnessFiles WitCtxMint)
-> Parser TxIn
-> Parser
     (AnyScriptLanguage
      -> ScriptDatumOrFile WitCtxMint
      -> ScriptRedeemerOrFile
      -> ExecutionUnits
      -> Maybe PolicyId
      -> ScriptWitnessFiles WitCtxMint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser TxIn
pReferenceTxIn String
"mint-" String
"plutus"
      Parser
  (AnyScriptLanguage
   -> ScriptDatumOrFile WitCtxMint
   -> ScriptRedeemerOrFile
   -> ExecutionUnits
   -> Maybe PolicyId
   -> ScriptWitnessFiles WitCtxMint)
-> Parser AnyScriptLanguage
-> Parser
     (ScriptDatumOrFile WitCtxMint
      -> ScriptRedeemerOrFile
      -> ExecutionUnits
      -> Maybe PolicyId
      -> ScriptWitnessFiles WitCtxMint)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Parser AnyScriptLanguage
pPlutusScriptLanguage String
"mint-"
      Parser
  (ScriptDatumOrFile WitCtxMint
   -> ScriptRedeemerOrFile
   -> ExecutionUnits
   -> Maybe PolicyId
   -> ScriptWitnessFiles WitCtxMint)
-> Parser (ScriptDatumOrFile WitCtxMint)
-> Parser
     (ScriptRedeemerOrFile
      -> ExecutionUnits
      -> Maybe PolicyId
      -> ScriptWitnessFiles WitCtxMint)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ScriptDatumOrFile WitCtxMint
-> Parser (ScriptDatumOrFile WitCtxMint)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScriptDatumOrFile WitCtxMint
NoScriptDatumOrFileForMint
      Parser
  (ScriptRedeemerOrFile
   -> ExecutionUnits
   -> Maybe PolicyId
   -> ScriptWitnessFiles WitCtxMint)
-> Parser ScriptRedeemerOrFile
-> Parser
     (ExecutionUnits -> Maybe PolicyId -> ScriptWitnessFiles WitCtxMint)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Parser ScriptRedeemerOrFile
pScriptRedeemerOrFile String
"mint-reference-tx-in"
      Parser
  (ExecutionUnits -> Maybe PolicyId -> ScriptWitnessFiles WitCtxMint)
-> Parser ExecutionUnits
-> Parser (Maybe PolicyId -> ScriptWitnessFiles WitCtxMint)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( case BalanceTxExecUnits
autoBalanceExecUnits of
              BalanceTxExecUnits
AutoBalance -> ExecutionUnits -> Parser ExecutionUnits
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> Natural -> ExecutionUnits
ExecutionUnits Natural
0 Natural
0)
              BalanceTxExecUnits
ManualBalance -> String -> Parser ExecutionUnits
pExecutionUnits String
"mint-reference-tx-in"
          )
      Parser (Maybe PolicyId -> ScriptWitnessFiles WitCtxMint)
-> Parser (Maybe PolicyId)
-> Parser (ScriptWitnessFiles WitCtxMint)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (PolicyId -> Maybe PolicyId
forall a. a -> Maybe a
Just (PolicyId -> Maybe PolicyId)
-> Parser PolicyId -> Parser (Maybe PolicyId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PolicyId
pPolicyId)

  helpText :: String
helpText =
    [String] -> String
forall a. Monoid a => [a] -> a
mconcat
      [ String
"Mint multi-asset value(s) with the multi-asset cli syntax. "
      , String
"You must specify a script witness."
      ]

pPolicyId :: Parser PolicyId
pPolicyId :: Parser PolicyId
pPolicyId =
  ReadM PolicyId -> Mod OptionFields PolicyId -> Parser PolicyId
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser PolicyId -> ReadM PolicyId
forall a. Parser a -> ReadM a
readerFromParsecParser Parser PolicyId
policyId) (Mod OptionFields PolicyId -> Parser PolicyId)
-> Mod OptionFields PolicyId -> Parser PolicyId
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields PolicyId] -> Mod OptionFields PolicyId
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields PolicyId
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"policy-id"
      , String -> Mod OptionFields PolicyId
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"HASH"
      , String -> Mod OptionFields PolicyId
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Policy id of minting script."
      ]

pInvalidBefore :: Parser SlotNo
pInvalidBefore :: Parser SlotNo
pInvalidBefore =
  (Word64 -> SlotNo) -> Parser Word64 -> Parser SlotNo
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> SlotNo
SlotNo (Parser Word64 -> Parser SlotNo) -> Parser Word64 -> Parser SlotNo
forall a b. (a -> b) -> a -> b
$
    [Parser Word64] -> Parser Word64
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
      [ ReadM Word64 -> Mod OptionFields Word64 -> Parser Word64
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (String -> ReadM Word64
forall a. (Bounded a, Integral a, Show a) => String -> ReadM a
bounded String
"SLOT") (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
"invalid-before"
            , String -> Mod OptionFields Word64
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"SLOT"
            , String -> Mod OptionFields Word64
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Time that transaction is valid from (in slots)."
            ]
      , ReadM Word64 -> Mod OptionFields Word64 -> Parser Word64
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (String -> ReadM Word64
forall a. (Bounded a, Integral a, Show a) => String -> ReadM a
bounded String
"SLOT") (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
"lower-bound"
            , String -> Mod OptionFields Word64
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"SLOT"
            , String -> Mod OptionFields Word64
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod OptionFields Word64)
-> String -> Mod OptionFields Word64
forall a b. (a -> b) -> a -> b
$
                [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                  [ String
"Time that transaction is valid from (in slots) "
                  , String
"(deprecated; use --invalid-before instead)."
                  ]
            , Mod OptionFields Word64
forall (f :: * -> *) a. Mod f a
Opt.internal
            ]
      ]

pLegacyInvalidHereafter :: Parser SlotNo
pLegacyInvalidHereafter :: Parser SlotNo
pLegacyInvalidHereafter =
  (Word64 -> SlotNo) -> Parser Word64 -> Parser SlotNo
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> SlotNo
SlotNo (Parser Word64 -> Parser SlotNo) -> Parser Word64 -> Parser SlotNo
forall a b. (a -> b) -> a -> b
$
    [Parser Word64] -> Parser Word64
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
      [ ReadM Word64 -> Mod OptionFields Word64 -> Parser Word64
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (String -> ReadM Word64
forall a. (Bounded a, Integral a, Show a) => String -> ReadM a
bounded String
"SLOT") (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
"invalid-hereafter"
            , String -> Mod OptionFields Word64
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"SLOT"
            , String -> Mod OptionFields Word64
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Time that transaction is valid until (in slots)."
            ]
      , ReadM Word64 -> Mod OptionFields Word64 -> Parser Word64
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (String -> ReadM Word64
forall a. (Bounded a, Integral a, Show a) => String -> ReadM a
bounded String
"SLOT") (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
"upper-bound"
            , String -> Mod OptionFields Word64
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"SLOT"
            , String -> Mod OptionFields Word64
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod OptionFields Word64)
-> String -> Mod OptionFields Word64
forall a b. (a -> b) -> a -> b
$
                [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                  [ String
"Time that transaction is valid until (in slots) "
                  , String
"(deprecated; use --invalid-hereafter instead)."
                  ]
            , Mod OptionFields Word64
forall (f :: * -> *) a. Mod f a
Opt.internal
            ]
      , ReadM Word64 -> Mod OptionFields Word64 -> Parser Word64
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (String -> ReadM Word64
forall a. (Bounded a, Integral a, Show a) => String -> ReadM a
bounded String
"SLOT") (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
"ttl"
            , String -> Mod OptionFields Word64
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"SLOT"
            , String -> Mod OptionFields Word64
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Time to live (in slots) (deprecated; use --invalid-hereafter instead)."
            , Mod OptionFields Word64
forall (f :: * -> *) a. Mod f a
Opt.internal
            ]
      ]

pInvalidHereafter
  :: ()
  => ShelleyBasedEra era
  -> Parser (TxValidityUpperBound era)
pInvalidHereafter :: forall era.
ShelleyBasedEra era -> Parser (TxValidityUpperBound era)
pInvalidHereafter ShelleyBasedEra era
eon =
  (Maybe SlotNo -> TxValidityUpperBound era)
-> Parser (Maybe SlotNo) -> Parser (TxValidityUpperBound era)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ShelleyBasedEra era -> Maybe SlotNo -> TxValidityUpperBound era
forall era.
ShelleyBasedEra era -> Maybe SlotNo -> TxValidityUpperBound era
TxValidityUpperBound ShelleyBasedEra era
eon) (Parser (Maybe SlotNo) -> Parser (TxValidityUpperBound era))
-> Parser (Maybe SlotNo) -> Parser (TxValidityUpperBound era)
forall a b. (a -> b) -> a -> b
$
    [Parser (Maybe SlotNo)] -> Parser (Maybe SlotNo)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
      [ (Word64 -> Maybe SlotNo) -> Parser Word64 -> Parser (Maybe SlotNo)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SlotNo -> Maybe SlotNo
forall a. a -> Maybe a
Just (SlotNo -> Maybe SlotNo)
-> (Word64 -> SlotNo) -> Word64 -> Maybe SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> SlotNo
SlotNo) (Parser Word64 -> Parser (Maybe SlotNo))
-> Parser Word64 -> Parser (Maybe SlotNo)
forall a b. (a -> b) -> a -> b
$
          ReadM Word64 -> Mod OptionFields Word64 -> Parser Word64
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (String -> ReadM Word64
forall a. (Bounded a, Integral a, Show a) => String -> ReadM a
bounded String
"SLOT") (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
"invalid-hereafter"
              , String -> Mod OptionFields Word64
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"SLOT"
              , String -> Mod OptionFields Word64
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Time that transaction is valid until (in slots)."
              ]
      , (Word64 -> Maybe SlotNo) -> Parser Word64 -> Parser (Maybe SlotNo)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SlotNo -> Maybe SlotNo
forall a. a -> Maybe a
Just (SlotNo -> Maybe SlotNo)
-> (Word64 -> SlotNo) -> Word64 -> Maybe SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> SlotNo
SlotNo) (Parser Word64 -> Parser (Maybe SlotNo))
-> Parser Word64 -> Parser (Maybe SlotNo)
forall a b. (a -> b) -> a -> b
$
          ReadM Word64 -> Mod OptionFields Word64 -> Parser Word64
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (String -> ReadM Word64
forall a. (Bounded a, Integral a, Show a) => String -> ReadM a
bounded String
"SLOT") (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
"upper-bound"
              , String -> Mod OptionFields Word64
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"SLOT"
              , String -> Mod OptionFields Word64
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod OptionFields Word64)
-> String -> Mod OptionFields Word64
forall a b. (a -> b) -> a -> b
$
                  [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                    [ String
"Time that transaction is valid until (in slots) "
                    , String
"(deprecated; use --invalid-hereafter instead)."
                    ]
              , Mod OptionFields Word64
forall (f :: * -> *) a. Mod f a
Opt.internal
              ]
      , (Word64 -> Maybe SlotNo) -> Parser Word64 -> Parser (Maybe SlotNo)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SlotNo -> Maybe SlotNo
forall a. a -> Maybe a
Just (SlotNo -> Maybe SlotNo)
-> (Word64 -> SlotNo) -> Word64 -> Maybe SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> SlotNo
SlotNo) (Parser Word64 -> Parser (Maybe SlotNo))
-> Parser Word64 -> Parser (Maybe SlotNo)
forall a b. (a -> b) -> a -> b
$
          ReadM Word64 -> Mod OptionFields Word64 -> Parser Word64
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (String -> ReadM Word64
forall a. (Bounded a, Integral a, Show a) => String -> ReadM a
bounded String
"SLOT") (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
"ttl"
              , String -> Mod OptionFields Word64
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"SLOT"
              , String -> Mod OptionFields Word64
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Time to live (in slots) (deprecated; use --invalid-hereafter instead)."
              , Mod OptionFields Word64
forall (f :: * -> *) a. Mod f a
Opt.internal
              ]
      , Maybe SlotNo -> Parser (Maybe SlotNo)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe SlotNo
forall a. Maybe a
Nothing
      ]

pTxFee :: Parser Lovelace
pTxFee :: Parser Lovelace
pTxFee =
  (Natural -> Lovelace) -> Parser Natural -> Parser Lovelace
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> Lovelace
L.Coin (Integer -> Lovelace)
-> (Natural -> Integer) -> Natural -> Lovelace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Natural -> Integer)) (Parser Natural -> Parser Lovelace)
-> Parser Natural -> Parser Lovelace
forall a b. (a -> b) -> a -> b
$
    ReadM Natural -> Mod OptionFields Natural -> Parser Natural
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Natural
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader (Mod OptionFields Natural -> Parser Natural)
-> Mod OptionFields Natural -> Parser Natural
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields Natural] -> Mod OptionFields Natural
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"fee"
        , String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"LOVELACE"
        , String -> Mod OptionFields Natural
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The fee amount in Lovelace."
        ]

pWitnessFile :: Parser WitnessFile
pWitnessFile :: Parser WitnessFile
pWitnessFile = String -> WitnessFile
WitnessFile (String -> WitnessFile) -> Parser String -> Parser WitnessFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser String
parseFilePath String
"witness-file" String
"Filepath of the witness"

pTxBodyFileIn :: Parser (TxBodyFile In)
pTxBodyFileIn :: Parser (TxBodyFile 'In)
pTxBodyFileIn = String -> TxBodyFile 'In
forall content (direction :: FileDirection).
String -> File content direction
File (String -> TxBodyFile 'In)
-> Parser String -> Parser (TxBodyFile 'In)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser String
parseFilePath String
"tx-body-file" String
"Input filepath of the JSON TxBody."

pTxBodyFileOut :: Parser (TxBodyFile Out)
pTxBodyFileOut :: Parser (TxBodyFile 'Out)
pTxBodyFileOut =
  (String -> TxBodyFile 'Out)
-> Parser String -> Parser (TxBodyFile 'Out)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> TxBodyFile 'Out
forall content (direction :: FileDirection).
String -> File content direction
File (Parser String -> Parser (TxBodyFile 'Out))
-> Parser String -> Parser (TxBodyFile 'Out)
forall a b. (a -> b) -> a -> b
$
    [Parser String] -> Parser String
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
      [ String -> String -> Parser String
parseFilePath String
"out-file" String
"Output filepath of the JSON TxBody."
      , 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
"tx-body-file"
            , Mod OptionFields String
forall (f :: * -> *) a. Mod f a
Opt.internal
            ]
      ]

pTxFileIn :: Parser (TxFile In)
pTxFileIn :: Parser (TxFile 'In)
pTxFileIn = String -> TxFile 'In
forall content (direction :: FileDirection).
String -> File content direction
File (String -> TxFile 'In) -> Parser String -> Parser (TxFile 'In)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser String
parseFilePath String
"tx-file" String
"Input filepath of the JSON Tx."

pTxFileOut :: Parser (TxFile Out)
pTxFileOut :: Parser (TxFile 'Out)
pTxFileOut =
  String -> TxFile 'Out
forall content (direction :: FileDirection).
String -> File content direction
File
    (String -> TxFile 'Out) -> Parser String -> Parser (TxFile 'Out)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Parser String] -> Parser String
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
      [ String -> String -> Parser String
parseFilePath String
"out-file" String
"Output filepath of the JSON Tx."
      , 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
"tx-file"
            , Mod OptionFields String
forall (f :: * -> *) a. Mod f a
Opt.internal
            ]
      ]

pInputTxOrTxBodyFile :: Parser InputTxBodyOrTxFile
pInputTxOrTxBodyFile :: Parser InputTxBodyOrTxFile
pInputTxOrTxBodyFile =
  [Parser InputTxBodyOrTxFile] -> Parser InputTxBodyOrTxFile
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ TxBodyFile 'In -> InputTxBodyOrTxFile
InputTxBodyFile (TxBodyFile 'In -> InputTxBodyOrTxFile)
-> Parser (TxBodyFile 'In) -> Parser InputTxBodyOrTxFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (TxBodyFile 'In)
pTxBodyFileIn
    , TxFile 'In -> InputTxBodyOrTxFile
InputTxFile (TxFile 'In -> InputTxBodyOrTxFile)
-> Parser (TxFile 'In) -> Parser InputTxBodyOrTxFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (TxFile 'In)
pTxFileIn
    ]

pTxInCountDeprecated :: Parser TxInCount
pTxInCountDeprecated :: Parser TxInCount
pTxInCountDeprecated =
  (Int -> TxInCount) -> Parser Int -> Parser TxInCount
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> TxInCount
TxInCount (Parser Int -> Parser TxInCount) -> Parser Int -> Parser TxInCount
forall a b. (a -> b) -> a -> b
$
    ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Int
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader (Mod OptionFields Int -> Parser Int)
-> Mod OptionFields Int -> Parser Int
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields Int] -> Mod OptionFields Int
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"tx-in-count"
        , String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"NATURAL"
        , String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"DEPRECATED. This argument has no effect."
        ]

pTxOutCountDeprecated :: Parser TxOutCount
pTxOutCountDeprecated :: Parser TxOutCount
pTxOutCountDeprecated =
  (Int -> TxOutCount) -> Parser Int -> Parser TxOutCount
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> TxOutCount
TxOutCount (Parser Int -> Parser TxOutCount)
-> Parser Int -> Parser TxOutCount
forall a b. (a -> b) -> a -> b
$
    ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Int
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader (Mod OptionFields Int -> Parser Int)
-> Mod OptionFields Int -> Parser Int
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields Int] -> Mod OptionFields Int
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"tx-out-count"
        , String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"NATURAL"
        , String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"DEPRECATED. This argument has no effect."
        ]

pTxShelleyWitnessCount :: Parser TxShelleyWitnessCount
pTxShelleyWitnessCount :: Parser TxShelleyWitnessCount
pTxShelleyWitnessCount =
  (Int -> TxShelleyWitnessCount)
-> Parser Int -> Parser TxShelleyWitnessCount
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> TxShelleyWitnessCount
TxShelleyWitnessCount (Parser Int -> Parser TxShelleyWitnessCount)
-> Parser Int -> Parser TxShelleyWitnessCount
forall a b. (a -> b) -> a -> b
$
    ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Int
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader (Mod OptionFields Int -> Parser Int)
-> Mod OptionFields Int -> Parser Int
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields Int] -> Mod OptionFields Int
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"witness-count"
        , String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"NATURAL"
        , String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The number of Shelley key witnesses."
        ]

pTxByronWitnessCount :: Parser TxByronWitnessCount
pTxByronWitnessCount :: Parser TxByronWitnessCount
pTxByronWitnessCount =
  (Int -> TxByronWitnessCount)
-> Parser Int -> Parser TxByronWitnessCount
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> TxByronWitnessCount
TxByronWitnessCount (Parser Int -> Parser TxByronWitnessCount)
-> Parser Int -> Parser TxByronWitnessCount
forall a b. (a -> b) -> a -> b
$
    ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Int
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader (Mod OptionFields Int -> Parser Int)
-> Mod OptionFields Int -> Parser Int
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields Int] -> Mod OptionFields Int
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"byron-witness-count"
        , String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"NATURAL"
        , String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The number of Byron key witnesses (default is 0)."
        , Int -> Mod OptionFields Int
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value Int
0
        ]

pQueryUTxOFilter :: Parser QueryUTxOFilter
pQueryUTxOFilter :: Parser QueryUTxOFilter
pQueryUTxOFilter =
  [Parser QueryUTxOFilter] -> Parser QueryUTxOFilter
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ Parser QueryUTxOFilter
pQueryUTxOWhole
    , Parser QueryUTxOFilter
pQueryUTxOByAddress
    , Parser QueryUTxOFilter
pQueryUTxOByTxIn
    ]
 where
  pQueryUTxOWhole :: Parser QueryUTxOFilter
pQueryUTxOWhole =
    QueryUTxOFilter
-> Mod FlagFields QueryUTxOFilter -> Parser QueryUTxOFilter
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' QueryUTxOFilter
QueryUTxOWhole (Mod FlagFields QueryUTxOFilter -> Parser QueryUTxOFilter)
-> Mod FlagFields QueryUTxOFilter -> Parser QueryUTxOFilter
forall a b. (a -> b) -> a -> b
$
      [Mod FlagFields QueryUTxOFilter] -> Mod FlagFields QueryUTxOFilter
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod FlagFields QueryUTxOFilter
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"whole-utxo"
        , String -> Mod FlagFields QueryUTxOFilter
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Return the whole UTxO (only appropriate on small testnets)."
        ]

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

  pByAddress :: Parser AddressAny
  pByAddress :: Parser AddressAny
pByAddress =
    ReadM AddressAny
-> Mod OptionFields AddressAny -> Parser AddressAny
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser AddressAny -> ReadM AddressAny
forall a. Parser a -> ReadM a
readerFromParsecParser Parser AddressAny
parseAddressAny) (Mod OptionFields AddressAny -> Parser AddressAny)
-> Mod OptionFields AddressAny -> Parser AddressAny
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields AddressAny] -> Mod OptionFields AddressAny
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod OptionFields AddressAny
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"address"
        , String -> Mod OptionFields AddressAny
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"ADDRESS"
        , String -> Mod OptionFields AddressAny
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Filter by Cardano address(es) (Bech32-encoded)."
        ]

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

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

pFilterByStakeAddress :: Parser StakeAddress
pFilterByStakeAddress :: Parser StakeAddress
pFilterByStakeAddress =
  ReadM StakeAddress
-> Mod OptionFields StakeAddress -> Parser StakeAddress
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser StakeAddress -> ReadM StakeAddress
forall a. Parser a -> ReadM a
readerFromParsecParser Parser StakeAddress
parseStakeAddress) (Mod OptionFields StakeAddress -> Parser StakeAddress)
-> Mod OptionFields StakeAddress -> Parser StakeAddress
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields StakeAddress] -> Mod OptionFields StakeAddress
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields StakeAddress
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"address"
      , String -> Mod OptionFields StakeAddress
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"ADDRESS"
      , String -> Mod OptionFields StakeAddress
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Filter by Cardano stake address (Bech32-encoded)."
      ]

pByronAddress :: Parser (Address ByronAddr)
pByronAddress :: Parser (Address ByronAddr)
pByronAddress =
  ReadM (Address ByronAddr)
-> Mod OptionFields (Address ByronAddr)
-> Parser (Address ByronAddr)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ((String -> Either String (Address ByronAddr))
-> ReadM (Address ByronAddr)
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader String -> Either String (Address ByronAddr)
deserialise) (Mod OptionFields (Address ByronAddr)
 -> Parser (Address ByronAddr))
-> Mod OptionFields (Address ByronAddr)
-> Parser (Address ByronAddr)
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields (Address ByronAddr)]
-> Mod OptionFields (Address ByronAddr)
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields (Address ByronAddr)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"address"
      , String -> Mod OptionFields (Address ByronAddr)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
      , String -> Mod OptionFields (Address ByronAddr)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Byron address (Base58-encoded)."
      ]
 where
  deserialise :: String -> Either String (Address ByronAddr)
  deserialise :: String -> Either String (Address ByronAddr)
deserialise =
    Either String (Address ByronAddr)
-> (Address ByronAddr -> Either String (Address ByronAddr))
-> Maybe (Address ByronAddr)
-> Either String (Address ByronAddr)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String (Address ByronAddr)
forall a b. a -> Either a b
Left String
"Invalid Byron address.") Address ByronAddr -> Either String (Address ByronAddr)
forall a b. b -> Either a b
Right
      (Maybe (Address ByronAddr) -> Either String (Address ByronAddr))
-> (String -> Maybe (Address ByronAddr))
-> String
-> Either String (Address ByronAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsType (Address ByronAddr) -> Text -> Maybe (Address ByronAddr)
forall addr.
SerialiseAddress addr =>
AsType addr -> Text -> Maybe addr
deserialiseAddress AsType (Address ByronAddr)
AsByronAddress
      (Text -> Maybe (Address ByronAddr))
-> (String -> Text) -> String -> Maybe (Address ByronAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

pAddress :: Parser Text
pAddress :: Parser Text
pAddress =
  (String -> Text) -> Parser String -> Parser Text
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
Text.pack (Parser String -> Parser Text) -> Parser String -> Parser Text
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
"address"
        , String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"ADDRESS"
        , String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"A Cardano address"
        ]

-- | First argument is the prefix for the option's flag to use
pStakePoolVerificationKeyHash :: Maybe String -> Parser (Hash StakePoolKey)
pStakePoolVerificationKeyHash :: Maybe String -> Parser (Hash StakePoolKey)
pStakePoolVerificationKeyHash Maybe String
prefix =
  ReadM (Hash StakePoolKey)
-> Mod OptionFields (Hash StakePoolKey)
-> Parser (Hash StakePoolKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (AsType StakePoolKey -> ReadM (Hash StakePoolKey)
forall a. SerialiseAsBech32 (Hash a) => AsType a -> ReadM (Hash a)
rBech32KeyHash AsType StakePoolKey
AsStakePoolKey ReadM (Hash StakePoolKey)
-> ReadM (Hash StakePoolKey) -> ReadM (Hash StakePoolKey)
forall a. ReadM a -> ReadM a -> ReadM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AsType StakePoolKey -> Maybe String -> ReadM (Hash StakePoolKey)
forall a.
SerialiseAsRawBytes (Hash a) =>
AsType a -> Maybe String -> ReadM (Hash a)
rHexHash AsType StakePoolKey
AsStakePoolKey Maybe String
forall a. Maybe a
Nothing) (Mod OptionFields (Hash StakePoolKey)
 -> Parser (Hash StakePoolKey))
-> Mod OptionFields (Hash StakePoolKey)
-> Parser (Hash StakePoolKey)
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields (Hash StakePoolKey)]
-> Mod OptionFields (Hash StakePoolKey)
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields (Hash StakePoolKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long (String -> Mod OptionFields (Hash StakePoolKey))
-> String -> Mod OptionFields (Hash StakePoolKey)
forall a b. (a -> b) -> a -> b
$ Maybe String -> String -> String
prefixFlag Maybe String
prefix String
"stake-pool-id"
      , String -> Mod OptionFields (Hash StakePoolKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STAKE_POOL_ID"
      , String -> Mod OptionFields (Hash StakePoolKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help
          String
"Stake pool ID/verification key hash (either Bech32-encoded or hex-encoded)."
      ]

pVrfVerificationKeyFile :: Parser (VerificationKeyFile In)
pVrfVerificationKeyFile :: Parser (VerificationKeyFile 'In)
pVrfVerificationKeyFile =
  String -> VerificationKeyFile 'In
forall content (direction :: FileDirection).
String -> File content direction
File (String -> VerificationKeyFile 'In)
-> Parser String -> Parser (VerificationKeyFile 'In)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser String
parseFilePath String
"vrf-verification-key-file" String
"Filepath of the VRF verification key."

pVrfVerificationKeyHash :: Parser (Hash VrfKey)
pVrfVerificationKeyHash :: Parser (Hash VrfKey)
pVrfVerificationKeyHash =
  ReadM (Hash VrfKey)
-> Mod OptionFields (Hash VrfKey) -> Parser (Hash VrfKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM (Hash VrfKey)
deserialiseFromHex (Mod OptionFields (Hash VrfKey) -> Parser (Hash VrfKey))
-> Mod OptionFields (Hash VrfKey) -> Parser (Hash VrfKey)
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields (Hash VrfKey)] -> Mod OptionFields (Hash VrfKey)
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields (Hash VrfKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"vrf-verification-key-hash"
      , String -> Mod OptionFields (Hash VrfKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
      , String -> Mod OptionFields (Hash VrfKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"VRF verification key hash (hex-encoded)."
      ]
 where
  deserialiseFromHex :: ReadM (Hash VrfKey)
  deserialiseFromHex :: ReadM (Hash VrfKey)
deserialiseFromHex =
    AsType VrfKey -> Maybe String -> ReadM (Hash VrfKey)
forall a.
SerialiseAsRawBytes (Hash a) =>
AsType a -> Maybe String -> ReadM (Hash a)
rHexHash AsType VrfKey
AsVrfKey (String -> Maybe String
forall a. a -> Maybe a
Just String
"Invalid VRF verification key hash")

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

pVrfVerificationKeyOrFile :: Parser (VerificationKeyOrFile VrfKey)
pVrfVerificationKeyOrFile :: Parser (VerificationKeyOrFile VrfKey)
pVrfVerificationKeyOrFile =
  [Parser (VerificationKeyOrFile VrfKey)]
-> Parser (VerificationKeyOrFile VrfKey)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ VerificationKey VrfKey -> VerificationKeyOrFile VrfKey
forall keyrole.
VerificationKey keyrole -> VerificationKeyOrFile keyrole
VerificationKeyValue (VerificationKey VrfKey -> VerificationKeyOrFile VrfKey)
-> Parser (VerificationKey VrfKey)
-> Parser (VerificationKeyOrFile VrfKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKey VrfKey)
pVrfVerificationKey
    , VerificationKeyFile 'In -> VerificationKeyOrFile VrfKey
forall keyrole.
VerificationKeyFile 'In -> VerificationKeyOrFile keyrole
VerificationKeyFilePath (VerificationKeyFile 'In -> VerificationKeyOrFile VrfKey)
-> Parser (VerificationKeyFile 'In)
-> Parser (VerificationKeyOrFile VrfKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyFile 'In)
pVrfVerificationKeyFile
    ]

pVrfVerificationKeyOrHashOrFile :: Parser (VerificationKeyOrHashOrFile VrfKey)
pVrfVerificationKeyOrHashOrFile :: Parser (VerificationKeyOrHashOrFile VrfKey)
pVrfVerificationKeyOrHashOrFile =
  [Parser (VerificationKeyOrHashOrFile VrfKey)]
-> Parser (VerificationKeyOrHashOrFile VrfKey)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ VerificationKeyOrFile VrfKey -> VerificationKeyOrHashOrFile VrfKey
forall keyrole.
VerificationKeyOrFile keyrole
-> VerificationKeyOrHashOrFile keyrole
VerificationKeyOrFile (VerificationKeyOrFile VrfKey
 -> VerificationKeyOrHashOrFile VrfKey)
-> Parser (VerificationKeyOrFile VrfKey)
-> Parser (VerificationKeyOrHashOrFile VrfKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyOrFile VrfKey)
pVrfVerificationKeyOrFile
    , Hash VrfKey -> VerificationKeyOrHashOrFile VrfKey
forall keyrole. Hash keyrole -> VerificationKeyOrHashOrFile keyrole
VerificationKeyHash (Hash VrfKey -> VerificationKeyOrHashOrFile VrfKey)
-> Parser (Hash VrfKey)
-> Parser (VerificationKeyOrHashOrFile VrfKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Hash VrfKey)
pVrfVerificationKeyHash
    ]

pRewardAcctVerificationKeyFile :: Parser (VerificationKeyFile In)
pRewardAcctVerificationKeyFile :: Parser (VerificationKeyFile 'In)
pRewardAcctVerificationKeyFile =
  String -> VerificationKeyFile 'In
forall content (direction :: FileDirection).
String -> File content direction
File
    (String -> VerificationKeyFile 'In)
-> Parser String -> Parser (VerificationKeyFile 'In)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Parser String] -> Parser String
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
      [ String -> String -> Parser String
parseFilePath
          String
"pool-reward-account-verification-key-file"
          String
"Filepath of the reward account stake verification key."
      , 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
"reward-account-verification-key-file"
            , Mod OptionFields String
forall (f :: * -> *) a. Mod f a
Opt.internal
            ]
      ]

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

pRewardAcctVerificationKeyOrFile :: Parser (VerificationKeyOrFile StakeKey)
pRewardAcctVerificationKeyOrFile :: Parser (VerificationKeyOrFile StakeKey)
pRewardAcctVerificationKeyOrFile =
  [Parser (VerificationKeyOrFile StakeKey)]
-> Parser (VerificationKeyOrFile StakeKey)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ VerificationKey StakeKey -> VerificationKeyOrFile StakeKey
forall keyrole.
VerificationKey keyrole -> VerificationKeyOrFile keyrole
VerificationKeyValue (VerificationKey StakeKey -> VerificationKeyOrFile StakeKey)
-> Parser (VerificationKey StakeKey)
-> Parser (VerificationKeyOrFile StakeKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKey StakeKey)
pRewardAcctVerificationKey
    , VerificationKeyFile 'In -> VerificationKeyOrFile StakeKey
forall keyrole.
VerificationKeyFile 'In -> VerificationKeyOrFile keyrole
VerificationKeyFilePath (VerificationKeyFile 'In -> VerificationKeyOrFile StakeKey)
-> Parser (VerificationKeyFile 'In)
-> Parser (VerificationKeyOrFile StakeKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyFile 'In)
pRewardAcctVerificationKeyFile
    ]

pPoolOwnerVerificationKeyFile :: Parser (VerificationKeyFile In)
pPoolOwnerVerificationKeyFile :: Parser (VerificationKeyFile 'In)
pPoolOwnerVerificationKeyFile =
  String -> VerificationKeyFile 'In
forall content (direction :: FileDirection).
String -> File content direction
File
    (String -> VerificationKeyFile 'In)
-> Parser String -> Parser (VerificationKeyFile 'In)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Parser String] -> Parser String
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
      [ String -> String -> Parser String
parseFilePath
          String
"pool-owner-stake-verification-key-file"
          String
"Filepath of the pool owner stake verification key."
      , 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
"pool-owner-staking-verification-key"
            , Mod OptionFields String
forall (f :: * -> *) a. Mod f a
Opt.internal
            ]
      ]

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

pPoolOwnerVerificationKeyOrFile :: Parser (VerificationKeyOrFile StakeKey)
pPoolOwnerVerificationKeyOrFile :: Parser (VerificationKeyOrFile StakeKey)
pPoolOwnerVerificationKeyOrFile =
  [Parser (VerificationKeyOrFile StakeKey)]
-> Parser (VerificationKeyOrFile StakeKey)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ VerificationKey StakeKey -> VerificationKeyOrFile StakeKey
forall keyrole.
VerificationKey keyrole -> VerificationKeyOrFile keyrole
VerificationKeyValue (VerificationKey StakeKey -> VerificationKeyOrFile StakeKey)
-> Parser (VerificationKey StakeKey)
-> Parser (VerificationKeyOrFile StakeKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKey StakeKey)
pPoolOwnerVerificationKey
    , VerificationKeyFile 'In -> VerificationKeyOrFile StakeKey
forall keyrole.
VerificationKeyFile 'In -> VerificationKeyOrFile keyrole
VerificationKeyFilePath (VerificationKeyFile 'In -> VerificationKeyOrFile StakeKey)
-> Parser (VerificationKeyFile 'In)
-> Parser (VerificationKeyOrFile StakeKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyFile 'In)
pPoolOwnerVerificationKeyFile
    ]

pPoolPledge :: Parser Lovelace
pPoolPledge :: Parser Lovelace
pPoolPledge =
  ReadM Lovelace -> Mod OptionFields Lovelace -> Parser Lovelace
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser Lovelace -> ReadM Lovelace
forall a. Parser a -> ReadM a
readerFromParsecParser Parser Lovelace
parseLovelace) (Mod OptionFields Lovelace -> Parser Lovelace)
-> Mod OptionFields Lovelace -> Parser Lovelace
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Lovelace] -> Mod OptionFields Lovelace
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"pool-pledge"
      , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"LOVELACE"
      , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The stake pool's pledge."
      ]

pPoolCost :: Parser Lovelace
pPoolCost :: Parser Lovelace
pPoolCost =
  ReadM Lovelace -> Mod OptionFields Lovelace -> Parser Lovelace
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser Lovelace -> ReadM Lovelace
forall a. Parser a -> ReadM a
readerFromParsecParser Parser Lovelace
parseLovelace) (Mod OptionFields Lovelace -> Parser Lovelace)
-> Mod OptionFields Lovelace -> Parser Lovelace
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Lovelace] -> Mod OptionFields Lovelace
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"pool-cost"
      , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"LOVELACE"
      , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The stake pool's cost."
      ]

pRational :: String -> String -> Parser Rational
pRational :: String -> String -> Parser Rational
pRational String
opt String
h =
  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
opt
      , 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
h
      ]

pPoolMargin :: Parser Rational
pPoolMargin :: Parser Rational
pPoolMargin = String -> String -> Parser Rational
pRational String
"pool-margin" String
"The stake pool's margin."

pPoolRelay :: Parser StakePoolRelay
pPoolRelay :: Parser StakePoolRelay
pPoolRelay =
  [Parser StakePoolRelay] -> Parser StakePoolRelay
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ Parser StakePoolRelay
pSingleHostAddress
    , Parser StakePoolRelay
pSingleHostName
    , Parser StakePoolRelay
pMultiHostName
    ]

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

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

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

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

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

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

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

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

pStakePoolMetadataHash :: Parser (Hash StakePoolMetadata)
pStakePoolMetadataHash :: Parser (Hash StakePoolMetadata)
pStakePoolMetadataHash =
  ReadM (Hash StakePoolMetadata)
-> Mod OptionFields (Hash StakePoolMetadata)
-> Parser (Hash StakePoolMetadata)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM (Hash StakePoolMetadata)
deserializeFromHex (Mod OptionFields (Hash StakePoolMetadata)
 -> Parser (Hash StakePoolMetadata))
-> Mod OptionFields (Hash StakePoolMetadata)
-> Parser (Hash StakePoolMetadata)
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields (Hash StakePoolMetadata)]
-> Mod OptionFields (Hash StakePoolMetadata)
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields (Hash StakePoolMetadata)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"metadata-hash"
      , String -> Mod OptionFields (Hash StakePoolMetadata)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"HASH"
      , String -> Mod OptionFields (Hash StakePoolMetadata)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Pool metadata hash."
      ]
 where
  deserializeFromHex :: ReadM (Hash StakePoolMetadata)
  deserializeFromHex :: ReadM (Hash StakePoolMetadata)
deserializeFromHex =
    AsType StakePoolMetadata
-> Maybe String -> ReadM (Hash StakePoolMetadata)
forall a.
SerialiseAsRawBytes (Hash a) =>
AsType a -> Maybe String -> ReadM (Hash a)
rHexHash AsType StakePoolMetadata
AsStakePoolMetadata Maybe String
forall a. Maybe a
Nothing

pStakePoolRegistrationParserRequirements
  :: EnvCli -> Parser StakePoolRegistrationParserRequirements
pStakePoolRegistrationParserRequirements :: EnvCli -> Parser StakePoolRegistrationParserRequirements
pStakePoolRegistrationParserRequirements EnvCli
envCli =
  VerificationKeyOrFile StakePoolKey
-> VerificationKeyOrFile VrfKey
-> Lovelace
-> Lovelace
-> Rational
-> VerificationKeyOrFile StakeKey
-> [VerificationKeyOrFile StakeKey]
-> [StakePoolRelay]
-> Maybe
     (PotentiallyCheckedAnchor
        StakePoolMetadataReference StakePoolMetadataReference)
-> NetworkId
-> StakePoolRegistrationParserRequirements
StakePoolRegistrationParserRequirements
    (VerificationKeyOrFile StakePoolKey
 -> VerificationKeyOrFile VrfKey
 -> Lovelace
 -> Lovelace
 -> Rational
 -> VerificationKeyOrFile StakeKey
 -> [VerificationKeyOrFile StakeKey]
 -> [StakePoolRelay]
 -> Maybe
      (PotentiallyCheckedAnchor
         StakePoolMetadataReference StakePoolMetadataReference)
 -> NetworkId
 -> StakePoolRegistrationParserRequirements)
-> Parser (VerificationKeyOrFile StakePoolKey)
-> Parser
     (VerificationKeyOrFile VrfKey
      -> Lovelace
      -> Lovelace
      -> Rational
      -> VerificationKeyOrFile StakeKey
      -> [VerificationKeyOrFile StakeKey]
      -> [StakePoolRelay]
      -> Maybe
           (PotentiallyCheckedAnchor
              StakePoolMetadataReference StakePoolMetadataReference)
      -> NetworkId
      -> StakePoolRegistrationParserRequirements)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String -> Parser (VerificationKeyOrFile StakePoolKey)
pStakePoolVerificationKeyOrFile Maybe String
forall a. Maybe a
Nothing
    Parser
  (VerificationKeyOrFile VrfKey
   -> Lovelace
   -> Lovelace
   -> Rational
   -> VerificationKeyOrFile StakeKey
   -> [VerificationKeyOrFile StakeKey]
   -> [StakePoolRelay]
   -> Maybe
        (PotentiallyCheckedAnchor
           StakePoolMetadataReference StakePoolMetadataReference)
   -> NetworkId
   -> StakePoolRegistrationParserRequirements)
-> Parser (VerificationKeyOrFile VrfKey)
-> Parser
     (Lovelace
      -> Lovelace
      -> Rational
      -> VerificationKeyOrFile StakeKey
      -> [VerificationKeyOrFile StakeKey]
      -> [StakePoolRelay]
      -> Maybe
           (PotentiallyCheckedAnchor
              StakePoolMetadataReference StakePoolMetadataReference)
      -> NetworkId
      -> StakePoolRegistrationParserRequirements)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (VerificationKeyOrFile VrfKey)
pVrfVerificationKeyOrFile
    Parser
  (Lovelace
   -> Lovelace
   -> Rational
   -> VerificationKeyOrFile StakeKey
   -> [VerificationKeyOrFile StakeKey]
   -> [StakePoolRelay]
   -> Maybe
        (PotentiallyCheckedAnchor
           StakePoolMetadataReference StakePoolMetadataReference)
   -> NetworkId
   -> StakePoolRegistrationParserRequirements)
-> Parser Lovelace
-> Parser
     (Lovelace
      -> Rational
      -> VerificationKeyOrFile StakeKey
      -> [VerificationKeyOrFile StakeKey]
      -> [StakePoolRelay]
      -> Maybe
           (PotentiallyCheckedAnchor
              StakePoolMetadataReference StakePoolMetadataReference)
      -> NetworkId
      -> StakePoolRegistrationParserRequirements)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Lovelace
pPoolPledge
    Parser
  (Lovelace
   -> Rational
   -> VerificationKeyOrFile StakeKey
   -> [VerificationKeyOrFile StakeKey]
   -> [StakePoolRelay]
   -> Maybe
        (PotentiallyCheckedAnchor
           StakePoolMetadataReference StakePoolMetadataReference)
   -> NetworkId
   -> StakePoolRegistrationParserRequirements)
-> Parser Lovelace
-> Parser
     (Rational
      -> VerificationKeyOrFile StakeKey
      -> [VerificationKeyOrFile StakeKey]
      -> [StakePoolRelay]
      -> Maybe
           (PotentiallyCheckedAnchor
              StakePoolMetadataReference StakePoolMetadataReference)
      -> NetworkId
      -> StakePoolRegistrationParserRequirements)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Lovelace
pPoolCost
    Parser
  (Rational
   -> VerificationKeyOrFile StakeKey
   -> [VerificationKeyOrFile StakeKey]
   -> [StakePoolRelay]
   -> Maybe
        (PotentiallyCheckedAnchor
           StakePoolMetadataReference StakePoolMetadataReference)
   -> NetworkId
   -> StakePoolRegistrationParserRequirements)
-> Parser Rational
-> Parser
     (VerificationKeyOrFile StakeKey
      -> [VerificationKeyOrFile StakeKey]
      -> [StakePoolRelay]
      -> Maybe
           (PotentiallyCheckedAnchor
              StakePoolMetadataReference StakePoolMetadataReference)
      -> NetworkId
      -> StakePoolRegistrationParserRequirements)
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
pPoolMargin
    Parser
  (VerificationKeyOrFile StakeKey
   -> [VerificationKeyOrFile StakeKey]
   -> [StakePoolRelay]
   -> Maybe
        (PotentiallyCheckedAnchor
           StakePoolMetadataReference StakePoolMetadataReference)
   -> NetworkId
   -> StakePoolRegistrationParserRequirements)
-> Parser (VerificationKeyOrFile StakeKey)
-> Parser
     ([VerificationKeyOrFile StakeKey]
      -> [StakePoolRelay]
      -> Maybe
           (PotentiallyCheckedAnchor
              StakePoolMetadataReference StakePoolMetadataReference)
      -> NetworkId
      -> StakePoolRegistrationParserRequirements)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (VerificationKeyOrFile StakeKey)
pRewardAcctVerificationKeyOrFile
    Parser
  ([VerificationKeyOrFile StakeKey]
   -> [StakePoolRelay]
   -> Maybe
        (PotentiallyCheckedAnchor
           StakePoolMetadataReference StakePoolMetadataReference)
   -> NetworkId
   -> StakePoolRegistrationParserRequirements)
-> Parser [VerificationKeyOrFile StakeKey]
-> Parser
     ([StakePoolRelay]
      -> Maybe
           (PotentiallyCheckedAnchor
              StakePoolMetadataReference StakePoolMetadataReference)
      -> NetworkId
      -> StakePoolRegistrationParserRequirements)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (VerificationKeyOrFile StakeKey)
-> Parser [VerificationKeyOrFile StakeKey]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser (VerificationKeyOrFile StakeKey)
pPoolOwnerVerificationKeyOrFile
    Parser
  ([StakePoolRelay]
   -> Maybe
        (PotentiallyCheckedAnchor
           StakePoolMetadataReference StakePoolMetadataReference)
   -> NetworkId
   -> StakePoolRegistrationParserRequirements)
-> Parser [StakePoolRelay]
-> Parser
     (Maybe
        (PotentiallyCheckedAnchor
           StakePoolMetadataReference StakePoolMetadataReference)
      -> NetworkId -> StakePoolRegistrationParserRequirements)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser StakePoolRelay -> Parser [StakePoolRelay]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser StakePoolRelay
pPoolRelay
    Parser
  (Maybe
     (PotentiallyCheckedAnchor
        StakePoolMetadataReference StakePoolMetadataReference)
   -> NetworkId -> StakePoolRegistrationParserRequirements)
-> Parser
     (Maybe
        (PotentiallyCheckedAnchor
           StakePoolMetadataReference StakePoolMetadataReference))
-> Parser (NetworkId -> StakePoolRegistrationParserRequirements)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser
  (PotentiallyCheckedAnchor
     StakePoolMetadataReference StakePoolMetadataReference)
-> Parser
     (Maybe
        (PotentiallyCheckedAnchor
           StakePoolMetadataReference StakePoolMetadataReference))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
      ( Parser (MustCheckHash StakePoolMetadataReference)
-> Parser StakePoolMetadataReference
-> Parser
     (PotentiallyCheckedAnchor
        StakePoolMetadataReference StakePoolMetadataReference)
forall anchorType anchor.
Parser (MustCheckHash anchorType)
-> Parser anchor
-> Parser (PotentiallyCheckedAnchor anchorType anchor)
pPotentiallyCheckedAnchorData
          Parser (MustCheckHash StakePoolMetadataReference)
pMustCheckStakeMetadataHash
          Parser StakePoolMetadataReference
pStakePoolMetadataReference
      )
    Parser (NetworkId -> StakePoolRegistrationParserRequirements)
-> Parser NetworkId
-> Parser StakePoolRegistrationParserRequirements
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

pProtocolParametersUpdate :: Parser ProtocolParametersUpdate
pProtocolParametersUpdate :: Parser ProtocolParametersUpdate
pProtocolParametersUpdate =
  Maybe (Natural, Natural)
-> Maybe Rational
-> Maybe (Maybe PraosNonce)
-> Maybe Word16
-> Maybe Word32
-> Maybe Word32
-> Maybe Lovelace
-> Maybe Lovelace
-> Maybe Lovelace
-> Maybe Lovelace
-> Maybe Lovelace
-> Maybe Lovelace
-> Maybe EpochInterval
-> Maybe Natural
-> Maybe Rational
-> Maybe Rational
-> Maybe Rational
-> Map AnyPlutusScriptVersion CostModel
-> Maybe ExecutionUnitPrices
-> Maybe ExecutionUnits
-> Maybe ExecutionUnits
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Lovelace
-> ProtocolParametersUpdate
ProtocolParametersUpdate
    (Maybe (Natural, Natural)
 -> Maybe Rational
 -> Maybe (Maybe PraosNonce)
 -> Maybe Word16
 -> Maybe Word32
 -> Maybe Word32
 -> Maybe Lovelace
 -> Maybe Lovelace
 -> Maybe Lovelace
 -> Maybe Lovelace
 -> Maybe Lovelace
 -> Maybe Lovelace
 -> Maybe EpochInterval
 -> Maybe Natural
 -> Maybe Rational
 -> Maybe Rational
 -> Maybe Rational
 -> Map AnyPlutusScriptVersion CostModel
 -> Maybe ExecutionUnitPrices
 -> Maybe ExecutionUnits
 -> Maybe ExecutionUnits
 -> Maybe Natural
 -> Maybe Natural
 -> Maybe Natural
 -> Maybe Lovelace
 -> ProtocolParametersUpdate)
-> Parser (Maybe (Natural, Natural))
-> Parser
     (Maybe Rational
      -> Maybe (Maybe PraosNonce)
      -> Maybe Word16
      -> Maybe Word32
      -> Maybe Word32
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe EpochInterval
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Natural, Natural) -> Parser (Maybe (Natural, Natural))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser (Natural, Natural)
pProtocolVersion
    Parser
  (Maybe Rational
   -> Maybe (Maybe PraosNonce)
   -> Maybe Word16
   -> Maybe Word32
   -> Maybe Word32
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe EpochInterval
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Parser (Maybe Rational)
-> Parser
     (Maybe (Maybe PraosNonce)
      -> Maybe Word16
      -> Maybe Word32
      -> Maybe Word32
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe EpochInterval
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
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 -> Parser (Maybe Rational)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Rational
pDecentralParam
    Parser
  (Maybe (Maybe PraosNonce)
   -> Maybe Word16
   -> Maybe Word32
   -> Maybe Word32
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe EpochInterval
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Parser (Maybe (Maybe PraosNonce))
-> Parser
     (Maybe Word16
      -> Maybe Word32
      -> Maybe Word32
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe EpochInterval
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
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 PraosNonce) -> Parser (Maybe (Maybe PraosNonce))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser (Maybe PraosNonce)
pExtraEntropy
    Parser
  (Maybe Word16
   -> Maybe Word32
   -> Maybe Word32
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe EpochInterval
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Parser (Maybe Word16)
-> Parser
     (Maybe Word32
      -> Maybe Word32
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe EpochInterval
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word16 -> Parser (Maybe Word16)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Word16
pMaxBlockHeaderSize
    Parser
  (Maybe Word32
   -> Maybe Word32
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe EpochInterval
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Parser (Maybe Word32)
-> Parser
     (Maybe Word32
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe EpochInterval
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word32 -> Parser (Maybe Word32)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Word32
pMaxBodySize
    Parser
  (Maybe Word32
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe EpochInterval
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Parser (Maybe Word32)
-> Parser
     (Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe EpochInterval
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word32 -> Parser (Maybe Word32)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Word32
pMaxTransactionSize
    Parser
  (Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe EpochInterval
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Parser (Maybe Lovelace)
-> Parser
     (Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe EpochInterval
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Lovelace -> Parser (Maybe Lovelace)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Lovelace
pMinFeeConstantFactor
    Parser
  (Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe EpochInterval
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Parser (Maybe Lovelace)
-> Parser
     (Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe EpochInterval
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Lovelace -> Parser (Maybe Lovelace)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Lovelace
pMinFeePerByteFactor
    Parser
  (Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe EpochInterval
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Parser (Maybe Lovelace)
-> Parser
     (Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe EpochInterval
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Lovelace -> Parser (Maybe Lovelace)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Lovelace
pMinUTxOValue
    Parser
  (Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe EpochInterval
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Parser (Maybe Lovelace)
-> Parser
     (Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe EpochInterval
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Lovelace -> Parser (Maybe Lovelace)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Lovelace
pKeyRegistDeposit
    Parser
  (Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe EpochInterval
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Parser (Maybe Lovelace)
-> Parser
     (Maybe Lovelace
      -> Maybe EpochInterval
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Lovelace -> Parser (Maybe Lovelace)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Lovelace
pPoolDeposit
    Parser
  (Maybe Lovelace
   -> Maybe EpochInterval
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Parser (Maybe Lovelace)
-> Parser
     (Maybe EpochInterval
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Lovelace -> Parser (Maybe Lovelace)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Lovelace
pMinPoolCost
    Parser
  (Maybe EpochInterval
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Parser (Maybe EpochInterval)
-> Parser
     (Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser EpochInterval -> Parser (Maybe EpochInterval)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser EpochInterval
pEpochBoundRetirement
    Parser
  (Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Parser (Maybe Natural)
-> Parser
     (Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Natural -> Parser (Maybe Natural)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Natural
pNumberOfPools
    Parser
  (Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Parser (Maybe Rational)
-> Parser
     (Maybe Rational
      -> Maybe Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
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 -> Parser (Maybe Rational)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Rational
pPoolInfluence
    Parser
  (Maybe Rational
   -> Maybe Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Parser (Maybe Rational)
-> Parser
     (Maybe Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
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 -> Parser (Maybe Rational)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Rational
pMonetaryExpansion
    Parser
  (Maybe Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Parser (Maybe Rational)
-> Parser
     (Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
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 -> Parser (Maybe Rational)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Rational
pTreasuryExpansion
    Parser
  (Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Parser (Map AnyPlutusScriptVersion CostModel)
-> Parser
     (Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map AnyPlutusScriptVersion CostModel
-> Parser (Map AnyPlutusScriptVersion CostModel)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map AnyPlutusScriptVersion CostModel
forall a. Monoid a => a
mempty
    Parser
  (Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Parser (Maybe ExecutionUnitPrices)
-> Parser
     (Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ExecutionUnitPrices -> Parser (Maybe ExecutionUnitPrices)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ExecutionUnitPrices
pExecutionUnitPrices
    Parser
  (Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Parser (Maybe ExecutionUnits)
-> Parser
     (Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ExecutionUnits -> Parser (Maybe ExecutionUnits)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ExecutionUnits
pMaxTxExecutionUnits
    Parser
  (Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Parser (Maybe ExecutionUnits)
-> Parser
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ExecutionUnits -> Parser (Maybe ExecutionUnits)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ExecutionUnits
pMaxBlockExecutionUnits
    Parser
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Parser (Maybe Natural)
-> Parser
     (Maybe Natural
      -> Maybe Natural -> Maybe Lovelace -> ProtocolParametersUpdate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Natural -> Parser (Maybe Natural)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Natural
pMaxValueSize
    Parser
  (Maybe Natural
   -> Maybe Natural -> Maybe Lovelace -> ProtocolParametersUpdate)
-> Parser (Maybe Natural)
-> Parser
     (Maybe Natural -> Maybe Lovelace -> ProtocolParametersUpdate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Natural -> Parser (Maybe Natural)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Natural
pCollateralPercent
    Parser
  (Maybe Natural -> Maybe Lovelace -> ProtocolParametersUpdate)
-> Parser (Maybe Natural)
-> Parser (Maybe Lovelace -> ProtocolParametersUpdate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Natural -> Parser (Maybe Natural)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Natural
pMaxCollateralInputs
    Parser (Maybe Lovelace -> ProtocolParametersUpdate)
-> Parser (Maybe Lovelace) -> Parser ProtocolParametersUpdate
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Lovelace -> Parser (Maybe Lovelace)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Lovelace
pUTxOCostPerByte

pCostModels :: Parser FilePath
pCostModels :: Parser String
pCostModels =
  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
"cost-model-file"
      , String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE"
      , String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Filepath of the JSON formatted cost model"
      , Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
      ]

pMinFeePerByteFactor :: Parser Lovelace
pMinFeePerByteFactor :: Parser Lovelace
pMinFeePerByteFactor =
  ReadM Lovelace -> Mod OptionFields Lovelace -> Parser Lovelace
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser Lovelace -> ReadM Lovelace
forall a. Parser a -> ReadM a
readerFromParsecParser Parser Lovelace
parseLovelace) (Mod OptionFields Lovelace -> Parser Lovelace)
-> Mod OptionFields Lovelace -> Parser Lovelace
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Lovelace] -> Mod OptionFields Lovelace
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"min-fee-linear"
      , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"LOVELACE"
      , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The linear factor per byte for the minimum fee calculation."
      ]

pMinFeeConstantFactor :: Parser Lovelace
pMinFeeConstantFactor :: Parser Lovelace
pMinFeeConstantFactor =
  ReadM Lovelace -> Mod OptionFields Lovelace -> Parser Lovelace
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser Lovelace -> ReadM Lovelace
forall a. Parser a -> ReadM a
readerFromParsecParser Parser Lovelace
parseLovelace) (Mod OptionFields Lovelace -> Parser Lovelace)
-> Mod OptionFields Lovelace -> Parser Lovelace
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Lovelace] -> Mod OptionFields Lovelace
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"min-fee-constant"
      , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"LOVELACE"
      , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The constant factor for the minimum fee calculation."
      ]

pMinUTxOValue :: Parser Lovelace
pMinUTxOValue :: Parser Lovelace
pMinUTxOValue =
  ReadM Lovelace -> Mod OptionFields Lovelace -> Parser Lovelace
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser Lovelace -> ReadM Lovelace
forall a. Parser a -> ReadM a
readerFromParsecParser Parser Lovelace
parseLovelace) (Mod OptionFields Lovelace -> Parser Lovelace)
-> Mod OptionFields Lovelace -> Parser Lovelace
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Lovelace] -> Mod OptionFields Lovelace
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"min-utxo-value"
      , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"NATURAL"
      , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The minimum allowed UTxO value (Shelley to Mary eras)."
      ]

pMinPoolCost :: Parser Lovelace
pMinPoolCost :: Parser Lovelace
pMinPoolCost =
  ReadM Lovelace -> Mod OptionFields Lovelace -> Parser Lovelace
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser Lovelace -> ReadM Lovelace
forall a. Parser a -> ReadM a
readerFromParsecParser Parser Lovelace
parseLovelace) (Mod OptionFields Lovelace -> Parser Lovelace)
-> Mod OptionFields Lovelace -> Parser Lovelace
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Lovelace] -> Mod OptionFields Lovelace
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"min-pool-cost"
      , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"NATURAL"
      , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The minimum allowed cost parameter for stake pools."
      ]

pMaxBodySize :: Parser Word32
pMaxBodySize :: Parser Word32
pMaxBodySize =
  ReadM Word32 -> Mod OptionFields Word32 -> Parser Word32
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word32
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader (Mod OptionFields Word32 -> Parser Word32)
-> Mod OptionFields Word32 -> Parser Word32
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Word32] -> Mod OptionFields Word32
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields Word32
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"max-block-body-size"
      , String -> Mod OptionFields Word32
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"WORD32"
      , String -> Mod OptionFields Word32
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Maximal block body size."
      ]

pMaxTransactionSize :: Parser Word32
pMaxTransactionSize :: Parser Word32
pMaxTransactionSize =
  ReadM Word32 -> Mod OptionFields Word32 -> Parser Word32
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word32
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader (Mod OptionFields Word32 -> Parser Word32)
-> Mod OptionFields Word32 -> Parser Word32
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Word32] -> Mod OptionFields Word32
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields Word32
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"max-tx-size"
      , String -> Mod OptionFields Word32
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"WORD32"
      , String -> Mod OptionFields Word32
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Maximum transaction size."
      ]

-- | A parser for @(Int, Int)@-like expressions. In other words, 'integralReader'-lifted
-- to a pairs with a Haskell-like syntax.
pairIntegralReader :: (Typeable a, Integral a, Bits a) => ReadM (a, a)
pairIntegralReader :: forall a. (Typeable a, Integral a, Bits a) => ReadM (a, a)
pairIntegralReader = Parser (a, a) -> ReadM (a, a)
forall a. Parser a -> ReadM a
readerFromParsecParser Parser (a, a)
forall a. (Typeable a, Integral a, Bits a) => Parser (a, a)
pairIntegralParsecParser

pairIntegralParsecParser :: (Typeable a, Integral a, Bits a) => Parsec.Parser (a, a)
pairIntegralParsecParser :: forall a. (Typeable a, Integral a, Bits a) => Parser (a, a)
pairIntegralParsecParser = do
  ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
Parsec.spaces -- Skip initial spaces
  ParsecT String () Identity Char -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String () Identity Char -> ParsecT String () Identity ())
-> ParsecT String () Identity Char -> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'('
  ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
Parsec.spaces -- Skip spaces between opening paren and lhs
  a
lhs :: a <- Parser a
forall a. (Typeable a, Integral a, Bits a) => Parser a
integralParsecParser
  ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
Parsec.spaces -- Skip spaces between lhs and comma
  ParsecT String () Identity Char -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String () Identity Char -> ParsecT String () Identity ())
-> ParsecT String () Identity Char -> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
','
  ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
Parsec.spaces -- Skip spaces between comma and rhs
  a
rhs :: a <- Parser a
forall a. (Typeable a, Integral a, Bits a) => Parser a
integralParsecParser
  ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
Parsec.spaces -- Skip spaces between comma and closing paren
  ParsecT String () Identity Char -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String () Identity Char -> ParsecT String () Identity ())
-> ParsecT String () Identity Char -> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
')'
  ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
Parsec.spaces -- Skip trailing spaces
  (a, a) -> Parser (a, a)
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
lhs, a
rhs)

-- | @integralReader@ is a reader for a word of type @a@. When it fails
-- parsing, it provides a nice error message. This custom reader is needed
-- to avoid the overflow issues of 'Opt.auto' described in https://github.com/IntersectMBO/cardano-cli/issues/860.
integralReader :: (Typeable a, Integral a, Bits a) => ReadM a
integralReader :: forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader = Parser a -> ReadM a
forall a. Parser a -> ReadM a
readerFromParsecParser Parser a
forall a. (Typeable a, Integral a, Bits a) => Parser a
integralParsecParser

integralParsecParser :: forall a. (Typeable a, Integral a, Bits a) => Parsec.Parser a
integralParsecParser :: forall a. (Typeable a, Integral a, Bits a) => Parser a
integralParsecParser = do
  Integer
i <- ParsecT String () Identity Integer
decimal
  case Integer -> Maybe a
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
toIntegralSized Integer
i of
    Maybe a
Nothing -> String -> Parser a
forall a. String -> ParsecT String () Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$ String
"Cannot parse " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show Integer
i String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" as a " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
typeName
    Just a
n -> a -> Parser a
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return a
n
 where
  typeName :: String
typeName = TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)

pMaxBlockHeaderSize :: Parser Word16
pMaxBlockHeaderSize :: Parser Word16
pMaxBlockHeaderSize =
  ReadM Word16 -> Mod OptionFields Word16 -> Parser Word16
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word16
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader (Mod OptionFields Word16 -> Parser Word16)
-> Mod OptionFields Word16 -> Parser Word16
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Word16] -> Mod OptionFields Word16
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields Word16
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"max-block-header-size"
      , String -> Mod OptionFields Word16
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"WORD16"
      , String -> Mod OptionFields Word16
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Maximum block header size."
      ]

pKeyRegistDeposit :: Parser Lovelace
pKeyRegistDeposit :: Parser Lovelace
pKeyRegistDeposit =
  ReadM Lovelace -> Mod OptionFields Lovelace -> Parser Lovelace
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser Lovelace -> ReadM Lovelace
forall a. Parser a -> ReadM a
readerFromParsecParser Parser Lovelace
parseLovelace) (Mod OptionFields Lovelace -> Parser Lovelace)
-> Mod OptionFields Lovelace -> Parser Lovelace
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Lovelace] -> Mod OptionFields Lovelace
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"key-reg-deposit-amt"
      , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"NATURAL"
      , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Key registration deposit amount."
      ]

pDrepDeposit :: Parser Lovelace
pDrepDeposit :: Parser Lovelace
pDrepDeposit =
  ReadM Lovelace -> Mod OptionFields Lovelace -> Parser Lovelace
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser Lovelace -> ReadM Lovelace
forall a. Parser a -> ReadM a
readerFromParsecParser Parser Lovelace
parseLovelace) (Mod OptionFields Lovelace -> Parser Lovelace)
-> Mod OptionFields Lovelace -> Parser Lovelace
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Lovelace] -> Mod OptionFields Lovelace
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"deposit-amt"
      , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"LOVELACE"
      , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"DRep deposit amount (same at registration and retirement)."
      ]

pPoolDeposit :: Parser Lovelace
pPoolDeposit :: Parser Lovelace
pPoolDeposit =
  ReadM Lovelace -> Mod OptionFields Lovelace -> Parser Lovelace
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser Lovelace -> ReadM Lovelace
forall a. Parser a -> ReadM a
readerFromParsecParser Parser Lovelace
parseLovelace) (Mod OptionFields Lovelace -> Parser Lovelace)
-> Mod OptionFields Lovelace -> Parser Lovelace
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Lovelace] -> Mod OptionFields Lovelace
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"pool-reg-deposit"
      , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"NATURAL"
      , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The amount of a pool registration deposit."
      ]

pEpochBoundRetirement :: Parser L.EpochInterval
pEpochBoundRetirement :: Parser EpochInterval
pEpochBoundRetirement =
  (Word32 -> EpochInterval) -> Parser Word32 -> Parser EpochInterval
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> EpochInterval
L.EpochInterval (Parser Word32 -> Parser EpochInterval)
-> Parser Word32 -> Parser EpochInterval
forall a b. (a -> b) -> a -> b
$
    [Parser Word32] -> Parser Word32
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
      [ ReadM Word32 -> Mod OptionFields Word32 -> Parser Word32
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (String -> ReadM Word32
forall a. (Bounded a, Integral a, Show a) => String -> ReadM a
bounded String
"EPOCH_INTERVAL") (Mod OptionFields Word32 -> Parser Word32)
-> Mod OptionFields Word32 -> Parser Word32
forall a b. (a -> b) -> a -> b
$
          [Mod OptionFields Word32] -> Mod OptionFields Word32
forall a. Monoid a => [a] -> a
mconcat
            [ String -> Mod OptionFields Word32
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"pool-retirement-epoch-interval"
            , String -> Mod OptionFields Word32
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"WORD32"
            , String -> Mod OptionFields Word32
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Epoch interval of pool retirement."
            ]
      , ReadM Word32 -> Mod OptionFields Word32 -> Parser Word32
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (String -> ReadM Word32
forall a. (Bounded a, Integral a, Show a) => String -> ReadM a
bounded String
"EPOCH_BOUNDARY") (Mod OptionFields Word32 -> Parser Word32)
-> Mod OptionFields Word32 -> Parser Word32
forall a b. (a -> b) -> a -> b
$
          [Mod OptionFields Word32] -> Mod OptionFields Word32
forall a. Monoid a => [a] -> a
mconcat
            [ String -> Mod OptionFields Word32
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"pool-retirement-epoch-boundary"
            , Mod OptionFields Word32
forall (f :: * -> *) a. Mod f a
Opt.internal
            ]
      ]

pNumberOfPools :: Parser Natural
pNumberOfPools :: Parser Natural
pNumberOfPools =
  ReadM Natural -> Mod OptionFields Natural -> Parser Natural
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Natural
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader (Mod OptionFields Natural -> Parser Natural)
-> Mod OptionFields Natural -> Parser Natural
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Natural] -> Mod OptionFields Natural
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"number-of-pools"
      , String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"NATURAL"
      , String -> Mod OptionFields Natural
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Desired number of pools."
      ]

pPoolInfluence :: Parser Rational
pPoolInfluence :: Parser Rational
pPoolInfluence =
  ReadM Rational -> Mod OptionFields Rational -> Parser Rational
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Rational
readRational (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
"pool-influence"
      , 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
"Pool influence."
      ]

pTreasuryExpansion :: Parser Rational
pTreasuryExpansion :: Parser Rational
pTreasuryExpansion =
  ReadM Rational -> Mod OptionFields Rational -> Parser Rational
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Rational
readRationalUnitInterval (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
"treasury-expansion"
      , 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
"Treasury expansion."
      ]

pMonetaryExpansion :: Parser Rational
pMonetaryExpansion :: Parser Rational
pMonetaryExpansion =
  ReadM Rational -> Mod OptionFields Rational -> Parser Rational
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Rational
readRationalUnitInterval (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
"monetary-expansion"
      , 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
"Monetary expansion."
      ]

pDecentralParam :: Parser Rational
pDecentralParam :: Parser Rational
pDecentralParam =
  ReadM Rational -> Mod OptionFields Rational -> Parser Rational
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Rational
readRationalUnitInterval (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
"decentralization-parameter"
      , 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
"Decentralization parameter."
      ]

pExtraEntropy :: Parser (Maybe PraosNonce)
pExtraEntropy :: Parser (Maybe PraosNonce)
pExtraEntropy =
  [Parser (Maybe PraosNonce)] -> Parser (Maybe PraosNonce)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ ReadM (Maybe PraosNonce)
-> Mod OptionFields (Maybe PraosNonce) -> Parser (Maybe PraosNonce)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (PraosNonce -> Maybe PraosNonce
forall a. a -> Maybe a
Just (PraosNonce -> Maybe PraosNonce)
-> ReadM PraosNonce -> ReadM (Maybe PraosNonce)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PraosNonce -> ReadM PraosNonce
forall a. Parser a -> ReadM a
readerFromParsecParser Parser PraosNonce
parsePraosNonce) (Mod OptionFields (Maybe PraosNonce) -> Parser (Maybe PraosNonce))
-> Mod OptionFields (Maybe PraosNonce) -> Parser (Maybe PraosNonce)
forall a b. (a -> b) -> a -> b
$
        [Mod OptionFields (Maybe PraosNonce)]
-> Mod OptionFields (Maybe PraosNonce)
forall a. Monoid a => [a] -> a
mconcat
          [ String -> Mod OptionFields (Maybe PraosNonce)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"extra-entropy"
          , String -> Mod OptionFields (Maybe PraosNonce)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"HEX"
          , String -> Mod OptionFields (Maybe PraosNonce)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Praos extra entropy seed, as a hex byte string."
          ]
    , Maybe PraosNonce
-> Mod FlagFields (Maybe PraosNonce) -> Parser (Maybe PraosNonce)
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' Maybe PraosNonce
forall a. Maybe a
Nothing (Mod FlagFields (Maybe PraosNonce) -> Parser (Maybe PraosNonce))
-> Mod FlagFields (Maybe PraosNonce) -> Parser (Maybe PraosNonce)
forall a b. (a -> b) -> a -> b
$
        [Mod FlagFields (Maybe PraosNonce)]
-> Mod FlagFields (Maybe PraosNonce)
forall a. Monoid a => [a] -> a
mconcat
          [ String -> Mod FlagFields (Maybe PraosNonce)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"reset-extra-entropy"
          , String -> Mod FlagFields (Maybe PraosNonce)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Reset the Praos extra entropy to none."
          ]
    ]
 where
  parsePraosNonce :: Parsec.Parser PraosNonce
  parsePraosNonce :: Parser PraosNonce
parsePraosNonce = ByteString -> PraosNonce
makePraosNonce (ByteString -> PraosNonce)
-> ParsecT String () Identity ByteString -> Parser PraosNonce
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity ByteString
parseEntropyBytes

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

pUTxOCostPerByte :: Parser Lovelace
pUTxOCostPerByte :: Parser Lovelace
pUTxOCostPerByte =
  ReadM Lovelace -> Mod OptionFields Lovelace -> Parser Lovelace
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser Lovelace -> ReadM Lovelace
forall a. Parser a -> ReadM a
readerFromParsecParser Parser Lovelace
parseLovelace) (Mod OptionFields Lovelace -> Parser Lovelace)
-> Mod OptionFields Lovelace -> Parser Lovelace
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Lovelace] -> Mod OptionFields Lovelace
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"utxo-cost-per-byte"
      , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"LOVELACE"
      , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Cost in lovelace per unit of UTxO storage (from Babbage era)."
      ]

pExecutionUnitPrices :: Parser ExecutionUnitPrices
pExecutionUnitPrices :: Parser ExecutionUnitPrices
pExecutionUnitPrices =
  Rational -> Rational -> ExecutionUnitPrices
ExecutionUnitPrices
    (Rational -> Rational -> ExecutionUnitPrices)
-> Parser Rational -> Parser (Rational -> ExecutionUnitPrices)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Rational -> Mod OptionFields Rational -> Parser Rational
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ReadM Rational
readRational
      ( [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
"price-execution-steps"
          , 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 -> Mod OptionFields Rational)
-> String -> Mod OptionFields Rational
forall a b. (a -> b) -> a -> b
$
              [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                [ String
"Step price of execution units for script languages that use "
                , String
"them (from Alonzo era).  (Examples: '1.1', '11/10')"
                ]
          ]
      )
    Parser (Rational -> ExecutionUnitPrices)
-> Parser Rational -> Parser ExecutionUnitPrices
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM Rational -> Mod OptionFields Rational -> Parser Rational
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ReadM Rational
readRational
      ( [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
"price-execution-memory"
          , 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 -> Mod OptionFields Rational)
-> String -> Mod OptionFields Rational
forall a b. (a -> b) -> a -> b
$
              [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                [ String
"Memory price of execution units for script languages that "
                , String
"use them (from Alonzo era).  (Examples: '1.1', '11/10')"
                ]
          ]
      )

pMaxTxExecutionUnits :: Parser ExecutionUnits
pMaxTxExecutionUnits :: Parser ExecutionUnits
pMaxTxExecutionUnits =
  (Natural -> Natural -> ExecutionUnits)
-> (Natural, Natural) -> ExecutionUnits
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Natural -> Natural -> ExecutionUnits
ExecutionUnits
    ((Natural, Natural) -> ExecutionUnits)
-> Parser (Natural, Natural) -> Parser ExecutionUnits
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM (Natural, Natural)
-> Mod OptionFields (Natural, Natural) -> Parser (Natural, Natural)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ReadM (Natural, Natural)
forall a. (Typeable a, Integral a, Bits a) => ReadM (a, a)
pairIntegralReader
      ( [Mod OptionFields (Natural, Natural)]
-> Mod OptionFields (Natural, Natural)
forall a. Monoid a => [a] -> a
mconcat
          [ String -> Mod OptionFields (Natural, Natural)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"max-tx-execution-units"
          , String -> Mod OptionFields (Natural, Natural)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"(INT, INT)"
          , String -> Mod OptionFields (Natural, Natural)
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod OptionFields (Natural, Natural))
-> String -> Mod OptionFields (Natural, Natural)
forall a b. (a -> b) -> a -> b
$
              [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                [ String
"Max total script execution resources units allowed per tx "
                , String
"(from Alonzo era). They are denominated as follows (steps, memory)."
                ]
          ]
      )

pMaxBlockExecutionUnits :: Parser ExecutionUnits
pMaxBlockExecutionUnits :: Parser ExecutionUnits
pMaxBlockExecutionUnits =
  (Natural -> Natural -> ExecutionUnits)
-> (Natural, Natural) -> ExecutionUnits
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Natural -> Natural -> ExecutionUnits
ExecutionUnits
    ((Natural, Natural) -> ExecutionUnits)
-> Parser (Natural, Natural) -> Parser ExecutionUnits
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM (Natural, Natural)
-> Mod OptionFields (Natural, Natural) -> Parser (Natural, Natural)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ReadM (Natural, Natural)
forall a. (Typeable a, Integral a, Bits a) => ReadM (a, a)
pairIntegralReader
      ( [Mod OptionFields (Natural, Natural)]
-> Mod OptionFields (Natural, Natural)
forall a. Monoid a => [a] -> a
mconcat
          [ String -> Mod OptionFields (Natural, Natural)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"max-block-execution-units"
          , String -> Mod OptionFields (Natural, Natural)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"(INT, INT)"
          , String -> Mod OptionFields (Natural, Natural)
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod OptionFields (Natural, Natural))
-> String -> Mod OptionFields (Natural, Natural)
forall a b. (a -> b) -> a -> b
$
              [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                [ String
"Max total script execution resources units allowed per block "
                , String
"(from Alonzo era). They are denominated as follows (steps, memory)."
                ]
          ]
      )

pMaxValueSize :: Parser Natural
pMaxValueSize :: Parser Natural
pMaxValueSize =
  ReadM Natural -> Mod OptionFields Natural -> Parser Natural
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Natural
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader (Mod OptionFields Natural -> Parser Natural)
-> Mod OptionFields Natural -> Parser Natural
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Natural] -> Mod OptionFields Natural
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"max-value-size"
      , String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"INT"
      , String -> Mod OptionFields Natural
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod OptionFields Natural)
-> String -> Mod OptionFields Natural
forall a b. (a -> b) -> a -> b
$
          [String] -> String
forall a. Monoid a => [a] -> a
mconcat
            [ String
"Max size of a multi-asset value in a tx output (from Alonzo era)."
            ]
      ]

pCollateralPercent :: Parser Natural
pCollateralPercent :: Parser Natural
pCollateralPercent =
  ReadM Natural -> Mod OptionFields Natural -> Parser Natural
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Natural
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader (Mod OptionFields Natural -> Parser Natural)
-> Mod OptionFields Natural -> Parser Natural
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Natural] -> Mod OptionFields Natural
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"collateral-percent"
      , String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"INT"
      , String -> Mod OptionFields Natural
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod OptionFields Natural)
-> String -> Mod OptionFields Natural
forall a b. (a -> b) -> a -> b
$
          [String] -> String
forall a. Monoid a => [a] -> a
mconcat
            [ String
"The percentage of the script contribution to the txfee that "
            , String
"must be provided as collateral inputs when including Plutus "
            , String
"scripts (from Alonzo era)."
            ]
      ]

pMaxCollateralInputs :: Parser Natural
pMaxCollateralInputs :: Parser Natural
pMaxCollateralInputs =
  ReadM Natural -> Mod OptionFields Natural -> Parser Natural
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Natural
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader (Mod OptionFields Natural -> Parser Natural)
-> Mod OptionFields Natural -> Parser Natural
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Natural] -> Mod OptionFields Natural
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"max-collateral-inputs"
      , String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"INT"
      , String -> Mod OptionFields Natural
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod OptionFields Natural)
-> String -> Mod OptionFields Natural
forall a b. (a -> b) -> a -> b
$
          [String] -> String
forall a. Monoid a => [a] -> a
mconcat
            [ String
"The maximum number of collateral inputs allowed in a "
            , String
"transaction (from Alonzo era)."
            ]
      ]

pProtocolVersion :: Parser (Natural, Natural)
pProtocolVersion :: Parser (Natural, Natural)
pProtocolVersion =
  (,) (Natural -> Natural -> (Natural, Natural))
-> Parser Natural -> Parser (Natural -> (Natural, Natural))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Natural
pProtocolMajorVersion Parser (Natural -> (Natural, Natural))
-> Parser Natural -> Parser (Natural, Natural)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Natural
pProtocolMinorVersion
 where
  pProtocolMajorVersion :: Parser Natural
pProtocolMajorVersion =
    ReadM Natural -> Mod OptionFields Natural -> Parser Natural
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Natural
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader (Mod OptionFields Natural -> Parser Natural)
-> Mod OptionFields Natural -> Parser Natural
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields Natural] -> Mod OptionFields Natural
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"protocol-major-version"
        , String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"MAJOR"
        , String -> Mod OptionFields Natural
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod OptionFields Natural)
-> String -> Mod OptionFields Natural
forall a b. (a -> b) -> a -> b
$
            [String] -> String
forall a. Monoid a => [a] -> a
mconcat
              [ String
"Specify the major protocol version to fork into. An increase indicates a hard fork. "
              , String
"It must be the next natural number after the current version and must be supported by the node."
              ]
        ]
  pProtocolMinorVersion :: Parser Natural
pProtocolMinorVersion =
    ReadM Natural -> Mod OptionFields Natural -> Parser Natural
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Natural
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader (Mod OptionFields Natural -> Parser Natural)
-> Mod OptionFields Natural -> Parser Natural
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields Natural] -> Mod OptionFields Natural
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"protocol-minor-version"
        , String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"MINOR"
        , String -> Mod OptionFields Natural
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod OptionFields Natural)
-> String -> Mod OptionFields Natural
forall a b. (a -> b) -> a -> b
$
            [String] -> String
forall a. Monoid a => [a] -> a
mconcat
              [ String
"Minor protocol version. An increase indicates a soft fork "
              , String
"(old software can validate but not produce new blocks). "
              , String
"Must be zero when the major protocol version is increased."
              ]
        ]

pPoolVotingThresholds :: Parser L.PoolVotingThresholds
pPoolVotingThresholds :: Parser PoolVotingThresholds
pPoolVotingThresholds =
  UnitInterval
-> UnitInterval
-> UnitInterval
-> UnitInterval
-> UnitInterval
-> PoolVotingThresholds
L.PoolVotingThresholds
    (UnitInterval
 -> UnitInterval
 -> UnitInterval
 -> UnitInterval
 -> UnitInterval
 -> PoolVotingThresholds)
-> Parser UnitInterval
-> Parser
     (UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> PoolVotingThresholds)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser UnitInterval
pMotionNoConfidence
    Parser
  (UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> PoolVotingThresholds)
-> Parser UnitInterval
-> Parser
     (UnitInterval
      -> UnitInterval -> UnitInterval -> PoolVotingThresholds)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser UnitInterval
pCommitteeNormal
    Parser
  (UnitInterval
   -> UnitInterval -> UnitInterval -> PoolVotingThresholds)
-> Parser UnitInterval
-> Parser (UnitInterval -> UnitInterval -> PoolVotingThresholds)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser UnitInterval
pCommitteeNoConfidence
    Parser (UnitInterval -> UnitInterval -> PoolVotingThresholds)
-> Parser UnitInterval
-> Parser (UnitInterval -> PoolVotingThresholds)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser UnitInterval
pHardForkInitiation
    Parser (UnitInterval -> PoolVotingThresholds)
-> Parser UnitInterval -> Parser PoolVotingThresholds
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser UnitInterval
pPPSecurityGroup
 where
  pMotionNoConfidence :: Parser UnitInterval
pMotionNoConfidence =
    ReadM UnitInterval
-> Mod OptionFields UnitInterval -> Parser UnitInterval
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Rational -> UnitInterval
toUnitIntervalOrErr (Rational -> UnitInterval) -> ReadM Rational -> ReadM UnitInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Rational
readRationalUnitInterval) (Mod OptionFields UnitInterval -> Parser UnitInterval)
-> Mod OptionFields UnitInterval -> Parser UnitInterval
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields UnitInterval] -> Mod OptionFields UnitInterval
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"pool-voting-threshold-motion-no-confidence"
        , String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"RATIONAL"
        , String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Acceptance threshold for stake pool votes on motions no confidence."
        ]
  pCommitteeNormal :: Parser UnitInterval
pCommitteeNormal =
    ReadM UnitInterval
-> Mod OptionFields UnitInterval -> Parser UnitInterval
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Rational -> UnitInterval
toUnitIntervalOrErr (Rational -> UnitInterval) -> ReadM Rational -> ReadM UnitInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Rational
readRationalUnitInterval) (Mod OptionFields UnitInterval -> Parser UnitInterval)
-> Mod OptionFields UnitInterval -> Parser UnitInterval
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields UnitInterval] -> Mod OptionFields UnitInterval
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"pool-voting-threshold-committee-normal"
        , String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"RATIONAL"
        , String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Acceptance threshold for stake pool votes on normal committee updates."
        ]
  pCommitteeNoConfidence :: Parser UnitInterval
pCommitteeNoConfidence =
    ReadM UnitInterval
-> Mod OptionFields UnitInterval -> Parser UnitInterval
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Rational -> UnitInterval
toUnitIntervalOrErr (Rational -> UnitInterval) -> ReadM Rational -> ReadM UnitInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Rational
readRationalUnitInterval) (Mod OptionFields UnitInterval -> Parser UnitInterval)
-> Mod OptionFields UnitInterval -> Parser UnitInterval
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields UnitInterval] -> Mod OptionFields UnitInterval
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"pool-voting-threshold-committee-no-confidence"
        , String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"RATIONAL"
        , String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. String -> Mod f a
Opt.help
            String
"Acceptance threshold for stake pool votes on committee updates when the committee is in a state of no confidence."
        ]
  pHardForkInitiation :: Parser UnitInterval
pHardForkInitiation =
    ReadM UnitInterval
-> Mod OptionFields UnitInterval -> Parser UnitInterval
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Rational -> UnitInterval
toUnitIntervalOrErr (Rational -> UnitInterval) -> ReadM Rational -> ReadM UnitInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Rational
readRationalUnitInterval) (Mod OptionFields UnitInterval -> Parser UnitInterval)
-> Mod OptionFields UnitInterval -> Parser UnitInterval
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields UnitInterval] -> Mod OptionFields UnitInterval
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"pool-voting-threshold-hard-fork-initiation"
        , String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"RATIONAL"
        , String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Acceptance threshold for stake pool votes on hard fork initiations."
        ]
  pPPSecurityGroup :: Parser UnitInterval
pPPSecurityGroup =
    ReadM UnitInterval
-> Mod OptionFields UnitInterval -> Parser UnitInterval
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Rational -> UnitInterval
toUnitIntervalOrErr (Rational -> UnitInterval) -> ReadM Rational -> ReadM UnitInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Rational
readRationalUnitInterval) (Mod OptionFields UnitInterval -> Parser UnitInterval)
-> Mod OptionFields UnitInterval -> Parser UnitInterval
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields UnitInterval] -> Mod OptionFields UnitInterval
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"pool-voting-threshold-pp-security-group"
        , String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"RATIONAL"
        , String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. String -> Mod f a
Opt.help
            String
"Acceptance threshold for stake pool votes on protocol parameters for parameters in the 'security' group."
        ]

pDRepVotingThresholds :: Parser L.DRepVotingThresholds
pDRepVotingThresholds :: Parser DRepVotingThresholds
pDRepVotingThresholds =
  UnitInterval
-> UnitInterval
-> UnitInterval
-> UnitInterval
-> UnitInterval
-> UnitInterval
-> UnitInterval
-> UnitInterval
-> UnitInterval
-> UnitInterval
-> DRepVotingThresholds
L.DRepVotingThresholds
    (UnitInterval
 -> UnitInterval
 -> UnitInterval
 -> UnitInterval
 -> UnitInterval
 -> UnitInterval
 -> UnitInterval
 -> UnitInterval
 -> UnitInterval
 -> UnitInterval
 -> DRepVotingThresholds)
-> Parser UnitInterval
-> Parser
     (UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> DRepVotingThresholds)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser UnitInterval
pMotionNoConfidence
    Parser
  (UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> DRepVotingThresholds)
-> Parser UnitInterval
-> Parser
     (UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> DRepVotingThresholds)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser UnitInterval
pCommitteeNormal
    Parser
  (UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> DRepVotingThresholds)
-> Parser UnitInterval
-> Parser
     (UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> DRepVotingThresholds)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser UnitInterval
pCommitteeNoConfidence
    Parser
  (UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> DRepVotingThresholds)
-> Parser UnitInterval
-> Parser
     (UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> DRepVotingThresholds)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser UnitInterval
pUpdateToConstitution
    Parser
  (UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> DRepVotingThresholds)
-> Parser UnitInterval
-> Parser
     (UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> DRepVotingThresholds)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser UnitInterval
pHardForkInitiation
    Parser
  (UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> DRepVotingThresholds)
-> Parser UnitInterval
-> Parser
     (UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> DRepVotingThresholds)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser UnitInterval
pPPNetworkGroup
    Parser
  (UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> DRepVotingThresholds)
-> Parser UnitInterval
-> Parser
     (UnitInterval
      -> UnitInterval -> UnitInterval -> DRepVotingThresholds)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser UnitInterval
pPPEconomicGroup
    Parser
  (UnitInterval
   -> UnitInterval -> UnitInterval -> DRepVotingThresholds)
-> Parser UnitInterval
-> Parser (UnitInterval -> UnitInterval -> DRepVotingThresholds)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser UnitInterval
pPPTechnicalGroup
    Parser (UnitInterval -> UnitInterval -> DRepVotingThresholds)
-> Parser UnitInterval
-> Parser (UnitInterval -> DRepVotingThresholds)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser UnitInterval
pPPGovGroup
    Parser (UnitInterval -> DRepVotingThresholds)
-> Parser UnitInterval -> Parser DRepVotingThresholds
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser UnitInterval
pTreasuryWithdrawal
 where
  pMotionNoConfidence :: Parser UnitInterval
pMotionNoConfidence =
    ReadM UnitInterval
-> Mod OptionFields UnitInterval -> Parser UnitInterval
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Rational -> UnitInterval
toUnitIntervalOrErr (Rational -> UnitInterval) -> ReadM Rational -> ReadM UnitInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Rational
readRationalUnitInterval) (Mod OptionFields UnitInterval -> Parser UnitInterval)
-> Mod OptionFields UnitInterval -> Parser UnitInterval
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields UnitInterval] -> Mod OptionFields UnitInterval
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"drep-voting-threshold-motion-no-confidence"
        , String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"RATIONAL"
        , String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Acceptance threshold for DRep votes on motions of no confidence."
        ]
  pCommitteeNormal :: Parser UnitInterval
pCommitteeNormal =
    ReadM UnitInterval
-> Mod OptionFields UnitInterval -> Parser UnitInterval
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Rational -> UnitInterval
toUnitIntervalOrErr (Rational -> UnitInterval) -> ReadM Rational -> ReadM UnitInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Rational
readRationalUnitInterval) (Mod OptionFields UnitInterval -> Parser UnitInterval)
-> Mod OptionFields UnitInterval -> Parser UnitInterval
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields UnitInterval] -> Mod OptionFields UnitInterval
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"drep-voting-threshold-committee-normal"
        , String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"RATIONAL"
        , String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Acceptance threshold for DRep votes on normal committee updates."
        ]
  pCommitteeNoConfidence :: Parser UnitInterval
pCommitteeNoConfidence =
    ReadM UnitInterval
-> Mod OptionFields UnitInterval -> Parser UnitInterval
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Rational -> UnitInterval
toUnitIntervalOrErr (Rational -> UnitInterval) -> ReadM Rational -> ReadM UnitInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Rational
readRationalUnitInterval) (Mod OptionFields UnitInterval -> Parser UnitInterval)
-> Mod OptionFields UnitInterval -> Parser UnitInterval
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields UnitInterval] -> Mod OptionFields UnitInterval
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"drep-voting-threshold-committee-no-confidence"
        , String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"RATIONAL"
        , String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. String -> Mod f a
Opt.help
            String
"Acceptance threshold for DRep votes on committee updates when the committee is in a state of no confidence."
        ]
  pUpdateToConstitution :: Parser UnitInterval
pUpdateToConstitution =
    ReadM UnitInterval
-> Mod OptionFields UnitInterval -> Parser UnitInterval
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Rational -> UnitInterval
toUnitIntervalOrErr (Rational -> UnitInterval) -> ReadM Rational -> ReadM UnitInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Rational
readRationalUnitInterval) (Mod OptionFields UnitInterval -> Parser UnitInterval)
-> Mod OptionFields UnitInterval -> Parser UnitInterval
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields UnitInterval] -> Mod OptionFields UnitInterval
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"drep-voting-threshold-update-to-constitution"
        , String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"RATIONAL"
        , String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Acceptance threshold for DRep votes on constitution updates."
        ]
  pHardForkInitiation :: Parser UnitInterval
pHardForkInitiation =
    ReadM UnitInterval
-> Mod OptionFields UnitInterval -> Parser UnitInterval
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Rational -> UnitInterval
toUnitIntervalOrErr (Rational -> UnitInterval) -> ReadM Rational -> ReadM UnitInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Rational
readRationalUnitInterval) (Mod OptionFields UnitInterval -> Parser UnitInterval)
-> Mod OptionFields UnitInterval -> Parser UnitInterval
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields UnitInterval] -> Mod OptionFields UnitInterval
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"drep-voting-threshold-hard-fork-initiation"
        , String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"RATIONAL"
        , String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Acceptance threshold for DRep votes on hard fork initiations."
        ]
  pPPNetworkGroup :: Parser UnitInterval
pPPNetworkGroup =
    ReadM UnitInterval
-> Mod OptionFields UnitInterval -> Parser UnitInterval
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Rational -> UnitInterval
toUnitIntervalOrErr (Rational -> UnitInterval) -> ReadM Rational -> ReadM UnitInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Rational
readRationalUnitInterval) (Mod OptionFields UnitInterval -> Parser UnitInterval)
-> Mod OptionFields UnitInterval -> Parser UnitInterval
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields UnitInterval] -> Mod OptionFields UnitInterval
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"drep-voting-threshold-pp-network-group"
        , String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"RATIONAL"
        , String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. String -> Mod f a
Opt.help
            String
"Acceptance threshold for DRep votes on protocol parameters for parameters in the 'network' group."
        ]
  pPPEconomicGroup :: Parser UnitInterval
pPPEconomicGroup =
    ReadM UnitInterval
-> Mod OptionFields UnitInterval -> Parser UnitInterval
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Rational -> UnitInterval
toUnitIntervalOrErr (Rational -> UnitInterval) -> ReadM Rational -> ReadM UnitInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Rational
readRationalUnitInterval) (Mod OptionFields UnitInterval -> Parser UnitInterval)
-> Mod OptionFields UnitInterval -> Parser UnitInterval
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields UnitInterval] -> Mod OptionFields UnitInterval
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"drep-voting-threshold-pp-economic-group"
        , String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"RATIONAL"
        , String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. String -> Mod f a
Opt.help
            String
"Acceptance threshold for DRep votes on protocol parameters for parameters in the 'economic' group."
        ]
  pPPTechnicalGroup :: Parser UnitInterval
pPPTechnicalGroup =
    ReadM UnitInterval
-> Mod OptionFields UnitInterval -> Parser UnitInterval
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Rational -> UnitInterval
toUnitIntervalOrErr (Rational -> UnitInterval) -> ReadM Rational -> ReadM UnitInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Rational
readRationalUnitInterval) (Mod OptionFields UnitInterval -> Parser UnitInterval)
-> Mod OptionFields UnitInterval -> Parser UnitInterval
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields UnitInterval] -> Mod OptionFields UnitInterval
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"drep-voting-threshold-pp-technical-group"
        , String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"RATIONAL"
        , String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. String -> Mod f a
Opt.help
            String
"Acceptance threshold for DRep votes on protocol parameters for parameters in the 'technical' group."
        ]
  pPPGovGroup :: Parser UnitInterval
pPPGovGroup =
    ReadM UnitInterval
-> Mod OptionFields UnitInterval -> Parser UnitInterval
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Rational -> UnitInterval
toUnitIntervalOrErr (Rational -> UnitInterval) -> ReadM Rational -> ReadM UnitInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Rational
readRationalUnitInterval) (Mod OptionFields UnitInterval -> Parser UnitInterval)
-> Mod OptionFields UnitInterval -> Parser UnitInterval
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields UnitInterval] -> Mod OptionFields UnitInterval
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"drep-voting-threshold-pp-governance-group"
        , String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"RATIONAL"
        , String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. String -> Mod f a
Opt.help
            String
"Acceptance threshold for DRep votes on protocol parameters for parameters in the 'governance' group."
        ]
  pTreasuryWithdrawal :: Parser UnitInterval
pTreasuryWithdrawal =
    ReadM UnitInterval
-> Mod OptionFields UnitInterval -> Parser UnitInterval
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Rational -> UnitInterval
toUnitIntervalOrErr (Rational -> UnitInterval) -> ReadM Rational -> ReadM UnitInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Rational
readRationalUnitInterval) (Mod OptionFields UnitInterval -> Parser UnitInterval)
-> Mod OptionFields UnitInterval -> Parser UnitInterval
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields UnitInterval] -> Mod OptionFields UnitInterval
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"drep-voting-threshold-treasury-withdrawal"
        , String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"RATIONAL"
        , String -> Mod OptionFields UnitInterval
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Acceptance threshold for DRep votes on treasury withdrawals."
        ]

pMinCommitteeSize :: Parser Natural
pMinCommitteeSize :: Parser Natural
pMinCommitteeSize =
  ReadM Natural -> Mod OptionFields Natural -> Parser Natural
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Natural
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader (Mod OptionFields Natural -> Parser Natural)
-> Mod OptionFields Natural -> Parser Natural
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Natural] -> Mod OptionFields Natural
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"min-committee-size"
      , String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"INT"
      , String -> Mod OptionFields Natural
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Minimal size of the constitutional committee."
      ]

pCommitteeTermLength :: Parser L.EpochInterval
pCommitteeTermLength :: Parser EpochInterval
pCommitteeTermLength =
  (Word32 -> EpochInterval) -> Parser Word32 -> Parser EpochInterval
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> EpochInterval
L.EpochInterval (Parser Word32 -> Parser EpochInterval)
-> Parser Word32 -> Parser EpochInterval
forall a b. (a -> b) -> a -> b
$
    ReadM Word32 -> Mod OptionFields Word32 -> Parser Word32
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (String -> ReadM Word32
forall a. (Bounded a, Integral a, Show a) => String -> ReadM a
bounded String
"EPOCH_INTERVAL") (Mod OptionFields Word32 -> Parser Word32)
-> Mod OptionFields Word32 -> Parser Word32
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields Word32] -> Mod OptionFields Word32
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod OptionFields Word32
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"committee-term-length"
        , String -> Mod OptionFields Word32
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"WORD32"
        , String -> Mod OptionFields Word32
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Maximal term length for members of the constitutional committee, in epochs."
        ]

pGovActionLifetime :: Parser L.EpochInterval
pGovActionLifetime :: Parser EpochInterval
pGovActionLifetime =
  (Word32 -> EpochInterval) -> Parser Word32 -> Parser EpochInterval
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> EpochInterval
L.EpochInterval (Parser Word32 -> Parser EpochInterval)
-> Parser Word32 -> Parser EpochInterval
forall a b. (a -> b) -> a -> b
$
    ReadM Word32 -> Mod OptionFields Word32 -> Parser Word32
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (String -> ReadM Word32
forall a. (Bounded a, Integral a, Show a) => String -> ReadM a
bounded String
"EPOCH_INTERVAL") (Mod OptionFields Word32 -> Parser Word32)
-> Mod OptionFields Word32 -> Parser Word32
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields Word32] -> Mod OptionFields Word32
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod OptionFields Word32
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"governance-action-lifetime"
        , String -> Mod OptionFields Word32
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"WORD32"
        , String -> Mod OptionFields Word32
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Maximal lifetime of governance actions, in epochs."
        ]

pDRepDeposit :: Parser Lovelace
pDRepDeposit :: Parser Lovelace
pDRepDeposit =
  ReadM Lovelace -> Mod OptionFields Lovelace -> Parser Lovelace
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser Lovelace -> ReadM Lovelace
forall a. Parser a -> ReadM a
readerFromParsecParser Parser Lovelace
parseLovelace) (Mod OptionFields Lovelace -> Parser Lovelace)
-> Mod OptionFields Lovelace -> Parser Lovelace
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Lovelace] -> Mod OptionFields Lovelace
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"drep-deposit"
      , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"LOVELACE"
      , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"DRep deposit amount."
      ]

pDRepActivity :: Parser L.EpochInterval
pDRepActivity :: Parser EpochInterval
pDRepActivity =
  (Word32 -> EpochInterval) -> Parser Word32 -> Parser EpochInterval
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> EpochInterval
L.EpochInterval (Parser Word32 -> Parser EpochInterval)
-> Parser Word32 -> Parser EpochInterval
forall a b. (a -> b) -> a -> b
$
    ReadM Word32 -> Mod OptionFields Word32 -> Parser Word32
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (String -> ReadM Word32
forall a. (Bounded a, Integral a, Show a) => String -> ReadM a
bounded String
"EPOCH_INTERVAL") (Mod OptionFields Word32 -> Parser Word32)
-> Mod OptionFields Word32 -> Parser Word32
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields Word32] -> Mod OptionFields Word32
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod OptionFields Word32
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"drep-activity"
        , String -> Mod OptionFields Word32
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"WORD32"
        , String -> Mod OptionFields Word32
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"DRep activity period, in epochs."
        ]

parseTxOutShelleyBasedEra
  :: Parsec.Parser (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutShelleyBasedEra)
parseTxOutShelleyBasedEra :: Parser
  (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutShelleyBasedEra)
parseTxOutShelleyBasedEra = do
  Address ShelleyAddr
addr <- Parser (Address ShelleyAddr)
parseShelleyAddress
  ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
Parsec.spaces
  -- Accept the old style of separating the address and value in a
  -- transaction output:
  ()
-> ParsecT String () Identity () -> ParsecT String () Identity ()
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
Parsec.option () (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'+' ParsecT String () Identity Char
-> ParsecT String () Identity () -> ParsecT String () Identity ()
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
Parsec.spaces)
  Value
val <- Parser Value
parseValue
  (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutShelleyBasedEra)
-> Parser
     (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutShelleyBasedEra)
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Address ShelleyAddr
-> Value
-> TxOutDatumAnyEra
-> ReferenceScriptAnyEra
-> TxOutShelleyBasedEra
TxOutShelleyBasedEra Address ShelleyAddr
addr Value
val)

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

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

--------------------------------------------------------------------------------

pVoteChoice :: Parser Vote
pVoteChoice :: Parser Vote
pVoteChoice =
  [Parser Vote] -> Parser Vote
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ Vote -> Mod FlagFields Vote -> Parser Vote
forall a. a -> Mod FlagFields a -> Parser a
flag' Vote
Yes (Mod FlagFields Vote -> Parser Vote)
-> Mod FlagFields Vote -> Parser Vote
forall a b. (a -> b) -> a -> b
$ String -> Mod FlagFields Vote
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"yes"
    , Vote -> Mod FlagFields Vote -> Parser Vote
forall a. a -> Mod FlagFields a -> Parser a
flag' Vote
No (Mod FlagFields Vote -> Parser Vote)
-> Mod FlagFields Vote -> Parser Vote
forall a b. (a -> b) -> a -> b
$ String -> Mod FlagFields Vote
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"no"
    , Vote -> Mod FlagFields Vote -> Parser Vote
forall a. a -> Mod FlagFields a -> Parser a
flag' Vote
Abstain (Mod FlagFields Vote -> Parser Vote)
-> Mod FlagFields Vote -> Parser Vote
forall a b. (a -> b) -> a -> b
$ String -> Mod FlagFields Vote
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"abstain"
    ]

pVoterType :: Parser VType
pVoterType :: Parser VType
pVoterType =
  [Parser VType] -> Parser VType
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ VType -> Mod FlagFields VType -> Parser VType
forall a. a -> Mod FlagFields a -> Parser a
flag' VType
VCC (Mod FlagFields VType -> Parser VType)
-> Mod FlagFields VType -> Parser VType
forall a b. (a -> b) -> a -> b
$
        [Mod FlagFields VType] -> Mod FlagFields VType
forall a. Monoid a => [a] -> a
mconcat [String -> Mod FlagFields VType
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"constitutional-committee-member", String -> Mod FlagFields VType
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Member of the constiutional committee"]
    , VType -> Mod FlagFields VType -> Parser VType
forall a. a -> Mod FlagFields a -> Parser a
flag' VType
VDR (Mod FlagFields VType -> Parser VType)
-> Mod FlagFields VType -> Parser VType
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields VType] -> Mod FlagFields VType
forall a. Monoid a => [a] -> a
mconcat [String -> Mod FlagFields VType
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"drep", String -> Mod FlagFields VType
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Delegated representative"]
    , VType -> Mod FlagFields VType -> Parser VType
forall a. a -> Mod FlagFields a -> Parser a
flag' VType
VSP (Mod FlagFields VType -> Parser VType)
-> Mod FlagFields VType -> Parser VType
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields VType] -> Mod FlagFields VType
forall a. Monoid a => [a] -> a
mconcat [String -> Mod FlagFields VType
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"spo", String -> Mod FlagFields VType
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Stake pool operator"]
    ]

-- TODO: Conway era include "normal" stake keys
pVotingCredential :: Parser (VerificationKeyOrFile StakePoolKey)
pVotingCredential :: Parser (VerificationKeyOrFile StakePoolKey)
pVotingCredential = Maybe String -> Parser (VerificationKeyOrFile StakePoolKey)
pStakePoolVerificationKeyOrFile Maybe String
forall a. Maybe a
Nothing

pVoteDelegationTarget :: Parser VoteDelegationTarget
pVoteDelegationTarget :: Parser VoteDelegationTarget
pVoteDelegationTarget =
  [Parser VoteDelegationTarget] -> Parser VoteDelegationTarget
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ DRepHashSource -> VoteDelegationTarget
VoteDelegationTargetOfDRep (DRepHashSource -> VoteDelegationTarget)
-> Parser DRepHashSource -> Parser VoteDelegationTarget
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DRepHashSource
pDRepHashSource
    , VoteDelegationTarget
VoteDelegationTargetOfAbstain VoteDelegationTarget -> Parser () -> Parser VoteDelegationTarget
forall a b. a -> Parser b -> Parser a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
pAlwaysAbstain
    , VoteDelegationTarget
VoteDelegationTargetOfNoConfidence VoteDelegationTarget -> Parser () -> Parser VoteDelegationTarget
forall a b. a -> Parser b -> Parser a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
pAlwaysNoConfidence
    ]

pAlwaysAbstain :: Parser ()
pAlwaysAbstain :: Parser ()
pAlwaysAbstain =
  () -> Mod FlagFields () -> Parser ()
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' () (Mod FlagFields () -> Parser ()) -> Mod FlagFields () -> Parser ()
forall a b. (a -> b) -> a -> b
$
    [Mod FlagFields ()] -> Mod FlagFields ()
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod FlagFields ()
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"always-abstain"
      , String -> Mod FlagFields ()
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Abstain from voting on all proposals."
      ]

pVoteAnchor :: Parser (VoteUrl, L.SafeHash L.StandardCrypto L.AnchorData)
pVoteAnchor :: Parser (VoteUrl, SafeHash StandardCrypto AnchorData)
pVoteAnchor =
  ((,) (VoteUrl
 -> SafeHash StandardCrypto AnchorData
 -> (VoteUrl, SafeHash StandardCrypto AnchorData))
-> (Url -> VoteUrl)
-> Url
-> SafeHash StandardCrypto AnchorData
-> (VoteUrl, SafeHash StandardCrypto AnchorData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Url -> VoteUrl
VoteUrl (Url
 -> SafeHash StandardCrypto AnchorData
 -> (VoteUrl, SafeHash StandardCrypto AnchorData))
-> Parser Url
-> Parser
     (SafeHash StandardCrypto AnchorData
      -> (VoteUrl, SafeHash StandardCrypto AnchorData))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser Url
pUrl String
"anchor-url" String
"Vote anchor URL")
    Parser
  (SafeHash StandardCrypto AnchorData
   -> (VoteUrl, SafeHash StandardCrypto AnchorData))
-> Parser (SafeHash StandardCrypto AnchorData)
-> Parser (VoteUrl, SafeHash StandardCrypto AnchorData)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (SafeHash StandardCrypto AnchorData)
pVoteAnchorDataHash

pVoteAnchorDataHash :: Parser (L.SafeHash L.StandardCrypto L.AnchorData)
pVoteAnchorDataHash :: Parser (SafeHash StandardCrypto AnchorData)
pVoteAnchorDataHash =
  ReadM (SafeHash StandardCrypto AnchorData)
-> Mod OptionFields (SafeHash StandardCrypto AnchorData)
-> Parser (SafeHash StandardCrypto AnchorData)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM (SafeHash StandardCrypto AnchorData)
readSafeHash (Mod OptionFields (SafeHash StandardCrypto AnchorData)
 -> Parser (SafeHash StandardCrypto AnchorData))
-> Mod OptionFields (SafeHash StandardCrypto AnchorData)
-> Parser (SafeHash StandardCrypto AnchorData)
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields (SafeHash StandardCrypto AnchorData)]
-> Mod OptionFields (SafeHash StandardCrypto AnchorData)
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields (SafeHash StandardCrypto AnchorData)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"anchor-data-hash"
      , String -> Mod OptionFields (SafeHash StandardCrypto AnchorData)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"HASH"
      , String -> Mod OptionFields (SafeHash StandardCrypto AnchorData)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Hash of the vote anchor data (obtain it with \"cardano-cli hash anchor-data ...\")."
      ]

pAlwaysNoConfidence :: Parser ()
pAlwaysNoConfidence :: Parser ()
pAlwaysNoConfidence =
  () -> Mod FlagFields () -> Parser ()
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' () (Mod FlagFields () -> Parser ()) -> Mod FlagFields () -> Parser ()
forall a b. (a -> b) -> a -> b
$
    [Mod FlagFields ()] -> Mod FlagFields ()
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod FlagFields ()
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"always-no-confidence"
      , String -> Mod FlagFields ()
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Always vote no confidence"
      ]

pDrepRefund :: Parser (DRepHashSource, Lovelace)
pDrepRefund :: Parser (DRepHashSource, Lovelace)
pDrepRefund =
  (,)
    (DRepHashSource -> Lovelace -> (DRepHashSource, Lovelace))
-> Parser DRepHashSource
-> Parser (Lovelace -> (DRepHashSource, Lovelace))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DRepHashSource
pDRepHashSource
    Parser (Lovelace -> (DRepHashSource, Lovelace))
-> Parser Lovelace -> Parser (DRepHashSource, Lovelace)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Lovelace
pDepositRefund

pDepositRefund :: Parser Lovelace
pDepositRefund :: Parser Lovelace
pDepositRefund =
  ReadM Lovelace -> Mod OptionFields Lovelace -> Parser Lovelace
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (Parser Lovelace -> ReadM Lovelace
forall a. Parser a -> ReadM a
readerFromParsecParser Parser Lovelace
parseLovelace) (Mod OptionFields Lovelace -> Parser Lovelace)
-> Mod OptionFields Lovelace -> Parser Lovelace
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Lovelace] -> Mod OptionFields Lovelace
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"deposit-refund"
      , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"LOVELACE"
      , String -> Mod OptionFields Lovelace
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Deposit refund amount."
      ]

pDRepHashSource :: Parser DRepHashSource
pDRepHashSource :: Parser DRepHashSource
pDRepHashSource =
  [Parser DRepHashSource] -> Parser DRepHashSource
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ ScriptHash -> DRepHashSource
DRepHashSourceScript (ScriptHash -> DRepHashSource)
-> Parser ScriptHash -> Parser DRepHashSource
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ScriptHash
pDRepScriptHash
    , VerificationKeyOrHashOrFile DRepKey -> DRepHashSource
DRepHashSourceVerificationKey (VerificationKeyOrHashOrFile DRepKey -> DRepHashSource)
-> Parser (VerificationKeyOrHashOrFile DRepKey)
-> Parser DRepHashSource
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyOrHashOrFile DRepKey)
pDRepVerificationKeyOrHashOrFile
    ]

pSPOHashSource :: Parser SPOHashSource
pSPOHashSource :: Parser SPOHashSource
pSPOHashSource = VerificationKeyOrHashOrFile StakePoolKey -> SPOHashSource
SPOHashSourceVerificationKey (VerificationKeyOrHashOrFile StakePoolKey -> SPOHashSource)
-> Parser (VerificationKeyOrHashOrFile StakePoolKey)
-> Parser SPOHashSource
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyOrHashOrFile StakePoolKey)
pSPOVerificationKeyOrHashOrFile

pDRepScriptHash :: Parser ScriptHash
pDRepScriptHash :: Parser ScriptHash
pDRepScriptHash =
  String -> String -> Parser ScriptHash
pScriptHash
    String
"drep-script-hash"
    String
"DRep script hash (hex-encoded). Obtain it with \"cardano-cli hash script ...\"."

pSPOScriptHash :: Parser ScriptHash
pSPOScriptHash :: Parser ScriptHash
pSPOScriptHash =
  String -> String -> Parser ScriptHash
pScriptHash
    String
"spo-script-hash"
    String
"Stake pool operator script hash (hex-encoded). Obtain it with \"cardano-cli hash script ...\"."

pConstitutionScriptHash :: Parser ScriptHash
pConstitutionScriptHash :: Parser ScriptHash
pConstitutionScriptHash =
  String -> String -> Parser ScriptHash
pScriptHash
    String
"constitution-script-hash"
    String
"Constitution script hash (hex-encoded). Obtain it with \"cardano-cli hash script ...\"."

pDRepVerificationKeyOrHashOrFile
  :: Parser (VerificationKeyOrHashOrFile DRepKey)
pDRepVerificationKeyOrHashOrFile :: Parser (VerificationKeyOrHashOrFile DRepKey)
pDRepVerificationKeyOrHashOrFile =
  [Parser (VerificationKeyOrHashOrFile DRepKey)]
-> Parser (VerificationKeyOrHashOrFile DRepKey)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ VerificationKeyOrFile DRepKey
-> VerificationKeyOrHashOrFile DRepKey
forall keyrole.
VerificationKeyOrFile keyrole
-> VerificationKeyOrHashOrFile keyrole
VerificationKeyOrFile (VerificationKeyOrFile DRepKey
 -> VerificationKeyOrHashOrFile DRepKey)
-> Parser (VerificationKeyOrFile DRepKey)
-> Parser (VerificationKeyOrHashOrFile DRepKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyOrFile DRepKey)
pDRepVerificationKeyOrFile
    , Hash DRepKey -> VerificationKeyOrHashOrFile DRepKey
forall keyrole. Hash keyrole -> VerificationKeyOrHashOrFile keyrole
VerificationKeyHash (Hash DRepKey -> VerificationKeyOrHashOrFile DRepKey)
-> Parser (Hash DRepKey)
-> Parser (VerificationKeyOrHashOrFile DRepKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Hash DRepKey)
pDRepVerificationKeyHash
    ]

pSPOVerificationKeyOrHashOrFile
  :: Parser (VerificationKeyOrHashOrFile StakePoolKey)
pSPOVerificationKeyOrHashOrFile :: Parser (VerificationKeyOrHashOrFile StakePoolKey)
pSPOVerificationKeyOrHashOrFile =
  [Parser (VerificationKeyOrHashOrFile StakePoolKey)]
-> Parser (VerificationKeyOrHashOrFile StakePoolKey)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ VerificationKeyOrFile StakePoolKey
-> VerificationKeyOrHashOrFile StakePoolKey
forall keyrole.
VerificationKeyOrFile keyrole
-> VerificationKeyOrHashOrFile keyrole
VerificationKeyOrFile (VerificationKeyOrFile StakePoolKey
 -> VerificationKeyOrHashOrFile StakePoolKey)
-> Parser (VerificationKeyOrFile StakePoolKey)
-> Parser (VerificationKeyOrHashOrFile StakePoolKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyOrFile StakePoolKey)
pSPOVerificationKeyOrFile
    , Hash StakePoolKey -> VerificationKeyOrHashOrFile StakePoolKey
forall keyrole. Hash keyrole -> VerificationKeyOrHashOrFile keyrole
VerificationKeyHash (Hash StakePoolKey -> VerificationKeyOrHashOrFile StakePoolKey)
-> Parser (Hash StakePoolKey)
-> Parser (VerificationKeyOrHashOrFile StakePoolKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Hash StakePoolKey)
pSPOVerificationKeyHash
    ]

pDRepVerificationKeyOrHashOrFileOrScriptHash
  :: Parser (VerificationKeyOrHashOrFileOrScriptHash DRepKey)
pDRepVerificationKeyOrHashOrFileOrScriptHash :: Parser (VerificationKeyOrHashOrFileOrScriptHash DRepKey)
pDRepVerificationKeyOrHashOrFileOrScriptHash =
  [Parser (VerificationKeyOrHashOrFileOrScriptHash DRepKey)]
-> Parser (VerificationKeyOrHashOrFileOrScriptHash DRepKey)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ VerificationKeyOrHashOrFile DRepKey
-> VerificationKeyOrHashOrFileOrScriptHash DRepKey
forall keyrole.
VerificationKeyOrHashOrFile keyrole
-> VerificationKeyOrHashOrFileOrScriptHash keyrole
VkhfshKeyHashFile (VerificationKeyOrHashOrFile DRepKey
 -> VerificationKeyOrHashOrFileOrScriptHash DRepKey)
-> (VerificationKeyOrFile DRepKey
    -> VerificationKeyOrHashOrFile DRepKey)
-> VerificationKeyOrFile DRepKey
-> VerificationKeyOrHashOrFileOrScriptHash DRepKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationKeyOrFile DRepKey
-> VerificationKeyOrHashOrFile DRepKey
forall keyrole.
VerificationKeyOrFile keyrole
-> VerificationKeyOrHashOrFile keyrole
VerificationKeyOrFile (VerificationKeyOrFile DRepKey
 -> VerificationKeyOrHashOrFileOrScriptHash DRepKey)
-> Parser (VerificationKeyOrFile DRepKey)
-> Parser (VerificationKeyOrHashOrFileOrScriptHash DRepKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyOrFile DRepKey)
pDRepVerificationKeyOrFile
    , VerificationKeyOrHashOrFile DRepKey
-> VerificationKeyOrHashOrFileOrScriptHash DRepKey
forall keyrole.
VerificationKeyOrHashOrFile keyrole
-> VerificationKeyOrHashOrFileOrScriptHash keyrole
VkhfshKeyHashFile (VerificationKeyOrHashOrFile DRepKey
 -> VerificationKeyOrHashOrFileOrScriptHash DRepKey)
-> (Hash DRepKey -> VerificationKeyOrHashOrFile DRepKey)
-> Hash DRepKey
-> VerificationKeyOrHashOrFileOrScriptHash DRepKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash DRepKey -> VerificationKeyOrHashOrFile DRepKey
forall keyrole. Hash keyrole -> VerificationKeyOrHashOrFile keyrole
VerificationKeyHash (Hash DRepKey -> VerificationKeyOrHashOrFileOrScriptHash DRepKey)
-> Parser (Hash DRepKey)
-> Parser (VerificationKeyOrHashOrFileOrScriptHash DRepKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Hash DRepKey)
pDRepVerificationKeyHash
    , ScriptHash -> VerificationKeyOrHashOrFileOrScriptHash DRepKey
forall keyrole.
ScriptHash -> VerificationKeyOrHashOrFileOrScriptHash keyrole
VkhfshScriptHash
        (ScriptHash -> VerificationKeyOrHashOrFileOrScriptHash DRepKey)
-> Parser ScriptHash
-> Parser (VerificationKeyOrHashOrFileOrScriptHash DRepKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser ScriptHash
pScriptHash
          String
"drep-script-hash"
          String
"Cold Native or Plutus script file hash (hex-encoded). Obtain it with \"cardano-cli hash script ...\"."
    ]

pAllOrOnlyDRepHashSource
  :: Parser (AllOrOnly DRepHashSource)
pAllOrOnlyDRepHashSource :: Parser (AllOrOnly DRepHashSource)
pAllOrOnlyDRepHashSource = Parser (AllOrOnly DRepHashSource)
forall {a}. Parser (AllOrOnly a)
pAll Parser (AllOrOnly DRepHashSource)
-> Parser (AllOrOnly DRepHashSource)
-> Parser (AllOrOnly DRepHashSource)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (AllOrOnly DRepHashSource)
pOnly
 where
  pOnly :: Parser (AllOrOnly DRepHashSource)
pOnly = [DRepHashSource] -> AllOrOnly DRepHashSource
forall a. [a] -> AllOrOnly a
Only ([DRepHashSource] -> AllOrOnly DRepHashSource)
-> Parser [DRepHashSource] -> Parser (AllOrOnly DRepHashSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DRepHashSource -> Parser [DRepHashSource]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser DRepHashSource
pDRepHashSource
  pAll :: Parser (AllOrOnly a)
pAll =
    AllOrOnly a -> Mod FlagFields (AllOrOnly a) -> Parser (AllOrOnly a)
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' AllOrOnly a
forall a. AllOrOnly a
All (Mod FlagFields (AllOrOnly a) -> Parser (AllOrOnly a))
-> Mod FlagFields (AllOrOnly a) -> Parser (AllOrOnly a)
forall a b. (a -> b) -> a -> b
$
      [Mod FlagFields (AllOrOnly a)] -> Mod FlagFields (AllOrOnly a)
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod FlagFields (AllOrOnly a)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"all-dreps"
        , String -> Mod FlagFields (AllOrOnly a)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Query for all DReps."
        ]

pAllOrOnlySPOHashSource :: Parser (AllOrOnly SPOHashSource)
pAllOrOnlySPOHashSource :: Parser (AllOrOnly SPOHashSource)
pAllOrOnlySPOHashSource = Parser (AllOrOnly SPOHashSource)
forall {a}. Parser (AllOrOnly a)
pAll Parser (AllOrOnly SPOHashSource)
-> Parser (AllOrOnly SPOHashSource)
-> Parser (AllOrOnly SPOHashSource)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (AllOrOnly SPOHashSource)
pOnly
 where
  pOnly :: Parser (AllOrOnly SPOHashSource)
pOnly = [SPOHashSource] -> AllOrOnly SPOHashSource
forall a. [a] -> AllOrOnly a
Only ([SPOHashSource] -> AllOrOnly SPOHashSource)
-> Parser [SPOHashSource] -> Parser (AllOrOnly SPOHashSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SPOHashSource -> Parser [SPOHashSource]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser SPOHashSource
pSPOHashSource
  pAll :: Parser (AllOrOnly a)
pAll =
    AllOrOnly a -> Mod FlagFields (AllOrOnly a) -> Parser (AllOrOnly a)
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' AllOrOnly a
forall a. AllOrOnly a
All (Mod FlagFields (AllOrOnly a) -> Parser (AllOrOnly a))
-> Mod FlagFields (AllOrOnly a) -> Parser (AllOrOnly a)
forall a b. (a -> b) -> a -> b
$
      [Mod FlagFields (AllOrOnly a)] -> Mod FlagFields (AllOrOnly a)
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod FlagFields (AllOrOnly a)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"all-spos"
        , String -> Mod FlagFields (AllOrOnly a)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Query for all DReps."
        ]

pDRepVerificationKeyHash :: Parser (Hash DRepKey)
pDRepVerificationKeyHash :: Parser (Hash DRepKey)
pDRepVerificationKeyHash =
  ReadM (Hash DRepKey)
-> Mod OptionFields (Hash DRepKey) -> Parser (Hash DRepKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (AsType DRepKey -> ReadM (Hash DRepKey)
forall a. SerialiseAsBech32 (Hash a) => AsType a -> ReadM (Hash a)
rBech32KeyHash AsType DRepKey
AsDRepKey ReadM (Hash DRepKey)
-> ReadM (Hash DRepKey) -> ReadM (Hash DRepKey)
forall a. ReadM a -> ReadM a -> ReadM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AsType DRepKey -> Maybe String -> ReadM (Hash DRepKey)
forall a.
SerialiseAsRawBytes (Hash a) =>
AsType a -> Maybe String -> ReadM (Hash a)
rHexHash AsType DRepKey
AsDRepKey Maybe String
forall a. Maybe a
Nothing) (Mod OptionFields (Hash DRepKey) -> Parser (Hash DRepKey))
-> Mod OptionFields (Hash DRepKey) -> Parser (Hash DRepKey)
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields (Hash DRepKey)]
-> Mod OptionFields (Hash DRepKey)
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields (Hash DRepKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"drep-key-hash"
      , String -> Mod OptionFields (Hash DRepKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"HASH"
      , String -> Mod OptionFields (Hash DRepKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"DRep verification key hash (either Bech32-encoded or hex-encoded)."
      ]

pDRepVerificationKey :: Parser (VerificationKey DRepKey)
pDRepVerificationKey :: Parser (VerificationKey DRepKey)
pDRepVerificationKey =
  ReadM (VerificationKey DRepKey)
-> Mod OptionFields (VerificationKey DRepKey)
-> Parser (VerificationKey DRepKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (AsType DRepKey -> ReadM (VerificationKey DRepKey)
forall keyrole.
SerialiseAsBech32 (VerificationKey keyrole) =>
AsType keyrole -> ReadM (VerificationKey keyrole)
readVerificationKey AsType DRepKey
AsDRepKey) (Mod OptionFields (VerificationKey DRepKey)
 -> Parser (VerificationKey DRepKey))
-> Mod OptionFields (VerificationKey DRepKey)
-> Parser (VerificationKey DRepKey)
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields (VerificationKey DRepKey)]
-> Mod OptionFields (VerificationKey DRepKey)
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields (VerificationKey DRepKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"drep-verification-key"
      , String -> Mod OptionFields (VerificationKey DRepKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
      , String -> Mod OptionFields (VerificationKey DRepKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"DRep verification key (Bech32 or hex-encoded)."
      ]

pDRepVerificationKeyOrFile :: Parser (VerificationKeyOrFile DRepKey)
pDRepVerificationKeyOrFile :: Parser (VerificationKeyOrFile DRepKey)
pDRepVerificationKeyOrFile =
  [Parser (VerificationKeyOrFile DRepKey)]
-> Parser (VerificationKeyOrFile DRepKey)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ VerificationKey DRepKey -> VerificationKeyOrFile DRepKey
forall keyrole.
VerificationKey keyrole -> VerificationKeyOrFile keyrole
VerificationKeyValue (VerificationKey DRepKey -> VerificationKeyOrFile DRepKey)
-> Parser (VerificationKey DRepKey)
-> Parser (VerificationKeyOrFile DRepKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKey DRepKey)
pDRepVerificationKey
    , VerificationKeyFile 'In -> VerificationKeyOrFile DRepKey
forall keyrole.
VerificationKeyFile 'In -> VerificationKeyOrFile keyrole
VerificationKeyFilePath (VerificationKeyFile 'In -> VerificationKeyOrFile DRepKey)
-> Parser (VerificationKeyFile 'In)
-> Parser (VerificationKeyOrFile DRepKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyFile 'In)
pDRepVerificationKeyFile
    ]

pDRepVerificationKeyFile :: Parser (VerificationKeyFile In)
pDRepVerificationKeyFile :: Parser (VerificationKeyFile 'In)
pDRepVerificationKeyFile =
  String -> VerificationKeyFile 'In
forall content (direction :: FileDirection).
String -> File content direction
File (String -> VerificationKeyFile 'In)
-> Parser String -> Parser (VerificationKeyFile 'In)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser String
parseFilePath String
"drep-verification-key-file" String
"Filepath of the DRep verification key."

pSPOVerificationKeyHash :: Parser (Hash StakePoolKey)
pSPOVerificationKeyHash :: Parser (Hash StakePoolKey)
pSPOVerificationKeyHash =
  ReadM (Hash StakePoolKey)
-> Mod OptionFields (Hash StakePoolKey)
-> Parser (Hash StakePoolKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (AsType StakePoolKey -> ReadM (Hash StakePoolKey)
forall a. SerialiseAsBech32 (Hash a) => AsType a -> ReadM (Hash a)
rBech32KeyHash AsType StakePoolKey
AsStakePoolKey ReadM (Hash StakePoolKey)
-> ReadM (Hash StakePoolKey) -> ReadM (Hash StakePoolKey)
forall a. ReadM a -> ReadM a -> ReadM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AsType StakePoolKey -> Maybe String -> ReadM (Hash StakePoolKey)
forall a.
SerialiseAsRawBytes (Hash a) =>
AsType a -> Maybe String -> ReadM (Hash a)
rHexHash AsType StakePoolKey
AsStakePoolKey Maybe String
forall a. Maybe a
Nothing) (Mod OptionFields (Hash StakePoolKey)
 -> Parser (Hash StakePoolKey))
-> Mod OptionFields (Hash StakePoolKey)
-> Parser (Hash StakePoolKey)
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields (Hash StakePoolKey)]
-> Mod OptionFields (Hash StakePoolKey)
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields (Hash StakePoolKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"spo-key-hash"
      , String -> Mod OptionFields (Hash StakePoolKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"HASH"
      , String -> Mod OptionFields (Hash StakePoolKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"SPO verification key hash (either Bech32-encoded or hex-encoded)."
      ]

pSPOVerificationKey :: Parser (VerificationKey StakePoolKey)
pSPOVerificationKey :: Parser (VerificationKey StakePoolKey)
pSPOVerificationKey =
  ReadM (VerificationKey StakePoolKey)
-> Mod OptionFields (VerificationKey StakePoolKey)
-> Parser (VerificationKey StakePoolKey)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (AsType StakePoolKey -> ReadM (VerificationKey StakePoolKey)
forall keyrole.
SerialiseAsBech32 (VerificationKey keyrole) =>
AsType keyrole -> ReadM (VerificationKey keyrole)
readVerificationKey AsType StakePoolKey
AsStakePoolKey) (Mod OptionFields (VerificationKey StakePoolKey)
 -> Parser (VerificationKey StakePoolKey))
-> Mod OptionFields (VerificationKey StakePoolKey)
-> Parser (VerificationKey StakePoolKey)
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields (VerificationKey StakePoolKey)]
-> Mod OptionFields (VerificationKey StakePoolKey)
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields (VerificationKey StakePoolKey)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"spo-verification-key"
      , String -> Mod OptionFields (VerificationKey StakePoolKey)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"STRING"
      , String -> Mod OptionFields (VerificationKey StakePoolKey)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"SPO verification key (Bech32 or hex-encoded)."
      ]

pSPOVerificationKeyOrFile :: Parser (VerificationKeyOrFile StakePoolKey)
pSPOVerificationKeyOrFile :: Parser (VerificationKeyOrFile StakePoolKey)
pSPOVerificationKeyOrFile =
  [Parser (VerificationKeyOrFile StakePoolKey)]
-> Parser (VerificationKeyOrFile StakePoolKey)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ VerificationKey StakePoolKey -> VerificationKeyOrFile StakePoolKey
forall keyrole.
VerificationKey keyrole -> VerificationKeyOrFile keyrole
VerificationKeyValue (VerificationKey StakePoolKey
 -> VerificationKeyOrFile StakePoolKey)
-> Parser (VerificationKey StakePoolKey)
-> Parser (VerificationKeyOrFile StakePoolKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKey StakePoolKey)
pSPOVerificationKey
    , VerificationKeyFile 'In -> VerificationKeyOrFile StakePoolKey
forall keyrole.
VerificationKeyFile 'In -> VerificationKeyOrFile keyrole
VerificationKeyFilePath (VerificationKeyFile 'In -> VerificationKeyOrFile StakePoolKey)
-> Parser (VerificationKeyFile 'In)
-> Parser (VerificationKeyOrFile StakePoolKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyFile 'In)
pSPOVerificationKeyFile
    ]

pSPOVerificationKeyFile :: Parser (VerificationKeyFile In)
pSPOVerificationKeyFile :: Parser (VerificationKeyFile 'In)
pSPOVerificationKeyFile =
  String -> VerificationKeyFile 'In
forall content (direction :: FileDirection).
String -> File content direction
File (String -> VerificationKeyFile 'In)
-> Parser String -> Parser (VerificationKeyFile 'In)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser String
parseFilePath String
"spo-verification-key-file" String
"Filepath of the SPO verification key."

pAnchorUrl :: Parser ProposalUrl
pAnchorUrl :: Parser ProposalUrl
pAnchorUrl =
  Url -> ProposalUrl
ProposalUrl
    (Url -> ProposalUrl) -> Parser Url -> Parser ProposalUrl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser Url
pUrl String
"anchor-url" String
"Anchor URL"

pExpectedAnchorDataHash :: Parser (L.SafeHash L.StandardCrypto L.AnchorData)
pExpectedAnchorDataHash :: Parser (SafeHash StandardCrypto AnchorData)
pExpectedAnchorDataHash = (SafeHash StandardCrypto AnchorData
 -> SafeHash StandardCrypto AnchorData)
-> String -> Parser (SafeHash StandardCrypto AnchorData)
forall a.
(SafeHash StandardCrypto AnchorData -> a) -> String -> Parser a
pExpectedHash SafeHash StandardCrypto AnchorData
-> SafeHash StandardCrypto AnchorData
forall a. a -> a
id String
"anchor data"

pExpectedHash :: (L.SafeHash L.StandardCrypto L.AnchorData -> a) -> String -> Parser a
pExpectedHash :: forall a.
(SafeHash StandardCrypto AnchorData -> a) -> String -> Parser a
pExpectedHash SafeHash StandardCrypto AnchorData -> a
adaptor String
hashedDataName =
  ReadM a -> Mod OptionFields a -> Parser a
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (SafeHash StandardCrypto AnchorData -> a
adaptor (SafeHash StandardCrypto AnchorData -> a)
-> ReadM (SafeHash StandardCrypto AnchorData) -> ReadM a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM (SafeHash StandardCrypto AnchorData)
readSafeHash) (Mod OptionFields a -> Parser a) -> Mod OptionFields a -> Parser a
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields a] -> Mod OptionFields a
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields a
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"expected-hash"
      , String -> Mod OptionFields a
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"HASH"
      , String -> Mod OptionFields a
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod OptionFields a) -> String -> Mod OptionFields a
forall a b. (a -> b) -> a -> b
$
          [String] -> String
forall a. Monoid a => [a] -> a
mconcat
            [ String
"Expected hash for the " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
hashedDataName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", for verification purposes. "
            , String
"If provided, the hash of the " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
hashedDataName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" will be compared to this value."
            ]
      ]

pAnchorDataHash :: Parser (L.SafeHash L.StandardCrypto L.AnchorData)
pAnchorDataHash :: Parser (SafeHash StandardCrypto AnchorData)
pAnchorDataHash =
  ReadM (SafeHash StandardCrypto AnchorData)
-> Mod OptionFields (SafeHash StandardCrypto AnchorData)
-> Parser (SafeHash StandardCrypto AnchorData)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM (SafeHash StandardCrypto AnchorData)
readSafeHash (Mod OptionFields (SafeHash StandardCrypto AnchorData)
 -> Parser (SafeHash StandardCrypto AnchorData))
-> Mod OptionFields (SafeHash StandardCrypto AnchorData)
-> Parser (SafeHash StandardCrypto AnchorData)
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields (SafeHash StandardCrypto AnchorData)]
-> Mod OptionFields (SafeHash StandardCrypto AnchorData)
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields (SafeHash StandardCrypto AnchorData)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"anchor-data-hash"
      , String -> Mod OptionFields (SafeHash StandardCrypto AnchorData)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"HASH"
      , String -> Mod OptionFields (SafeHash StandardCrypto AnchorData)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Proposal anchor data hash (obtain it with \"cardano-cli hash anchor-data ...\")"
      ]

pMustCheckHash :: String -> String -> String -> String -> Parser (MustCheckHash anchorData)
pMustCheckHash :: forall anchorData.
String
-> String -> String -> String -> Parser (MustCheckHash anchorData)
pMustCheckHash String
flagSuffix' String
dataName' String
hashParamName' String
urlParamName' =
  MustCheckHash anchorData
-> MustCheckHash anchorData
-> Mod FlagFields (MustCheckHash anchorData)
-> Parser (MustCheckHash anchorData)
forall a. a -> a -> Mod FlagFields a -> Parser a
Opt.flag MustCheckHash anchorData
forall a. MustCheckHash a
TrustHash MustCheckHash anchorData
forall a. MustCheckHash a
CheckHash (Mod FlagFields (MustCheckHash anchorData)
 -> Parser (MustCheckHash anchorData))
-> Mod FlagFields (MustCheckHash anchorData)
-> Parser (MustCheckHash anchorData)
forall a b. (a -> b) -> a -> b
$
    [Mod FlagFields (MustCheckHash anchorData)]
-> Mod FlagFields (MustCheckHash anchorData)
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod FlagFields (MustCheckHash anchorData)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long (String
"check-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
flagSuffix')
      , String -> Mod FlagFields (MustCheckHash anchorData)
forall (f :: * -> *) a. String -> Mod f a
Opt.help
          ( String
"Verify that the expected "
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dataName'
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" hash provided in "
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
hashParamName'
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" matches the hash of the file downloaded from the URL provided in "
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
urlParamName'
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (this parameter will download the file from the URL)"
          )
      ]

pPotentiallyCheckedAnchorData
  :: Parser (MustCheckHash anchorType)
  -> Parser anchor
  -> Parser (PotentiallyCheckedAnchor anchorType anchor)
pPotentiallyCheckedAnchorData :: forall anchorType anchor.
Parser (MustCheckHash anchorType)
-> Parser anchor
-> Parser (PotentiallyCheckedAnchor anchorType anchor)
pPotentiallyCheckedAnchorData Parser (MustCheckHash anchorType)
mustCheckHash Parser anchor
anchorData =
  anchor
-> MustCheckHash anchorType
-> PotentiallyCheckedAnchor anchorType anchor
forall anchorType anchor.
anchor
-> MustCheckHash anchorType
-> PotentiallyCheckedAnchor anchorType anchor
PotentiallyCheckedAnchor
    (anchor
 -> MustCheckHash anchorType
 -> PotentiallyCheckedAnchor anchorType anchor)
-> Parser anchor
-> Parser
     (MustCheckHash anchorType
      -> PotentiallyCheckedAnchor anchorType anchor)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser anchor
anchorData
    Parser
  (MustCheckHash anchorType
   -> PotentiallyCheckedAnchor anchorType anchor)
-> Parser (MustCheckHash anchorType)
-> Parser (PotentiallyCheckedAnchor anchorType anchor)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (MustCheckHash anchorType)
mustCheckHash

pMustCheckProposalHash :: Parser (MustCheckHash ProposalUrl)
pMustCheckProposalHash :: Parser (MustCheckHash ProposalUrl)
pMustCheckProposalHash = String
-> String -> String -> String -> Parser (MustCheckHash ProposalUrl)
forall anchorData.
String
-> String -> String -> String -> Parser (MustCheckHash anchorData)
pMustCheckHash String
"anchor-data" String
"proposal" String
"--anchor-data-hash" String
"--anchor-url"

pMustCheckConstitutionHash :: Parser (MustCheckHash ConstitutionUrl)
pMustCheckConstitutionHash :: Parser (MustCheckHash ConstitutionUrl)
pMustCheckConstitutionHash = String
-> String
-> String
-> String
-> Parser (MustCheckHash ConstitutionUrl)
forall anchorData.
String
-> String -> String -> String -> Parser (MustCheckHash anchorData)
pMustCheckHash String
"constitution-hash" String
"constitution" String
"--constitution-hash" String
"--constitution-url"

pMustCheckMetadataHash :: Parser (MustCheckHash DRepMetadataUrl)
pMustCheckMetadataHash :: Parser (MustCheckHash DRepMetadataUrl)
pMustCheckMetadataHash = String
-> String
-> String
-> String
-> Parser (MustCheckHash DRepMetadataUrl)
forall anchorData.
String
-> String -> String -> String -> Parser (MustCheckHash anchorData)
pMustCheckHash String
"drep-metadata-hash" String
"DRep metadata" String
"--drep-metadata-hash" String
"--drep-metadata-url"

pMustCheckStakeMetadataHash :: Parser (MustCheckHash StakePoolMetadataReference)
pMustCheckStakeMetadataHash :: Parser (MustCheckHash StakePoolMetadataReference)
pMustCheckStakeMetadataHash = String
-> String
-> String
-> String
-> Parser (MustCheckHash StakePoolMetadataReference)
forall anchorData.
String
-> String -> String -> String -> Parser (MustCheckHash anchorData)
pMustCheckHash String
"metadata-hash" String
"stake pool metadata" String
"--metadata-hash" String
"--metadata-url"

pPreviousGovernanceAction :: Parser (Maybe (TxId, Word16))
pPreviousGovernanceAction :: Parser (Maybe (TxId, Word16))
pPreviousGovernanceAction =
  Parser (TxId, Word16) -> Parser (Maybe (TxId, Word16))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser (TxId, Word16) -> Parser (Maybe (TxId, Word16)))
-> Parser (TxId, Word16) -> Parser (Maybe (TxId, Word16))
forall a b. (a -> b) -> a -> b
$
    (,)
      (TxId -> Word16 -> (TxId, Word16))
-> Parser TxId -> Parser (Word16 -> (TxId, Word16))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser TxId
pTxId String
"prev-governance-action-tx-id" String
"Txid of the previous governance action."
      Parser (Word16 -> (TxId, Word16))
-> Parser Word16 -> Parser (TxId, Word16)
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 Word16
pWord16 String
"prev-governance-action-index" String
"Action index of the previous governance action."

pGovernanceActionId :: Parser (TxId, Word16)
pGovernanceActionId :: Parser (TxId, Word16)
pGovernanceActionId =
  (,)
    (TxId -> Word16 -> (TxId, Word16))
-> Parser TxId -> Parser (Word16 -> (TxId, Word16))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser TxId
pTxId String
"governance-action-tx-id" String
"Txid of the governance action."
    Parser (Word16 -> (TxId, Word16))
-> Parser Word16 -> Parser (TxId, Word16)
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 Word16
pWord16 String
"governance-action-index" String
"Tx's governance action index."

pWord16 :: String -> String -> Parser Word16
pWord16 :: String -> String -> Parser Word16
pWord16 String
l String
h =
  ReadM Word16 -> Mod OptionFields Word16 -> Parser Word16
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word16
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader (Mod OptionFields Word16 -> Parser Word16)
-> Mod OptionFields Word16 -> Parser Word16
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Word16] -> Mod OptionFields Word16
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields Word16
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
l
      , String -> Mod OptionFields Word16
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"WORD16"
      , String -> Mod OptionFields Word16
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
h
      ]

pTxId :: String -> String -> Parser TxId
pTxId :: String -> String -> Parser TxId
pTxId String
l String
h =
  ReadM TxId -> Mod OptionFields TxId -> Parser TxId
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (ParsecT String () Identity TxId -> ReadM TxId
forall a. Parser a -> ReadM a
readerFromParsecParser ParsecT String () Identity TxId
parseTxId) (Mod OptionFields TxId -> Parser TxId)
-> Mod OptionFields TxId -> Parser TxId
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields TxId] -> Mod OptionFields TxId
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields TxId
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
l
      , String -> Mod OptionFields TxId
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"TXID"
      , String -> Mod OptionFields TxId
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
h
      ]

pNetworkIdForTestnetData :: EnvCli -> Parser NetworkId
pNetworkIdForTestnetData :: EnvCli -> Parser NetworkId
pNetworkIdForTestnetData EnvCli
envCli =
  [Parser NetworkId] -> Parser NetworkId
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([Parser NetworkId] -> Parser NetworkId)
-> [Parser NetworkId] -> Parser NetworkId
forall a b. (a -> b) -> a -> b
$
    [[Parser NetworkId]] -> [Parser NetworkId]
forall a. Monoid a => [a] -> a
mconcat
      [
        [ (Word32 -> NetworkId) -> Parser Word32 -> Parser NetworkId
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NetworkMagic -> NetworkId
Testnet (NetworkMagic -> NetworkId)
-> (Word32 -> NetworkMagic) -> Word32 -> NetworkId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> NetworkMagic
NetworkMagic) (Parser Word32 -> Parser NetworkId)
-> Parser Word32 -> Parser NetworkId
forall a b. (a -> b) -> a -> b
$
            ReadM Word32 -> Mod OptionFields Word32 -> Parser Word32
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (String -> ReadM Word32
forall a. (Bounded a, Integral a, Show a) => String -> ReadM a
bounded String
"TESTNET_MAGIC") (Mod OptionFields Word32 -> Parser Word32)
-> Mod OptionFields Word32 -> Parser Word32
forall a b. (a -> b) -> a -> b
$
              [Mod OptionFields Word32] -> Mod OptionFields Word32
forall a. Monoid a => [a] -> a
mconcat
                [ String -> Mod OptionFields Word32
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"testnet-magic"
                , String -> Mod OptionFields Word32
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"NATURAL"
                , String -> Mod OptionFields Word32
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod OptionFields Word32)
-> String -> Mod OptionFields Word32
forall a b. (a -> b) -> a -> b
$
                    [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                      [ String
"Specify a testnet magic id for the cluster. "
                      , String
"This overrides both the network magic from the "
                      , String
"spec file and CARDANO_NODE_NETWORK_ID environment variable."
                      ]
                ]
        ]
      , -- Default to the network id specified by the environment variable if it is available.
        NetworkId -> Parser NetworkId
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NetworkId -> Parser NetworkId)
-> [NetworkId] -> [Parser NetworkId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe NetworkId -> [NetworkId]
forall a. Maybe a -> [a]
maybeToList (EnvCli -> Maybe NetworkId
envCliNetworkId EnvCli
envCli)
      ]

pReferenceScriptSize :: Parser ReferenceScriptSize
pReferenceScriptSize :: Parser ReferenceScriptSize
pReferenceScriptSize =
  (Int -> ReferenceScriptSize)
-> Parser Int -> Parser ReferenceScriptSize
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> ReferenceScriptSize
ReferenceScriptSize (Parser Int -> Parser ReferenceScriptSize)
-> Parser Int -> Parser ReferenceScriptSize
forall a b. (a -> b) -> a -> b
$
    ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Int
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader (Mod OptionFields Int -> Parser Int)
-> Mod OptionFields Int -> Parser Int
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields Int] -> Mod OptionFields Int
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"reference-script-size"
        , String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"NATURAL"
        , String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Total size in bytes of transaction reference scripts (default is 0)."
        , Int -> Mod OptionFields Int
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value Int
0
        ]

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

pFeatured
  :: ()
  => Eon eon
  => ToCardanoEra peon
  => peon era
  -> Parser a
  -> Parser (Maybe (Featured eon era a))
pFeatured :: forall (eon :: * -> *) (peon :: * -> *) era a.
(Eon eon, ToCardanoEra peon) =>
peon era -> Parser a -> Parser (Maybe (Featured eon era a))
pFeatured peon era
peon Parser a
p = do
  let mw :: Maybe (eon era)
mw = CardanoEra era -> Maybe (eon era)
forall (eon :: * -> *) era.
Eon eon =>
CardanoEra era -> Maybe (eon era)
forEraMaybeEon (peon era -> CardanoEra era
forall era. peon era -> CardanoEra era
forall (eon :: * -> *) era.
ToCardanoEra eon =>
eon era -> CardanoEra era
toCardanoEra peon era
peon)
  case Maybe (eon era)
mw of
    Maybe (eon era)
Nothing -> Maybe (Featured eon era a) -> Parser (Maybe (Featured eon era a))
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Featured eon era a)
forall a. Maybe a
Nothing
    Just eon era
eon' -> Featured eon era a -> Maybe (Featured eon era a)
forall a. a -> Maybe a
Just (Featured eon era a -> Maybe (Featured eon era a))
-> (a -> Featured eon era a) -> a -> Maybe (Featured eon era a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. eon era -> a -> Featured eon era a
forall (eon :: * -> *) era a. eon era -> a -> Featured eon era a
Featured eon era
eon' (a -> Maybe (Featured eon era a))
-> Parser a -> Parser (Maybe (Featured eon era a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
p

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