{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}

module Cardano.CLI.EraBased.Options.Governance.DRep
  ( pGovernanceDRepCmds
  , pUpdateCertificateCmd
  )
where

import           Cardano.Api
import qualified Cardano.Api.Ledger as L
import           Cardano.Api.Shelley (Hash (DRepMetadataHash))

import           Cardano.CLI.Commands.Hash (HashGoal (..))
import           Cardano.CLI.Environment
import           Cardano.CLI.EraBased.Commands.Governance.DRep
import           Cardano.CLI.EraBased.Options.Common
import           Cardano.CLI.Parser
import           Cardano.CLI.Read
import           Cardano.CLI.Types.Common hiding (CheckHash)
import           Cardano.CLI.Types.Key

import           Control.Applicative
import           Data.Foldable
import           Data.String
import           Options.Applicative (Parser)
import qualified Options.Applicative as Opt

pGovernanceDRepCmds
  :: ()
  => ShelleyBasedEra era
  -> Maybe (Parser (GovernanceDRepCmds era))
pGovernanceDRepCmds :: forall era.
ShelleyBasedEra era -> Maybe (Parser (GovernanceDRepCmds era))
pGovernanceDRepCmds ShelleyBasedEra era
era =
  String
-> InfoMod (GovernanceDRepCmds era)
-> [Maybe (Parser (GovernanceDRepCmds era))]
-> Maybe (Parser (GovernanceDRepCmds era))
forall a.
String -> InfoMod a -> [Maybe (Parser a)] -> Maybe (Parser a)
subInfoParser
    String
"drep"
    ( String -> InfoMod (GovernanceDRepCmds era)
forall a. String -> InfoMod a
Opt.progDesc (String -> InfoMod (GovernanceDRepCmds era))
-> String -> InfoMod (GovernanceDRepCmds era)
forall a b. (a -> b) -> a -> b
$
        [String] -> String
forall a. Monoid a => [a] -> a
mconcat
          [ String
"DRep member commands."
          ]
    )
    [ ShelleyBasedEra era -> Maybe (Parser (GovernanceDRepCmds era))
forall era.
ShelleyBasedEra era -> Maybe (Parser (GovernanceDRepCmds era))
pGovernanceDRepKeyGenCmd ShelleyBasedEra era
era
    , ShelleyBasedEra era -> Maybe (Parser (GovernanceDRepCmds era))
forall era.
ShelleyBasedEra era -> Maybe (Parser (GovernanceDRepCmds era))
pGovernanceDRepKeyIdCmd ShelleyBasedEra era
era
    , ShelleyBasedEra era -> Maybe (Parser (GovernanceDRepCmds era))
forall era.
ShelleyBasedEra era -> Maybe (Parser (GovernanceDRepCmds era))
pRegistrationCertificateCmd ShelleyBasedEra era
era
    , ShelleyBasedEra era -> Maybe (Parser (GovernanceDRepCmds era))
forall era.
ShelleyBasedEra era -> Maybe (Parser (GovernanceDRepCmds era))
pRetirementCertificateCmd ShelleyBasedEra era
era
    , ShelleyBasedEra era -> Maybe (Parser (GovernanceDRepCmds era))
forall era.
ShelleyBasedEra era -> Maybe (Parser (GovernanceDRepCmds era))
pUpdateCertificateCmd ShelleyBasedEra era
era
    , ShelleyBasedEra era -> Maybe (Parser (GovernanceDRepCmds era))
forall era.
ShelleyBasedEra era -> Maybe (Parser (GovernanceDRepCmds era))
pGovernanceDrepMetadataHashCmd ShelleyBasedEra era
era
    ]

pGovernanceDRepKeyGenCmd
  :: ()
  => ShelleyBasedEra era
  -> Maybe (Parser (GovernanceDRepCmds era))
pGovernanceDRepKeyGenCmd :: forall era.
ShelleyBasedEra era -> Maybe (Parser (GovernanceDRepCmds era))
pGovernanceDRepKeyGenCmd ShelleyBasedEra era
era = do
  ConwayEraOnwards era
w <- ShelleyBasedEra era -> Maybe (ConwayEraOnwards era)
forall (eon :: * -> *) era.
Eon eon =>
ShelleyBasedEra era -> Maybe (eon era)
forShelleyBasedEraMaybeEon ShelleyBasedEra era
era
  Parser (GovernanceDRepCmds era)
-> Maybe (Parser (GovernanceDRepCmds era))
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Parser (GovernanceDRepCmds era)
 -> Maybe (Parser (GovernanceDRepCmds era)))
-> Parser (GovernanceDRepCmds era)
-> Maybe (Parser (GovernanceDRepCmds era))
forall a b. (a -> b) -> a -> b
$ String
-> ParserInfo (GovernanceDRepCmds era)
-> Parser (GovernanceDRepCmds era)
forall a. String -> ParserInfo a -> Parser a
subParser String
"key-gen"
    (ParserInfo (GovernanceDRepCmds era)
 -> Parser (GovernanceDRepCmds era))
