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

module Cardano.Api.Experimental.Tx.Internal.Certificate.Compatible
  ( Delegatee

    -- * Registering stake address and delegating
  , makeStakeAddressDelegationCertificate
  , makeStakeAddressRegistrationCertificate
  , makeStakeAddressUnregistrationCertificate
  , StakeCredentialAndDeposit (..)
  , StakeRegistrationRequirements

    -- * Registering stake pools
  , makeStakePoolRegistrationCertificate
  , makeStakePoolRetirementCertificate

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

    -- * Internal
  , getTxCertWitness
  )
where

import Cardano.Api.Address
import Cardano.Api.Era.Internal.Core
import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra
import Cardano.Api.Experimental.Tx.Internal.Certificate.Type
import Cardano.Api.Hash qualified as Api
import Cardano.Api.Key.Internal qualified as Api
import Cardano.Api.Key.Internal.Praos qualified as Api
import Cardano.Api.Ledger.Internal.Reexport qualified as Ledger
import Cardano.Api.Plutus.Internal.Script

import Cardano.Ledger.Keys qualified as Ledger

type family Delegatee era where
  Delegatee DijkstraEra = Ledger.Delegatee
  Delegatee ConwayEra = Ledger.Delegatee
  Delegatee BabbageEra = Api.Hash Api.StakePoolKey
  Delegatee AlonzoEra = Api.Hash Api.StakePoolKey
  Delegatee MaryEra = Api.Hash Api.StakePoolKey
  Delegatee AllegraEra = Api.Hash Api.StakePoolKey
  Delegatee ShelleyEra = Api.Hash Api.StakePoolKey

makeStakeAddressDelegationCertificate
  :: forall era
   . IsShelleyBasedEra era
  => StakeCredential
  -> Delegatee era
  -> Certificate (ShelleyLedgerEra era)
makeStakeAddressDelegationCertificate :: forall era.
IsShelleyBasedEra era =>
StakeCredential
-> Delegatee era -> Certificate (ShelleyLedgerEra era)
makeStakeAddressDelegationCertificate StakeCredential
sCred Delegatee era
delegatee =
  case forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra @era of
    ShelleyBasedEra era
ShelleyBasedEraConway ->
      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
$
        StakeCredential -> Delegatee -> TxCert ConwayEra
forall era.
ConwayEraTxCert era =>
StakeCredential -> Delegatee -> TxCert era
Ledger.mkDelegTxCert (StakeCredential -> StakeCredential
toShelleyStakeCredential StakeCredential
sCred) Delegatee
Delegatee era
delegatee
    e :: ShelleyBasedEra era
e@ShelleyBasedEra era
ShelleyBasedEraBabbage -> (Delegatee era ~ Hash StakePoolKey) =>
ShelleyBasedEra era
-> Delegatee era -> Certificate (ShelleyLedgerEra era)
ShelleyBasedEra era
-> Delegatee era -> Certificate (ShelleyLedgerEra era)
cert ShelleyBasedEra era
e Delegatee era
delegatee
    e :: ShelleyBasedEra era
e@ShelleyBasedEra era
ShelleyBasedEraAlonzo -> (Delegatee era ~ Hash StakePoolKey) =>
ShelleyBasedEra era
-> Delegatee era -> Certificate (ShelleyLedgerEra era)
ShelleyBasedEra era
-> Delegatee era -> Certificate (ShelleyLedgerEra era)
cert ShelleyBasedEra era
e Delegatee era
delegatee
    e :: ShelleyBasedEra era
e@ShelleyBasedEra era
ShelleyBasedEraMary -> (Delegatee era ~ Hash StakePoolKey) =>
ShelleyBasedEra era
-> Delegatee era -> Certificate (ShelleyLedgerEra era)
ShelleyBasedEra era
-> Delegatee era -> Certificate (ShelleyLedgerEra era)
cert ShelleyBasedEra era
e Delegatee era
delegatee
    e :: ShelleyBasedEra era
