{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}

module Cardano.CLI.Compatible.StakePool.Command
  ( CompatibleStakePoolCmds (..)
  , renderCompatibleStakePoolCmds
  , CompatibleStakePoolRegistrationCertificateCmdArgs (..)
  )
where

import Cardano.Api.Ledger (Coin)
import Cardano.Api.Shelley hiding (QueryInShelleyBasedEra (..))

import Cardano.CLI.Type.Common
import Cardano.CLI.Type.Key

import Prelude

import Data.Text (Text)

data CompatibleStakePoolCmds era
  = CompatibleStakePoolRegistrationCertificateCmd
      !(CompatibleStakePoolRegistrationCertificateCmdArgs era)
  deriving Int -> CompatibleStakePoolCmds era -> ShowS
[CompatibleStakePoolCmds era] -> ShowS
CompatibleStakePoolCmds era -> String
(Int -> CompatibleStakePoolCmds era -> ShowS)
-> (CompatibleStakePoolCmds era -> String)
-> ([CompatibleStakePoolCmds era] -> ShowS)
-> Show (CompatibleStakePoolCmds era)
forall era. Int -> CompatibleStakePoolCmds era -> ShowS
forall era. [CompatibleStakePoolCmds era] -> ShowS
forall era. CompatibleStakePoolCmds era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era. Int -> CompatibleStakePoolCmds era -> ShowS
showsPrec :: Int -> CompatibleStakePoolCmds era -> ShowS
$cshow :: forall era. CompatibleStakePoolCmds era -> String
show :: CompatibleStakePoolCmds era -> String
$cshowList :: forall era. [CompatibleStakePoolCmds era] -> ShowS
showList :: [CompatibleStakePoolCmds era] -> ShowS
Show

data CompatibleStakePoolRegistrationCertificateCmdArgs era
  = CompatibleStakePoolRegistrationCertificateCmdArgs
  { forall era.
CompatibleStakePoolRegistrationCertificateCmdArgs era
-> ShelleyBasedEra era
sbe :: !(ShelleyBasedEra era)
  -- ^ Era in which to register the stake pool.
  , forall era.
CompatibleStakePoolRegistrationCertificateCmdArgs era
-> VerificationKeyOrFile StakePoolKey
poolVerificationKeyOrFile :: !(VerificationKeyOrFile StakePoolKey)
  -- ^ Stake pool verification key.
  , forall era.
CompatibleStakePoolRegistrationCertificateCmdArgs era
-> VerificationKeyOrFile VrfKey
vrfVerificationKeyOrFile :: !(VerificationKeyOrFile VrfKey)
  -- ^ VRF Verification key.
  , forall era.
CompatibleStakePoolRegistrationCertificateCmdArgs era -> Coin
poolPledge :: !Coin
  -- ^ Pool pledge.
  , forall era.
CompatibleStakePoolRegistrationCertificateCmdArgs era -> Coin
poolCost :: !Coin
  -- ^ Pool cost.
  , forall era.
CompatibleStakePoolRegistrationCertificateCmdArgs era -> Rational
poolMargin :: !Rational
  -- ^ Pool margin.
  , forall era.
CompatibleStakePoolRegistrationCertificateCmdArgs era
-> VerificationKeyOrFile StakeKey
rewardStakeVerificationKeyOrFile :: !(VerificationKeyOrFile StakeKey)
  -- ^ Reward account verification staking key.
  , forall era.
CompatibleStakePoolRegistrationCertificateCmdArgs era
-> [VerificationKeyOrFile StakeKey]
ownerStakeVerificationKeyOrFiles :: ![VerificationKeyOrFile StakeKey]
  -- ^ Pool owner verification staking key(s).
  , forall era.
CompatibleStakePoolRegistrationCertificateCmdArgs era
-> [StakePoolRelay]
relays :: ![StakePoolRelay]
  -- ^ Stake pool relays.
  , forall era.
CompatibleStakePoolRegistrationCertificateCmdArgs era
-> Maybe
     (PotentiallyCheckedAnchor
        StakePoolMetadataReference StakePoolMetadataReference)
mMetadata
      :: !(Maybe (PotentiallyCheckedAnchor StakePoolMetadataReference StakePoolMetadataReference))
  -- ^ Stake pool metadata.
  , forall era.
CompatibleStakePoolRegistrationCertificateCmdArgs era -> NetworkId
network :: !NetworkId
  , forall era.
CompatibleStakePoolRegistrationCertificateCmdArgs era
-> File () 'Out
outFile :: !(File () Out)
  }
  deriving Int
-> CompatibleStakePoolRegistrationCertificateCmdArgs era -> ShowS
[CompatibleStakePoolRegistrationCertificateCmdArgs era] -> ShowS
CompatibleStakePoolRegistrationCertificateCmdArgs era -> String
(Int
 -> CompatibleStakePoolRegistrationCertificateCmdArgs era -> ShowS)
-> (CompatibleStakePoolRegistrationCertificateCmdArgs era
    -> String)
-> ([CompatibleStakePoolRegistrationCertificateCmdArgs era]
    -> ShowS)
-> Show (CompatibleStakePoolRegistrationCertificateCmdArgs era)
forall era.
Int
-> CompatibleStakePoolRegistrationCertificateCmdArgs era -> ShowS
forall era.
[CompatibleStakePoolRegistrationCertificateCmdArgs era] -> ShowS
forall era.
CompatibleStakePoolRegistrationCertificateCmdArgs era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era.
Int
-> CompatibleStakePoolRegistrationCertificateCmdArgs era -> ShowS
showsPrec :: Int
-> CompatibleStakePoolRegistrationCertificateCmdArgs era -> ShowS
$cshow :: forall era.
CompatibleStakePoolRegistrationCertificateCmdArgs era -> String
show :: CompatibleStakePoolRegistrationCertificateCmdArgs era -> String
$cshowList :: forall era.
[CompatibleStakePoolRegistrationCertificateCmdArgs era] -> ShowS
showList :: [CompatibleStakePoolRegistrationCertificateCmdArgs era] -> ShowS
Show

renderCompatibleStakePoolCmds :: CompatibleStakePoolCmds era -> Text
renderCompatibleStakePoolCmds :: forall era. CompatibleStakePoolCmds era -> Text
renderCompatibleStakePoolCmds =
  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) Text
"stake-pool " (Text -> Text)
-> (CompatibleStakePoolCmds era -> Text)
-> CompatibleStakePoolCmds era
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    CompatibleStakePoolRegistrationCertificateCmd{} ->
      Text
"registration-certificate"