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

module Cardano.CLI.Compatible.Governance.Option
  ( pCompatibleGovernanceCmds
  )
where

import Cardano.Api
import Cardano.Api.Experimental (obtainCommonConstraints)

import Cardano.CLI.Compatible.Governance.Command
import Cardano.CLI.Compatible.Governance.Types
import Cardano.CLI.EraBased.Common.Option
import Cardano.CLI.EraBased.Governance.Actions.Option
  ( pCostModelsFile
  , pGovActionProtocolParametersUpdate
  , pProtocolParametersUpdateGenesisKeys
  , pUpdateProtocolParametersPostConway
  )
import Cardano.CLI.EraBased.Governance.Option qualified as Latest
import Cardano.CLI.Parser

import Data.Foldable
import Data.Maybe
import Options.Applicative
import Options.Applicative qualified as Opt

pCompatibleGovernanceCmds
  :: ShelleyBasedEra era
  -> Parser (CompatibleGovernanceCmds era)
pCompatibleGovernanceCmds :: forall era.
ShelleyBasedEra era -> Parser (CompatibleGovernanceCmds era)
pCompatibleGovernanceCmds ShelleyBasedEra era
sbe =
  [Parser (CompatibleGovernanceCmds era)]
-> Parser (CompatibleGovernanceCmds era)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([Parser (CompatibleGovernanceCmds era)]
 -> Parser (CompatibleGovernanceCmds era))
-> [Parser (CompatibleGovernanceCmds era)]
-> Parser (CompatibleGovernanceCmds era)
forall a b. (a -> b) -> a -> b
$
    [Maybe (Parser (CompatibleGovernanceCmds era))]