e@ShelleyBasedEra era
ShelleyBasedEraAllegra -> (Delegatee era ~ Hash StakePoolKey) =>
ShelleyBasedEra era
-> Delegatee era -> Certificate (ShelleyLedgerEra era)
ShelleyBasedEra era
-> Delegatee era -> Certificate (ShelleyLedgerEra era)
cert ShelleyBasedEra era
e Delegatee era
delegatee
    e :: ShelleyBasedEra era
e@ShelleyBasedEra era
ShelleyBasedEraShelley -> (Delegatee era ~ Hash StakePoolKey) =>
ShelleyBasedEra era
-> Delegatee era -> Certificate (ShelleyLedgerEra era)
ShelleyBasedEra era
-> Delegatee era -> Certificate (ShelleyLedgerEra era)
cert ShelleyBasedEra era
e Delegatee era
delegatee
    ShelleyBasedEra era
ShelleyBasedEraDijkstra -> [Char] -> Certificate DijkstraEra
forall a. HasCallStack => [Char] -> a
error [Char]
"TODO: makeStakeAddressDelegationCertificate DijkstraEra"
 where
  cert
    :: Delegatee era ~ Api.Hash Api.StakePoolKey
    => ShelleyBasedEra era -> Delegatee era -> Certificate (ShelleyLedgerEra era)
  cert :: (Delegatee era ~ Hash StakePoolKey) =>
ShelleyBasedEra era
-> Delegatee era -> Certificate (ShelleyLedgerEra era)
cert ShelleyBasedEra era
e Delegatee era
delegatee' =
    ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    Certificate (ShelleyLedgerEra era))
-> Certificate (ShelleyLedgerEra era)
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
e ((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
$
        StakeCredential
-> KeyHash 'StakePool -> TxCert (ShelleyLedgerEra era)
forall era.
ShelleyEraTxCert era =>
StakeCredential -> KeyHash 'StakePool -> TxCert era
Ledger.mkDelegStakeTxCert (StakeCredential -> StakeCredential
toShelleyStakeCredential StakeCredential
sCred) (Hash StakePoolKey -> KeyHash 'StakePool
Api.unStakePoolKeyHash Hash StakePoolKey
Delegatee era
delegatee')

data StakeCredentialAndDeposit = StakeCredentialAndDeposit StakeCredential Ledger.Coin

type family StakeRegistrationRequirements era where
  StakeRegistrationRequirements DijkstraEra = StakeCredentialAndDeposit
  StakeRegistrationRequirements ConwayEra = StakeCredentialAndDeposit
  StakeRegistrationRequirements BabbageEra = StakeCredential
  StakeRegistrationRequirements AlonzoEra = StakeCredential
  StakeRegistrationRequirements MaryEra = StakeCredential
  StakeRegistrationRequirements AllegraEra = StakeCredential
  StakeRegistrationRequirements ShelleyEra = StakeCredential

makeStakeAddressRegistrationCertificate
  :: forall era
   . IsShelleyBasedEra era
  => StakeRegistrationRequirements era
  -> Certificate (ShelleyLedgerEra era)
makeStakeAddressRegistrationCertificate :: forall era.
IsShelleyBasedEra era =>
StakeRegistrationRequirements era
-> Certificate (ShelleyLedgerEra era)
makeStakeAddressRegistrationCertificate StakeRegistrationRequirements era
scred =
  case forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra @era of
    ShelleyBasedEra era
ShelleyBasedEraDijkstra ->
      StakeCredentialAndDeposit -> Certificate DijkstraEra
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ConwayEraTxCert era) =>
StakeCredentialAndDeposit -> Certificate era
createRegCertWithDeposit StakeCredentialAndDeposit
StakeRegistrationRequirements era
scred
    ShelleyBasedEra era
ShelleyBasedEraConway ->
      StakeCredentialAndDeposit -> Certificate ConwayEra
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ConwayEraTxCert era) =>
StakeCredentialAndDeposit -> Certificate era
createRegCertWithDeposit StakeCredentialAndDeposit
StakeRegistrationRequirements era
scred
    ShelleyBasedEra era
ShelleyBasedEraBabbage ->
      StakeCredential -> Certificate BabbageEra
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ShelleyEraTxCert era) =>
StakeCredential -> Certificate era
createRegCertNoDeposit StakeCredential
StakeRegistrationRequirements era
scred
    ShelleyBasedEra era
