{-# 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 (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.Governance (Anchor)
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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConwayTxCertUpgradeError -> ConwayTxCertUpgradeError -> Bool
$c/= :: ConwayTxCertUpgradeError -> ConwayTxCertUpgradeError -> Bool
== :: ConwayTxCertUpgradeError -> ConwayTxCertUpgradeError -> Bool
$c== :: ConwayTxCertUpgradeError -> ConwayTxCertUpgradeError -> Bool
Eq, Int -> ConwayTxCertUpgradeError -> ShowS
[ConwayTxCertUpgradeError] -> ShowS
ConwayTxCertUpgradeError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConwayTxCertUpgradeError] -> ShowS
$cshowList :: [ConwayTxCertUpgradeError] -> ShowS
show :: ConwayTxCertUpgradeError -> String
$cshow :: ConwayTxCertUpgradeError -> String
showsPrec :: Int -> ConwayTxCertUpgradeError -> ShowS
$cshowsPrec :: Int -> 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 -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall era. EraTxCert era => PoolParams -> TxCert era
RegPoolTxCert PoolParams
poolParams
    RetirePoolTxCert KeyHash 'StakePool
poolId EpochNo
epochNo -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall era.
EraTxCert era =>
KeyHash 'StakePool -> EpochNo -> TxCert era
RetirePoolTxCert KeyHash 'StakePool
poolId EpochNo
epochNo
    RegTxCert StakeCredential
cred -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall era. ShelleyEraTxCert era => StakeCredential -> TxCert era
RegTxCert StakeCredential
cred
    UnRegTxCert StakeCredential
cred -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall era. ShelleyEraTxCert era => StakeCredential -> TxCert era
UnRegTxCert StakeCredential
cred
    DelegStakeTxCert StakeCredential
cred KeyHash 'StakePool
poolId -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall era.
ShelleyEraTxCert era =>
StakeCredential -> KeyHash 'StakePool -> TxCert era
DelegStakeTxCert StakeCredential
cred KeyHash 'StakePool
poolId
    MirTxCert {} -> 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)
_ -> forall a b. a -> Either a b
Left ConwayTxCertUpgradeError
GenesisDelegTxCertExpunged

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

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

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

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

  mkRetirePoolTxCert :: KeyHash 'StakePool -> EpochNo -> TxCert ConwayEra
mkRetirePoolTxCert KeyHash 'StakePool
poolId EpochNo
epochNo = forall era. PoolCert -> ConwayTxCert era
ConwayTxCertPool 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)) = forall a. a -> Maybe a
Just (KeyHash 'StakePool
poolId, EpochNo
epochNo)
  getRetirePoolTxCert TxCert ConwayEra
_ = forall a. Maybe a
Nothing

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

  getTotalRefundsTxCerts :: forall (f :: * -> *).
Foldable f =>
PParams ConwayEra
-> (StakeCredential -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe Coin)
-> f (TxCert ConwayEra)
-> Coin
getTotalRefundsTxCerts = forall era (f :: * -> *).
(EraPParams era, Foldable f, ConwayEraTxCert era) =>
PParams era
-> (StakeCredential -> 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 = forall era (f :: * -> *).
(ConwayEraPParams era, Foldable f, ConwayEraTxCert era) =>
PParams era
-> (KeyHash 'StakePool -> Bool) -> f (TxCert era) -> Coin
conwayTotalDepositsTxCerts

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

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

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

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

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

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

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

  mkMirTxCert :: ProtVerAtMost ConwayEra 8 => MIRCert -> TxCert ConwayEra
mkMirTxCert = forall a. HasCallStack => a
notSupportedInThisEra
  getMirTxCert :: ProtVerAtMost ConwayEra 8 => TxCert ConwayEra -> Maybe MIRCert
getMirTxCert = forall a b. a -> b -> a
const 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 :: StakeCredential -> Coin -> TxCert ConwayEra
mkRegDepositTxCert StakeCredential
cred Coin
c = forall era. ConwayDelegCert -> ConwayTxCert era
ConwayTxCertDeleg forall a b. (a -> b) -> a -> b
$ StakeCredential -> StrictMaybe Coin -> ConwayDelegCert
ConwayRegCert StakeCredential
cred forall a b. (a -> b) -> a -> b
$ forall a. a -> StrictMaybe a
SJust Coin
c

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

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

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

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

  mkAuthCommitteeHotKeyTxCert :: Credential 'ColdCommitteeRole
-> Credential 'HotCommitteeRole -> TxCert ConwayEra
mkAuthCommitteeHotKeyTxCert Credential 'ColdCommitteeRole
ck Credential 'HotCommitteeRole
hk = forall era. ConwayGovCert -> ConwayTxCert era
ConwayTxCertGov 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)) = forall a. a -> Maybe a
Just (Credential 'ColdCommitteeRole
ck, Credential 'HotCommitteeRole
hk)
  getAuthCommitteeHotKeyTxCert TxCert ConwayEra
_ = forall a. Maybe a
Nothing

  mkResignCommitteeColdTxCert :: Credential 'ColdCommitteeRole
-> StrictMaybe Anchor -> TxCert ConwayEra
mkResignCommitteeColdTxCert Credential 'ColdCommitteeRole
ck StrictMaybe Anchor
a = forall era. ConwayGovCert -> ConwayTxCert era
ConwayTxCertGov 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)) = forall a. a -> Maybe a
Just (Credential 'ColdCommitteeRole
ck, StrictMaybe Anchor
a)
  getResignCommitteeColdTxCert TxCert ConwayEra
