{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Sophie CLI command types
module Bcc.CLI.Sophie.Commands
  ( -- * CLI command types
    SophieCommand (..)
  , AddressCmd (..)
  , StakeAddressCmd (..)
  , KeyCmd (..)
  , TransactionCmd (..)
  , NodeCmd (..)
  , PoolCmd (..)
  , QueryCmd (..)
  , GovernanceCmd (..)
  , GenesisCmd (..)
  , TextViewCmd (..)
  , renderSophieCommand

    -- * CLI flag types
  , AddressKeyType (..)
  , ColeKeyType (..)
  , ColeKeyFormat (..)
  , BccAddressKeyType (..)
  , GenesisDir (..)
  , VestedDir (..)
  , TxInCount (..)
  , TxOutCount (..)
  , TxSophieWitnessCount (..)
  , TxColeWitnessCount (..)
  , SomeKeyFile (..)
  , OpCertCounterFile (..)
  , OutputFile (..)
  , ProtocolParamsFile (..)
  , ProtocolParamsSourceSpec (..)
  , WitnessFile (..)
  , TxBodyFile (..)
  , TxFile (..)
  , InputTxFile (..)
  , VerificationKeyBase64 (..)
  , GenesisKeyFile (..)
  , VestedKeyFile (..)
  , MetadataFile (..)
  , PoolId (..)
  , PoolMetadataFile (..)
  , PrivKeyFile (..)
  , BlockId (..)
  , WitnessSigningData (..)
  , ColdVerificationKeyOrFile (..)
  ) where

import           Data.Text (Text)
import           Prelude

import           Bcc.Api.Sophie hiding (PoolId)

import           Shardagnostic.Consensus.BlockchainTime (SystemStart (..))

import           Bcc.CLI.Sophie.Key (PaymentVerifier, StakeVerifier, VerificationKeyOrFile,
                   VerificationKeyOrHashOrFile, VerificationKeyTextOrFile)
import           Bcc.CLI.Types

import           Sophie.Spec.Ledger.TxBody (MIRPot)
--
-- Sophie CLI command data types
--

-- | All the CLI subcommands under \"sophie\".
--
data SophieCommand
  = AddressCmd      AddressCmd
  | StakeAddressCmd StakeAddressCmd
  | KeyCmd          KeyCmd
  | TransactionCmd  TransactionCmd
  | NodeCmd         NodeCmd
  | PoolCmd         PoolCmd
  | QueryCmd        QueryCmd
  | GovernanceCmd   GovernanceCmd
  | GenesisCmd      GenesisCmd
  | TextViewCmd     TextViewCmd
  deriving Int -> SophieCommand -> ShowS
[SophieCommand] -> ShowS
SophieCommand -> String
(Int -> SophieCommand -> ShowS)
-> (SophieCommand -> String)
-> ([SophieCommand] -> ShowS)
-> Show SophieCommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SophieCommand] -> ShowS
$cshowList :: [SophieCommand] -> ShowS
show :: SophieCommand -> String
$cshow :: SophieCommand -> String
showsPrec :: Int -> SophieCommand -> ShowS
$cshowsPrec :: Int -> SophieCommand -> ShowS
Show

renderSophieCommand :: SophieCommand -> Text
renderSophieCommand :: SophieCommand -> Text
renderSophieCommand SophieCommand
sc =
  case SophieCommand
sc of
    AddressCmd AddressCmd
cmd -> AddressCmd -> Text
renderAddressCmd AddressCmd
cmd
    StakeAddressCmd StakeAddressCmd
cmd -> StakeAddressCmd -> Text
renderStakeAddressCmd StakeAddressCmd
cmd
    KeyCmd KeyCmd
cmd -> KeyCmd -> Text
renderKeyCmd KeyCmd
cmd
    TransactionCmd TransactionCmd
cmd -> TransactionCmd -> Text
renderTransactionCmd TransactionCmd
cmd
    NodeCmd NodeCmd
cmd -> NodeCmd -> Text
renderNodeCmd NodeCmd
cmd
    PoolCmd PoolCmd
cmd -> PoolCmd -> Text
renderPoolCmd PoolCmd
cmd
    QueryCmd QueryCmd
cmd -> QueryCmd -> Text
renderQueryCmd QueryCmd
cmd
    GovernanceCmd GovernanceCmd
cmd -> GovernanceCmd -> Text
renderGovernanceCmd GovernanceCmd
cmd
    GenesisCmd GenesisCmd
cmd -> GenesisCmd -> Text
renderGenesisCmd GenesisCmd
cmd
    TextViewCmd TextViewCmd
cmd -> TextViewCmd -> Text
renderTextViewCmd TextViewCmd
cmd

data AddressCmd
  = AddressKeyGen AddressKeyType VerificationKeyFile SigningKeyFile
  | AddressKeyHash VerificationKeyTextOrFile (Maybe OutputFile)
  | AddressBuild
      PaymentVerifier
      (Maybe StakeVerifier)
      NetworkId
      (Maybe OutputFile)
  | AddressBuildMultiSig ScriptFile NetworkId (Maybe OutputFile)
  | AddressInfo Text (Maybe OutputFile)
  deriving Int -> AddressCmd -> ShowS
[AddressCmd] -> ShowS
AddressCmd -> String
(Int -> AddressCmd -> ShowS)
-> (AddressCmd -> String)
-> ([AddressCmd] -> ShowS)
-> Show AddressCmd
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddressCmd] -> ShowS
$cshowList :: [AddressCmd] -> ShowS
show :: AddressCmd -> String
$cshow :: AddressCmd -> String
showsPrec :: Int -> AddressCmd -> ShowS
$cshowsPrec :: Int -> AddressCmd -> ShowS
Show


renderAddressCmd :: AddressCmd -> Text
renderAddressCmd :: AddressCmd -> Text
renderAddressCmd AddressCmd
cmd =
  case AddressCmd
cmd of
    AddressKeyGen {} -> Text
"address key-gen"
    AddressKeyHash {} -> Text
"address key-hash"
    AddressBuild {} -> Text
"address build"
    AddressBuildMultiSig {} -> Text
"address build-script"
    AddressInfo {} -> Text
"address info"

