{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

-- | Certificates embedded in transactions
module Cardano.Api.Certificate
  ( Certificate (..)

    -- * Registering stake address and delegating
  , StakeAddressRequirements (..)
  , StakeDelegationRequirements (..)
  , makeStakeAddressDelegationCertificate
  , makeStakeAddressRegistrationCertificate
  , makeStakeAddressUnregistrationCertificate
  , PoolId

    -- * Registering stake pools
  , StakePoolRegistrationRequirements (..)
  , StakePoolRetirementRequirements (..)
  , makeStakePoolRegistrationCertificate
  , makeStakePoolRetirementCertificate
  , StakePoolParameters (..)
  , StakePoolRelay (..)
  , StakePoolMetadataReference (..)

    -- * Conway specific certificates
  , CommitteeColdkeyResignationRequirements (..)
  , CommitteeHotKeyAuthorizationRequirements (..)
  , DRepRegistrationRequirements (..)
  , DRepUnregistrationRequirements (..)
  , DRepUpdateRequirements (..)
  , makeCommitteeColdkeyResignationCertificate
  , makeCommitteeHotKeyAuthorizationCertificate
  , makeDrepRegistrationCertificate
  , makeDrepUnregistrationCertificate
  , makeDrepUpdateCertificate
  , makeStakeAddressAndDRepDelegationCertificate

    -- * Registering DReps
  , DRepMetadataReference (..)

    -- * Special certificates
  , GenesisKeyDelegationRequirements (..)
  , MirCertificateRequirements (..)
  , makeMIRCertificate
  , makeGenesisKeyDelegationCertificate
  , Ledger.MIRTarget (..)
  , Ledger.MIRPot (..)
  , selectStakeCredentialWitness

    -- * Anchor data
  , AnchorDataFromCertificateError (..)
  , getAnchorDataFromCertificate

    -- * Internal conversion functions
  , toShelleyCertificate
  , fromShelleyCertificate
  , toShelleyPoolParams
  , fromShelleyPoolParams

    -- * Data family instances
  , AsType (..)

    -- * Internal functions
  , filterUnRegCreds
  , filterUnRegDRepCreds
  , isDRepRegOrUpdateCert
  )
where

import           Cardano.Api.Address
import           Cardano.Api.DRepMetadata
import           Cardano.Api.Eon.Convert
import           Cardano.Api.Eon.ConwayEraOnwards
import           Cardano.Api.Eon.ShelleyBasedEra
import           Cardano.Api.Eon.ShelleyToBabbageEra
import           Cardano.Api.Eras
import           Cardano.Api.Error (Error (..))
import           Cardano.Api.Governance.Actions.VotingProcedure
import           Cardano.Api.HasTypeProxy
import           Cardano.Api.Keys.Praos
import           Cardano.Api.Keys.Shelley
import           Cardano.Api.Pretty (Doc)
import           Cardano.Api.ReexposeLedger (EraCrypto, StandardCrypto)
import qualified Cardano.Api.ReexposeLedger as Ledger
import           Cardano.Api.Script
import           Cardano.Api.SerialiseCBOR
import           Cardano.Api.SerialiseTextEnvelope
import           Cardano.Api.StakePoolMetadata
import           Cardano.Api.Utils (noInlineMaybeToStrictMaybe)
import           Cardano.Api.Value

import           Cardano.Ledger.BaseTypes (strictMaybe)
import qualified Cardano.Ledger.Coin as L
import qualified Cardano.Ledger.Keys as Ledger

import           Control.Monad.Except (MonadError (..))
import           Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import           Data.IP (IPv4, IPv6)
import           Data.Maybe
import           Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import           Data.Typeable
import           GHC.Exts (IsList (..), fromString)
import           Network.Socket (PortNumber)

-- ----------------------------------------------------------------------------
-- Certificates embedded in transactions
--

data Certificate era where
  -- Pre-Conway
  --   1. Stake registration
  --   2. Stake unregistration
  --   3. Stake delegation
  --   4. Pool retirement
  --   5. Pool registration
  --   6. Genesis delegation
  --   7. MIR certificates
  ShelleyRelatedCertificate
    :: ShelleyToBabbageEra era
    -> Ledger.ShelleyTxCert (ShelleyLedgerEra era)
    -> Certificate era
  -- Conway onwards
  -- TODO: Add comments about the new types of certificates
  ConwayCertificate
    :: ConwayEraOnwards era
    -> Ledger.ConwayTxCert (ShelleyLedgerEra era)
    -> Certificate era
  deriving anyclass HasTypeProxy (Certificate era)
HasTypeProxy (Certificate era) =>
(Certificate era -> ByteString)
-> (AsType (Certificate era)
    -> ByteString -> Either DecoderError (Certificate era))
-> SerialiseAsCBOR (Certificate era)
AsType (Certificate era)
-> ByteString -> Either DecoderError (Certificate era)
Certificate era -> ByteString
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
forall era. IsShelleyBasedEra era => HasTypeProxy (Certificate era)
forall era.
IsShelleyBasedEra era =>
AsType (Certificate era)
-> ByteString -> Either DecoderError (Certificate era)
forall era. IsShelleyBasedEra era => Certificate era -> ByteString
$cserialiseToCBOR :: forall era. IsShelleyBasedEra era => Certificate era -> ByteString
serialiseToCBOR :: Certificate era -> ByteString
$cdeserialiseFromCBOR :: forall era.
IsShelleyBasedEra era =>
AsType (Certificate era)
-> ByteString -> Either DecoderError (Certificate era)
deserialiseFromCBOR :: AsType (Certificate era)
-> ByteString -> Either DecoderError (Certificate era)
SerialiseAsCBOR

deriving instance Eq (Certificate era)

deriving instance Show (Certificate era)

instance Typeable era => HasTypeProxy (Certificate era) where
  data AsType (Certificate era) = AsCertificate
  proxyToAsType :: Proxy (Certificate era) -> AsType (Certificate era)
proxyToAsType Proxy (Certificate era)
_ = AsType (Certificate era)
forall era. AsType (Certificate era)
AsCertificate

instance
  forall era
   . IsShelleyBasedEra era
  => ToCBOR (Certificate era)
  where
  toCBOR :: Certificate era -> Encoding
toCBOR =
    ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => Certificate era -> Encoding)
-> Certificate era
-> Encoding
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints (forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra @era) ((ShelleyBasedEraConstraints era => Certificate era -> Encoding)
 -> Certificate era -> Encoding)
-> (ShelleyBasedEraConstraints era => Certificate era -> Encoding)
-> Certificate era
-> Encoding
forall a b. (a -> b) -> a -> b
$
      forall era t. (Era era, EncCBOR t) => t -> Encoding
Ledger.toEraCBOR @(ShelleyLedgerEra era) (TxCert (ShelleyLedgerEra era) -> Encoding)
-> (Certificate era -> TxCert (ShelleyLedgerEra era))
-> Certificate era
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Certificate era -> TxCert (ShelleyLedgerEra era)
forall era. Certificate era -> TxCert (ShelleyLedgerEra era)
toShelleyCertificate

instance
  IsShelleyBasedEra era
  => FromCBOR (Certificate era)
  where
  fromCBOR :: forall s. Decoder s (Certificate era)
fromCBOR =
    ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => Decoder s (Certificate era))
-> Decoder s (Certificate era)
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints (forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra @era) ((ShelleyBasedEraConstraints era => Decoder s (Certificate era))
 -> Decoder s (Certificate era))
-> (ShelleyBasedEraConstraints era => Decoder s (Certificate era))
-> Decoder s (Certificate era)
forall a b. (a -> b) -> a -> b
$
      ShelleyBasedEra era
