{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# 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 #-}
#if __GLASGOW_HASKELL__ >= 908
{-# OPTIONS_GHC -Wno-x-unsafe-ledger-internal #-}
#endif

module Cardano.Ledger.Conway.TxCert (
  ConwayTxCert (..),
  ConwayTxCertUpgradeError (..),
  ConwayDelegCert (..),
  ConwayGovCert (..),
  Delegatee (..),
  mkDelegatee,
  ConwayEraTxCert (..),
  conwayTxCertDelegDecoder,
  fromShelleyDelegCert,
  toShelleyDelegCert,
  getScriptWitnessConwayTxCert,
  getVKeyWitnessConwayTxCert,
  conwayGovCertVKeyWitness,
  getDelegateeTxCert,
  getStakePoolDelegatee,
  getDRepDelegatee,
  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 (..),
  credKeyHashWitness,
  credScriptHash,
 )
import Cardano.Ledger.DRep (DRep)
import Cardano.Ledger.Internal.Era (DijkstraEra)
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 StakePoolParams
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
$ StakePoolParams -> TxCert ConwayEra
forall era. EraTxCert era => StakePoolParams -> TxCert era
RegPoolTxCert StakePoolParams
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 :: StakePoolParams -> TxCert ConwayEra
mkRegPoolTxCert = PoolCert -> ConwayTxCert ConwayEra
forall era. PoolCert -> ConwayTxCert era
ConwayTxCertPool (PoolCert -> ConwayTxCert ConwayEra)
-> (StakePoolParams -> PoolCert)
-> StakePoolParams
-> ConwayTxCert ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StakePoolParams -> PoolCert
RegPool

  getRegPoolTxCert :: TxCert ConwayEra -> Maybe StakePoolParams
getRegPoolTxCert (ConwayTxCertPool (RegPool StakePoolParams
poolParams)) = StakePoolParams -> Maybe StakePoolParams
forall a. a -> Maybe a
Just StakePoolParams
poolParams
  getRegPoolTxCert TxCert ConwayEra
_ = Maybe StakePoolParams
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 :: AtMostEra "Babbage" ConwayEra =>
GenesisDelegCert -> TxCert ConwayEra
mkGenesisDelegTxCert = GenesisDelegCert -> TxCert ConwayEra
GenesisDelegCert -> ConwayTxCert ConwayEra
forall a. HasCallStack => a
notSupportedInThisEra
  getGenesisDelegTxCert :: AtMostEra "Babbage" ConwayEra =>
TxCert ConwayEra -> Maybe GenesisDelegCert
getGenesisDelegTxCert TxCert ConwayEra
_ = Maybe GenesisDelegCert
forall a. Maybe a
Nothing

  mkMirTxCert :: AtMostEra "Babbage" ConwayEra => MIRCert -> TxCert ConwayEra
mkMirTxCert = MIRCert -> TxCert ConwayEra
MIRCert -> ConwayTxCert ConwayEra
forall a. HasCallStack => a
notSupportedInThisEra
  getMirTxCert :: AtMostEra "Babbage" ConwayEra => 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 EraTxCert era => ConwayEraTxCert era where
  mkRegDepositTxCert :: Credential Staking -> Coin -> TxCert era
  getRegDepositTxCert :: TxCert era -> Maybe (Credential Staking, Coin)

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

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

  mkRegDepositDelegTxCert ::
    Credential Staking -> Delegatee -> Coin -> TxCert era
  getRegDepositDelegTxCert ::
    TxCert era -> Maybe (Credential Staking, 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 =>
  Credential Staking ->
  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 =>
  Credential Staking ->
  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 =>
  Credential Staking ->
  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 =>
  Credential Staking ->
  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
  #-}

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

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
    poolId <- Object
obj Object -> Key -> Parser (Maybe (KeyHash StakePool))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"poolId"
    dRep <- obj .:? "dRep"
    case (poolId, 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 (ZonkAny 0)) (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 (ZonkAny 0)) (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 (ZonkAny 1)) 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 (ZonkAny 1)) 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 (ZonkAny 3)) (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 (ZonkAny 3)) (KeyHash StakePool)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode Open (DRep -> Delegatee)
-> Decode (Closed (ZonkAny 2)) 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 (ZonkAny 2)) 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