data StakeAddressCmd
  = StakeAddressKeyGen VerificationKeyFile SigningKeyFile
  | StakeAddressKeyHash (VerificationKeyOrFile StakeKey) (Maybe OutputFile)
  | StakeAddressBuild (VerificationKeyOrFile StakeKey) NetworkId (Maybe OutputFile)
  | StakeRegistrationCert StakeVerifier OutputFile
  | StakeCredentialDelegationCert
      StakeVerifier
      (VerificationKeyOrHashOrFile StakePoolKey)
      OutputFile
  | StakeCredentialDeRegistrationCert StakeVerifier OutputFile
  deriving Int -> StakeAddressCmd -> ShowS
[StakeAddressCmd] -> ShowS
StakeAddressCmd -> String
(Int -> StakeAddressCmd -> ShowS)
-> (StakeAddressCmd -> String)
-> ([StakeAddressCmd] -> ShowS)
-> Show StakeAddressCmd
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StakeAddressCmd] -> ShowS
$cshowList :: [StakeAddressCmd] -> ShowS
show :: StakeAddressCmd -> String
$cshow :: StakeAddressCmd -> String
showsPrec :: Int -> StakeAddressCmd -> ShowS
$cshowsPrec :: Int -> StakeAddressCmd -> ShowS
Show

renderStakeAddressCmd :: StakeAddressCmd -> Text
renderStakeAddressCmd :: StakeAddressCmd -> Text
renderStakeAddressCmd StakeAddressCmd
cmd =
  case StakeAddressCmd
cmd of
    StakeAddressKeyGen {} -> Text
"stake-address key-gen"
    StakeAddressKeyHash {} -> Text
"stake-address key-hash"
    StakeAddressBuild {} -> Text
"stake-address build"
    StakeRegistrationCert {} -> Text
"stake-address registration-certificate"
    StakeCredentialDelegationCert {} -> Text
"stake-address delegation-certificate"
    StakeCredentialDeRegistrationCert {} -> Text
"stake-address deregistration-certificate"

data KeyCmd
  = KeyGetVerificationKey SigningKeyFile VerificationKeyFile
  | KeyNonExtendedKey  VerificationKeyFile VerificationKeyFile
  | KeyConvertColeKey (Maybe Text) ColeKeyType SomeKeyFile OutputFile
  | KeyConvertColeGenesisVKey VerificationKeyBase64 OutputFile
  | KeyConvertColeVestedVKey VerificationKeyBase64 OutputFile
  | KeyConvertITNStakeKey SomeKeyFile OutputFile
  | KeyConvertITNExtendedToStakeKey SomeKeyFile OutputFile
  | KeyConvertITNBip32ToStakeKey SomeKeyFile OutputFile
  | KeyConvertBccAddressSigningKey BccAddressKeyType SigningKeyFile OutputFile
  deriving Int -> KeyCmd -> ShowS
[KeyCmd] -> ShowS
KeyCmd -> String
(Int -> KeyCmd -> ShowS)
-> (KeyCmd -> String) -> ([KeyCmd] -> ShowS) -> Show KeyCmd
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyCmd] -> ShowS
$cshowList :: [KeyCmd] -> ShowS
show :: KeyCmd -> String
$cshow :: KeyCmd -> String
showsPrec :: Int -> KeyCmd -> ShowS
$cshowsPrec :: Int -> KeyCmd -> ShowS
Show

renderKeyCmd :: KeyCmd -> Text
renderKeyCmd :: KeyCmd -> Text
renderKeyCmd KeyCmd
cmd =
  case KeyCmd
cmd of
    KeyGetVerificationKey {} -> Text
"key verification-key"
    KeyNonExtendedKey {} -> Text
"key non-extended-key"
    KeyConvertColeKey {} -> Text
"key convert-cole-key"
    KeyConvertColeGenesisVKey {} -> Text
"key convert-cole-genesis-key"
    KeyConvertColeVestedVKey {} -> Text
"key convert-cole-vested-key"
    KeyConvertITNStakeKey {} -> Text
"key convert-itn-key"
    KeyConvertITNExtendedToStakeKey {} -> Text
"key convert-itn-extended-key"
    KeyConvertITNBip32ToStakeKey {} -> Text
"key convert-itn-bip32-key"
    KeyConvertBccAddressSigningKey {} -> Text
"key convert-bcc-address-signing-key"

