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

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

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

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

instance Crypto c => EraTxCert (ConwayEra c) where
  type TxCert (ConwayEra c) = ConwayTxCert (ConwayEra c)

  type TxCertUpgradeError (ConwayEra c) = ConwayTxCertUpgradeError

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

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

  getScriptWitnessTxCert :: TxCert (ConwayEra c)
-> Maybe (ScriptHash (EraCrypto (ConwayEra c)))
getScriptWitnessTxCert = forall era. ConwayTxCert era -> Maybe (ScriptHash (EraCrypto era))
getScriptWitnessConwayTxCert

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

getDelegateeTxCert :: ConwayEraTxCert era => TxCert era -> Maybe (Delegatee (EraCrypto era))
getDelegateeTxCert :: forall era.
ConwayEraTxCert era =>
TxCert era -> Maybe (Delegatee (EraCrypto era))
getDelegateeTxCert = \case
  DelegTxCert StakeCredential (EraCrypto era)
_ Delegatee (EraCrypto era)
delegatee -> forall a. a -> Maybe a
Just Delegatee (EraCrypto era)
delegatee
  RegDepositDelegTxCert StakeCredential (EraCrypto era)
_ Delegatee (EraCrypto era)
delegatee Coin
_ -> forall a. a -> Maybe a
Just Delegatee (EraCrypto era)
delegatee
  TxCert era
_ -> forall a. Maybe a
Nothing

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

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

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

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

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

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

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

instance NFData (Delegatee c)

instance NoThunks (Delegatee c)

-- | 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 c
  = -- | Register staking credential. Deposit, when present, must match the expected deposit
    -- amount specified by `ppKeyDepositL` in the protocol parameters.
    ConwayRegCert !(StakeCredential c) !(StrictMaybe Coin)
  | -- | De-Register the staking credential. Deposit, if present, must match the amount
    -- that was left as a deposit upon stake credential registration.
    ConwayUnRegCert !(StakeCredential c) !(StrictMaybe Coin)
  | -- | Delegate staking credentials to a delegatee. Staking credential must already be registered.
    ConwayDelegCert !(StakeCredential c) !(Delegatee c)
  | -- | This is a new type of certificate, which allows to register staking credential
    -- and delegate within a single certificate. Deposit is required and must match the
    -- expected deposit amount specified by `ppKeyDepositL` in the protocol parameters.
    ConwayRegDelegCert !(StakeCredential c) !(Delegatee c) !Coin
  deriving (Int -> ConwayDelegCert c -> ShowS
forall c. Int -> ConwayDelegCert c -> ShowS
forall c. [ConwayDelegCert c] -> ShowS
forall c. ConwayDelegCert c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConwayDelegCert c] -> ShowS
$cshowList :: forall c. [ConwayDelegCert c] -> ShowS
show :: ConwayDelegCert c -> String
$cshow :: forall c. ConwayDelegCert c -> String
showsPrec :: Int -> ConwayDelegCert c -> ShowS
$cshowsPrec :: forall c. Int -> ConwayDelegCert c -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (ConwayDelegCert c) x -> ConwayDelegCert c
forall c x. ConwayDelegCert c -> Rep (ConwayDelegCert c) x
$cto :: forall c x. Rep (ConwayDelegCert c) x -> ConwayDelegCert c
$cfrom :: forall c x. ConwayDelegCert c -> Rep (ConwayDelegCert c) x
Generic, ConwayDelegCert c -> ConwayDelegCert c -> Bool
forall c. ConwayDelegCert c -> ConwayDelegCert c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConwayDelegCert c -> ConwayDelegCert c -> Bool
$c/= :: forall c. ConwayDelegCert c -> ConwayDelegCert c -> Bool
== :: ConwayDelegCert c -> ConwayDelegCert c -> Bool
$c== :: forall c. ConwayDelegCert c -> ConwayDelegCert c -> Bool
Eq, ConwayDelegCert c -> ConwayDelegCert c -> Ordering
forall c. Eq (ConwayDelegCert c)
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 c. ConwayDelegCert c -> ConwayDelegCert c -> Bool
forall c. ConwayDelegCert c -> ConwayDelegCert c -> Ordering
forall c.
ConwayDelegCert c -> ConwayDelegCert c -> ConwayDelegCert c
min :: ConwayDelegCert c -> ConwayDelegCert c -> ConwayDelegCert c
$cmin :: forall c.
ConwayDelegCert c -> ConwayDelegCert c -> ConwayDelegCert c
max :: ConwayDelegCert c -> ConwayDelegCert c -> ConwayDelegCert c
$cmax :: forall c.
ConwayDelegCert c -> ConwayDelegCert c -> ConwayDelegCert c
>= :: ConwayDelegCert c -> ConwayDelegCert c -> Bool
$c>= :: forall c. ConwayDelegCert c -> ConwayDelegCert c -> Bool
> :: ConwayDelegCert c -> ConwayDelegCert c -> Bool
$c> :: forall c. ConwayDelegCert c -> ConwayDelegCert c -> Bool
<= :: ConwayDelegCert c -> ConwayDelegCert c -> Bool
$c<= :: forall c. ConwayDelegCert c -> ConwayDelegCert c -> Bool
< :: ConwayDelegCert c -> ConwayDelegCert c -> Bool
$c< :: forall c. ConwayDelegCert c -> ConwayDelegCert c -> Bool
compare :: ConwayDelegCert c -> ConwayDelegCert c -> Ordering
$ccompare :: forall c. ConwayDelegCert c -> ConwayDelegCert c -> Ordering
Ord)

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