mkDelegatee :: Maybe (KeyHash StakePool) -> Maybe DRep -> Maybe Delegatee
mkDelegatee :: Maybe (KeyHash StakePool) -> Maybe DRep -> Maybe Delegatee
mkDelegatee Maybe (KeyHash StakePool)
mStakePool Maybe DRep
mDRep =
  case (Maybe (KeyHash StakePool)
mStakePool, Maybe DRep
mDRep) of
    (Maybe (KeyHash StakePool)
Nothing, Maybe DRep
Nothing) -> Maybe Delegatee
forall a. Maybe a
Nothing
    (Just KeyHash StakePool
pool, Maybe DRep
Nothing) -> Delegatee -> Maybe Delegatee
forall a. a -> Maybe a
Just (Delegatee -> Maybe Delegatee) -> Delegatee -> Maybe Delegatee
forall a b. (a -> b) -> a -> b
$ KeyHash StakePool -> Delegatee
DelegStake KeyHash StakePool
pool
    (Maybe (KeyHash StakePool)
Nothing, Just DRep
dRep) -> Delegatee -> Maybe Delegatee
forall a. a -> Maybe a
Just (Delegatee -> Maybe Delegatee) -> Delegatee -> Maybe Delegatee
forall a b. (a -> b) -> a -> b
$ DRep -> Delegatee
DelegVote DRep
dRep
    (Just KeyHash StakePool
pool, Just DRep
dRep) -> Delegatee -> Maybe Delegatee
forall a. a -> Maybe a
Just (Delegatee -> Maybe Delegatee) -> Delegatee -> Maybe Delegatee
forall a b. (a -> b) -> a -> b
$ KeyHash StakePool -> DRep -> Delegatee
DelegStakeVote KeyHash StakePool
pool DRep
dRep

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

getDRepDelegatee :: Delegatee -> Maybe DRep
getDRepDelegatee :: Delegatee -> Maybe DRep
getDRepDelegatee DelegStake {} = Maybe DRep
forall a. Maybe a
Nothing
getDRepDelegatee (DelegVote DRep
x) = DRep -> Maybe DRep
forall a. a -> Maybe a
Just DRep
x
getDRepDelegatee (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 !(Credential Staking) !(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 !(Credential Staking) !(StrictMaybe Coin)
  | -- | Delegate staking credentials to a delegatee. Staking credential must already be registered.
    ConwayDelegCert !(Credential Staking) !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 !(Credential Staking) !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
  ( ShelleyEraTxCert era
  , 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
    cred <- Decoder s (Credential Staking)
forall s. Decoder s (Credential Staking)
forall a s. DecCBOR a => Decoder s a
decCBOR
    deposit <- decCBOR
    pure (3, RegDepositTxCert cred deposit)
  Word
8 -> do
    cred <- Decoder s (Credential Staking)
forall s. Decoder s (Credential Staking)
forall a s. DecCBOR a => Decoder s a
decCBOR
    deposit <- decCBOR
    pure (3, UnRegDepositTxCert cred 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
    cred <- Decoder s (Credential ColdCommitteeRole)
forall s. Decoder s (Credential ColdCommitteeRole)
forall a s. DecCBOR a => Decoder s a
decCBOR
    key <- decCBOR
    pure (3, AuthCommitteeHotKeyTxCert cred key)
  Word
15 -> do
    cred <- Decoder s (Credential ColdCommitteeRole)
forall s. Decoder s (Credential ColdCommitteeRole)
forall a s. DecCBOR a => Decoder s a
decCBOR
    a <- decodeNullStrictMaybe decCBOR
    pure (3, ResignCommitteeColdTxCert cred a)
  Word
16 -> do
    cred <- Decoder s (Credential DRepRole)
forall s. Decoder s (Credential DRepRole)
forall a s. DecCBOR a => Decoder s a
decCBOR
    deposit <- decCBOR
    mAnchor <- decodeNullStrictMaybe decCBOR
    pure (4, RegDRepTxCert cred deposit mAnchor)
  Word
17 -> do
    cred <- Decoder s (Credential DRepRole)
forall s. Decoder s (Credential DRepRole)
forall a s. DecCBOR a => Decoder s a
decCBOR
    deposit <- decCBOR
    pure (3, UnRegDRepTxCert cred deposit)
  Word
18 -> do
    cred <- Decoder s (Credential DRepRole)
forall s. Decoder s (Credential DRepRole)
forall a s. DecCBOR a => Decoder s a
decCBOR
    mAnchor <- decodeNullStrictMaybe decCBOR
    pure (3, UpdateDRepTxCert cred 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
      cred <- Decoder s (Credential Staking)
forall s. Decoder s (Credential Staking)
forall a s. DecCBOR a => Decoder s a
decCBOR
      delegatee <- decodeDelegatee
      pure (n, DelegTxCert cred delegatee)
    {-# INLINE delegCertDecoder #-}
    regDelegCertDecoder :: a -> Decoder s Delegatee -> Decoder s (a, TxCert era)
regDelegCertDecoder a
n Decoder s Delegatee
decodeDelegatee = do
      cred <- Decoder s (Credential Staking)
forall s. Decoder s (Credential Staking)
forall a s. DecCBOR a => Decoder s a
decCBOR
      delegatee <- decodeDelegatee
      deposit <- decCBOR
      pure (n, RegDepositDelegTxCert cred delegatee 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 => 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)
conwayGovCertVKeyWitness ConwayGovCert
govCert

conwayGovCertVKeyWitness :: ConwayGovCert -> Maybe (KeyHash Witness)
conwayGovCertVKeyWitness :: ConwayGovCert -> Maybe (KeyHash Witness)
conwayGovCertVKeyWitness = \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