data TransactionCmd
  = TxBuildRaw
      AnyBccEra
      (Maybe ScriptValidity) -- ^ Mark script as expected to pass or fail validation
      [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
      -- ^ Transaction inputs with optional spending scripts
      [TxIn]
      -- ^ Transaction inputs for collateral, only key witnesses, no scripts.
      [WitnessSigningData]
      -- ^ Required signers
      [TxOutAnyEra]
      (Maybe (Value, [ScriptWitnessFiles WitCtxMint]))
      -- ^ Multi-Asset value with script witness
      (Maybe SlotNo)
      -- ^ Transaction lower bound
      (Maybe SlotNo)
      -- ^ Transaction upper bound
      (Maybe Entropic)
      -- ^ Tx fee
      [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
      -- ^ Certificates with potential script witness
      [(StakeAddress, Entropic, Maybe (ScriptWitnessFiles WitCtxStake))]
      TxMetadataJsonSchema
      [ScriptFile]
      -- ^ Auxillary scripts
      [MetadataFile]
      (Maybe ProtocolParamsSourceSpec)
      (Maybe UpdateProposalFile)
      TxBodyFile

    -- | Like 'TxBuildRaw' but without the fee, and with a change output.
  | TxBuild
      AnyBccEra
      AnyConsensusModeParams
      NetworkId
      (Maybe ScriptValidity) -- ^ Mark script as expected to pass or fail validation
      (Maybe Word)
      -- ^ Override the required number of tx witnesses
      [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
      -- ^ Required signers
      [WitnessSigningData]
      -- ^ Transaction inputs with optional spending scripts
      [TxIn]
      -- ^ Transaction inputs for collateral, only key witnesses, no scripts.
      [TxOutAnyEra]
      -- ^ Normal outputs
      TxOutChangeAddress
      -- ^ A change output
      (Maybe (Value, [ScriptWitnessFiles WitCtxMint]))
      -- ^ Multi-Asset value with script witness
      (Maybe SlotNo)
      -- ^ Transaction lower bound
      (Maybe SlotNo)
      -- ^ Transaction upper bound
      [(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))]
      -- ^ Certificates with potential script witness
      [(StakeAddress, Entropic, Maybe (ScriptWitnessFiles WitCtxStake))]
      -- ^ Withdrawals with potential script witness
      TxMetadataJsonSchema
      [ScriptFile]
      -- ^ Auxillary scripts
      [MetadataFile]
      (Maybe ProtocolParamsSourceSpec)
      (Maybe UpdateProposalFile)
      TxBodyFile
  | TxSign TxBodyFile [WitnessSigningData] (Maybe NetworkId) TxFile
  | TxCreateWitness TxBodyFile WitnessSigningData (Maybe NetworkId) OutputFile
  | TxAssembleTxBodyWitness TxBodyFile [WitnessFile] OutputFile
  | TxSubmit AnyConsensusModeParams NetworkId FilePath
  | TxMintedPolicyId ScriptFile
  | TxCalculateMinFee
      TxBodyFile
      (Maybe NetworkId)
      ProtocolParamsSourceSpec
      TxInCount
      TxOutCount
      TxSophieWitnessCount
      TxColeWitnessCount
  | TxCalculateMinRequiredUTxO
      AnyBccEra
      ProtocolParamsSourceSpec
      TxOutAnyEra
  | TxHashScriptData
      ScriptDataOrFile
  | TxGetTxId InputTxFile
  | TxView InputTxFile
  deriving Int -> TransactionCmd -> ShowS
[TransactionCmd] -> ShowS
TransactionCmd -> String
(Int -> TransactionCmd -> ShowS)
-> (TransactionCmd -> String)
-> ([TransactionCmd] -> ShowS)
-> Show TransactionCmd
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransactionCmd] -> ShowS
$cshowList :: [TransactionCmd] -> ShowS
show :: TransactionCmd -> String
$cshow :: TransactionCmd -> String
showsPrec :: Int -> TransactionCmd -> ShowS
$cshowsPrec :: Int -> TransactionCmd -> ShowS
Show

data InputTxFile = InputTxBodyFile TxBodyFile | InputTxFile TxFile
  deriving Int -> InputTxFile -> ShowS
[InputTxFile] -> ShowS
InputTxFile -> String
(Int -> InputTxFile -> ShowS)
-> (InputTxFile -> String)
-> ([InputTxFile] -> ShowS)
-> Show InputTxFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InputTxFile] -> ShowS
$cshowList :: [InputTxFile] -> ShowS
show :: InputTxFile -> String
$cshow :: InputTxFile -> String
showsPrec :: Int -> InputTxFile -> ShowS
$cshowsPrec :: Int -> InputTxFile -> ShowS
Show

data ProtocolParamsSourceSpec
  = ParamsFromGenesis !GenesisFile
    -- ^ We allow an appropriately forewarned user to obtain protocol params
    --   directly from the genesis file, which allows them to avoid running
    --   the node in case they would like to estimate the fee using the
    --   blockchain's initial protocol parameters.
  | ParamsFromFile !ProtocolParamsFile
    -- ^ Obtain protocol parameters from a file structured by the
    --   'bcc-api' 'ProtocolParameters' data type.
  deriving Int -> ProtocolParamsSourceSpec -> ShowS
[ProtocolParamsSourceSpec] -> ShowS
ProtocolParamsSourceSpec -> String
(Int -> ProtocolParamsSourceSpec -> ShowS)
-> (ProtocolParamsSourceSpec -> String)
-> ([ProtocolParamsSourceSpec] -> ShowS)
-> Show ProtocolParamsSourceSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProtocolParamsSourceSpec] -> ShowS
$cshowList :: [ProtocolParamsSourceSpec] -> ShowS
show :: ProtocolParamsSourceSpec -> String
$cshow :: ProtocolParamsSourceSpec -> String
showsPrec :: Int -> ProtocolParamsSourceSpec -> ShowS
$cshowsPrec :: Int -> ProtocolParamsSourceSpec -> ShowS
Show

renderTransactionCmd :: TransactionCmd -> Text
renderTransactionCmd :: TransactionCmd -> Text
renderTransactionCmd TransactionCmd
cmd =
  case TransactionCmd
cmd of
    TxBuild {} -> Text
"transaction build"
    TxBuildRaw {} -> Text
"transaction build-raw"
    TxSign {} -> Text
"transaction sign"
    TxCreateWitness {} -> Text
"transaction witness"
    TxAssembleTxBodyWitness {} -> Text
"transaction sign-witness"
    TxSubmit {} -> Text
"transaction submit"
    TxMintedPolicyId {} -> Text
"transaction policyid"
    TxCalculateMinFee {} -> Text
"transaction calculate-min-fee"
    TxCalculateMinRequiredUTxO {} -> Text
"transaction calculate-min-value"
    TxHashScriptData {} -> Text
"transaction hash-script-data"
    TxGetTxId {} -> Text
"transaction txid"
    TxView {} -> Text
"transaction view"

data NodeCmd
  = NodeKeyGenCold VerificationKeyFile SigningKeyFile OpCertCounterFile
  | NodeKeyGenKES  VerificationKeyFile SigningKeyFile
  | NodeKeyGenVRF  VerificationKeyFile SigningKeyFile
  | NodeKeyHashVRF  (VerificationKeyOrFile VrfKey) (Maybe OutputFile)
  | NodeNewCounter ColdVerificationKeyOrFile Word OpCertCounterFile
  | NodeIssueOpCert (VerificationKeyOrFile KesKey) SigningKeyFile OpCertCounterFile
                    KESPeriod OutputFile
  deriving Int -> NodeCmd -> ShowS
[NodeCmd] -> ShowS
NodeCmd -> String
(Int -> NodeCmd -> ShowS)
-> (NodeCmd -> String) -> ([NodeCmd] -> ShowS) -> Show NodeCmd
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeCmd] -> ShowS
$cshowList :: [NodeCmd] -> ShowS
show :: NodeCmd -> String
$cshow :: NodeCmd -> String
showsPrec :: Int -> NodeCmd -> ShowS
$cshowsPrec :: Int -> NodeCmd -> ShowS
Show

renderNodeCmd :: NodeCmd -> Text
renderNodeCmd :: NodeCmd -> Text
renderNodeCmd NodeCmd
cmd = do
  case NodeCmd
cmd of
    NodeKeyGenCold {} -> Text
"node key-gen"
    NodeKeyGenKES {} -> Text
"node key-gen-KES"
    NodeKeyGenVRF {} -> Text
"node key-gen-VRF"
    NodeKeyHashVRF {} -> Text
"node key-hash-VRF"
    NodeNewCounter {} -> Text