ShelleyBasedEraAlonzo ->
      StakeCredential -> Certificate AlonzoEra
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ShelleyEraTxCert era) =>
StakeCredential -> Certificate era
createRegCertNoDeposit StakeCredential
StakeRegistrationRequirements era
scred
    ShelleyBasedEra era
ShelleyBasedEraMary ->
      StakeCredential -> Certificate MaryEra
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ShelleyEraTxCert era) =>
StakeCredential -> Certificate era
createRegCertNoDeposit StakeCredential
StakeRegistrationRequirements era
scred
    ShelleyBasedEra era
ShelleyBasedEraAllegra ->
      StakeCredential -> Certificate AllegraEra
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ShelleyEraTxCert era) =>
StakeCredential -> Certificate era
createRegCertNoDeposit StakeCredential
StakeRegistrationRequirements era
scred
    ShelleyBasedEra era
ShelleyBasedEraShelley ->
      StakeCredential -> Certificate ShelleyEra
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ShelleyEraTxCert era) =>
StakeCredential -> Certificate era
createRegCertNoDeposit StakeCredential
StakeRegistrationRequirements era
scred
 where
  createRegCertWithDeposit :: StakeCredentialAndDeposit -> Certificate era
createRegCertWithDeposit StakeCredentialAndDeposit
stakeCredWithDeposit =
    let StakeCredentialAndDeposit StakeCredential
cred Coin
dep = StakeCredentialAndDeposit
stakeCredWithDeposit
     in TxCert era -> Certificate era
forall era. EraTxCert era => TxCert era -> Certificate era
Certificate (TxCert era -> Certificate era) -> TxCert era -> Certificate era
forall a b. (a -> b) -> a -> b
$
          StakeCredential -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
StakeCredential -> Coin -> TxCert era
Ledger.mkRegDepositTxCert (StakeCredential -> StakeCredential
toShelleyStakeCredential StakeCredential
cred) Coin
dep
  createRegCertNoDeposit :: StakeCredential -> Certificate era
createRegCertNoDeposit StakeCredential
stakeCredential =
    TxCert era -> Certificate era
forall era. EraTxCert era => TxCert era -> Certificate era
Certificate (TxCert era -> Certificate era) -> TxCert era -> Certificate era
forall a b. (a -> b) -> a -> b
$
      StakeCredential -> TxCert era
forall era. ShelleyEraTxCert era => StakeCredential -> TxCert era
Ledger.mkRegTxCert (StakeCredential -> TxCert era) -> StakeCredential -> TxCert era
forall a b. (a -> b) -> a -> b
$
        StakeCredential -> StakeCredential
toShelleyStakeCredential StakeCredential
stakeCredential

makeStakeAddressUnregistrationCertificate
  :: forall era
   . IsShelleyBasedEra era
  => StakeCredential -> Certificate (ShelleyLedgerEra era)
makeStakeAddressUnregistrationCertificate :: forall era.
IsShelleyBasedEra era =>
StakeCredential -> Certificate (ShelleyLedgerEra era)
makeStakeAddressUnregistrationCertificate StakeCredential
scred =
  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
$
      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

makeStakePoolRegistrationCertificate
  :: forall era
   . IsShelleyBasedEra era
  => Ledger.PoolParams
  -> Certificate (ShelleyLedgerEra era)
makeStakePoolRegistrationCertificate :: forall era.
IsShelleyBasedEra era =>
PoolParams -> Certificate (ShelleyLedgerEra era)
makeStakePoolRegistrationCertificate PoolParams
poolParams =
  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