instance NFData (ConwayDelegCert c)

instance NoThunks (ConwayDelegCert c)

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

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

instance Crypto c => NFData (ConwayGovCert c)

instance NoThunks (ConwayGovCert c)

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

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

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

instance Crypto (EraCrypto era) => NFData (ConwayTxCert era)

instance NoThunks (ConwayTxCert era)

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

instance
  ( ShelleyEraTxCert era
  , TxCert era ~ ConwayTxCert era
  ) =>
  FromCBOR (ConwayTxCert era)
  where
  fromCBOR :: forall s. Decoder s (ConwayTxCert era)
fromCBOR = forall s a. Version -> Decoder s a -> Decoder s a
toPlainDecoder (forall era. Era era => Version
eraProtVerLow @era) forall a s. DecCBOR a => Decoder s a
decCBOR

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

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

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

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

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

toShelleyDelegCert :: ConwayDelegCert c -> Maybe (ShelleyDelegCert c)
toShelleyDelegCert :: forall c. ConwayDelegCert c -> Maybe (ShelleyDelegCert c)
toShelleyDelegCert = \case
  ConwayRegCert StakeCredential c
cred StrictMaybe Coin
SNothing -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall c. StakeCredential c -> ShelleyDelegCert c
ShelleyRegCert StakeCredential c
cred
  ConwayUnRegCert StakeCredential c
cred StrictMaybe Coin
SNothing -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall c. StakeCredential c -> ShelleyDelegCert c
ShelleyUnRegCert StakeCredential c
cred
  ConwayDelegCert StakeCredential c
cred (DelegStake KeyHash 'StakePool c
poolId) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall c.
StakeCredential c -> KeyHash 'StakePool c -> ShelleyDelegCert c
ShelleyDelegCert StakeCredential c
cred KeyHash 'StakePool c
poolId
  ConwayDelegCert c
_ -> 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 (EraCrypto era))
getScriptWitnessConwayTxCert :: forall era. ConwayTxCert era -> Maybe (ScriptHash (EraCrypto era))
getScriptWitnessConwayTxCert = \case
  ConwayTxCertDeleg ConwayDelegCert (EraCrypto era)
delegCert ->
    case ConwayDelegCert (EraCrypto era)
delegCert of
      ConwayRegCert StakeCredential (EraCrypto era)
_ StrictMaybe Coin
SNothing -> forall a. Maybe a
Nothing
      ConwayRegCert StakeCredential (EraCrypto era)
cred (SJust Coin
_) -> forall (kr :: KeyRole) c. Credential kr c -> Maybe (ScriptHash c)
credScriptHash StakeCredential (EraCrypto era)
cred
      ConwayUnRegCert StakeCredential (EraCrypto era)