-> TxCert (ShelleyLedgerEra era) -> Certificate era
forall era.
ShelleyBasedEra era
-> TxCert (ShelleyLedgerEra era) -> Certificate era
fromShelleyCertificate ShelleyBasedEra era
forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra (TxCert (ShelleyLedgerEra era) -> Certificate era)
-> Decoder s (TxCert (ShelleyLedgerEra era))
-> Decoder s (Certificate era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era t s. (Era era, DecCBOR t) => Decoder s t
Ledger.fromEraCBOR @(ShelleyLedgerEra era)

instance
  IsShelleyBasedEra era
  => HasTextEnvelope (Certificate era)
  where
  textEnvelopeType :: AsType (Certificate era) -> TextEnvelopeType
textEnvelopeType AsType (Certificate era)
_ =
    forall (eon :: * -> *) era a.
Eon eon =>
CardanoEra era -> a -> (eon era -> a) -> a
forEraInEon @ConwayEraOnwards
      (CardanoEra era
forall era. IsCardanoEra era => CardanoEra era
cardanoEra :: CardanoEra era)
      TextEnvelopeType
"CertificateShelley"
      (TextEnvelopeType -> ConwayEraOnwards era -> TextEnvelopeType
forall a b. a -> b -> a
const TextEnvelopeType
"CertificateConway")
  textEnvelopeDefaultDescr :: Certificate era -> TextEnvelopeDescr
textEnvelopeDefaultDescr Certificate era
cert = case Certificate era
cert of
    ShelleyRelatedCertificate ShelleyToBabbageEra era
_ (Ledger.ShelleyTxCertDelegCert Ledger.ShelleyRegCert{}) -> TextEnvelopeDescr
"Stake address registration"
    ShelleyRelatedCertificate ShelleyToBabbageEra era
_ (Ledger.ShelleyTxCertDelegCert Ledger.ShelleyUnRegCert{}) -> TextEnvelopeDescr
"Stake address deregistration"
    ShelleyRelatedCertificate ShelleyToBabbageEra era
_ (Ledger.ShelleyTxCertDelegCert Ledger.ShelleyDelegCert{}) -> TextEnvelopeDescr
"Stake address delegation"
    ShelleyRelatedCertificate ShelleyToBabbageEra era
_ (Ledger.ShelleyTxCertPool Ledger.RetirePool{}) -> TextEnvelopeDescr
"Pool retirement"
    ShelleyRelatedCertificate ShelleyToBabbageEra era
_ (Ledger.ShelleyTxCertPool Ledger.RegPool{}) -> TextEnvelopeDescr
"Pool registration"
    ShelleyRelatedCertificate ShelleyToBabbageEra era
_ Ledger.ShelleyTxCertGenesisDeleg{} -> TextEnvelopeDescr
"Genesis key delegation"
    ShelleyRelatedCertificate ShelleyToBabbageEra era
_ Ledger.ShelleyTxCertMir{} -> TextEnvelopeDescr
"MIR"
    -- Conway and onwards related
    -- Constitutional Committee related
    ConwayCertificate ConwayEraOnwards era
_ (Ledger.ConwayTxCertGov Ledger.ConwayRegDRep{}) -> TextEnvelopeDescr
"Constitution committee member key registration"
    ConwayCertificate ConwayEraOnwards era
_ (Ledger.ConwayTxCertGov Ledger.ConwayUnRegDRep{}) -> TextEnvelopeDescr
"Constitution committee member key unregistration"
    ConwayCertificate ConwayEraOnwards era
_ (Ledger.ConwayTxCertGov Ledger.ConwayUpdateDRep{}) -> TextEnvelopeDescr
"Constitution committee member key registration update"
    ConwayCertificate ConwayEraOnwards era
_ (Ledger.ConwayTxCertGov Ledger.ConwayAuthCommitteeHotKey{}) -> TextEnvelopeDescr
"Constitution committee member hot key registration"
    ConwayCertificate ConwayEraOnwards era
_ (Ledger.ConwayTxCertGov Ledger.ConwayResignCommitteeColdKey{}) -> TextEnvelopeDescr
"Constitution committee member hot key resignation"
    ConwayCertificate ConwayEraOnwards era
_ (Ledger.ConwayTxCertDeleg Ledger.ConwayRegCert{}) -> TextEnvelopeDescr
"Stake address registration"
    ConwayCertificate ConwayEraOnwards era
_ (Ledger.ConwayTxCertDeleg Ledger.ConwayUnRegCert{}) -> TextEnvelopeDescr
"Stake address deregistration"
    ConwayCertificate ConwayEraOnwards era
_ (Ledger.ConwayTxCertDeleg Ledger.ConwayDelegCert{}) -> TextEnvelopeDescr
"Stake address delegation"
    ConwayCertificate ConwayEraOnwards era
_ (Ledger.ConwayTxCertDeleg Ledger.ConwayRegDelegCert{}) -> TextEnvelopeDescr
"Stake address registration and delegation"
    ConwayCertificate ConwayEraOnwards era
_ (Ledger.ConwayTxCertPool Ledger.RegPool{}) -> TextEnvelopeDescr
"Pool registration"
    ConwayCertificate ConwayEraOnwards era
_ (Ledger.ConwayTxCertPool Ledger.RetirePool{}) -> TextEnvelopeDescr
"Pool retirement"

-- ----------------------------------------------------------------------------
-- Stake pool parameters
--

type PoolId = Hash StakePoolKey

data StakePoolParameters
  = StakePoolParameters
  { StakePoolParameters -> PoolId
stakePoolId :: PoolId
  , StakePoolParameters -> Hash VrfKey
stakePoolVRF :: Hash VrfKey
  , StakePoolParameters -> Coin
stakePoolCost :: L.Coin
  , StakePoolParameters -> Rational
stakePoolMargin :: Rational
  , StakePoolParameters -> StakeAddress
stakePoolRewardAccount :: StakeAddress
  , StakePoolParameters -> Coin
stakePoolPledge :: L.Coin
  , StakePoolParameters -> [Hash StakeKey]
stakePoolOwners :: [Hash StakeKey]
  , StakePoolParameters -> [StakePoolRelay]
stakePoolRelays :: [StakePoolRelay]
  , StakePoolParameters -> Maybe StakePoolMetadataReference
stakePoolMetadata :: Maybe StakePoolMetadataReference
  }
  deriving (StakePoolParameters -> StakePoolParameters -> Bool
(StakePoolParameters -> StakePoolParameters -> Bool)
-> (StakePoolParameters -> StakePoolParameters -> Bool)
-> Eq StakePoolParameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StakePoolParameters -> StakePoolParameters -> Bool
== :: StakePoolParameters -> StakePoolParameters -> Bool
$c/= :: StakePoolParameters -> StakePoolParameters -> Bool
/= :: StakePoolParameters -> StakePoolParameters -> Bool
Eq, Int -> StakePoolParameters -> ShowS
[StakePoolParameters] -> ShowS
StakePoolParameters -> String
(Int -> StakePoolParameters -> ShowS)
-> (StakePoolParameters -> String)
-> ([StakePoolParameters] -> ShowS)
-> Show StakePoolParameters
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StakePoolParameters -> ShowS
showsPrec :: Int -> StakePoolParameters -> ShowS
$cshow :: StakePoolParameters -> String
show :: StakePoolParameters -> String
$cshowList :: [StakePoolParameters] -> ShowS
showList :: [StakePoolParameters] -> ShowS
Show)

data StakePoolRelay
  = -- | One or both of IPv4 & IPv6
    StakePoolRelayIp
      (Maybe IPv4)
      (Maybe IPv6)
      (Maybe PortNumber)
  | -- | An DNS name pointing to a @A@ or @AAAA@ record.
    StakePoolRelayDnsARecord
      ByteString
      (Maybe PortNumber)
  | -- | A DNS name pointing to a @SRV@ record.
    StakePoolRelayDnsSrvRecord
      ByteString
  deriving (StakePoolRelay -> StakePoolRelay -> Bool
(StakePoolRelay -> StakePoolRelay -> Bool)
-> (StakePoolRelay -> StakePoolRelay -> Bool) -> Eq StakePoolRelay
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StakePoolRelay -> StakePoolRelay -> Bool
== :: StakePoolRelay -> StakePoolRelay -> Bool
$c/= :: StakePoolRelay -> StakePoolRelay -> Bool
/= :: StakePoolRelay -> StakePoolRelay -> Bool
Eq, Int -> StakePoolRelay -> ShowS
[StakePoolRelay] -> ShowS
StakePoolRelay -> String
(Int -> StakePoolRelay -> ShowS)
-> (StakePoolRelay -> String)
-> ([StakePoolRelay] -> ShowS)
-> Show StakePoolRelay
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StakePoolRelay -> ShowS
showsPrec :: Int -> StakePoolRelay -> ShowS
$cshow :: StakePoolRelay -> String
show :: StakePoolRelay -> String
$cshowList :: [StakePoolRelay] -> ShowS
showList :: [StakePoolRelay] -> ShowS
Show)

data StakePoolMetadataReference
  = StakePoolMetadataReference
  { StakePoolMetadataReference -> Text
stakePoolMetadataURL :: Text
  , StakePoolMetadataReference -> Hash StakePoolMetadata
stakePoolMetadataHash :: Hash StakePoolMetadata
  }
  deriving (StakePoolMetadataReference -> StakePoolMetadataReference -> Bool
(StakePoolMetadataReference -> StakePoolMetadataReference -> Bool)
-> (StakePoolMetadataReference
    -> StakePoolMetadataReference -> Bool)
-> Eq StakePoolMetadataReference
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StakePoolMetadataReference -> StakePoolMetadataReference -> Bool
== :: StakePoolMetadataReference -> StakePoolMetadataReference -> Bool
$c/= :: StakePoolMetadataReference -> StakePoolMetadataReference -> Bool
/= :: StakePoolMetadataReference -> StakePoolMetadataReference -> Bool
Eq, Int -> StakePoolMetadataReference -> ShowS
[StakePoolMetadataReference] -> ShowS
StakePoolMetadataReference -> String
(Int -> StakePoolMetadataReference -> ShowS)
-> (StakePoolMetadataReference -> String)
-> ([StakePoolMetadataReference] -> ShowS)
-> Show StakePoolMetadataReference
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StakePoolMetadataReference -> ShowS
showsPrec :: Int -> StakePoolMetadataReference -> ShowS
$cshow :: StakePoolMetadataReference -> String
show :: StakePoolMetadataReference -> String
$cshowList :: [StakePoolMetadataReference] -> ShowS
showList :: [StakePoolMetadataReference] -> ShowS
Show)

-- ----------------------------------------------------------------------------
-- DRep parameters
--

data DRepMetadataReference
  = DRepMetadataReference
  { DRepMetadataReference -> Text
drepMetadataURL :: Text
  , DRepMetadataReference -> Hash DRepMetadata
drepMetadataHash :: Hash DRepMetadata
  }
  deriving (DRepMetadataReference -> DRepMetadataReference -> Bool
(DRepMetadataReference -> DRepMetadataReference -> Bool)
-> (DRepMetadataReference -> DRepMetadataReference -> Bool)
-> Eq DRepMetadataReference
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DRepMetadataReference -> DRepMetadataReference -> Bool
== :: DRepMetadataReference -> DRepMetadataReference -> Bool
$c/= :: DRepMetadataReference -> DRepMetadataReference -> Bool
/= :: DRepMetadataReference -> DRepMetadataReference -> Bool
Eq, Int -> DRepMetadataReference -> ShowS
[DRepMetadataReference] -> ShowS
DRepMetadataReference -> String
(Int -> DRepMetadataReference -> ShowS)
-> (DRepMetadataReference -> String)
-> ([DRepMetadataReference] -> ShowS)
-> Show DRepMetadataReference
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DRepMetadataReference -> ShowS
showsPrec :: Int -> DRepMetadataReference -> ShowS
$cshow :: DRepMetadataReference -> String
show :: DRepMetadataReference -> String
$cshowList :: [DRepMetadataReference] -> ShowS
showList :: [DRepMetadataReference] -> ShowS
Show)

-- ----------------------------------------------------------------------------
-- Constructor functions
--

data StakeAddressRequirements era where
  StakeAddrRegistrationConway
    :: ConwayEraOnwards era
    -> L.Coin
    -> StakeCredential
    -> StakeAddressRequirements era
  StakeAddrRegistrationPreConway
    :: ShelleyToBabbageEra era
    -> StakeCredential
    -> StakeAddressRequirements era

makeStakeAddressRegistrationCertificate :: StakeAddressRequirements era -> Certificate era
makeStakeAddressRegistrationCertificate :: forall era. StakeAddressRequirements era -> Certificate era
makeStakeAddressRegistrationCertificate = \case
  StakeAddrRegistrationPreConway ShelleyToBabbageEra era
w StakeCredential
scred ->
    ShelleyToBabbageEra era
-> (ShelleyToBabbageEraConstraints era => Certificate era)
-> Certificate era
forall era a.
ShelleyToBabbageEra era
-> (ShelleyToBabbageEraConstraints era => a) -> a
shelleyToBabbageEraConstraints ShelleyToBabbageEra era
w ((ShelleyToBabbageEraConstraints era => Certificate era)
 -> Certificate era)
-> (ShelleyToBabbageEraConstraints era => Certificate era)
-> Certificate era
forall a b. (a -> b) -> a -> b
$
      ShelleyToBabbageEra era
-> ShelleyTxCert (ShelleyLedgerEra era) -> Certificate era
forall era.
ShelleyToBabbageEra era
-> ShelleyTxCert (ShelleyLedgerEra era) -> Certificate era
ShelleyRelatedCertificate ShelleyToBabbageEra era
w (ShelleyTxCert (ShelleyLedgerEra era) -> Certificate era)
-> ShelleyTxCert (ShelleyLedgerEra era) -> Certificate era
forall a b. (a -> b) -> a -> b
$
        StakeCredential (EraCrypto (ShelleyLedgerEra era))
-> TxCert (ShelleyLedgerEra era)
forall era.
ShelleyEraTxCert era =>
StakeCredential (EraCrypto era) -> TxCert era
Ledger.mkRegTxCert (StakeCredential (EraCrypto (ShelleyLedgerEra era))
 -> TxCert (ShelleyLedgerEra era))
-> StakeCredential (EraCrypto (ShelleyLedgerEra era))
-> TxCert (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$
          StakeCredential -> StakeCredential StandardCrypto
toShelleyStakeCredential StakeCredential
scred
  StakeAddrRegistrationConway ConwayEraOnwards era
cOnwards Coin
deposit StakeCredential
scred ->
    ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era => Certificate era)
-> Certificate era
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
cOnwards ((ConwayEraOnwardsConstraints era => Certificate era)
 -> Certificate era)
-> (ConwayEraOnwardsConstraints era => Certificate era)
-> Certificate era
forall a b. (a -> b) -> a -> b
$
      ConwayEraOnwards era
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
forall era.
ConwayEraOnwards era
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
ConwayCertificate ConwayEraOnwards era
cOnwards (ConwayTxCert (ShelleyLedgerEra era) -> Certificate era)
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
forall a b. (a -> b) -> a -> b
$
        StakeCredential (EraCrypto (ShelleyLedgerEra era))
-> Coin -> TxCert (ShelleyLedgerEra era)
forall era.
ConwayEraTxCert era =>
StakeCredential (EraCrypto era) -> Coin -> TxCert era
Ledger.mkRegDepositTxCert (StakeCredential -> StakeCredential StandardCrypto
toShelleyStakeCredential StakeCredential
scred) Coin
deposit

makeStakeAddressUnregistrationCertificate :: StakeAddressRequirements era -> Certificate era
makeStakeAddressUnregistrationCertificate :: forall era. StakeAddressRequirements era -> Certificate era
makeStakeAddressUnregistrationCertificate StakeAddressRequirements era
req =
  case StakeAddressRequirements era
req of
    StakeAddrRegistrationConway ConwayEraOnwards era
cOnwards Coin
deposit StakeCredential
scred ->
      ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era => Certificate era)
-> Certificate era
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
cOnwards ((ConwayEraOnwardsConstraints era => Certificate era)
 -> Certificate era)
-> (ConwayEraOnwardsConstraints era => Certificate era)
-> Certificate era
forall a b. (a -> b) -> a -> b
$
        ConwayEraOnwards era
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
forall era.
ConwayEraOnwards era
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
ConwayCertificate ConwayEraOnwards era
cOnwards (ConwayTxCert (ShelleyLedgerEra era) -> Certificate era)
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
forall a b. (a -> b) -> a -> b
$
          StakeCredential (EraCrypto (ShelleyLedgerEra era))
-> Coin -> TxCert (ShelleyLedgerEra era)
forall era.
ConwayEraTxCert era =>
StakeCredential (EraCrypto era) -> Coin -> TxCert era
Ledger.mkUnRegDepositTxCert (StakeCredential -> StakeCredential StandardCrypto
toShelleyStakeCredential StakeCredential
scred) Coin
deposit
    StakeAddrRegistrationPreConway ShelleyToBabbageEra era
atMostEra StakeCredential
scred ->
      ShelleyToBabbageEra era
-> (ShelleyToBabbageEraConstraints era => Certificate era)
-> Certificate era
forall era a.
ShelleyToBabbageEra era
-> (ShelleyToBabbageEraConstraints era => a) -> a
shelleyToBabbageEraConstraints ShelleyToBabbageEra era
atMostEra ((ShelleyToBabbageEraConstraints era => Certificate era)
 -> Certificate era)
-> (ShelleyToBabbageEraConstraints era => Certificate era)
-> Certificate era
forall a b. (a -> b) -> a -> b
$
        ShelleyToBabbageEra era
-> ShelleyTxCert (ShelleyLedgerEra era) -> Certificate era
forall era.
ShelleyToBabbageEra era
-> ShelleyTxCert (ShelleyLedgerEra era) -> Certificate era
ShelleyRelatedCertificate ShelleyToBabbageEra era
atMostEra (ShelleyTxCert (ShelleyLedgerEra era) -> Certificate era)
-> ShelleyTxCert (ShelleyLedgerEra era) -> Certificate era
forall a b. (a -> b) -> a -> b
$
          StakeCredential (EraCrypto (ShelleyLedgerEra era))
-> TxCert (ShelleyLedgerEra era)
forall era.
ShelleyEraTxCert era =>
StakeCredential (EraCrypto era) -> TxCert era
Ledger.mkUnRegTxCert (StakeCredential (EraCrypto (ShelleyLedgerEra era))
 -> TxCert (ShelleyLedgerEra era))
-> StakeCredential (EraCrypto (ShelleyLedgerEra era))
-> TxCert (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$
            StakeCredential -> StakeCredential StandardCrypto
toShelleyStakeCredential StakeCredential
scred

data StakeDelegationRequirements era where
  StakeDelegationRequirementsConwayOnwards
    :: ConwayEraOnwards era
    -> StakeCredential
    -> Ledger.Delegatee (EraCrypto (ShelleyLedgerEra era))
    -> StakeDelegationRequirements era
  StakeDelegationRequirementsPreConway
    :: ShelleyToBabbageEra era
    -> StakeCredential
    -> PoolId
    -> StakeDelegationRequirements era

makeStakeAddressDelegationCertificate :: StakeDelegationRequirements era -> Certificate era
makeStakeAddressDelegationCertificate :: forall era. StakeDelegationRequirements era -> Certificate era
makeStakeAddressDelegationCertificate = \case
  StakeDelegationRequirementsConwayOnwards ConwayEraOnwards era
cOnwards StakeCredential
scred Delegatee (EraCrypto (ShelleyLedgerEra era))
delegatee ->
    ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era => Certificate era)
-> Certificate era
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
cOnwards ((ConwayEraOnwardsConstraints era => Certificate era)
 -> Certificate era)
-> (ConwayEraOnwardsConstraints era => Certificate era)
-> Certificate era
forall a b. (a -> b) -> a -> b
$
      ConwayEraOnwards era
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
forall era.
ConwayEraOnwards era
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
ConwayCertificate ConwayEraOnwards era
cOnwards (ConwayTxCert (ShelleyLedgerEra era) -> Certificate era)
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
forall a b. (a -> b) -> a -> b
$
        StakeCredential (EraCrypto (ShelleyLedgerEra era))
-> Delegatee (EraCrypto (ShelleyLedgerEra era))
-> TxCert (ShelleyLedgerEra era)
forall era.
ConwayEraTxCert era =>
StakeCredential (EraCrypto era)
-> Delegatee (EraCrypto era) -> TxCert era
Ledger.mkDelegTxCert (StakeCredential -> StakeCredential StandardCrypto
toShelleyStakeCredential StakeCredential
scred) Delegatee (EraCrypto (ShelleyLedgerEra era))
delegatee
  StakeDelegationRequirementsPreConway ShelleyToBabbageEra era
atMostBabbage StakeCredential
scred PoolId
pid ->
    ShelleyToBabbageEra era