$
      PoolParams -> TxCert (ShelleyLedgerEra 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

-- This is only used by QA and only exists up until the Babbage era.
-- The serialization does not change from Shelley -> Babbage therefore
-- we hardcode the Babbage era here to simplify the type signature.
makeMIRCertificate
  :: Ledger.MIRPot
  -> Ledger.MIRTarget
  -> Certificate (ShelleyLedgerEra BabbageEra)
makeMIRCertificate :: MIRPot -> MIRTarget -> Certificate (ShelleyLedgerEra BabbageEra)
makeMIRCertificate MIRPot
mirPot MIRTarget
mirTarget =
  TxCert (ShelleyLedgerEra BabbageEra)
-> Certificate (ShelleyLedgerEra BabbageEra)
forall era. EraTxCert era => TxCert era -> Certificate era
Certificate (TxCert (ShelleyLedgerEra BabbageEra)
 -> Certificate (ShelleyLedgerEra BabbageEra))
-> TxCert (ShelleyLedgerEra BabbageEra)
-> Certificate (ShelleyLedgerEra BabbageEra)
forall a b. (a -> b) -> a -> b
$
    MIRCert -> ShelleyTxCert BabbageEra
forall era. MIRCert -> ShelleyTxCert era
Ledger.ShelleyTxCertMir (MIRCert -> ShelleyTxCert BabbageEra)
-> MIRCert -> ShelleyTxCert BabbageEra
forall a b. (a -> b) -> a -> b
$
      MIRPot -> MIRTarget -> MIRCert
Ledger.MIRCert MIRPot
mirPot MIRTarget
mirTarget

-- This is only used by QA and only exists up until the Babbage era.
-- The serialization does not change from Shelley -> Babbage therefore
-- we hardcode the Babbage era here to simplify the type signature.
makeGenesisKeyDelegationCertificate
  :: Api.Hash Api.GenesisKey
  -> Api.Hash Api.GenesisDelegateKey
  -> Api.Hash Api.VrfKey
  -> Certificate (ShelleyLedgerEra BabbageEra)
makeGenesisKeyDelegationCertificate :: Hash GenesisKey
-> Hash GenesisDelegateKey
-> Hash VrfKey
-> Certificate (ShelleyLedgerEra BabbageEra)
makeGenesisKeyDelegationCertificate
  (Api.GenesisKeyHash KeyHash 'Genesis
hGenKey)
  (Api.GenesisDelegateKeyHash KeyHash 'GenesisDelegate
hGenDelegKey)
  (Api.VrfKeyHash Hash HASH (VerKeyVRF (VRF StandardCrypto))
hVrfKey) =
    TxCert (ShelleyLedgerEra BabbageEra)
-> Certificate (ShelleyLedgerEra BabbageEra)
forall era. EraTxCert era => TxCert era -> Certificate era
Certificate (TxCert (ShelleyLedgerEra BabbageEra)
 -> Certificate (ShelleyLedgerEra BabbageEra))
-> TxCert (ShelleyLedgerEra BabbageEra)
-> Certificate (ShelleyLedgerEra BabbageEra)
forall a b. (a -> b) -> a -> b
$
      GenesisDelegCert -> TxCert BabbageEra
forall era.
(ShelleyEraTxCert era, AtMostEra "Babbage" era) =>
GenesisDelegCert -> TxCert era
Ledger.mkGenesisDelegTxCert (GenesisDelegCert -> TxCert BabbageEra)
-> GenesisDelegCert -> TxCert BabbageEra
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)

-- | 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
  :: IsShelleyBasedEra era
  => Certificate (ShelleyLedgerEra era)
  -> Maybe StakeCredential
selectStakeCredentialWitness :: forall era.
IsShelleyBasedEra era =>
Certificate (ShelleyLedgerEra era) -> Maybe StakeCredential
selectStakeCredentialWitness (Certificate TxCert (ShelleyLedgerEra era)
cert) =
  ShelleyBasedEra era
-> TxCert (ShelleyLedgerEra era) -> Maybe StakeCredential
forall era.
ShelleyBasedEra era
-> TxCert (ShelleyLedgerEra era) -> Maybe StakeCredential
getTxCertWitness ShelleyBasedEra era
forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra TxCert (ShelleyLedgerEra era)
cert

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
Api.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