cred StrictMaybe Coin
_ -> forall (kr :: KeyRole) c. Credential kr c -> Maybe (ScriptHash c)
credScriptHash StakeCredential (EraCrypto era)
cred
      ConwayDelegCert StakeCredential (EraCrypto era)
cred Delegatee (EraCrypto era)
_ -> forall (kr :: KeyRole) c. Credential kr c -> Maybe (ScriptHash c)
credScriptHash StakeCredential (EraCrypto era)
cred
      ConwayRegDelegCert StakeCredential (EraCrypto era)
cred Delegatee (EraCrypto era)
_ Coin
_ -> forall (kr :: KeyRole) c. Credential kr c -> Maybe (ScriptHash c)
credScriptHash StakeCredential (EraCrypto era)
cred
  -- PoolIds can't be Scripts
  ConwayTxCertPool {} -> forall a. Maybe a
Nothing
  ConwayTxCertGov ConwayGovCert (EraCrypto era)
govCert -> forall c. ConwayGovCert c -> Maybe (ScriptHash c)
govWitness ConwayGovCert (EraCrypto era)
govCert
  where
    govWitness :: ConwayGovCert c -> Maybe (ScriptHash c)
    govWitness :: forall c. ConwayGovCert c -> Maybe (ScriptHash c)
govWitness = \case
      ConwayAuthCommitteeHotKey Credential 'ColdCommitteeRole c
coldCred Credential 'HotCommitteeRole c
_hotCred -> forall (kr :: KeyRole) c. Credential kr c -> Maybe (ScriptHash c)
credScriptHash Credential 'ColdCommitteeRole c
coldCred
      ConwayResignCommitteeColdKey Credential 'ColdCommitteeRole c
coldCred StrictMaybe (Anchor c)
_ -> forall (kr :: KeyRole) c. Credential kr c -> Maybe (ScriptHash c)
credScriptHash Credential 'ColdCommitteeRole c
coldCred
      ConwayRegDRep Credential 'DRepRole c
cred Coin
_ StrictMaybe (Anchor c)
_ -> forall (kr :: KeyRole) c. Credential kr c -> Maybe (ScriptHash c)
credScriptHash Credential 'DRepRole c
cred
      ConwayUnRegDRep Credential 'DRepRole c
cred Coin
_ -> forall (kr :: KeyRole) c. Credential kr c -> Maybe (ScriptHash c)
credScriptHash Credential 'DRepRole c
cred
      ConwayUpdateDRep Credential 'DRepRole c
cred StrictMaybe (Anchor c)
_ -> forall (kr :: KeyRole) c. Credential kr c -> Maybe (ScriptHash c)
credScriptHash Credential 'DRepRole c
cred

