{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Conway.TxCert (
  ConwayTxCert (..),
  ConwayTxCertUpgradeError (..),
  ConwayDelegCert (..),
  ConwayGovCert (..),
  Delegatee (..),
  ConwayEraTxCert (..),
  fromShelleyDelegCert,
  toShelleyDelegCert,
  getScriptWitnessConwayTxCert,
  getVKeyWitnessConwayTxCert,
  getDelegateeTxCert,
  getStakePoolDelegatee,
  getVoteDelegatee,
  conwayDRepDepositsTxCerts,
  conwayDRepRefundsTxCerts,
  conwayTotalDepositsTxCerts,
  conwayTotalRefundsTxCerts,
  pattern RegDepositTxCert,
  pattern UnRegDepositTxCert,
  pattern DelegTxCert,
  pattern RegDepositDelegTxCert,
  pattern AuthCommitteeHotKeyTxCert,
  pattern ResignCommitteeColdTxCert,
  pattern RegDRepTxCert,
  pattern UnRegDRepTxCert,
  pattern UpdateDRepTxCert,
) where

import Cardano.Ledger.Babbage.Core
import Cardano.Ledger.BaseTypes (Anchor, StrictMaybe (..), invalidKey, kindObject)
import Cardano.Ledger.Binary (
  DecCBOR (..),
  Decoder,
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR (..),
  decodeNullStrictMaybe,
  decodeRecordSum,
  encodeListLen,
  encodeNullStrictMaybe,
  encodeWord8,
  toPlainEncoding,
 )
import Cardano.Ledger.Binary.Coders (Decode (..), Encode (..), decode, encode, (!>), (<!))
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Conway.Era (ConwayEra)
import Cardano.Ledger.Conway.PParams (ConwayEraPParams, ppDRepDepositL)
import Cardano.Ledger.Credential (
  Credential (..),
  StakeCredential,
  credKeyHashWitness,
  credScriptHash,
 )
import Cardano.Ledger.DRep (DRep)
import Cardano.Ledger.Shelley.TxCert (
  ShelleyDelegCert (..),
  encodePoolCert,
  encodeShelleyDelegCert,
  poolTxCertDecoder,
  shelleyTotalDepositsTxCerts,
  shelleyTotalRefundsTxCerts,
  shelleyTxCertDelegDecoder,
 )
import Cardano.Ledger.Val (Val (..))
import Control.DeepSeq (NFData)
import Data.Aeson (FromJSON (..), ToJSON (..), withObject, (.:?), (.=))
import Data.Foldable as F (foldMap', foldl')
import qualified Data.Map.Strict as Map
import Data.Monoid (Sum (getSum))
import GHC.Generics (Generic)
import Lens.Micro
import NoThunks.Class (NoThunks)

data ConwayTxCertUpgradeError
  = MirTxCertExpunged
  | GenesisDelegTxCertExpunged
  deriving (ConwayTxCertUpgradeError -> ConwayTxCertUpgradeError -> Bool
(ConwayTxCertUpgradeError -> ConwayTxCertUpgradeError -> Bool)
-> (ConwayTxCertUpgradeError -> ConwayTxCertUpgradeError -> Bool)
-> Eq ConwayTxCertUpgradeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConwayTxCertUpgradeError -> ConwayTxCertUpgradeError -> Bool
== :: ConwayTxCertUpgradeError -> ConwayTxCertUpgradeError -> Bool
$c/= :: ConwayTxCertUpgradeError -> ConwayTxCertUpgradeError -> Bool
/= :: ConwayTxCertUpgradeError -> ConwayTxCertUpgradeError -> Bool
Eq, Int -> ConwayTxCertUpgradeError -> ShowS
[ConwayTxCertUpgradeError] -> ShowS
ConwayTxCertUpgradeError -> String
(Int -> ConwayTxCertUpgradeError -> ShowS)
-> (ConwayTxCertUpgradeError -> String)
-> ([ConwayTxCertUpgradeError] -> ShowS)
-> Show ConwayTxCertUpgradeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConwayTxCertUpgradeError -> ShowS
showsPrec :: Int -> ConwayTxCertUpgradeError -> ShowS
$cshow :: ConwayTxCertUpgradeError -> String
show :: ConwayTxCertUpgradeError -> String
$cshowList :: [ConwayTxCertUpgradeError] -> ShowS
showList :: [ConwayTxCertUpgradeError] -> ShowS
Show)

instance EraTxCert ConwayEra where
  type TxCert ConwayEra = ConwayTxCert ConwayEra

  type TxCertUpgradeError ConwayEra = ConwayTxCertUpgradeError

  upgradeTxCert :: EraTxCert (PreviousEra ConwayEra) =>
TxCert (PreviousEra ConwayEra)
-> Either (TxCertUpgradeError ConwayEra) (TxCert ConwayEra)
upgradeTxCert = \case
    RegPoolTxCert PoolParams
poolParams -> TxCert ConwayEra
-> Either (TxCertUpgradeError ConwayEra) (TxCert ConwayEra)
forall a b. b -> Either a b
Right (TxCert ConwayEra
 -> Either (TxCertUpgradeError ConwayEra) (TxCert ConwayEra))
-> TxCert ConwayEra
-> Either (TxCertUpgradeError ConwayEra) (TxCert ConwayEra)
forall a b. (a -> b) -> a -> b
$ PoolParams -> TxCert ConwayEra
forall era. EraTxCert era => PoolParams -> TxCert era
RegPoolTxCert PoolParams
poolParams
    RetirePoolTxCert KeyHash 'StakePool
poolId EpochNo
epochNo -> TxCert ConwayEra
-> Either (TxCertUpgradeError ConwayEra) (TxCert ConwayEra)
forall a b. b -> Either a b
Right (TxCert ConwayEra
 -> Either (TxCertUpgradeError ConwayEra) (TxCert ConwayEra))
-> TxCert ConwayEra
-> Either (TxCertUpgradeError ConwayEra) (TxCert ConwayEra)
forall a b. (a -> b) -> a -> b
$ KeyHash 'StakePool -> EpochNo -> TxCert ConwayEra
forall era.
EraTxCert era =>
KeyHash 'StakePool -> EpochNo -> TxCert era
RetirePoolTxCert KeyHash 'StakePool
poolId EpochNo
epochNo
    RegTxCert Credential 'Staking
cred -> TxCert ConwayEra
-> Either (TxCertUpgradeError ConwayEra) (TxCert ConwayEra)
forall a b. b -> Either a b
Right (TxCert ConwayEra
 -> Either (TxCertUpgradeError ConwayEra) (TxCert ConwayEra))
-> TxCert ConwayEra
-> Either (TxCertUpgradeError ConwayEra) (TxCert ConwayEra)
forall a b. (a -> b) -> a -> b
$ Credential 'Staking -> TxCert ConwayEra
forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> TxCert era
RegTxCert Credential 'Staking
cred
    UnRegTxCert Credential 'Staking
cred -> TxCert ConwayEra
-> Either (TxCertUpgradeError ConwayEra) (TxCert ConwayEra)
forall a b. b -> Either a b
Right (TxCert ConwayEra
 -> Either (TxCertUpgradeError ConwayEra) (TxCert ConwayEra))
-> TxCert ConwayEra
-> Either (TxCertUpgradeError ConwayEra) (TxCert ConwayEra)
forall a b. (a -> b) -> a -> b
$ Credential 'Staking -> TxCert ConwayEra
forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> TxCert era
UnRegTxCert Credential 'Staking
cred
    DelegStakeTxCert Credential 'Staking
cred KeyHash 'StakePool
poolId -> TxCert ConwayEra
-> Either (TxCertUpgradeError ConwayEra) (TxCert ConwayEra)
forall a b. b -> Either a b
Right (TxCert ConwayEra
 -> Either (TxCertUpgradeError ConwayEra) (TxCert ConwayEra))
-> TxCert ConwayEra
-> Either (TxCertUpgradeError ConwayEra) (TxCert ConwayEra)
forall a b. (a -> b) -> a -> b
$ Credential 'Staking -> KeyHash 'StakePool -> TxCert ConwayEra
forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> KeyHash 'StakePool -> TxCert era
DelegStakeTxCert Credential 'Staking
cred KeyHash 'StakePool
poolId
    MirTxCert {} -> ConwayTxCertUpgradeError
-> Either ConwayTxCertUpgradeError (ConwayTxCert ConwayEra)
forall a b. a -> Either a b
Left ConwayTxCertUpgradeError
MirTxCertExpunged
    -- Using wildcard here instead of a pattern match on GenesisDelegTxCert in order to
    -- workaround ghc-8.10 disrespecting the completeness pragma.
    TxCert (PreviousEra ConwayEra)
_ -> ConwayTxCertUpgradeError
-> Either ConwayTxCertUpgradeError (ConwayTxCert ConwayEra)
forall a b. a -> Either a b
Left ConwayTxCertUpgradeError
GenesisDelegTxCertExpunged

  getVKeyWitnessTxCert :: TxCert ConwayEra -> Maybe (KeyHash 'Witness)
getVKeyWitnessTxCert = TxCert ConwayEra -> Maybe (KeyHash 'Witness)
ConwayTxCert ConwayEra -> Maybe (KeyHash 'Witness)
forall era. ConwayTxCert era -> Maybe (KeyHash 'Witness)
getVKeyWitnessConwayTxCert

  getScriptWitnessTxCert :: TxCert ConwayEra -> Maybe ScriptHash
getScriptWitnessTxCert = TxCert ConwayEra -> Maybe ScriptHash
ConwayTxCert ConwayEra -> Maybe ScriptHash
forall era. ConwayTxCert era -> Maybe ScriptHash
getScriptWitnessConwayTxCert

  mkRegPoolTxCert :: PoolParams -> TxCert ConwayEra
mkRegPoolTxCert = PoolCert -> ConwayTxCert ConwayEra
forall era. PoolCert -> ConwayTxCert era
ConwayTxCertPool (PoolCert -> ConwayTxCert ConwayEra)
-> (PoolParams -> PoolCert) -> PoolParams -> ConwayTxCert ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoolParams -> PoolCert
RegPool

  getRegPoolTxCert :: TxCert ConwayEra -> Maybe PoolParams
getRegPoolTxCert (ConwayTxCertPool (RegPool PoolParams
poolParams)) = PoolParams -> Maybe PoolParams
forall a. a -> Maybe a
Just PoolParams
poolParams
  getRegPoolTxCert TxCert ConwayEra
_ = Maybe PoolParams
forall a. Maybe a
Nothing

  mkRetirePoolTxCert :: KeyHash 'StakePool -> EpochNo -> TxCert ConwayEra
mkRetirePoolTxCert KeyHash 'StakePool
poolId EpochNo
epochNo = PoolCert -> ConwayTxCert ConwayEra
forall era. PoolCert -> ConwayTxCert era
ConwayTxCertPool (PoolCert -> ConwayTxCert ConwayEra)
-> PoolCert -> ConwayTxCert ConwayEra
forall a b. (a -> b) -> a -> b
$ KeyHash 'StakePool -> EpochNo -> PoolCert
RetirePool KeyHash 'StakePool
poolId EpochNo
epochNo

  getRetirePoolTxCert :: TxCert ConwayEra -> Maybe (KeyHash 'StakePool, EpochNo)
getRetirePoolTxCert (ConwayTxCertPool (RetirePool KeyHash 'StakePool
poolId EpochNo
epochNo)) = (KeyHash 'StakePool, EpochNo)
-> Maybe (KeyHash 'StakePool, EpochNo)
forall a. a -> Maybe a
Just (KeyHash 'StakePool
poolId, EpochNo
epochNo)
  getRetirePoolTxCert TxCert ConwayEra
_ = Maybe (KeyHash 'StakePool, EpochNo)
forall a. Maybe a
Nothing

  lookupRegStakeTxCert :: TxCert ConwayEra -> Maybe (Credential 'Staking)
lookupRegStakeTxCert = \case
    RegTxCert Credential 'Staking
c -> Credential 'Staking -> Maybe (Credential 'Staking)
forall a. a -> Maybe a
Just Credential 'Staking
c
    RegDepositTxCert Credential 'Staking
c Coin
_ -> Credential 'Staking -> Maybe (Credential 'Staking)
forall a. a -> Maybe a
Just Credential 'Staking
c
    RegDepositDelegTxCert Credential 'Staking
c Delegatee
_ Coin
_ -> Credential 'Staking -> Maybe (Credential 'Staking)
forall a. a -> Maybe a
Just Credential 'Staking
c
    TxCert ConwayEra
_ -> Maybe (Credential 'Staking)
forall a. Maybe a
Nothing
  lookupUnRegStakeTxCert :: TxCert ConwayEra -> Maybe (Credential 'Staking)
lookupUnRegStakeTxCert = \case
    UnRegTxCert Credential 'Staking
c -> Credential 'Staking -> Maybe (Credential 'Staking)
forall a. a -> Maybe a
Just Credential 'Staking
c
    UnRegDepositTxCert Credential 'Staking
c Coin
_ -> Credential 'Staking -> Maybe (Credential 'Staking)
forall a. a -> Maybe a
Just Credential 'Staking
c
    TxCert ConwayEra
_ -> Maybe (Credential 'Staking)
forall a. Maybe a
Nothing

  getTotalRefundsTxCerts :: forall (f :: * -> *).
Foldable f =>
PParams ConwayEra
-> (Credential 'Staking -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe Coin)
-> f (TxCert ConwayEra)
-> Coin
getTotalRefundsTxCerts = PParams ConwayEra
-> (Credential 'Staking -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe Coin)
-> f (TxCert ConwayEra)
-> Coin
forall era (f :: * -> *).
(EraPParams era, Foldable f, ConwayEraTxCert era) =>
PParams era
-> (Credential 'Staking -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe Coin)
-> f (TxCert era)
-> Coin
conwayTotalRefundsTxCerts

  getTotalDepositsTxCerts :: forall (f :: * -> *).
Foldable f =>
PParams ConwayEra
-> (KeyHash 'StakePool -> Bool) -> f (TxCert ConwayEra) -> Coin
getTotalDepositsTxCerts = PParams ConwayEra
-> (KeyHash 'StakePool -> Bool) -> f (TxCert ConwayEra) -> Coin
forall era (f :: * -> *).
(ConwayEraPParams era, Foldable f, ConwayEraTxCert era) =>
PParams era
-> (KeyHash 'StakePool -> Bool) -> f (TxCert era) -> Coin
conwayTotalDepositsTxCerts

instance ShelleyEraTxCert ConwayEra where
  mkRegTxCert :: Credential 'Staking -> TxCert ConwayEra
mkRegTxCert Credential 'Staking
c = ConwayDelegCert -> ConwayTxCert ConwayEra
forall era. ConwayDelegCert -> ConwayTxCert era
ConwayTxCertDeleg (ConwayDelegCert -> ConwayTxCert ConwayEra)
-> ConwayDelegCert -> ConwayTxCert ConwayEra
forall a b. (a -> b) -> a -> b
$ Credential 'Staking -> StrictMaybe Coin -> ConwayDelegCert
ConwayRegCert Credential 'Staking
c StrictMaybe Coin
forall a. StrictMaybe a
SNothing

  getRegTxCert :: TxCert ConwayEra -> Maybe (Credential 'Staking)
getRegTxCert (ConwayTxCertDeleg (ConwayRegCert Credential 'Staking
c StrictMaybe Coin
SNothing)) = Credential 'Staking -> Maybe (Credential 'Staking)
forall a. a -> Maybe a
Just Credential 'Staking
c
  getRegTxCert TxCert ConwayEra
_ = Maybe (Credential 'Staking)
forall a. Maybe a
Nothing

  mkUnRegTxCert :: Credential 'Staking -> TxCert ConwayEra
mkUnRegTxCert Credential 'Staking
c = ConwayDelegCert -> ConwayTxCert ConwayEra
forall era. ConwayDelegCert -> ConwayTxCert era
ConwayTxCertDeleg (ConwayDelegCert -> ConwayTxCert ConwayEra)
-> ConwayDelegCert -> ConwayTxCert ConwayEra
forall a b. (a -> b) -> a -> b
$ Credential 'Staking -> StrictMaybe Coin -> ConwayDelegCert
ConwayUnRegCert Credential 'Staking
c StrictMaybe Coin
forall a. StrictMaybe a
SNothing

  getUnRegTxCert :: TxCert ConwayEra -> Maybe (Credential 'Staking)
getUnRegTxCert (ConwayTxCertDeleg (ConwayUnRegCert Credential 'Staking
c StrictMaybe Coin
SNothing)) = Credential 'Staking -> Maybe (Credential 'Staking)
forall a. a -> Maybe a
Just Credential 'Staking
c
  getUnRegTxCert TxCert ConwayEra
_ = Maybe (Credential 'Staking)
forall a. Maybe a
Nothing

  mkDelegStakeTxCert :: Credential 'Staking -> KeyHash 'StakePool -> TxCert ConwayEra
mkDelegStakeTxCert Credential 'Staking
c KeyHash 'StakePool
kh = ConwayDelegCert -> ConwayTxCert ConwayEra
forall era. ConwayDelegCert -> ConwayTxCert era
ConwayTxCertDeleg (ConwayDelegCert -> ConwayTxCert ConwayEra)
-> ConwayDelegCert -> ConwayTxCert ConwayEra
forall a b. (a -> b) -> a -> b
$ Credential 'Staking -> Delegatee -> ConwayDelegCert
ConwayDelegCert Credential 'Staking
c (KeyHash 'StakePool -> Delegatee
DelegStake KeyHash 'StakePool
kh)

  getDelegStakeTxCert :: TxCert ConwayEra -> Maybe (Credential 'Staking, KeyHash 'StakePool)
getDelegStakeTxCert (ConwayTxCertDeleg (ConwayDelegCert Credential 'Staking
c (DelegStake KeyHash 'StakePool
kh))) = (Credential 'Staking, KeyHash 'StakePool)
-> Maybe (Credential 'Staking, KeyHash 'StakePool)
forall a. a -> Maybe a
Just (Credential 'Staking
c, KeyHash 'StakePool
kh)
  getDelegStakeTxCert TxCert ConwayEra
_ = Maybe (Credential 'Staking, KeyHash 'StakePool)
forall a. Maybe a
Nothing

  mkGenesisDelegTxCert :: ProtVerAtMost ConwayEra 8 => GenesisDelegCert -> TxCert ConwayEra
mkGenesisDelegTxCert = GenesisDelegCert -> TxCert ConwayEra
GenesisDelegCert -> ConwayTxCert ConwayEra
forall a. HasCallStack => a
notSupportedInThisEra
  getGenesisDelegTxCert :: ProtVerAtMost ConwayEra 8 =>
TxCert ConwayEra -> Maybe GenesisDelegCert
getGenesisDelegTxCert TxCert ConwayEra
_ = Maybe GenesisDelegCert
forall a. Maybe a
Nothing

  mkMirTxCert :: ProtVerAtMost ConwayEra 8 => MIRCert -> TxCert ConwayEra
mkMirTxCert = MIRCert -> TxCert ConwayEra
MIRCert -> ConwayTxCert ConwayEra
forall a. HasCallStack => a
notSupportedInThisEra
  getMirTxCert :: ProtVerAtMost ConwayEra 8 => TxCert ConwayEra -> Maybe MIRCert
getMirTxCert = Maybe MIRCert -> ConwayTxCert ConwayEra -> Maybe MIRCert
forall a b. a -> b -> a
const Maybe MIRCert
forall a. Maybe a
Nothing

class ShelleyEraTxCert era => ConwayEraTxCert era where
  mkRegDepositTxCert :: StakeCredential -> Coin -> TxCert era
  getRegDepositTxCert :: TxCert era -> Maybe (StakeCredential, Coin)

  mkUnRegDepositTxCert :: StakeCredential -> Coin -> TxCert era
  getUnRegDepositTxCert :: TxCert era -> Maybe (StakeCredential, Coin)

  mkDelegTxCert ::
    StakeCredential -> Delegatee -> TxCert era
  getDelegTxCert ::
    TxCert era -> Maybe (StakeCredential, Delegatee)

  mkRegDepositDelegTxCert ::
    StakeCredential -> Delegatee -> Coin -> TxCert era
  getRegDepositDelegTxCert ::
    TxCert era -> Maybe (StakeCredential, Delegatee, Coin)

  mkAuthCommitteeHotKeyTxCert ::
    Credential 'ColdCommitteeRole ->
    Credential 'HotCommitteeRole ->
    TxCert era
  getAuthCommitteeHotKeyTxCert ::
    TxCert era ->
    Maybe (Credential 'ColdCommitteeRole, Credential 'HotCommitteeRole)

  mkResignCommitteeColdTxCert ::
    Credential 'ColdCommitteeRole -> StrictMaybe Anchor -> TxCert era
  getResignCommitteeColdTxCert ::
    TxCert era ->
    Maybe (Credential 'ColdCommitteeRole, StrictMaybe Anchor)

  mkRegDRepTxCert ::
    Credential 'DRepRole -> Coin -> StrictMaybe Anchor -> TxCert era
  getRegDRepTxCert ::
    TxCert era ->
    Maybe (Credential 'DRepRole, Coin, StrictMaybe Anchor)

  mkUnRegDRepTxCert :: Credential 'DRepRole -> Coin -> TxCert era
  getUnRegDRepTxCert :: TxCert era -> Maybe (Credential 'DRepRole, Coin)

  mkUpdateDRepTxCert ::
    Credential 'DRepRole -> StrictMaybe Anchor -> TxCert era
  getUpdateDRepTxCert ::
    TxCert era -> Maybe (Credential 'DRepRole, StrictMaybe Anchor)

instance ConwayEraTxCert ConwayEra where
  mkRegDepositTxCert :: Credential 'Staking -> Coin -> TxCert ConwayEra
mkRegDepositTxCert Credential 'Staking
cred Coin
c = ConwayDelegCert -> ConwayTxCert ConwayEra
forall era. ConwayDelegCert -> ConwayTxCert era
ConwayTxCertDeleg (ConwayDelegCert -> ConwayTxCert ConwayEra)
-> ConwayDelegCert -> ConwayTxCert ConwayEra
forall a b. (a -> b) -> a -> b
$ Credential 'Staking -> StrictMaybe Coin -> ConwayDelegCert
ConwayRegCert Credential 'Staking
cred (StrictMaybe Coin -> ConwayDelegCert)
-> StrictMaybe Coin -> ConwayDelegCert
forall a b. (a -> b) -> a -> b
$ Coin -> StrictMaybe Coin
forall a. a -> StrictMaybe a
SJust Coin
c

  getRegDepositTxCert :: TxCert ConwayEra -> Maybe (Credential 'Staking, Coin)
getRegDepositTxCert (ConwayTxCertDeleg (ConwayRegCert Credential 'Staking
cred (SJust Coin
c))) = (Credential 'Staking, Coin) -> Maybe (Credential 'Staking, Coin)
forall a. a -> Maybe a
Just (Credential 'Staking
cred, Coin
c)
  getRegDepositTxCert TxCert ConwayEra
_ = Maybe (Credential 'Staking, Coin)
forall a. Maybe a
Nothing

  mkUnRegDepositTxCert :: Credential 'Staking -> Coin -> TxCert ConwayEra
mkUnRegDepositTxCert Credential 'Staking
cred Coin
c = ConwayDelegCert -> ConwayTxCert ConwayEra
forall era. ConwayDelegCert -> ConwayTxCert era
ConwayTxCertDeleg (ConwayDelegCert -> ConwayTxCert ConwayEra)
-> ConwayDelegCert -> ConwayTxCert ConwayEra
forall a b. (a -> b) -> a -> b
$ Credential 'Staking -> StrictMaybe Coin -> ConwayDelegCert
ConwayUnRegCert Credential 'Staking
cred (Coin -> StrictMaybe Coin
forall a. a -> StrictMaybe a
SJust Coin
c)
  getUnRegDepositTxCert :: TxCert ConwayEra -> Maybe (Credential 'Staking, Coin)
getUnRegDepositTxCert (ConwayTxCertDeleg (ConwayUnRegCert Credential 'Staking
cred (SJust Coin
c))) = (Credential 'Staking, Coin) -> Maybe (Credential 'Staking, Coin)
forall a. a -> Maybe a
Just (Credential 'Staking
cred, Coin
c)
  getUnRegDepositTxCert TxCert ConwayEra
_ = Maybe (Credential 'Staking, Coin)
forall a. Maybe a
Nothing

  mkDelegTxCert :: Credential 'Staking -> Delegatee -> TxCert ConwayEra
mkDelegTxCert Credential 'Staking
cred Delegatee
d = ConwayDelegCert -> ConwayTxCert ConwayEra
forall era. ConwayDelegCert -> ConwayTxCert era
ConwayTxCertDeleg (ConwayDelegCert -> ConwayTxCert ConwayEra)
-> ConwayDelegCert -> ConwayTxCert ConwayEra
forall a b. (a -> b) -> a -> b
$ Credential 'Staking -> Delegatee -> ConwayDelegCert
ConwayDelegCert Credential 'Staking
cred Delegatee
d
  getDelegTxCert :: TxCert ConwayEra -> Maybe (Credential 'Staking, Delegatee)
getDelegTxCert (ConwayTxCertDeleg (ConwayDelegCert Credential 'Staking
cred Delegatee
d)) = (Credential 'Staking, Delegatee)
-> Maybe (Credential 'Staking, Delegatee)
forall a. a -> Maybe a
Just (Credential 'Staking
cred, Delegatee
d)
  getDelegTxCert TxCert ConwayEra
_ = Maybe (Credential 'Staking, Delegatee)
forall a. Maybe a
Nothing

  mkRegDepositDelegTxCert :: Credential 'Staking -> Delegatee -> Coin -> TxCert ConwayEra
mkRegDepositDelegTxCert Credential 'Staking
cred Delegatee
d Coin
c = ConwayDelegCert -> ConwayTxCert ConwayEra
forall era. ConwayDelegCert -> ConwayTxCert era
ConwayTxCertDeleg (ConwayDelegCert -> ConwayTxCert ConwayEra)
-> ConwayDelegCert -> ConwayTxCert ConwayEra
forall a b. (a -> b) -> a -> b
$ Credential 'Staking -> Delegatee -> Coin -> ConwayDelegCert
ConwayRegDelegCert Credential 'Staking
cred Delegatee
d Coin
c
  getRegDepositDelegTxCert :: TxCert ConwayEra -> Maybe (Credential 'Staking, Delegatee, Coin)
getRegDepositDelegTxCert (ConwayTxCertDeleg (ConwayRegDelegCert Credential 'Staking
cred Delegatee
d Coin
c)) = (Credential 'Staking, Delegatee, Coin)
-> Maybe (Credential 'Staking, Delegatee, Coin)
forall a. a -> Maybe a
Just (Credential 'Staking
cred, Delegatee
d, Coin
c)
  getRegDepositDelegTxCert TxCert ConwayEra
_ = Maybe (Credential 'Staking, Delegatee, Coin)
forall a. Maybe a
Nothing

  mkAuthCommitteeHotKeyTxCert :: Credential 'ColdCommitteeRole
-> Credential 'HotCommitteeRole -> TxCert ConwayEra
mkAuthCommitteeHotKeyTxCert Credential 'ColdCommitteeRole
ck Credential 'HotCommitteeRole
hk = ConwayGovCert -> ConwayTxCert ConwayEra
forall era. ConwayGovCert -> ConwayTxCert era
ConwayTxCertGov (ConwayGovCert -> ConwayTxCert ConwayEra)
-> ConwayGovCert -> ConwayTxCert ConwayEra
forall a b. (a -> b) -> a -> b
$ Credential 'ColdCommitteeRole
-> Credential 'HotCommitteeRole -> ConwayGovCert
ConwayAuthCommitteeHotKey Credential 'ColdCommitteeRole
ck Credential 'HotCommitteeRole
hk
  getAuthCommitteeHotKeyTxCert :: TxCert ConwayEra
-> Maybe
     (Credential 'ColdCommitteeRole, Credential 'HotCommitteeRole)
getAuthCommitteeHotKeyTxCert (ConwayTxCertGov (ConwayAuthCommitteeHotKey Credential 'ColdCommitteeRole
ck Credential 'HotCommitteeRole
hk)) = (Credential 'ColdCommitteeRole, Credential 'HotCommitteeRole)
-> Maybe
     (Credential 'ColdCommitteeRole, Credential 'HotCommitteeRole)
forall a. a -> Maybe a
Just (Credential 'ColdCommitteeRole
ck, Credential 'HotCommitteeRole
hk)
  getAuthCommitteeHotKeyTxCert TxCert ConwayEra
_ = Maybe (Credential 'ColdCommitteeRole, Credential 'HotCommitteeRole)
forall a. Maybe a
Nothing

  mkResignCommitteeColdTxCert :: Credential 'ColdCommitteeRole
-> StrictMaybe Anchor -> TxCert ConwayEra
mkResignCommitteeColdTxCert Credential 'ColdCommitteeRole
ck StrictMaybe Anchor
a = ConwayGovCert -> ConwayTxCert ConwayEra
forall era. ConwayGovCert -> ConwayTxCert era
ConwayTxCertGov (ConwayGovCert -> ConwayTxCert ConwayEra)
-> ConwayGovCert -> ConwayTxCert ConwayEra
forall a b. (a -> b) -> a -> b
$ Credential 'ColdCommitteeRole
-> StrictMaybe Anchor -> ConwayGovCert
ConwayResignCommitteeColdKey Credential 'ColdCommitteeRole
ck StrictMaybe Anchor
a
  getResignCommitteeColdTxCert :: TxCert ConwayEra
-> Maybe (Credential 'ColdCommitteeRole, StrictMaybe Anchor)
getResignCommitteeColdTxCert (ConwayTxCertGov (ConwayResignCommitteeColdKey Credential 'ColdCommitteeRole
ck StrictMaybe Anchor
a)) = (Credential 'ColdCommitteeRole, StrictMaybe Anchor)
-> Maybe (Credential 'ColdCommitteeRole, StrictMaybe Anchor)
forall a. a -> Maybe a
Just (Credential 'ColdCommitteeRole
ck, StrictMaybe Anchor
a)
  getResignCommitteeColdTxCert TxCert ConwayEra
_ = Maybe (Credential 'ColdCommitteeRole, StrictMaybe Anchor)
forall a. Maybe a
Nothing

  mkRegDRepTxCert :: Credential 'DRepRole
-> Coin -> StrictMaybe Anchor -> TxCert ConwayEra
mkRegDRepTxCert Credential 'DRepRole
cred Coin
deposit StrictMaybe Anchor
mAnchor = ConwayGovCert -> ConwayTxCert ConwayEra
forall era. ConwayGovCert -> ConwayTxCert era
ConwayTxCertGov (ConwayGovCert -> ConwayTxCert ConwayEra)
-> ConwayGovCert -> ConwayTxCert ConwayEra
forall a b. (a -> b) -> a -> b
$ Credential 'DRepRole -> Coin -> StrictMaybe Anchor -> ConwayGovCert
ConwayRegDRep Credential 'DRepRole
cred Coin
deposit StrictMaybe Anchor
mAnchor
  getRegDRepTxCert :: TxCert ConwayEra
-> Maybe (Credential 'DRepRole, Coin, StrictMaybe Anchor)
getRegDRepTxCert = \case
    ConwayTxCertGov (ConwayRegDRep Credential 'DRepRole
cred Coin
deposit StrictMaybe Anchor
mAnchor) -> (Credential 'DRepRole, Coin, StrictMaybe Anchor)
-> Maybe (Credential 'DRepRole, Coin, StrictMaybe Anchor)
forall a. a -> Maybe a
Just (Credential 'DRepRole
cred, Coin
deposit, StrictMaybe Anchor
mAnchor)
    TxCert ConwayEra
_ -> Maybe (Credential 'DRepRole, Coin, StrictMaybe Anchor)
forall a. Maybe a
Nothing

  mkUnRegDRepTxCert :: Credential 'DRepRole -> Coin -> TxCert ConwayEra
mkUnRegDRepTxCert Credential 'DRepRole
cred Coin
deposit = ConwayGovCert -> ConwayTxCert ConwayEra
forall era. ConwayGovCert -> ConwayTxCert era
ConwayTxCertGov (ConwayGovCert -> ConwayTxCert ConwayEra)
-> ConwayGovCert -> ConwayTxCert ConwayEra
forall a b. (a -> b) -> a -> b
$ Credential 'DRepRole -> Coin -> ConwayGovCert
ConwayUnRegDRep Credential 'DRepRole
cred Coin
deposit
  getUnRegDRepTxCert :: TxCert ConwayEra -> Maybe (Credential 'DRepRole, Coin)
getUnRegDRepTxCert = \case
    ConwayTxCertGov (ConwayUnRegDRep Credential 'DRepRole
cred Coin
deposit) -> (Credential 'DRepRole, Coin) -> Maybe (Credential 'DRepRole, Coin)
forall a. a -> Maybe a
Just (Credential 'DRepRole
cred, Coin
deposit)
    TxCert ConwayEra
_ -> Maybe (Credential 'DRepRole, Coin)
forall a. Maybe a
Nothing

  mkUpdateDRepTxCert :: Credential 'DRepRole -> StrictMaybe Anchor -> TxCert ConwayEra
mkUpdateDRepTxCert Credential 'DRepRole
cred StrictMaybe Anchor
mAnchor = ConwayGovCert -> ConwayTxCert ConwayEra
forall era. ConwayGovCert -> ConwayTxCert era
ConwayTxCertGov (ConwayGovCert -> ConwayTxCert ConwayEra)
-> ConwayGovCert -> ConwayTxCert ConwayEra
forall a b. (a -> b) -> a -> b
$ Credential 'DRepRole -> StrictMaybe Anchor -> ConwayGovCert
ConwayUpdateDRep Credential 'DRepRole
cred StrictMaybe Anchor
mAnchor
  getUpdateDRepTxCert :: TxCert ConwayEra
-> Maybe (Credential 'DRepRole, StrictMaybe Anchor)
getUpdateDRepTxCert = \case
    ConwayTxCertGov (ConwayUpdateDRep Credential 'DRepRole
cred StrictMaybe Anchor
mAnchor) -> (Credential 'DRepRole, StrictMaybe Anchor)
-> Maybe (Credential 'DRepRole, StrictMaybe Anchor)
forall a. a -> Maybe a
Just (Credential 'DRepRole
cred, StrictMaybe Anchor
mAnchor)
    TxCert ConwayEra
_ -> Maybe (Credential 'DRepRole, StrictMaybe Anchor)
forall a. Maybe a
Nothing

pattern RegDepositTxCert ::
  ConwayEraTxCert era =>
  StakeCredential ->
  Coin ->
  TxCert era
pattern $mRegDepositTxCert :: forall {r} {era}.
ConwayEraTxCert era =>
TxCert era
-> (Credential 'Staking -> Coin -> r) -> ((# #) -> r) -> r
$bRegDepositTxCert :: forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert cred c <- (getRegDepositTxCert -> Just (cred, c))
  where
    RegDepositTxCert Credential 'Staking
cred Coin
c = Credential 'Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
mkRegDepositTxCert Credential 'Staking
cred Coin
c

pattern UnRegDepositTxCert ::
  ConwayEraTxCert era =>
  StakeCredential ->
  Coin ->
  TxCert era
pattern $mUnRegDepositTxCert :: forall {r} {era}.
ConwayEraTxCert era =>
TxCert era
-> (Credential 'Staking -> Coin -> r) -> ((# #) -> r) -> r
$bUnRegDepositTxCert :: forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
UnRegDepositTxCert cred c <- (getUnRegDepositTxCert -> Just (cred, c))
  where
    UnRegDepositTxCert Credential 'Staking
cred Coin
c = Credential 'Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
mkUnRegDepositTxCert Credential 'Staking
cred Coin
c

pattern DelegTxCert ::
  ConwayEraTxCert era =>
  StakeCredential ->
  Delegatee ->
  TxCert era
pattern $mDelegTxCert :: forall {r} {era}.
ConwayEraTxCert era =>
TxCert era
-> (Credential 'Staking -> Delegatee -> r) -> ((# #) -> r) -> r
$bDelegTxCert :: forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert cred d <- (getDelegTxCert -> Just (cred, d))
  where
    DelegTxCert Credential 'Staking
cred Delegatee
d = Credential 'Staking -> Delegatee -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
mkDelegTxCert Credential 'Staking
cred Delegatee
d

pattern RegDepositDelegTxCert ::
  ConwayEraTxCert era =>
  StakeCredential ->
  Delegatee ->
  Coin ->
  TxCert era
pattern $mRegDepositDelegTxCert :: forall {r} {era}.
ConwayEraTxCert era =>
TxCert era
-> (Credential 'Staking -> Delegatee -> Coin -> r)
-> ((# #) -> r)
-> r
$bRegDepositDelegTxCert :: forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> Coin -> TxCert era
RegDepositDelegTxCert cred d c <- (getRegDepositDelegTxCert -> Just (cred, d, c))
  where
    RegDepositDelegTxCert Credential 'Staking
cred Delegatee
d Coin
c = Credential 'Staking -> Delegatee -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> Coin -> TxCert era
mkRegDepositDelegTxCert Credential 'Staking
cred Delegatee
d Coin
c

pattern AuthCommitteeHotKeyTxCert ::
  ConwayEraTxCert era =>
  Credential 'ColdCommitteeRole ->
  Credential 'HotCommitteeRole ->
  TxCert era
pattern $mAuthCommitteeHotKeyTxCert :: forall {r} {era}.
ConwayEraTxCert era =>
TxCert era
-> (Credential 'ColdCommitteeRole
    -> Credential 'HotCommitteeRole -> r)
-> ((# #) -> r)
-> r
$bAuthCommitteeHotKeyTxCert :: forall era.
ConwayEraTxCert era =>
Credential 'ColdCommitteeRole
-> Credential 'HotCommitteeRole -> TxCert era
AuthCommitteeHotKeyTxCert ck hk <- (getAuthCommitteeHotKeyTxCert -> Just (ck, hk))
  where
    AuthCommitteeHotKeyTxCert Credential 'ColdCommitteeRole
ck Credential 'HotCommitteeRole
hk = Credential 'ColdCommitteeRole
-> Credential 'HotCommitteeRole -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'ColdCommitteeRole
-> Credential 'HotCommitteeRole -> TxCert era
mkAuthCommitteeHotKeyTxCert Credential 'ColdCommitteeRole
ck Credential 'HotCommitteeRole
hk

pattern ResignCommitteeColdTxCert ::
  ConwayEraTxCert era =>
  Credential 'ColdCommitteeRole ->
  StrictMaybe Anchor ->
  TxCert era
pattern $mResignCommitteeColdTxCert :: forall {r} {era}.
ConwayEraTxCert era =>
TxCert era
-> (Credential 'ColdCommitteeRole -> StrictMaybe Anchor -> r)
-> ((# #) -> r)
-> r
$bResignCommitteeColdTxCert :: forall era.
ConwayEraTxCert era =>
Credential 'ColdCommitteeRole -> StrictMaybe Anchor -> TxCert era
ResignCommitteeColdTxCert ck a <- (getResignCommitteeColdTxCert -> Just (ck, a))
  where
    ResignCommitteeColdTxCert Credential 'ColdCommitteeRole
ck = Credential 'ColdCommitteeRole -> StrictMaybe Anchor -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'ColdCommitteeRole -> StrictMaybe Anchor -> TxCert era
mkResignCommitteeColdTxCert Credential 'ColdCommitteeRole
ck

pattern RegDRepTxCert ::
  ConwayEraTxCert era =>
  Credential 'DRepRole ->
  Coin ->
  StrictMaybe Anchor ->
  TxCert era
pattern $mRegDRepTxCert :: forall {r} {era}.
ConwayEraTxCert era =>
TxCert era
-> (Credential 'DRepRole -> Coin -> StrictMaybe Anchor -> r)
-> ((# #) -> r)
-> r
$bRegDRepTxCert :: forall era.
ConwayEraTxCert era =>
Credential 'DRepRole -> Coin -> StrictMaybe Anchor -> TxCert era
RegDRepTxCert cred deposit mAnchor <- (getRegDRepTxCert -> Just (cred, deposit, mAnchor))
  where
    RegDRepTxCert Credential 'DRepRole
cred Coin
deposit StrictMaybe Anchor
mAnchor = Credential 'DRepRole -> Coin -> StrictMaybe Anchor -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'DRepRole -> Coin -> StrictMaybe Anchor -> TxCert era
mkRegDRepTxCert Credential 'DRepRole
cred Coin
deposit StrictMaybe Anchor
mAnchor

pattern UnRegDRepTxCert ::
  ConwayEraTxCert era =>
  Credential 'DRepRole ->
  Coin ->
  TxCert era
pattern $mUnRegDRepTxCert :: forall {r} {era}.
ConwayEraTxCert era =>
TxCert era
-> (Credential 'DRepRole -> Coin -> r) -> ((# #) -> r) -> r
$bUnRegDRepTxCert :: forall era.
ConwayEraTxCert era =>
Credential 'DRepRole -> Coin -> TxCert era
UnRegDRepTxCert cred deposit <- (getUnRegDRepTxCert -> Just (cred, deposit))
  where
    UnRegDRepTxCert Credential 'DRepRole
cred Coin
deposit = Credential 'DRepRole -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'DRepRole -> Coin -> TxCert era
mkUnRegDRepTxCert Credential 'DRepRole
cred Coin
deposit

pattern UpdateDRepTxCert ::
  ConwayEraTxCert era =>
  Credential 'DRepRole ->
  StrictMaybe Anchor ->
  TxCert era
pattern $mUpdateDRepTxCert :: forall {r} {era}.
ConwayEraTxCert era =>
TxCert era
-> (Credential 'DRepRole -> StrictMaybe Anchor -> r)
-> ((# #) -> r)
-> r
$bUpdateDRepTxCert :: forall era.
ConwayEraTxCert era =>
Credential 'DRepRole -> StrictMaybe Anchor -> TxCert era
UpdateDRepTxCert cred mAnchor <- (getUpdateDRepTxCert -> Just (cred, mAnchor))
  where
    UpdateDRepTxCert Credential 'DRepRole
cred StrictMaybe Anchor
mAnchor = Credential 'DRepRole -> StrictMaybe Anchor -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'DRepRole -> StrictMaybe Anchor -> TxCert era
mkUpdateDRepTxCert Credential 'DRepRole
cred StrictMaybe Anchor
mAnchor

{-# COMPLETE
  RegPoolTxCert
  , RetirePoolTxCert
  , RegTxCert
  , UnRegTxCert
  , RegDepositTxCert
  , UnRegDepositTxCert
  , DelegTxCert
  , RegDepositDelegTxCert
  , AuthCommitteeHotKeyTxCert
  , ResignCommitteeColdTxCert
  , RegDRepTxCert
  , UnRegDRepTxCert
  , UpdateDRepTxCert ::
    ConwayEra
  #-}

getDelegateeTxCert :: ConwayEraTxCert era => TxCert era -> Maybe Delegatee
getDelegateeTxCert :: forall era. ConwayEraTxCert era => TxCert era -> Maybe Delegatee
getDelegateeTxCert = \case
  DelegTxCert Credential 'Staking
_ Delegatee
delegatee -> Delegatee -> Maybe Delegatee
forall a. a -> Maybe a
Just Delegatee
delegatee
  RegDepositDelegTxCert Credential 'Staking
_ Delegatee
delegatee Coin
_ -> Delegatee -> Maybe Delegatee
forall a. a -> Maybe a
Just Delegatee
delegatee
  TxCert era
_ -> Maybe Delegatee
forall a. Maybe a
Nothing

-- | First type argument is the deposit
data Delegatee
  = DelegStake !(KeyHash 'StakePool)
  | DelegVote !DRep
  | DelegStakeVote !(KeyHash 'StakePool) !DRep
  deriving (Int -> Delegatee -> ShowS
[Delegatee] -> ShowS
Delegatee -> String
(Int -> Delegatee -> ShowS)
-> (Delegatee -> String)
-> ([Delegatee] -> ShowS)
-> Show Delegatee
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Delegatee -> ShowS
showsPrec :: Int -> Delegatee -> ShowS
$cshow :: Delegatee -> String
show :: Delegatee -> String
$cshowList :: [Delegatee] -> ShowS
showList :: [Delegatee] -> ShowS
Show, (forall x. Delegatee -> Rep Delegatee x)
-> (forall x. Rep Delegatee x -> Delegatee) -> Generic Delegatee
forall x. Rep Delegatee x -> Delegatee
forall x. Delegatee -> Rep Delegatee x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Delegatee -> Rep Delegatee x
from :: forall x. Delegatee -> Rep Delegatee x
$cto :: forall x. Rep Delegatee x -> Delegatee
to :: forall x. Rep Delegatee x -> Delegatee
Generic, Delegatee -> Delegatee -> Bool
(Delegatee -> Delegatee -> Bool)
-> (Delegatee -> Delegatee -> Bool) -> Eq Delegatee
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Delegatee -> Delegatee -> Bool
== :: Delegatee -> Delegatee -> Bool
$c/= :: Delegatee -> Delegatee -> Bool
/= :: Delegatee -> Delegatee -> Bool
Eq, Eq Delegatee
Eq Delegatee =>
(Delegatee -> Delegatee -> Ordering)
-> (Delegatee -> Delegatee -> Bool)
-> (Delegatee -> Delegatee -> Bool)
-> (Delegatee -> Delegatee -> Bool)
-> (Delegatee -> Delegatee -> Bool)
-> (Delegatee -> Delegatee -> Delegatee)
-> (Delegatee -> Delegatee -> Delegatee)
-> Ord Delegatee
Delegatee -> Delegatee -> Bool
Delegatee -> Delegatee -> Ordering
Delegatee -> Delegatee -> Delegatee
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Delegatee -> Delegatee -> Ordering
compare :: Delegatee -> Delegatee -> Ordering
$c< :: Delegatee -> Delegatee -> Bool
< :: Delegatee -> Delegatee -> Bool
$c<= :: Delegatee -> Delegatee -> Bool
<= :: Delegatee -> Delegatee -> Bool
$c> :: Delegatee -> Delegatee -> Bool
> :: Delegatee -> Delegatee -> Bool
$c>= :: Delegatee -> Delegatee -> Bool
>= :: Delegatee -> Delegatee -> Bool
$cmax :: Delegatee -> Delegatee -> Delegatee
max :: Delegatee -> Delegatee -> Delegatee
$cmin :: Delegatee -> Delegatee -> Delegatee
min :: Delegatee -> Delegatee -> Delegatee
Ord)

instance ToJSON Delegatee where
  toJSON :: Delegatee -> Value
toJSON = \case
    DelegStake KeyHash 'StakePool
poolId ->
      Text -> [Pair] -> Value
kindObject Text
"DelegStake" [Key
"poolId" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= KeyHash 'StakePool -> Value
forall a. ToJSON a => a -> Value
toJSON KeyHash 'StakePool
poolId]
    DelegVote DRep
dRep ->
      Text -> [Pair] -> Value
kindObject Text
"DelegVote" [Key
"dRep" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DRep -> Value
forall a. ToJSON a => a -> Value
toJSON DRep
dRep]
    DelegStakeVote KeyHash 'StakePool
poolId DRep
dRep ->
      Text -> [Pair] -> Value
kindObject Text
"DelegStakeVote" ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        [ Key
"poolId" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= KeyHash 'StakePool -> Value
forall a. ToJSON a => a -> Value
toJSON KeyHash 'StakePool
poolId
        , Key
"dRep" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DRep -> Value
forall a. ToJSON a => a -> Value
toJSON DRep
dRep
        ]

instance FromJSON Delegatee where
  parseJSON :: Value -> Parser Delegatee
parseJSON = String -> (Object -> Parser Delegatee) -> Value -> Parser Delegatee
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Delegatee" ((Object -> Parser Delegatee) -> Value -> Parser Delegatee)
-> (Object -> Parser Delegatee) -> Value -> Parser Delegatee
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
    Maybe (KeyHash 'StakePool)
poolId <- Object
obj Object -> Key -> Parser (Maybe (KeyHash 'StakePool))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"poolId"
    Maybe DRep
dRep <- Object
obj Object -> Key -> Parser (Maybe DRep)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"dRep"
    case (Maybe (KeyHash 'StakePool)
poolId, Maybe DRep
dRep) of
      (Just KeyHash 'StakePool
poolId', Maybe DRep
Nothing) -> Delegatee -> Parser Delegatee
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Delegatee -> Parser Delegatee) -> Delegatee -> Parser Delegatee
forall a b. (a -> b) -> a -> b
$ KeyHash 'StakePool -> Delegatee
DelegStake KeyHash 'StakePool
poolId'
      (Maybe (KeyHash 'StakePool)
Nothing, Just DRep
dRep') -> Delegatee -> Parser Delegatee
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Delegatee -> Parser Delegatee) -> Delegatee -> Parser Delegatee
forall a b. (a -> b) -> a -> b
$ DRep -> Delegatee
DelegVote DRep
dRep'
      (Just KeyHash 'StakePool
poolId', Just DRep
dRep') -> Delegatee -> Parser Delegatee
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Delegatee -> Parser Delegatee) -> Delegatee -> Parser Delegatee
forall a b. (a -> b) -> a -> b
$ KeyHash 'StakePool -> DRep -> Delegatee
DelegStakeVote KeyHash 'StakePool
poolId' DRep
dRep'
      (Maybe (KeyHash 'StakePool), Maybe DRep)
_ -> String -> Parser Delegatee
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Object does not contain a dRep or a poolId field"

instance EncCBOR Delegatee where
  encCBOR :: Delegatee -> Encoding
encCBOR =
    Encode 'Open Delegatee -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode 'Open Delegatee -> Encoding)
-> (Delegatee -> Encode 'Open Delegatee) -> Delegatee -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      DelegStake KeyHash 'StakePool
kh -> (KeyHash 'StakePool -> Delegatee)
-> Word -> Encode 'Open (KeyHash 'StakePool -> Delegatee)
forall t. t -> Word -> Encode 'Open t
Sum KeyHash 'StakePool -> Delegatee
DelegStake Word
0 Encode 'Open (KeyHash 'StakePool -> Delegatee)
-> Encode ('Closed 'Dense) (KeyHash 'StakePool)
-> Encode 'Open Delegatee
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> KeyHash 'StakePool -> Encode ('Closed 'Dense) (KeyHash 'StakePool)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To KeyHash 'StakePool
kh
      DelegVote DRep
dRep -> (DRep -> Delegatee) -> Word -> Encode 'Open (DRep -> Delegatee)
forall t. t -> Word -> Encode 'Open t
Sum DRep -> Delegatee
DelegVote Word
1 Encode 'Open (DRep -> Delegatee)
-> Encode ('Closed 'Dense) DRep -> Encode 'Open Delegatee
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> DRep -> Encode ('Closed 'Dense) DRep
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To DRep
dRep
      DelegStakeVote KeyHash 'StakePool
kh DRep
dRep -> (KeyHash 'StakePool -> DRep -> Delegatee)
-> Word -> Encode 'Open (KeyHash 'StakePool -> DRep -> Delegatee)
forall t. t -> Word -> Encode 'Open t
Sum KeyHash 'StakePool -> DRep -> Delegatee
DelegStakeVote Word
2 Encode 'Open (KeyHash 'StakePool -> DRep -> Delegatee)
-> Encode ('Closed 'Dense) (KeyHash 'StakePool)
-> Encode 'Open (DRep -> Delegatee)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> KeyHash 'StakePool -> Encode ('Closed 'Dense) (KeyHash 'StakePool)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To KeyHash 'StakePool
kh Encode 'Open (DRep -> Delegatee)
-> Encode ('Closed 'Dense) DRep -> Encode 'Open Delegatee
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> DRep -> Encode ('Closed 'Dense) DRep
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To DRep
dRep

instance DecCBOR Delegatee where
  decCBOR :: forall s. Decoder s Delegatee
decCBOR = Decode ('Closed 'Dense) Delegatee -> Decoder s Delegatee
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) Delegatee -> Decoder s Delegatee)
-> Decode ('Closed 'Dense) Delegatee -> Decoder s Delegatee
forall a b. (a -> b) -> a -> b
$
    Text
-> (Word -> Decode 'Open Delegatee)
-> Decode ('Closed 'Dense) Delegatee
forall t.
Text -> (Word -> Decode 'Open t) -> Decode ('Closed 'Dense) t
Summands Text
"Delegatee" ((Word -> Decode 'Open Delegatee)
 -> Decode ('Closed 'Dense) Delegatee)
-> (Word -> Decode 'Open Delegatee)
-> Decode ('Closed 'Dense) Delegatee
forall a b. (a -> b) -> a -> b
$ \case
      Word
0 -> (KeyHash 'StakePool -> Delegatee)
-> Decode 'Open (KeyHash 'StakePool -> Delegatee)
forall t. t -> Decode 'Open t
SumD KeyHash 'StakePool -> Delegatee
DelegStake Decode 'Open (KeyHash 'StakePool -> Delegatee)
-> Decode ('Closed Any) (KeyHash 'StakePool)
-> Decode 'Open Delegatee
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (KeyHash 'StakePool)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      Word
1 -> (DRep -> Delegatee) -> Decode 'Open (DRep -> Delegatee)
forall t. t -> Decode 'Open t
SumD DRep -> Delegatee
DelegVote Decode 'Open (DRep -> Delegatee)
-> Decode ('Closed Any) DRep -> Decode 'Open Delegatee
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) DRep
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      Word
2 -> (KeyHash 'StakePool -> DRep -> Delegatee)
-> Decode 'Open (KeyHash 'StakePool -> DRep -> Delegatee)
forall t. t -> Decode 'Open t
SumD KeyHash 'StakePool -> DRep -> Delegatee
DelegStakeVote Decode 'Open (KeyHash 'StakePool -> DRep -> Delegatee)
-> Decode ('Closed Any) (KeyHash 'StakePool)
-> Decode 'Open (DRep -> Delegatee)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (KeyHash 'StakePool)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode 'Open (DRep -> Delegatee)
-> Decode ('Closed Any) DRep -> Decode 'Open Delegatee
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) DRep
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      Word
k -> Word -> Decode 'Open Delegatee
forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
k

getStakePoolDelegatee :: Delegatee -> Maybe (KeyHash 'StakePool)
getStakePoolDelegatee :: Delegatee -> Maybe (KeyHash 'StakePool)
getStakePoolDelegatee = \case
  DelegStake KeyHash 'StakePool
targetPool -> KeyHash 'StakePool -> Maybe (KeyHash 'StakePool)
forall a. a -> Maybe a
Just KeyHash 'StakePool
targetPool
  DelegVote {} -> Maybe (KeyHash 'StakePool)
forall a. Maybe a
Nothing
  DelegStakeVote KeyHash 'StakePool
targetPool DRep
_ -> KeyHash 'StakePool -> Maybe (KeyHash 'StakePool)
forall a. a -> Maybe a
Just KeyHash 'StakePool
targetPool

getVoteDelegatee :: Delegatee -> Maybe DRep
getVoteDelegatee :: Delegatee -> Maybe DRep
getVoteDelegatee DelegStake {} = Maybe DRep
forall a. Maybe a
Nothing
getVoteDelegatee (DelegVote DRep
x) = DRep -> Maybe DRep
forall a. a -> Maybe a
Just DRep
x
getVoteDelegatee (DelegStakeVote KeyHash 'StakePool
_ DRep
x) = DRep -> Maybe DRep
forall a. a -> Maybe a
Just DRep
x

instance NFData Delegatee

instance NoThunks Delegatee

-- | Certificates for registration and delegation of stake to Pools and DReps. Comparing
-- to previous eras, there is now ability to:
--
-- * Register and delegate with a single certificate: `ConwayRegDelegCert`
--
-- * Ability to delegate to DReps with `DelegVote` and `DelegStakeVote`
--
-- * Ability to specify the deposit amount. Deposits during registration and
--   unregistration in Conway are optional, which will change in the future era. They are
--   optional only for the smooth transition from Babbage to Conway. Validity of deposits
--   is checked by the @CERT@ rule.
data ConwayDelegCert
  = -- | Register staking credential. Deposit, when present, must match the expected deposit
    -- amount specified by `ppKeyDepositL` in the protocol parameters.
    ConwayRegCert !StakeCredential !(StrictMaybe Coin)
  | -- | De-Register the staking credential. Deposit, if present, must match the amount
    -- that was left as a deposit upon stake credential registration.
    ConwayUnRegCert !StakeCredential !(StrictMaybe Coin)
  | -- | Delegate staking credentials to a delegatee. Staking credential must already be registered.
    ConwayDelegCert !StakeCredential !Delegatee
  | -- | This is a new type of certificate, which allows to register staking credential
    -- and delegate within a single certificate. Deposit is required and must match the
    -- expected deposit amount specified by `ppKeyDepositL` in the protocol parameters.
    ConwayRegDelegCert !StakeCredential !Delegatee !Coin
  deriving (Int -> ConwayDelegCert -> ShowS
[ConwayDelegCert] -> ShowS
ConwayDelegCert -> String
(Int -> ConwayDelegCert -> ShowS)
-> (ConwayDelegCert -> String)
-> ([ConwayDelegCert] -> ShowS)
-> Show ConwayDelegCert
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConwayDelegCert -> ShowS
showsPrec :: Int -> ConwayDelegCert -> ShowS
$cshow :: ConwayDelegCert -> String
show :: ConwayDelegCert -> String
$cshowList :: [ConwayDelegCert] -> ShowS
showList :: [ConwayDelegCert] -> ShowS
Show, (forall x. ConwayDelegCert -> Rep ConwayDelegCert x)
-> (forall x. Rep ConwayDelegCert x -> ConwayDelegCert)
-> Generic ConwayDelegCert
forall x. Rep ConwayDelegCert x -> ConwayDelegCert
forall x. ConwayDelegCert -> Rep ConwayDelegCert x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ConwayDelegCert -> Rep ConwayDelegCert x
from :: forall x. ConwayDelegCert -> Rep ConwayDelegCert x
$cto :: forall x. Rep ConwayDelegCert x -> ConwayDelegCert
to :: forall x. Rep ConwayDelegCert x -> ConwayDelegCert
Generic, ConwayDelegCert -> ConwayDelegCert -> Bool
(ConwayDelegCert -> ConwayDelegCert -> Bool)
-> (ConwayDelegCert -> ConwayDelegCert -> Bool)
-> Eq ConwayDelegCert
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConwayDelegCert -> ConwayDelegCert -> Bool
== :: ConwayDelegCert -> ConwayDelegCert -> Bool
$c/= :: ConwayDelegCert -> ConwayDelegCert -> Bool
/= :: ConwayDelegCert -> ConwayDelegCert -> Bool
Eq, Eq ConwayDelegCert
Eq ConwayDelegCert =>
(ConwayDelegCert -> ConwayDelegCert -> Ordering)
-> (ConwayDelegCert -> ConwayDelegCert -> Bool)
-> (ConwayDelegCert -> ConwayDelegCert -> Bool)
-> (ConwayDelegCert -> ConwayDelegCert -> Bool)
-> (ConwayDelegCert -> ConwayDelegCert -> Bool)
-> (ConwayDelegCert -> ConwayDelegCert -> ConwayDelegCert)
-> (ConwayDelegCert -> ConwayDelegCert -> ConwayDelegCert)
-> Ord ConwayDelegCert
ConwayDelegCert -> ConwayDelegCert -> Bool
ConwayDelegCert -> ConwayDelegCert -> Ordering
ConwayDelegCert -> ConwayDelegCert -> ConwayDelegCert
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ConwayDelegCert -> ConwayDelegCert -> Ordering
compare :: ConwayDelegCert -> ConwayDelegCert -> Ordering
$c< :: ConwayDelegCert -> ConwayDelegCert -> Bool
< :: ConwayDelegCert -> ConwayDelegCert -> Bool
$c<= :: ConwayDelegCert -> ConwayDelegCert -> Bool
<= :: ConwayDelegCert -> ConwayDelegCert -> Bool
$c> :: ConwayDelegCert -> ConwayDelegCert -> Bool
> :: ConwayDelegCert -> ConwayDelegCert -> Bool
$c>= :: ConwayDelegCert -> ConwayDelegCert -> Bool
>= :: ConwayDelegCert -> ConwayDelegCert -> Bool
$cmax :: ConwayDelegCert -> ConwayDelegCert -> ConwayDelegCert
max :: ConwayDelegCert -> ConwayDelegCert -> ConwayDelegCert
$cmin :: ConwayDelegCert -> ConwayDelegCert -> ConwayDelegCert
min :: ConwayDelegCert -> ConwayDelegCert -> ConwayDelegCert
Ord)

instance EncCBOR ConwayDelegCert where
  encCBOR :: ConwayDelegCert -> Encoding
encCBOR = \case
    -- Shelley backwards compatibility
    ConwayRegCert Credential 'Staking
cred StrictMaybe Coin
SNothing -> ShelleyDelegCert -> Encoding
encodeShelleyDelegCert (ShelleyDelegCert -> Encoding) -> ShelleyDelegCert -> Encoding
forall a b. (a -> b) -> a -> b
$ Credential 'Staking -> ShelleyDelegCert
ShelleyRegCert Credential 'Staking
cred
    ConwayUnRegCert Credential 'Staking
cred StrictMaybe Coin
SNothing -> ShelleyDelegCert -> Encoding
encodeShelleyDelegCert (ShelleyDelegCert -> Encoding) -> ShelleyDelegCert -> Encoding
forall a b. (a -> b) -> a -> b
$ Credential 'Staking -> ShelleyDelegCert
ShelleyUnRegCert Credential 'Staking
cred
    ConwayDelegCert Credential 'Staking
cred (DelegStake KeyHash 'StakePool
poolId) -> ShelleyDelegCert -> Encoding
encodeShelleyDelegCert (ShelleyDelegCert -> Encoding) -> ShelleyDelegCert -> Encoding
forall a b. (a -> b) -> a -> b
$ Credential 'Staking -> KeyHash 'StakePool -> ShelleyDelegCert
ShelleyDelegCert Credential 'Staking
cred KeyHash 'StakePool
poolId
    -- New in Conway
    ConwayRegCert Credential 'Staking
cred (SJust Coin
deposit) ->
      Word -> Encoding
encodeListLen Word
3
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
encodeWord8 Word8
7
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Credential 'Staking -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Credential 'Staking
cred
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Coin -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Coin
deposit
    ConwayUnRegCert Credential 'Staking
cred (SJust Coin
deposit) ->
      Word -> Encoding
encodeListLen Word
3
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
encodeWord8 Word8
8
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Credential 'Staking -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Credential 'Staking
cred
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Coin -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Coin
deposit
    ConwayDelegCert Credential 'Staking
cred (DelegVote DRep
drep) ->
      Word -> Encoding
encodeListLen Word
3
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
encodeWord8 Word8
9
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Credential 'Staking -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Credential 'Staking
cred
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> DRep -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR DRep
drep
    ConwayDelegCert Credential 'Staking
cred (DelegStakeVote KeyHash 'StakePool
poolId DRep
dRep) ->
      Word -> Encoding
encodeListLen Word
4
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
encodeWord8 Word8
10
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Credential 'Staking -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Credential 'Staking
cred
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> KeyHash 'StakePool -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR KeyHash 'StakePool
poolId
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> DRep -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR DRep
dRep
    ConwayRegDelegCert Credential 'Staking
cred (DelegStake KeyHash 'StakePool
poolId) Coin
deposit ->
      Word -> Encoding
encodeListLen Word
4
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
encodeWord8 Word8
11
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Credential 'Staking -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Credential 'Staking
cred
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> KeyHash 'StakePool -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR KeyHash 'StakePool
poolId
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Coin -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Coin
deposit
    ConwayRegDelegCert Credential 'Staking
cred (DelegVote DRep
drep) Coin
deposit ->
      Word -> Encoding
encodeListLen Word
4
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
encodeWord8 Word8
12
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Credential 'Staking -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Credential 'Staking
cred
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> DRep -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR DRep
drep
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Coin -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Coin
deposit
    ConwayRegDelegCert Credential 'Staking
cred (DelegStakeVote KeyHash 'StakePool
poolId DRep
dRep) Coin
deposit ->
      Word -> Encoding
encodeListLen Word
5
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
encodeWord8 Word8
13
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Credential 'Staking -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Credential 'Staking
cred
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> KeyHash 'StakePool -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR KeyHash 'StakePool
poolId
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> DRep -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR DRep
dRep
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Coin -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Coin
deposit

instance NFData ConwayDelegCert

instance NoThunks ConwayDelegCert

instance ToJSON ConwayDelegCert where
  toJSON :: ConwayDelegCert -> Value
toJSON = \case
    ConwayRegCert Credential 'Staking
cred StrictMaybe Coin
deposit ->
      Text -> [Pair] -> Value
kindObject Text
"RegCert" ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        [ Key
"credential" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Credential 'Staking -> Value
forall a. ToJSON a => a -> Value
toJSON Credential 'Staking
cred
        , Key
"deposit" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StrictMaybe Coin -> Value
forall a. ToJSON a => a -> Value
toJSON StrictMaybe Coin
deposit
        ]
    ConwayUnRegCert Credential 'Staking
cred StrictMaybe Coin
refund ->
      Text -> [Pair] -> Value
kindObject Text
"UnRegCert" ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        [ Key
"credential" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Credential 'Staking -> Value
forall a. ToJSON a => a -> Value
toJSON Credential 'Staking
cred
        , Key
"refund" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StrictMaybe Coin -> Value
forall a. ToJSON a => a -> Value
toJSON StrictMaybe Coin
refund
        ]
    ConwayDelegCert Credential 'Staking
cred Delegatee
delegatee ->
      Text -> [Pair] -> Value
kindObject Text
"DelegCert" ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        [ Key
"credential" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Credential 'Staking -> Value
forall a. ToJSON a => a -> Value
toJSON Credential 'Staking
cred
        , Key
"delegatee" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Delegatee -> Value
forall a. ToJSON a => a -> Value
toJSON Delegatee
delegatee
        ]
    ConwayRegDelegCert Credential 'Staking
cred Delegatee
delegatee Coin
deposit ->
      Text -> [Pair] -> Value
kindObject Text
"RegDelegCert" ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        [ Key
"credential" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Credential 'Staking -> Value
forall a. ToJSON a => a -> Value
toJSON Credential 'Staking
cred
        , Key
"delegatee" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Delegatee -> Value
forall a. ToJSON a => a -> Value
toJSON Delegatee
delegatee
        , Key
"deposit" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin -> Value
forall a. ToJSON a => a -> Value
toJSON Coin
deposit
        ]

data ConwayGovCert
  = ConwayRegDRep !(Credential 'DRepRole) !Coin !(StrictMaybe Anchor)
  | ConwayUnRegDRep !(Credential 'DRepRole) !Coin
  | ConwayUpdateDRep !(Credential 'DRepRole) !(StrictMaybe Anchor)
  | ConwayAuthCommitteeHotKey !(Credential 'ColdCommitteeRole) !(Credential 'HotCommitteeRole)
  | ConwayResignCommitteeColdKey !(Credential 'ColdCommitteeRole) !(StrictMaybe Anchor)
  deriving (Int -> ConwayGovCert -> ShowS
[ConwayGovCert] -> ShowS
ConwayGovCert -> String
(Int -> ConwayGovCert -> ShowS)
-> (ConwayGovCert -> String)
-> ([ConwayGovCert] -> ShowS)
-> Show ConwayGovCert
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConwayGovCert -> ShowS
showsPrec :: Int -> ConwayGovCert -> ShowS
$cshow :: ConwayGovCert -> String
show :: ConwayGovCert -> String
$cshowList :: [ConwayGovCert] -> ShowS
showList :: [ConwayGovCert] -> ShowS
Show, (forall x. ConwayGovCert -> Rep ConwayGovCert x)
-> (forall x. Rep ConwayGovCert x -> ConwayGovCert)
-> Generic ConwayGovCert
forall x. Rep ConwayGovCert x -> ConwayGovCert
forall x. ConwayGovCert -> Rep ConwayGovCert x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ConwayGovCert -> Rep ConwayGovCert x
from :: forall x. ConwayGovCert -> Rep ConwayGovCert x
$cto :: forall x. Rep ConwayGovCert x -> ConwayGovCert
to :: forall x. Rep ConwayGovCert x -> ConwayGovCert
Generic, ConwayGovCert -> ConwayGovCert -> Bool
(ConwayGovCert -> ConwayGovCert -> Bool)
-> (ConwayGovCert -> ConwayGovCert -> Bool) -> Eq ConwayGovCert
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConwayGovCert -> ConwayGovCert -> Bool
== :: ConwayGovCert -> ConwayGovCert -> Bool
$c/= :: ConwayGovCert -> ConwayGovCert -> Bool
/= :: ConwayGovCert -> ConwayGovCert -> Bool
Eq, Eq ConwayGovCert
Eq ConwayGovCert =>
(ConwayGovCert -> ConwayGovCert -> Ordering)
-> (ConwayGovCert -> ConwayGovCert -> Bool)
-> (ConwayGovCert -> ConwayGovCert -> Bool)
-> (ConwayGovCert -> ConwayGovCert -> Bool)
-> (ConwayGovCert -> ConwayGovCert -> Bool)
-> (ConwayGovCert -> ConwayGovCert -> ConwayGovCert)
-> (ConwayGovCert -> ConwayGovCert -> ConwayGovCert)
-> Ord ConwayGovCert
ConwayGovCert -> ConwayGovCert -> Bool
ConwayGovCert -> ConwayGovCert -> Ordering
ConwayGovCert -> ConwayGovCert -> ConwayGovCert
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ConwayGovCert -> ConwayGovCert -> Ordering
compare :: ConwayGovCert -> ConwayGovCert -> Ordering
$c< :: ConwayGovCert -> ConwayGovCert -> Bool
< :: ConwayGovCert -> ConwayGovCert -> Bool
$c<= :: ConwayGovCert -> ConwayGovCert -> Bool
<= :: ConwayGovCert -> ConwayGovCert -> Bool
$c> :: ConwayGovCert -> ConwayGovCert -> Bool
> :: ConwayGovCert -> ConwayGovCert -> Bool
$c>= :: ConwayGovCert -> ConwayGovCert -> Bool
>= :: ConwayGovCert -> ConwayGovCert -> Bool
$cmax :: ConwayGovCert -> ConwayGovCert -> ConwayGovCert
max :: ConwayGovCert -> ConwayGovCert -> ConwayGovCert
$cmin :: ConwayGovCert -> ConwayGovCert -> ConwayGovCert
min :: ConwayGovCert -> ConwayGovCert -> ConwayGovCert
Ord)

instance NFData ConwayGovCert

instance NoThunks ConwayGovCert

instance ToJSON ConwayGovCert where
  toJSON :: ConwayGovCert -> Value
toJSON = \case
    ConwayRegDRep Credential 'DRepRole
dRep Coin
deposit StrictMaybe Anchor
anchor ->
      Text -> [Pair] -> Value
kindObject Text
"RegDRep" ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        [ Key
"dRep" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Credential 'DRepRole -> Value
forall a. ToJSON a => a -> Value
toJSON Credential 'DRepRole
dRep
        , Key
"deposit" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin -> Value
forall a. ToJSON a => a -> Value
toJSON Coin
deposit
        , Key
"anchor" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StrictMaybe Anchor -> Value
forall a. ToJSON a => a -> Value
toJSON StrictMaybe Anchor
anchor
        ]
    ConwayUnRegDRep Credential 'DRepRole
dRep Coin
refund ->
      Text -> [Pair] -> Value
kindObject Text
"UnRegDRep" ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        [ Key
"dRep" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Credential 'DRepRole -> Value
forall a. ToJSON a => a -> Value
toJSON Credential 'DRepRole
dRep
        , Key
"refund" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin -> Value
forall a. ToJSON a => a -> Value
toJSON Coin
refund
        ]
    ConwayUpdateDRep Credential 'DRepRole
dRep StrictMaybe Anchor
anchor ->
      Text -> [Pair] -> Value
kindObject Text
"UpdateDRep" ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        [ Key
"dRep" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Credential 'DRepRole -> Value
forall a. ToJSON a => a -> Value
toJSON Credential 'DRepRole
dRep
        , Key
"anchor" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StrictMaybe Anchor -> Value
forall a. ToJSON a => a -> Value
toJSON StrictMaybe Anchor
anchor
        ]
    ConwayAuthCommitteeHotKey Credential 'ColdCommitteeRole
coldCred Credential 'HotCommitteeRole
hotCred ->
      Text -> [Pair] -> Value
kindObject Text
"AuthCommitteeHotKey" ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        [ Key
"coldCredential" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Credential 'ColdCommitteeRole -> Value
forall a. ToJSON a => a -> Value
toJSON Credential 'ColdCommitteeRole
coldCred
        , Key
"hotCredential" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Credential 'HotCommitteeRole -> Value
forall a. ToJSON a => a -> Value
toJSON Credential 'HotCommitteeRole
hotCred
        ]
    ConwayResignCommitteeColdKey Credential 'ColdCommitteeRole
coldCred StrictMaybe Anchor
anchor ->
      Text -> [Pair] -> Value
kindObject Text
"ResignCommitteeColdKey" ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        [ Key
"coldCredential" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Credential 'ColdCommitteeRole -> Value
forall a. ToJSON a => a -> Value
toJSON Credential 'ColdCommitteeRole
coldCred
        , Key
"anchor" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StrictMaybe Anchor -> Value
forall a. ToJSON a => a -> Value
toJSON StrictMaybe Anchor
anchor
        ]

instance EncCBOR ConwayGovCert where
  encCBOR :: ConwayGovCert -> Encoding
encCBOR = \case
    ConwayAuthCommitteeHotKey Credential 'ColdCommitteeRole
cred Credential 'HotCommitteeRole
key ->
      Word -> Encoding
encodeListLen Word
3
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
encodeWord8 Word8
14
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Credential 'ColdCommitteeRole -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Credential 'ColdCommitteeRole
cred
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Credential 'HotCommitteeRole -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Credential 'HotCommitteeRole
key
    ConwayResignCommitteeColdKey Credential 'ColdCommitteeRole
cred StrictMaybe Anchor
a ->
      Word -> Encoding
encodeListLen Word
3
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
encodeWord8 Word8
15
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Credential 'ColdCommitteeRole -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Credential 'ColdCommitteeRole
cred
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (Anchor -> Encoding) -> StrictMaybe Anchor -> Encoding
forall a. (a -> Encoding) -> StrictMaybe a -> Encoding
encodeNullStrictMaybe Anchor -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR StrictMaybe Anchor
a
    ConwayRegDRep Credential 'DRepRole
cred Coin
deposit StrictMaybe Anchor
mAnchor ->
      Word -> Encoding
encodeListLen Word
4
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
encodeWord8 Word8
16
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Credential 'DRepRole -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Credential 'DRepRole
cred
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Coin -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Coin
deposit
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (Anchor -> Encoding) -> StrictMaybe Anchor -> Encoding
forall a. (a -> Encoding) -> StrictMaybe a -> Encoding
encodeNullStrictMaybe Anchor -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR StrictMaybe Anchor
mAnchor
    ConwayUnRegDRep Credential 'DRepRole
cred Coin
deposit ->
      Word -> Encoding
encodeListLen Word
3
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
encodeWord8 Word8
17
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Credential 'DRepRole -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Credential 'DRepRole
cred
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Coin -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Coin
deposit
    ConwayUpdateDRep Credential 'DRepRole
cred StrictMaybe Anchor
mAnchor ->
      Word -> Encoding
encodeListLen Word
3
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
encodeWord8 Word8
18
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Credential 'DRepRole -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Credential 'DRepRole
cred
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (Anchor -> Encoding) -> StrictMaybe Anchor -> Encoding
forall a. (a -> Encoding) -> StrictMaybe a -> Encoding
encodeNullStrictMaybe Anchor -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR StrictMaybe Anchor
mAnchor

data ConwayTxCert era
  = ConwayTxCertDeleg !ConwayDelegCert
  | ConwayTxCertPool !PoolCert
  | ConwayTxCertGov !ConwayGovCert
  deriving (Int -> ConwayTxCert era -> ShowS
[ConwayTxCert era] -> ShowS
ConwayTxCert era -> String
(Int -> ConwayTxCert era -> ShowS)
-> (ConwayTxCert era -> String)
-> ([ConwayTxCert era] -> ShowS)
-> Show (ConwayTxCert era)
forall era. Int -> ConwayTxCert era -> ShowS
forall era. [ConwayTxCert era] -> ShowS
forall era. ConwayTxCert era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era. Int -> ConwayTxCert era -> ShowS
showsPrec :: Int -> ConwayTxCert era -> ShowS
$cshow :: forall era. ConwayTxCert era -> String
show :: ConwayTxCert era -> String
$cshowList :: forall era. [ConwayTxCert era] -> ShowS
showList :: [ConwayTxCert era] -> ShowS
Show, (forall x. ConwayTxCert era -> Rep (ConwayTxCert era) x)
-> (forall x. Rep (ConwayTxCert era) x -> ConwayTxCert era)
-> Generic (ConwayTxCert era)
forall x. Rep (ConwayTxCert era) x -> ConwayTxCert era
forall x. ConwayTxCert era -> Rep (ConwayTxCert era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (ConwayTxCert era) x -> ConwayTxCert era
forall era x. ConwayTxCert era -> Rep (ConwayTxCert era) x
$cfrom :: forall era x. ConwayTxCert era -> Rep (ConwayTxCert era) x
from :: forall x. ConwayTxCert era -> Rep (ConwayTxCert era) x
$cto :: forall era x. Rep (ConwayTxCert era) x -> ConwayTxCert era
to :: forall x. Rep (ConwayTxCert era) x -> ConwayTxCert era
Generic, ConwayTxCert era -> ConwayTxCert era -> Bool
(ConwayTxCert era -> ConwayTxCert era -> Bool)
-> (ConwayTxCert era -> ConwayTxCert era -> Bool)
-> Eq (ConwayTxCert era)
forall era. ConwayTxCert era -> ConwayTxCert era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall era. ConwayTxCert era -> ConwayTxCert era -> Bool
== :: ConwayTxCert era -> ConwayTxCert era -> Bool
$c/= :: forall era. ConwayTxCert era -> ConwayTxCert era -> Bool
/= :: ConwayTxCert era -> ConwayTxCert era -> Bool
Eq, Eq (ConwayTxCert era)
Eq (ConwayTxCert era) =>
(ConwayTxCert era -> ConwayTxCert era -> Ordering)
-> (ConwayTxCert era -> ConwayTxCert era -> Bool)
-> (ConwayTxCert era -> ConwayTxCert era -> Bool)
-> (ConwayTxCert era -> ConwayTxCert era -> Bool)
-> (ConwayTxCert era -> ConwayTxCert era -> Bool)
-> (ConwayTxCert era -> ConwayTxCert era -> ConwayTxCert era)
-> (ConwayTxCert era -> ConwayTxCert era -> ConwayTxCert era)
-> Ord (ConwayTxCert era)
ConwayTxCert era -> ConwayTxCert era -> Bool
ConwayTxCert era -> ConwayTxCert era -> Ordering
ConwayTxCert era -> ConwayTxCert era -> ConwayTxCert era
forall era. Eq (ConwayTxCert era)
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall era. ConwayTxCert era -> ConwayTxCert era -> Bool
forall era. ConwayTxCert era -> ConwayTxCert era -> Ordering
forall era.
ConwayTxCert era -> ConwayTxCert era -> ConwayTxCert era
$ccompare :: forall era. ConwayTxCert era -> ConwayTxCert era -> Ordering
compare :: ConwayTxCert era -> ConwayTxCert era -> Ordering
$c< :: forall era. ConwayTxCert era -> ConwayTxCert era -> Bool
< :: ConwayTxCert era -> ConwayTxCert era -> Bool
$c<= :: forall era. ConwayTxCert era -> ConwayTxCert era -> Bool
<= :: ConwayTxCert era -> ConwayTxCert era -> Bool
$c> :: forall era. ConwayTxCert era -> ConwayTxCert era -> Bool
> :: ConwayTxCert era -> ConwayTxCert era -> Bool
$c>= :: forall era. ConwayTxCert era -> ConwayTxCert era -> Bool
>= :: ConwayTxCert era -> ConwayTxCert era -> Bool
$cmax :: forall era.
ConwayTxCert era -> ConwayTxCert era -> ConwayTxCert era
max :: ConwayTxCert era -> ConwayTxCert era -> ConwayTxCert era
$cmin :: forall era.
ConwayTxCert era -> ConwayTxCert era -> ConwayTxCert era
min :: ConwayTxCert era -> ConwayTxCert era -> ConwayTxCert era
Ord)

instance NFData (ConwayTxCert era)

instance NoThunks (ConwayTxCert era)

instance Era era => ToJSON (ConwayTxCert era) where
  toJSON :: ConwayTxCert era -> Value
toJSON = \case
    ConwayTxCertDeleg ConwayDelegCert
delegCert -> ConwayDelegCert -> Value
forall a. ToJSON a => a -> Value
toJSON ConwayDelegCert
delegCert
    ConwayTxCertPool PoolCert
poolCert -> PoolCert -> Value
forall a. ToJSON a => a -> Value
toJSON PoolCert
poolCert
    ConwayTxCertGov ConwayGovCert
govCert -> ConwayGovCert -> Value
forall a. ToJSON a => a -> Value
toJSON ConwayGovCert
govCert

instance
  ( ShelleyEraTxCert era
  , TxCert era ~ ConwayTxCert era
  ) =>
  FromCBOR (ConwayTxCert era)
  where
  fromCBOR :: forall s. Decoder s (ConwayTxCert era)
fromCBOR = forall era t s. (Era era, DecCBOR t) => Decoder s t
fromEraCBOR @era

instance
  ( ConwayEraTxCert era
  , TxCert era ~ ConwayTxCert era
  ) =>
  DecCBOR (ConwayTxCert era)
  where
  decCBOR :: forall s. Decoder s (ConwayTxCert era)
decCBOR = Text
-> (Word -> Decoder s (Int, ConwayTxCert era))
-> Decoder s (ConwayTxCert era)
forall s a. Text -> (Word -> Decoder s (Int, a)) -> Decoder s a
decodeRecordSum Text
"ConwayTxCert" ((Word -> Decoder s (Int, ConwayTxCert era))
 -> Decoder s (ConwayTxCert era))
-> (Word -> Decoder s (Int, ConwayTxCert era))
-> Decoder s (ConwayTxCert era)
forall a b. (a -> b) -> a -> b
$ \case
    Word
t
      | Word
0 Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
t Bool -> Bool -> Bool
&& Word
t Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
3 -> Word -> Decoder s (Int, TxCert era)
forall era s.
ShelleyEraTxCert era =>
Word -> Decoder s (Int, TxCert era)
shelleyTxCertDelegDecoder Word
t
      | Word
3 Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
t Bool -> Bool -> Bool
&& Word
t Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
5 -> Word -> Decoder s (Int, TxCert era)
forall era s. EraTxCert era => Word -> Decoder s (Int, TxCert era)
poolTxCertDecoder Word
t
      | Word
t Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
5 -> String -> Decoder s (Int, ConwayTxCert era)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Genesis delegation certificates are no longer supported"
      | Word
t Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
6 -> String -> Decoder s (Int, ConwayTxCert era)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"MIR certificates are no longer supported"
      | Word
7 Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
t -> Word -> Decoder s (Int, TxCert era)
forall era s.
ConwayEraTxCert era =>
Word -> Decoder s (Int, TxCert era)
conwayTxCertDelegDecoder Word
t
    Word
t -> Word -> Decoder s (Int, ConwayTxCert era)
forall a (m :: * -> *). (Typeable a, MonadFail m) => Word -> m a
invalidKey Word
t

conwayTxCertDelegDecoder :: ConwayEraTxCert era => Word -> Decoder s (Int, TxCert era)
conwayTxCertDelegDecoder :: forall era s.
ConwayEraTxCert era =>
Word -> Decoder s (Int, TxCert era)
conwayTxCertDelegDecoder = \case
  Word
7 -> do
    Credential 'Staking
cred <- Decoder s (Credential 'Staking)
forall s. Decoder s (Credential 'Staking)
forall a s. DecCBOR a => Decoder s a
decCBOR
    Coin
deposit <- Decoder s Coin
forall s. Decoder s Coin
forall a s. DecCBOR a => Decoder s a
decCBOR
    (Int, TxCert era) -> Decoder s (Int, TxCert era)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
3, Credential 'Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert Credential 'Staking
cred Coin
deposit)
  Word
8 -> do
    Credential 'Staking
cred <- Decoder s (Credential 'Staking)
forall s. Decoder s (Credential 'Staking)
forall a s. DecCBOR a => Decoder s a
decCBOR
    Coin
deposit <- Decoder s Coin
forall s. Decoder s Coin
forall a s. DecCBOR a => Decoder s a
decCBOR
    (Int, TxCert era) -> Decoder s (Int, TxCert era)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
3, Credential 'Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
UnRegDepositTxCert Credential 'Staking
cred Coin
deposit)
  Word
9 -> Int -> Decoder s Delegatee -> Decoder s (Int, TxCert era)
forall {era} {a} {s}.
(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) =>
a -> Decoder s Delegatee -> Decoder s (a, TxCert era)
delegCertDecoder Int
3 (DRep -> Delegatee
DelegVote (DRep -> Delegatee) -> Decoder s DRep -> Decoder s Delegatee
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s DRep
forall s. Decoder s DRep
forall a s. DecCBOR a => Decoder s a
decCBOR)
  Word
10 -> Int -> Decoder s Delegatee -> Decoder s (Int, TxCert era)
forall {era} {a} {s}.
(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) =>
a -> Decoder s Delegatee -> Decoder s (a, TxCert era)
delegCertDecoder Int
4 (KeyHash 'StakePool -> DRep -> Delegatee
DelegStakeVote (KeyHash 'StakePool -> DRep -> Delegatee)
-> Decoder s (KeyHash 'StakePool) -> Decoder s (DRep -> Delegatee)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (KeyHash 'StakePool)
forall s. Decoder s (KeyHash 'StakePool)
forall a s. DecCBOR a => Decoder s a
decCBOR Decoder s (DRep -> Delegatee)
-> Decoder s DRep -> Decoder s Delegatee
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s DRep
forall s. Decoder s DRep
forall a s. DecCBOR a => Decoder s a
decCBOR)
  Word
11 -> Int -> Decoder s Delegatee -> Decoder s (Int, TxCert era)
forall {era} {a} {s}.
(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) =>
a -> Decoder s Delegatee -> Decoder s (a, TxCert era)
regDelegCertDecoder Int
4 (KeyHash 'StakePool -> Delegatee
DelegStake (KeyHash 'StakePool -> Delegatee)
-> Decoder s (KeyHash 'StakePool) -> Decoder s Delegatee
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (KeyHash 'StakePool)
forall s. Decoder s (KeyHash 'StakePool)
forall a s. DecCBOR a => Decoder s a
decCBOR)
  Word
12 -> Int -> Decoder s Delegatee -> Decoder s (Int, TxCert era)
forall {era} {a} {s}.
(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) =>
a -> Decoder s Delegatee -> Decoder s (a, TxCert era)
regDelegCertDecoder Int
4 (DRep -> Delegatee
DelegVote (DRep -> Delegatee) -> Decoder s DRep -> Decoder s Delegatee
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s DRep
forall s. Decoder s DRep
forall a s. DecCBOR a => Decoder s a
decCBOR)
  Word
13 -> Int -> Decoder s Delegatee -> Decoder s (Int, TxCert era)
forall {era} {a} {s}.
(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) =>
a -> Decoder s Delegatee -> Decoder s (a, TxCert era)
regDelegCertDecoder Int
5 (KeyHash 'StakePool -> DRep -> Delegatee
DelegStakeVote (KeyHash 'StakePool -> DRep -> Delegatee)
-> Decoder s (KeyHash 'StakePool) -> Decoder s (DRep -> Delegatee)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (KeyHash 'StakePool)
forall s. Decoder s (KeyHash 'StakePool)
forall a s. DecCBOR a => Decoder s a
decCBOR Decoder s (DRep -> Delegatee)
-> Decoder s DRep -> Decoder s Delegatee
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s DRep
forall s. Decoder s DRep
forall a s. DecCBOR a => Decoder s a
decCBOR)
  Word
14 -> do
    Credential 'ColdCommitteeRole
cred <- Decoder s (Credential 'ColdCommitteeRole)
forall s. Decoder s (Credential 'ColdCommitteeRole)
forall a s. DecCBOR a => Decoder s a
decCBOR
    Credential 'HotCommitteeRole
key <- Decoder s (Credential 'HotCommitteeRole)
forall s. Decoder s (Credential 'HotCommitteeRole)
forall a s. DecCBOR a => Decoder s a
decCBOR
    (Int, TxCert era) -> Decoder s (Int, TxCert era)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
3, Credential 'ColdCommitteeRole
-> Credential 'HotCommitteeRole -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'ColdCommitteeRole
-> Credential 'HotCommitteeRole -> TxCert era
AuthCommitteeHotKeyTxCert Credential 'ColdCommitteeRole
cred Credential 'HotCommitteeRole
key)
  Word
15 -> do
    Credential 'ColdCommitteeRole
cred <- Decoder s (Credential 'ColdCommitteeRole)
forall s. Decoder s (Credential 'ColdCommitteeRole)
forall a s. DecCBOR a => Decoder s a
decCBOR
    StrictMaybe Anchor
a <- Decoder s Anchor -> Decoder s (StrictMaybe Anchor)
forall s a. Decoder s a -> Decoder s (StrictMaybe a)
decodeNullStrictMaybe Decoder s Anchor
forall s. Decoder s Anchor
forall a s. DecCBOR a => Decoder s a
decCBOR
    (Int, TxCert era) -> Decoder s (Int, TxCert era)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
3, Credential 'ColdCommitteeRole -> StrictMaybe Anchor -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'ColdCommitteeRole -> StrictMaybe Anchor -> TxCert era
ResignCommitteeColdTxCert Credential 'ColdCommitteeRole
cred StrictMaybe Anchor
a)
  Word
16 -> do
    Credential 'DRepRole
cred <- Decoder s (Credential 'DRepRole)
forall s. Decoder s (Credential 'DRepRole)
forall a s. DecCBOR a => Decoder s a
decCBOR
    Coin
deposit <- Decoder s Coin
forall s. Decoder s Coin
forall a s. DecCBOR a => Decoder s a
decCBOR
    StrictMaybe Anchor
mAnchor <- Decoder s Anchor -> Decoder s (StrictMaybe Anchor)
forall s a. Decoder s a -> Decoder s (StrictMaybe a)
decodeNullStrictMaybe Decoder s Anchor
forall s. Decoder s Anchor
forall a s. DecCBOR a => Decoder s a
decCBOR
    (Int, TxCert era) -> Decoder s (Int, TxCert era)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
4, Credential 'DRepRole -> Coin -> StrictMaybe Anchor -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'DRepRole -> Coin -> StrictMaybe Anchor -> TxCert era
RegDRepTxCert Credential 'DRepRole
cred Coin
deposit StrictMaybe Anchor
mAnchor)
  Word
17 -> do
    Credential 'DRepRole
cred <- Decoder s (Credential 'DRepRole)
forall s. Decoder s (Credential 'DRepRole)
forall a s. DecCBOR a => Decoder s a
decCBOR
    Coin
deposit <- Decoder s Coin
forall s. Decoder s Coin
forall a s. DecCBOR a => Decoder s a
decCBOR
    (Int, TxCert era) -> Decoder s (Int, TxCert era)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
3, Credential 'DRepRole -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'DRepRole -> Coin -> TxCert era
UnRegDRepTxCert Credential 'DRepRole
cred Coin
deposit)
  Word
18 -> do
    Credential 'DRepRole
cred <- Decoder s (Credential 'DRepRole)
forall s. Decoder s (Credential 'DRepRole)
forall a s. DecCBOR a => Decoder s a
decCBOR
    StrictMaybe Anchor
mAnchor <- Decoder s Anchor -> Decoder s (StrictMaybe Anchor)
forall s a. Decoder s a -> Decoder s (StrictMaybe a)
decodeNullStrictMaybe Decoder s Anchor
forall s. Decoder s Anchor
forall a s. DecCBOR a => Decoder s a
decCBOR
    (Int, TxCert era) -> Decoder s (Int, TxCert era)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
3, Credential 'DRepRole -> StrictMaybe Anchor -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'DRepRole -> StrictMaybe Anchor -> TxCert era
UpdateDRepTxCert Credential 'DRepRole
cred StrictMaybe Anchor
mAnchor)
  Word
k -> Word -> Decoder s (Int, TxCert era)
forall a (m :: * -> *). (Typeable a, MonadFail m) => Word -> m a
invalidKey Word
k
  where
    delegCertDecoder :: a -> Decoder s Delegatee -> Decoder s (a, TxCert era)
delegCertDecoder a
n Decoder s Delegatee
decodeDelegatee = do
      Credential 'Staking
cred <- Decoder s (Credential 'Staking)
forall s. Decoder s (Credential 'Staking)
forall a s. DecCBOR a => Decoder s a
decCBOR
      Delegatee
delegatee <- Decoder s Delegatee
decodeDelegatee
      (a, TxCert era) -> Decoder s (a, TxCert era)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
n, Credential 'Staking -> Delegatee -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert Credential 'Staking
cred Delegatee
delegatee)
    {-# INLINE delegCertDecoder #-}
    regDelegCertDecoder :: a -> Decoder s Delegatee -> Decoder s (a, TxCert era)
regDelegCertDecoder a
n Decoder s Delegatee
decodeDelegatee = do
      Credential 'Staking
cred <- Decoder s (Credential 'Staking)
forall s. Decoder s (Credential 'Staking)
forall a s. DecCBOR a => Decoder s a
decCBOR
      Delegatee
delegatee <- Decoder s Delegatee
decodeDelegatee
      Coin
deposit <- Decoder s Coin
forall s. Decoder s Coin
forall a s. DecCBOR a => Decoder s a
decCBOR
      (a, TxCert era) -> Decoder s (a, TxCert era)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
n, Credential 'Staking -> Delegatee -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> Coin -> TxCert era
RegDepositDelegTxCert Credential 'Staking
cred Delegatee
delegatee Coin
deposit)
    {-# INLINE regDelegCertDecoder #-}
{-# INLINE conwayTxCertDelegDecoder #-}

instance (Era era, Val (Value era)) => ToCBOR (ConwayTxCert era) where
  toCBOR :: ConwayTxCert era -> Encoding
toCBOR = Version -> Encoding -> Encoding
toPlainEncoding (forall era. Era era => Version
eraProtVerLow @era) (Encoding -> Encoding)
-> (ConwayTxCert era -> Encoding) -> ConwayTxCert era -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConwayTxCert era -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR

instance (Era era, Val (Value era)) => EncCBOR (ConwayTxCert era) where
  encCBOR :: ConwayTxCert era -> Encoding
encCBOR = \case
    ConwayTxCertDeleg ConwayDelegCert
delegCert -> ConwayDelegCert -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR ConwayDelegCert
delegCert
    ConwayTxCertPool PoolCert
poolCert -> PoolCert -> Encoding
encodePoolCert PoolCert
poolCert
    ConwayTxCertGov ConwayGovCert
govCert -> ConwayGovCert -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR ConwayGovCert
govCert

fromShelleyDelegCert :: ShelleyDelegCert -> ConwayDelegCert
fromShelleyDelegCert :: ShelleyDelegCert -> ConwayDelegCert
fromShelleyDelegCert = \case
  ShelleyRegCert Credential 'Staking
cred -> Credential 'Staking -> StrictMaybe Coin -> ConwayDelegCert
ConwayRegCert Credential 'Staking
cred StrictMaybe Coin
forall a. StrictMaybe a
SNothing
  ShelleyUnRegCert Credential 'Staking
cred -> Credential 'Staking -> StrictMaybe Coin -> ConwayDelegCert
ConwayUnRegCert Credential 'Staking
cred StrictMaybe Coin
forall a. StrictMaybe a
SNothing
  ShelleyDelegCert Credential 'Staking
cred KeyHash 'StakePool
poolId -> Credential 'Staking -> Delegatee -> ConwayDelegCert
ConwayDelegCert Credential 'Staking
cred (KeyHash 'StakePool -> Delegatee
DelegStake KeyHash 'StakePool
poolId)

toShelleyDelegCert :: ConwayDelegCert -> Maybe ShelleyDelegCert
toShelleyDelegCert :: ConwayDelegCert -> Maybe ShelleyDelegCert
toShelleyDelegCert = \case
  ConwayRegCert Credential 'Staking
cred StrictMaybe Coin
SNothing -> ShelleyDelegCert -> Maybe ShelleyDelegCert
forall a. a -> Maybe a
Just (ShelleyDelegCert -> Maybe ShelleyDelegCert)
-> ShelleyDelegCert -> Maybe ShelleyDelegCert
forall a b. (a -> b) -> a -> b
$ Credential 'Staking -> ShelleyDelegCert
ShelleyRegCert Credential 'Staking
cred
  ConwayUnRegCert Credential 'Staking
cred StrictMaybe Coin
SNothing -> ShelleyDelegCert -> Maybe ShelleyDelegCert
forall a. a -> Maybe a
Just (ShelleyDelegCert -> Maybe ShelleyDelegCert)
-> ShelleyDelegCert -> Maybe ShelleyDelegCert
forall a b. (a -> b) -> a -> b
$ Credential 'Staking -> ShelleyDelegCert
ShelleyUnRegCert Credential 'Staking
cred
  ConwayDelegCert Credential 'Staking
cred (DelegStake KeyHash 'StakePool
poolId) -> ShelleyDelegCert -> Maybe ShelleyDelegCert
forall a. a -> Maybe a
Just (ShelleyDelegCert -> Maybe ShelleyDelegCert)
-> ShelleyDelegCert -> Maybe ShelleyDelegCert
forall a b. (a -> b) -> a -> b
$ Credential 'Staking -> KeyHash 'StakePool -> ShelleyDelegCert
ShelleyDelegCert Credential 'Staking
cred KeyHash 'StakePool
poolId
  ConwayDelegCert
_ -> Maybe ShelleyDelegCert
forall a. Maybe a
Nothing

-- For both of the functions `getScriptWitnessConwayTxCert` and
-- `getVKeyWitnessConwayTxCert` we preserve the old behavior of not requiring a witness
-- for staking credential registration, but only during the transitional period of Conway
-- era and only for staking credential registration certificates without a deposit. Future
-- eras will require a witness for registration certificates, because the one without a
-- deposit will be removed.

getScriptWitnessConwayTxCert ::
  ConwayTxCert era ->
  Maybe ScriptHash
getScriptWitnessConwayTxCert :: forall era. ConwayTxCert era -> Maybe ScriptHash
getScriptWitnessConwayTxCert = \case
  ConwayTxCertDeleg ConwayDelegCert
delegCert ->
    case ConwayDelegCert
delegCert of
      ConwayRegCert Credential 'Staking
_ StrictMaybe Coin
SNothing -> Maybe ScriptHash
forall a. Maybe a
Nothing
      ConwayRegCert Credential 'Staking
cred (SJust Coin
_) -> Credential 'Staking -> Maybe ScriptHash
forall (kr :: KeyRole). Credential kr -> Maybe ScriptHash
credScriptHash Credential 'Staking
cred
      ConwayUnRegCert Credential 'Staking
cred StrictMaybe Coin
_ -> Credential 'Staking -> Maybe ScriptHash
forall (kr :: KeyRole). Credential kr -> Maybe ScriptHash
credScriptHash Credential 'Staking
cred
      ConwayDelegCert Credential 'Staking
cred Delegatee
_ -> Credential 'Staking -> Maybe ScriptHash
forall (kr :: KeyRole). Credential kr -> Maybe ScriptHash
credScriptHash Credential 'Staking
cred
      ConwayRegDelegCert Credential 'Staking
cred Delegatee
_ Coin
_ -> Credential 'Staking -> Maybe ScriptHash
forall (kr :: KeyRole). Credential kr -> Maybe ScriptHash
credScriptHash Credential 'Staking
cred
  -- PoolIds can't be Scripts
  ConwayTxCertPool {} -> Maybe ScriptHash
forall a. Maybe a
Nothing
  ConwayTxCertGov ConwayGovCert
govCert -> ConwayGovCert -> Maybe ScriptHash
govWitness ConwayGovCert
govCert
  where
    govWitness :: ConwayGovCert -> Maybe ScriptHash
    govWitness :: ConwayGovCert -> Maybe ScriptHash
govWitness = \case
      ConwayAuthCommitteeHotKey Credential 'ColdCommitteeRole
coldCred Credential 'HotCommitteeRole
_hotCred -> Credential 'ColdCommitteeRole -> Maybe ScriptHash
forall (kr :: KeyRole). Credential kr -> Maybe ScriptHash
credScriptHash Credential 'ColdCommitteeRole
coldCred
      ConwayResignCommitteeColdKey Credential 'ColdCommitteeRole
coldCred StrictMaybe Anchor
_ -> Credential 'ColdCommitteeRole -> Maybe ScriptHash
forall (kr :: KeyRole). Credential kr -> Maybe ScriptHash
credScriptHash Credential 'ColdCommitteeRole
coldCred
      ConwayRegDRep Credential 'DRepRole
cred Coin
_ StrictMaybe Anchor
_ -> Credential 'DRepRole -> Maybe ScriptHash
forall (kr :: KeyRole). Credential kr -> Maybe ScriptHash
credScriptHash Credential 'DRepRole
cred
      ConwayUnRegDRep Credential 'DRepRole
cred Coin
_ -> Credential 'DRepRole -> Maybe ScriptHash
forall (kr :: KeyRole). Credential kr -> Maybe ScriptHash
credScriptHash Credential 'DRepRole
cred
      ConwayUpdateDRep Credential 'DRepRole
cred StrictMaybe Anchor
_ -> Credential 'DRepRole -> Maybe ScriptHash
forall (kr :: KeyRole). Credential kr -> Maybe ScriptHash
credScriptHash Credential 'DRepRole
cred

getVKeyWitnessConwayTxCert :: ConwayTxCert era -> Maybe (KeyHash 'Witness)
getVKeyWitnessConwayTxCert :: forall era. ConwayTxCert era -> Maybe (KeyHash 'Witness)
getVKeyWitnessConwayTxCert = \case
  ConwayTxCertDeleg ConwayDelegCert
delegCert ->
    case ConwayDelegCert
delegCert of
      ConwayRegCert Credential 'Staking
_ StrictMaybe Coin
SNothing -> Maybe (KeyHash 'Witness)
forall a. Maybe a
Nothing
      ConwayRegCert Credential 'Staking
cred (SJust Coin
_) -> Credential 'Staking -> Maybe (KeyHash 'Witness)
forall (r :: KeyRole). Credential r -> Maybe (KeyHash 'Witness)
credKeyHashWitness Credential 'Staking
cred
      ConwayUnRegCert Credential 'Staking
cred StrictMaybe Coin
_ -> Credential 'Staking -> Maybe (KeyHash 'Witness)
forall (r :: KeyRole). Credential r -> Maybe (KeyHash 'Witness)
credKeyHashWitness Credential 'Staking
cred
      ConwayDelegCert Credential 'Staking
cred Delegatee
_ -> Credential 'Staking -> Maybe (KeyHash 'Witness)
forall (r :: KeyRole). Credential r -> Maybe (KeyHash 'Witness)
credKeyHashWitness Credential 'Staking
cred
      ConwayRegDelegCert Credential 'Staking
cred Delegatee
_ Coin
_ -> Credential 'Staking -> Maybe (KeyHash 'Witness)
forall (r :: KeyRole). Credential r -> Maybe (KeyHash 'Witness)
credKeyHashWitness Credential 'Staking
cred
  ConwayTxCertPool PoolCert
poolCert -> KeyHash 'Witness -> Maybe (KeyHash 'Witness)
forall a. a -> Maybe a
Just (KeyHash 'Witness -> Maybe (KeyHash 'Witness))
-> KeyHash 'Witness -> Maybe (KeyHash 'Witness)
forall a b. (a -> b) -> a -> b
$ PoolCert -> KeyHash 'Witness
poolCertKeyHashWitness PoolCert
poolCert
  ConwayTxCertGov ConwayGovCert
govCert -> ConwayGovCert -> Maybe (KeyHash 'Witness)
govWitness ConwayGovCert
govCert
  where
    govWitness :: ConwayGovCert -> Maybe (KeyHash 'Witness)
    govWitness :: ConwayGovCert -> Maybe (KeyHash 'Witness)
govWitness = \case
      ConwayAuthCommitteeHotKey Credential 'ColdCommitteeRole
coldCred Credential 'HotCommitteeRole
_hotCred -> Credential 'ColdCommitteeRole -> Maybe (KeyHash 'Witness)
forall (r :: KeyRole). Credential r -> Maybe (KeyHash 'Witness)
credKeyHashWitness Credential 'ColdCommitteeRole
coldCred
      ConwayResignCommitteeColdKey Credential 'ColdCommitteeRole
coldCred StrictMaybe Anchor
_ -> Credential 'ColdCommitteeRole -> Maybe (KeyHash 'Witness)
forall (r :: KeyRole). Credential r -> Maybe (KeyHash 'Witness)
credKeyHashWitness Credential 'ColdCommitteeRole
coldCred
      ConwayRegDRep Credential 'DRepRole
cred Coin
_ StrictMaybe Anchor
_ -> Credential 'DRepRole -> Maybe (KeyHash 'Witness)
forall (r :: KeyRole). Credential r -> Maybe (KeyHash 'Witness)
credKeyHashWitness Credential 'DRepRole
cred
      ConwayUnRegDRep Credential 'DRepRole
cred Coin
_ -> Credential 'DRepRole -> Maybe (KeyHash 'Witness)
forall (r :: KeyRole). Credential r -> Maybe (KeyHash 'Witness)
credKeyHashWitness Credential 'DRepRole
cred
      ConwayUpdateDRep Credential 'DRepRole
cred StrictMaybe Anchor
_ -> Credential 'DRepRole -> Maybe (KeyHash 'Witness)
forall (r :: KeyRole). Credential r -> Maybe (KeyHash 'Witness)
credKeyHashWitness Credential 'DRepRole
cred

-- | Determine the total deposit amount needed from a TxBody.
-- The block may (legitimately) contain multiple registration certificates
-- for the same pool, where the first will be treated as a registration and
-- any subsequent ones as re-registration. As such, we must only take a
-- deposit for the first such registration. It is even possible for a single
-- transaction to have multiple pool registration for the same pool, so as
-- we process pool registrations, we must keep track of those that are already
-- registered, so we do not add a Deposit for the same pool twice.
--
-- Note that this is not an issue for key registrations since subsequent
-- registration certificates would be invalid.
conwayTotalDepositsTxCerts ::
  (ConwayEraPParams era, Foldable f, ConwayEraTxCert era) =>
  PParams era ->
  -- | Check whether a pool with a supplied PoolStakeId is already registered.
  (KeyHash 'StakePool -> Bool) ->
  f (TxCert era) ->
  Coin
conwayTotalDepositsTxCerts :: forall era (f :: * -> *).
(ConwayEraPParams era, Foldable f, ConwayEraTxCert era) =>
PParams era
-> (KeyHash 'StakePool -> Bool) -> f (TxCert era) -> Coin
conwayTotalDepositsTxCerts PParams era
pp KeyHash 'StakePool -> Bool
isRegPoolRegistered f (TxCert era)
certs =
  PParams era
-> (KeyHash 'StakePool -> Bool) -> f (TxCert era) -> Coin
forall era (f :: * -> *).
(EraPParams era, Foldable f, EraTxCert era) =>
PParams era
-> (KeyHash 'StakePool -> Bool) -> f (TxCert era) -> Coin
shelleyTotalDepositsTxCerts PParams era
pp KeyHash 'StakePool -> Bool
isRegPoolRegistered f (TxCert era)
certs
    Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> PParams era -> f (TxCert era) -> Coin
forall era (f :: * -> *).
(ConwayEraPParams era, Foldable f, ConwayEraTxCert era) =>
PParams era -> f (TxCert era) -> Coin
conwayDRepDepositsTxCerts PParams era
pp f (TxCert era)
certs

conwayDRepDepositsTxCerts ::
  (ConwayEraPParams era, Foldable f, ConwayEraTxCert era) =>
  PParams era ->
  f (TxCert era) ->
  Coin
conwayDRepDepositsTxCerts :: forall era (f :: * -> *).
(ConwayEraPParams era, Foldable f, ConwayEraTxCert era) =>
PParams era -> f (TxCert era) -> Coin
conwayDRepDepositsTxCerts PParams era
pp f (TxCert era)
certs = Int
nDReps Int -> Coin -> Coin
forall i. Integral i => i -> Coin -> Coin
forall t i. (Val t, Integral i) => i -> t -> t
<×> Coin
depositPerDRep
  where
    nDReps :: Int
nDReps = forall a. Sum a -> a
getSum @Int ((TxCert era -> Sum Int) -> f (TxCert era) -> Sum Int
forall m a. Monoid m => (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' (\case RegDRepTxCert {} -> Sum Int
1; TxCert era
_ -> Sum Int
0) f (TxCert era)
certs)
    depositPerDRep :: Coin
depositPerDRep = PParams era
pp PParams era -> Getting Coin (PParams era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (PParams era) Coin
forall era. ConwayEraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppDRepDepositL

-- | Compute the key deregistration refunds in a transaction
conwayTotalRefundsTxCerts ::
  (EraPParams era, Foldable f, ConwayEraTxCert era) =>
  PParams era ->
  -- | Function that can lookup current deposit, in case when the Staking credential is registered.
  (Credential 'Staking -> Maybe Coin) ->
  -- | Function that can lookup current deposit, in case when the DRep credential is registered.
  (Credential 'DRepRole -> Maybe Coin) ->
  f (TxCert era) ->
  Coin
conwayTotalRefundsTxCerts :: forall era (f :: * -> *).
(EraPParams era, Foldable f, ConwayEraTxCert era) =>
PParams era
-> (Credential 'Staking -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe Coin)
-> f (TxCert era)
-> Coin
conwayTotalRefundsTxCerts PParams era
pp Credential 'Staking -> Maybe Coin
lookupStakingDeposit Credential 'DRepRole -> Maybe Coin
lookupDRepDeposit f (TxCert era)
certs =
  PParams era
-> (Credential 'Staking -> Maybe Coin) -> f (TxCert era) -> Coin
forall era (f :: * -> *).
(EraPParams era, Foldable f, EraTxCert era) =>
PParams era
-> (Credential 'Staking -> Maybe Coin) -> f (TxCert era) -> Coin
shelleyTotalRefundsTxCerts PParams era
pp Credential 'Staking -> Maybe Coin
lookupStakingDeposit f (TxCert era)
certs
    Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> (Credential 'DRepRole -> Maybe Coin) -> f (TxCert era) -> Coin
forall (f :: * -> *) era.
(Foldable f, ConwayEraTxCert era) =>
(Credential 'DRepRole -> Maybe Coin) -> f (TxCert era) -> Coin
conwayDRepRefundsTxCerts Credential 'DRepRole -> Maybe Coin
lookupDRepDeposit f (TxCert era)
certs

-- | Compute the Refunds from a TxBody, given a function that computes a partial Coin for
-- known Credentials.
conwayDRepRefundsTxCerts ::
  (Foldable f, ConwayEraTxCert era) =>
  (Credential 'DRepRole -> Maybe Coin) ->
  f (TxCert era) ->
  Coin
conwayDRepRefundsTxCerts :: forall (f :: * -> *) era.
(Foldable f, ConwayEraTxCert era) =>
(Credential 'DRepRole -> Maybe Coin) -> f (TxCert era) -> Coin
conwayDRepRefundsTxCerts Credential 'DRepRole -> Maybe Coin
lookupDRepDeposit = (Map (Credential 'DRepRole) Coin, Coin) -> Coin
forall a b. (a, b) -> b
snd ((Map (Credential 'DRepRole) Coin, Coin) -> Coin)
-> (f (TxCert era) -> (Map (Credential 'DRepRole) Coin, Coin))
-> f (TxCert era)
-> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Map (Credential 'DRepRole) Coin, Coin)
 -> TxCert era -> (Map (Credential 'DRepRole) Coin, Coin))
-> (Map (Credential 'DRepRole) Coin, Coin)
-> f (TxCert era)
-> (Map (Credential 'DRepRole) Coin, Coin)
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' (Map (Credential 'DRepRole) Coin, Coin)
-> TxCert era -> (Map (Credential 'DRepRole) Coin, Coin)
go (Map (Credential 'DRepRole) Coin
forall k a. Map k a
Map.empty, Integer -> Coin
Coin Integer
0)
  where
    go :: (Map (Credential 'DRepRole) Coin, Coin)
-> TxCert era -> (Map (Credential 'DRepRole) Coin, Coin)
go accum :: (Map (Credential 'DRepRole) Coin, Coin)
accum@(!Map (Credential 'DRepRole) Coin
drepRegsInTx, !Coin
totalRefund) = \case
      RegDRepTxCert Credential 'DRepRole
cred Coin
deposit StrictMaybe Anchor
_ ->
        -- Track registrations
        (Credential 'DRepRole
-> Coin
-> Map (Credential 'DRepRole) Coin
-> Map (Credential 'DRepRole) Coin
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Credential 'DRepRole
cred Coin
deposit Map (Credential 'DRepRole) Coin
drepRegsInTx, Coin
totalRefund)
      UnRegDRepTxCert Credential 'DRepRole
cred Coin
_
        -- DRep previously registered in the same tx.
        | Just Coin
deposit <- Credential 'DRepRole
-> Map (Credential 'DRepRole) Coin -> Maybe Coin
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'DRepRole
cred Map (Credential 'DRepRole) Coin
drepRegsInTx ->
            (Credential 'DRepRole
-> Map (Credential 'DRepRole) Coin
-> Map (Credential 'DRepRole) Coin
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Credential 'DRepRole
cred Map (Credential 'DRepRole) Coin
drepRegsInTx, Coin
totalRefund Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Coin
deposit)
        -- DRep previously registered in some other tx.
        | Just Coin
deposit <- Credential 'DRepRole -> Maybe Coin
lookupDRepDeposit Credential 'DRepRole
cred -> (Map (Credential 'DRepRole) Coin
drepRegsInTx, Coin
totalRefund Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Coin
deposit)
      TxCert era
_ -> (Map (Credential 'DRepRole) Coin, Coin)
accum