{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Cardano.Api.Experimental.Tx.Internal.Certificate
  ( Certificate (..)

    -- * Registering stake address and delegating
  , makeStakeAddressDelegationCertificate
  , makeStakeAddressRegistrationCertificate
  , makeStakeAddressUnregistrationCertificate

    -- * Registering stake pools
  , makeStakePoolRegistrationCertificate
  , makeStakePoolRetirementCertificate

    -- * Governance related certificates
  , makeCommitteeColdkeyResignationCertificate
  , makeCommitteeHotKeyAuthorizationCertificate
  , makeDrepRegistrationCertificate
  , makeDrepUnregistrationCertificate
  , makeDrepUpdateCertificate
  , makeStakeAddressAndDRepDelegationCertificate

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

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

import Cardano.Api.Address
import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra
import Cardano.Api.Error
import Cardano.Api.Experimental.Era
import Cardano.Api.Experimental.Tx.Internal.Certificate.Compatible (Delegatee)
import Cardano.Api.Experimental.Tx.Internal.Certificate.Type
import Cardano.Api.HasTypeProxy
import Cardano.Api.Hash qualified as Api
import Cardano.Api.Internal.Utils
import Cardano.Api.Key.Internal qualified as Api
import Cardano.Api.Ledger.Internal.Reexport qualified as Ledger
import Cardano.Api.Pretty
import Cardano.Api.Serialise.TextEnvelope.Internal

import Cardano.Ledger.BaseTypes (strictMaybe)

import Control.Monad.Except (MonadError (..))
import Data.ByteString (ByteString)
import Data.String (IsString (fromString))

makeStakeAddressDelegationCertificate
  :: forall era
   . IsEra era
  => StakeCredential
  -> Delegatee era
  -> Certificate (LedgerEra era)
makeStakeAddressDelegationCertificate :: forall era.
IsEra era =>
StakeCredential -> Delegatee era -> Certificate (LedgerEra era)
makeStakeAddressDelegationCertificate StakeCredential
sCred Delegatee era
delegatee =
  case forall era. IsEra era => Era era
useEra @era of
    e :: Era era
e@Era era
ConwayEra ->
      Era era
-> (EraCommonConstraints era => Certificate (LedgerEra era))
-> Certificate (LedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
e ((EraCommonConstraints era => Certificate (LedgerEra era))
 -> Certificate (LedgerEra era))
-> (EraCommonConstraints era => Certificate (LedgerEra era))
-> Certificate (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
        TxCert (LedgerEra era) -> Certificate (LedgerEra era)
forall era. EraTxCert era => TxCert era -> Certificate era
Certificate (TxCert (LedgerEra era) -> Certificate (LedgerEra era))
-> TxCert (LedgerEra era) -> Certificate (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
          StakeCredential -> Delegatee -> TxCert ConwayEra
forall era.
ConwayEraTxCert era =>
StakeCredential -> Delegatee -> TxCert era
Ledger.mkDelegTxCert (StakeCredential -> StakeCredential
toShelleyStakeCredential StakeCredential
sCred) Delegatee
Delegatee era
delegatee
    e :: Era era
e@Era era
DijkstraEra ->
      Era era
-> (EraCommonConstraints era => Certificate (LedgerEra era))
-> Certificate (LedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
e ((EraCommonConstraints era => Certificate (LedgerEra era))
 -> Certificate (LedgerEra era))
-> (EraCommonConstraints era => Certificate (LedgerEra era))
-> Certificate (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
        TxCert (LedgerEra era) -> Certificate (LedgerEra era)
forall era. EraTxCert era => TxCert era -> Certificate era
Certificate (TxCert (LedgerEra era) -> Certificate (LedgerEra era))
-> TxCert (LedgerEra era) -> Certificate (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
          StakeCredential -> Delegatee -> TxCert DijkstraEra
forall era.
ConwayEraTxCert era =>
StakeCredential -> Delegatee -> TxCert era
Ledger.mkDelegTxCert (StakeCredential -> StakeCredential
toShelleyStakeCredential StakeCredential
sCred) Delegatee
Delegatee era
delegatee

makeStakeAddressRegistrationCertificate
  :: forall era. IsEra era => StakeCredential -> Ledger.Coin -> Certificate (LedgerEra era)
makeStakeAddressRegistrationCertificate :: forall era.
IsEra era =>
StakeCredential -> Coin -> Certificate (LedgerEra era)
makeStakeAddressRegistrationCertificate StakeCredential
scred Coin
deposit =
  Era era
-> (EraCommonConstraints era => Certificate (LedgerEra era))
-> Certificate (LedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era) ((EraCommonConstraints era => Certificate (LedgerEra era))
 -> Certificate (LedgerEra era))
-> (EraCommonConstraints era => Certificate (LedgerEra era))
-> Certificate (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
    TxCert (LedgerEra era) -> Certificate (LedgerEra era)
forall era. EraTxCert era => TxCert era -> Certificate era
Certificate (TxCert (LedgerEra era) -> Certificate (LedgerEra era))
-> TxCert (LedgerEra era) -> Certificate (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
      StakeCredential -> Coin -> TxCert (LedgerEra era)
forall era.
ConwayEraTxCert era =>
StakeCredential -> Coin -> TxCert era
Ledger.mkRegDepositTxCert (StakeCredential -> StakeCredential
toShelleyStakeCredential StakeCredential
scred) Coin
deposit

makeStakeAddressUnregistrationCertificate
  :: forall era. IsEra era => StakeCredential -> Ledger.Coin -> Certificate (LedgerEra era)
makeStakeAddressUnregistrationCertificate :: forall era.
IsEra era =>
StakeCredential -> Coin -> Certificate (LedgerEra era)
makeStakeAddressUnregistrationCertificate StakeCredential
scred Coin
deposit =
  Era era
-> (EraCommonConstraints era => Certificate (LedgerEra era))
-> Certificate (LedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era) ((EraCommonConstraints era => Certificate (LedgerEra era))
 -> Certificate (LedgerEra era))
-> (EraCommonConstraints era => Certificate (LedgerEra era))
-> Certificate (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
    TxCert (LedgerEra era) -> Certificate (LedgerEra era)
forall era. EraTxCert era => TxCert era -> Certificate era
Certificate (TxCert (LedgerEra era) -> Certificate (LedgerEra era))
-> TxCert (LedgerEra era) -> Certificate (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
      StakeCredential -> Coin -> TxCert (LedgerEra era)
forall era.
ConwayEraTxCert era =>
StakeCredential -> Coin -> TxCert era
Ledger.mkUnRegDepositTxCert (StakeCredential -> StakeCredential
toShelleyStakeCredential StakeCredential
scred) Coin
deposit

makeStakePoolRegistrationCertificate
  :: forall era
   . IsEra era
  => Ledger.PoolParams
  -> Certificate (LedgerEra era)
makeStakePoolRegistrationCertificate :: forall era. IsEra era => PoolParams -> Certificate (LedgerEra era)
makeStakePoolRegistrationCertificate PoolParams
poolParams =
  Era era
-> (EraCommonConstraints era => Certificate (LedgerEra era))
-> Certificate (LedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era) ((EraCommonConstraints era => Certificate (LedgerEra era))
 -> Certificate (LedgerEra era))
-> (EraCommonConstraints era => Certificate (LedgerEra era))
-> Certificate (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
    TxCert (LedgerEra era) -> Certificate (LedgerEra era)
forall era. EraTxCert era => TxCert era -> Certificate era
Certificate (TxCert (LedgerEra era) -> Certificate (LedgerEra era))
-> TxCert (LedgerEra era) -> Certificate (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
      PoolParams -> TxCert (LedgerEra era)
forall era. EraTxCert era => PoolParams -> TxCert era
Ledger.mkRegPoolTxCert PoolParams
poolParams

makeStakePoolRetirementCertificate
  :: forall era
   . IsShelleyBasedEra era
  => Api.Hash Api.StakePoolKey
  -> Ledger.EpochNo
  -> Certificate (ShelleyLedgerEra era)
makeStakePoolRetirementCertificate :: forall era.
IsShelleyBasedEra era =>
Hash StakePoolKey -> EpochNo -> Certificate (ShelleyLedgerEra era)
makeStakePoolRetirementCertificate Hash StakePoolKey
poolId EpochNo
retirementEpoch =
  ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    Certificate (ShelleyLedgerEra era))
-> Certificate (ShelleyLedgerEra era)
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints (forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra @era) ((ShelleyBasedEraConstraints era =>
  Certificate (ShelleyLedgerEra era))
 -> Certificate (ShelleyLedgerEra era))
-> (ShelleyBasedEraConstraints era =>
    Certificate (ShelleyLedgerEra era))
-> Certificate (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$
    TxCert (ShelleyLedgerEra era) -> Certificate (ShelleyLedgerEra era)
forall era. EraTxCert era => TxCert era -> Certificate era
Certificate (TxCert (ShelleyLedgerEra era)
 -> Certificate (ShelleyLedgerEra era))
-> TxCert (ShelleyLedgerEra era)
-> Certificate (ShelleyLedgerEra 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 (Hash StakePoolKey -> KeyHash 'StakePool
Api.unStakePoolKeyHash Hash StakePoolKey
poolId) EpochNo
retirementEpoch

makeCommitteeColdkeyResignationCertificate
  :: forall era
   . IsEra era
  => Ledger.Credential Ledger.ColdCommitteeRole
  -> Maybe Ledger.Anchor
  -> Certificate (LedgerEra era)
makeCommitteeColdkeyResignationCertificate :: forall era.
IsEra era =>
Credential 'ColdCommitteeRole
-> Maybe Anchor -> Certificate (LedgerEra era)
makeCommitteeColdkeyResignationCertificate Credential 'ColdCommitteeRole
coldKeyCred Maybe Anchor
anchor =
  Era era
-> (EraCommonConstraints era => Certificate (LedgerEra era))
-> Certificate (LedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era) ((EraCommonConstraints era => Certificate (LedgerEra era))
 -> Certificate (LedgerEra era))
-> (EraCommonConstraints era => Certificate (LedgerEra era))
-> Certificate (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
    TxCert (LedgerEra era) -> Certificate (LedgerEra era)
forall era. EraTxCert era => TxCert era -> Certificate era
Certificate (TxCert (LedgerEra era) -> Certificate (LedgerEra era))
-> TxCert (LedgerEra era) -> Certificate (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
      Credential 'ColdCommitteeRole
-> StrictMaybe Anchor -> TxCert (LedgerEra era)
forall era.
ConwayEraTxCert era =>
Credential 'ColdCommitteeRole -> StrictMaybe Anchor -> TxCert era
Ledger.mkResignCommitteeColdTxCert
        Credential 'ColdCommitteeRole
coldKeyCred
        (Maybe Anchor -> StrictMaybe Anchor
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Anchor
anchor)

makeCommitteeHotKeyAuthorizationCertificate
  :: forall era
   . IsEra era
  => Ledger.Credential Ledger.ColdCommitteeRole
  -> Ledger.Credential Ledger.HotCommitteeRole
  -> Certificate (LedgerEra era)
makeCommitteeHotKeyAuthorizationCertificate :: forall era.
IsEra era =>
Credential 'ColdCommitteeRole
-> Credential 'HotCommitteeRole -> Certificate (LedgerEra era)
makeCommitteeHotKeyAuthorizationCertificate Credential 'ColdCommitteeRole
coldKeyCredential Credential 'HotCommitteeRole
hotKeyCredential =
  Era era
-> (EraCommonConstraints era => Certificate (LedgerEra era))
-> Certificate (LedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era) ((EraCommonConstraints era => Certificate (LedgerEra era))
 -> Certificate (LedgerEra era))
-> (EraCommonConstraints era => Certificate (LedgerEra era))
-> Certificate (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
    TxCert (LedgerEra era) -> Certificate (LedgerEra era)
forall era. EraTxCert era => TxCert era -> Certificate era
Certificate (TxCert (LedgerEra era) -> Certificate (LedgerEra era))
-> TxCert (LedgerEra era) -> Certificate (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
      Credential 'ColdCommitteeRole
-> Credential 'HotCommitteeRole -> TxCert (LedgerEra era)
forall era.
ConwayEraTxCert era =>
Credential 'ColdCommitteeRole
-> Credential 'HotCommitteeRole -> TxCert era
Ledger.mkAuthCommitteeHotKeyTxCert Credential 'ColdCommitteeRole
coldKeyCredential Credential 'HotCommitteeRole
hotKeyCredential

makeDrepRegistrationCertificate
  :: forall era
   . IsEra era
  => Ledger.Credential Ledger.DRepRole
  -> Ledger.Coin
  -> Maybe Ledger.Anchor
  -> Certificate (LedgerEra era)
makeDrepRegistrationCertificate :: forall era.
IsEra era =>
Credential 'DRepRole
-> Coin -> Maybe Anchor -> Certificate (LedgerEra era)
makeDrepRegistrationCertificate Credential 'DRepRole
vcred Coin
deposit Maybe Anchor
anchor =
  Era era
-> (EraCommonConstraints era => Certificate (LedgerEra era))
-> Certificate (LedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era) ((EraCommonConstraints era => Certificate (LedgerEra era))
 -> Certificate (LedgerEra era))
-> (EraCommonConstraints era => Certificate (LedgerEra era))
-> Certificate (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
    TxCert (LedgerEra era) -> Certificate (LedgerEra era)
forall era. EraTxCert era => TxCert era -> Certificate era
Certificate (TxCert (LedgerEra era) -> Certificate (LedgerEra era))
-> TxCert (LedgerEra era) -> Certificate (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
      Credential 'DRepRole
-> Coin -> StrictMaybe Anchor -> TxCert (LedgerEra era)
forall era.
ConwayEraTxCert era =>
Credential 'DRepRole -> Coin -> StrictMaybe Anchor -> TxCert era
Ledger.mkRegDRepTxCert Credential 'DRepRole
vcred Coin
deposit (Maybe Anchor -> StrictMaybe Anchor
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Anchor
anchor)

makeDrepUnregistrationCertificate
  :: forall era
   . IsEra era
  => Ledger.Credential Ledger.DRepRole
  -> Ledger.Coin
  -> Certificate (LedgerEra era)
makeDrepUnregistrationCertificate :: forall era.
IsEra era =>
Credential 'DRepRole -> Coin -> Certificate (LedgerEra era)
makeDrepUnregistrationCertificate Credential 'DRepRole
vcred Coin
deposit =
  Era era
-> (EraCommonConstraints era => Certificate (LedgerEra era))
-> Certificate (LedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era) ((EraCommonConstraints era => Certificate (LedgerEra era))
 -> Certificate (LedgerEra era))
-> (EraCommonConstraints era => Certificate (LedgerEra era))
-> Certificate (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
    TxCert (LedgerEra era) -> Certificate (LedgerEra era)
forall era. EraTxCert era => TxCert era -> Certificate era
Certificate (TxCert (LedgerEra era) -> Certificate (LedgerEra era))
-> TxCert (LedgerEra era) -> Certificate (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
      Credential 'DRepRole -> Coin -> TxCert (LedgerEra era)
forall era.
ConwayEraTxCert era =>
Credential 'DRepRole -> Coin -> TxCert era
Ledger.mkUnRegDRepTxCert
        Credential 'DRepRole
vcred
        Coin
deposit

makeDrepUpdateCertificate
  :: forall era
   . IsEra era
  => Ledger.Credential Ledger.DRepRole
  -> Maybe Ledger.Anchor
  -> Certificate (LedgerEra era)
makeDrepUpdateCertificate :: forall era.
IsEra era =>
Credential 'DRepRole -> Maybe Anchor -> Certificate (LedgerEra era)
makeDrepUpdateCertificate Credential 'DRepRole
vcred Maybe Anchor
mAnchor =
  Era era
-> (EraCommonConstraints era => Certificate (LedgerEra era))
-> Certificate (LedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era) ((EraCommonConstraints era => Certificate (LedgerEra era))
 -> Certificate (LedgerEra era))
-> (EraCommonConstraints era => Certificate (LedgerEra era))
-> Certificate (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
    TxCert (LedgerEra era) -> Certificate (LedgerEra era)
forall era. EraTxCert era => TxCert era -> Certificate era
Certificate (TxCert (LedgerEra era) -> Certificate (LedgerEra era))
-> TxCert (LedgerEra era) -> Certificate (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
      Credential 'DRepRole
-> StrictMaybe Anchor -> TxCert (LedgerEra era)
forall era.
ConwayEraTxCert era =>
Credential 'DRepRole -> StrictMaybe Anchor -> TxCert era
Ledger.mkUpdateDRepTxCert Credential 'DRepRole
vcred (Maybe Anchor -> StrictMaybe Anchor
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Anchor
mAnchor)

makeStakeAddressAndDRepDelegationCertificate
  :: forall era
   . IsEra era
  => StakeCredential
  -> Ledger.Delegatee
  -> Ledger.Coin
  -> Certificate (LedgerEra era)
makeStakeAddressAndDRepDelegationCertificate :: forall era.
IsEra era =>
StakeCredential -> Delegatee -> Coin -> Certificate (LedgerEra era)
makeStakeAddressAndDRepDelegationCertificate StakeCredential
cred Delegatee
delegatee Coin
deposit =
  Era era
-> (EraCommonConstraints era => Certificate (LedgerEra era))
-> Certificate (LedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era) ((EraCommonConstraints era => Certificate (LedgerEra era))
 -> Certificate (LedgerEra era))
-> (EraCommonConstraints era => Certificate (LedgerEra era))
-> Certificate (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
    TxCert (LedgerEra era) -> Certificate (LedgerEra era)
forall era. EraTxCert era => TxCert era -> Certificate era
Certificate (TxCert (LedgerEra era) -> Certificate (LedgerEra era))
-> TxCert (LedgerEra era) -> Certificate (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
      StakeCredential -> Delegatee -> Coin -> TxCert (LedgerEra era)
forall era.
ConwayEraTxCert era =>
StakeCredential -> Delegatee -> Coin -> TxCert era
Ledger.mkRegDepositDelegTxCert
        (StakeCredential -> StakeCredential
toShelleyStakeCredential StakeCredential
cred)
        Delegatee
delegatee
        Coin
deposit

-- -------------------------------------

getAnchorDataFromCertificate
  :: Era era
  -> Certificate (LedgerEra era)
  -> Either AnchorDataFromCertificateError (Maybe Ledger.Anchor)
getAnchorDataFromCertificate :: forall era.
Era era
-> Certificate (LedgerEra era)
-> Either AnchorDataFromCertificateError (Maybe Anchor)
getAnchorDataFromCertificate Era era
ConwayEra (Certificate TxCert (LedgerEra era)
c) =
  case TxCert (LedgerEra era)
c 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
    TxCert (LedgerEra era)
_ -> [Char] -> Either AnchorDataFromCertificateError (Maybe Anchor)
forall a. HasCallStack => [Char] -> a
error [Char]
"getAnchorDataFromCertificate: Unrecognized cert"
getAnchorDataFromCertificate Era era
DijkstraEra (Certificate TxCert (LedgerEra era)
c) =
  case TxCert (LedgerEra era)
c of
    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
    TxCert (LedgerEra era)
_ -> [Char] -> Either AnchorDataFromCertificateError (Maybe Anchor)
forall a. HasCallStack => [Char] -> a
error [Char]
"getAnchorDataFromCertificate: Unrecognized cert"

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 <-
    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
  return $
    Just
      ( Ledger.Anchor
          { Ledger.anchorUrl = url
          , Ledger.anchorDataHash = Ledger.unsafeMakeSafeHash hash
          }
      )

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 -> [Char]
(Int -> AnchorDataFromCertificateError -> ShowS)
-> (AnchorDataFromCertificateError -> [Char])
-> ([AnchorDataFromCertificateError] -> ShowS)
-> Show AnchorDataFromCertificateError
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AnchorDataFromCertificateError -> ShowS
showsPrec :: Int -> AnchorDataFromCertificateError -> ShowS
$cshow :: AnchorDataFromCertificateError -> [Char]
show :: AnchorDataFromCertificateError -> [Char]
$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
<> Url -> Doc ann
forall ann. Url -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty 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
<> [Char] -> Doc ann
forall a. IsString a => [Char] -> a
fromString (ByteString -> [Char]
forall a. Show a => a -> [Char]
show ByteString
hash)