"node new-counter"
    NodeIssueOpCert{} -> Text
"node issue-op-cert"


data PoolCmd
  = PoolRegistrationCert
      (VerificationKeyOrFile StakePoolKey)
      -- ^ Stake pool verification key.
      (VerificationKeyOrFile VrfKey)
      -- ^ VRF Verification key.
      Entropic
      -- ^ Pool pledge.
      Entropic
      -- ^ Pool cost.
      Rational
      -- ^ Pool margin.
      (VerificationKeyOrFile StakeKey)
      -- ^ Reward account verification staking key.
      [VerificationKeyOrFile StakeKey]
      -- ^ Pool owner verification staking key(s).
      [StakePoolRelay]
      -- ^ Stake pool relays.
      (Maybe StakePoolMetadataReference)
      -- ^ Stake pool metadata.
      NetworkId
      OutputFile
  | PoolRetirementCert
      (VerificationKeyOrFile StakePoolKey)
      -- ^ Stake pool verification key.
      EpochNo
      -- ^ Epoch in which to retire the stake pool.
      OutputFile
  | PoolGetId (VerificationKeyOrFile StakePoolKey) OutputFormat
  | PoolMetadataHash PoolMetadataFile (Maybe OutputFile)
  deriving Int -> PoolCmd -> ShowS
[PoolCmd] -> ShowS
PoolCmd -> String
(Int -> PoolCmd -> ShowS)
-> (PoolCmd -> String) -> ([PoolCmd] -> ShowS) -> Show PoolCmd
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PoolCmd] -> ShowS
$cshowList :: [PoolCmd] -> ShowS
show :: PoolCmd -> String
$cshow :: PoolCmd -> String
showsPrec :: Int -> PoolCmd -> ShowS
$cshowsPrec :: Int -> PoolCmd -> ShowS
Show

renderPoolCmd :: PoolCmd -> Text
renderPoolCmd :: PoolCmd -> Text
renderPoolCmd PoolCmd
cmd =
  case PoolCmd
cmd of
    PoolRegistrationCert {} -> Text
"stake-pool registration-certificate"
    PoolRetirementCert {} -> Text
"stake-pool deregistration-certificate"
    PoolGetId {} -> Text
"stake-pool id"
    PoolMetadataHash {} -> Text
"stake-pool metadata-hash"

data QueryCmd =
    QueryProtocolParameters' AnyConsensusModeParams NetworkId (Maybe OutputFile)
  | QueryTip AnyConsensusModeParams NetworkId (Maybe OutputFile)
  | QueryStakePools' AnyConsensusModeParams NetworkId (Maybe OutputFile)
  | QueryStakeDistribution' AnyConsensusModeParams NetworkId (Maybe OutputFile)
  | QueryStakeAddressInfo AnyConsensusModeParams StakeAddress NetworkId (Maybe OutputFile)
  | QueryUTxO' AnyConsensusModeParams QueryUTxOFilter NetworkId (Maybe OutputFile)
  | QueryDebugLedgerState' AnyConsensusModeParams NetworkId (Maybe OutputFile)
  | QueryProtocolState' AnyConsensusModeParams NetworkId (Maybe OutputFile)
  | QueryStakeSnapshot' AnyConsensusModeParams NetworkId (Hash StakePoolKey)
  | QueryPoolParams' AnyConsensusModeParams NetworkId (Hash StakePoolKey)
  deriving Int -> QueryCmd -> ShowS
[QueryCmd] -> ShowS
QueryCmd -> String
(Int -> QueryCmd -> ShowS)
-> (QueryCmd -> String) -> ([QueryCmd] -> ShowS) -> Show QueryCmd
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QueryCmd] -> ShowS
$cshowList :: [QueryCmd] -> ShowS
show :: QueryCmd -> String
$cshow :: QueryCmd -> String
showsPrec :: Int -> QueryCmd -> ShowS
$cshowsPrec :: Int -> QueryCmd -> ShowS
Show

renderQueryCmd :: QueryCmd -> Text
renderQueryCmd :: QueryCmd -> Text
renderQueryCmd QueryCmd
cmd =
  case QueryCmd
cmd of
    QueryProtocolParameters' {} -> Text
"query protocol-parameters "
    QueryTip {} -> Text
"query tip"
    QueryStakePools' {} -> Text
"query stake-pools"
    QueryStakeDistribution' {} -> Text
"query stake-distribution"
    QueryStakeAddressInfo {} -> Text
"query stake-address-info"
    QueryUTxO' {} -> Text
"query utxo"
    QueryDebugLedgerState' {} -> Text
"query ledger-state"
    QueryProtocolState' {} -> Text
"query protocol-state"
    QueryStakeSnapshot' {} -> Text
"query stake-snapshot"
    QueryPoolParams' {} -> Text
"query pool-params"

data GovernanceCmd
  = GovernanceMIRPayStakeAddressesCertificate
      MIRPot
      [StakeAddress]
      [Entropic]
      OutputFile
  | GovernanceMIRTransfer Entropic OutputFile TransferDirection
  | GovernanceGenesisKeyDelegationCertificate
      (VerificationKeyOrHashOrFile GenesisKey)
      (VerificationKeyOrHashOrFile GenesisDelegateKey)
      (VerificationKeyOrHashOrFile VrfKey)
      OutputFile
  | GovernanceVestedKeyDelegationCertificate
      (VerificationKeyOrHashOrFile VestedKey)
      (VerificationKeyOrHashOrFile VestedDelegateKey)
      (VerificationKeyOrHashOrFile VrfKey)
      OutputFile
  | GovernanceUpdateProposal OutputFile EpochNo
                             [VerificationKeyFile]
                             ProtocolParametersUpdate
  deriving Int -> GovernanceCmd -> ShowS
[GovernanceCmd] -> ShowS
GovernanceCmd -> String
(Int -> GovernanceCmd -> ShowS)
-> (GovernanceCmd -> String)
-> ([GovernanceCmd] -> ShowS)
-> Show GovernanceCmd
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GovernanceCmd] -> ShowS
$cshowList :: [GovernanceCmd] -> ShowS
show :: GovernanceCmd -> String
$cshow :: GovernanceCmd -> String
showsPrec :: Int -> GovernanceCmd -> ShowS
$cshowsPrec :: Int -> GovernanceCmd -> ShowS
Show

