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

-- | Certificates embedded in transactions
module Cardano.Api.Internal.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
  , certificateToTxCert
  , filterUnRegCreds
  , filterUnRegDRepCreds
  , isDRepRegOrUpdateCert
  )
where

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

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

import Control.Monad.Except (MonadError (..))
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.IP (IPv4, IPv6)
import Data.Maybe
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text
import Data.Type.Equality (TestEquality (..))
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
    :: Typeable era
    => ShelleyToBabbageEra era
    -> Ledger.ShelleyTxCert (ShelleyLedgerEra era)
    -> Certificate era
  -- Conway onwards
  -- TODO: Add comments about the new types of certificates
  ConwayCertificate
    :: Typeable era
    => 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 Ord (Certificate era)

deriving instance Show (Certificate era)

instance TestEquality Certificate where
  testEquality :: forall a b. Certificate a -> Certificate b -> Maybe (a :~: b)
testEquality (ShelleyRelatedCertificate ShelleyToBabbageEra a
_ ShelleyTxCert (ShelleyLedgerEra a)
c) (ShelleyRelatedCertificate ShelleyToBabbageEra b
_ ShelleyTxCert (ShelleyLedgerEra b)
c') =
    ShelleyTxCert (ShelleyLedgerEra a)
-> ShelleyTxCert (ShelleyLedgerEra b) -> Maybe (a :~: b)
forall eraA eraB.
(Typeable eraA, Typeable eraB) =>
ShelleyTxCert (ShelleyLedgerEra eraA)
-> ShelleyTxCert (ShelleyLedgerEra eraB) -> Maybe (eraA :~: eraB)
shelleyCertTypeEquality ShelleyTxCert (ShelleyLedgerEra a)
c ShelleyTxCert (ShelleyLedgerEra b)
c'
  testEquality (ConwayCertificate ConwayEraOnwards a
_ ConwayTxCert (ShelleyLedgerEra a)
c) (ConwayCertificate ConwayEraOnwards b
_ ConwayTxCert (ShelleyLedgerEra b)
c') =
    ConwayTxCert (ShelleyLedgerEra a)
-> ConwayTxCert (ShelleyLedgerEra b) -> Maybe (a :~: b)
forall eraA eraB.
(Typeable eraA, Typeable eraB) =>
ConwayTxCert (ShelleyLedgerEra eraA)
-> ConwayTxCert (ShelleyLedgerEra eraB) -> Maybe (eraA :~: eraB)
conwayCertTypeEquality ConwayTxCert (ShelleyLedgerEra a)
c ConwayTxCert (ShelleyLedgerEra b)
c'
  testEquality ShelleyRelatedCertificate{} ConwayCertificate{} = Maybe (a :~: b)
forall a. Maybe a
Nothing
  testEquality ConwayCertificate{} ShelleyRelatedCertificate{} = Maybe (a :~: b)
forall a. Maybe a
Nothing

conwayCertTypeEquality
  :: (Typeable eraA, Typeable eraB)
  => Ledger.ConwayTxCert (ShelleyLedgerEra eraA)
  -> Ledger.ConwayTxCert (ShelleyLedgerEra eraB)
  -> Maybe (eraA :~: eraB)
conwayCertTypeEquality :: forall eraA eraB.
(Typeable eraA, Typeable eraB) =>
ConwayTxCert (ShelleyLedgerEra eraA)
-> ConwayTxCert (ShelleyLedgerEra eraB) -> Maybe (eraA :~: eraB)
conwayCertTypeEquality ConwayTxCert (ShelleyLedgerEra eraA)
_ ConwayTxCert (ShelleyLedgerEra eraB)
_ = Maybe (eraA :~: eraB)
forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT

shelleyCertTypeEquality
  :: (Typeable eraA, Typeable eraB)
  => Ledger.ShelleyTxCert (ShelleyLedgerEra eraA)
  -> Ledger.ShelleyTxCert (ShelleyLedgerEra eraB)
  -> Maybe (eraA :~: eraB)
shelleyCertTypeEquality :: forall eraA eraB.
(Typeable eraA, Typeable eraB) =>
ShelleyTxCert (ShelleyLedgerEra eraA)
-> ShelleyTxCert (ShelleyLedgerEra eraB) -> Maybe (eraA :~: eraB)
shelleyCertTypeEquality ShelleyTxCert (ShelleyLedgerEra eraA)
_ ShelleyTxCert (ShelleyLedgerEra eraB)
_ = Maybe (eraA :~: eraB)
forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT

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"

certificateToTxCert :: Certificate era -> L.TxCert (ShelleyLedgerEra era)
certificateToTxCert :: forall era. Certificate era -> TxCert (ShelleyLedgerEra era)
certificateToTxCert Certificate era
c =
  case Certificate era
c of
    ShelleyRelatedCertificate ShelleyToBabbageEra era
eon ShelleyTxCert (ShelleyLedgerEra era)
cert ->
      case ShelleyToBabbageEra era
eon of
        ShelleyToBabbageEra era
ShelleyToBabbageEraShelley -> TxCert (ShelleyLedgerEra era)
ShelleyTxCert (ShelleyLedgerEra era)
cert
        ShelleyToBabbageEra era
ShelleyToBabbageEraAllegra -> TxCert (ShelleyLedgerEra era)
ShelleyTxCert (ShelleyLedgerEra era)
cert
        ShelleyToBabbageEra era
ShelleyToBabbageEraMary -> TxCert (ShelleyLedgerEra era)
ShelleyTxCert (ShelleyLedgerEra era)
cert
        ShelleyToBabbageEra era
ShelleyToBabbageEraAlonzo -> TxCert (ShelleyLedgerEra era)
ShelleyTxCert (ShelleyLedgerEra era)
cert
        ShelleyToBabbageEra era
ShelleyToBabbageEraBabbage -> TxCert (ShelleyLedgerEra era)
ShelleyTxCert (ShelleyLedgerEra era)
cert
    ConwayCertificate ConwayEraOnwards era
eon ConwayTxCert (ShelleyLedgerEra era)
cert ->
      case ConwayEraOnwards era
eon of
        ConwayEraOnwards era
ConwayEraOnwardsConway -> TxCert (ShelleyLedgerEra era)
ConwayTxCert (ShelleyLedgerEra era)
cert

-- ----------------------------------------------------------------------------
-- 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.
Typeable 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 -> TxCert (ShelleyLedgerEra era)
forall era. ShelleyEraTxCert era => StakeCredential -> TxCert era
Ledger.mkRegTxCert (StakeCredential -> TxCert (ShelleyLedgerEra era))
-> StakeCredential -> TxCert (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$
          StakeCredential -> StakeCredential
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.
Typeable 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 -> Coin -> TxCert (ShelleyLedgerEra era)
forall era.
ConwayEraTxCert era =>
StakeCredential -> Coin -> TxCert era
Ledger.mkRegDepositTxCert (StakeCredential -> StakeCredential
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.
Typeable 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 -> Coin -> TxCert (ShelleyLedgerEra era)
forall era.
ConwayEraTxCert era =>
StakeCredential -> Coin -> TxCert era
Ledger.mkUnRegDepositTxCert (StakeCredential -> StakeCredential
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.
Typeable 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 -> TxCert (ShelleyLedgerEra era)
forall era. ShelleyEraTxCert era => StakeCredential -> TxCert era
Ledger.mkUnRegTxCert (StakeCredential -> TxCert (ShelleyLedgerEra era))
-> StakeCredential -> TxCert (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$
            StakeCredential -> StakeCredential
toShelleyStakeCredential StakeCredential
scred

data StakeDelegationRequirements era where
  StakeDelegationRequirementsConwayOnwards
    :: ConwayEraOnwards era
    -> StakeCredential
    -> Ledger.Delegatee
    -> 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
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.
Typeable 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 -> Delegatee -> TxCert (ShelleyLedgerEra era)
forall era.
ConwayEraTxCert era =>
StakeCredential -> Delegatee -> TxCert era
Ledger.mkDelegTxCert (StakeCredential -> StakeCredential
toShelleyStakeCredential StakeCredential
scred) Delegatee
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.
Typeable 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
-> KeyHash 'StakePool -> TxCert (ShelleyLedgerEra era)
forall era.
ShelleyEraTxCert era =>
StakeCredential -> KeyHash 'StakePool -> TxCert era
Ledger.mkDelegStakeTxCert (StakeCredential -> StakeCredential
toShelleyStakeCredential StakeCredential
scred) (PoolId -> KeyHash 'StakePool
unStakePoolKeyHash PoolId
pid)

data StakePoolRegistrationRequirements era where
  StakePoolRegistrationRequirementsConwayOnwards
    :: ConwayEraOnwards era
    -> Ledger.PoolParams
    -> StakePoolRegistrationRequirements era
  StakePoolRegistrationRequirementsPreConway
    :: ShelleyToBabbageEra era
    -> Ledger.PoolParams
    -> StakePoolRegistrationRequirements era

makeStakePoolRegistrationCertificate
  :: ()
  => StakePoolRegistrationRequirements era
  -> Certificate era
makeStakePoolRegistrationCertificate :: forall era.
StakePoolRegistrationRequirements era -> Certificate era
makeStakePoolRegistrationCertificate = \case
  StakePoolRegistrationRequirementsConwayOnwards ConwayEraOnwards era
cOnwards PoolParams
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.
Typeable 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 -> TxCert (ShelleyLedgerEra era)
forall era. EraTxCert era => PoolParams -> TxCert era
Ledger.mkRegPoolTxCert PoolParams
poolParams
  StakePoolRegistrationRequirementsPreConway ShelleyToBabbageEra era
atMostBab PoolParams
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.
Typeable 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 -> TxCert (ShelleyLedgerEra era)
forall era. EraTxCert era => PoolParams -> TxCert era
Ledger.mkRegPoolTxCert PoolParams
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.
Typeable 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 -> EpochNo -> TxCert (ShelleyLedgerEra era)
forall era.
EraTxCert era =>
KeyHash 'StakePool -> EpochNo -> TxCert era
Ledger.mkRetirePoolTxCert (PoolId -> KeyHash 'StakePool
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.
Typeable 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 -> EpochNo -> TxCert (ShelleyLedgerEra era)
forall era.
EraTxCert era =>
KeyHash 'StakePool -> EpochNo -> TxCert era
Ledger.mkRetirePoolTxCert (PoolId -> KeyHash 'StakePool
unStakePoolKeyHash PoolId
poolId) EpochNo
retirementEpoch

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

makeGenesisKeyDelegationCertificate
  :: Typeable era => GenesisKeyDelegationRequirements era -> Certificate era
makeGenesisKeyDelegationCertificate :: forall era.
Typeable era =>
GenesisKeyDelegationRequirements era -> Certificate era
makeGenesisKeyDelegationCertificate
  ( GenesisKeyDelegationRequirements
      ShelleyToBabbageEra era
atMostEra
      (GenesisKeyHash KeyHash 'Genesis
hGenKey)
      (GenesisDelegateKeyHash KeyHash 'GenesisDelegate
hGenDelegKey)
      (VrfKeyHash Hash HASH (VerKeyVRF (VRF StandardCrypto))
hVrfKey)
    ) =
    ShelleyToBabbageEra era
-> ShelleyTxCert (ShelleyLedgerEra era) -> Certificate era
forall era.
Typeable 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 -> ShelleyTxCert (ShelleyLedgerEra era)
forall era. GenesisDelegCert -> ShelleyTxCert era
Ledger.ShelleyTxCertGenesisDeleg (GenesisDelegCert -> ShelleyTxCert (ShelleyLedgerEra era))
-> GenesisDelegCert -> ShelleyTxCert (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$
          KeyHash 'Genesis
-> KeyHash 'GenesisDelegate
-> VRFVerKeyHash 'GenDelegVRF
-> GenesisDelegCert
Ledger.GenesisDelegCert KeyHash 'Genesis
hGenKey KeyHash 'GenesisDelegate
hGenDelegKey (Hash HASH (VerKeyVRF PraosVRF) -> VRFVerKeyHash 'GenDelegVRF
forall v (r :: KeyRoleVRF).
Hash HASH (VerKeyVRF v) -> VRFVerKeyHash r
Ledger.toVRFVerKeyHash Hash HASH (VerKeyVRF PraosVRF)
Hash HASH (VerKeyVRF (VRF StandardCrypto))
hVrfKey)

data MirCertificateRequirements era where
  MirCertificateRequirements
    :: ShelleyToBabbageEra era
    -> Ledger.MIRPot
    -> Ledger.MIRTarget
    -> MirCertificateRequirements era

makeMIRCertificate
  :: Typeable era
  => MirCertificateRequirements era
  -> Certificate era
makeMIRCertificate :: forall era.
Typeable era =>
MirCertificateRequirements era -> Certificate era
makeMIRCertificate (MirCertificateRequirements ShelleyToBabbageEra era
atMostEra MIRPot
mirPot MIRTarget
mirTarget) =
  ShelleyToBabbageEra era
-> ShelleyTxCert (ShelleyLedgerEra era) -> Certificate era
forall era.
Typeable 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 -> ShelleyTxCert (ShelleyLedgerEra era)
forall era. MIRCert -> ShelleyTxCert era
Ledger.ShelleyTxCertMir (MIRCert -> ShelleyTxCert (ShelleyLedgerEra era))
-> MIRCert -> ShelleyTxCert (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$
      MIRPot -> MIRTarget -> MIRCert
Ledger.MIRCert MIRPot
mirPot MIRTarget
mirTarget

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

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

data CommitteeHotKeyAuthorizationRequirements era where
  CommitteeHotKeyAuthorizationRequirements
    :: ConwayEraOnwards era
    -> Ledger.Credential Ledger.ColdCommitteeRole
    -> Ledger.Credential Ledger.HotCommitteeRole
    -> CommitteeHotKeyAuthorizationRequirements era

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

data CommitteeColdkeyResignationRequirements era where
  CommitteeColdkeyResignationRequirements
    :: ConwayEraOnwards era
    -> Ledger.Credential Ledger.ColdCommitteeRole
    -> Maybe Ledger.Anchor
    -> CommitteeColdkeyResignationRequirements era

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

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

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

makeStakeAddressAndDRepDelegationCertificate
  :: ()
  => ConwayEraOnwards era
  -> StakeCredential
  -> Ledger.Delegatee
  -> L.Coin
  -> Certificate era
makeStakeAddressAndDRepDelegationCertificate :: forall era.
ConwayEraOnwards era
-> StakeCredential -> Delegatee -> Coin -> Certificate era
makeStakeAddressAndDRepDelegationCertificate ConwayEraOnwards era
w StakeCredential
cred Delegatee
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.
Typeable 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
-> Delegatee -> Coin -> TxCert (ShelleyLedgerEra era)
forall era.
ConwayEraTxCert era =>
StakeCredential -> Delegatee -> Coin -> TxCert era
Ledger.mkRegDepositDelegTxCert (StakeCredential -> StakeCredential
toShelleyStakeCredential StakeCredential
cred) Delegatee
delegatee Coin
deposit

data DRepUpdateRequirements era where
  DRepUpdateRequirements
    :: ConwayEraOnwards era
    -> Ledger.Credential Ledger.DRepRole
    -> DRepUpdateRequirements era

makeDrepUpdateCertificate
  :: Typeable era
  => DRepUpdateRequirements era
  -> Maybe Ledger.Anchor
  -> Certificate era
makeDrepUpdateCertificate :: forall era.
Typeable era =>
DRepUpdateRequirements era -> Maybe Anchor -> Certificate era
makeDrepUpdateCertificate (DRepUpdateRequirements ConwayEraOnwards era
conwayOnwards Credential 'DRepRole
vcred) Maybe Anchor
mAnchor =
  ConwayEraOnwards era
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
forall era.
Typeable era =>
ConwayEraOnwards era
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
ConwayCertificate ConwayEraOnwards era
conwayOnwards
    (ConwayTxCert (ShelleyLedgerEra era) -> Certificate era)
-> (ConwayGovCert -> ConwayTxCert (ShelleyLedgerEra era))
-> ConwayGovCert
-> Certificate era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConwayGovCert -> ConwayTxCert (ShelleyLedgerEra era)
forall era. ConwayGovCert -> ConwayTxCert era
Ledger.ConwayTxCertGov
    (ConwayGovCert -> Certificate era)
-> ConwayGovCert -> Certificate era
forall a b. (a -> b) -> a -> b
$ Credential 'DRepRole -> StrictMaybe Anchor -> ConwayGovCert
Ledger.ConwayUpdateDRep Credential 'DRepRole
vcred (Maybe Anchor -> StrictMaybe Anchor
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Anchor
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)
forall era. EraTxCert era => TxCert era -> Maybe (KeyHash 'Witness)
Ledger.getVKeyWitnessTxCert TxCert (ShelleyLedgerEra era)
ledgerCert of
    Just KeyHash 'Witness
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 -> Hash StakeKey
StakeKeyHash (KeyHash 'Staking -> Hash StakeKey)
-> KeyHash 'Staking -> Hash StakeKey
forall a b. (a -> b) -> a -> b
$ KeyHash 'Witness -> KeyHash 'Staking
forall (r :: KeyRole) (r' :: KeyRole). KeyHash r -> KeyHash r'
forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
Ledger.coerceKeyRole KeyHash 'Witness
keyHash
    Maybe (KeyHash 'Witness)
Nothing ->
      ScriptHash -> StakeCredential
StakeCredentialByScript (ScriptHash -> StakeCredential)
-> (ScriptHash -> ScriptHash) -> ScriptHash -> StakeCredential
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash -> ScriptHash
fromShelleyScriptHash
        (ScriptHash -> StakeCredential)
-> Maybe ScriptHash -> Maybe StakeCredential
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxCert (ShelleyLedgerEra era) -> Maybe ScriptHash
forall era. EraTxCert era => TxCert era -> Maybe ScriptHash
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 -> StakeCredential)
-> Maybe StakeCredential -> 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 -> StakeCredential
fromShelleyStakeCredential (Maybe StakeCredential -> Maybe StakeCredential)
-> (Certificate era -> Maybe StakeCredential)
-> 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)
-> 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
$
      case ShelleyTxCert (ShelleyLedgerEra era)
shelleyCert of
        Ledger.RegTxCert StakeCredential
_ -> Maybe StakeCredential
forall a. Maybe a
Nothing
        Ledger.UnRegTxCert StakeCredential
cred -> StakeCredential -> Maybe StakeCredential
forall a. a -> Maybe a
Just StakeCredential
cred
        Ledger.DelegStakeTxCert StakeCredential
_ KeyHash 'StakePool
_ -> Maybe StakeCredential
forall a. Maybe a
Nothing
        Ledger.RegPoolTxCert PoolParams
_ -> Maybe StakeCredential
forall a. Maybe a
Nothing
        Ledger.RetirePoolTxCert KeyHash 'StakePool
_ EpochNo
_ -> Maybe StakeCredential
forall a. Maybe a
Nothing
        Ledger.MirTxCert MIRCert
_ -> Maybe StakeCredential
forall a. Maybe a
Nothing
        Ledger.GenesisDelegTxCert{} -> Maybe StakeCredential
forall a. Maybe a
Nothing
    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
$
      case ConwayTxCert (ShelleyLedgerEra era)
conwayCert of
        Ledger.RegPoolTxCert PoolParams
_ -> Maybe StakeCredential
forall a. Maybe a
Nothing
        Ledger.RetirePoolTxCert KeyHash 'StakePool
_ EpochNo
_ -> Maybe StakeCredential
forall a. Maybe a
Nothing
        Ledger.RegDepositTxCert StakeCredential
_ Coin
_ -> Maybe StakeCredential
forall a. Maybe a
Nothing
        Ledger.UnRegDepositTxCert StakeCredential
cred Coin
_ -> StakeCredential -> Maybe StakeCredential
forall a. a -> Maybe a
Just StakeCredential
cred
        Ledger.DelegTxCert StakeCredential
_ Delegatee
_ -> Maybe StakeCredential
forall a. Maybe a
Nothing
        Ledger.RegDepositDelegTxCert{} -> Maybe StakeCredential
forall a. Maybe a
Nothing
        Ledger.AuthCommitteeHotKeyTxCert{} -> Maybe StakeCredential
forall a. Maybe a
Nothing
        Ledger.ResignCommitteeColdTxCert{} -> Maybe StakeCredential
forall a. Maybe a
Nothing
        Ledger.RegDRepTxCert{} -> Maybe StakeCredential
forall a. Maybe a
Nothing
        Ledger.UnRegDRepTxCert{} -> Maybe StakeCredential
forall a. Maybe a
Nothing
        Ledger.UpdateDRepTxCert{} -> Maybe StakeCredential
forall a. Maybe a
Nothing
        -- those are old shelley patterns
        Ledger.RegTxCert StakeCredential
_ -> Maybe StakeCredential
forall a. Maybe a
Nothing
        -- stake cred deregistration w/o deposit
        Ledger.UnRegTxCert StakeCredential
cred -> StakeCredential -> Maybe StakeCredential
forall a. a -> Maybe a
Just StakeCredential
cred

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

toShelleyPoolParams :: StakePoolParameters -> Ledger.PoolParams
toShelleyPoolParams :: StakePoolParameters -> PoolParams
toShelleyPoolParams
  StakePoolParameters
    { stakePoolId :: StakePoolParameters -> PoolId
stakePoolId = StakePoolKeyHash KeyHash 'StakePool
poolkh
    , stakePoolVRF :: StakePoolParameters -> Hash VrfKey
stakePoolVRF = VrfKeyHash Hash HASH (VerKeyVRF (VRF 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
Ledger.ppId = KeyHash 'StakePool
poolkh
      , ppVrf :: VRFVerKeyHash 'StakePoolVRF
Ledger.ppVrf = Hash HASH (VerKeyVRF PraosVRF) -> VRFVerKeyHash 'StakePoolVRF
forall v (r :: KeyRoleVRF).
Hash HASH (VerKeyVRF v) -> VRFVerKeyHash r
Ledger.toVRFVerKeyHash Hash HASH (VerKeyVRF PraosVRF)
Hash HASH (VerKeyVRF (VRF 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
Ledger.ppRewardAccount = StakeAddress -> RewardAccount
toShelleyStakeAddr StakeAddress
stakePoolRewardAccount
      , ppOwners :: Set (KeyHash 'Staking)
Ledger.ppOwners =
          [Item (Set (KeyHash 'Staking))] -> Set (KeyHash 'Staking)
forall l. IsList l => [Item l] -> l
fromList
            [Item (Set (KeyHash 'Staking))
KeyHash 'Staking
kh | StakeKeyHash KeyHash 'Staking
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 HASH ByteString
mdh
        } =
        Ledger.PoolMetadata
          { pmUrl :: Url
Ledger.pmUrl = Text -> Url
toShelleyUrl Text
stakePoolMetadataURL
          , pmHash :: ByteString
Ledger.pmHash = Hash HASH ByteString -> ByteString
forall h a. Hash h a -> ByteString
Ledger.hashToBytes Hash HASH 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
  -> StakePoolParameters
fromShelleyPoolParams :: PoolParams -> StakePoolParameters
fromShelleyPoolParams
  Ledger.PoolParams
    { KeyHash 'StakePool
ppId :: PoolParams -> KeyHash 'StakePool
ppId :: KeyHash 'StakePool
Ledger.ppId
    , VRFVerKeyHash 'StakePoolVRF
ppVrf :: PoolParams -> VRFVerKeyHash 'StakePoolVRF
ppVrf :: VRFVerKeyHash 'StakePoolVRF
Ledger.ppVrf
    , Coin
ppPledge :: PoolParams -> Coin
ppPledge :: Coin
Ledger.ppPledge
    , Coin
ppCost :: PoolParams -> Coin
ppCost :: Coin
Ledger.ppCost
    , UnitInterval
ppMargin :: PoolParams -> UnitInterval
ppMargin :: UnitInterval
Ledger.ppMargin
    , RewardAccount
ppRewardAccount :: PoolParams -> RewardAccount
ppRewardAccount :: RewardAccount
Ledger.ppRewardAccount
    , Set (KeyHash 'Staking)
ppOwners :: PoolParams -> Set (KeyHash 'Staking)
ppOwners :: Set (KeyHash 'Staking)
Ledger.ppOwners
    , StrictSeq StakePoolRelay
ppRelays :: PoolParams -> StrictSeq StakePoolRelay
ppRelays :: StrictSeq StakePoolRelay
Ledger.ppRelays
    , StrictMaybe PoolMetadata
ppMetadata :: PoolParams -> StrictMaybe PoolMetadata
ppMetadata :: StrictMaybe PoolMetadata
Ledger.ppMetadata
    } =
    StakePoolParameters
      { stakePoolId :: PoolId
stakePoolId = KeyHash 'StakePool -> PoolId
StakePoolKeyHash KeyHash 'StakePool
ppId
      , stakePoolVRF :: Hash VrfKey
stakePoolVRF = Hash HASH (VerKeyVRF (VRF StandardCrypto)) -> Hash VrfKey
VrfKeyHash (VRFVerKeyHash 'StakePoolVRF -> Hash HASH (VerKeyVRF PraosVRF)
forall (r :: KeyRoleVRF) v.
VRFVerKeyHash r -> Hash HASH (VerKeyVRF v)
Ledger.fromVRFVerKeyHash VRFVerKeyHash 'StakePoolVRF
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 -> StakeAddress
fromShelleyStakeAddr RewardAccount
ppRewardAccount
      , stakePoolPledge :: Coin
stakePoolPledge = Coin
ppPledge
      , stakePoolOwners :: [Hash StakeKey]
stakePoolOwners = (KeyHash 'Staking -> Hash StakeKey)
-> [KeyHash 'Staking] -> [Hash StakeKey]
forall a b. (a -> b) -> [a] -> [b]
map KeyHash 'Staking -> Hash StakeKey
StakeKeyHash (Set (KeyHash 'Staking) -> [Item (Set (KeyHash 'Staking))]
forall l. IsList l => l -> [Item l]
toList Set (KeyHash 'Staking)
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 HASH ByteString -> Hash StakePoolMetadata
StakePoolMetadataHash
                (Hash HASH ByteString -> Hash StakePoolMetadata)
-> (ByteString -> Hash HASH ByteString)
-> ByteString
-> Hash StakePoolMetadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash HASH ByteString
-> Maybe (Hash HASH ByteString) -> Hash HASH ByteString
forall a. a -> Maybe a -> a
fromMaybe (String -> Hash HASH ByteString
forall a. HasCallStack => String -> a
error String
"fromShelleyPoolMetadata: invalid hash. TODO: proper validation")
                (Maybe (Hash HASH ByteString) -> Hash HASH ByteString)
-> (ByteString -> Maybe (Hash HASH ByteString))
-> ByteString
-> Hash HASH ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Hash HASH 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)
getAnchorDataFromCertificate :: forall era.
Certificate era
-> Either AnchorDataFromCertificateError (Maybe Anchor)
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))
-> Either AnchorDataFromCertificateError (Maybe Anchor)
forall era a.
ShelleyToBabbageEra era
-> (ShelleyToBabbageEraConstraints era => a) -> a
shelleyToBabbageEraConstraints ShelleyToBabbageEra era
stbe ((ShelleyToBabbageEraConstraints era =>
  Either AnchorDataFromCertificateError (Maybe Anchor))
 -> Either AnchorDataFromCertificateError (Maybe Anchor))
-> (ShelleyToBabbageEraConstraints era =>
    Either AnchorDataFromCertificateError (Maybe Anchor))
-> Either AnchorDataFromCertificateError (Maybe Anchor)
forall a b. (a -> b) -> a -> b
$
        case ShelleyTxCert (ShelleyLedgerEra era)
scert of
          Ledger.RegTxCert StakeCredential
_ -> Maybe Anchor
-> Either AnchorDataFromCertificateError (Maybe Anchor)
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Anchor
forall a. Maybe a
Nothing
          Ledger.UnRegTxCert StakeCredential
_ -> Maybe Anchor
-> Either AnchorDataFromCertificateError (Maybe Anchor)
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Anchor
forall a. Maybe a
Nothing
          Ledger.DelegStakeTxCert StakeCredential
_ KeyHash 'StakePool
_ -> Maybe Anchor
-> Either AnchorDataFromCertificateError (Maybe Anchor)
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Anchor
forall a. Maybe a
Nothing
          Ledger.RegPoolTxCert PoolParams
poolParams -> Either AnchorDataFromCertificateError (Maybe Anchor)
-> (PoolMetadata
    -> Either AnchorDataFromCertificateError (Maybe Anchor))
-> StrictMaybe PoolMetadata
-> Either AnchorDataFromCertificateError (Maybe Anchor)
forall a b. a -> (b -> a) -> StrictMaybe b -> a
strictMaybe (Maybe Anchor
-> Either AnchorDataFromCertificateError (Maybe Anchor)
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Anchor
forall a. Maybe a
Nothing) PoolMetadata
-> Either AnchorDataFromCertificateError (Maybe Anchor)
forall (m :: * -> *).
MonadError AnchorDataFromCertificateError m =>
PoolMetadata -> m (Maybe Anchor)
anchorDataFromPoolMetadata (StrictMaybe PoolMetadata
 -> Either AnchorDataFromCertificateError (Maybe Anchor))
-> StrictMaybe PoolMetadata
-> Either AnchorDataFromCertificateError (Maybe Anchor)
forall a b. (a -> b) -> a -> b
$ PoolParams -> StrictMaybe PoolMetadata
Ledger.ppMetadata PoolParams
poolParams
          Ledger.RetirePoolTxCert KeyHash 'StakePool
_ EpochNo
_ -> Maybe Anchor
-> Either AnchorDataFromCertificateError (Maybe Anchor)
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Anchor
forall a. Maybe a
Nothing
          Ledger.GenesisDelegTxCert{} -> Maybe Anchor
-> Either AnchorDataFromCertificateError (Maybe Anchor)
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Anchor
forall a. Maybe a
Nothing
          Ledger.MirTxCert MIRCert
_ -> Maybe Anchor
-> Either AnchorDataFromCertificateError (Maybe Anchor)
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Anchor
forall a. Maybe a
Nothing
    ConwayCertificate ConwayEraOnwards era
ceo ConwayTxCert (ShelleyLedgerEra era)
ccert ->
      ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era =>
    Either AnchorDataFromCertificateError (Maybe Anchor))
-> Either AnchorDataFromCertificateError (Maybe Anchor)
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
ceo ((ConwayEraOnwardsConstraints era =>
  Either AnchorDataFromCertificateError (Maybe Anchor))
 -> Either AnchorDataFromCertificateError (Maybe Anchor))
-> (ConwayEraOnwardsConstraints era =>
    Either AnchorDataFromCertificateError (Maybe Anchor))
-> Either AnchorDataFromCertificateError (Maybe Anchor)
forall a b. (a -> b) -> a -> b
$
        case ConwayTxCert (ShelleyLedgerEra era)
ccert of
          Ledger.RegTxCert StakeCredential
_ -> Maybe Anchor
-> Either AnchorDataFromCertificateError (Maybe Anchor)
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Anchor
forall a. Maybe a
Nothing
          Ledger.UnRegTxCert StakeCredential
_ -> Maybe Anchor
-> Either AnchorDataFromCertificateError (Maybe Anchor)
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Anchor
forall a. Maybe a
Nothing
          Ledger.RegDepositTxCert StakeCredential
_ Coin
_ -> Maybe Anchor
-> Either AnchorDataFromCertificateError (Maybe Anchor)
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Anchor
forall a. Maybe a
Nothing
          Ledger.UnRegDepositTxCert StakeCredential
_ Coin
_ -> Maybe Anchor
-> Either AnchorDataFromCertificateError (Maybe Anchor)
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Anchor
forall a. Maybe a
Nothing
          Ledger.RegDepositDelegTxCert{} -> Maybe Anchor
-> Either AnchorDataFromCertificateError (Maybe Anchor)
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Anchor
forall a. Maybe a
Nothing
          Ledger.DelegTxCert{} -> Maybe Anchor
-> Either AnchorDataFromCertificateError (Maybe Anchor)
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Anchor
forall a. Maybe a
Nothing
          Ledger.RegPoolTxCert PoolParams
poolParams -> Either AnchorDataFromCertificateError (Maybe Anchor)
-> (PoolMetadata
    -> Either AnchorDataFromCertificateError (Maybe Anchor))
-> StrictMaybe PoolMetadata
-> Either AnchorDataFromCertificateError (Maybe Anchor)
forall a b. a -> (b -> a) -> StrictMaybe b -> a
strictMaybe (Maybe Anchor
-> Either AnchorDataFromCertificateError (Maybe Anchor)
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Anchor
forall a. Maybe a
Nothing) PoolMetadata
-> Either AnchorDataFromCertificateError (Maybe Anchor)
forall (m :: * -> *).
MonadError AnchorDataFromCertificateError m =>
PoolMetadata -> m (Maybe Anchor)
anchorDataFromPoolMetadata (StrictMaybe PoolMetadata
 -> Either AnchorDataFromCertificateError (Maybe Anchor))
-> StrictMaybe PoolMetadata
-> Either AnchorDataFromCertificateError (Maybe Anchor)
forall a b. (a -> b) -> a -> b
$ PoolParams -> StrictMaybe PoolMetadata
Ledger.ppMetadata PoolParams
poolParams
          Ledger.RetirePoolTxCert KeyHash 'StakePool
_ EpochNo
_ -> Maybe Anchor
-> Either AnchorDataFromCertificateError (Maybe Anchor)
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Anchor
forall a. Maybe a
Nothing
          Ledger.RegDRepTxCert Credential 'DRepRole
_ Coin
_ StrictMaybe Anchor
mAnchor -> Maybe Anchor
-> Either AnchorDataFromCertificateError (Maybe Anchor)
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Anchor
 -> Either AnchorDataFromCertificateError (Maybe Anchor))
-> Maybe Anchor
-> Either AnchorDataFromCertificateError (Maybe Anchor)
forall a b. (a -> b) -> a -> b
$ StrictMaybe Anchor -> Maybe Anchor
forall a. StrictMaybe a -> Maybe a
Ledger.strictMaybeToMaybe StrictMaybe Anchor
mAnchor
          Ledger.UnRegDRepTxCert Credential 'DRepRole
_ Coin
_ -> Maybe Anchor
-> Either AnchorDataFromCertificateError (Maybe Anchor)
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Anchor
forall a. Maybe a
Nothing
          Ledger.UpdateDRepTxCert Credential 'DRepRole
_ StrictMaybe Anchor
mAnchor -> Maybe Anchor
-> Either AnchorDataFromCertificateError (Maybe Anchor)
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Anchor
 -> Either AnchorDataFromCertificateError (Maybe Anchor))
-> Maybe Anchor
-> Either AnchorDataFromCertificateError (Maybe Anchor)
forall a b. (a -> b) -> a -> b
$ StrictMaybe Anchor -> Maybe Anchor
forall a. StrictMaybe a -> Maybe a
Ledger.strictMaybeToMaybe StrictMaybe Anchor
mAnchor
          Ledger.AuthCommitteeHotKeyTxCert Credential 'ColdCommitteeRole
_ Credential 'HotCommitteeRole
_ -> Maybe Anchor
-> Either AnchorDataFromCertificateError (Maybe Anchor)
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Anchor
forall a. Maybe a
Nothing
          Ledger.ResignCommitteeColdTxCert Credential 'ColdCommitteeRole
_ StrictMaybe Anchor
mAnchor -> Maybe Anchor
-> Either AnchorDataFromCertificateError (Maybe Anchor)
forall a. a -> Either AnchorDataFromCertificateError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Anchor
 -> Either AnchorDataFromCertificateError (Maybe Anchor))
-> Maybe Anchor
-> Either AnchorDataFromCertificateError (Maybe Anchor)
forall a b. (a -> b) -> a -> b
$ StrictMaybe Anchor -> Maybe Anchor
forall a. StrictMaybe a -> Maybe a
Ledger.strictMaybeToMaybe StrictMaybe Anchor
mAnchor
 where
  anchorDataFromPoolMetadata
    :: MonadError AnchorDataFromCertificateError m
    => Ledger.PoolMetadata
    -> m (Maybe Ledger.Anchor)
  anchorDataFromPoolMetadata :: forall (m :: * -> *).
MonadError AnchorDataFromCertificateError m =>
PoolMetadata -> m (Maybe Anchor)
anchorDataFromPoolMetadata (Ledger.PoolMetadata{pmUrl :: PoolMetadata -> Url
Ledger.pmUrl = Url
url, pmHash :: PoolMetadata -> ByteString
Ledger.pmHash = ByteString
hashBytes}) = do
    Hash HASH AnchorData
hash <-
      m (Hash HASH AnchorData)
-> (Hash HASH AnchorData -> m (Hash HASH AnchorData))
-> Maybe (Hash HASH AnchorData)
-> m (Hash HASH AnchorData)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (AnchorDataFromCertificateError -> m (Hash HASH AnchorData)
forall a. AnchorDataFromCertificateError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (AnchorDataFromCertificateError -> m (Hash HASH AnchorData))
-> AnchorDataFromCertificateError -> m (Hash HASH AnchorData)
forall a b. (a -> b) -> a -> b
$ Url -> ByteString -> AnchorDataFromCertificateError
InvalidPoolMetadataHashError Url
url ByteString
hashBytes) Hash HASH AnchorData -> m (Hash HASH AnchorData)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Hash HASH AnchorData) -> m (Hash HASH AnchorData))
-> Maybe (Hash HASH AnchorData) -> m (Hash HASH AnchorData)
forall a b. (a -> b) -> a -> b
$
        ByteString -> Maybe (Hash HASH AnchorData)
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Ledger.hashFromBytes ByteString
hashBytes
    Maybe Anchor -> m (Maybe Anchor)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Anchor -> m (Maybe Anchor))
-> Maybe Anchor -> m (Maybe Anchor)
forall a b. (a -> b) -> a -> b
$
      Anchor -> Maybe Anchor
forall a. a -> Maybe a
Just
        ( Ledger.Anchor
            { anchorUrl :: Url
Ledger.anchorUrl = Url
url
            , anchorDataHash :: SafeHash AnchorData
Ledger.anchorDataHash = Hash HASH AnchorData -> SafeHash AnchorData
forall i. Hash HASH i -> SafeHash i
Ledger.unsafeMakeSafeHash Hash HASH 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