-> [Parser (CompatibleGovernanceCmds era)]
forall a. [Maybe a] -> [a]
catMaybes
      [ (ShelleyToBabbageEraConstraints era =>
 ShelleyToBabbageEra era
 -> Maybe (Parser (CompatibleGovernanceCmds era)))
-> (ConwayEraOnwardsConstraints era =>
    ConwayEraOnwards era
    -> Maybe (Parser (CompatibleGovernanceCmds era)))
-> ShelleyBasedEra era
-> Maybe (Parser (CompatibleGovernanceCmds era))
forall era a.
(ShelleyToBabbageEraConstraints era =>
 ShelleyToBabbageEra era -> a)
-> (ConwayEraOnwardsConstraints era => ConwayEraOnwards era -> a)
-> ShelleyBasedEra era
-> a
caseShelleyToBabbageOrConwayEraOnwards
          ( Maybe (Parser (CompatibleGovernanceCmds era))
-> ShelleyToBabbageEra era
-> Maybe (Parser (CompatibleGovernanceCmds era))
forall a b. a -> b -> a
const (Maybe (Parser (CompatibleGovernanceCmds era))
 -> ShelleyToBabbageEra era
 -> Maybe (Parser (CompatibleGovernanceCmds era)))
-> Maybe (Parser (CompatibleGovernanceCmds era))
-> ShelleyToBabbageEra era
-> Maybe (Parser (CompatibleGovernanceCmds era))
forall a b. (a -> b) -> a -> b
$
              String
-> InfoMod (CompatibleGovernanceCmds era)
-> [Maybe (Parser (CompatibleGovernanceCmds era))]
-> Maybe (Parser (CompatibleGovernanceCmds era))
forall a.
String -> InfoMod a -> [Maybe (Parser a)] -> Maybe (Parser a)
subInfoParser
                String
"governance"
                ( String -> InfoMod (CompatibleGovernanceCmds era)
forall a. String -> InfoMod a
Opt.progDesc (String -> InfoMod (CompatibleGovernanceCmds era))
-> String -> InfoMod (CompatibleGovernanceCmds era)
forall a b. (a -> b) -> a -> b
$
                    [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                      [ String
"Governance commands."
                      ]
                )
                [ ShelleyBasedEra era
-> Maybe (Parser (CompatibleGovernanceCmds era))
forall era.
ShelleyBasedEra era
-> Maybe (Parser (CompatibleGovernanceCmds era))
pCreateMirCertificatesCmds ShelleyBasedEra era
sbe
                , ShelleyBasedEra era
-> Maybe (Parser (CompatibleGovernanceCmds era))
forall era.
ShelleyBasedEra era
-> Maybe (Parser (CompatibleGovernanceCmds era))
pGovernanceGenesisKeyDelegationCertificate ShelleyBasedEra era
sbe
                , (GovernanceActionProtocolParametersUpdateCmdArgs era
 -> CompatibleGovernanceCmds era)
-> Parser (GovernanceActionProtocolParametersUpdateCmdArgs era)
-> Parser (CompatibleGovernanceCmds era)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GovernanceActionProtocolParametersUpdateCmdArgs era
-> CompatibleGovernanceCmds era
forall era.
GovernanceActionProtocolParametersUpdateCmdArgs era
-> CompatibleGovernanceCmds era
CreateCompatibleProtocolParametersUpdateCmd (Parser (GovernanceActionProtocolParametersUpdateCmdArgs era)
 -> Parser (CompatibleGovernanceCmds era))
-> Maybe
     (Parser (GovernanceActionProtocolParametersUpdateCmdArgs era))
-> Maybe (Parser (CompatibleGovernanceCmds era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ShelleyBasedEra era
-> Maybe
     (Parser (GovernanceActionProtocolParametersUpdateCmdArgs era))
forall era.
ShelleyBasedEra era
-> Maybe
     (Parser (GovernanceActionProtocolParametersUpdateCmdArgs era))
pGovernanceActionCmds ShelleyBasedEra era
sbe
                ]
          )
          ( \ConwayEraOnwards era
w ->
              (GovernanceCmds era -> CompatibleGovernanceCmds era)
-> Parser (GovernanceCmds era)
-> Parser (CompatibleGovernanceCmds era)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GovernanceCmds era -> CompatibleGovernanceCmds era
forall era. GovernanceCmds era -> CompatibleGovernanceCmds era
LatestCompatibleGovernanceCmds (Parser (GovernanceCmds era)
 -> Parser (CompatibleGovernanceCmds era))
-> Maybe (Parser (GovernanceCmds era))
-> Maybe (Parser (CompatibleGovernanceCmds era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Era era
-> (EraCommonConstraints era =>
    Maybe (Parser (GovernanceCmds era)))
-> Maybe (Parser (GovernanceCmds era))
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (ConwayEraOnwards era -> Era era
forall era. ConwayEraOnwards era -> Era era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert ConwayEraOnwards era
w) Maybe (Parser (GovernanceCmds era))
EraCommonConstraints era => Maybe (Parser (GovernanceCmds era))
forall era. IsEra era => Maybe (Parser (GovernanceCmds era))
Latest.pGovernanceCmds
          )
          ShelleyBasedEra era
sbe
      ]

pGovernanceActionCmds
  :: ShelleyBasedEra era -> Maybe (Parser (GovernanceActionProtocolParametersUpdateCmdArgs era))
pGovernanceActionCmds :: forall era.
ShelleyBasedEra era
-> Maybe
     (Parser (GovernanceActionProtocolParametersUpdateCmdArgs era))
pGovernanceActionCmds ShelleyBasedEra era
sbe =
  String
-> InfoMod (GovernanceActionProtocolParametersUpdateCmdArgs era)
-> [Maybe
      (Parser (GovernanceActionProtocolParametersUpdateCmdArgs era))]
-> Maybe
     (Parser (GovernanceActionProtocolParametersUpdateCmdArgs era))
forall a.
String -> InfoMod a -> [Maybe (Parser a)] -> Maybe (Parser a)
subInfoParser
    String
"action"
    ( String
-> InfoMod (GovernanceActionProtocolParametersUpdateCmdArgs era)
forall a. String -> InfoMod a
Opt.progDesc (String
 -> InfoMod (GovernanceActionProtocolParametersUpdateCmdArgs era))
-> String
-> InfoMod (GovernanceActionProtocolParametersUpdateCmdArgs era)
forall a b. (a -> b) -> a -> b
$
        [String] -> String
forall a. Monoid a => [a] -> a
mconcat
          [ String
"Governance action commands."
          ]
    )
    [ ShelleyBasedEra era
-> Maybe
     (Parser (GovernanceActionProtocolParametersUpdateCmdArgs era))
forall era.
ShelleyBasedEra era
-> Maybe
     (Parser (GovernanceActionProtocolParametersUpdateCmdArgs era))
pGovernanceActionProtocolParametersUpdateCmd ShelleyBasedEra era
sbe
    ]

pGovernanceActionProtocolParametersUpdateCmd
  :: ()
  => ShelleyBasedEra era
  -> Maybe (Parser (GovernanceActionProtocolParametersUpdateCmdArgs era))
pGovernanceActionProtocolParametersUpdateCmd :: forall era.
ShelleyBasedEra era
-> Maybe
     (Parser (GovernanceActionProtocolParametersUpdateCmdArgs era))
pGovernanceActionProtocolParametersUpdateCmd ShelleyBasedEra era
sbe = do
  ShelleyBasedEra era
w <- ShelleyBasedEra era -> Maybe (ShelleyBasedEra era)
forall (eon :: * -> *) era.
Eon eon =>
ShelleyBasedEra era -> Maybe (eon era)
forShelleyBasedEraMaybeEon ShelleyBasedEra era
sbe
  Parser (GovernanceActionProtocolParametersUpdateCmdArgs era)
-> Maybe
     (Parser (GovernanceActionProtocolParametersUpdateCmdArgs era))
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser (GovernanceActionProtocolParametersUpdateCmdArgs era)
 -> Maybe
      (Parser (GovernanceActionProtocolParametersUpdateCmdArgs era)))
-> Parser (GovernanceActionProtocolParametersUpdateCmdArgs era)
-> Maybe
     (Parser (GovernanceActionProtocolParametersUpdateCmdArgs era))
forall a b. (a -> b) -> a -> b
$
    ShelleyBasedEra era
-> Parser (GovernanceActionProtocolParametersUpdateCmdArgs era)
forall era.
ShelleyBasedEra era
-> Parser (GovernanceActionProtocolParametersUpdateCmdArgs era)
pUpdateProtocolParametersCmd ShelleyBasedEra era
w

pUpdateProtocolParametersCmd
  :: ShelleyBasedEra era -> Parser (GovernanceActionProtocolParametersUpdateCmdArgs era)
pUpdateProtocolParametersCmd :: forall era.
ShelleyBasedEra era
-> Parser (GovernanceActionProtocolParametersUpdateCmdArgs era)
pUpdateProtocolParametersCmd =
  (ShelleyToBabbageEraConstraints era =>
 ShelleyToBabbageEra era
 -> Parser (GovernanceActionProtocolParametersUpdateCmdArgs era))
-> (ConwayEraOnwardsConstraints era =>
    ConwayEraOnwards era
    -> Parser (GovernanceActionProtocolParametersUpdateCmdArgs era))
-> ShelleyBasedEra era
-> Parser (GovernanceActionProtocolParametersUpdateCmdArgs era)
forall era a.
(ShelleyToBabbageEraConstraints era =>
 ShelleyToBabbageEra era -> a)
-> (ConwayEraOnwardsConstraints era => ConwayEraOnwards era -> a)
-> ShelleyBasedEra era
-> a
caseShelleyToBabbageOrConwayEraOnwards
    ( \ShelleyToBabbageEra era
shelleyToBab ->
        let sbe :: ShelleyBasedEra era
sbe = ShelleyToBabbageEra era -> ShelleyBasedEra era
forall era. ShelleyToBabbageEra era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert ShelleyToBabbageEra era
shelleyToBab
         in Mod
  CommandFields (GovernanceActionProtocolParametersUpdateCmdArgs era)
-> Parser (GovernanceActionProtocolParametersUpdateCmdArgs era)
forall a. Mod CommandFields a -> Parser a
Opt.hsubparser
              (Mod
   CommandFields (GovernanceActionProtocolParametersUpdateCmdArgs era)
 -> Parser (GovernanceActionProtocolParametersUpdateCmdArgs era))
-> Mod
     CommandFields (GovernanceActionProtocolParametersUpdateCmdArgs era)
-> Parser (GovernanceActionProtocolParametersUpdateCmdArgs era)
forall a b. (a -> b) -> a -> b
$ String
-> ParserInfo (GovernanceActionProtocolParametersUpdateCmdArgs era)
-> Mod
     CommandFields (GovernanceActionProtocolParametersUpdateCmdArgs era)
forall a. String -> ParserInfo a -> Mod CommandFields a
commandWithMetavar String
"create-protocol-parameters-update"
              (ParserInfo (GovernanceActionProtocolParametersUpdateCmdArgs era)
 -> Mod
      CommandFields
      (GovernanceActionProtocolParametersUpdateCmdArgs era))
-> ParserInfo (GovernanceActionProtocolParametersUpdateCmdArgs era)
-> Mod
     CommandFields (GovernanceActionProtocolParametersUpdateCmdArgs era)
forall a b. (a -> b) -> a -> b
$ Parser (GovernanceActionProtocolParametersUpdateCmdArgs era)
-> InfoMod (GovernanceActionProtocolParametersUpdateCmdArgs era)
-> ParserInfo (GovernanceActionProtocolParametersUpdateCmdArgs era)
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info
                ( ShelleyBasedEra era
-> Maybe (UpdateProtocolParametersPreConway era)
-> Maybe (UpdateProtocolParametersConwayOnwards era)
-> EraBasedProtocolParametersUpdate era
-> Maybe (CostModelsFile era)
-> File () 'Out
-> GovernanceActionProtocolParametersUpdateCmdArgs era
forall era.
ShelleyBasedEra era
-> Maybe (UpdateProtocolParametersPreConway era)
-> Maybe (UpdateProtocolParametersConwayOnwards era)
-> EraBasedProtocolParametersUpdate era
-> Maybe (CostModelsFile era)
-> File () 'Out
-> GovernanceActionProtocolParametersUpdateCmdArgs era
GovernanceActionProtocolParametersUpdateCmdArgs
                    (ShelleyToBabbageEra era -> ShelleyBasedEra era
forall era. ShelleyToBabbageEra era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert ShelleyToBabbageEra era
shelleyToBab)
                    (Maybe (UpdateProtocolParametersPreConway era)
 -> Maybe (UpdateProtocolParametersConwayOnwards era)
 -> EraBasedProtocolParametersUpdate era
 -> Maybe (CostModelsFile era)
 -> File () 'Out
 -> GovernanceActionProtocolParametersUpdateCmdArgs era)
-> Parser (Maybe (UpdateProtocolParametersPreConway era))
-> Parser
     (Maybe (UpdateProtocolParametersConwayOnwards era)
      -> EraBasedProtocolParametersUpdate era
      -> Maybe (CostModelsFile era)
      -> File () 'Out
      -> GovernanceActionProtocolParametersUpdateCmdArgs era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UpdateProtocolParametersPreConway era
 -> Maybe (UpdateProtocolParametersPreConway era))
-> Parser (UpdateProtocolParametersPreConway era)
-> Parser (Maybe (UpdateProtocolParametersPreConway era))
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UpdateProtocolParametersPreConway era
-> Maybe (UpdateProtocolParametersPreConway era)
forall a. a -> Maybe a
Just (ShelleyToBabbageEra era
-> Parser (UpdateProtocolParametersPreConway era)
forall era.
ShelleyToBabbageEra era
-> Parser (UpdateProtocolParametersPreConway era)
pUpdateProtocolParametersPreConway ShelleyToBabbageEra era
shelleyToBab)
                    Parser
  (Maybe (UpdateProtocolParametersConwayOnwards era)
   -> EraBasedProtocolParametersUpdate era
   -> Maybe (CostModelsFile era)
   -> File () 'Out
   -> GovernanceActionProtocolParametersUpdateCmdArgs era)
-> Parser (Maybe (UpdateProtocolParametersConwayOnwards era))
-> Parser
     (EraBasedProtocolParametersUpdate era
      -> Maybe (CostModelsFile era)
      -> File () 'Out
      -> GovernanceActionProtocolParametersUpdateCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (UpdateProtocolParametersConwayOnwards era)
-> Parser (Maybe (UpdateProtocolParametersConwayOnwards era))
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (UpdateProtocolParametersConwayOnwards era)
forall a. Maybe a
Nothing
                    Parser
  (EraBasedProtocolParametersUpdate era
   -> Maybe (CostModelsFile era)
   -> File () 'Out
   -> GovernanceActionProtocolParametersUpdateCmdArgs era)
-> Parser (EraBasedProtocolParametersUpdate era)
-> Parser
     (Maybe (CostModelsFile era)
      -> File () 'Out
      -> GovernanceActionProtocolParametersUpdateCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ShelleyBasedEra era
-> Parser (EraBasedProtocolParametersUpdate era)
forall era.
ShelleyBasedEra era
-> Parser (EraBasedProtocolParametersUpdate era)
pGovActionProtocolParametersUpdate ShelleyBasedEra era
sbe
                    Parser
  (Maybe (CostModelsFile era)
   -> File () 'Out
   -> GovernanceActionProtocolParametersUpdateCmdArgs era)
-> Parser (Maybe (CostModelsFile era))
-> Parser
     (File () 'Out
      -> GovernanceActionProtocolParametersUpdateCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ShelleyBasedEra era -> Parser (Maybe (CostModelsFile era))
forall era.
ShelleyBasedEra era -> Parser (Maybe (CostModelsFile era))
pCostModelsFile ShelleyBasedEra era
sbe
                    Parser
  (File () 'Out
   -> GovernanceActionProtocolParametersUpdateCmdArgs era)
-> Parser (File () 'Out)
-> Parser (GovernanceActionProtocolParametersUpdateCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (File () 'Out)
forall content. Parser (File content 'Out)
pOutputFile
                )
              (InfoMod (GovernanceActionProtocolParametersUpdateCmdArgs era)
 -> ParserInfo
      (GovernanceActionProtocolParametersUpdateCmdArgs era))
-> InfoMod (GovernanceActionProtocolParametersUpdateCmdArgs era)
-> ParserInfo (GovernanceActionProtocolParametersUpdateCmdArgs era)
forall a b. (a -> b) -> a -> b
$ String
-> InfoMod (GovernanceActionProtocolParametersUpdateCmdArgs era)
forall a. String -> InfoMod a
Opt.progDesc String
"Create a protocol parameters update."
    )
    ( \ConwayEraOnwards era
conwayOnwards ->
        let sbe :: ShelleyBasedEra era
sbe = ConwayEraOnwards era -> ShelleyBasedEra era
forall era. ConwayEraOnwards era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert ConwayEraOnwards era
conwayOnwards
            ppup :: Parser (Maybe (UpdateProtocolParametersConwayOnwards era))
ppup = (UpdateProtocolParametersConwayOnwards era
 -> Maybe (UpdateProtocolParametersConwayOnwards era))
-> Parser (UpdateProtocolParametersConwayOnwards era)
-> Parser (Maybe (UpdateProtocolParametersConwayOnwards era))
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UpdateProtocolParametersConwayOnwards era
-> Maybe (UpdateProtocolParametersConwayOnwards era)
forall a. a -> Maybe a
Just (Era era
-> (EraCommonConstraints era =>
    Parser (UpdateProtocolParametersConwayOnwards era))
-> Parser (UpdateProtocolParametersConwayOnwards era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (ConwayEraOnwards era -> Era era
forall era. ConwayEraOnwards era -> Era era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert ConwayEraOnwards era
conwayOnwards) Parser (UpdateProtocolParametersConwayOnwards era)
EraCommonConstraints era =>
Parser (UpdateProtocolParametersConwayOnwards era)
forall era.
IsEra era =>
Parser (UpdateProtocolParametersConwayOnwards era)
pUpdateProtocolParametersPostConway)
         in Mod
  CommandFields (GovernanceActionProtocolParametersUpdateCmdArgs era)
-> Parser (GovernanceActionProtocolParametersUpdateCmdArgs era)
forall a. Mod CommandFields a -> Parser a
Opt.hsubparser
              (Mod
   CommandFields (GovernanceActionProtocolParametersUpdateCmdArgs era)
 -> Parser (GovernanceActionProtocolParametersUpdateCmdArgs era))
-> Mod
     CommandFields (GovernanceActionProtocolParametersUpdateCmdArgs era)
-> Parser (GovernanceActionProtocolParametersUpdateCmdArgs era)
forall a b. (a -> b) -> a -> b
$ String
-> ParserInfo (GovernanceActionProtocolParametersUpdateCmdArgs era)
-> Mod
     CommandFields (GovernanceActionProtocolParametersUpdateCmdArgs era)
forall a. String -> ParserInfo a -> Mod CommandFields a
commandWithMetavar String
"create-protocol-parameters-update"
              (ParserInfo (GovernanceActionProtocolParametersUpdateCmdArgs era)
 -> Mod
      CommandFields
      (GovernanceActionProtocolParametersUpdateCmdArgs era))
-> ParserInfo (GovernanceActionProtocolParametersUpdateCmdArgs era)
-> Mod
     CommandFields (GovernanceActionProtocolParametersUpdateCmdArgs era)
forall a b. (a -> b) -> a -> b
$ Parser (GovernanceActionProtocolParametersUpdateCmdArgs era)
-> InfoMod (GovernanceActionProtocolParametersUpdateCmdArgs era)
-> ParserInfo (GovernanceActionProtocolParametersUpdateCmdArgs era)
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info
                ( ShelleyBasedEra era
-> Maybe (UpdateProtocolParametersPreConway era)
-> Maybe (UpdateProtocolParametersConwayOnwards era)
-> EraBasedProtocolParametersUpdate era
-> Maybe (CostModelsFile era)
-> File () 'Out
-> GovernanceActionProtocolParametersUpdateCmdArgs era
forall era.
ShelleyBasedEra era
-> Maybe (UpdateProtocolParametersPreConway era)
-> Maybe (UpdateProtocolParametersConwayOnwards era)
-> EraBasedProtocolParametersUpdate era
-> Maybe (CostModelsFile era)
-> File () 'Out
-> GovernanceActionProtocolParametersUpdateCmdArgs era
GovernanceActionProtocolParametersUpdateCmdArgs
                    (ConwayEraOnwards era -> ShelleyBasedEra era
forall era. ConwayEraOnwards era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert ConwayEraOnwards era
conwayOnwards)
                    Maybe (UpdateProtocolParametersPreConway era)
forall a. Maybe a
Nothing
                    (Maybe (UpdateProtocolParametersConwayOnwards era)
 -> EraBasedProtocolParametersUpdate era
 -> Maybe (CostModelsFile era)
 -> File () 'Out
 -> GovernanceActionProtocolParametersUpdateCmdArgs era)
-> Parser (Maybe (UpdateProtocolParametersConwayOnwards era))
-> Parser
     (EraBasedProtocolParametersUpdate era
      -> Maybe (CostModelsFile era)
      -> File () 'Out
      -> GovernanceActionProtocolParametersUpdateCmdArgs era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe (UpdateProtocolParametersConwayOnwards era))
ppup
                    Parser
  (EraBasedProtocolParametersUpdate era
   -> Maybe (CostModelsFile era)
   -> File () 'Out
   -> GovernanceActionProtocolParametersUpdateCmdArgs era)
-> Parser (EraBasedProtocolParametersUpdate era)
-> Parser
     (Maybe (CostModelsFile era)
      -> File () 'Out
      -> GovernanceActionProtocolParametersUpdateCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ShelleyBasedEra era
-> Parser (EraBasedProtocolParametersUpdate era)
forall era.
ShelleyBasedEra era
-> Parser (EraBasedProtocolParametersUpdate era)
pGovActionProtocolParametersUpdate ShelleyBasedEra era
sbe
                    Parser
  (Maybe (CostModelsFile era)
   -> File () 'Out
   -> GovernanceActionProtocolParametersUpdateCmdArgs era)
-> Parser (Maybe (CostModelsFile era))
-> Parser
     (File () 'Out
      -> GovernanceActionProtocolParametersUpdateCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ShelleyBasedEra era -> Parser (Maybe (CostModelsFile era))
forall era.
ShelleyBasedEra era -> Parser (Maybe (CostModelsFile era))
pCostModelsFile ShelleyBasedEra era
sbe
                    Parser
  (File () 'Out
   -> GovernanceActionProtocolParametersUpdateCmdArgs era)
-> Parser (File () 'Out)
-> Parser (GovernanceActionProtocolParametersUpdateCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (File () 'Out)
forall content. Parser (File content 'Out)
pOutputFile
                )
              (InfoMod (GovernanceActionProtocolParametersUpdateCmdArgs era)
 -> ParserInfo
      (GovernanceActionProtocolParametersUpdateCmdArgs era))
-> InfoMod (GovernanceActionProtocolParametersUpdateCmdArgs era)
-> ParserInfo (GovernanceActionProtocolParametersUpdateCmdArgs era)
forall a b. (a -> b) -> a -> b
$ String
-> InfoMod (GovernanceActionProtocolParametersUpdateCmdArgs era)
forall a. String -> InfoMod a
Opt.progDesc String
"Create a protocol parameters update."
    )

pUpdateProtocolParametersPreConway
  :: ShelleyToBabbageEra era -> Parser (UpdateProtocolParametersPreConway era)
pUpdateProtocolParametersPreConway :: forall era.
ShelleyToBabbageEra era
-> Parser (UpdateProtocolParametersPreConway era)
pUpdateProtocolParametersPreConway ShelleyToBabbageEra era
shelleyToBab =
  ShelleyToBabbageEra era
-> EpochNo
-> [VerificationKeyFile 'In]
-> UpdateProtocolParametersPreConway era
forall era.
ShelleyToBabbageEra era
-> EpochNo
-> [VerificationKeyFile 'In]
-> UpdateProtocolParametersPreConway era
UpdateProtocolParametersPreConway ShelleyToBabbageEra era
shelleyToBab
    (EpochNo
 -> [VerificationKeyFile 'In]
 -> UpdateProtocolParametersPreConway era)
-> Parser EpochNo
-> Parser
     ([VerificationKeyFile 'In]
      -> UpdateProtocolParametersPreConway era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser EpochNo
pEpochNoUpdateProp
    Parser
  ([VerificationKeyFile 'In]
   -> UpdateProtocolParametersPreConway era)
-> Parser [VerificationKeyFile 'In]
-> Parser (UpdateProtocolParametersPreConway era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [VerificationKeyFile 'In]
pProtocolParametersUpdateGenesisKeys

pGovernanceGenesisKeyDelegationCertificate
  :: ()
  => ShelleyBasedEra era
  -> Maybe (Parser (CompatibleGovernanceCmds era))
pGovernanceGenesisKeyDelegationCertificate :: forall era.
ShelleyBasedEra era
-> Maybe (Parser (CompatibleGovernanceCmds era))
pGovernanceGenesisKeyDelegationCertificate ShelleyBasedEra era
sbe = do
  ShelleyToBabbageEra era
w <- ShelleyBasedEra era -> Maybe (ShelleyToBabbageEra era)
forall (eon :: * -> *) era.
Eon eon =>
ShelleyBasedEra era -> Maybe (eon era)
forShelleyBasedEraMaybeEon ShelleyBasedEra era
sbe
  Parser (CompatibleGovernanceCmds era)
-> Maybe (Parser (CompatibleGovernanceCmds era))
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser (CompatibleGovernanceCmds era)
 -> Maybe (Parser (CompatibleGovernanceCmds era)))
-> Parser (CompatibleGovernanceCmds era)
-> Maybe (Parser (CompatibleGovernanceCmds era))
forall a b. (a -> b) -> a -> b
$
    Mod CommandFields (CompatibleGovernanceCmds era)
-> Parser (CompatibleGovernanceCmds era)
forall a. Mod CommandFields a -> Parser a
Opt.hsubparser (Mod CommandFields (CompatibleGovernanceCmds era)
 -> Parser (CompatibleGovernanceCmds era))
-> Mod CommandFields (CompatibleGovernanceCmds era)
-> Parser (CompatibleGovernanceCmds era)
forall a b. (a -> b) -> a -> b
$
      String
-> ParserInfo (CompatibleGovernanceCmds era)
-> Mod CommandFields (CompatibleGovernanceCmds era)
forall a. String -> ParserInfo a -> Mod CommandFields a
commandWithMetavar String
"create-genesis-key-delegation-certificate" (ParserInfo (CompatibleGovernanceCmds era)
 -> Mod CommandFields (CompatibleGovernanceCmds era))
-> ParserInfo (CompatibleGovernanceCmds era)
-> Mod CommandFields (CompatibleGovernanceCmds era)
forall a b. (a -> b) -> a -> b
$
        Parser (CompatibleGovernanceCmds era)
-> InfoMod (CompatibleGovernanceCmds era)
-> ParserInfo (CompatibleGovernanceCmds era)
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (ShelleyToBabbageEra era -> Parser (CompatibleGovernanceCmds era)
forall {era}.
ShelleyToBabbageEra era -> Parser (CompatibleGovernanceCmds era)
parser ShelleyToBabbageEra era
w) (InfoMod (CompatibleGovernanceCmds era)
 -> ParserInfo (CompatibleGovernanceCmds era))
-> InfoMod (CompatibleGovernanceCmds era)
-> ParserInfo (CompatibleGovernanceCmds era)
forall a b. (a -> b) -> a -> b
$
          String -> InfoMod (CompatibleGovernanceCmds era)
forall a. String -> InfoMod a
Opt.progDesc String
"Create a genesis key delegation certificate"
 where
  parser :: ShelleyToBabbageEra era -> Parser (CompatibleGovernanceCmds era)
parser ShelleyToBabbageEra era
w =
    ShelleyToBabbageEra era
-> VerificationKeyOrHashOrFile GenesisKey
-> VerificationKeyOrHashOrFile GenesisDelegateKey
-> VerificationKeyOrHashOrFile VrfKey
-> File () 'Out
-> CompatibleGovernanceCmds era
forall era.
ShelleyToBabbageEra era
-> VerificationKeyOrHashOrFile GenesisKey
-> VerificationKeyOrHashOrFile GenesisDelegateKey
-> VerificationKeyOrHashOrFile VrfKey
-> File () 'Out
-> CompatibleGovernanceCmds era
CompatibleGenesisKeyDelegationCertificate ShelleyToBabbageEra era
w
      (VerificationKeyOrHashOrFile GenesisKey
 -> VerificationKeyOrHashOrFile GenesisDelegateKey
 -> VerificationKeyOrHashOrFile VrfKey
 -> File () 'Out
 -> CompatibleGovernanceCmds era)
-> Parser (VerificationKeyOrHashOrFile GenesisKey)
-> Parser
     (VerificationKeyOrHashOrFile GenesisDelegateKey
      -> VerificationKeyOrHashOrFile VrfKey
      -> File () 'Out
      -> CompatibleGovernanceCmds era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyOrHashOrFile GenesisKey)
pGenesisVerificationKeyOrHashOrFile
      Parser
  (VerificationKeyOrHashOrFile GenesisDelegateKey
   -> VerificationKeyOrHashOrFile VrfKey
   -> File () 'Out
   -> CompatibleGovernanceCmds era)
-> Parser (VerificationKeyOrHashOrFile GenesisDelegateKey)
-> Parser
     (VerificationKeyOrHashOrFile VrfKey
      -> File () 'Out -> CompatibleGovernanceCmds era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (VerificationKeyOrHashOrFile GenesisDelegateKey)
pGenesisDelegateVerificationKeyOrHashOrFile
      Parser
  (VerificationKeyOrHashOrFile VrfKey
   -> File () 'Out -> CompatibleGovernanceCmds era)
-> Parser (VerificationKeyOrHashOrFile VrfKey)
-> Parser (File () 'Out -> CompatibleGovernanceCmds era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (VerificationKeyOrHashOrFile VrfKey)
pVrfVerificationKeyOrHashOrFile
      Parser (File () 'Out -> CompatibleGovernanceCmds era)
-> Parser (File () 'Out) -> Parser (CompatibleGovernanceCmds era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (File () 'Out)
forall content. Parser (File content 'Out)
pOutputFile

pCreateMirCertificatesCmds :: ShelleyBasedEra era -> Maybe (Parser (CompatibleGovernanceCmds era))
pCreateMirCertificatesCmds :: forall era.
ShelleyBasedEra era
-> Maybe (Parser (CompatibleGovernanceCmds era))
pCreateMirCertificatesCmds ShelleyBasedEra era
era' = do
  ShelleyToBabbageEra era
w <- ShelleyBasedEra era -> Maybe (ShelleyToBabbageEra era)
forall (eon :: * -> *) era.
Eon eon =>
ShelleyBasedEra era -> Maybe (eon era)
forShelleyBasedEraMaybeEon ShelleyBasedEra era
era'
  Parser (CompatibleGovernanceCmds era)
-> Maybe (Parser (CompatibleGovernanceCmds era))
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser (CompatibleGovernanceCmds era)
 -> Maybe (Parser (CompatibleGovernanceCmds era)))
-> Parser (CompatibleGovernanceCmds era)
-> Maybe (Parser (CompatibleGovernanceCmds era))
forall a b. (a -> b) -> a -> b
$
    Mod CommandFields (CompatibleGovernanceCmds era)
-> Parser (CompatibleGovernanceCmds era)
forall a. Mod CommandFields a -> Parser a
Opt.hsubparser (Mod CommandFields (CompatibleGovernanceCmds era)
 -> Parser (CompatibleGovernanceCmds era))
-> Mod CommandFields (CompatibleGovernanceCmds era)
-> Parser (CompatibleGovernanceCmds era)
forall a b. (a -> b) -> a -> b
$
      String
-> ParserInfo (CompatibleGovernanceCmds era)
-> Mod CommandFields (CompatibleGovernanceCmds era)
forall a. String -> ParserInfo a -> Mod CommandFields a
commandWithMetavar String
"create-mir-certificate" (ParserInfo (CompatibleGovernanceCmds era)
 -> Mod CommandFields (CompatibleGovernanceCmds era))
-> ParserInfo (CompatibleGovernanceCmds era)
-> Mod CommandFields (CompatibleGovernanceCmds era)
forall a b. (a -> b) -> a -> b
$
        Parser (CompatibleGovernanceCmds era)
-> InfoMod (CompatibleGovernanceCmds era)
-> ParserInfo (CompatibleGovernanceCmds era)
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (ShelleyToBabbageEra era -> Parser (CompatibleGovernanceCmds era)
forall {era}.
ShelleyToBabbageEra era -> Parser (CompatibleGovernanceCmds era)
pMIRPayStakeAddresses ShelleyToBabbageEra era
w Parser (CompatibleGovernanceCmds era)
-> Parser (CompatibleGovernanceCmds era)
-> Parser (CompatibleGovernanceCmds era)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ShelleyToBabbageEra era -> Parser (CompatibleGovernanceCmds era)
forall {era}.
ShelleyToBabbageEra era -> Parser (CompatibleGovernanceCmds era)
mirCertParsers ShelleyToBabbageEra era
w) (InfoMod (CompatibleGovernanceCmds era)
 -> ParserInfo (CompatibleGovernanceCmds era))
-> InfoMod (CompatibleGovernanceCmds era)
-> ParserInfo (CompatibleGovernanceCmds era)
forall a b. (a -> b) -> a -> b
$
          String -> InfoMod (CompatibleGovernanceCmds era)
forall a. String -> InfoMod a
Opt.progDesc String
"Create an MIR (Move Instantaneous Rewards) certificate"

mirCertParsers
  :: ()
  => ShelleyToBabbageEra era
  -> Parser (CompatibleGovernanceCmds era)
mirCertParsers :: forall {era}.
ShelleyToBabbageEra era -> Parser (CompatibleGovernanceCmds era)
mirCertParsers ShelleyToBabbageEra era
w =
  [Parser (CompatibleGovernanceCmds era)]
-> Parser (CompatibleGovernanceCmds era)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ Mod CommandFields (CompatibleGovernanceCmds era)
-> Parser (CompatibleGovernanceCmds era)
forall a. Mod CommandFields a -> Parser a
Opt.hsubparser (Mod CommandFields (CompatibleGovernanceCmds era)
 -> Parser (CompatibleGovernanceCmds era))
-> Mod CommandFields (CompatibleGovernanceCmds era)
-> Parser (CompatibleGovernanceCmds era)
forall a b. (a -> b) -> a -> b
$
        String
-> ParserInfo (CompatibleGovernanceCmds era)
-> Mod CommandFields (CompatibleGovernanceCmds era)
forall a. String -> ParserInfo a -> Mod CommandFields a
commandWithMetavar String
"stake-addresses" (ParserInfo (CompatibleGovernanceCmds era)
 -> Mod CommandFields (CompatibleGovernanceCmds era))
-> ParserInfo (CompatibleGovernanceCmds era)
-> Mod CommandFields (CompatibleGovernanceCmds era)
forall a b. (a -> b) -> a -> b
$
          Parser (CompatibleGovernanceCmds era)
-> InfoMod (CompatibleGovernanceCmds era)
-> ParserInfo (CompatibleGovernanceCmds era)
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (ShelleyToBabbageEra era -> Parser (CompatibleGovernanceCmds era)
forall {era}.
ShelleyToBabbageEra era -> Parser (CompatibleGovernanceCmds era)
pMIRPayStakeAddresses ShelleyToBabbageEra era
w) (InfoMod (CompatibleGovernanceCmds era)
 -> ParserInfo (CompatibleGovernanceCmds era))
-> InfoMod (CompatibleGovernanceCmds era)
-> ParserInfo (CompatibleGovernanceCmds era)
forall a b. (a -> b) -> a -> b
$
            String -> InfoMod (CompatibleGovernanceCmds era)
forall a. String -> InfoMod a
Opt.progDesc String
"Create an MIR certificate to pay stake addresses"
    , Mod CommandFields (CompatibleGovernanceCmds era)
-> Parser (CompatibleGovernanceCmds era)
forall a. Mod CommandFields a -> Parser a
Opt.hsubparser (Mod CommandFields (CompatibleGovernanceCmds era)
 -> Parser (CompatibleGovernanceCmds era))
-> Mod CommandFields (CompatibleGovernanceCmds era)
-> Parser (CompatibleGovernanceCmds era)
forall a b. (a -> b) -> a -> b
$
        String
-> ParserInfo (CompatibleGovernanceCmds era)
-> Mod CommandFields (CompatibleGovernanceCmds era)
forall a. String -> ParserInfo a -> Mod CommandFields a
commandWithMetavar String
"transfer-to-treasury" (ParserInfo (CompatibleGovernanceCmds era)
 -> Mod CommandFields (CompatibleGovernanceCmds era))
-> ParserInfo (CompatibleGovernanceCmds era)
-> Mod CommandFields (CompatibleGovernanceCmds era)
forall a b. (a -> b) -> a -> b
$
          Parser (CompatibleGovernanceCmds era)
-> InfoMod (CompatibleGovernanceCmds era)
-> ParserInfo (CompatibleGovernanceCmds era)
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (ShelleyToBabbageEra era -> Parser (CompatibleGovernanceCmds era)
forall {era}.
ShelleyToBabbageEra era -> Parser (CompatibleGovernanceCmds era)
pGovernanceCreateMirCertificateTransferToTreasuryCmd ShelleyToBabbageEra era
w) (InfoMod (CompatibleGovernanceCmds era)
 -> ParserInfo (CompatibleGovernanceCmds era))
-> InfoMod (CompatibleGovernanceCmds era)
-> ParserInfo (CompatibleGovernanceCmds era)
forall a b. (a -> b) -> a -> b
$
            String -> InfoMod (CompatibleGovernanceCmds era)
forall a. String -> InfoMod a
Opt.progDesc String
"Create an MIR certificate to transfer from the reserves pot to the treasury pot"
    , Mod CommandFields (CompatibleGovernanceCmds era)
-> Parser (CompatibleGovernanceCmds era)
forall a. Mod CommandFields a -> Parser a
Opt.hsubparser (Mod CommandFields (CompatibleGovernanceCmds era)
 -> Parser (CompatibleGovernanceCmds era))
-> Mod CommandFields (CompatibleGovernanceCmds era)
-> Parser (CompatibleGovernanceCmds era)
forall a b. (a -> b) -> a -> b
$
        String
-> ParserInfo (CompatibleGovernanceCmds era)
-> Mod CommandFields (CompatibleGovernanceCmds era)
forall a. String -> ParserInfo a -> Mod CommandFields a
commandWithMetavar String
"transfer-to-rewards" (ParserInfo (CompatibleGovernanceCmds era)
 -> Mod CommandFields (CompatibleGovernanceCmds era))
-> ParserInfo (CompatibleGovernanceCmds era)
-> Mod CommandFields (CompatibleGovernanceCmds era)
forall a b. (a -> b) -> a -> b
$
          Parser (CompatibleGovernanceCmds era)
-> InfoMod (CompatibleGovernanceCmds era)
-> ParserInfo (CompatibleGovernanceCmds era)
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (ShelleyToBabbageEra era -> Parser (CompatibleGovernanceCmds era)
forall {era}.
ShelleyToBabbageEra era -> Parser (CompatibleGovernanceCmds era)
pGovernanceCreateMirCertificateTransferToReservesCmd ShelleyToBabbageEra era
w) (InfoMod (CompatibleGovernanceCmds era)
 -> ParserInfo (CompatibleGovernanceCmds era))
-> InfoMod (CompatibleGovernanceCmds era)
-> ParserInfo (CompatibleGovernanceCmds era)
forall a b. (a -> b) -> a -> b
$
            String -> InfoMod (CompatibleGovernanceCmds era)
forall a. String -> InfoMod a
Opt.progDesc String
"Create an MIR certificate to transfer from the treasury pot to the reserves pot"
    ]

pMIRPayStakeAddresses
  :: ()
  => ShelleyToBabbageEra era
  -> Parser (CompatibleGovernanceCmds era)
pMIRPayStakeAddresses :: forall {era}.
ShelleyToBabbageEra era -> Parser (CompatibleGovernanceCmds era)
pMIRPayStakeAddresses ShelleyToBabbageEra era
w =
  ShelleyToBabbageEra era
-> MIRPot
-> [StakeAddress]
-> [Coin]
-> File () 'Out
-> CompatibleGovernanceCmds era
forall era.
ShelleyToBabbageEra era
-> MIRPot
-> [StakeAddress]
-> [Coin]
-> File () 'Out
-> CompatibleGovernanceCmds era
CompatibleCreateMirCertificateStakeAddressesCmd ShelleyToBabbageEra era
w
    (MIRPot
 -> [StakeAddress]
 -> [Coin]
 -> File () 'Out
 -> CompatibleGovernanceCmds era)
-> Parser MIRPot
-> Parser
     ([StakeAddress]
      -> [Coin] -> File () 'Out -> CompatibleGovernanceCmds era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MIRPot
pMIRPot
    Parser
  ([StakeAddress]
   -> [Coin] -> File () 'Out -> CompatibleGovernanceCmds era)
-> Parser [StakeAddress]
-> Parser ([Coin] -> File () 'Out -> CompatibleGovernanceCmds era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser StakeAddress -> Parser [StakeAddress]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (Maybe String -> Parser StakeAddress
pStakeAddress Maybe String
forall a. Maybe a
Nothing)
    Parser ([Coin] -> File () 'Out -> CompatibleGovernanceCmds era)
-> Parser [Coin]
-> Parser (File () 'Out -> CompatibleGovernanceCmds era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Coin -> Parser [Coin]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser Coin
pRewardAmt
    Parser (File () 'Out -> CompatibleGovernanceCmds era)
-> Parser (File () 'Out) -> Parser (CompatibleGovernanceCmds era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (File () 'Out)
forall content. Parser (File content 'Out)
pOutputFile

pGovernanceCreateMirCertificateTransferToTreasuryCmd
  :: ()
  => ShelleyToBabbageEra era
  -> Parser (CompatibleGovernanceCmds era)
pGovernanceCreateMirCertificateTransferToTreasuryCmd :: forall {era}.
ShelleyToBabbageEra era -> Parser (CompatibleGovernanceCmds era)
pGovernanceCreateMirCertificateTransferToTreasuryCmd ShelleyToBabbageEra era
w =
  ShelleyToBabbageEra era
-> Coin -> File () 'Out -> CompatibleGovernanceCmds era
forall era.
ShelleyToBabbageEra era
-> Coin -> File () 'Out -> CompatibleGovernanceCmds era
CompatibleCreateMirCertificateTransferToTreasuryCmd ShelleyToBabbageEra era
w
    (Coin -> File () 'Out -> CompatibleGovernanceCmds era)
-> Parser Coin
-> Parser (File () 'Out -> CompatibleGovernanceCmds era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Coin
pTransferAmt
    Parser (File () 'Out -> CompatibleGovernanceCmds era)
-> Parser (File () 'Out) -> Parser (CompatibleGovernanceCmds era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (File () 'Out)
forall content. Parser (File content 'Out)
pOutputFile

pGovernanceCreateMirCertificateTransferToReservesCmd
  :: ()
  => ShelleyToBabbageEra era
  -> Parser (CompatibleGovernanceCmds era)
pGovernanceCreateMirCertificateTransferToReservesCmd :: forall {era}.
ShelleyToBabbageEra era -> Parser (CompatibleGovernanceCmds era)
pGovernanceCreateMirCertificateTransferToReservesCmd ShelleyToBabbageEra era
w =
  ShelleyToBabbageEra era
-> Coin -> File () 'Out -> CompatibleGovernanceCmds era
forall era.
ShelleyToBabbageEra era
-> Coin -> File () 'Out -> CompatibleGovernanceCmds era
CompatibleCreateMirCertificateTransferToReservesCmd ShelleyToBabbageEra era
w
    (Coin -> File () 'Out -> CompatibleGovernanceCmds era)
-> Parser Coin
-> Parser (File () 'Out -> CompatibleGovernanceCmds era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Coin
pTransferAmt
    Parser (File () 'Out -> CompatibleGovernanceCmds era)
-> Parser (File () 'Out) -> Parser (CompatibleGovernanceCmds era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (File () 'Out)
forall content. Parser (File content 'Out)
pOutputFile