_ = forall a. Maybe a
Nothing

  mkRegDRepTxCert :: Credential 'DRepRole
-> Coin -> StrictMaybe Anchor -> TxCert ConwayEra
mkRegDRepTxCert Credential 'DRepRole
cred Coin
deposit StrictMaybe Anchor
mAnchor = forall era. ConwayGovCert -> ConwayTxCert era
ConwayTxCertGov 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) -> forall a. a -> Maybe a
Just (Credential 'DRepRole
cred, Coin
deposit, StrictMaybe Anchor
mAnchor)
    TxCert ConwayEra
_ -> forall a. Maybe a
Nothing

  mkUnRegDRepTxCert :: Credential 'DRepRole -> Coin -> TxCert ConwayEra
mkUnRegDRepTxCert Credential 'DRepRole
cred Coin
deposit = forall era. ConwayGovCert -> ConwayTxCert era
ConwayTxCertGov 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) -> forall a. a -> Maybe a
Just (Credential 'DRepRole
cred, Coin
deposit)
    TxCert ConwayEra
_ -> forall a. Maybe a
Nothing

  mkUpdateDRepTxCert :: Credential 'DRepRole -> StrictMaybe Anchor -> TxCert ConwayEra
mkUpdateDRepTxCert Credential 'DRepRole
cred StrictMaybe Anchor
mAnchor = forall era. ConwayGovCert -> ConwayTxCert era
ConwayTxCertGov 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) -> forall a. a -> Maybe a
Just (Credential 'DRepRole
cred, StrictMaybe Anchor
mAnchor)
    TxCert ConwayEra
_ -> forall a. Maybe a
Nothing

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

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

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

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

pattern AuthCommitteeHotKeyTxCert ::
  ConwayEraTxCert era =>
  Credential 'ColdCommitteeRole ->
  Credential 'HotCommitteeRole ->
  TxCert era