-> (ShelleyToBabbageEraConstraints era => Certificate era)
-> Certificate era
forall era a.
ShelleyToBabbageEra era
-> (ShelleyToBabbageEraConstraints era => a) -> a
shelleyToBabbageEraConstraints ShelleyToBabbageEra era
atMostBabbage ((ShelleyToBabbageEraConstraints era => Certificate era)
 -> Certificate era)
-> (ShelleyToBabbageEraConstraints era => Certificate era)
-> Certificate era
forall a b. (a -> b) -> a -> b
$
      ShelleyToBabbageEra era
-> ShelleyTxCert (ShelleyLedgerEra era) -> Certificate era
forall era.
ShelleyToBabbageEra era
-> ShelleyTxCert (ShelleyLedgerEra era) -> Certificate era
ShelleyRelatedCertificate ShelleyToBabbageEra era
atMostBabbage (ShelleyTxCert (ShelleyLedgerEra era) -> Certificate era)
-> ShelleyTxCert (ShelleyLedgerEra era) -> Certificate era
forall a b. (a -> b) -> a -> b
$
        StakeCredential (EraCrypto (ShelleyLedgerEra era))
-> KeyHash 'StakePool (EraCrypto (ShelleyLedgerEra era))
-> TxCert (ShelleyLedgerEra era)
forall era.
ShelleyEraTxCert era =>
StakeCredential (EraCrypto era)
-> KeyHash 'StakePool (EraCrypto era) -> TxCert era
Ledger.mkDelegStakeTxCert (StakeCredential -> StakeCredential StandardCrypto
toShelleyStakeCredential StakeCredential
scred) (PoolId -> KeyHash 'StakePool StandardCrypto
unStakePoolKeyHash PoolId
pid)

data StakePoolRegistrationRequirements era where
  StakePoolRegistrationRequirementsConwayOnwards
    :: ConwayEraOnwards era
    -> Ledger.PoolParams (EraCrypto (ShelleyLedgerEra era))
    -> StakePoolRegistrationRequirements era
  StakePoolRegistrationRequirementsPreConway
    :: ShelleyToBabbageEra era
    -> Ledger.PoolParams (EraCrypto (ShelleyLedgerEra era))
    -> StakePoolRegistrationRequirements era

makeStakePoolRegistrationCertificate
  :: ()
  => StakePoolRegistrationRequirements era
  -> Certificate era
makeStakePoolRegistrationCertificate :: forall era.
StakePoolRegistrationRequirements era -> Certificate era
makeStakePoolRegistrationCertificate = \case
  StakePoolRegistrationRequirementsConwayOnwards ConwayEraOnwards era
cOnwards PoolParams (EraCrypto (ShelleyLedgerEra era))
poolParams ->
    ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era => Certificate era)
-> Certificate era
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
cOnwards ((ConwayEraOnwardsConstraints era => Certificate era)
 -> Certificate era)
-> (ConwayEraOnwardsConstraints era => Certificate era)
-> Certificate era
forall a b. (a -> b) -> a -> b
$
      ConwayEraOnwards era
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
forall era.
ConwayEraOnwards era
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
ConwayCertificate ConwayEraOnwards era
cOnwards (ConwayTxCert (ShelleyLedgerEra era) -> Certificate era)
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
forall a b. (a -> b) -> a -> b
$
        PoolParams (EraCrypto (ShelleyLedgerEra era))
-> TxCert (ShelleyLedgerEra era)
forall era.
EraTxCert era =>
PoolParams (EraCrypto era) -> TxCert era
Ledger.mkRegPoolTxCert PoolParams (EraCrypto (ShelleyLedgerEra era))
poolParams
  StakePoolRegistrationRequirementsPreConway ShelleyToBabbageEra era
atMostBab PoolParams (EraCrypto (ShelleyLedgerEra era))
poolParams ->
    ShelleyToBabbageEra era
-> (ShelleyToBabbageEraConstraints era => Certificate era)
-> Certificate era
forall era a.
ShelleyToBabbageEra era
-> (ShelleyToBabbageEraConstraints era => a) -> a
shelleyToBabbageEraConstraints ShelleyToBabbageEra era
atMostBab ((ShelleyToBabbageEraConstraints era => Certificate era)
 -> Certificate era)
-> (ShelleyToBabbageEraConstraints era => Certificate era)
-> Certificate era
forall a b. (a -> b) -> a -> b
$
      ShelleyToBabbageEra era
-> ShelleyTxCert (ShelleyLedgerEra era) -> Certificate era
forall era.
ShelleyToBabbageEra era
-> ShelleyTxCert (ShelleyLedgerEra era) -> Certificate era
ShelleyRelatedCertificate ShelleyToBabbageEra era
atMostBab (ShelleyTxCert (ShelleyLedgerEra era) -> Certificate era)
-> ShelleyTxCert (ShelleyLedgerEra era) -> Certificate era
forall a b. (a -> b) -> a -> b
$
        PoolParams (EraCrypto (ShelleyLedgerEra era))
-> TxCert (ShelleyLedgerEra era)
forall era.
EraTxCert era =>
PoolParams (EraCrypto era) -> TxCert era
Ledger.mkRegPoolTxCert PoolParams (EraCrypto (ShelleyLedgerEra era))
poolParams

data StakePoolRetirementRequirements era where
  StakePoolRetirementRequirementsConwayOnwards
    :: ConwayEraOnwards era
    -> PoolId
    -> Ledger.EpochNo
    -> StakePoolRetirementRequirements era
  StakePoolRetirementRequirementsPreConway
    :: ShelleyToBabbageEra era
    -> PoolId
    -> Ledger.EpochNo
    -> StakePoolRetirementRequirements era

makeStakePoolRetirementCertificate
  :: ()
  => StakePoolRetirementRequirements era
  -> Certificate era
makeStakePoolRetirementCertificate :: forall era. StakePoolRetirementRequirements era -> Certificate era
makeStakePoolRetirementCertificate StakePoolRetirementRequirements era
req =
  case StakePoolRetirementRequirements era
req of
    StakePoolRetirementRequirementsPreConway ShelleyToBabbageEra era
atMostBab PoolId
poolId EpochNo
retirementEpoch ->
      ShelleyToBabbageEra era
-> (ShelleyToBabbageEraConstraints era => Certificate era)
-> Certificate era
forall era a.
ShelleyToBabbageEra era
-> (ShelleyToBabbageEraConstraints era => a) -> a
shelleyToBabbageEraConstraints ShelleyToBabbageEra era
atMostBab ((ShelleyToBabbageEraConstraints era => Certificate era)
 -> Certificate era)
-> (ShelleyToBabbageEraConstraints era => Certificate era)
-> Certificate era
forall a b. (a -> b) -> a -> b
$
        ShelleyToBabbageEra era
-> ShelleyTxCert (ShelleyLedgerEra era) -> Certificate era
forall era.
ShelleyToBabbageEra era
-> ShelleyTxCert (ShelleyLedgerEra era) -> Certificate era
ShelleyRelatedCertificate ShelleyToBabbageEra era
atMostBab (ShelleyTxCert (ShelleyLedgerEra era) -> Certificate era)
-> ShelleyTxCert (ShelleyLedgerEra era) -> Certificate era
forall a b. (a -> b) -> a -> b
$
          KeyHash 'StakePool (EraCrypto (ShelleyLedgerEra era))
-> EpochNo -> TxCert (ShelleyLedgerEra era)
forall era.
EraTxCert era =>
KeyHash 'StakePool (EraCrypto era) -> EpochNo -> TxCert era
Ledger.mkRetirePoolTxCert (PoolId -> KeyHash 'StakePool StandardCrypto
unStakePoolKeyHash PoolId
poolId) EpochNo
retirementEpoch
    StakePoolRetirementRequirementsConwayOnwards ConwayEraOnwards era
atMostBab PoolId
poolId EpochNo
retirementEpoch ->
      ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era => Certificate era)
-> Certificate era
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
atMostBab ((ConwayEraOnwardsConstraints era => Certificate era)
 -> Certificate era)
-> (ConwayEraOnwardsConstraints era => Certificate era)
-> Certificate era
forall a b. (a -> b) -> a -> b
$
        ConwayEraOnwards era
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
forall era.
ConwayEraOnwards era
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
ConwayCertificate ConwayEraOnwards era
atMostBab (ConwayTxCert (ShelleyLedgerEra era) -> Certificate era)
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
forall a b. (a -> b) -> a -> b
$
          KeyHash 'StakePool (EraCrypto (ShelleyLedgerEra era))
-> EpochNo -> TxCert (ShelleyLedgerEra era)
forall era.
EraTxCert era =>
KeyHash 'StakePool (EraCrypto era) -> EpochNo -> TxCert era
Ledger.mkRetirePoolTxCert (PoolId -> KeyHash 'StakePool StandardCrypto
unStakePoolKeyHash PoolId
poolId) EpochNo
retirementEpoch

data GenesisKeyDelegationRequirements era where
  GenesisKeyDelegationRequirements
    :: ShelleyToBabbageEra era
    -> Hash GenesisKey
    -> Hash GenesisDelegateKey
    -> Hash VrfKey
    -> GenesisKeyDelegationRequirements era

makeGenesisKeyDelegationCertificate :: GenesisKeyDelegationRequirements era -> Certificate era
makeGenesisKeyDelegationCertificate :: forall era. GenesisKeyDelegationRequirements era -> Certificate era
makeGenesisKeyDelegationCertificate
  ( GenesisKeyDelegationRequirements
      ShelleyToBabbageEra era
atMostEra
      (GenesisKeyHash KeyHash 'Genesis StandardCrypto
hGenKey)
      (GenesisDelegateKeyHash KeyHash 'GenesisDelegate StandardCrypto
hGenDelegKey)
      (VrfKeyHash Hash StandardCrypto (VerKeyVRF StandardCrypto)
hVrfKey)
    ) =
    ShelleyToBabbageEra era
-> ShelleyTxCert (ShelleyLedgerEra era) -> Certificate era
forall era.
ShelleyToBabbageEra era
-> ShelleyTxCert (ShelleyLedgerEra era) -> Certificate era
ShelleyRelatedCertificate ShelleyToBabbageEra era
atMostEra (ShelleyTxCert (ShelleyLedgerEra era) -> Certificate era)
-> ShelleyTxCert (ShelleyLedgerEra era) -> Certificate era
forall a b. (a -> b) -> a -> b
$
      ShelleyToBabbageEra era
-> (ShelleyToBabbageEraConstraints era =>
    ShelleyTxCert (ShelleyLedgerEra era))
-> ShelleyTxCert (ShelleyLedgerEra era)
forall era a.
ShelleyToBabbageEra era
-> (ShelleyToBabbageEraConstraints era => a) -> a
shelleyToBabbageEraConstraints ShelleyToBabbageEra era
atMostEra ((ShelleyToBabbageEraConstraints era =>
  ShelleyTxCert (ShelleyLedgerEra era))
 -> ShelleyTxCert (ShelleyLedgerEra era))
-> (ShelleyToBabbageEraConstraints era =>
    ShelleyTxCert (ShelleyLedgerEra era))