renderGovernanceCmd :: GovernanceCmd -> Text
renderGovernanceCmd :: GovernanceCmd -> Text
renderGovernanceCmd GovernanceCmd
cmd =
  case GovernanceCmd
cmd of
    GovernanceGenesisKeyDelegationCertificate {} -> Text
"governance create-genesis-key-delegation-certificate"
    GovernanceVestedKeyDelegationCertificate   {} -> Text
"governance create-vested-key-delegation-certificate"
    GovernanceMIRPayStakeAddressesCertificate {} -> Text
"governance create-mir-certificate stake-addresses"
    GovernanceMIRTransfer Entropic
_ OutputFile
_ TransferDirection
TransferToTreasury -> Text
"governance create-mir-certificate transfer-to-treasury"
    GovernanceMIRTransfer Entropic
_ OutputFile
_ TransferDirection
TransferToReserves -> Text
"governance create-mir-certificate transfer-to-reserves"
    GovernanceUpdateProposal {} -> Text
"governance create-update-proposal"

data TextViewCmd
  = TextViewInfo !FilePath (Maybe OutputFile)
  deriving Int -> TextViewCmd -> ShowS
[TextViewCmd] -> ShowS
TextViewCmd -> String
(Int -> TextViewCmd -> ShowS)
-> (TextViewCmd -> String)
-> ([TextViewCmd] -> ShowS)
-> Show TextViewCmd
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextViewCmd] -> ShowS
$cshowList :: [TextViewCmd] -> ShowS
show :: TextViewCmd -> String
$cshow :: TextViewCmd -> String
showsPrec :: Int -> TextViewCmd -> ShowS
$cshowsPrec :: Int -> TextViewCmd -> ShowS
Show


renderTextViewCmd :: TextViewCmd -> Text
renderTextViewCmd :: TextViewCmd -> Text
renderTextViewCmd (TextViewInfo String
_ Maybe OutputFile
_) = Text
"text-view decode-cbor"

data GenesisCmd
  = GenesisCreate GenesisDir Word Word Word (Maybe SystemStart) (Maybe Entropic) NetworkId
  | GenesisCreateStaked GenesisDir Word Word Word Word Word (Maybe SystemStart) (Maybe Entropic) Entropic NetworkId Word Word Word
  | GenesisKeyGenGenesis VerificationKeyFile SigningKeyFile
  | GenesisKeyGenDelegate VerificationKeyFile SigningKeyFile OpCertCounterFile
  | GenesisKeyGenVested VerificationKeyFile SigningKeyFile
  | GenesisKeyGenVestedDelegate VerificationKeyFile SigningKeyFile OpCertCounterFile
  | GenesisKeyGenUTxO VerificationKeyFile SigningKeyFile
  | GenesisCmdKeyHash VerificationKeyFile
  | GenesisVerKey VerificationKeyFile SigningKeyFile
  | GenesisTxIn VerificationKeyFile NetworkId (Maybe OutputFile)
  | GenesisAddr VerificationKeyFile NetworkId (Maybe OutputFile)
  | GenesisHashFile GenesisFile
  deriving Int -> GenesisCmd -> ShowS
[GenesisCmd] -> ShowS
GenesisCmd -> String
(Int -> GenesisCmd -> ShowS)
-> (GenesisCmd -> String)
-> ([GenesisCmd] -> ShowS)
-> Show GenesisCmd
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenesisCmd] -> ShowS
$cshowList :: [GenesisCmd] -> ShowS
show :: GenesisCmd -> String
$cshow :: GenesisCmd -> String
showsPrec :: Int -> GenesisCmd -> ShowS
$cshowsPrec :: Int -> GenesisCmd -> ShowS
Show

renderGenesisCmd :: GenesisCmd -> Text
renderGenesisCmd :: GenesisCmd -> Text
renderGenesisCmd GenesisCmd
cmd =
  case GenesisCmd
cmd of
    GenesisCreate {} -> Text
"genesis create"
    GenesisCreateStaked {} -> Text
"genesis create-staked"
    GenesisKeyGenGenesis {} -> Text
"genesis key-gen-genesis"
    GenesisKeyGenDelegate {} -> Text
"genesis key-gen-delegate"
    GenesisKeyGenVested {} -> Text
"genesis key-gen-vested"
    GenesisKeyGenVestedDelegate {} -> Text
"genesis key-gen-vesteddelegate"
    GenesisKeyGenUTxO {} -> Text
"genesis key-gen-utxo"
    GenesisCmdKeyHash {} -> Text
"genesis key-hash"
    GenesisVerKey {} -> Text
"genesis get-ver-key"
    GenesisTxIn {} -> Text
"genesis initial-txin"
    GenesisAddr {} -> Text
"genesis initial-addr"
    GenesisHashFile {} -> Text
"genesis hash"

--
-- Sophie CLI flag/option data types
--

newtype ProtocolParamsFile
  = ProtocolParamsFile FilePath
  deriving (Int -> ProtocolParamsFile -> ShowS
[ProtocolParamsFile] -> ShowS
ProtocolParamsFile -> String
(Int -> ProtocolParamsFile -> ShowS)
-> (ProtocolParamsFile -> String)
-> ([ProtocolParamsFile] -> ShowS)
-> Show ProtocolParamsFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProtocolParamsFile] -> ShowS
$cshowList :: [ProtocolParamsFile] -> ShowS
show :: ProtocolParamsFile -> String
$cshow :: ProtocolParamsFile -> String
showsPrec :: Int -> ProtocolParamsFile -> ShowS
$cshowsPrec :: Int -> ProtocolParamsFile -> ShowS
Show, ProtocolParamsFile -> ProtocolParamsFile -> Bool
(ProtocolParamsFile -> ProtocolParamsFile -> Bool)
-> (ProtocolParamsFile -> ProtocolParamsFile -> Bool)
-> Eq ProtocolParamsFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProtocolParamsFile -> ProtocolParamsFile -> Bool
$c/= :: ProtocolParamsFile -> ProtocolParamsFile -> Bool
== :: ProtocolParamsFile -> ProtocolParamsFile -> Bool
$c== :: ProtocolParamsFile -> ProtocolParamsFile -> Bool
Eq)

newtype TxInCount
  = TxInCount Int
  deriving Int -> TxInCount -> ShowS