-> ParserInfo (GovernanceDRepCmds era)
-> Parser (GovernanceDRepCmds era)
forall a b. (a -> b) -> a -> b
$ Parser (GovernanceDRepCmds era)
-> InfoMod (GovernanceDRepCmds era)
-> ParserInfo (GovernanceDRepCmds era)
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info
      ( (GovernanceDRepKeyGenCmdArgs era -> GovernanceDRepCmds era)
-> Parser (GovernanceDRepKeyGenCmdArgs era)
-> Parser (GovernanceDRepCmds era)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GovernanceDRepKeyGenCmdArgs era -> GovernanceDRepCmds era
forall era.
GovernanceDRepKeyGenCmdArgs era -> GovernanceDRepCmds era
GovernanceDRepKeyGenCmd (Parser (GovernanceDRepKeyGenCmdArgs era)
 -> Parser (GovernanceDRepCmds era))
-> Parser (GovernanceDRepKeyGenCmdArgs era)
-> Parser (GovernanceDRepCmds era)
forall a b. (a -> b) -> a -> b
$
          ConwayEraOnwards era
-> File (VerificationKey ()) 'Out
-> File (SigningKey ()) 'Out
-> GovernanceDRepKeyGenCmdArgs era
forall era.
ConwayEraOnwards era
-> File (VerificationKey ()) 'Out
-> File (SigningKey ()) 'Out
-> GovernanceDRepKeyGenCmdArgs era
GovernanceDRepKeyGenCmdArgs ConwayEraOnwards era
w
            (File (VerificationKey ()) 'Out
 -> File (SigningKey ()) 'Out -> GovernanceDRepKeyGenCmdArgs era)
-> Parser (File (VerificationKey ()) 'Out)
-> Parser
     (File (SigningKey ()) 'Out -> GovernanceDRepKeyGenCmdArgs era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (File (VerificationKey ()) 'Out)
forall keyrole. Parser (File (VerificationKey keyrole) 'Out)
pVerificationKeyFileOut
            Parser
  (File (SigningKey ()) 'Out -> GovernanceDRepKeyGenCmdArgs era)
-> Parser (File (SigningKey ()) 'Out)
-> Parser (GovernanceDRepKeyGenCmdArgs 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 (SigningKey ()) 'Out)
forall keyrole. Parser (File (SigningKey keyrole) 'Out)
pSigningKeyFileOut
      )
    (InfoMod (GovernanceDRepCmds era)
 -> ParserInfo (GovernanceDRepCmds era))
-> InfoMod (GovernanceDRepCmds era)
-> ParserInfo (GovernanceDRepCmds era)
forall a b. (a -> b) -> a -> b
$ String -> InfoMod (GovernanceDRepCmds era)
forall a. String -> InfoMod a
Opt.progDesc String
"Generate Delegated Representative verification and signing keys."

pGovernanceDRepKeyIdCmd
  :: ()
  => ShelleyBasedEra era
  -> Maybe (Parser (GovernanceDRepCmds era))
pGovernanceDRepKeyIdCmd :: forall era.
ShelleyBasedEra era -> Maybe (Parser (GovernanceDRepCmds era))
pGovernanceDRepKeyIdCmd ShelleyBasedEra era
era = do
  ConwayEraOnwards era
w <- ShelleyBasedEra era -> Maybe (ConwayEraOnwards era)
forall (eon :: * -> *) era.
Eon eon =>
ShelleyBasedEra era -> Maybe (eon era)
forShelleyBasedEraMaybeEon ShelleyBasedEra era
era
  Parser (GovernanceDRepCmds era)
-> Maybe (Parser (GovernanceDRepCmds era))
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Parser (GovernanceDRepCmds era)
 -> Maybe (Parser (GovernanceDRepCmds era)))
-> Parser (GovernanceDRepCmds era)
-> Maybe (Parser (GovernanceDRepCmds era))
forall a b. (a -> b) -> a -> b
$ String
-> ParserInfo (GovernanceDRepCmds era)
-> Parser (GovernanceDRepCmds era)
forall a. String -> ParserInfo a -> Parser a
subParser String
"id"
    (ParserInfo (GovernanceDRepCmds era)
 -> Parser (GovernanceDRepCmds era))
-> ParserInfo (GovernanceDRepCmds era)
-> Parser (GovernanceDRepCmds era)
forall a b. (a -> b) -> a -> b
$ Parser (GovernanceDRepCmds era)
-> InfoMod (GovernanceDRepCmds era)
-> ParserInfo (GovernanceDRepCmds era)
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info
      ( (GovernanceDRepIdCmdArgs era -> GovernanceDRepCmds era)
-> Parser (GovernanceDRepIdCmdArgs era)
-> Parser (GovernanceDRepCmds era)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GovernanceDRepIdCmdArgs era -> GovernanceDRepCmds era
forall era. GovernanceDRepIdCmdArgs era -> GovernanceDRepCmds era
GovernanceDRepIdCmd (Parser (GovernanceDRepIdCmdArgs era)
 -> Parser (GovernanceDRepCmds era))
-> Parser (GovernanceDRepIdCmdArgs era)
-> Parser (GovernanceDRepCmds era)
forall a b. (a -> b) -> a -> b
$
          ConwayEraOnwards era
-> VerificationKeyOrHashOrFile DRepKey
-> IdOutputFormat
-> Maybe (File () 'Out)
-> GovernanceDRepIdCmdArgs era
forall era.
ConwayEraOnwards era
-> VerificationKeyOrHashOrFile DRepKey
-> IdOutputFormat
-> Maybe (File () 'Out)
-> GovernanceDRepIdCmdArgs era
GovernanceDRepIdCmdArgs ConwayEraOnwards era
w
            (VerificationKeyOrHashOrFile DRepKey
 -> IdOutputFormat
 -> Maybe (File () 'Out)
 -> GovernanceDRepIdCmdArgs era)
-> Parser (VerificationKeyOrHashOrFile DRepKey)
-> Parser
     (IdOutputFormat
      -> Maybe (File () 'Out) -> GovernanceDRepIdCmdArgs era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyOrHashOrFile DRepKey)
pDRepVerificationKeyOrHashOrFile
            Parser
  (IdOutputFormat
   -> Maybe (File () 'Out) -> GovernanceDRepIdCmdArgs era)
-> Parser IdOutputFormat
-> Parser (Maybe (File () 'Out) -> GovernanceDRepIdCmdArgs 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 IdOutputFormat
pDRepIdOutputFormat
            Parser (Maybe (File () 'Out) -> GovernanceDRepIdCmdArgs era)
-> Parser (Maybe (File () 'Out))
-> Parser (GovernanceDRepIdCmdArgs 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) -> Parser (Maybe (File () 'Out))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser (File () 'Out)
forall content. Parser (File content 'Out)
pOutputFile
      )
    (InfoMod (GovernanceDRepCmds era)
 -> ParserInfo (GovernanceDRepCmds era))
-> InfoMod (GovernanceDRepCmds era)
-> ParserInfo (GovernanceDRepCmds era)
forall a b. (a -> b) -> a -> b
$ String -> InfoMod (GovernanceDRepCmds era)
forall a. String -> InfoMod a
Opt.progDesc String
"Generate a drep id."

pDRepIdOutputFormat :: Parser IdOutputFormat
pDRepIdOutputFormat :: Parser IdOutputFormat
pDRepIdOutputFormat =
  [Parser IdOutputFormat] -> Parser IdOutputFormat
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [IdOutputFormat -> String -> Parser IdOutputFormat
make IdOutputFormat
IdOutputFormatHex String
"hex", IdOutputFormat -> String -> Parser IdOutputFormat
make IdOutputFormat
IdOutputFormatBech32 String
"bech32"]
    Parser IdOutputFormat
-> Parser IdOutputFormat -> Parser IdOutputFormat
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IdOutputFormat -> Parser IdOutputFormat
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IdOutputFormat
default_
 where
  default_ :: IdOutputFormat
default_ = IdOutputFormat
IdOutputFormatBech32
  make :: IdOutputFormat -> String -> Parser IdOutputFormat
make IdOutputFormat
format String
flag_ =
    IdOutputFormat
-> Mod FlagFields IdOutputFormat -> Parser IdOutputFormat
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' IdOutputFormat
format (Mod FlagFields IdOutputFormat -> Parser IdOutputFormat)
-> Mod FlagFields IdOutputFormat -> Parser IdOutputFormat
forall a b. (a -> b) -> a -> b
$
      [Mod FlagFields IdOutputFormat] -> Mod FlagFields IdOutputFormat
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod FlagFields IdOutputFormat
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod FlagFields IdOutputFormat)
-> String -> Mod FlagFields IdOutputFormat
forall a b. (a -> b) -> a -> b
$
            String
"Format drep id output as "
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
flag_
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (if IdOutputFormat
format IdOutputFormat -> IdOutputFormat -> Bool
forall a. Eq a => a -> a -> Bool
== IdOutputFormat
default_ then String
" (the default)." else String
".")
        , String -> Mod FlagFields IdOutputFormat
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_)
        ]

-- Registration Certificate related

pRegistrationCertificateCmd
  :: ()
  => ShelleyBasedEra era
  -> Maybe (Parser (GovernanceDRepCmds era))
pRegistrationCertificateCmd :: forall era.
ShelleyBasedEra era -> Maybe (Parser (GovernanceDRepCmds era))
pRegistrationCertificateCmd ShelleyBasedEra era
era = do
  ConwayEraOnwards era
w <- ShelleyBasedEra era -> Maybe (ConwayEraOnwards era)
forall (eon :: * -> *) era.
Eon eon =>
ShelleyBasedEra era -> Maybe (eon era)
forShelleyBasedEraMaybeEon ShelleyBasedEra era
era
  Parser (GovernanceDRepCmds era)
-> Maybe (Parser (GovernanceDRepCmds era))
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser (GovernanceDRepCmds era)
 -> Maybe (Parser (GovernanceDRepCmds era)))
-> Parser (GovernanceDRepCmds era)
-> Maybe (Parser (GovernanceDRepCmds era))
forall a b. (a -> b) -> a -> b
$
    String
-> ParserInfo (GovernanceDRepCmds era)
-> Parser (GovernanceDRepCmds era)
forall a. String -> ParserInfo a -> Parser a
subParser String
"registration-certificate" (ParserInfo (GovernanceDRepCmds era)
 -> Parser (GovernanceDRepCmds era))
-> ParserInfo (GovernanceDRepCmds era)
-> Parser (GovernanceDRepCmds era)
forall a b. (a -> b) -> a -> b
$
      Parser (GovernanceDRepCmds era)
-> InfoMod (GovernanceDRepCmds era)
-> ParserInfo (GovernanceDRepCmds era)
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era =>
    Parser (GovernanceDRepCmds era))
-> Parser (GovernanceDRepCmds era)
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
w ((ConwayEraOnwardsConstraints era =>
  Parser (GovernanceDRepCmds era))
 -> Parser (GovernanceDRepCmds era))
-> (ConwayEraOnwardsConstraints era =>
    Parser (GovernanceDRepCmds era))
-> Parser (GovernanceDRepCmds era)
forall a b. (a -> b) -> a -> b
$ ConwayEraOnwards era -> Parser (GovernanceDRepCmds era)
forall {era}.
ConwayEraOnwards era -> Parser (GovernanceDRepCmds era)
mkParser ConwayEraOnwards era
w) (InfoMod (GovernanceDRepCmds era)
 -> ParserInfo (GovernanceDRepCmds era))
-> InfoMod (GovernanceDRepCmds era)
-> ParserInfo (GovernanceDRepCmds era)
forall a b. (a -> b) -> a -> b
$
        String -> InfoMod (GovernanceDRepCmds era)
forall a. String -> InfoMod a
Opt.progDesc String
"Create a registration certificate."
 where
  mkParser :: ConwayEraOnwards era -> Parser (GovernanceDRepCmds era)
mkParser ConwayEraOnwards era
w =
    (GovernanceDRepRegistrationCertificateCmdArgs era
 -> GovernanceDRepCmds era)
-> Parser (GovernanceDRepRegistrationCertificateCmdArgs era)
-> Parser (GovernanceDRepCmds era)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GovernanceDRepRegistrationCertificateCmdArgs era
-> GovernanceDRepCmds era
forall era.
GovernanceDRepRegistrationCertificateCmdArgs era
-> GovernanceDRepCmds era
GovernanceDRepRegistrationCertificateCmd (Parser (GovernanceDRepRegistrationCertificateCmdArgs era)
 -> Parser (GovernanceDRepCmds era))
-> Parser (GovernanceDRepRegistrationCertificateCmdArgs era)
-> Parser (GovernanceDRepCmds era)
forall a b. (a -> b) -> a -> b
$
      ConwayEraOnwards era
-> DRepHashSource
-> Lovelace
-> Maybe
     (PotentiallyCheckedAnchor DRepMetadataUrl (Anchor StandardCrypto))
-> File () 'Out
-> GovernanceDRepRegistrationCertificateCmdArgs era
forall era.
ConwayEraOnwards era
-> DRepHashSource
-> Lovelace
-> Maybe
     (PotentiallyCheckedAnchor DRepMetadataUrl (Anchor StandardCrypto))
-> File () 'Out
-> GovernanceDRepRegistrationCertificateCmdArgs era
GovernanceDRepRegistrationCertificateCmdArgs ConwayEraOnwards era
w
        (DRepHashSource
 -> Lovelace
 -> Maybe
      (PotentiallyCheckedAnchor DRepMetadataUrl (Anchor StandardCrypto))
 -> File () 'Out
 -> GovernanceDRepRegistrationCertificateCmdArgs era)
-> Parser DRepHashSource
-> Parser
     (Lovelace
      -> Maybe
           (PotentiallyCheckedAnchor DRepMetadataUrl (Anchor StandardCrypto))
      -> File () 'Out
      -> GovernanceDRepRegistrationCertificateCmdArgs era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DRepHashSource
pDRepHashSource
        Parser
  (Lovelace
   -> Maybe
        (PotentiallyCheckedAnchor DRepMetadataUrl (Anchor StandardCrypto))
   -> File () 'Out
   -> GovernanceDRepRegistrationCertificateCmdArgs era)
-> Parser Lovelace
-> Parser
     (Maybe
        (PotentiallyCheckedAnchor DRepMetadataUrl (Anchor StandardCrypto))
      -> File () 'Out
      -> GovernanceDRepRegistrationCertificateCmdArgs 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 Lovelace
pKeyRegistDeposit
        Parser
  (Maybe
     (PotentiallyCheckedAnchor DRepMetadataUrl (Anchor StandardCrypto))
   -> File () 'Out
   -> GovernanceDRepRegistrationCertificateCmdArgs era)
-> Parser
     (Maybe
        (PotentiallyCheckedAnchor DRepMetadataUrl (Anchor StandardCrypto)))
-> Parser
     (File () 'Out -> GovernanceDRepRegistrationCertificateCmdArgs 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
  (PotentiallyCheckedAnchor DRepMetadataUrl (Anchor StandardCrypto))
-> Parser
     (Maybe
        (PotentiallyCheckedAnchor DRepMetadataUrl (Anchor StandardCrypto)))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
          ( Parser (MustCheckHash DRepMetadataUrl)
-> Parser (Anchor StandardCrypto)
-> Parser
     (PotentiallyCheckedAnchor DRepMetadataUrl (Anchor StandardCrypto))
forall anchorType anchor.
Parser (MustCheckHash anchorType)
-> Parser anchor
-> Parser (PotentiallyCheckedAnchor anchorType anchor)
pPotentiallyCheckedAnchorData
              Parser (MustCheckHash DRepMetadataUrl)
pMustCheckMetadataHash
              Parser (Anchor StandardCrypto)
pDRepMetadata
          )
        Parser
  (File () 'Out -> GovernanceDRepRegistrationCertificateCmdArgs era)
-> Parser (File () 'Out)
-> Parser (GovernanceDRepRegistrationCertificateCmdArgs 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

pDRepMetadata :: Parser (L.Anchor L.StandardCrypto)
pDRepMetadata :: Parser (Anchor StandardCrypto)
pDRepMetadata =
  Url -> SafeHash StandardCrypto AnchorData -> Anchor StandardCrypto
forall c. Url -> SafeHash c AnchorData -> Anchor c
L.Anchor
    (Url
 -> SafeHash StandardCrypto AnchorData -> Anchor StandardCrypto)
-> Parser Url
-> Parser
     (SafeHash StandardCrypto AnchorData -> Anchor StandardCrypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AnchorUrl -> Url) -> Parser AnchorUrl -> Parser Url
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AnchorUrl -> Url
unAnchorUrl Parser AnchorUrl
pDrepMetadataUrl
    Parser
  (SafeHash StandardCrypto AnchorData -> Anchor StandardCrypto)
-> Parser (SafeHash StandardCrypto AnchorData)
-> Parser (Anchor StandardCrypto)
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)
pDrepMetadataHash

pDrepMetadataUrl :: Parser AnchorUrl
pDrepMetadataUrl :: Parser AnchorUrl
pDrepMetadataUrl =
  Url -> AnchorUrl
AnchorUrl
    (Url -> AnchorUrl) -> Parser Url -> Parser AnchorUrl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser Url
pUrl String
"drep-metadata-url" String
"DRep anchor URL"

pExpectedDrepMetadataHash :: Parser (Hash DRepMetadata)
pExpectedDrepMetadataHash :: Parser (Hash DRepMetadata)
pExpectedDrepMetadataHash =
  (SafeHash StandardCrypto AnchorData -> Hash DRepMetadata)
-> String -> Parser (Hash DRepMetadata)
forall a.
(SafeHash StandardCrypto AnchorData -> a) -> String -> Parser a
pExpectedHash (Hash Blake2b_256 ByteString -> Hash DRepMetadata
Hash StandardCrypto ByteString -> Hash DRepMetadata
DRepMetadataHash (Hash Blake2b_256 ByteString -> Hash DRepMetadata)
-> (SafeHash StandardCrypto AnchorData
    -> Hash Blake2b_256 ByteString)
-> SafeHash StandardCrypto AnchorData
-> Hash DRepMetadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SafeHash StandardCrypto ByteString -> Hash Blake2b_256 ByteString
SafeHash StandardCrypto ByteString
-> Hash StandardCrypto ByteString
forall c i. SafeHash c i -> Hash (HASH c) i
L.extractHash (SafeHash StandardCrypto ByteString -> Hash Blake2b_256 ByteString)
-> (SafeHash StandardCrypto AnchorData
    -> SafeHash StandardCrypto ByteString)
-> SafeHash StandardCrypto AnchorData
-> Hash Blake2b_256 ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SafeHash StandardCrypto AnchorData
-> SafeHash StandardCrypto ByteString
forall i j c. SafeHash c i -> SafeHash c j
L.castSafeHash) String
"DRep metadata"

pDrepMetadataHash :: Parser (L.SafeHash L.StandardCrypto L.AnchorData)
pDrepMetadataHash :: Parser (SafeHash StandardCrypto AnchorData)
pDrepMetadataHash =
  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
"drep-metadata-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
"DRep anchor data hash."
      ]

pRetirementCertificateCmd
  :: ()
  => ShelleyBasedEra era
  -> Maybe (Parser (GovernanceDRepCmds era))
pRetirementCertificateCmd :: forall era.
ShelleyBasedEra era -> Maybe (Parser (GovernanceDRepCmds era))
pRetirementCertificateCmd ShelleyBasedEra era
era = do
  ConwayEraOnwards era
w <- ShelleyBasedEra era -> Maybe (ConwayEraOnwards era)
forall (eon :: * -> *) era.
Eon eon =>
ShelleyBasedEra era -> Maybe (eon era)
forShelleyBasedEraMaybeEon ShelleyBasedEra era
era
  Parser (GovernanceDRepCmds era)
-> Maybe (Parser (GovernanceDRepCmds era))
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Parser (GovernanceDRepCmds era)
 -> Maybe (Parser (GovernanceDRepCmds era)))
-> Parser (GovernanceDRepCmds era)
-> Maybe (Parser (GovernanceDRepCmds era))
forall a b. (a -> b) -> a -> b
$ String
-> ParserInfo (GovernanceDRepCmds era)
-> Parser (GovernanceDRepCmds era)
forall a. String -> ParserInfo a -> Parser a
subParser String
"retirement-certificate"
    (ParserInfo (GovernanceDRepCmds era)
 -> Parser (GovernanceDRepCmds era))
-> ParserInfo (GovernanceDRepCmds era)
-> Parser (GovernanceDRepCmds era)
forall a b. (a -> b) -> a -> b
$ Parser (GovernanceDRepCmds era)
-> InfoMod (GovernanceDRepCmds era)
-> ParserInfo (GovernanceDRepCmds era)
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info
      ( (GovernanceDRepRetirementCertificateCmdArgs era
 -> GovernanceDRepCmds era)
-> Parser (GovernanceDRepRetirementCertificateCmdArgs era)
-> Parser (GovernanceDRepCmds era)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GovernanceDRepRetirementCertificateCmdArgs era
-> GovernanceDRepCmds era
forall era.
GovernanceDRepRetirementCertificateCmdArgs era
-> GovernanceDRepCmds era
GovernanceDRepRetirementCertificateCmd (Parser (GovernanceDRepRetirementCertificateCmdArgs era)
 -> Parser (GovernanceDRepCmds era))
-> Parser (GovernanceDRepRetirementCertificateCmdArgs era)
-> Parser (GovernanceDRepCmds era)
forall a b. (a -> b) -> a -> b
$
          ConwayEraOnwards era
-> DRepHashSource
-> Lovelace
-> File () 'Out
-> GovernanceDRepRetirementCertificateCmdArgs era
forall era.
ConwayEraOnwards era
-> DRepHashSource
-> Lovelace
-> File () 'Out
-> GovernanceDRepRetirementCertificateCmdArgs era
GovernanceDRepRetirementCertificateCmdArgs ConwayEraOnwards era
w
            (DRepHashSource
 -> Lovelace
 -> File () 'Out
 -> GovernanceDRepRetirementCertificateCmdArgs era)
-> Parser DRepHashSource
-> Parser
     (Lovelace
      -> File () 'Out -> GovernanceDRepRetirementCertificateCmdArgs era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DRepHashSource
pDRepHashSource
            Parser
  (Lovelace
   -> File () 'Out -> GovernanceDRepRetirementCertificateCmdArgs era)
-> Parser Lovelace
-> Parser
     (File () 'Out -> GovernanceDRepRetirementCertificateCmdArgs 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 Lovelace
pDrepDeposit
            Parser
  (File () 'Out -> GovernanceDRepRetirementCertificateCmdArgs era)
-> Parser (File () 'Out)
-> Parser (GovernanceDRepRetirementCertificateCmdArgs 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 (GovernanceDRepCmds era)
 -> ParserInfo (GovernanceDRepCmds era))
-> InfoMod (GovernanceDRepCmds era)
-> ParserInfo (GovernanceDRepCmds era)
forall a b. (a -> b) -> a -> b
$ String -> InfoMod (GovernanceDRepCmds era)
forall a. String -> InfoMod a
Opt.progDesc String
"Create a DRep retirement certificate."

pUpdateCertificateCmd
  :: ()
  => ShelleyBasedEra era
  -> Maybe (Parser (GovernanceDRepCmds era))
pUpdateCertificateCmd :: forall era.
ShelleyBasedEra era -> Maybe (Parser (GovernanceDRepCmds era))
pUpdateCertificateCmd ShelleyBasedEra era
era = do
  ConwayEraOnwards era
w <- ShelleyBasedEra era -> Maybe (ConwayEraOnwards era)
forall (eon :: * -> *) era.
Eon eon =>
ShelleyBasedEra era -> Maybe (eon era)
forShelleyBasedEraMaybeEon ShelleyBasedEra era
era
  Parser (GovernanceDRepCmds era)
-> Maybe (Parser (GovernanceDRepCmds era))
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Parser (GovernanceDRepCmds era)
 -> Maybe (Parser (GovernanceDRepCmds era)))
-> Parser (GovernanceDRepCmds era)
-> Maybe (Parser (GovernanceDRepCmds era))
forall a b. (a -> b) -> a -> b
$ String
-> ParserInfo (GovernanceDRepCmds era)
-> Parser (GovernanceDRepCmds era)
forall a. String -> ParserInfo a -> Parser a
subParser String
"update-certificate"
    (ParserInfo (GovernanceDRepCmds era)
 -> Parser (GovernanceDRepCmds era))
-> ParserInfo (GovernanceDRepCmds era)
-> Parser (GovernanceDRepCmds era)
forall a b. (a -> b) -> a -> b
$ Parser (GovernanceDRepCmds era)
-> InfoMod (GovernanceDRepCmds era)
-> ParserInfo (GovernanceDRepCmds era)
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info
      ( (GovernanceDRepUpdateCertificateCmdArgs era
 -> GovernanceDRepCmds era)
-> Parser (GovernanceDRepUpdateCertificateCmdArgs era)
-> Parser (GovernanceDRepCmds era)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GovernanceDRepUpdateCertificateCmdArgs era
-> GovernanceDRepCmds era
forall era.
GovernanceDRepUpdateCertificateCmdArgs era
-> GovernanceDRepCmds era
GovernanceDRepUpdateCertificateCmd (Parser (GovernanceDRepUpdateCertificateCmdArgs era)
 -> Parser (GovernanceDRepCmds era))
-> Parser (GovernanceDRepUpdateCertificateCmdArgs era)
-> Parser (GovernanceDRepCmds era)
forall a b. (a -> b) -> a -> b
$
          ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era =>
    Parser (GovernanceDRepUpdateCertificateCmdArgs era))
-> Parser (GovernanceDRepUpdateCertificateCmdArgs era)
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
w ((ConwayEraOnwardsConstraints era =>
  Parser (GovernanceDRepUpdateCertificateCmdArgs era))
 -> Parser (GovernanceDRepUpdateCertificateCmdArgs era))
-> (ConwayEraOnwardsConstraints era =>
    Parser (GovernanceDRepUpdateCertificateCmdArgs era))
-> Parser (GovernanceDRepUpdateCertificateCmdArgs era)
forall a b. (a -> b) -> a -> b
$
            ConwayEraOnwards era
-> DRepHashSource
-> Maybe
     (PotentiallyCheckedAnchor DRepMetadataUrl (Anchor StandardCrypto))
-> File () 'Out
-> GovernanceDRepUpdateCertificateCmdArgs era
forall era.
ConwayEraOnwards era
-> DRepHashSource
-> Maybe
     (PotentiallyCheckedAnchor DRepMetadataUrl (Anchor StandardCrypto))
-> File () 'Out
-> GovernanceDRepUpdateCertificateCmdArgs era
GovernanceDRepUpdateCertificateCmdArgs ConwayEraOnwards era
w
              (DRepHashSource
 -> Maybe
      (PotentiallyCheckedAnchor DRepMetadataUrl (Anchor StandardCrypto))
 -> File () 'Out
 -> GovernanceDRepUpdateCertificateCmdArgs era)
-> Parser DRepHashSource
-> Parser
     (Maybe
        (PotentiallyCheckedAnchor DRepMetadataUrl (Anchor StandardCrypto))
      -> File () 'Out -> GovernanceDRepUpdateCertificateCmdArgs era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DRepHashSource
pDRepHashSource
              Parser
  (Maybe
     (PotentiallyCheckedAnchor DRepMetadataUrl (Anchor StandardCrypto))
   -> File () 'Out -> GovernanceDRepUpdateCertificateCmdArgs era)
-> Parser
     (Maybe
        (PotentiallyCheckedAnchor DRepMetadataUrl (Anchor StandardCrypto)))
-> Parser
     (File () 'Out -> GovernanceDRepUpdateCertificateCmdArgs 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
  (PotentiallyCheckedAnchor DRepMetadataUrl (Anchor StandardCrypto))
-> Parser
     (Maybe
        (PotentiallyCheckedAnchor DRepMetadataUrl (Anchor StandardCrypto)))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
                ( Parser (MustCheckHash DRepMetadataUrl)
-> Parser (Anchor StandardCrypto)
-> Parser
     (PotentiallyCheckedAnchor DRepMetadataUrl (Anchor StandardCrypto))
forall anchorType anchor.
Parser (MustCheckHash anchorType)
-> Parser anchor
-> Parser (PotentiallyCheckedAnchor anchorType anchor)
pPotentiallyCheckedAnchorData
                    Parser (MustCheckHash DRepMetadataUrl)
pMustCheckMetadataHash
                    Parser (Anchor StandardCrypto)
pDRepMetadata
                )
              Parser (File () 'Out -> GovernanceDRepUpdateCertificateCmdArgs era)
-> Parser (File () 'Out)
-> Parser (GovernanceDRepUpdateCertificateCmdArgs 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 (GovernanceDRepCmds era)
 -> ParserInfo (GovernanceDRepCmds era))
-> InfoMod (GovernanceDRepCmds era)
-> ParserInfo (GovernanceDRepCmds era)
forall a b. (a -> b) -> a -> b
$ String -> InfoMod (GovernanceDRepCmds era)
forall a. String -> InfoMod a
Opt.progDesc String
"Create a DRep update certificate."

pGovernanceDrepMetadataHashCmd
  :: ()
  => ShelleyBasedEra era
  -> Maybe (Parser (GovernanceDRepCmds era))
pGovernanceDrepMetadataHashCmd :: forall era.
ShelleyBasedEra era -> Maybe (Parser (GovernanceDRepCmds era))
pGovernanceDrepMetadataHashCmd ShelleyBasedEra era
era = do
  ConwayEraOnwards era
w <- ShelleyBasedEra era -> Maybe (ConwayEraOnwards era)
forall (eon :: * -> *) era.
Eon eon =>
ShelleyBasedEra era -> Maybe (eon era)
forShelleyBasedEraMaybeEon ShelleyBasedEra era
era
  Parser (GovernanceDRepCmds era)
-> Maybe (Parser (GovernanceDRepCmds era))
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Parser (GovernanceDRepCmds era)
 -> Maybe (Parser (GovernanceDRepCmds era)))
-> Parser (GovernanceDRepCmds era)
-> Maybe (Parser (GovernanceDRepCmds era))
forall a b. (a -> b) -> a -> b
$ String
-> ParserInfo (GovernanceDRepCmds era)
-> Parser (GovernanceDRepCmds era)
forall a. String -> ParserInfo a -> Parser a
subParser String
"metadata-hash"
    (ParserInfo (GovernanceDRepCmds era)
 -> Parser (GovernanceDRepCmds era))
-> ParserInfo (GovernanceDRepCmds era)
-> Parser (GovernanceDRepCmds era)
forall a b. (a -> b) -> a -> b
$ Parser (GovernanceDRepCmds era)
-> InfoMod (GovernanceDRepCmds era)
-> ParserInfo (GovernanceDRepCmds era)
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info
      ( (GovernanceDRepMetadataHashCmdArgs era -> GovernanceDRepCmds era)
-> Parser (GovernanceDRepMetadataHashCmdArgs era)
-> Parser (GovernanceDRepCmds era)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GovernanceDRepMetadataHashCmdArgs era -> GovernanceDRepCmds era
forall era.
GovernanceDRepMetadataHashCmdArgs era -> GovernanceDRepCmds era
GovernanceDRepMetadataHashCmd (Parser (GovernanceDRepMetadataHashCmdArgs era)
 -> Parser (GovernanceDRepCmds era))
-> Parser (GovernanceDRepMetadataHashCmdArgs era)
-> Parser (GovernanceDRepCmds era)
forall a b. (a -> b) -> a -> b
$
          ConwayEraOnwards era
-> DRepMetadataSource
-> HashGoal (Hash DRepMetadata)
-> GovernanceDRepMetadataHashCmdArgs era
forall era.
ConwayEraOnwards era
-> DRepMetadataSource
-> HashGoal (Hash DRepMetadata)
-> GovernanceDRepMetadataHashCmdArgs era
GovernanceDRepMetadataHashCmdArgs ConwayEraOnwards era
w
            (DRepMetadataSource
 -> HashGoal (Hash DRepMetadata)
 -> GovernanceDRepMetadataHashCmdArgs era)
-> Parser DRepMetadataSource
-> Parser
     (HashGoal (Hash DRepMetadata)
      -> GovernanceDRepMetadataHashCmdArgs era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DRepMetadataSource
pDRepMetadataSource
            Parser
  (HashGoal (Hash DRepMetadata)
   -> GovernanceDRepMetadataHashCmdArgs era)
-> Parser (HashGoal (Hash DRepMetadata))
-> Parser (GovernanceDRepMetadataHashCmdArgs 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 (HashGoal (Hash DRepMetadata))
pDRepHashGoal
      )
    (InfoMod (GovernanceDRepCmds era)
 -> ParserInfo (GovernanceDRepCmds era))
-> InfoMod (GovernanceDRepCmds era)
-> ParserInfo (GovernanceDRepCmds era)
forall a b. (a -> b) -> a -> b
$ String -> InfoMod (GovernanceDRepCmds era)
forall a. String -> InfoMod a
Opt.progDesc
      String
"Calculate the hash of a metadata file, optionally checking the obtained hash against an expected value."

pDRepHashGoal :: Parser (HashGoal (Hash DRepMetadata))
pDRepHashGoal :: Parser (HashGoal (Hash DRepMetadata))
pDRepHashGoal =
  [Parser (HashGoal (Hash DRepMetadata))]
-> Parser (HashGoal (Hash DRepMetadata))
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ Hash DRepMetadata -> HashGoal (Hash DRepMetadata)
forall hash. hash -> HashGoal hash
CheckHash (Hash DRepMetadata -> HashGoal (Hash DRepMetadata))
-> Parser (Hash DRepMetadata)
-> Parser (HashGoal (Hash DRepMetadata))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Hash DRepMetadata)
pExpectedDrepMetadataHash
    , File () 'Out -> HashGoal (Hash DRepMetadata)
forall hash. File () 'Out -> HashGoal hash
HashToFile (File () 'Out -> HashGoal (Hash DRepMetadata))
-> Parser (File () 'Out) -> Parser (HashGoal (Hash DRepMetadata))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (File () 'Out)
forall content. Parser (File content 'Out)
pOutputFile
    ]
    Parser (HashGoal (Hash DRepMetadata))
-> Parser (HashGoal (Hash DRepMetadata))
-> Parser (HashGoal (Hash DRepMetadata))
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> HashGoal (Hash DRepMetadata)
-> Parser (HashGoal (Hash DRepMetadata))
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashGoal (Hash DRepMetadata)
forall hash. HashGoal hash
HashToStdout

pDRepMetadataSource :: Parser DRepMetadataSource
pDRepMetadataSource :: Parser DRepMetadataSource
pDRepMetadataSource =
  [Parser DRepMetadataSource] -> Parser DRepMetadataSource
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ DRepMetadataFile 'In -> DRepMetadataSource
DrepMetadataFileIn (DRepMetadataFile 'In -> DRepMetadataSource)
-> Parser (DRepMetadataFile 'In) -> Parser DRepMetadataSource
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser (DRepMetadataFile 'In)
forall a. String -> String -> Parser (File a 'In)
pFileInDirection String
"drep-metadata-file" String
"JSON Metadata file to hash."
    , Url -> DRepMetadataSource
DrepMetadataURL (Url -> DRepMetadataSource)
-> Parser Url -> Parser DRepMetadataSource
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser Url
pUrl String
"drep-metadata-url" String
"URL pointing to the JSON Metadata file to hash."
    ]