-> ShelleyTxCert (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$
        GenesisDelegCert (EraCrypto (ShelleyLedgerEra era))
-> ShelleyTxCert (ShelleyLedgerEra era)
forall era. GenesisDelegCert (EraCrypto era) -> ShelleyTxCert era
Ledger.ShelleyTxCertGenesisDeleg (GenesisDelegCert (EraCrypto (ShelleyLedgerEra era))
 -> ShelleyTxCert (ShelleyLedgerEra era))
-> GenesisDelegCert (EraCrypto (ShelleyLedgerEra era))
-> ShelleyTxCert (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$
          KeyHash 'Genesis StandardCrypto
-> KeyHash 'GenesisDelegate StandardCrypto
-> VRFVerKeyHash 'GenDelegVRF StandardCrypto
-> GenesisDelegCert StandardCrypto
forall c.
KeyHash 'Genesis c
-> KeyHash 'GenesisDelegate c
-> VRFVerKeyHash 'GenDelegVRF c
-> GenesisDelegCert c
Ledger.GenesisDelegCert KeyHash 'Genesis StandardCrypto
hGenKey KeyHash 'GenesisDelegate StandardCrypto
hGenDelegKey (Hash (HASH StandardCrypto) (VerKeyVRF PraosVRF)
-> VRFVerKeyHash 'GenDelegVRF StandardCrypto
forall c v (r :: KeyRoleVRF).
Hash (HASH c) (VerKeyVRF v) -> VRFVerKeyHash r c
Ledger.toVRFVerKeyHash Hash (HASH StandardCrypto) (VerKeyVRF PraosVRF)
Hash StandardCrypto (VerKeyVRF StandardCrypto)
hVrfKey)

data MirCertificateRequirements era where
  MirCertificateRequirements
    :: ShelleyToBabbageEra era
    -> Ledger.MIRPot
    -> Ledger.MIRTarget (EraCrypto (ShelleyLedgerEra era))
    -> MirCertificateRequirements era

makeMIRCertificate
  :: ()
  => MirCertificateRequirements era
  -> Certificate era
makeMIRCertificate :: forall era. MirCertificateRequirements era -> Certificate era
makeMIRCertificate (MirCertificateRequirements ShelleyToBabbageEra era
atMostEra MIRPot
mirPot MIRTarget (EraCrypto (ShelleyLedgerEra era))
mirTarget) =
  ShelleyToBabbageEra era
-> ShelleyTxCert (ShelleyLedgerEra era) -> Certificate era
forall era.
ShelleyToBabbageEra era
-> ShelleyTxCert (ShelleyLedgerEra era) -> Certificate era
ShelleyRelatedCertificate ShelleyToBabbageEra era
atMostEra (ShelleyTxCert (ShelleyLedgerEra era) -> Certificate era)
-> ShelleyTxCert (ShelleyLedgerEra era) -> Certificate era
forall a b. (a -> b) -> a -> b
$
    MIRCert (EraCrypto (ShelleyLedgerEra era))
-> ShelleyTxCert (ShelleyLedgerEra era)
forall era. MIRCert (EraCrypto era) -> ShelleyTxCert era
Ledger.ShelleyTxCertMir (MIRCert (EraCrypto (ShelleyLedgerEra era))
 -> ShelleyTxCert (ShelleyLedgerEra era))
-> MIRCert (EraCrypto (ShelleyLedgerEra era))
-> ShelleyTxCert (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$
      MIRPot
-> MIRTarget (EraCrypto (ShelleyLedgerEra era))
-> MIRCert (EraCrypto (ShelleyLedgerEra era))
forall c. MIRPot -> MIRTarget c -> MIRCert c
Ledger.MIRCert MIRPot
mirPot MIRTarget (EraCrypto (ShelleyLedgerEra era))
mirTarget

data DRepRegistrationRequirements era where
  DRepRegistrationRequirements
    :: ConwayEraOnwards era
    -> (Ledger.Credential Ledger.DRepRole (EraCrypto (ShelleyLedgerEra era)))
    -> L.Coin
    -> DRepRegistrationRequirements era

makeDrepRegistrationCertificate
  :: ()
  => DRepRegistrationRequirements era
  -> Maybe (Ledger.Anchor (EraCrypto (ShelleyLedgerEra era)))
  -> Certificate era
makeDrepRegistrationCertificate :: forall era.
DRepRegistrationRequirements era
-> Maybe (Anchor (EraCrypto (ShelleyLedgerEra era)))
-> Certificate era
makeDrepRegistrationCertificate (DRepRegistrationRequirements ConwayEraOnwards era
conwayOnwards Credential 'DRepRole (EraCrypto (ShelleyLedgerEra era))
vcred Coin
deposit) Maybe (Anchor (EraCrypto (ShelleyLedgerEra era)))
anchor =
  ConwayEraOnwards era
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
forall era.
ConwayEraOnwards era
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
ConwayCertificate ConwayEraOnwards era
conwayOnwards
    (ConwayTxCert (ShelleyLedgerEra era) -> Certificate era)
-> (ConwayGovCert (EraCrypto (ShelleyLedgerEra era))
    -> ConwayTxCert (ShelleyLedgerEra era))
-> ConwayGovCert (EraCrypto (ShelleyLedgerEra era))
-> Certificate era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConwayGovCert (EraCrypto (ShelleyLedgerEra era))
-> ConwayTxCert (ShelleyLedgerEra era)
forall era. ConwayGovCert (EraCrypto era) -> ConwayTxCert era
Ledger.ConwayTxCertGov
    (ConwayGovCert (EraCrypto (ShelleyLedgerEra era))
 -> Certificate era)
-> ConwayGovCert (EraCrypto (ShelleyLedgerEra era))
-> Certificate era
forall a b. (a -> b) -> a -> b
$ Credential 'DRepRole (EraCrypto (ShelleyLedgerEra era))
-> Coin
-> StrictMaybe (Anchor (EraCrypto (ShelleyLedgerEra era)))
-> ConwayGovCert (EraCrypto (ShelleyLedgerEra era))
forall c.
Credential 'DRepRole c
-> Coin -> StrictMaybe (Anchor c) -> ConwayGovCert c
Ledger.ConwayRegDRep Credential 'DRepRole (EraCrypto (ShelleyLedgerEra era))
vcred Coin
deposit (Maybe (Anchor (EraCrypto (ShelleyLedgerEra era)))
-> StrictMaybe (Anchor (EraCrypto (ShelleyLedgerEra era)))
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe (Anchor (EraCrypto (ShelleyLedgerEra era)))
anchor)

data CommitteeHotKeyAuthorizationRequirements era where
  CommitteeHotKeyAuthorizationRequirements
    :: ConwayEraOnwards era
    -> Ledger.Credential Ledger.ColdCommitteeRole (EraCrypto (ShelleyLedgerEra era))
    -> Ledger.Credential Ledger.HotCommitteeRole (EraCrypto (ShelleyLedgerEra era))
    -> CommitteeHotKeyAuthorizationRequirements era

makeCommitteeHotKeyAuthorizationCertificate
  :: ()
  => CommitteeHotKeyAuthorizationRequirements era
  -> Certificate era
makeCommitteeHotKeyAuthorizationCertificate :: forall era.
CommitteeHotKeyAuthorizationRequirements era -> Certificate era
makeCommitteeHotKeyAuthorizationCertificate (CommitteeHotKeyAuthorizationRequirements ConwayEraOnwards era
cOnwards Credential 'ColdCommitteeRole (EraCrypto (ShelleyLedgerEra era))
coldKeyCredential Credential 'HotCommitteeRole (EraCrypto (ShelleyLedgerEra era))
hotKeyCredential) =
  ConwayEraOnwards era
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
forall era.
ConwayEraOnwards era
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
ConwayCertificate ConwayEraOnwards era
cOnwards
    (ConwayTxCert (ShelleyLedgerEra era) -> Certificate era)
-> (ConwayGovCert (EraCrypto (ShelleyLedgerEra era))
    -> ConwayTxCert (ShelleyLedgerEra era))
-> ConwayGovCert (EraCrypto (ShelleyLedgerEra era))
-> Certificate era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConwayGovCert (EraCrypto (ShelleyLedgerEra era))
-> ConwayTxCert (ShelleyLedgerEra era)
forall era. ConwayGovCert (EraCrypto era) -> ConwayTxCert era
Ledger.ConwayTxCertGov
    (ConwayGovCert (EraCrypto (ShelleyLedgerEra era))
 -> Certificate era)
-> ConwayGovCert (EraCrypto (ShelleyLedgerEra era))
-> Certificate era
forall a b. (a -> b) -> a -> b
$ Credential 'ColdCommitteeRole (EraCrypto (ShelleyLedgerEra era))
-> Credential 'HotCommitteeRole (EraCrypto (ShelleyLedgerEra era))
-> ConwayGovCert (EraCrypto (ShelleyLedgerEra era))
forall c.
Credential 'ColdCommitteeRole c
-> Credential 'HotCommitteeRole c -> ConwayGovCert c
Ledger.ConwayAuthCommitteeHotKey Credential 'ColdCommitteeRole (EraCrypto (ShelleyLedgerEra era))
coldKeyCredential Credential 'HotCommitteeRole (EraCrypto (ShelleyLedgerEra era))
hotKeyCredential

data CommitteeColdkeyResignationRequirements era where
  CommitteeColdkeyResignationRequirements
    :: ConwayEraOnwards era
    -> Ledger.Credential Ledger.ColdCommitteeRole (EraCrypto (ShelleyLedgerEra era))
    -> Maybe (Ledger.Anchor (EraCrypto (ShelleyLedgerEra era)))
    -> CommitteeColdkeyResignationRequirements era

makeCommitteeColdkeyResignationCertificate
  :: ()
  => CommitteeColdkeyResignationRequirements era
  -> Certificate era
makeCommitteeColdkeyResignationCertificate :: forall era.
CommitteeColdkeyResignationRequirements era -> Certificate era
makeCommitteeColdkeyResignationCertificate (CommitteeColdkeyResignationRequirements ConwayEraOnwards era
cOnwards Credential 'ColdCommitteeRole (EraCrypto (ShelleyLedgerEra era))
coldKeyCred Maybe (Anchor (EraCrypto (ShelleyLedgerEra era)))
anchor) =
  ConwayEraOnwards era
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
forall era.
ConwayEraOnwards era
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
ConwayCertificate ConwayEraOnwards era
cOnwards
    (ConwayTxCert (ShelleyLedgerEra era) -> Certificate era)
-> (ConwayGovCert (EraCrypto (ShelleyLedgerEra era))
    -> ConwayTxCert (ShelleyLedgerEra era))
-> ConwayGovCert (EraCrypto (ShelleyLedgerEra era))
-> Certificate era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConwayGovCert (EraCrypto (ShelleyLedgerEra era))
-> ConwayTxCert (ShelleyLedgerEra era)
forall era. ConwayGovCert (EraCrypto era) -> ConwayTxCert era
Ledger.ConwayTxCertGov
    (ConwayGovCert (EraCrypto (ShelleyLedgerEra era))
 -> Certificate era)
-> ConwayGovCert (EraCrypto (ShelleyLedgerEra era))
-> Certificate era
forall a b. (a -> b) -> a -> b
$ Credential 'ColdCommitteeRole (EraCrypto (ShelleyLedgerEra era))
-> StrictMaybe (Anchor (EraCrypto (ShelleyLedgerEra era)))
-> ConwayGovCert (EraCrypto (ShelleyLedgerEra era))
forall c.
Credential 'ColdCommitteeRole c
-> StrictMaybe (Anchor c) -> ConwayGovCert c
Ledger.ConwayResignCommitteeColdKey
      Credential 'ColdCommitteeRole (EraCrypto (ShelleyLedgerEra era))
coldKeyCred
      (Maybe (Anchor (EraCrypto (ShelleyLedgerEra era)))
-> StrictMaybe (Anchor (EraCrypto (ShelleyLedgerEra era)))
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe (Anchor (EraCrypto (ShelleyLedgerEra era)))
anchor)

data DRepUnregistrationRequirements era where
  DRepUnregistrationRequirements
    :: ConwayEraOnwards era
    -> (Ledger.Credential Ledger.DRepRole (EraCrypto (ShelleyLedgerEra era)))
    -> L.Coin
    -> DRepUnregistrationRequirements era

makeDrepUnregistrationCertificate
  :: ()
  => DRepUnregistrationRequirements era
  -> Certificate era
makeDrepUnregistrationCertificate :: forall era. DRepUnregistrationRequirements era -> Certificate era
makeDrepUnregistrationCertificate (DRepUnregistrationRequirements ConwayEraOnwards era
conwayOnwards Credential 'DRepRole (EraCrypto (ShelleyLedgerEra era))
vcred Coin
deposit) =
  ConwayEraOnwards era
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
forall era.
ConwayEraOnwards era
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
ConwayCertificate ConwayEraOnwards era
conwayOnwards
    (ConwayTxCert (ShelleyLedgerEra era) -> Certificate era)
-> (ConwayGovCert (EraCrypto (ShelleyLedgerEra era))
    -> ConwayTxCert (ShelleyLedgerEra era))
-> ConwayGovCert (EraCrypto (ShelleyLedgerEra era))
-> Certificate era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConwayGovCert (EraCrypto (ShelleyLedgerEra era))
-> ConwayTxCert (ShelleyLedgerEra era)
forall era. ConwayGovCert (EraCrypto era) -> ConwayTxCert era
Ledger.ConwayTxCertGov
    (ConwayGovCert (EraCrypto (ShelleyLedgerEra era))
 -> Certificate era)
-> ConwayGovCert (EraCrypto (ShelleyLedgerEra era))
-> Certificate era
forall a b. (a -> b) -> a -> b
$ Credential 'DRepRole (EraCrypto (ShelleyLedgerEra era))
-> Coin -> ConwayGovCert (EraCrypto (ShelleyLedgerEra era))
forall c. Credential 'DRepRole c -> Coin -> ConwayGovCert c
Ledger.ConwayUnRegDRep Credential 'DRepRole (EraCrypto (ShelleyLedgerEra era))
vcred Coin
deposit

makeStakeAddressAndDRepDelegationCertificate
  :: ()
  => ConwayEraOnwards era
  -> StakeCredential
  -> Ledger.Delegatee (EraCrypto (ShelleyLedgerEra era))
  -> L.Coin
  -> Certificate era
makeStakeAddressAndDRepDelegationCertificate :: forall era.
ConwayEraOnwards era
-> StakeCredential
-> Delegatee (EraCrypto (ShelleyLedgerEra era))
-> Coin
-> Certificate era
makeStakeAddressAndDRepDelegationCertificate ConwayEraOnwards era
w StakeCredential
cred Delegatee (EraCrypto (ShelleyLedgerEra era))
delegatee Coin
deposit =
  ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era => Certificate era)
-> Certificate era
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
w ((ConwayEraOnwardsConstraints era => Certificate era)
 -> Certificate era)
-> (ConwayEraOnwardsConstraints era => Certificate era)
-> Certificate era
forall a b. (a -> b) -> a -> b
$
    ConwayEraOnwards era
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
forall era.
ConwayEraOnwards era
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
ConwayCertificate ConwayEraOnwards era
w (ConwayTxCert (ShelleyLedgerEra era) -> Certificate era)
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
forall a b. (a -> b) -> a -> b
$
      StakeCredential (EraCrypto (ShelleyLedgerEra era))
-> Delegatee (EraCrypto (ShelleyLedgerEra era))
-> Coin
-> TxCert (ShelleyLedgerEra era)
forall era.
ConwayEraTxCert era =>
StakeCredential (EraCrypto era)
-> Delegatee (EraCrypto era) -> Coin -> TxCert era
Ledger.mkRegDepositDelegTxCert (StakeCredential -> StakeCredential StandardCrypto
toShelleyStakeCredential StakeCredential
cred) Delegatee (EraCrypto (ShelleyLedgerEra era))
delegatee Coin
deposit

data DRepUpdateRequirements era where
  DRepUpdateRequirements
    :: ConwayEraOnwards era
    -> Ledger.Credential Ledger.DRepRole (EraCrypto (ShelleyLedgerEra era))
    -> DRepUpdateRequirements era

makeDrepUpdateCertificate
  :: DRepUpdateRequirements era
  -> Maybe (Ledger.Anchor (EraCrypto (ShelleyLedgerEra era)))
  -> Certificate era
makeDrepUpdateCertificate :: forall era.
DRepUpdateRequirements era
-> Maybe (Anchor (EraCrypto (ShelleyLedgerEra era)))
-> Certificate era
makeDrepUpdateCertificate (DRepUpdateRequirements ConwayEraOnwards era
conwayOnwards Credential 'DRepRole (EraCrypto (ShelleyLedgerEra era))
vcred) Maybe (Anchor (EraCrypto (ShelleyLedgerEra era)))
mAnchor =
  ConwayEraOnwards era
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
forall era.
ConwayEraOnwards era
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
ConwayCertificate ConwayEraOnwards era
conwayOnwards
    (ConwayTxCert (ShelleyLedgerEra era) -> Certificate era)
-> (ConwayGovCert (EraCrypto (ShelleyLedgerEra era))
    -> ConwayTxCert (ShelleyLedgerEra era))
-> ConwayGovCert (EraCrypto (ShelleyLedgerEra era))
-> Certificate era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConwayGovCert (EraCrypto (ShelleyLedgerEra era))
-> ConwayTxCert (ShelleyLedgerEra era)
forall era. ConwayGovCert (EraCrypto era) -> ConwayTxCert era
Ledger.ConwayTxCertGov
    (ConwayGovCert (EraCrypto (ShelleyLedgerEra era))
 -> Certificate era)
-> ConwayGovCert (EraCrypto (ShelleyLedgerEra era))
-> Certificate era
forall a b. (a -> b) -> a -> b
$ Credential 'DRepRole (EraCrypto (ShelleyLedgerEra era))
-> StrictMaybe (Anchor (EraCrypto (ShelleyLedgerEra era)))
-> ConwayGovCert (EraCrypto (ShelleyLedgerEra era))
forall c.
Credential 'DRepRole c -> StrictMaybe (Anchor c) -> ConwayGovCert c
Ledger.ConwayUpdateDRep Credential 'DRepRole (EraCrypto (ShelleyLedgerEra era))
vcred (Maybe (Anchor (EraCrypto (ShelleyLedgerEra era)))
-> StrictMaybe (Anchor (EraCrypto (ShelleyLedgerEra era)))
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe (Anchor (EraCrypto (ShelleyLedgerEra era)))
mAnchor)

-- ----------------------------------------------------------------------------
-- Helper functions
--

getTxCertWitness
  :: ShelleyBasedEra era
  -> Ledger.TxCert (ShelleyLedgerEra era)
  -> Maybe StakeCredential
getTxCertWitness :: forall era.
ShelleyBasedEra era
-> TxCert (ShelleyLedgerEra era) -> Maybe StakeCredential
getTxCertWitness ShelleyBasedEra era
sbe TxCert (ShelleyLedgerEra era)
ledgerCert = ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => Maybe StakeCredential)
-> Maybe StakeCredential
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era => Maybe StakeCredential)
 -> Maybe StakeCredential)