[TxInCount] -> ShowS
TxInCount -> String
(Int -> TxInCount -> ShowS)
-> (TxInCount -> String)
-> ([TxInCount] -> ShowS)
-> Show TxInCount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxInCount] -> ShowS
$cshowList :: [TxInCount] -> ShowS
show :: TxInCount -> String
$cshow :: TxInCount -> String
showsPrec :: Int -> TxInCount -> ShowS
$cshowsPrec :: Int -> TxInCount -> ShowS
Show

newtype TxOutCount
  = TxOutCount Int
  deriving Int -> TxOutCount -> ShowS
[TxOutCount] -> ShowS
TxOutCount -> String
(Int -> TxOutCount -> ShowS)
-> (TxOutCount -> String)
-> ([TxOutCount] -> ShowS)
-> Show TxOutCount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxOutCount] -> ShowS
$cshowList :: [TxOutCount] -> ShowS
show :: TxOutCount -> String
$cshow :: TxOutCount -> String
showsPrec :: Int -> TxOutCount -> ShowS
$cshowsPrec :: Int -> TxOutCount -> ShowS
Show

newtype TxSophieWitnessCount
  = TxSophieWitnessCount Int
  deriving Int -> TxSophieWitnessCount -> ShowS
[TxSophieWitnessCount] -> ShowS
TxSophieWitnessCount -> String
(Int -> TxSophieWitnessCount -> ShowS)
-> (TxSophieWitnessCount -> String)
-> ([TxSophieWitnessCount] -> ShowS)
-> Show TxSophieWitnessCount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxSophieWitnessCount] -> ShowS
$cshowList :: [TxSophieWitnessCount] -> ShowS
show :: TxSophieWitnessCount -> String
$cshow :: TxSophieWitnessCount -> String
showsPrec :: Int -> TxSophieWitnessCount -> ShowS
$cshowsPrec :: Int -> TxSophieWitnessCount -> ShowS
Show

newtype TxColeWitnessCount
  = TxColeWitnessCount Int
  deriving Int -> TxColeWitnessCount -> ShowS
[TxColeWitnessCount] -> ShowS
TxColeWitnessCount -> String
(Int -> TxColeWitnessCount -> ShowS)
-> (TxColeWitnessCount -> String)
-> ([TxColeWitnessCount] -> ShowS)
-> Show TxColeWitnessCount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxColeWitnessCount] -> ShowS
$cshowList :: [TxColeWitnessCount] -> ShowS
show :: TxColeWitnessCount -> String
$cshow :: TxColeWitnessCount -> String
showsPrec :: Int -> TxColeWitnessCount -> ShowS
$cshowsPrec :: Int -> TxColeWitnessCount -> ShowS
Show

newtype BlockId
  = BlockId String -- Probably not a String
  deriving Int -> BlockId -> ShowS
[BlockId] -> ShowS
BlockId -> String
(Int -> BlockId -> ShowS)
-> (BlockId -> String) -> ([BlockId] -> ShowS) -> Show BlockId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockId] -> ShowS
$cshowList :: [BlockId] -> ShowS
show :: BlockId -> String
$cshow :: BlockId -> String
showsPrec :: Int -> BlockId -> ShowS
$cshowsPrec :: Int -> BlockId -> ShowS
Show

newtype GenesisKeyFile
  = GenesisKeyFile FilePath
  deriving Int -> GenesisKeyFile -> ShowS
[GenesisKeyFile] -> ShowS
GenesisKeyFile -> String
(Int -> GenesisKeyFile -> ShowS)
-> (GenesisKeyFile -> String)
-> ([GenesisKeyFile] -> ShowS)
-> Show GenesisKeyFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenesisKeyFile] -> ShowS
$cshowList :: [GenesisKeyFile] -> ShowS
show :: GenesisKeyFile -> String
$cshow :: GenesisKeyFile -> String
showsPrec :: Int -> GenesisKeyFile -> ShowS
$cshowsPrec :: Int -> GenesisKeyFile -> ShowS
Show

newtype VestedKeyFile
  = VestedKeyFile FilePath
  deriving Int -> VestedKeyFile -> ShowS
[VestedKeyFile] -> ShowS
VestedKeyFile -> String
(Int -> VestedKeyFile -> ShowS)
-> (VestedKeyFile -> String)
-> ([VestedKeyFile] -> ShowS)
-> Show VestedKeyFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VestedKeyFile] -> ShowS
$cshowList :: [VestedKeyFile] -> ShowS
show :: VestedKeyFile -> String
$cshow :: VestedKeyFile -> String
showsPrec :: Int -> VestedKeyFile -> ShowS
$cshowsPrec :: Int -> VestedKeyFile -> ShowS
Show

data MetadataFile = MetadataFileJSON FilePath
                  | MetadataFileCBOR FilePath

  deriving Int -> MetadataFile -> ShowS
[MetadataFile] -> ShowS
MetadataFile -> String
(Int -> MetadataFile -> ShowS)
-> (MetadataFile -> String)
-> ([MetadataFile] -> ShowS)
-> Show MetadataFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MetadataFile] -> ShowS
$cshowList :: [MetadataFile] -> ShowS
show :: MetadataFile -> String
$cshow :: MetadataFile -> String
showsPrec :: Int -> MetadataFile -> ShowS
$cshowsPrec :: Int -> MetadataFile -> ShowS
Show

newtype OutputFile
  = OutputFile FilePath
  deriving Int -> OutputFile -> ShowS
[OutputFile] -> ShowS
OutputFile -> String
(Int -> OutputFile -> ShowS)
-> (OutputFile -> String)
-> ([OutputFile] -> ShowS)
-> Show OutputFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OutputFile] -> ShowS
$cshowList :: [OutputFile] -> ShowS
show :: OutputFile -> String
$cshow :: OutputFile -> String
showsPrec :: Int -> OutputFile -> ShowS
$cshowsPrec :: Int -> OutputFile -> ShowS
Show

newtype PoolId
  = PoolId String -- Probably not a String
  deriving Int -> PoolId -> ShowS
[PoolId] -> ShowS
PoolId -> String
(Int -> PoolId -> ShowS)
-> (PoolId -> String) -> ([PoolId] -> ShowS) -> Show PoolId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PoolId] -> ShowS
$cshowList :: [PoolId] -> ShowS
show :: PoolId -> String
$cshow :: PoolId -> String
showsPrec :: Int -> PoolId -> ShowS
$cshowsPrec :: Int -> PoolId -> ShowS
Show

newtype PoolMetadataFile = PoolMetadataFile
  { PoolMetadataFile -> String
unPoolMetadataFile :: FilePath }
  deriving Int -> PoolMetadataFile -> ShowS