getVKeyWitnessConwayTxCert :: ConwayTxCert era -> Maybe (KeyHash 'Witness (EraCrypto era))
getVKeyWitnessConwayTxCert :: forall era.
ConwayTxCert era -> Maybe (KeyHash 'Witness (EraCrypto era))
getVKeyWitnessConwayTxCert = \case
  ConwayTxCertDeleg ConwayDelegCert (EraCrypto era)
delegCert ->
    case ConwayDelegCert (EraCrypto era)
delegCert of
      ConwayRegCert StakeCredential (EraCrypto era)
_ StrictMaybe Coin
SNothing -> forall a. Maybe a
Nothing
      ConwayRegCert StakeCredential (EraCrypto era)
cred (SJust Coin
_) -> forall (r :: KeyRole) c.
Credential r c -> Maybe (KeyHash 'Witness c)
credKeyHashWitness StakeCredential (EraCrypto era)
cred
      ConwayUnRegCert StakeCredential (EraCrypto era)
cred StrictMaybe Coin
_ -> forall (r :: KeyRole) c.
Credential r c -> Maybe (KeyHash 'Witness c)
credKeyHashWitness StakeCredential (EraCrypto era)
cred
      ConwayDelegCert StakeCredential (EraCrypto era)
cred Delegatee (EraCrypto era)
_ -> forall (r :: KeyRole) c.
Credential r c -> Maybe (KeyHash 'Witness c)
credKeyHashWitness StakeCredential (EraCrypto era)
cred
      ConwayRegDelegCert StakeCredential (EraCrypto era)
cred Delegatee (EraCrypto era)
_ Coin
_ -> forall (r :: KeyRole) c.
Credential r c -> Maybe (KeyHash 'Witness c)
credKeyHashWitness StakeCredential (EraCrypto era)
cred
  ConwayTxCertPool PoolCert (EraCrypto era)
poolCert -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall c. PoolCert c -> KeyHash 'Witness c
poolCertKeyHashWitness PoolCert (EraCrypto era)
poolCert
  ConwayTxCertGov ConwayGovCert (EraCrypto era)
govCert -> forall c. ConwayGovCert c -> Maybe (KeyHash 'Witness c)
govWitness ConwayGovCert (EraCrypto era)
govCert
  where
    govWitness :: ConwayGovCert c -> Maybe (KeyHash 'Witness c)
    govWitness :: forall c. ConwayGovCert c -> Maybe (KeyHash 'Witness c)
govWitness = \case
      ConwayAuthCommitteeHotKey Credential 'ColdCommitteeRole c
coldCred Credential 'HotCommitteeRole c
_hotCred -> forall (r :: KeyRole) c.
Credential r c -> Maybe (KeyHash 'Witness c)
credKeyHashWitness Credential 'ColdCommitteeRole c
coldCred
      ConwayResignCommitteeColdKey Credential 'ColdCommitteeRole c
coldCred StrictMaybe (Anchor c)
_ -> forall (r :: KeyRole) c.
Credential r c -> Maybe (KeyHash 'Witness c)
credKeyHashWitness Credential 'ColdCommitteeRole c
coldCred
      ConwayRegDRep Credential 'DRepRole c
cred Coin
_ StrictMaybe (Anchor c)
_ -> forall (r :: KeyRole) c.
Credential r c -> Maybe (KeyHash 'Witness c)
credKeyHashWitness Credential 'DRepRole c
cred
      ConwayUnRegDRep Credential 'DRepRole c
cred Coin
_ -> forall (r :: KeyRole) c.
Credential r c -> Maybe (KeyHash 'Witness c)
credKeyHashWitness Credential 'DRepRole c
cred
      ConwayUpdateDRep Credential 'DRepRole c
cred StrictMaybe (Anchor c)
_ -> forall (r :: KeyRole) c.
Credential r c -> Maybe (KeyHash 'Witness c)
credKeyHashWitness Credential 'DRepRole c
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 (EraCrypto era) -> Bool) ->
  f (TxCert era) ->
  Coin
conwayTotalDepositsTxCerts :: forall era (f :: * -> *).
(ConwayEraPParams era, Foldable f, ConwayEraTxCert era) =>
PParams era
-> (KeyHash 'StakePool (EraCrypto era) -> Bool)
-> f (TxCert era)
-> Coin
conwayTotalDepositsTxCerts PParams era
pp KeyHash 'StakePool (EraCrypto era) -> Bool
isRegPoolRegistered f (TxCert era)
certs =
  forall era (f :: * -> *).
(EraPParams era, Foldable f, EraTxCert era) =>
PParams era
-> (KeyHash 'StakePool (EraCrypto era) -> Bool)
-> f (TxCert era)
-> Coin
shelleyTotalDepositsTxCerts PParams era
pp KeyHash 'StakePool (EraCrypto era) -> Bool
isRegPoolRegistered f (TxCert era)
certs
    forall t. Val t => t -> t -> t
<+> forall era (f :: * -> *).
(ConwayEraPParams era, Foldable f, ConwayEraTxCert era) =>
PParams era -> f (TxCert era) -> Coin
conwayDRepDepositsTxCerts PParams era
pp f (TxCert era)
certs

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

-- | Compute the key deregistration refunds in a transaction
conwayTotalRefundsTxCerts ::
  (EraPParams era, Foldable f, ConwayEraTxCert era) =>
  PParams era ->
  -- | Function that can lookup current deposit, in case when the Staking credential is registered.
  (Credential 'Staking (EraCrypto era) -> Maybe Coin) ->
  -- | Function that can lookup current deposit, in case when the DRep credential is registered.
  (Credential 'DRepRole (EraCrypto era) -> Maybe Coin) ->
  f (TxCert era) ->
  Coin
conwayTotalRefundsTxCerts :: forall era (f :: * -> *).
(EraPParams era, Foldable f, ConwayEraTxCert era) =>
PParams era
-> (Credential 'Staking (EraCrypto era) -> Maybe Coin)
-> (Credential 'DRepRole (EraCrypto era) -> Maybe Coin)
-> f (TxCert era)
-> Coin
conwayTotalRefundsTxCerts PParams era
pp Credential 'Staking (EraCrypto era) -> Maybe Coin
lookupStakingDeposit Credential 'DRepRole (EraCrypto era) -> Maybe Coin
lookupDRepDeposit f (TxCert era)
certs =
  forall era (f :: * -> *).
(EraPParams era, Foldable f, EraTxCert era) =>
PParams era
-> (StakeCredential (EraCrypto era) -> Maybe Coin)
-> f (TxCert era)
-> Coin
shelleyTotalRefundsTxCerts PParams era
pp Credential 'Staking (EraCrypto era) -> Maybe Coin
lookupStakingDeposit f (TxCert era)
certs
    forall t. Val t => t -> t -> t
<+> forall (f :: * -> *) era.
(Foldable f, ConwayEraTxCert era) =>
(Credential 'DRepRole (EraCrypto era) -> Maybe Coin)
-> f (TxCert era) -> Coin
conwayDRepRefundsTxCerts Credential 'DRepRole (EraCrypto era) -> 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 (EraCrypto era) -> Maybe Coin) ->
  f (TxCert era) ->
  Coin
conwayDRepRefundsTxCerts :: forall (f :: * -> *) era.
(Foldable f, ConwayEraTxCert era) =>
(Credential 'DRepRole (EraCrypto era) -> Maybe Coin)
-> f (TxCert era) -> Coin
conwayDRepRefundsTxCerts Credential 'DRepRole (EraCrypto era) -> Maybe Coin
lookupDRepDeposit = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' (Map (Credential 'DRepRole (EraCrypto era)) Coin, Coin)
-> TxCert era
-> (Map (Credential 'DRepRole (EraCrypto era)) Coin, Coin)
go (forall k a. Map k a
Map.empty, Integer -> Coin
Coin Integer
0)
  where
    go :: (Map (Credential 'DRepRole (EraCrypto era)) Coin, Coin)
-> TxCert era
-> (Map (Credential 'DRepRole (EraCrypto era)) Coin, Coin)
go accum :: (Map (Credential 'DRepRole (EraCrypto era)) Coin, Coin)
accum@(!Map (Credential 'DRepRole (EraCrypto era)) Coin
drepRegsInTx, !Coin
totalRefund) = \case
      RegDRepTxCert Credential 'DRepRole (EraCrypto era)
cred Coin
deposit StrictMaybe (Anchor (EraCrypto era))
_ ->
        -- Track registrations
        (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Credential 'DRepRole (EraCrypto era)
cred Coin
deposit Map (Credential 'DRepRole (EraCrypto era)) Coin
drepRegsInTx, Coin
totalRefund)
      UnRegDRepTxCert Credential 'DRepRole (EraCrypto era)
cred Coin
_
        -- DRep previously registered in the same tx.
        | Just Coin
deposit <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'DRepRole (EraCrypto era)
cred Map (Credential 'DRepRole (EraCrypto era)) Coin
drepRegsInTx ->
            (forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Credential 'DRepRole (EraCrypto era)
cred Map (Credential 'DRepRole (EraCrypto era)) Coin
drepRegsInTx, Coin
totalRefund forall t. Val t => t -> t -> t
<+> Coin
deposit)
        -- DRep previously registered in some other tx.
        | Just Coin
deposit <- Credential 'DRepRole (EraCrypto era) -> Maybe Coin
lookupDRepDeposit Credential 'DRepRole (EraCrypto era)
cred -> (Map (Credential 'DRepRole (EraCrypto era)) Coin
drepRegsInTx, Coin
totalRefund forall t. Val t => t -> t -> t
<+> Coin
deposit)
      TxCert era
_ -> (Map (Credential 'DRepRole (EraCrypto era)) Coin, Coin)
accum