-> (ShelleyBasedEraConstraints era => Maybe StakeCredential)
-> Maybe StakeCredential
forall a b. (a -> b) -> a -> b
$
  case TxCert (ShelleyLedgerEra era)
-> Maybe (KeyHash 'Witness (EraCrypto (ShelleyLedgerEra era)))
forall era.
EraTxCert era =>
TxCert era -> Maybe (KeyHash 'Witness (EraCrypto era))
Ledger.getVKeyWitnessTxCert TxCert (ShelleyLedgerEra era)
ledgerCert of
    Just KeyHash 'Witness (EraCrypto (ShelleyLedgerEra era))
keyHash -> StakeCredential -> Maybe StakeCredential
forall a. a -> Maybe a
Just (StakeCredential -> Maybe StakeCredential)
-> StakeCredential -> Maybe StakeCredential
forall a b. (a -> b) -> a -> b
$ Hash StakeKey -> StakeCredential
StakeCredentialByKey (Hash StakeKey -> StakeCredential)
-> Hash StakeKey -> StakeCredential
forall a b. (a -> b) -> a -> b
$ KeyHash 'Staking StandardCrypto -> Hash StakeKey
StakeKeyHash (KeyHash 'Staking StandardCrypto -> Hash StakeKey)
-> KeyHash 'Staking StandardCrypto -> Hash StakeKey
forall a b. (a -> b) -> a -> b
$ KeyHash 'Witness StandardCrypto -> KeyHash 'Staking StandardCrypto
forall (r :: KeyRole) c (r' :: KeyRole).
KeyHash r c -> KeyHash r' c
forall (a :: KeyRole -> * -> *) (r :: KeyRole) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
Ledger.coerceKeyRole KeyHash 'Witness (EraCrypto (ShelleyLedgerEra era))
KeyHash 'Witness StandardCrypto
keyHash
    Maybe (KeyHash 'Witness (EraCrypto (ShelleyLedgerEra era)))
Nothing ->
      ScriptHash -> StakeCredential
StakeCredentialByScript (ScriptHash -> StakeCredential)
-> (ScriptHash StandardCrypto -> ScriptHash)
-> ScriptHash StandardCrypto
-> StakeCredential
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash StandardCrypto -> ScriptHash
fromShelleyScriptHash
        (ScriptHash StandardCrypto -> StakeCredential)
-> Maybe (ScriptHash StandardCrypto) -> Maybe StakeCredential
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxCert (ShelleyLedgerEra era)
-> Maybe (ScriptHash (EraCrypto (ShelleyLedgerEra era)))
forall era.
EraTxCert era =>
TxCert era -> Maybe (ScriptHash (EraCrypto era))
Ledger.getScriptWitnessTxCert TxCert (ShelleyLedgerEra era)
ledgerCert

-- | Get the stake credential witness for a certificate that requires it.
-- Only stake address deregistration and delegation requires witnessing (witness can be script or key).
selectStakeCredentialWitness
  :: Certificate era
  -> Maybe StakeCredential
selectStakeCredentialWitness :: forall era. Certificate era -> Maybe StakeCredential
selectStakeCredentialWitness = \case
  ShelleyRelatedCertificate ShelleyToBabbageEra era
stbEra ShelleyTxCert (ShelleyLedgerEra era)
shelleyCert ->
    ShelleyToBabbageEra era
-> (ShelleyToBabbageEraConstraints era => Maybe StakeCredential)
-> Maybe StakeCredential
forall era a.
ShelleyToBabbageEra era
-> (ShelleyToBabbageEraConstraints era => a) -> a
shelleyToBabbageEraConstraints ShelleyToBabbageEra era
stbEra ((ShelleyToBabbageEraConstraints era => Maybe StakeCredential)
 -> Maybe StakeCredential)
-> (ShelleyToBabbageEraConstraints era => Maybe StakeCredential)
-> Maybe StakeCredential
forall a b. (a -> b) -> a -> b
$
      ShelleyBasedEra era
-> TxCert (ShelleyLedgerEra era) -> Maybe StakeCredential
forall era.
ShelleyBasedEra era
-> TxCert (ShelleyLedgerEra era) -> Maybe StakeCredential
getTxCertWitness (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
stbEra) TxCert (ShelleyLedgerEra era)
ShelleyTxCert (ShelleyLedgerEra era)
shelleyCert
  ConwayCertificate ConwayEraOnwards era
cEra ConwayTxCert (ShelleyLedgerEra era)
conwayCert ->
    ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era => Maybe StakeCredential)
-> Maybe StakeCredential
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
cEra ((ConwayEraOnwardsConstraints era => Maybe StakeCredential)
 -> Maybe StakeCredential)
-> (ConwayEraOnwardsConstraints era => Maybe StakeCredential)
-> Maybe StakeCredential
forall a b. (a -> b) -> a -> b
$
      ShelleyBasedEra era
-> TxCert (ShelleyLedgerEra era) -> Maybe StakeCredential
forall era.
ShelleyBasedEra era
-> TxCert (ShelleyLedgerEra era) -> Maybe StakeCredential
getTxCertWitness (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
cEra) TxCert (ShelleyLedgerEra era)
ConwayTxCert (ShelleyLedgerEra era)
conwayCert

filterUnRegCreds
  :: Certificate era -> Maybe StakeCredential
filterUnRegCreds :: forall era. Certificate era -> Maybe StakeCredential
filterUnRegCreds =
  (StakeCredential StandardCrypto -> StakeCredential)
-> Maybe (StakeCredential StandardCrypto) -> Maybe StakeCredential
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StakeCredential StandardCrypto -> StakeCredential
fromShelleyStakeCredential (Maybe (StakeCredential StandardCrypto) -> Maybe StakeCredential)
-> (Certificate era -> Maybe (StakeCredential StandardCrypto))
-> Certificate era
-> Maybe StakeCredential
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    ShelleyRelatedCertificate ShelleyToBabbageEra era
stbEra ShelleyTxCert (ShelleyLedgerEra era)
shelleyCert -> ShelleyToBabbageEra era
-> (ShelleyToBabbageEraConstraints era =>
    Maybe (StakeCredential StandardCrypto))
-> Maybe (StakeCredential StandardCrypto)
forall era a.
ShelleyToBabbageEra era
-> (ShelleyToBabbageEraConstraints era => a) -> a
shelleyToBabbageEraConstraints ShelleyToBabbageEra era
stbEra ((ShelleyToBabbageEraConstraints era =>
  Maybe (StakeCredential StandardCrypto))
 -> Maybe (StakeCredential StandardCrypto))
-> (ShelleyToBabbageEraConstraints era =>
    Maybe (StakeCredential StandardCrypto))
-> Maybe (StakeCredential StandardCrypto)
forall a b. (a -> b) -> a -> b
$
      case ShelleyTxCert (ShelleyLedgerEra era)
shelleyCert of
        Ledger.RegTxCert StakeCredential (EraCrypto (ShelleyLedgerEra era))
_ -> Maybe (StakeCredential StandardCrypto)
forall a. Maybe a
Nothing
        Ledger.UnRegTxCert StakeCredential (EraCrypto (ShelleyLedgerEra era))
cred -> StakeCredential StandardCrypto
-> Maybe (StakeCredential StandardCrypto)
forall a. a -> Maybe a
Just StakeCredential (EraCrypto (ShelleyLedgerEra era))
StakeCredential StandardCrypto
cred
        Ledger.DelegStakeTxCert StakeCredential (EraCrypto (ShelleyLedgerEra era))
_ KeyHash 'StakePool (EraCrypto (ShelleyLedgerEra era))
_ -> Maybe (StakeCredential StandardCrypto)
forall a. Maybe a
Nothing
        Ledger.RegPoolTxCert PoolParams (EraCrypto (ShelleyLedgerEra era))
_ -> Maybe (StakeCredential StandardCrypto)
forall a. Maybe a
Nothing
        Ledger.RetirePoolTxCert KeyHash 'StakePool (EraCrypto (ShelleyLedgerEra era))
_ EpochNo
_ -> Maybe (StakeCredential StandardCrypto)
forall a. Maybe a
Nothing
        Ledger.MirTxCert MIRCert (EraCrypto (ShelleyLedgerEra era))
_ -> Maybe (StakeCredential StandardCrypto)
forall a. Maybe a
Nothing
        Ledger.GenesisDelegTxCert{} -> Maybe (StakeCredential StandardCrypto)
forall a. Maybe a
Nothing
    ConwayCertificate ConwayEraOnwards era
cEra ConwayTxCert (ShelleyLedgerEra era)
conwayCert -> ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era =>
    Maybe (StakeCredential StandardCrypto))
-> Maybe (StakeCredential StandardCrypto)
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
cEra ((ConwayEraOnwardsConstraints era =>
  Maybe (StakeCredential StandardCrypto))
 -> Maybe (StakeCredential StandardCrypto))
-> (ConwayEraOnwardsConstraints era =>
    Maybe (StakeCredential StandardCrypto))
-> Maybe (StakeCredential StandardCrypto)
forall a b. (a -> b) -> a -> b
$
      case ConwayTxCert (ShelleyLedgerEra era)
conwayCert of
        Ledger.RegPoolTxCert PoolParams (EraCrypto (ShelleyLedgerEra era))
_ -> Maybe (StakeCredential StandardCrypto)
forall a. Maybe a
Nothing
        Ledger.RetirePoolTxCert KeyHash 'StakePool (EraCrypto (ShelleyLedgerEra era))
_ EpochNo
_ -> Maybe (StakeCredential StandardCrypto)
forall a. Maybe a
Nothing
        Ledger.RegDepositTxCert StakeCredential (EraCrypto (ShelleyLedgerEra era))
_ Coin
_ -> Maybe (StakeCredential StandardCrypto)
forall a. Maybe a
Nothing
        Ledger.UnRegDepositTxCert StakeCredential (EraCrypto (ShelleyLedgerEra era))
cred Coin
_ -> StakeCredential StandardCrypto
-> Maybe (StakeCredential StandardCrypto)
forall a. a -> Maybe a
Just StakeCredential (EraCrypto (ShelleyLedgerEra era))
StakeCredential StandardCrypto
cred
        Ledger.DelegTxCert StakeCredential (EraCrypto (ShelleyLedgerEra era))
_ Delegatee (EraCrypto (ShelleyLedgerEra era))
_ -> Maybe (StakeCredential StandardCrypto)
forall a. Maybe a
Nothing
        Ledger.RegDepositDelegTxCert{} -> Maybe (StakeCredential StandardCrypto)
forall a. Maybe a
Nothing
        Ledger.AuthCommitteeHotKeyTxCert{} -> Maybe (StakeCredential StandardCrypto)
forall a. Maybe a
Nothing
        Ledger.ResignCommitteeColdTxCert{} -> Maybe (StakeCredential StandardCrypto)
forall a. Maybe a
Nothing
        Ledger.RegDRepTxCert{} -> Maybe (StakeCredential StandardCrypto)
forall a. Maybe a
Nothing
        Ledger.UnRegDRepTxCert{} -> Maybe (StakeCredential StandardCrypto)
forall a. Maybe a
Nothing
        Ledger.UpdateDRepTxCert{} -> Maybe (StakeCredential StandardCrypto)
forall a. Maybe a
Nothing
        -- those are old shelley patterns
        Ledger.RegTxCert StakeCredential (EraCrypto (ShelleyLedgerEra era))
_ -> Maybe (StakeCredential StandardCrypto)
forall a. Maybe a
Nothing
        -- stake cred deregistration w/o deposit
        Ledger.UnRegTxCert StakeCredential (EraCrypto (ShelleyLedgerEra era))
cred -> StakeCredential StandardCrypto
-> Maybe (StakeCredential StandardCrypto)
forall a. a -> Maybe a
Just StakeCredential (EraCrypto (ShelleyLedgerEra era))
StakeCredential StandardCrypto
cred

filterUnRegDRepCreds
  :: Certificate era -> Maybe (Ledger.Credential Ledger.DRepRole Ledger.StandardCrypto)
filterUnRegDRepCreds :: forall era.
Certificate era -> Maybe (Credential 'DRepRole StandardCrypto)
filterUnRegDRepCreds = \case
  ShelleyRelatedCertificate ShelleyToBabbageEra era
_ ShelleyTxCert (ShelleyLedgerEra era)
_ -> Maybe (Credential 'DRepRole StandardCrypto)
forall a. Maybe a
Nothing
  ConwayCertificate ConwayEraOnwards era
cEra ConwayTxCert (ShelleyLedgerEra era)
conwayCert -> ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era =>
    Maybe (Credential 'DRepRole StandardCrypto))
-> Maybe (Credential 'DRepRole StandardCrypto)
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
cEra ((ConwayEraOnwardsConstraints era =>
  Maybe (Credential 'DRepRole StandardCrypto))
 -> Maybe (Credential 'DRepRole StandardCrypto))
-> (ConwayEraOnwardsConstraints era =>
    Maybe (Credential 'DRepRole StandardCrypto))
-> Maybe (Credential 'DRepRole StandardCrypto)
forall a b. (a -> b) -> a -> b
$
    case ConwayTxCert (ShelleyLedgerEra era)
conwayCert of
      Ledger.RegPoolTxCert PoolParams (EraCrypto (ShelleyLedgerEra era))
_ -> Maybe (Credential 'DRepRole StandardCrypto)
forall a. Maybe a
Nothing
      Ledger.RetirePoolTxCert KeyHash 'StakePool (EraCrypto (ShelleyLedgerEra era))
_ EpochNo
_ -> Maybe (Credential 'DRepRole StandardCrypto)
forall a. Maybe a
Nothing
      Ledger.RegDepositTxCert StakeCredential (EraCrypto (ShelleyLedgerEra era))
_ Coin
_ -> Maybe (Credential 'DRepRole StandardCrypto)
forall a. Maybe a
Nothing
      Ledger.UnRegDepositTxCert StakeCredential (EraCrypto (ShelleyLedgerEra era))
_ Coin
_ -> Maybe (Credential 'DRepRole StandardCrypto)
forall a. Maybe a
Nothing
      Ledger.DelegTxCert StakeCredential (EraCrypto (ShelleyLedgerEra era))
_ Delegatee (EraCrypto (ShelleyLedgerEra era))
_ -> Maybe (Credential 'DRepRole StandardCrypto)
forall a. Maybe a
Nothing
      Ledger.RegDepositDelegTxCert{} -> Maybe (Credential 'DRepRole StandardCrypto)
forall a. Maybe a
Nothing
      Ledger.AuthCommitteeHotKeyTxCert{} -> Maybe (Credential 'DRepRole StandardCrypto)
forall a. Maybe a
Nothing
      Ledger.ResignCommitteeColdTxCert{} -> Maybe (Credential 'DRepRole StandardCrypto)
forall a. Maybe a
Nothing
      Ledger.RegDRepTxCert{} -> Maybe (Credential 'DRepRole StandardCrypto)
forall a. Maybe a
Nothing
      Ledger.UnRegDRepTxCert Credential 'DRepRole (EraCrypto (ShelleyLedgerEra era))
cred Coin
_ -> Credential 'DRepRole StandardCrypto
-> Maybe (Credential 'DRepRole StandardCrypto)
forall a. a -> Maybe a
Just Credential 'DRepRole (EraCrypto (ShelleyLedgerEra era))
Credential 'DRepRole StandardCrypto
cred
      Ledger.UpdateDRepTxCert{} -> Maybe (Credential 'DRepRole StandardCrypto)
forall a. Maybe a
Nothing
      -- those are old shelley patterns
      Ledger.RegTxCert StakeCredential (EraCrypto (ShelleyLedgerEra era))
_ -> Maybe (Credential 'DRepRole StandardCrypto)
forall a. Maybe a
Nothing
      -- stake cred deregistration w/o deposit
      Ledger.UnRegTxCert StakeCredential (EraCrypto (ShelleyLedgerEra era))
_ -> Maybe (Credential 'DRepRole StandardCrypto)
forall a. Maybe a
Nothing

-- ----------------------------------------------------------------------------
-- Internal conversion functions
--

toShelleyCertificate
  :: ()
  => Certificate era
  -> Ledger.TxCert (ShelleyLedgerEra era)
toShelleyCertificate :: forall era. Certificate era -> TxCert (ShelleyLedgerEra era)
toShelleyCertificate = \case
  ShelleyRelatedCertificate ShelleyToBabbageEra era
w ShelleyTxCert (ShelleyLedgerEra era)
c ->
    ShelleyToBabbageEra era
-> (ShelleyToBabbageEraConstraints era =>
    TxCert (ShelleyLedgerEra era))
-> TxCert (ShelleyLedgerEra era)
forall era a.
ShelleyToBabbageEra era
-> (ShelleyToBabbageEraConstraints era => a) -> a
shelleyToBabbageEraConstraints ShelleyToBabbageEra era
w TxCert (ShelleyLedgerEra era)
ShelleyTxCert (ShelleyLedgerEra era)
ShelleyToBabbageEraConstraints era => TxCert (ShelleyLedgerEra era)
c
  ConwayCertificate ConwayEraOnwards era
w ConwayTxCert (ShelleyLedgerEra era)
c ->
    ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era =>
    TxCert (ShelleyLedgerEra era))
-> TxCert (ShelleyLedgerEra era)
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
w TxCert (ShelleyLedgerEra era)
ConwayTxCert (ShelleyLedgerEra era)
ConwayEraOnwardsConstraints era => TxCert (ShelleyLedgerEra era)
c

fromShelleyCertificate
  :: ()
  => ShelleyBasedEra era
  -> Ledger.TxCert (ShelleyLedgerEra era)
  -> Certificate era
fromShelleyCertificate :: forall era.
ShelleyBasedEra era
-> TxCert (ShelleyLedgerEra era) -> Certificate era
fromShelleyCertificate =
  (ShelleyToBabbageEraConstraints era =>
 ShelleyToBabbageEra era
 -> TxCert (ShelleyLedgerEra era) -> Certificate era)
-> (ConwayEraOnwardsConstraints era =>
    ConwayEraOnwards era
    -> TxCert (ShelleyLedgerEra era) -> Certificate era)
-> ShelleyBasedEra era
-> TxCert (ShelleyLedgerEra era)
-> Certificate era
forall era a.
(ShelleyToBabbageEraConstraints era =>
 ShelleyToBabbageEra era -> a)
-> (ConwayEraOnwardsConstraints era => ConwayEraOnwards era -> a)
-> ShelleyBasedEra era
-> a
caseShelleyToBabbageOrConwayEraOnwards ShelleyToBabbageEraConstraints era =>
ShelleyToBabbageEra era
-> TxCert (ShelleyLedgerEra era) -> Certificate era
ShelleyToBabbageEra era
-> TxCert (ShelleyLedgerEra era) -> Certificate era
ShelleyToBabbageEra era
-> ShelleyTxCert (ShelleyLedgerEra era) -> Certificate era
forall era.
ShelleyToBabbageEra era
-> ShelleyTxCert (ShelleyLedgerEra era) -> Certificate era
ShelleyRelatedCertificate ConwayEraOnwardsConstraints era =>
ConwayEraOnwards era
-> TxCert (ShelleyLedgerEra era) -> Certificate era
ConwayEraOnwards era
-> TxCert (ShelleyLedgerEra era) -> Certificate era
ConwayEraOnwards era
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
forall era.
ConwayEraOnwards era
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
ConwayCertificate

toShelleyPoolParams :: StakePoolParameters -> Ledger.PoolParams StandardCrypto
toShelleyPoolParams :: StakePoolParameters -> PoolParams StandardCrypto
toShelleyPoolParams
  StakePoolParameters
    { stakePoolId :: StakePoolParameters -> PoolId
stakePoolId = StakePoolKeyHash KeyHash 'StakePool StandardCrypto
poolkh
    , stakePoolVRF :: StakePoolParameters -> Hash VrfKey
stakePoolVRF = VrfKeyHash Hash StandardCrypto (VerKeyVRF StandardCrypto)
vrfkh
    , Coin
stakePoolCost :: StakePoolParameters -> Coin
stakePoolCost :: Coin
stakePoolCost
    , Rational
stakePoolMargin :: StakePoolParameters -> Rational
stakePoolMargin :: Rational
stakePoolMargin
    , StakeAddress
stakePoolRewardAccount :: StakePoolParameters -> StakeAddress
stakePoolRewardAccount :: StakeAddress
stakePoolRewardAccount
    , Coin
stakePoolPledge :: StakePoolParameters -> Coin
stakePoolPledge :: Coin
stakePoolPledge
    , [Hash StakeKey]
stakePoolOwners :: StakePoolParameters -> [Hash StakeKey]
stakePoolOwners :: [Hash StakeKey]
stakePoolOwners
    , [StakePoolRelay]
stakePoolRelays :: StakePoolParameters -> [StakePoolRelay]
stakePoolRelays :: [StakePoolRelay]
stakePoolRelays
    , Maybe StakePoolMetadataReference
stakePoolMetadata :: StakePoolParameters -> Maybe StakePoolMetadataReference
stakePoolMetadata :: Maybe StakePoolMetadataReference
stakePoolMetadata
    } =
    -- TODO: validate pool parameters such as the PoolMargin below, but also
    -- do simple client-side sanity checks, e.g. on the pool metadata url
    Ledger.PoolParams
      { ppId :: KeyHash 'StakePool StandardCrypto
Ledger.ppId = KeyHash 'StakePool StandardCrypto
poolkh
      , ppVrf :: VRFVerKeyHash 'StakePoolVRF StandardCrypto
Ledger.ppVrf = Hash (HASH StandardCrypto) (VerKeyVRF PraosVRF)
-> VRFVerKeyHash 'StakePoolVRF StandardCrypto
forall c v (r :: KeyRoleVRF).
Hash (HASH c) (VerKeyVRF v) -> VRFVerKeyHash r c
Ledger.toVRFVerKeyHash Hash (HASH StandardCrypto) (VerKeyVRF PraosVRF)
Hash StandardCrypto (VerKeyVRF StandardCrypto)
vrfkh
      , ppPledge :: Coin
Ledger.ppPledge = Coin
stakePoolPledge
      , ppCost :: Coin
Ledger.ppCost = Coin
stakePoolCost
      , ppMargin :: UnitInterval
Ledger.ppMargin =
          UnitInterval -> Maybe UnitInterval -> UnitInterval
forall a. a -> Maybe a -> a
fromMaybe
            (String -> UnitInterval
forall a. HasCallStack => String -> a
error String
"toShelleyPoolParams: invalid PoolMargin")
            (Rational -> Maybe UnitInterval
forall r. BoundedRational r => Rational -> Maybe r
Ledger.boundRational Rational
stakePoolMargin)
      , ppRewardAccount :: RewardAccount StandardCrypto
Ledger.ppRewardAccount = StakeAddress -> RewardAccount StandardCrypto
toShelleyStakeAddr StakeAddress
stakePoolRewardAccount
      , ppOwners :: Set (KeyHash 'Staking StandardCrypto)
Ledger.ppOwners =
          [Item (Set (KeyHash 'Staking StandardCrypto))]
-> Set (KeyHash 'Staking StandardCrypto)
forall l. IsList l => [Item l] -> l
fromList
            [Item (Set (KeyHash 'Staking StandardCrypto))
KeyHash 'Staking StandardCrypto
kh | StakeKeyHash KeyHash 'Staking StandardCrypto
kh <- [Hash StakeKey]
stakePoolOwners]
      , ppRelays :: StrictSeq StakePoolRelay
Ledger.ppRelays =
          [Item (StrictSeq StakePoolRelay)] -> StrictSeq StakePoolRelay
forall l. IsList l => [Item l] -> l
fromList
            ((StakePoolRelay -> StakePoolRelay)
-> [StakePoolRelay] -> [StakePoolRelay]
forall a b. (a -> b) -> [a] -> [b]
map StakePoolRelay -> StakePoolRelay
toShelleyStakePoolRelay [StakePoolRelay]
stakePoolRelays)
      , ppMetadata :: StrictMaybe PoolMetadata
Ledger.ppMetadata =
          StakePoolMetadataReference -> PoolMetadata
toShelleyPoolMetadata
            (StakePoolMetadataReference -> PoolMetadata)
-> StrictMaybe StakePoolMetadataReference
-> StrictMaybe PoolMetadata
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe StakePoolMetadataReference
-> StrictMaybe StakePoolMetadataReference
forall a. Maybe a -> StrictMaybe a
Ledger.maybeToStrictMaybe Maybe StakePoolMetadataReference
stakePoolMetadata
      }
   where
    toShelleyStakePoolRelay :: StakePoolRelay -> Ledger.StakePoolRelay
    toShelleyStakePoolRelay :: StakePoolRelay -> StakePoolRelay
toShelleyStakePoolRelay (StakePoolRelayIp Maybe IPv4
mipv4 Maybe IPv6
mipv6 Maybe PortNumber
mport) =
      StrictMaybe Port
-> StrictMaybe IPv4 -> StrictMaybe IPv6 -> StakePoolRelay
Ledger.SingleHostAddr
        (PortNumber -> Port
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PortNumber -> Port) -> StrictMaybe PortNumber -> StrictMaybe Port
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PortNumber -> StrictMaybe PortNumber
forall a. Maybe a -> StrictMaybe a
Ledger.maybeToStrictMaybe Maybe PortNumber
mport)
        (Maybe IPv4 -> StrictMaybe IPv4
forall a. Maybe a -> StrictMaybe a
Ledger.maybeToStrictMaybe Maybe IPv4
mipv4)
        (Maybe IPv6 -> StrictMaybe IPv6
forall a. Maybe a -> StrictMaybe a
Ledger.maybeToStrictMaybe Maybe IPv6
mipv6)
    toShelleyStakePoolRelay (StakePoolRelayDnsARecord ByteString
dnsname Maybe PortNumber
mport) =
      StrictMaybe Port -> DnsName -> StakePoolRelay
Ledger.SingleHostName
        (PortNumber -> Port
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PortNumber -> Port) -> StrictMaybe PortNumber -> StrictMaybe Port
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PortNumber -> StrictMaybe PortNumber
forall a. Maybe a -> StrictMaybe a
Ledger.maybeToStrictMaybe Maybe PortNumber
mport)
        (ByteString -> DnsName
toShelleyDnsName ByteString
dnsname)
    toShelleyStakePoolRelay (StakePoolRelayDnsSrvRecord ByteString
dnsname) =
      DnsName -> StakePoolRelay
Ledger.MultiHostName
        (ByteString -> DnsName
toShelleyDnsName ByteString
dnsname)

    toShelleyPoolMetadata :: StakePoolMetadataReference -> Ledger.PoolMetadata
    toShelleyPoolMetadata :: StakePoolMetadataReference -> PoolMetadata
toShelleyPoolMetadata
      StakePoolMetadataReference
        { Text
stakePoolMetadataURL :: StakePoolMetadataReference -> Text
stakePoolMetadataURL :: Text
stakePoolMetadataURL
        , stakePoolMetadataHash :: StakePoolMetadataReference -> Hash StakePoolMetadata
stakePoolMetadataHash = StakePoolMetadataHash Hash StandardCrypto ByteString
mdh
        } =
        Ledger.PoolMetadata
          { pmUrl :: Url
Ledger.pmUrl = Text -> Url
toShelleyUrl Text
stakePoolMetadataURL
          , pmHash :: ByteString
Ledger.pmHash = Hash Blake2b_256 ByteString -> ByteString
forall h a. Hash h a -> ByteString
Ledger.hashToBytes Hash Blake2b_256 ByteString
Hash StandardCrypto ByteString
mdh
          }

    toShelleyDnsName :: ByteString -> Ledger.DnsName
    toShelleyDnsName :: ByteString -> DnsName
toShelleyDnsName ByteString
name =
      DnsName -> Maybe DnsName -> DnsName
forall a. a -> Maybe a -> a
fromMaybe (String -> DnsName
forall a. HasCallStack => String -> a
error String
"toShelleyDnsName: invalid dns name. TODO: proper validation")
        (Maybe DnsName -> DnsName)
-> (Text -> Maybe DnsName) -> Text -> DnsName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Maybe DnsName
forall (m :: * -> *). MonadFail m => Int -> Text -> m DnsName
Ledger.textToDns (ByteString -> Int
BS.length ByteString
name)
        (Text -> DnsName) -> Text -> DnsName
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
Text.decodeLatin1 ByteString
name

    toShelleyUrl :: Text -> Ledger.Url
    toShelleyUrl :: Text -> Url
toShelleyUrl Text
url =
      Url -> Maybe Url -> Url
forall a. a -> Maybe a -> a
fromMaybe (String -> Url
forall a. HasCallStack => String -> a
error String
"toShelleyUrl: invalid url. TODO: proper validation") (Maybe Url -> Url) -> Maybe Url -> Url
forall a b. (a -> b) -> a -> b
$
        Int -> Text -> Maybe Url
forall (m :: * -> *). MonadFail m => Int -> Text -> m Url
Ledger.textToUrl (Text -> Int
Text.length Text
url) Text
url

fromShelleyPoolParams
  :: Ledger.PoolParams StandardCrypto
  -> StakePoolParameters
fromShelleyPoolParams :: PoolParams StandardCrypto -> StakePoolParameters
fromShelleyPoolParams
  Ledger.PoolParams
    { KeyHash 'StakePool StandardCrypto
ppId :: forall c. PoolParams c -> KeyHash 'StakePool c
ppId :: KeyHash 'StakePool StandardCrypto
Ledger.ppId
    , VRFVerKeyHash 'StakePoolVRF StandardCrypto
ppVrf :: forall c. PoolParams c -> VRFVerKeyHash 'StakePoolVRF c
ppVrf :: VRFVerKeyHash 'StakePoolVRF StandardCrypto
Ledger.ppVrf
    , Coin
ppPledge :: forall c. PoolParams c -> Coin
ppPledge :: Coin
Ledger.ppPledge
    , Coin
ppCost :: forall c. PoolParams c -> Coin
ppCost :: Coin
Ledger.ppCost
    , UnitInterval
ppMargin :: forall c. PoolParams c -> UnitInterval
ppMargin :: UnitInterval
Ledger.ppMargin
    , RewardAccount StandardCrypto
ppRewardAccount :: forall c. PoolParams c -> RewardAccount c
ppRewardAccount :: RewardAccount StandardCrypto
Ledger.ppRewardAccount
    , Set (KeyHash 'Staking StandardCrypto)
ppOwners :: forall c. PoolParams c -> Set (KeyHash 'Staking c)
ppOwners :: Set (KeyHash 'Staking StandardCrypto)
Ledger.ppOwners
    , StrictSeq StakePoolRelay
ppRelays :: forall c. PoolParams c -> StrictSeq StakePoolRelay
ppRelays :: StrictSeq StakePoolRelay
Ledger.ppRelays
    , StrictMaybe PoolMetadata
ppMetadata :: forall c. PoolParams c -> StrictMaybe PoolMetadata
ppMetadata :: StrictMaybe PoolMetadata
Ledger.ppMetadata
    } =
    StakePoolParameters
      { stakePoolId :: PoolId
stakePoolId = KeyHash 'StakePool StandardCrypto -> PoolId
StakePoolKeyHash KeyHash 'StakePool StandardCrypto
ppId
      , stakePoolVRF :: Hash VrfKey
stakePoolVRF = Hash StandardCrypto (VerKeyVRF StandardCrypto) -> Hash VrfKey
VrfKeyHash (VRFVerKeyHash 'StakePoolVRF StandardCrypto
-> Hash (HASH StandardCrypto) (VerKeyVRF PraosVRF)
forall (r :: KeyRoleVRF) c v.
VRFVerKeyHash r c -> Hash (HASH c) (VerKeyVRF v)
Ledger.fromVRFVerKeyHash VRFVerKeyHash 'StakePoolVRF StandardCrypto
ppVrf)
      , stakePoolCost :: Coin
stakePoolCost = Coin
ppCost
      , stakePoolMargin :: Rational
stakePoolMargin = UnitInterval -> Rational
forall r. BoundedRational r => r -> Rational
Ledger.unboundRational UnitInterval
ppMargin
      , stakePoolRewardAccount :: StakeAddress
stakePoolRewardAccount = RewardAccount StandardCrypto -> StakeAddress
fromShelleyStakeAddr RewardAccount StandardCrypto
ppRewardAccount
      , stakePoolPledge :: Coin
stakePoolPledge = Coin
ppPledge
      , stakePoolOwners :: [Hash StakeKey]
stakePoolOwners = (KeyHash 'Staking StandardCrypto -> Hash StakeKey)
-> [KeyHash 'Staking StandardCrypto] -> [Hash StakeKey]
forall a b. (a -> b) -> [a] -> [b]
map KeyHash 'Staking StandardCrypto -> Hash StakeKey
StakeKeyHash (Set (KeyHash 'Staking StandardCrypto)
-> [Item (Set (KeyHash 'Staking StandardCrypto))]
forall l. IsList l => l -> [Item l]
toList Set (KeyHash 'Staking StandardCrypto)
ppOwners)
      , stakePoolRelays :: [StakePoolRelay]
stakePoolRelays =
          (StakePoolRelay -> StakePoolRelay)
-> [StakePoolRelay] -> [StakePoolRelay]
forall a b. (a -> b) -> [a] -> [b]
map
            StakePoolRelay -> StakePoolRelay
fromShelleyStakePoolRelay
            (StrictSeq StakePoolRelay -> [Item (StrictSeq StakePoolRelay)]
forall l. IsList l => l -> [Item l]
toList StrictSeq StakePoolRelay
ppRelays)
      , stakePoolMetadata :: Maybe StakePoolMetadataReference
stakePoolMetadata =
          PoolMetadata -> StakePoolMetadataReference
fromShelleyPoolMetadata
            (PoolMetadata -> StakePoolMetadataReference)
-> Maybe PoolMetadata -> Maybe StakePoolMetadataReference
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictMaybe PoolMetadata -> Maybe PoolMetadata
forall a. StrictMaybe a -> Maybe a
Ledger.strictMaybeToMaybe StrictMaybe PoolMetadata
ppMetadata
      }
   where
    fromShelleyStakePoolRelay :: Ledger.StakePoolRelay -> StakePoolRelay
    fromShelleyStakePoolRelay :: StakePoolRelay -> StakePoolRelay
fromShelleyStakePoolRelay (Ledger.SingleHostAddr StrictMaybe Port
mport StrictMaybe IPv4
mipv4 StrictMaybe IPv6
mipv6) =
      Maybe IPv4 -> Maybe IPv6 -> Maybe PortNumber -> StakePoolRelay
StakePoolRelayIp
        (StrictMaybe IPv4 -> Maybe IPv4
forall a. StrictMaybe a -> Maybe a
Ledger.strictMaybeToMaybe StrictMaybe IPv4
mipv4)
        (StrictMaybe IPv6 -> Maybe IPv6
forall a. StrictMaybe a -> Maybe a
Ledger.strictMaybeToMaybe StrictMaybe IPv6
mipv6)
        (Word16 -> PortNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> PortNumber) -> (Port -> Word16) -> Port -> PortNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Port -> Word16
Ledger.portToWord16 (Port -> PortNumber) -> Maybe Port -> Maybe PortNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictMaybe Port -> Maybe Port
forall a. StrictMaybe a -> Maybe a
Ledger.strictMaybeToMaybe StrictMaybe Port
mport)
    fromShelleyStakePoolRelay (Ledger.SingleHostName StrictMaybe Port
mport DnsName
dnsname) =
      ByteString -> Maybe PortNumber -> StakePoolRelay
StakePoolRelayDnsARecord
        (DnsName -> ByteString
fromShelleyDnsName DnsName
dnsname)
        (Word16 -> PortNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> PortNumber) -> (Port -> Word16) -> Port -> PortNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Port -> Word16
Ledger.portToWord16 (Port -> PortNumber) -> Maybe Port -> Maybe PortNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictMaybe Port -> Maybe Port
forall a. StrictMaybe a -> Maybe a
Ledger.strictMaybeToMaybe StrictMaybe Port
mport)
    fromShelleyStakePoolRelay (Ledger.MultiHostName DnsName
dnsname) =
      ByteString -> StakePoolRelay
StakePoolRelayDnsSrvRecord
        (DnsName -> ByteString
fromShelleyDnsName DnsName
dnsname)

    fromShelleyPoolMetadata :: Ledger.PoolMetadata -> StakePoolMetadataReference
    fromShelleyPoolMetadata :: PoolMetadata -> StakePoolMetadataReference
fromShelleyPoolMetadata
      Ledger.PoolMetadata
        { Url
pmUrl :: PoolMetadata -> Url
pmUrl :: Url
Ledger.pmUrl
        , ByteString
pmHash :: PoolMetadata -> ByteString
pmHash :: ByteString
Ledger.pmHash
        } =
        StakePoolMetadataReference
          { stakePoolMetadataURL :: Text
stakePoolMetadataURL = Url -> Text
Ledger.urlToText Url
pmUrl
          , stakePoolMetadataHash :: Hash StakePoolMetadata
stakePoolMetadataHash =
              Hash Blake2b_256 ByteString -> Hash StakePoolMetadata
Hash StandardCrypto ByteString -> Hash StakePoolMetadata
StakePoolMetadataHash
                (Hash Blake2b_256 ByteString -> Hash StakePoolMetadata)
-> (ByteString -> Hash Blake2b_256 ByteString)
-> ByteString
-> Hash StakePoolMetadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash Blake2b_256 ByteString
-> Maybe (Hash Blake2b_256 ByteString)
-> Hash Blake2b_256 ByteString
forall a. a -> Maybe a -> a
fromMaybe (String -> Hash Blake2b_256 ByteString
forall a. HasCallStack => String -> a
error String
"fromShelleyPoolMetadata: invalid hash. TODO: proper validation")
                (Maybe (Hash Blake2b_256 ByteString)
 -> Hash Blake2b_256 ByteString)
-> (ByteString -> Maybe (Hash Blake2b_256 ByteString))
-> ByteString
-> Hash Blake2b_256 ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Hash Blake2b_256 ByteString)
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Ledger.hashFromBytes
                (ByteString -> Hash StakePoolMetadata)
-> ByteString -> Hash StakePoolMetadata
forall a b. (a -> b) -> a -> b
$ ByteString
pmHash
          }

    -- TODO: change the ledger rep of the DNS name to use ShortByteString
    fromShelleyDnsName :: Ledger.DnsName -> ByteString
    fromShelleyDnsName :: DnsName -> ByteString
fromShelleyDnsName =
      Text -> ByteString
Text.encodeUtf8
        (Text -> ByteString) -> (DnsName -> Text) -> DnsName -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DnsName -> Text
Ledger.dnsToText

data AnchorDataFromCertificateError
  = InvalidPoolMetadataHashError Ledger.Url ByteString
  deriving (AnchorDataFromCertificateError
-> AnchorDataFromCertificateError -> Bool
(AnchorDataFromCertificateError
 -> AnchorDataFromCertificateError -> Bool)
-> (AnchorDataFromCertificateError
    -> AnchorDataFromCertificateError -> Bool)
-> Eq AnchorDataFromCertificateError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AnchorDataFromCertificateError
-> AnchorDataFromCertificateError -> Bool
== :: AnchorDataFromCertificateError
-> AnchorDataFromCertificateError -> Bool
$c/= :: AnchorDataFromCertificateError
-> AnchorDataFromCertificateError -> Bool
/= :: AnchorDataFromCertificateError
-> AnchorDataFromCertificateError -> Bool
Eq, Int -> AnchorDataFromCertificateError -> ShowS
[AnchorDataFromCertificateError] -> ShowS
AnchorDataFromCertificateError -> String
(Int -> AnchorDataFromCertificateError -> ShowS)
-> (AnchorDataFromCertificateError -> String)
-> ([AnchorDataFromCertificateError] -> ShowS)
-> Show AnchorDataFromCertificateError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AnchorDataFromCertificateError -> ShowS
showsPrec :: Int -> AnchorDataFromCertificateError -> ShowS
$cshow :: AnchorDataFromCertificateError -> String
show :: AnchorDataFromCertificateError -> String
$cshowList :: [AnchorDataFromCertificateError] -> ShowS
showList :: [AnchorDataFromCertificateError] -> ShowS
Show)

instance Error AnchorDataFromCertificateError where
  prettyError :: AnchorDataFromCertificateError -> Doc ann
  prettyError :: forall ann. AnchorDataFromCertificateError -> Doc ann
prettyError (InvalidPoolMetadataHashError Url
url ByteString
hash) =
    Doc ann
"Invalid pool metadata hash for URL " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall a. IsString a => String -> a
fromString (Url -> String
forall a. Show a => a -> String
show Url
url) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
": " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall a. IsString a => String -> a
fromString (ByteString -> String
forall a. Show a => a -> String
show ByteString
hash)

-- | Get anchor data url and hash from a certificate. A return value of `Nothing`
-- means that the certificate does not contain anchor data.
getAnchorDataFromCertificate
  :: Certificate era
  -> Either AnchorDataFromCertificateError (Maybe (Ledger.Anchor StandardCrypto))
getAnchorDataFromCertificate :: forall era.
Certificate era
-> Either
     AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto))
getAnchorDataFromCertificate Certificate era
c =
  case Certificate era
c of
    ShelleyRelatedCertificate ShelleyToBabbageEra era
stbe ShelleyTxCert (ShelleyLedgerEra era)
scert ->
      ShelleyToBabbageEra era
-> (ShelleyToBabbageEraConstraints era =>
    Either
      AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto)))
-> Either
     AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto))
forall era a.
ShelleyToBabbageEra era
-> (ShelleyToBabbageEraConstraints era => a) -> a
shelleyToBabbageEraConstraints ShelleyToBabbageEra era
stbe ((ShelleyToBabbageEraConstraints era =>
  Either
    AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto)))
 -> Either
      AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto)))
-> (ShelleyToBabbageEraConstraints era =>
    Either
      AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto)))
-> Either
     AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto))
forall a b. (a -> b) -> a -> b
$
        case ShelleyTxCert (ShelleyLedgerEra era)
scert of
          Ledger.RegTxCert StakeCredential (EraCrypto (ShelleyLedgerEra era))
_ -> Maybe (Anchor StandardCrypto)
-> Either
     AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto))
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Anchor StandardCrypto)
forall a. Maybe a
Nothing
          Ledger.UnRegTxCert StakeCredential (EraCrypto (ShelleyLedgerEra era))
_ -> Maybe (Anchor StandardCrypto)
-> Either
     AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto))
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Anchor StandardCrypto)
forall a. Maybe a
Nothing
          Ledger.DelegStakeTxCert StakeCredential (EraCrypto (ShelleyLedgerEra era))
_ KeyHash 'StakePool (EraCrypto (ShelleyLedgerEra era))
_ -> Maybe (Anchor StandardCrypto)
-> Either
     AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto))
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Anchor StandardCrypto)
forall a. Maybe a
Nothing
          Ledger.RegPoolTxCert PoolParams (EraCrypto (ShelleyLedgerEra era))
poolParams -> Either
  AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto))
-> (PoolMetadata
    -> Either
         AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto)))
-> StrictMaybe PoolMetadata
-> Either
     AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto))
forall a b. a -> (b -> a) -> StrictMaybe b -> a
strictMaybe (Maybe (Anchor StandardCrypto)
-> Either
     AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto))
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Anchor StandardCrypto)
forall a. Maybe a
Nothing) PoolMetadata
-> Either
     AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto))
forall (m :: * -> *).
MonadError AnchorDataFromCertificateError m =>
PoolMetadata -> m (Maybe (Anchor StandardCrypto))
anchorDataFromPoolMetadata (StrictMaybe PoolMetadata
 -> Either
      AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto)))
-> StrictMaybe PoolMetadata
-> Either
     AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto))
