{-# 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.Array.Byte (ByteArray)
import Data.ByteString.Short qualified as SBS
import Data.MemPack.Buffer (byteArrayToShortByteString)
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
$
          Credential Staking -> Delegatee -> TxCert ConwayEra
forall era.
ConwayEraTxCert era =>
Credential Staking -> Delegatee -> TxCert era
Ledger.mkDelegTxCert (StakeCredential -> Credential Staking
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
$
          Credential Staking -> Delegatee -> TxCert DijkstraEra
forall era.
ConwayEraTxCert era =>
Credential Staking -> Delegatee -> TxCert era
Ledger.mkDelegTxCert (StakeCredential -> Credential Staking
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
$
      Credential Staking -> Coin -> TxCert (LedgerEra era)
forall era.
ConwayEraTxCert era =>
Credential Staking -> Coin -> TxCert era
Ledger.mkRegDepositTxCert (StakeCredential -> Credential Staking
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
$
      Credential Staking -> Coin -> TxCert (LedgerEra era)
forall era.
ConwayEraTxCert era =>
Credential Staking -> Coin -> TxCert era
Ledger.mkUnRegDepositTxCert (StakeCredential -> Credential Staking
toShelleyStakeCredential StakeCredential
scred) Coin
deposit

makeStakePoolRegistrationCertificate
  :: forall era
   . IsEra era
  => Ledger.StakePoolParams
  -> Certificate (LedgerEra era)
makeStakePoolRegistrationCertificate :: forall era.
IsEra era =>
StakePoolParams -> Certificate (LedgerEra era)
makeStakePoolRegistrationCertificate StakePoolParams
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
$
      StakePoolParams -> TxCert (LedgerEra era)
forall era. EraTxCert era => StakePoolParams -> TxCert era
Ledger.mkRegPoolTxCert StakePoolParams
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
$
      Credential Staking -> Delegatee -> Coin -> TxCert (LedgerEra era)
forall era.
ConwayEraTxCert era =>
Credential Staking -> Delegatee -> Coin -> TxCert era
Ledger.mkRegDepositDelegTxCert
        (StakeCredential -> Credential Staking
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 Credential Staking
_ -> 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 Credential Staking
_ -> 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 Credential Staking
_ 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 Credential Staking
_ 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 StakePoolParams
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
$ StakePoolParams -> StrictMaybe PoolMetadata
Ledger.sppMetadata StakePoolParams
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 Credential Staking
_ 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 Credential Staking
_ 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 StakePoolParams
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
$ StakePoolParams -> StrictMaybe PoolMetadata
Ledger.sppMetadata StakePoolParams
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 -> ByteArray
Ledger.pmHash = ByteArray
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 -> ByteArray -> AnchorDataFromCertificateError
InvalidPoolMetadataHashError Url
url ByteArray
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 -> Maybe (Hash HASH AnchorData))
-> ByteString -> Maybe (Hash HASH AnchorData)
forall a b. (a -> b) -> a -> b
$
        ShortByteString -> ByteString
SBS.fromShort (ShortByteString -> ByteString) -> ShortByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
          ByteArray -> ShortByteString
byteArrayToShortByteString ByteArray
hashBytes
  return $
    Just
      ( Ledger.Anchor
          { Ledger.anchorUrl = url
          , Ledger.anchorDataHash = Ledger.unsafeMakeSafeHash hash
          }
      )

data AnchorDataFromCertificateError
  = InvalidPoolMetadataHashError Ledger.Url ByteArray
  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 ByteArray
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 (ByteArray -> [Char]
forall a. Show a => a -> [Char]
show ByteArray
hash)