[PoolMetadataFile] -> ShowS
PoolMetadataFile -> String
(Int -> PoolMetadataFile -> ShowS)
-> (PoolMetadataFile -> String)
-> ([PoolMetadataFile] -> ShowS)
-> Show PoolMetadataFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PoolMetadataFile] -> ShowS
$cshowList :: [PoolMetadataFile] -> ShowS
show :: PoolMetadataFile -> String
$cshow :: PoolMetadataFile -> String
showsPrec :: Int -> PoolMetadataFile -> ShowS
$cshowsPrec :: Int -> PoolMetadataFile -> ShowS
Show

newtype GenesisDir
  = GenesisDir FilePath
  deriving Int -> GenesisDir -> ShowS
[GenesisDir] -> ShowS
GenesisDir -> String
(Int -> GenesisDir -> ShowS)
-> (GenesisDir -> String)
-> ([GenesisDir] -> ShowS)
-> Show GenesisDir
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenesisDir] -> ShowS
$cshowList :: [GenesisDir] -> ShowS
show :: GenesisDir -> String
$cshow :: GenesisDir -> String
showsPrec :: Int -> GenesisDir -> ShowS
$cshowsPrec :: Int -> GenesisDir -> ShowS
Show

newtype VestedDir
  = VestedDir FilePath
  deriving Int -> VestedDir -> ShowS
[VestedDir] -> ShowS
VestedDir -> String
(Int -> VestedDir -> ShowS)
-> (VestedDir -> String)
-> ([VestedDir] -> ShowS)
-> Show VestedDir
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VestedDir] -> ShowS
$cshowList :: [VestedDir] -> ShowS
show :: VestedDir -> String
$cshow :: VestedDir -> String
showsPrec :: Int -> VestedDir -> ShowS
$cshowsPrec :: Int -> VestedDir -> ShowS
Show

-- | Either a verification or signing key, used for conversions and other
-- commands that make sense for both.
--
data SomeKeyFile
  = AVerificationKeyFile VerificationKeyFile
  | ASigningKeyFile SigningKeyFile
  deriving Int -> SomeKeyFile -> ShowS
[SomeKeyFile] -> ShowS
SomeKeyFile -> String
(Int -> SomeKeyFile -> ShowS)
-> (SomeKeyFile -> String)
-> ([SomeKeyFile] -> ShowS)
-> Show SomeKeyFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SomeKeyFile] -> ShowS
$cshowList :: [SomeKeyFile] -> ShowS
show :: SomeKeyFile -> String
$cshow :: SomeKeyFile -> String
showsPrec :: Int -> SomeKeyFile -> ShowS
$cshowsPrec :: Int -> SomeKeyFile -> ShowS
Show

data AddressKeyType
  = AddressKeySophie
  | AddressKeySophieExtended
  | AddressKeyCole
  deriving Int -> AddressKeyType -> ShowS
[AddressKeyType] -> ShowS
AddressKeyType -> String
(Int -> AddressKeyType -> ShowS)
-> (AddressKeyType -> String)
-> ([AddressKeyType] -> ShowS)
-> Show AddressKeyType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddressKeyType] -> ShowS
$cshowList :: [AddressKeyType] -> ShowS
show :: AddressKeyType -> String
$cshow :: AddressKeyType -> String
showsPrec :: Int -> AddressKeyType -> ShowS
$cshowsPrec :: Int -> AddressKeyType -> ShowS
Show

data ColeKeyType
  = ColePaymentKey        ColeKeyFormat
  | ColeGenesisKey        ColeKeyFormat
  | ColeGenesisVestedKey  ColeKeyFormat
  | ColeVestedKey         ColeKeyFormat
  | ColeDelegateKey       ColeKeyFormat
  | ColeVestedDelegateKey ColeKeyFormat
  deriving Int -> ColeKeyType -> ShowS
[ColeKeyType] -> ShowS
ColeKeyType -> String
(Int -> ColeKeyType -> ShowS)
-> (ColeKeyType -> String)
-> ([ColeKeyType] -> ShowS)
-> Show ColeKeyType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColeKeyType] -> ShowS
$cshowList :: [ColeKeyType] -> ShowS
show :: ColeKeyType -> String
$cshow :: ColeKeyType -> String
showsPrec :: Int -> ColeKeyType -> ShowS
$cshowsPrec :: Int -> ColeKeyType -> ShowS
Show

data ColeKeyFormat = NonLegacyColeKeyFormat
                    | LegacyColeKeyFormat
  deriving Int -> ColeKeyFormat -> ShowS
[ColeKeyFormat] -> ShowS
ColeKeyFormat -> String
(Int -> ColeKeyFormat -> ShowS)
-> (ColeKeyFormat -> String)
-> ([ColeKeyFormat] -> ShowS)
-> Show ColeKeyFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColeKeyFormat] -> ShowS
$cshowList :: [ColeKeyFormat] -> ShowS
show :: ColeKeyFormat -> String
$cshow :: ColeKeyFormat -> String
showsPrec :: Int -> ColeKeyFormat -> ShowS
$cshowsPrec :: Int -> ColeKeyFormat -> ShowS
Show

-- | The type of @bcc-address@ key.
data BccAddressKeyType
  = BccAddressSophiePaymentKey
  | BccAddressSophieStakeKey
  | BccAddressIcarusPaymentKey
  | BccAddressColePaymentKey
  deriving Int -> BccAddressKeyType -> ShowS
[BccAddressKeyType] -> ShowS
BccAddressKeyType -> String
(Int -> BccAddressKeyType -> ShowS)
-> (BccAddressKeyType -> String)
-> ([BccAddressKeyType] -> ShowS)
-> Show BccAddressKeyType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BccAddressKeyType] -> ShowS
$cshowList :: [BccAddressKeyType] -> ShowS
show :: BccAddressKeyType -> String
$cshow :: BccAddressKeyType -> String
showsPrec :: Int -> BccAddressKeyType -> ShowS
$cshowsPrec :: Int -> BccAddressKeyType -> ShowS
Show

newtype OpCertCounterFile
  = OpCertCounterFile FilePath
  deriving Int -> OpCertCounterFile -> ShowS