forall a b. (a -> b) -> a -> b
$ PoolParams StandardCrypto -> StrictMaybe PoolMetadata
forall c. PoolParams c -> StrictMaybe PoolMetadata
Ledger.ppMetadata PoolParams (EraCrypto (ShelleyLedgerEra era))
PoolParams StandardCrypto
poolParams
          Ledger.RetirePoolTxCert KeyHash 'StakePool (EraCrypto (ShelleyLedgerEra era))
_ EpochNo
_ -> Maybe (Anchor StandardCrypto)
-> Either
     AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto))
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Anchor StandardCrypto)
forall a. Maybe a
Nothing
          Ledger.GenesisDelegTxCert{} -> Maybe (Anchor StandardCrypto)
-> Either
     AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto))
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Anchor StandardCrypto)
forall a. Maybe a
Nothing
          Ledger.MirTxCert MIRCert (EraCrypto (ShelleyLedgerEra era))
_ -> Maybe (Anchor StandardCrypto)
-> Either
     AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto))
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Anchor StandardCrypto)
forall a. Maybe a
Nothing
    ConwayCertificate ConwayEraOnwards era
ceo ConwayTxCert (ShelleyLedgerEra era)
ccert ->
      ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era =>
    Either
      AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto)))
-> Either
     AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto))
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
ceo ((ConwayEraOnwardsConstraints era =>
  Either
    AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto)))
 -> Either
      AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto)))