pattern $bAuthCommitteeHotKeyTxCert :: forall era.
ConwayEraTxCert era =>
Credential 'ColdCommitteeRole
-> Credential 'HotCommitteeRole -> TxCert era
$mAuthCommitteeHotKeyTxCert :: forall {r} {era}.
ConwayEraTxCert era =>
TxCert era
-> (Credential 'ColdCommitteeRole
    -> Credential 'HotCommitteeRole -> r)
-> ((# #) -> r)
-> r
AuthCommitteeHotKeyTxCert ck hk <- (getAuthCommitteeHotKeyTxCert -> Just (ck, hk))
  where
    AuthCommitteeHotKeyTxCert Credential 'ColdCommitteeRole
ck Credential 'HotCommitteeRole
hk = 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 $bResignCommitteeColdTxCert :: forall era.
ConwayEraTxCert era =>
Credential 'ColdCommitteeRole -> StrictMaybe Anchor -> TxCert era
$mResignCommitteeColdTxCert :: forall {r} {era}.
ConwayEraTxCert era =>
TxCert era
-> (Credential 'ColdCommitteeRole -> StrictMaybe Anchor -> r)
-> ((# #) -> r)
-> r
ResignCommitteeColdTxCert ck a <- (getResignCommitteeColdTxCert -> Just (ck, a))
  where
    ResignCommitteeColdTxCert Credential 'ColdCommitteeRole
ck = 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 $bRegDRepTxCert :: forall era.
ConwayEraTxCert era =>
Credential 'DRepRole -> Coin -> StrictMaybe Anchor -> TxCert era
$mRegDRepTxCert :: forall {r} {era}.
ConwayEraTxCert era =>
TxCert era
-> (Credential 'DRepRole -> Coin -> StrictMaybe Anchor -> r)
-> ((# #) -> r)
-> r
RegDRepTxCert cred deposit mAnchor <- (getRegDRepTxCert -> Just (cred, deposit, mAnchor))
  where
    RegDRepTxCert Credential 'DRepRole
cred Coin
deposit StrictMaybe Anchor
mAnchor = 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 $bUnRegDRepTxCert :: forall era.
ConwayEraTxCert era =>
Credential 'DRepRole -> Coin -> TxCert era
$mUnRegDRepTxCert :: forall {r} {era}.
ConwayEraTxCert era =>
TxCert era
-> (Credential 'DRepRole -> Coin -> r) -> ((# #) -> r) -> r
UnRegDRepTxCert cred deposit <- (getUnRegDRepTxCert -> Just (cred, deposit))
  where
    UnRegDRepTxCert Credential 'DRepRole
cred Coin
deposit = 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 $bUpdateDRepTxCert :: forall era.
ConwayEraTxCert era =>
Credential 'DRepRole -> StrictMaybe Anchor -> TxCert era
$mUpdateDRepTxCert :: forall {r} {era}.
ConwayEraTxCert era =>
TxCert era
-> (Credential 'DRepRole -> StrictMaybe Anchor -> r)
-> ((# #) -> r)
-> r
UpdateDRepTxCert cred mAnchor <- (getUpdateDRepTxCert -> Just (cred, mAnchor))
  where
    UpdateDRepTxCert Credential 'DRepRole
cred StrictMaybe Anchor
mAnchor = 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
  #-}

getDelegateeTxCert :: ConwayEraTxCert era => TxCert era -> Maybe Delegatee
getDelegateeTxCert :: forall era. ConwayEraTxCert era => TxCert era -> Maybe Delegatee
getDelegateeTxCert = \case
  DelegTxCert StakeCredential
_ Delegatee
delegatee -> forall a. a -> Maybe a
Just Delegatee
delegatee
  RegDepositDelegTxCert StakeCredential
_ Delegatee
delegatee Coin
_ -> forall a. a -> Maybe a
Just Delegatee
delegatee
  TxCert era
_ -> 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Delegatee] -> ShowS
$cshowList :: [Delegatee] -> ShowS
show :: Delegatee -> String
$cshow :: Delegatee -> String
showsPrec :: Int -> Delegatee -> ShowS
$cshowsPrec :: Int -> Delegatee -> ShowS
Show, 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
$cto :: forall x. Rep Delegatee x -> Delegatee
$cfrom :: forall x. Delegatee -> Rep Delegatee x
Generic, Delegatee -> Delegatee -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Delegatee -> Delegatee -> Bool
$c/= :: Delegatee -> Delegatee -> Bool
== :: Delegatee -> Delegatee -> Bool
$c== :: Delegatee -> Delegatee -> Bool
Eq, Eq 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
min :: Delegatee -> Delegatee -> Delegatee
$cmin :: Delegatee -> Delegatee -> Delegatee
max :: Delegatee -> Delegatee -> Delegatee
$cmax :: Delegatee -> Delegatee -> Delegatee
>= :: Delegatee -> Delegatee -> Bool
$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
compare :: Delegatee -> Delegatee -> Ordering
$ccompare :: Delegatee -> Delegatee -> Ordering
Ord)

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

instance FromJSON Delegatee where
  parseJSON :: Value -> Parser Delegatee
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Delegatee" forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
    Maybe (KeyHash 'StakePool)
poolId <- Object
obj forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"poolId"
    Maybe DRep
dRep <- Object
obj 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) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ KeyHash 'StakePool -> Delegatee
DelegStake KeyHash 'StakePool
poolId'
      (Maybe (KeyHash 'StakePool)
Nothing, Just DRep
dRep') -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ DRep -> Delegatee
DelegVote DRep
dRep'
      (Just KeyHash 'StakePool
poolId', Just DRep
dRep') -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ KeyHash 'StakePool -> DRep -> Delegatee
DelegStakeVote KeyHash 'StakePool
poolId' DRep
dRep'
      (Maybe (KeyHash 'StakePool), Maybe DRep)
_ -> 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 =
    forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      DelegStake KeyHash 'StakePool
kh -> forall t. t -> Word -> Encode 'Open t
Sum KeyHash 'StakePool -> Delegatee
DelegStake Word
0 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To KeyHash 'StakePool
kh
      DelegVote DRep
dRep -> forall t. t -> Word -> Encode 'Open t
Sum DRep -> Delegatee
DelegVote Word
1 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To DRep
dRep
      DelegStakeVote KeyHash 'StakePool
kh DRep
dRep -> forall t. t -> Word -> Encode 'Open t
Sum KeyHash 'StakePool -> DRep -> Delegatee
DelegStakeVote Word
2 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To KeyHash 'StakePool
kh forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To DRep
dRep

instance DecCBOR Delegatee where
  decCBOR :: forall s. Decoder s Delegatee
decCBOR = forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode forall a b. (a -> b) -> a -> b
$
    forall t.
Text -> (Word -> Decode 'Open t) -> Decode ('Closed 'Dense) t
Summands Text
"Delegatee" forall a b. (a -> b) -> a -> b
$ \case
      Word
0 -> forall t. t -> Decode 'Open t
SumD KeyHash 'StakePool -> Delegatee
DelegStake forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      Word
1 -> forall t. t -> Decode 'Open t
SumD DRep -> Delegatee
DelegVote forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      Word
2 -> forall t. t -> Decode 'Open t
SumD KeyHash 'StakePool -> DRep -> Delegatee
DelegStakeVote forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      Word
k -> 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 -> forall a. a -> Maybe a
Just KeyHash 'StakePool
targetPool
  DelegVote {} -> forall a. Maybe a
Nothing
  DelegStakeVote KeyHash 'StakePool
targetPool DRep
_ -> forall a. a -> Maybe a
Just KeyHash 'StakePool
targetPool

getVoteDelegatee :: Delegatee -> Maybe DRep
getVoteDelegatee :: Delegatee -> Maybe DRep
getVoteDelegatee DelegStake {} = forall a. Maybe a
Nothing
getVoteDelegatee (DelegVote DRep
x) = forall a. a -> Maybe a
Just DRep
x
getVoteDelegatee (DelegStakeVote KeyHash 'StakePool
_ DRep
x) = 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConwayDelegCert] -> ShowS
$cshowList :: [ConwayDelegCert] -> ShowS
show :: ConwayDelegCert -> String
$cshow :: ConwayDelegCert -> String
showsPrec :: Int -> ConwayDelegCert -> ShowS
$cshowsPrec :: Int -> ConwayDelegCert -> ShowS
Show, 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
$cto :: forall x. Rep ConwayDelegCert x -> ConwayDelegCert
$cfrom :: forall x. ConwayDelegCert -> Rep ConwayDelegCert x
Generic, ConwayDelegCert -> ConwayDelegCert -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConwayDelegCert -> ConwayDelegCert -> Bool
$c/= :: ConwayDelegCert -> ConwayDelegCert -> Bool
== :: ConwayDelegCert -> ConwayDelegCert -> Bool
$c== :: ConwayDelegCert -> ConwayDelegCert -> Bool
Eq, Eq 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
min :: ConwayDelegCert -> ConwayDelegCert -> ConwayDelegCert
$cmin :: ConwayDelegCert -> ConwayDelegCert -> ConwayDelegCert
max :: ConwayDelegCert -> ConwayDelegCert -> ConwayDelegCert
$cmax :: ConwayDelegCert -> ConwayDelegCert -> ConwayDelegCert
>= :: ConwayDelegCert -> ConwayDelegCert -> Bool
$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
compare :: ConwayDelegCert -> ConwayDelegCert -> Ordering
$ccompare :: ConwayDelegCert -> ConwayDelegCert -> Ordering
Ord)

instance EncCBOR ConwayDelegCert where
  encCBOR :: ConwayDelegCert -> Encoding
encCBOR = \case
    -- Shelley backwards compatibility
    ConwayRegCert StakeCredential
cred StrictMaybe Coin
SNothing -> ShelleyDelegCert -> Encoding
encodeShelleyDelegCert forall a b. (a -> b) -> a -> b
$ StakeCredential -> ShelleyDelegCert
ShelleyRegCert StakeCredential
cred
    ConwayUnRegCert StakeCredential
cred StrictMaybe Coin
SNothing -> ShelleyDelegCert -> Encoding
encodeShelleyDelegCert forall a b. (a -> b) -> a -> b
$ StakeCredential -> ShelleyDelegCert
ShelleyUnRegCert StakeCredential
cred
    ConwayDelegCert StakeCredential
cred (DelegStake KeyHash 'StakePool
poolId) -> ShelleyDelegCert -> Encoding
encodeShelleyDelegCert forall a b. (a -> b) -> a -> b
$ StakeCredential -> KeyHash 'StakePool -> ShelleyDelegCert
ShelleyDelegCert StakeCredential
cred KeyHash 'StakePool
poolId
    -- New in Conway
    ConwayRegCert StakeCredential
cred (SJust Coin
deposit) ->
      Word -> Encoding
encodeListLen Word
3
        forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
encodeWord8 Word8
7
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR StakeCredential
cred
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Coin
deposit
    ConwayUnRegCert StakeCredential
cred (SJust Coin
deposit) ->
      Word -> Encoding
encodeListLen Word
3
        forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
encodeWord8 Word8
8
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR StakeCredential
cred
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Coin
deposit
    ConwayDelegCert StakeCredential
cred (DelegVote DRep
drep) ->
      Word -> Encoding
encodeListLen Word
3
        forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
encodeWord8 Word8
9
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR StakeCredential
cred
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR DRep
drep
    ConwayDelegCert StakeCredential
cred (DelegStakeVote KeyHash 'StakePool
poolId DRep
dRep) ->
      Word -> Encoding
encodeListLen Word
4
        forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
encodeWord8 Word8
10
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR StakeCredential
cred
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR KeyHash 'StakePool
poolId
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR DRep
dRep
    ConwayRegDelegCert StakeCredential
cred (DelegStake KeyHash 'StakePool
poolId) Coin
deposit ->
      Word -> Encoding
encodeListLen Word
4
        forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
encodeWord8 Word8
11
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR StakeCredential
cred
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR KeyHash 'StakePool
poolId
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Coin
deposit
    ConwayRegDelegCert StakeCredential
cred (DelegVote DRep
drep) Coin
deposit ->
      Word -> Encoding
encodeListLen Word
4
        forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
encodeWord8 Word8
12
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR StakeCredential
cred
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR DRep
drep
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Coin
deposit
    ConwayRegDelegCert StakeCredential
cred (DelegStakeVote KeyHash 'StakePool
poolId DRep
dRep) Coin
deposit ->
      Word -> Encoding
encodeListLen Word
5
        forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
encodeWord8 Word8
13
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR StakeCredential
cred
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR KeyHash 'StakePool
poolId
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR DRep
dRep
        forall a. Semigroup a => a -> a -> a
<> 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 StakeCredential
cred StrictMaybe Coin
deposit ->
      Text -> [Pair] -> Value
kindObject Text
"RegCert" forall a b. (a -> b) -> a -> b
$
        [ Key
"credential" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON StakeCredential
cred
        , Key
"deposit" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON StrictMaybe Coin
deposit
        ]
    ConwayUnRegCert StakeCredential
cred StrictMaybe Coin
refund ->
      Text -> [Pair] -> Value
kindObject Text
"UnRegCert" forall a b. (a -> b) -> a -> b
$
        [ Key
"credential" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON StakeCredential
cred
        , Key
"refund" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON StrictMaybe Coin
refund
        ]
    ConwayDelegCert StakeCredential
cred Delegatee
delegatee ->
      Text -> [Pair] -> Value
kindObject Text
"DelegCert" forall a b. (a -> b) -> a -> b
$
        [ Key
"credential" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON StakeCredential
cred
        , Key
"delegatee" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON Delegatee
delegatee
        ]
    ConwayRegDelegCert StakeCredential
cred Delegatee
delegatee Coin
deposit ->
      Text -> [Pair] -> Value
kindObject Text
"RegDelegCert" forall a b. (a -> b) -> a -> b
$
        [ Key
"credential" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON StakeCredential
cred
        , Key
"delegatee" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON Delegatee
delegatee
        , Key
"deposit" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConwayGovCert] -> ShowS
$cshowList :: [ConwayGovCert] -> ShowS
show :: ConwayGovCert -> String
$cshow :: ConwayGovCert -> String
showsPrec :: Int -> ConwayGovCert -> ShowS
$cshowsPrec :: Int -> ConwayGovCert -> ShowS
Show, 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
$cto :: forall x. Rep ConwayGovCert x -> ConwayGovCert
$cfrom :: forall x. ConwayGovCert -> Rep ConwayGovCert x
Generic, ConwayGovCert -> ConwayGovCert -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConwayGovCert -> ConwayGovCert -> Bool
$c/= :: ConwayGovCert -> ConwayGovCert -> Bool
== :: ConwayGovCert -> ConwayGovCert -> Bool
$c== :: ConwayGovCert -> ConwayGovCert -> Bool
Eq, Eq 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
min :: ConwayGovCert -> ConwayGovCert -> ConwayGovCert
$cmin :: ConwayGovCert -> ConwayGovCert -> ConwayGovCert
max :: ConwayGovCert -> ConwayGovCert -> ConwayGovCert
$cmax :: ConwayGovCert -> ConwayGovCert -> ConwayGovCert
>= :: ConwayGovCert -> ConwayGovCert -> Bool
$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
compare :: ConwayGovCert -> ConwayGovCert -> Ordering
$ccompare :: ConwayGovCert -> ConwayGovCert -> Ordering
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" forall a b. (a -> b) -> a -> b
$
        [ Key
"dRep" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON Credential 'DRepRole
dRep
        , Key
"deposit" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON Coin
deposit
        , Key
"anchor" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON StrictMaybe Anchor
anchor
        ]
    ConwayUnRegDRep Credential 'DRepRole
dRep Coin
refund ->
      Text -> [Pair] -> Value
kindObject Text
"UnRegDRep" forall a b. (a -> b) -> a -> b
$
        [ Key
"dRep" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON Credential 'DRepRole
dRep
        , Key
"refund" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON Coin
refund
        ]
    ConwayUpdateDRep Credential 'DRepRole
dRep StrictMaybe Anchor
anchor ->
      Text -> [Pair] -> Value
kindObject Text
"UpdateDRep" forall a b. (a -> b) -> a -> b
$
        [ Key
"dRep" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON Credential 'DRepRole
dRep
        , Key
"anchor" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON StrictMaybe Anchor
anchor
        ]
    ConwayAuthCommitteeHotKey Credential 'ColdCommitteeRole
coldCred Credential 'HotCommitteeRole
hotCred ->
      Text -> [Pair] -> Value
kindObject Text
"AuthCommitteeHotKey" forall a b. (a -> b) -> a -> b
$
        [ Key
"coldCredential" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON Credential 'ColdCommitteeRole
coldCred
        , Key
"hotCredential" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON Credential 'HotCommitteeRole
hotCred
        ]
    ConwayResignCommitteeColdKey Credential 'ColdCommitteeRole
coldCred StrictMaybe Anchor
anchor ->
      Text -> [Pair] -> Value
kindObject Text
"ResignCommitteeColdKey" forall a b. (a -> b) -> a -> b
$
        [ Key
"coldCredential" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON Credential 'ColdCommitteeRole
coldCred
        , Key
"anchor" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= 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
        forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
encodeWord8 Word8
14
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Credential 'ColdCommitteeRole
cred
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Credential 'HotCommitteeRole
key
    ConwayResignCommitteeColdKey Credential 'ColdCommitteeRole
cred StrictMaybe Anchor
a ->
      Word -> Encoding
encodeListLen Word
3
        forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
encodeWord8 Word8
15
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Credential 'ColdCommitteeRole
cred
        forall a. Semigroup a => a -> a -> a
<> forall a. (a -> Encoding) -> StrictMaybe a -> Encoding
encodeNullStrictMaybe forall a. EncCBOR a => a -> Encoding
encCBOR StrictMaybe Anchor
a
    ConwayRegDRep Credential 'DRepRole
cred Coin
deposit StrictMaybe Anchor
mAnchor ->
      Word -> Encoding
encodeListLen Word
4
        forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
encodeWord8 Word8
16
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Credential 'DRepRole
cred
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Coin
deposit
        forall a. Semigroup a => a -> a -> a
<> forall a. (a -> Encoding) -> StrictMaybe a -> Encoding
encodeNullStrictMaybe forall a. EncCBOR a => a -> Encoding
encCBOR StrictMaybe Anchor
mAnchor
    ConwayUnRegDRep Credential 'DRepRole
cred Coin
deposit ->
      Word -> Encoding
encodeListLen Word
3
        forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
encodeWord8 Word8
17
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Credential 'DRepRole
cred
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Coin
deposit
    ConwayUpdateDRep Credential 'DRepRole
cred StrictMaybe Anchor
mAnchor ->
      Word -> Encoding
encodeListLen Word
3
        forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
encodeWord8 Word8
18
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Credential 'DRepRole
cred
        forall a. Semigroup a => a -> a -> a
<> forall a. (a -> Encoding) -> StrictMaybe a -> Encoding
encodeNullStrictMaybe forall a. EncCBOR a => a -> Encoding
encCBOR StrictMaybe Anchor
mAnchor

data ConwayTxCert era
  = ConwayTxCertDeleg !ConwayDelegCert
  | ConwayTxCertPool !PoolCert
  | ConwayTxCertGov !ConwayGovCert
  deriving (Int -> ConwayTxCert era -> ShowS
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
showList :: [ConwayTxCert era] -> ShowS
$cshowList :: forall era. [ConwayTxCert era] -> ShowS
show :: ConwayTxCert era -> String
$cshow :: forall era. ConwayTxCert era -> String
showsPrec :: Int -> ConwayTxCert era -> ShowS
$cshowsPrec :: forall era. Int -> ConwayTxCert era -> ShowS
Show, 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
$cto :: forall era x. Rep (ConwayTxCert era) x -> ConwayTxCert era
$cfrom :: forall era x. ConwayTxCert era -> Rep (ConwayTxCert era) x
Generic, ConwayTxCert era -> ConwayTxCert era -> Bool
forall era. ConwayTxCert era -> ConwayTxCert era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: 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
Eq, ConwayTxCert era -> ConwayTxCert era -> Bool
ConwayTxCert era -> ConwayTxCert era -> Ordering
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
min :: ConwayTxCert era -> ConwayTxCert era -> ConwayTxCert era
$cmin :: forall era.
ConwayTxCert era -> ConwayTxCert era -> ConwayTxCert era
max :: ConwayTxCert era -> ConwayTxCert era -> ConwayTxCert era
$cmax :: forall era.
ConwayTxCert era -> ConwayTxCert era -> ConwayTxCert era
>= :: 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
$c< :: forall era. ConwayTxCert era -> ConwayTxCert era -> Bool
compare :: ConwayTxCert era -> ConwayTxCert era -> Ordering
$ccompare :: forall era. ConwayTxCert era -> ConwayTxCert era -> Ordering
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 -> forall a. ToJSON a => a -> Value
toJSON ConwayDelegCert
delegCert
    ConwayTxCertPool PoolCert
poolCert -> forall a. ToJSON a => a -> Value
toJSON PoolCert
poolCert
    ConwayTxCertGov ConwayGovCert
govCert -> 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 = forall s a. Text -> (Word -> Decoder s (Int, a)) -> Decoder s a
decodeRecordSum Text
"ConwayTxCert" forall a b. (a -> b) -> a -> b
$ \case
    Word
t
      | Word
0 forall a. Ord a => a -> a -> Bool
<= Word
t Bool -> Bool -> Bool
&& Word
t forall a. Ord a => a -> a -> Bool
< Word
3 -> forall era s.
ShelleyEraTxCert era =>
Word -> Decoder s (Int, TxCert era)
shelleyTxCertDelegDecoder Word
t
      | Word
3 forall a. Ord a => a -> a -> Bool
<= Word
t Bool -> Bool -> Bool
&& Word
t forall a. Ord a => a -> a -> Bool
< Word
5 -> forall era s. EraTxCert era => Word -> Decoder s (Int, TxCert era)
poolTxCertDecoder Word
t
      | Word
t forall a. Eq a => a -> a -> Bool
== Word
5 -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Genesis delegation certificates are no longer supported"
      | Word
t forall a. Eq a => a -> a -> Bool
== Word
6 -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"MIR certificates are no longer supported"
      | Word
7 forall a. Ord a => a -> a -> Bool
<= Word
t -> forall era s.
ConwayEraTxCert era =>
Word -> Decoder s (Int, TxCert era)
conwayTxCertDelegDecoder Word
t
    Word
t -> forall (m :: * -> *) 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
    StakeCredential
cred <- forall a s. DecCBOR a => Decoder s a
decCBOR
    Coin
deposit <- forall a s. DecCBOR a => Decoder s a
decCBOR
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
3, forall era.
ConwayEraTxCert era =>
StakeCredential -> Coin -> TxCert era
RegDepositTxCert StakeCredential
cred Coin
deposit)
  Word
8 -> do
    StakeCredential
cred <- forall a s. DecCBOR a => Decoder s a
decCBOR
    Coin
deposit <- forall a s. DecCBOR a => Decoder s a
decCBOR
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
3, forall era.
ConwayEraTxCert era =>
StakeCredential -> Coin -> TxCert era
UnRegDepositTxCert StakeCredential
cred Coin
deposit)
  Word
9 -> forall {era} {a} {s}.
ConwayEraTxCert era =>
a -> Decoder s Delegatee -> Decoder s (a, TxCert era)
delegCertDecoder Int
3 (DRep -> Delegatee
DelegVote forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR)
  Word
10 -> forall {era} {a} {s}.
ConwayEraTxCert era =>
a -> Decoder s Delegatee -> Decoder s (a, TxCert era)
delegCertDecoder Int
4 (KeyHash 'StakePool -> DRep -> Delegatee
DelegStakeVote forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR)
  Word
11 -> forall {era} {a} {s}.
ConwayEraTxCert era =>
a -> Decoder s Delegatee -> Decoder s (a, TxCert era)
regDelegCertDecoder Int
4 (KeyHash 'StakePool -> Delegatee
DelegStake forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR)
  Word
12 -> forall {era} {a} {s}.
ConwayEraTxCert era =>
a -> Decoder s Delegatee -> Decoder s (a, TxCert era)
regDelegCertDecoder Int
4 (DRep -> Delegatee
DelegVote forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR)
  Word
13 -> forall {era} {a} {s}.
ConwayEraTxCert era =>
a -> Decoder s Delegatee -> Decoder s (a, TxCert era)
regDelegCertDecoder Int
5 (KeyHash 'StakePool -> DRep -> Delegatee
DelegStakeVote forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR)
  Word
14 -> do
    Credential 'ColdCommitteeRole
cred <- forall a s. DecCBOR a => Decoder s a
decCBOR
    Credential 'HotCommitteeRole
key <- forall a s. DecCBOR a => Decoder s a
decCBOR
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
3, forall era.
ConwayEraTxCert era =>
Credential 'ColdCommitteeRole
-> Credential 'HotCommitteeRole -> TxCert era
AuthCommitteeHotKeyTxCert Credential 'ColdCommitteeRole
cred Credential 'HotCommitteeRole
key)
  Word
15 -> do
    Credential 'ColdCommitteeRole
cred <- forall a s. DecCBOR a => Decoder s a
decCBOR
    StrictMaybe Anchor
a <- forall s a. Decoder s a -> Decoder s (StrictMaybe a)
decodeNullStrictMaybe forall a s. DecCBOR a => Decoder s a
decCBOR
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
3, forall era.
ConwayEraTxCert era =>
Credential 'ColdCommitteeRole -> StrictMaybe Anchor -> TxCert era
ResignCommitteeColdTxCert Credential 'ColdCommitteeRole
cred StrictMaybe Anchor
a)
  Word
16 -> do
    Credential 'DRepRole
cred <- forall a s. DecCBOR a => Decoder s a
decCBOR
    Coin
deposit <- forall a s. DecCBOR a => Decoder s a
decCBOR
    StrictMaybe Anchor
mAnchor <- forall s a. Decoder s a -> Decoder s (StrictMaybe a)
decodeNullStrictMaybe forall a s. DecCBOR a => Decoder s a
decCBOR
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
4, 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 <- forall a s. DecCBOR a => Decoder s a
decCBOR
    Coin
deposit <- forall a s. DecCBOR a => Decoder s a
decCBOR
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
3, forall era.
ConwayEraTxCert era =>
Credential 'DRepRole -> Coin -> TxCert era
UnRegDRepTxCert Credential 'DRepRole
cred Coin
deposit)
  Word
18 -> do
    Credential 'DRepRole
cred <- forall a s. DecCBOR a => Decoder s a
decCBOR
    StrictMaybe Anchor
mAnchor <- forall s a. Decoder s a -> Decoder s (StrictMaybe a)
decodeNullStrictMaybe forall a s. DecCBOR a => Decoder s a
decCBOR
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
3, forall era.
ConwayEraTxCert era =>
Credential 'DRepRole -> StrictMaybe Anchor -> TxCert era
UpdateDRepTxCert Credential 'DRepRole
cred StrictMaybe Anchor
mAnchor)
  Word
k -> forall (m :: * -> *) 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
      StakeCredential
cred <- forall a s. DecCBOR a => Decoder s a
decCBOR
      Delegatee
delegatee <- Decoder s Delegatee
decodeDelegatee
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
n, forall era.
ConwayEraTxCert era =>
StakeCredential -> Delegatee -> TxCert era
DelegTxCert StakeCredential
cred Delegatee
delegatee)
    {-# INLINE delegCertDecoder #-}
    regDelegCertDecoder :: a -> Decoder s Delegatee -> Decoder s (a, TxCert era)
regDelegCertDecoder a
n Decoder s Delegatee
decodeDelegatee = do
      StakeCredential
cred <- forall a s. DecCBOR a => Decoder s a
decCBOR
      Delegatee
delegatee <- Decoder s Delegatee
decodeDelegatee
      Coin
deposit <- forall a s. DecCBOR a => Decoder s a
decCBOR
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
n, forall era.
ConwayEraTxCert era =>
StakeCredential -> Delegatee -> Coin -> TxCert era
RegDepositDelegTxCert StakeCredential
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) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> forall a. EncCBOR a => a -> Encoding
encCBOR ConwayDelegCert
delegCert
    ConwayTxCertPool PoolCert
poolCert -> PoolCert -> Encoding
encodePoolCert PoolCert
poolCert
    ConwayTxCertGov ConwayGovCert
govCert -> forall a. EncCBOR a => a -> Encoding
encCBOR ConwayGovCert
govCert

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

toShelleyDelegCert :: ConwayDelegCert -> Maybe ShelleyDelegCert
toShelleyDelegCert :: ConwayDelegCert -> Maybe ShelleyDelegCert
toShelleyDelegCert = \case
  ConwayRegCert StakeCredential
cred StrictMaybe Coin
SNothing -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ StakeCredential -> ShelleyDelegCert
ShelleyRegCert StakeCredential
cred
  ConwayUnRegCert StakeCredential
cred StrictMaybe Coin
SNothing -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ StakeCredential -> ShelleyDelegCert
ShelleyUnRegCert StakeCredential
cred
  ConwayDelegCert StakeCredential
cred (DelegStake KeyHash 'StakePool
poolId) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ StakeCredential -> KeyHash 'StakePool -> ShelleyDelegCert
ShelleyDelegCert StakeCredential
cred KeyHash 'StakePool
poolId
  ConwayDelegCert
_ -> 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 StakeCredential
_ StrictMaybe Coin
SNothing -> forall a. Maybe a
Nothing
      ConwayRegCert StakeCredential
cred (SJust Coin
_) -> forall (kr :: KeyRole). Credential kr -> Maybe ScriptHash
credScriptHash StakeCredential
cred
      ConwayUnRegCert StakeCredential
cred StrictMaybe Coin
_ -> forall (kr :: KeyRole). Credential kr -> Maybe ScriptHash
credScriptHash StakeCredential
cred
      ConwayDelegCert StakeCredential
cred Delegatee
_ -> forall (kr :: KeyRole). Credential kr -> Maybe ScriptHash
credScriptHash StakeCredential
cred
      ConwayRegDelegCert StakeCredential
cred Delegatee
_ Coin
_ -> forall (kr :: KeyRole). Credential kr -> Maybe ScriptHash
credScriptHash StakeCredential
cred
  -- PoolIds can't be Scripts
  ConwayTxCertPool {} -> 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 -> forall (kr :: KeyRole). Credential kr -> Maybe ScriptHash
credScriptHash Credential 'ColdCommitteeRole
coldCred
      ConwayResignCommitteeColdKey Credential 'ColdCommitteeRole
coldCred StrictMaybe Anchor
_ -> forall (kr :: KeyRole). Credential kr -> Maybe ScriptHash
credScriptHash Credential 'ColdCommitteeRole
coldCred
      ConwayRegDRep Credential 'DRepRole
cred Coin
_ StrictMaybe Anchor
_ -> forall (kr :: KeyRole). Credential kr -> Maybe ScriptHash
credScriptHash Credential 'DRepRole
cred
      ConwayUnRegDRep Credential 'DRepRole
cred Coin
_ -> forall (kr :: KeyRole). Credential kr -> Maybe ScriptHash
credScriptHash Credential 'DRepRole
cred
      ConwayUpdateDRep Credential 'DRepRole
cred StrictMaybe Anchor
_ -> 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 StakeCredential
_ StrictMaybe Coin
SNothing -> forall a. Maybe a
Nothing
      ConwayRegCert StakeCredential
cred (SJust Coin
_) -> forall (r :: KeyRole). Credential r -> Maybe (KeyHash 'Witness)
credKeyHashWitness StakeCredential
cred
      ConwayUnRegCert StakeCredential
cred StrictMaybe Coin
_ -> forall (r :: KeyRole). Credential r -> Maybe (KeyHash 'Witness)
credKeyHashWitness StakeCredential
cred
      ConwayDelegCert StakeCredential
cred Delegatee
_ -> forall (r :: KeyRole). Credential r -> Maybe (KeyHash 'Witness)
credKeyHashWitness StakeCredential
cred
      ConwayRegDelegCert StakeCredential
cred Delegatee
_ Coin
_ -> forall (r :: KeyRole). Credential r -> Maybe (KeyHash 'Witness)
credKeyHashWitness StakeCredential
cred
  ConwayTxCertPool PoolCert
poolCert -> forall a. a -> Maybe a
Just 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 -> forall (r :: KeyRole). Credential r -> Maybe (KeyHash 'Witness)
credKeyHashWitness Credential 'ColdCommitteeRole
coldCred
      ConwayResignCommitteeColdKey Credential 'ColdCommitteeRole
coldCred StrictMaybe Anchor
_ -> forall (r :: KeyRole). Credential r -> Maybe (KeyHash 'Witness)
credKeyHashWitness Credential 'ColdCommitteeRole
coldCred
      ConwayRegDRep Credential 'DRepRole
cred Coin
_ StrictMaybe Anchor
_ -> forall (r :: KeyRole). Credential r -> Maybe (KeyHash 'Witness)
credKeyHashWitness Credential 'DRepRole
cred
      ConwayUnRegDRep Credential 'DRepRole
cred Coin
_ -> forall (r :: KeyRole). Credential r -> Maybe (KeyHash 'Witness)
credKeyHashWitness Credential 'DRepRole
cred
      ConwayUpdateDRep Credential 'DRepRole
cred StrictMaybe Anchor
_ -> 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 =
  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
    forall t. Val t => t -> t -> t
<+> 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 forall t i. (Val t, Integral i) => i -> t -> t
<×> Coin
depositPerDRep
  where
    nDReps :: Int
nDReps = forall a. Sum a -> a
getSum @Int (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 forall s a. s -> Getting a s a -> a
^. forall era. ConwayEraPParams era => 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
-> (StakeCredential -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe Coin)
-> f (TxCert era)
-> Coin
conwayTotalRefundsTxCerts PParams era
pp StakeCredential -> Maybe Coin
lookupStakingDeposit Credential 'DRepRole -> Maybe Coin
lookupDRepDeposit f (TxCert era)
certs =
  forall era (f :: * -> *).
(EraPParams era, Foldable f, EraTxCert era) =>
PParams era
-> (StakeCredential -> Maybe Coin) -> f (TxCert era) -> Coin
shelleyTotalRefundsTxCerts PParams era
pp StakeCredential -> Maybe Coin
lookupStakingDeposit f (TxCert era)
certs
    forall t. Val t => t -> t -> t
<+> 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 = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (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
        (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 <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'DRepRole
cred Map (Credential 'DRepRole) Coin
drepRegsInTx ->
            (forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Credential 'DRepRole
cred Map (Credential 'DRepRole) Coin
drepRegsInTx, Coin
totalRefund 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 forall t. Val t => t -> t -> t
<+> Coin
deposit)
      TxCert era
_ -> (Map (Credential 'DRepRole) Coin, Coin)
accum