[OpCertCounterFile] -> ShowS
OpCertCounterFile -> String
(Int -> OpCertCounterFile -> ShowS)
-> (OpCertCounterFile -> String)
-> ([OpCertCounterFile] -> ShowS)
-> Show OpCertCounterFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpCertCounterFile] -> ShowS
$cshowList :: [OpCertCounterFile] -> ShowS
show :: OpCertCounterFile -> String
$cshow :: OpCertCounterFile -> String
showsPrec :: Int -> OpCertCounterFile -> ShowS
$cshowsPrec :: Int -> OpCertCounterFile -> ShowS
Show

newtype PrivKeyFile
  = PrivKeyFile FilePath
  deriving Int -> PrivKeyFile -> ShowS
[PrivKeyFile] -> ShowS
PrivKeyFile -> String
(Int -> PrivKeyFile -> ShowS)
-> (PrivKeyFile -> String)
-> ([PrivKeyFile] -> ShowS)
-> Show PrivKeyFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrivKeyFile] -> ShowS
$cshowList :: [PrivKeyFile] -> ShowS
show :: PrivKeyFile -> String
$cshow :: PrivKeyFile -> String
showsPrec :: Int -> PrivKeyFile -> ShowS
$cshowsPrec :: Int -> PrivKeyFile -> ShowS
Show

newtype WitnessFile
  = WitnessFile FilePath
  deriving Int -> WitnessFile -> ShowS
[WitnessFile] -> ShowS
WitnessFile -> String
(Int -> WitnessFile -> ShowS)
-> (WitnessFile -> String)
-> ([WitnessFile] -> ShowS)
-> Show WitnessFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WitnessFile] -> ShowS
$cshowList :: [WitnessFile] -> ShowS
show :: WitnessFile -> String
$cshow :: WitnessFile -> String
showsPrec :: Int -> WitnessFile -> ShowS
$cshowsPrec :: Int -> WitnessFile -> ShowS
Show

newtype TxBodyFile
  = TxBodyFile FilePath
  deriving Int -> TxBodyFile -> ShowS
[TxBodyFile] -> ShowS
TxBodyFile -> String
(Int -> TxBodyFile -> ShowS)
-> (TxBodyFile -> String)
-> ([TxBodyFile] -> ShowS)
-> Show TxBodyFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxBodyFile] -> ShowS
$cshowList :: [TxBodyFile] -> ShowS
show :: TxBodyFile -> String
$cshow :: TxBodyFile -> String
showsPrec :: Int -> TxBodyFile -> ShowS
$cshowsPrec :: Int -> TxBodyFile -> ShowS
Show

newtype TxFile
  = TxFile FilePath
  deriving Int -> TxFile -> ShowS
[TxFile] -> ShowS
TxFile -> String
(Int -> TxFile -> ShowS)
-> (TxFile -> String) -> ([TxFile] -> ShowS) -> Show TxFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxFile] -> ShowS
$cshowList :: [TxFile] -> ShowS
show :: TxFile -> String
$cshow :: TxFile -> String
showsPrec :: Int -> TxFile -> ShowS
$cshowsPrec :: Int -> TxFile -> ShowS
Show

-- | A raw verification key given in Base64, and decoded into a ByteString.
newtype VerificationKeyBase64
  = VerificationKeyBase64 String
  deriving Int -> VerificationKeyBase64 -> ShowS
[VerificationKeyBase64] -> ShowS
VerificationKeyBase64 -> String
(Int -> VerificationKeyBase64 -> ShowS)
-> (VerificationKeyBase64 -> String)
-> ([VerificationKeyBase64] -> ShowS)
-> Show VerificationKeyBase64
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VerificationKeyBase64] -> ShowS
$cshowList :: [VerificationKeyBase64] -> ShowS
show :: VerificationKeyBase64 -> String
$cshow :: VerificationKeyBase64 -> String
showsPrec :: Int -> VerificationKeyBase64 -> ShowS
$cshowsPrec :: Int -> VerificationKeyBase64 -> ShowS
Show

-- | Data required to construct a witness.
data WitnessSigningData
  = KeyWitnessSigningData
      !SigningKeyFile
      -- ^ Path to a file that should contain a signing key.
      !(Maybe (Address ColeAddr))
      -- ^ An optionally specified Cole address.
      --
      -- If specified, both the network ID and derivation path are extracted
      -- from the address and used in the construction of the Cole witness.
  deriving Int -> WitnessSigningData -> ShowS
[WitnessSigningData] -> ShowS
WitnessSigningData -> String
(Int -> WitnessSigningData -> ShowS)
-> (WitnessSigningData -> String)
-> ([WitnessSigningData] -> ShowS)
-> Show WitnessSigningData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WitnessSigningData] -> ShowS
$cshowList :: [WitnessSigningData] -> ShowS
show :: WitnessSigningData -> String
$cshow :: WitnessSigningData -> String
showsPrec :: Int -> WitnessSigningData -> ShowS
$cshowsPrec :: Int -> WitnessSigningData -> ShowS
Show

-- | Either a stake pool verification key, genesis delegate verification key,
-- or a path to a cold verification key file.
--
-- Note that a "cold verification key" refers to either a stake pool or
-- genesis delegate verification key.
--
-- TODO: A genesis delegate extended key should also be valid here.
data ColdVerificationKeyOrFile
  = ColdStakePoolVerificationKey !(VerificationKey StakePoolKey)
  | ColdGenesisDelegateVerificationKey !(VerificationKey GenesisDelegateKey)
  | ColdGenesisVestedDelegateVerificationKey !(VerificationKey GenesisVestedDelegateKey)
  | ColdVestedDelegateVerificationKey !(VerificationKey VestedDelegateKey)
  | ColdVerificationKeyFile !VerificationKeyFile
  deriving Int -> ColdVerificationKeyOrFile -> ShowS
[ColdVerificationKeyOrFile] -> ShowS
ColdVerificationKeyOrFile -> String
(Int -> ColdVerificationKeyOrFile -> ShowS)
-> (ColdVerificationKeyOrFile -> String)
-> ([ColdVerificationKeyOrFile] -> ShowS)
-> Show ColdVerificationKeyOrFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColdVerificationKeyOrFile] -> ShowS
$cshowList :: [ColdVerificationKeyOrFile] -> ShowS
show :: ColdVerificationKeyOrFile -> String
$cshow :: ColdVerificationKeyOrFile -> String
showsPrec :: Int -> ColdVerificationKeyOrFile -> ShowS
$cshowsPrec :: Int -> ColdVerificationKeyOrFile -> ShowS
Show