-> (ConwayEraOnwardsConstraints era =>
    Either
      AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto)))
-> Either
     AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto))
forall a b. (a -> b) -> a -> b
$
        case ConwayTxCert (ShelleyLedgerEra era)
ccert of
          Ledger.RegTxCert StakeCredential (EraCrypto (ShelleyLedgerEra era))
_ -> Maybe (Anchor StandardCrypto)
-> Either
     AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto))
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Anchor StandardCrypto)
forall a. Maybe a
Nothing
          Ledger.UnRegTxCert StakeCredential (EraCrypto (ShelleyLedgerEra era))
_ -> Maybe (Anchor StandardCrypto)
-> Either
     AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto))
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Anchor StandardCrypto)
forall a. Maybe a
Nothing
          Ledger.RegDepositTxCert StakeCredential (EraCrypto (ShelleyLedgerEra era))
_ Coin
_ -> Maybe (Anchor StandardCrypto)
-> Either
     AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto))
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Anchor StandardCrypto)
forall a. Maybe a
Nothing
          Ledger.UnRegDepositTxCert StakeCredential (EraCrypto (ShelleyLedgerEra era))
_ Coin
_ -> Maybe (Anchor StandardCrypto)
-> Either
     AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto))
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Anchor StandardCrypto)
forall a. Maybe a
Nothing
          Ledger.RegDepositDelegTxCert{} -> Maybe (Anchor StandardCrypto)
-> Either
     AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto))
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Anchor StandardCrypto)
forall a. Maybe a
Nothing
          Ledger.DelegTxCert{} -> Maybe (Anchor StandardCrypto)
-> Either
     AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto))
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Anchor StandardCrypto)
forall a. Maybe a
Nothing
          Ledger.RegPoolTxCert PoolParams (EraCrypto (ShelleyLedgerEra era))
poolParams -> Either
  AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto))
-> (PoolMetadata
    -> Either
         AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto)))
-> StrictMaybe PoolMetadata
-> Either
     AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto))
forall a b. a -> (b -> a) -> StrictMaybe b -> a
strictMaybe (Maybe (Anchor StandardCrypto)
-> Either
     AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto))
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Anchor StandardCrypto)
forall a. Maybe a
Nothing) PoolMetadata
-> Either
     AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto))
forall (m :: * -> *).
MonadError AnchorDataFromCertificateError m =>
PoolMetadata -> m (Maybe (Anchor StandardCrypto))
anchorDataFromPoolMetadata (StrictMaybe PoolMetadata
 -> Either
      AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto)))
-> StrictMaybe PoolMetadata
-> Either
     AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto))
forall a b. (a -> b) -> a -> b
$ PoolParams StandardCrypto -> StrictMaybe PoolMetadata
forall c. PoolParams c -> StrictMaybe PoolMetadata
Ledger.ppMetadata PoolParams (EraCrypto (ShelleyLedgerEra era))
PoolParams StandardCrypto
poolParams
          Ledger.RetirePoolTxCert KeyHash 'StakePool (EraCrypto (ShelleyLedgerEra era))
_ EpochNo
_ -> Maybe (Anchor StandardCrypto)
-> Either
     AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto))
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Anchor StandardCrypto)
forall a. Maybe a
Nothing
          Ledger.RegDRepTxCert Credential 'DRepRole (EraCrypto (ShelleyLedgerEra era))
_ Coin
_ StrictMaybe (Anchor (EraCrypto (ShelleyLedgerEra era)))
mAnchor -> Maybe (Anchor StandardCrypto)
-> Either
     AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto))
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Anchor StandardCrypto)
 -> Either
      AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto)))
-> Maybe (Anchor StandardCrypto)
-> Either
     AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto))
forall a b. (a -> b) -> a -> b
$ StrictMaybe (Anchor StandardCrypto)
-> Maybe (Anchor StandardCrypto)
forall a. StrictMaybe a -> Maybe a
Ledger.strictMaybeToMaybe StrictMaybe (Anchor (EraCrypto (ShelleyLedgerEra era)))
StrictMaybe (Anchor StandardCrypto)
mAnchor
          Ledger.UnRegDRepTxCert Credential 'DRepRole (EraCrypto (ShelleyLedgerEra era))
_ Coin
_ -> Maybe (Anchor StandardCrypto)
-> Either
     AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto))
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Anchor StandardCrypto)
forall a. Maybe a
Nothing
          Ledger.UpdateDRepTxCert Credential 'DRepRole (EraCrypto (ShelleyLedgerEra era))
_ StrictMaybe (Anchor (EraCrypto (ShelleyLedgerEra era)))
mAnchor -> Maybe (Anchor StandardCrypto)
-> Either
     AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto))
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Anchor StandardCrypto)
 -> Either
      AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto)))
-> Maybe (Anchor StandardCrypto)
-> Either
     AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto))
forall a b. (a -> b) -> a -> b
$ StrictMaybe (Anchor StandardCrypto)
-> Maybe (Anchor StandardCrypto)
forall a. StrictMaybe a -> Maybe a
Ledger.strictMaybeToMaybe StrictMaybe (Anchor (EraCrypto (ShelleyLedgerEra era)))
StrictMaybe (Anchor StandardCrypto)
mAnchor
          Ledger.AuthCommitteeHotKeyTxCert Credential 'ColdCommitteeRole (EraCrypto (ShelleyLedgerEra era))
_ Credential 'HotCommitteeRole (EraCrypto (ShelleyLedgerEra era))
_ -> Maybe (Anchor StandardCrypto)
-> Either
     AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto))
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Anchor StandardCrypto)
forall a. Maybe a
Nothing
          Ledger.ResignCommitteeColdTxCert Credential 'ColdCommitteeRole (EraCrypto (ShelleyLedgerEra era))
_ StrictMaybe (Anchor (EraCrypto (ShelleyLedgerEra era)))
mAnchor -> Maybe (Anchor StandardCrypto)
-> Either
     AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto))
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Anchor StandardCrypto)
 -> Either
      AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto)))
-> Maybe (Anchor StandardCrypto)
-> Either
     AnchorDataFromCertificateError (Maybe (Anchor StandardCrypto))
forall a b. (a -> b) -> a -> b
$ StrictMaybe (Anchor StandardCrypto)
-> Maybe (Anchor StandardCrypto)
forall a. StrictMaybe a -> Maybe a
Ledger.strictMaybeToMaybe StrictMaybe (Anchor (EraCrypto (ShelleyLedgerEra era)))
StrictMaybe (Anchor StandardCrypto)
mAnchor
 where
  anchorDataFromPoolMetadata
    :: MonadError AnchorDataFromCertificateError m
    => Ledger.PoolMetadata
    -> m (Maybe (Ledger.Anchor StandardCrypto))
  anchorDataFromPoolMetadata :: forall (m :: * -> *).
MonadError AnchorDataFromCertificateError m =>
PoolMetadata -> m (Maybe (Anchor StandardCrypto))
anchorDataFromPoolMetadata (Ledger.PoolMetadata{pmUrl :: PoolMetadata -> Url
Ledger.pmUrl = Url
url, pmHash :: PoolMetadata -> ByteString
Ledger.pmHash = ByteString
hashBytes}) = do
    Hash Blake2b_256 AnchorData
hash <-
      m (Hash Blake2b_256 AnchorData)
-> (Hash Blake2b_256 AnchorData -> m (Hash Blake2b_256 AnchorData))
-> Maybe (Hash Blake2b_256 AnchorData)
-> m (Hash Blake2b_256 AnchorData)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (AnchorDataFromCertificateError -> m (Hash Blake2b_256 AnchorData)
forall a. AnchorDataFromCertificateError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (AnchorDataFromCertificateError -> m (Hash Blake2b_256 AnchorData))
-> AnchorDataFromCertificateError
-> m (Hash Blake2b_256 AnchorData)
forall a b. (a -> b) -> a -> b
$ Url -> ByteString -> AnchorDataFromCertificateError
InvalidPoolMetadataHashError Url
url ByteString
hashBytes) Hash Blake2b_256 AnchorData -> m (Hash Blake2b_256 AnchorData)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Hash Blake2b_256 AnchorData)
 -> m (Hash Blake2b_256 AnchorData))
-> Maybe (Hash Blake2b_256 AnchorData)
-> m (Hash Blake2b_256 AnchorData)
forall a b. (a -> b) -> a -> b
$
        ByteString -> Maybe (Hash Blake2b_256 AnchorData)
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Ledger.hashFromBytes ByteString
hashBytes
    Maybe (Anchor StandardCrypto) -> m (Maybe (Anchor StandardCrypto))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Anchor StandardCrypto)
 -> m (Maybe (Anchor StandardCrypto)))
-> Maybe (Anchor StandardCrypto)
-> m (Maybe (Anchor StandardCrypto))
forall a b. (a -> b) -> a -> b
$
      Anchor StandardCrypto -> Maybe (Anchor StandardCrypto)
forall a. a -> Maybe a
Just
        ( Ledger.Anchor
            { anchorUrl :: Url
Ledger.anchorUrl = Url
url
            , anchorDataHash :: SafeHash StandardCrypto AnchorData
Ledger.anchorDataHash = Hash (HASH StandardCrypto) AnchorData
-> SafeHash StandardCrypto AnchorData
forall c index. Hash (HASH c) index -> SafeHash c index
Ledger.unsafeMakeSafeHash Hash Blake2b_256 AnchorData
Hash (HASH StandardCrypto) AnchorData
hash
            }
        )

-- | Returns `True` if the certificate is a DRep registration or update certificate,
-- otherwise `False`. This is to see if the certificate needs to be compliant with
-- CIP-0119.
isDRepRegOrUpdateCert :: Certificate era -> Bool
isDRepRegOrUpdateCert :: forall era. Certificate era -> Bool
isDRepRegOrUpdateCert = \case
  ShelleyRelatedCertificate ShelleyToBabbageEra era
_ ShelleyTxCert (ShelleyLedgerEra era)
_ -> Bool
False
  ConwayCertificate ConwayEraOnwards era
ceo ConwayTxCert (ShelleyLedgerEra era)
ccert ->
    ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era => Bool) -> Bool
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
ceo ((ConwayEraOnwardsConstraints era => Bool) -> Bool)
-> (ConwayEraOnwardsConstraints era => Bool) -> Bool
forall a b. (a -> b) -> a -> b
$
      case ConwayTxCert (ShelleyLedgerEra era)
ccert of
        Ledger.RegDRepTxCert{} -> Bool
True
        Ledger.UpdateDRepTxCert{} -> Bool
True
        ConwayTxCert (ShelleyLedgerEra era)
_ -> Bool
False