{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# 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.Shelley.TxCert (
  ShelleyEraTxCert (..),
  pattern MirTxCert,
  pattern GenesisDelegTxCert,
  pattern RegTxCert,
  pattern UnRegTxCert,
  pattern DelegStakeTxCert,
  ShelleyDelegCert (..),
  getVKeyWitnessShelleyTxCert,
  getScriptWitnessShelleyTxCert,
  ShelleyTxCert (..),
  upgradeShelleyTxCert,

  -- ** GenesisDelegCert
  GenesisDelegCert (..),
  genesisCWitness,
  genesisKeyHashWitness,

  -- ** MIRCert
  MIRCert (..),
  MIRPot (..),
  MIRTarget (..),
  isDelegation,
  isRegPool,
  isRetirePool,
  isGenesisDelegation,
  isInstantaneousRewards,
  isReservesMIRCert,
  isTreasuryMIRCert,

  -- ** Serialization helpers
  shelleyTxCertDelegDecoder,
  poolTxCertDecoder,
  encodeShelleyDelegCert,
  encodePoolCert,
  encodeGenesisDelegCert,

  -- ** Deposits and Refunds
  shelleyTotalDepositsTxCerts,
  shelleyTotalRefundsTxCerts,

  -- * Re-exports
  EraTxCert (..),
  pattern RegPoolTxCert,
  pattern RetirePoolTxCert,
  PoolCert (..),
  isRegStakeTxCert,
  isUnRegStakeTxCert,
) where

import Cardano.Ledger.BaseTypes (invalidKey, kindObject)
import Cardano.Ledger.Binary (
  DecCBOR (decCBOR),
  DecCBORGroup (..),
  Decoder,
  EncCBOR (..),
  EncCBORGroup (..),
  Encoding,
  FromCBOR (..),
  ToCBOR (..),
  TokenType (TypeMapLen, TypeMapLen64, TypeMapLenIndef),
  decodeRecordNamed,
  decodeRecordSum,
  decodeWord,
  encodeListLen,
  encodeWord8,
  listLenInt,
  peekTokenType,
 )
import Cardano.Ledger.Coin (Coin (..), DeltaCoin)
import Cardano.Ledger.Core
import Cardano.Ledger.Credential (
  Credential (..),
  credKeyHashWitness,
  credScriptHash,
 )
import Cardano.Ledger.Internal.Era (AllegraEra, AlonzoEra, BabbageEra, MaryEra)
import Cardano.Ledger.Keys (asWitness)
import Cardano.Ledger.Shelley.Era (ShelleyEra)
import Cardano.Ledger.Shelley.PParams ()
import Cardano.Ledger.State (StakePoolParams (..))
import Cardano.Ledger.Val ((<+>), (<×>))
import Control.DeepSeq (NFData (..), rwhnf)
import Data.Aeson (ToJSON (..), (.=))
import Data.Foldable as F (Foldable (..), foldMap', foldl')
import Data.Map.Strict (Map)
import Data.Maybe (isJust)
import Data.Monoid (Sum (..))
import qualified Data.Set as Set
import GHC.Generics (Generic)
import Lens.Micro
import NoThunks.Class (NoThunks (..))

instance EraTxCert ShelleyEra where
  type TxCert ShelleyEra = ShelleyTxCert ShelleyEra

  -- Calling this partial function will result in compilation error, since ByronEra has
  -- no instance for EraTxOut type class.
  upgradeTxCert :: EraTxCert (PreviousEra ShelleyEra) =>
TxCert (PreviousEra ShelleyEra)
-> Either (TxCertUpgradeError ShelleyEra) (TxCert ShelleyEra)
upgradeTxCert = [Char] -> TxCert ByronEra -> Either Void (ShelleyTxCert ShelleyEra)
forall a. HasCallStack => [Char] -> a
error [Char]
"Byron does not have any TxCerts to upgrade with 'upgradeTxCert'"

  getVKeyWitnessTxCert :: TxCert ShelleyEra -> Maybe (KeyHash Witness)
getVKeyWitnessTxCert = TxCert ShelleyEra -> Maybe (KeyHash Witness)
ShelleyTxCert ShelleyEra -> Maybe (KeyHash Witness)
forall era. ShelleyTxCert era -> Maybe (KeyHash Witness)
getVKeyWitnessShelleyTxCert

  getScriptWitnessTxCert :: TxCert ShelleyEra -> Maybe ScriptHash
getScriptWitnessTxCert = TxCert ShelleyEra -> Maybe ScriptHash
ShelleyTxCert ShelleyEra -> Maybe ScriptHash
forall era. ShelleyTxCert era -> Maybe ScriptHash
getScriptWitnessShelleyTxCert

  mkRegPoolTxCert :: StakePoolParams -> TxCert ShelleyEra
mkRegPoolTxCert = PoolCert -> ShelleyTxCert ShelleyEra
forall era. PoolCert -> ShelleyTxCert era
ShelleyTxCertPool (PoolCert -> ShelleyTxCert ShelleyEra)
-> (StakePoolParams -> PoolCert)
-> StakePoolParams
-> ShelleyTxCert ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StakePoolParams -> PoolCert
RegPool

  getRegPoolTxCert :: TxCert ShelleyEra -> Maybe StakePoolParams
getRegPoolTxCert (ShelleyTxCertPool (RegPool StakePoolParams
poolParams)) = StakePoolParams -> Maybe StakePoolParams
forall a. a -> Maybe a
Just StakePoolParams
poolParams
  getRegPoolTxCert TxCert ShelleyEra
_ = Maybe StakePoolParams
forall a. Maybe a
Nothing

  mkRetirePoolTxCert :: KeyHash StakePool -> EpochNo -> TxCert ShelleyEra
mkRetirePoolTxCert KeyHash StakePool
poolId EpochNo
epochNo = PoolCert -> ShelleyTxCert ShelleyEra
forall era. PoolCert -> ShelleyTxCert era
ShelleyTxCertPool (PoolCert -> ShelleyTxCert ShelleyEra)
-> PoolCert -> ShelleyTxCert ShelleyEra
forall a b. (a -> b) -> a -> b
$ KeyHash StakePool -> EpochNo -> PoolCert
RetirePool KeyHash StakePool
poolId EpochNo
epochNo

  getRetirePoolTxCert :: TxCert ShelleyEra -> Maybe (KeyHash StakePool, EpochNo)
getRetirePoolTxCert (ShelleyTxCertPool (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 ShelleyEra
_ = Maybe (KeyHash StakePool, EpochNo)
forall a. Maybe a
Nothing

  lookupRegStakeTxCert :: TxCert ShelleyEra -> Maybe (Credential Staking)
lookupRegStakeTxCert = \case
    RegTxCert Credential Staking
c -> Credential Staking -> Maybe (Credential Staking)
forall a. a -> Maybe a
Just Credential Staking
c
    TxCert ShelleyEra
_ -> Maybe (Credential Staking)
forall a. Maybe a
Nothing
  lookupUnRegStakeTxCert :: TxCert ShelleyEra -> Maybe (Credential Staking)
lookupUnRegStakeTxCert = \case
    UnRegTxCert Credential Staking
c -> Credential Staking -> Maybe (Credential Staking)
forall a. a -> Maybe a
Just Credential Staking
c
    TxCert ShelleyEra
_ -> Maybe (Credential Staking)
forall a. Maybe a
Nothing

  getTotalDepositsTxCerts :: forall (f :: * -> *).
Foldable f =>
PParams ShelleyEra
-> (KeyHash StakePool -> Bool) -> f (TxCert ShelleyEra) -> Coin
getTotalDepositsTxCerts = PParams ShelleyEra
-> (KeyHash StakePool -> Bool) -> f (TxCert ShelleyEra) -> Coin
forall era (f :: * -> *).
(EraPParams era, Foldable f, EraTxCert era) =>
PParams era
-> (KeyHash StakePool -> Bool) -> f (TxCert era) -> Coin
shelleyTotalDepositsTxCerts

  getTotalRefundsTxCerts :: forall (f :: * -> *).
Foldable f =>
PParams ShelleyEra
-> (Credential Staking -> Maybe Coin)
-> (Credential DRepRole -> Maybe Coin)
-> f (TxCert ShelleyEra)
-> Coin
getTotalRefundsTxCerts PParams ShelleyEra
pp Credential Staking -> Maybe Coin
lookupStakeDeposit Credential DRepRole -> Maybe Coin
_ = PParams ShelleyEra
-> (Credential Staking -> Maybe Coin)
-> f (TxCert ShelleyEra)
-> Coin
forall era (f :: * -> *).
(EraPParams era, Foldable f, EraTxCert era) =>
PParams era
-> (Credential Staking -> Maybe Coin) -> f (TxCert era) -> Coin
shelleyTotalRefundsTxCerts PParams ShelleyEra
pp Credential Staking -> Maybe Coin
lookupStakeDeposit

-- | All of the Shelley related certificate functionality that has been fully deprecated in Dijkstra.
class (EraTxCert era, AtMostEra "Conway" era) => ShelleyEraTxCert era where
  mkRegTxCert :: Credential Staking -> TxCert era
  getRegTxCert :: TxCert era -> Maybe (Credential Staking)

  mkUnRegTxCert :: Credential Staking -> TxCert era
  getUnRegTxCert :: TxCert era -> Maybe (Credential Staking)

  mkDelegStakeTxCert :: Credential Staking -> KeyHash StakePool -> TxCert era
  getDelegStakeTxCert :: TxCert era -> Maybe (Credential Staking, KeyHash StakePool)

  mkGenesisDelegTxCert :: AtMostEra "Babbage" era => GenesisDelegCert -> TxCert era
  getGenesisDelegTxCert :: AtMostEra "Babbage" era => TxCert era -> Maybe GenesisDelegCert

  mkMirTxCert :: AtMostEra "Babbage" era => MIRCert -> TxCert era
  getMirTxCert :: AtMostEra "Babbage" era => TxCert era -> Maybe MIRCert

instance ShelleyEraTxCert ShelleyEra where
  mkRegTxCert :: Credential Staking -> TxCert ShelleyEra
mkRegTxCert = ShelleyDelegCert -> ShelleyTxCert ShelleyEra
forall era. ShelleyDelegCert -> ShelleyTxCert era
ShelleyTxCertDelegCert (ShelleyDelegCert -> ShelleyTxCert ShelleyEra)
-> (Credential Staking -> ShelleyDelegCert)
-> Credential Staking
-> ShelleyTxCert ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential Staking -> ShelleyDelegCert
ShelleyRegCert

  getRegTxCert :: TxCert ShelleyEra -> Maybe (Credential Staking)
getRegTxCert (ShelleyTxCertDelegCert (ShelleyRegCert Credential Staking
c)) = Credential Staking -> Maybe (Credential Staking)
forall a. a -> Maybe a
Just Credential Staking
c
  getRegTxCert TxCert ShelleyEra
_ = Maybe (Credential Staking)
forall a. Maybe a
Nothing

  mkUnRegTxCert :: Credential Staking -> TxCert ShelleyEra
mkUnRegTxCert = ShelleyDelegCert -> ShelleyTxCert ShelleyEra
forall era. ShelleyDelegCert -> ShelleyTxCert era
ShelleyTxCertDelegCert (ShelleyDelegCert -> ShelleyTxCert ShelleyEra)
-> (Credential Staking -> ShelleyDelegCert)
-> Credential Staking
-> ShelleyTxCert ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential Staking -> ShelleyDelegCert
ShelleyUnRegCert

  getUnRegTxCert :: TxCert ShelleyEra -> Maybe (Credential Staking)
getUnRegTxCert (ShelleyTxCertDelegCert (ShelleyUnRegCert Credential Staking
c)) = Credential Staking -> Maybe (Credential Staking)
forall a. a -> Maybe a
Just Credential Staking
c
  getUnRegTxCert TxCert ShelleyEra
_ = Maybe (Credential Staking)
forall a. Maybe a
Nothing

  mkDelegStakeTxCert :: Credential Staking -> KeyHash StakePool -> TxCert ShelleyEra
mkDelegStakeTxCert Credential Staking
c KeyHash StakePool
kh = ShelleyDelegCert -> ShelleyTxCert ShelleyEra
forall era. ShelleyDelegCert -> ShelleyTxCert era
ShelleyTxCertDelegCert (ShelleyDelegCert -> ShelleyTxCert ShelleyEra)
-> ShelleyDelegCert -> ShelleyTxCert ShelleyEra
forall a b. (a -> b) -> a -> b
$ Credential Staking -> KeyHash StakePool -> ShelleyDelegCert
ShelleyDelegCert Credential Staking
c KeyHash StakePool
kh

  getDelegStakeTxCert :: TxCert ShelleyEra -> Maybe (Credential Staking, KeyHash StakePool)
getDelegStakeTxCert (ShelleyTxCertDelegCert (ShelleyDelegCert Credential Staking
c 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 ShelleyEra
_ = Maybe (Credential Staking, KeyHash StakePool)
forall a. Maybe a
Nothing

  mkGenesisDelegTxCert :: AtMostEra "Babbage" ShelleyEra =>
GenesisDelegCert -> TxCert ShelleyEra
mkGenesisDelegTxCert = GenesisDelegCert -> TxCert ShelleyEra
GenesisDelegCert -> ShelleyTxCert ShelleyEra
forall era. GenesisDelegCert -> ShelleyTxCert era
ShelleyTxCertGenesisDeleg

  getGenesisDelegTxCert :: AtMostEra "Babbage" ShelleyEra =>
TxCert ShelleyEra -> Maybe GenesisDelegCert
getGenesisDelegTxCert (ShelleyTxCertGenesisDeleg GenesisDelegCert
c) = GenesisDelegCert -> Maybe GenesisDelegCert
forall a. a -> Maybe a
Just GenesisDelegCert
c
  getGenesisDelegTxCert TxCert ShelleyEra
_ = Maybe GenesisDelegCert
forall a. Maybe a
Nothing

  mkMirTxCert :: AtMostEra "Babbage" ShelleyEra => MIRCert -> TxCert ShelleyEra
mkMirTxCert = MIRCert -> TxCert ShelleyEra
MIRCert -> ShelleyTxCert ShelleyEra
forall era. MIRCert -> ShelleyTxCert era
ShelleyTxCertMir

  getMirTxCert :: AtMostEra "Babbage" ShelleyEra =>
TxCert ShelleyEra -> Maybe MIRCert
getMirTxCert (ShelleyTxCertMir MIRCert
c) = MIRCert -> Maybe MIRCert
forall a. a -> Maybe a
Just MIRCert
c
  getMirTxCert TxCert ShelleyEra
_ = Maybe MIRCert
forall a. Maybe a
Nothing

pattern RegTxCert :: ShelleyEraTxCert era => Credential Staking -> TxCert era
pattern $mRegTxCert :: forall {r} {era}.
ShelleyEraTxCert era =>
TxCert era -> (Credential Staking -> r) -> ((# #) -> r) -> r
$bRegTxCert :: forall era.
ShelleyEraTxCert era =>
Credential Staking -> TxCert era
RegTxCert c <- (getRegTxCert -> Just c)
  where
    RegTxCert Credential Staking
c = Credential Staking -> TxCert era
forall era.
ShelleyEraTxCert era =>
Credential Staking -> TxCert era
mkRegTxCert Credential Staking
c

pattern UnRegTxCert :: ShelleyEraTxCert era => Credential Staking -> TxCert era
pattern $mUnRegTxCert :: forall {r} {era}.
ShelleyEraTxCert era =>
TxCert era -> (Credential Staking -> r) -> ((# #) -> r) -> r
$bUnRegTxCert :: forall era.
ShelleyEraTxCert era =>
Credential Staking -> TxCert era
UnRegTxCert c <- (getUnRegTxCert -> Just c)
  where
    UnRegTxCert Credential Staking
c = Credential Staking -> TxCert era
forall era.
ShelleyEraTxCert era =>
Credential Staking -> TxCert era
mkUnRegTxCert Credential Staking
c

pattern DelegStakeTxCert ::
  ShelleyEraTxCert era =>
  Credential Staking ->
  KeyHash StakePool ->
  TxCert era
pattern $mDelegStakeTxCert :: forall {r} {era}.
ShelleyEraTxCert era =>
TxCert era
-> (Credential Staking -> KeyHash StakePool -> r)
-> ((# #) -> r)
-> r
$bDelegStakeTxCert :: forall era.
ShelleyEraTxCert era =>
Credential Staking -> KeyHash StakePool -> TxCert era
DelegStakeTxCert c kh <- (getDelegStakeTxCert -> Just (c, kh))
  where
    DelegStakeTxCert Credential Staking
c KeyHash StakePool
kh = Credential Staking -> KeyHash StakePool -> TxCert era
forall era.
ShelleyEraTxCert era =>
Credential Staking -> KeyHash StakePool -> TxCert era
mkDelegStakeTxCert Credential Staking
c KeyHash StakePool
kh

pattern MirTxCert ::
  (ShelleyEraTxCert era, AtMostEra "Babbage" era) => MIRCert -> TxCert era
pattern $mMirTxCert :: forall {r} {era}.
(ShelleyEraTxCert era, AtMostEra "Babbage" era) =>
TxCert era -> (MIRCert -> r) -> ((# #) -> r) -> r
$bMirTxCert :: forall era.
(ShelleyEraTxCert era, AtMostEra "Babbage" era) =>
MIRCert -> TxCert era
MirTxCert d <- (getMirTxCert -> Just d)
  where
    MirTxCert MIRCert
d = MIRCert -> TxCert era
forall era.
(ShelleyEraTxCert era, AtMostEra "Babbage" era) =>
MIRCert -> TxCert era
mkMirTxCert MIRCert
d

pattern GenesisDelegTxCert ::
  (ShelleyEraTxCert era, AtMostEra "Babbage" era) =>
  KeyHash GenesisRole ->
  KeyHash GenesisDelegate ->
  VRFVerKeyHash GenDelegVRF ->
  TxCert era
pattern $mGenesisDelegTxCert :: forall {r} {era}.
(ShelleyEraTxCert era, AtMostEra "Babbage" era) =>
TxCert era
-> (KeyHash GenesisRole
    -> KeyHash GenesisDelegate -> VRFVerKeyHash GenDelegVRF -> r)
-> ((# #) -> r)
-> r
$bGenesisDelegTxCert :: forall era.
(ShelleyEraTxCert era, AtMostEra "Babbage" era) =>
KeyHash GenesisRole
-> KeyHash GenesisDelegate
-> VRFVerKeyHash GenDelegVRF
-> TxCert era
GenesisDelegTxCert genKey genDelegKey vrfKeyHash <-
  (getGenesisDelegTxCert -> Just (GenesisDelegCert genKey genDelegKey vrfKeyHash))
  where
    GenesisDelegTxCert KeyHash GenesisRole
genKey KeyHash GenesisDelegate
genDelegKey VRFVerKeyHash GenDelegVRF
vrfKeyHash =
      GenesisDelegCert -> TxCert era
forall era.
(ShelleyEraTxCert era, AtMostEra "Babbage" era) =>
GenesisDelegCert -> TxCert era
mkGenesisDelegTxCert (GenesisDelegCert -> TxCert era) -> GenesisDelegCert -> TxCert era
forall a b. (a -> b) -> a -> b
$ KeyHash GenesisRole
-> KeyHash GenesisDelegate
-> VRFVerKeyHash GenDelegVRF
-> GenesisDelegCert
GenesisDelegCert KeyHash GenesisRole
genKey KeyHash GenesisDelegate
genDelegKey VRFVerKeyHash GenDelegVRF
vrfKeyHash

{-# COMPLETE
  RegPoolTxCert
  , RetirePoolTxCert
  , RegTxCert
  , UnRegTxCert
  , DelegStakeTxCert
  , MirTxCert
  , GenesisDelegTxCert ::
    ShelleyEra
  #-}

{-# COMPLETE
  RegPoolTxCert
  , RetirePoolTxCert
  , RegTxCert
  , UnRegTxCert
  , DelegStakeTxCert
  , MirTxCert
  , GenesisDelegTxCert ::
    AllegraEra
  #-}

{-# COMPLETE
  RegPoolTxCert
  , RetirePoolTxCert
  , RegTxCert
  , UnRegTxCert
  , DelegStakeTxCert
  , MirTxCert
  , GenesisDelegTxCert ::
    MaryEra
  #-}

{-# COMPLETE
  RegPoolTxCert
  , RetirePoolTxCert
  , RegTxCert
  , UnRegTxCert
  , DelegStakeTxCert
  , MirTxCert
  , GenesisDelegTxCert ::
    AlonzoEra
  #-}

{-# COMPLETE
  RegPoolTxCert
  , RetirePoolTxCert
  , RegTxCert
  , UnRegTxCert
  , DelegStakeTxCert
  , MirTxCert
  , GenesisDelegTxCert ::
    BabbageEra
  #-}

-- | Genesis key delegation certificate
data GenesisDelegCert
  = GenesisDelegCert
      !(KeyHash GenesisRole)
      !(KeyHash GenesisDelegate)
      !(VRFVerKeyHash GenDelegVRF)
  deriving (Int -> GenesisDelegCert -> ShowS
[GenesisDelegCert] -> ShowS
GenesisDelegCert -> [Char]
(Int -> GenesisDelegCert -> ShowS)
-> (GenesisDelegCert -> [Char])
-> ([GenesisDelegCert] -> ShowS)
-> Show GenesisDelegCert
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenesisDelegCert -> ShowS
showsPrec :: Int -> GenesisDelegCert -> ShowS
$cshow :: GenesisDelegCert -> [Char]
show :: GenesisDelegCert -> [Char]
$cshowList :: [GenesisDelegCert] -> ShowS
showList :: [GenesisDelegCert] -> ShowS
Show, (forall x. GenesisDelegCert -> Rep GenesisDelegCert x)
-> (forall x. Rep GenesisDelegCert x -> GenesisDelegCert)
-> Generic GenesisDelegCert
forall x. Rep GenesisDelegCert x -> GenesisDelegCert
forall x. GenesisDelegCert -> Rep GenesisDelegCert x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GenesisDelegCert -> Rep GenesisDelegCert x
from :: forall x. GenesisDelegCert -> Rep GenesisDelegCert x
$cto :: forall x. Rep GenesisDelegCert x -> GenesisDelegCert
to :: forall x. Rep GenesisDelegCert x -> GenesisDelegCert
Generic, GenesisDelegCert -> GenesisDelegCert -> Bool
(GenesisDelegCert -> GenesisDelegCert -> Bool)
-> (GenesisDelegCert -> GenesisDelegCert -> Bool)
-> Eq GenesisDelegCert
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenesisDelegCert -> GenesisDelegCert -> Bool
== :: GenesisDelegCert -> GenesisDelegCert -> Bool
$c/= :: GenesisDelegCert -> GenesisDelegCert -> Bool
/= :: GenesisDelegCert -> GenesisDelegCert -> Bool
Eq, Eq GenesisDelegCert
Eq GenesisDelegCert =>
(GenesisDelegCert -> GenesisDelegCert -> Ordering)
-> (GenesisDelegCert -> GenesisDelegCert -> Bool)
-> (GenesisDelegCert -> GenesisDelegCert -> Bool)
-> (GenesisDelegCert -> GenesisDelegCert -> Bool)
-> (GenesisDelegCert -> GenesisDelegCert -> Bool)
-> (GenesisDelegCert -> GenesisDelegCert -> GenesisDelegCert)
-> (GenesisDelegCert -> GenesisDelegCert -> GenesisDelegCert)
-> Ord GenesisDelegCert
GenesisDelegCert -> GenesisDelegCert -> Bool
GenesisDelegCert -> GenesisDelegCert -> Ordering
GenesisDelegCert -> GenesisDelegCert -> GenesisDelegCert
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 :: GenesisDelegCert -> GenesisDelegCert -> Ordering
compare :: GenesisDelegCert -> GenesisDelegCert -> Ordering
$c< :: GenesisDelegCert -> GenesisDelegCert -> Bool
< :: GenesisDelegCert -> GenesisDelegCert -> Bool
$c<= :: GenesisDelegCert -> GenesisDelegCert -> Bool
<= :: GenesisDelegCert -> GenesisDelegCert -> Bool
$c> :: GenesisDelegCert -> GenesisDelegCert -> Bool
> :: GenesisDelegCert -> GenesisDelegCert -> Bool
$c>= :: GenesisDelegCert -> GenesisDelegCert -> Bool
>= :: GenesisDelegCert -> GenesisDelegCert -> Bool
$cmax :: GenesisDelegCert -> GenesisDelegCert -> GenesisDelegCert
max :: GenesisDelegCert -> GenesisDelegCert -> GenesisDelegCert
$cmin :: GenesisDelegCert -> GenesisDelegCert -> GenesisDelegCert
min :: GenesisDelegCert -> GenesisDelegCert -> GenesisDelegCert
Ord)

instance NoThunks GenesisDelegCert

instance NFData GenesisDelegCert where
  rnf :: GenesisDelegCert -> ()
rnf = GenesisDelegCert -> ()
forall a. a -> ()
rwhnf

instance ToJSON GenesisDelegCert where
  toJSON :: GenesisDelegCert -> Value
toJSON (GenesisDelegCert KeyHash GenesisRole
genKeyHash KeyHash GenesisDelegate
genDelegKeyHash VRFVerKeyHash GenDelegVRF
hashVrf) =
    Text -> [Pair] -> Value
kindObject Text
"GenesisDelegCert" ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
      [ Key
"genKeyHash" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= KeyHash GenesisRole -> Value
forall a. ToJSON a => a -> Value
toJSON KeyHash GenesisRole
genKeyHash
      , Key
"genDelegKeyHash" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= KeyHash GenesisDelegate -> Value
forall a. ToJSON a => a -> Value
toJSON KeyHash GenesisDelegate
genDelegKeyHash
      , Key
"hashVrf" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= VRFVerKeyHash GenDelegVRF -> Value
forall a. ToJSON a => a -> Value
toJSON VRFVerKeyHash GenDelegVRF
hashVrf
      ]

genesisKeyHashWitness :: GenesisDelegCert -> KeyHash Witness
genesisKeyHashWitness :: GenesisDelegCert -> KeyHash Witness
genesisKeyHashWitness (GenesisDelegCert KeyHash GenesisRole
gk KeyHash GenesisDelegate
_ VRFVerKeyHash GenDelegVRF
_) = KeyHash GenesisRole -> KeyHash Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a Witness
asWitness KeyHash GenesisRole
gk

genesisCWitness :: GenesisDelegCert -> KeyHash GenesisRole
genesisCWitness :: GenesisDelegCert -> KeyHash GenesisRole
genesisCWitness (GenesisDelegCert KeyHash GenesisRole
gk KeyHash GenesisDelegate
_ VRFVerKeyHash GenDelegVRF
_) = KeyHash GenesisRole
gk

data MIRPot = ReservesMIR | TreasuryMIR
  deriving (Int -> MIRPot -> ShowS
[MIRPot] -> ShowS
MIRPot -> [Char]
(Int -> MIRPot -> ShowS)
-> (MIRPot -> [Char]) -> ([MIRPot] -> ShowS) -> Show MIRPot
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MIRPot -> ShowS
showsPrec :: Int -> MIRPot -> ShowS
$cshow :: MIRPot -> [Char]
show :: MIRPot -> [Char]
$cshowList :: [MIRPot] -> ShowS
showList :: [MIRPot] -> ShowS
Show, (forall x. MIRPot -> Rep MIRPot x)
-> (forall x. Rep MIRPot x -> MIRPot) -> Generic MIRPot
forall x. Rep MIRPot x -> MIRPot
forall x. MIRPot -> Rep MIRPot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MIRPot -> Rep MIRPot x
from :: forall x. MIRPot -> Rep MIRPot x
$cto :: forall x. Rep MIRPot x -> MIRPot
to :: forall x. Rep MIRPot x -> MIRPot
Generic, MIRPot -> MIRPot -> Bool
(MIRPot -> MIRPot -> Bool)
-> (MIRPot -> MIRPot -> Bool) -> Eq MIRPot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MIRPot -> MIRPot -> Bool
== :: MIRPot -> MIRPot -> Bool
$c/= :: MIRPot -> MIRPot -> Bool
/= :: MIRPot -> MIRPot -> Bool
Eq, MIRPot -> ()
(MIRPot -> ()) -> NFData MIRPot
forall a. (a -> ()) -> NFData a
$crnf :: MIRPot -> ()
rnf :: MIRPot -> ()
NFData, Eq MIRPot
Eq MIRPot =>
(MIRPot -> MIRPot -> Ordering)
-> (MIRPot -> MIRPot -> Bool)
-> (MIRPot -> MIRPot -> Bool)
-> (MIRPot -> MIRPot -> Bool)
-> (MIRPot -> MIRPot -> Bool)
-> (MIRPot -> MIRPot -> MIRPot)
-> (MIRPot -> MIRPot -> MIRPot)
-> Ord MIRPot
MIRPot -> MIRPot -> Bool
MIRPot -> MIRPot -> Ordering
MIRPot -> MIRPot -> MIRPot
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 :: MIRPot -> MIRPot -> Ordering
compare :: MIRPot -> MIRPot -> Ordering
$c< :: MIRPot -> MIRPot -> Bool
< :: MIRPot -> MIRPot -> Bool
$c<= :: MIRPot -> MIRPot -> Bool
<= :: MIRPot -> MIRPot -> Bool
$c> :: MIRPot -> MIRPot -> Bool
> :: MIRPot -> MIRPot -> Bool
$c>= :: MIRPot -> MIRPot -> Bool
>= :: MIRPot -> MIRPot -> Bool
$cmax :: MIRPot -> MIRPot -> MIRPot
max :: MIRPot -> MIRPot -> MIRPot
$cmin :: MIRPot -> MIRPot -> MIRPot
min :: MIRPot -> MIRPot -> MIRPot
Ord, Int -> MIRPot
MIRPot -> Int
MIRPot -> [MIRPot]
MIRPot -> MIRPot
MIRPot -> MIRPot -> [MIRPot]
MIRPot -> MIRPot -> MIRPot -> [MIRPot]
(MIRPot -> MIRPot)
-> (MIRPot -> MIRPot)
-> (Int -> MIRPot)
-> (MIRPot -> Int)
-> (MIRPot -> [MIRPot])
-> (MIRPot -> MIRPot -> [MIRPot])
-> (MIRPot -> MIRPot -> [MIRPot])
-> (MIRPot -> MIRPot -> MIRPot -> [MIRPot])
-> Enum MIRPot
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: MIRPot -> MIRPot
succ :: MIRPot -> MIRPot
$cpred :: MIRPot -> MIRPot
pred :: MIRPot -> MIRPot
$ctoEnum :: Int -> MIRPot
toEnum :: Int -> MIRPot
$cfromEnum :: MIRPot -> Int
fromEnum :: MIRPot -> Int
$cenumFrom :: MIRPot -> [MIRPot]
enumFrom :: MIRPot -> [MIRPot]
$cenumFromThen :: MIRPot -> MIRPot -> [MIRPot]
enumFromThen :: MIRPot -> MIRPot -> [MIRPot]
$cenumFromTo :: MIRPot -> MIRPot -> [MIRPot]
enumFromTo :: MIRPot -> MIRPot -> [MIRPot]
$cenumFromThenTo :: MIRPot -> MIRPot -> MIRPot -> [MIRPot]
enumFromThenTo :: MIRPot -> MIRPot -> MIRPot -> [MIRPot]
Enum, MIRPot
MIRPot -> MIRPot -> Bounded MIRPot
forall a. a -> a -> Bounded a
$cminBound :: MIRPot
minBound :: MIRPot
$cmaxBound :: MIRPot
maxBound :: MIRPot
Bounded)

deriving instance NoThunks MIRPot

instance EncCBOR MIRPot where
  encCBOR :: MIRPot -> Encoding
encCBOR MIRPot
ReservesMIR = Word8 -> Encoding
encodeWord8 Word8
0
  encCBOR MIRPot
TreasuryMIR = Word8 -> Encoding
encodeWord8 Word8
1

instance DecCBOR MIRPot where
  decCBOR :: forall s. Decoder s MIRPot
decCBOR =
    Decoder s Word
forall s. Decoder s Word
decodeWord Decoder s Word -> (Word -> Decoder s MIRPot) -> Decoder s MIRPot
forall a b. Decoder s a -> (a -> Decoder s b) -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Word
0 -> MIRPot -> Decoder s MIRPot
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MIRPot
ReservesMIR
      Word
1 -> MIRPot -> Decoder s MIRPot
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MIRPot
TreasuryMIR
      Word
k -> Word -> Decoder s MIRPot
forall a (m :: * -> *). (Typeable a, MonadFail m) => Word -> m a
invalidKey Word
k

instance ToJSON MIRPot where
  toJSON :: MIRPot -> Value
toJSON = \case
    MIRPot
ReservesMIR -> Value
"reserves"
    MIRPot
TreasuryMIR -> Value
"treasury"

-- | MIRTarget specifies if funds from either the reserves
-- or the treasury are to be handed out to a collection of
-- reward accounts or instead transfered to the opposite pot.
data MIRTarget
  = StakeAddressesMIR !(Map (Credential Staking) DeltaCoin)
  | SendToOppositePotMIR !Coin
  deriving (Int -> MIRTarget -> ShowS
[MIRTarget] -> ShowS
MIRTarget -> [Char]
(Int -> MIRTarget -> ShowS)
-> (MIRTarget -> [Char])
-> ([MIRTarget] -> ShowS)
-> Show MIRTarget
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MIRTarget -> ShowS
showsPrec :: Int -> MIRTarget -> ShowS
$cshow :: MIRTarget -> [Char]
show :: MIRTarget -> [Char]
$cshowList :: [MIRTarget] -> ShowS
showList :: [MIRTarget] -> ShowS
Show, (forall x. MIRTarget -> Rep MIRTarget x)
-> (forall x. Rep MIRTarget x -> MIRTarget) -> Generic MIRTarget
forall x. Rep MIRTarget x -> MIRTarget
forall x. MIRTarget -> Rep MIRTarget x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MIRTarget -> Rep MIRTarget x
from :: forall x. MIRTarget -> Rep MIRTarget x
$cto :: forall x. Rep MIRTarget x -> MIRTarget
to :: forall x. Rep MIRTarget x -> MIRTarget
Generic, MIRTarget -> MIRTarget -> Bool
(MIRTarget -> MIRTarget -> Bool)
-> (MIRTarget -> MIRTarget -> Bool) -> Eq MIRTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MIRTarget -> MIRTarget -> Bool
== :: MIRTarget -> MIRTarget -> Bool
$c/= :: MIRTarget -> MIRTarget -> Bool
/= :: MIRTarget -> MIRTarget -> Bool
Eq, Eq MIRTarget
Eq MIRTarget =>
(MIRTarget -> MIRTarget -> Ordering)
-> (MIRTarget -> MIRTarget -> Bool)
-> (MIRTarget -> MIRTarget -> Bool)
-> (MIRTarget -> MIRTarget -> Bool)
-> (MIRTarget -> MIRTarget -> Bool)
-> (MIRTarget -> MIRTarget -> MIRTarget)
-> (MIRTarget -> MIRTarget -> MIRTarget)
-> Ord MIRTarget
MIRTarget -> MIRTarget -> Bool
MIRTarget -> MIRTarget -> Ordering
MIRTarget -> MIRTarget -> MIRTarget
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 :: MIRTarget -> MIRTarget -> Ordering
compare :: MIRTarget -> MIRTarget -> Ordering
$c< :: MIRTarget -> MIRTarget -> Bool
< :: MIRTarget -> MIRTarget -> Bool
$c<= :: MIRTarget -> MIRTarget -> Bool
<= :: MIRTarget -> MIRTarget -> Bool
$c> :: MIRTarget -> MIRTarget -> Bool
> :: MIRTarget -> MIRTarget -> Bool
$c>= :: MIRTarget -> MIRTarget -> Bool
>= :: MIRTarget -> MIRTarget -> Bool
$cmax :: MIRTarget -> MIRTarget -> MIRTarget
max :: MIRTarget -> MIRTarget -> MIRTarget
$cmin :: MIRTarget -> MIRTarget -> MIRTarget
min :: MIRTarget -> MIRTarget -> MIRTarget
Ord, MIRTarget -> ()
(MIRTarget -> ()) -> NFData MIRTarget
forall a. (a -> ()) -> NFData a
$crnf :: MIRTarget -> ()
rnf :: MIRTarget -> ()
NFData)

deriving instance NoThunks MIRTarget

instance DecCBOR MIRTarget where
  decCBOR :: forall s. Decoder s MIRTarget
decCBOR = do
    Decoder s TokenType
forall s. Decoder s TokenType
peekTokenType Decoder s TokenType
-> (TokenType -> Decoder s MIRTarget) -> Decoder s MIRTarget
forall a b. Decoder s a -> (a -> Decoder s b) -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      TokenType
TypeMapLen -> Map (Credential Staking) DeltaCoin -> MIRTarget
StakeAddressesMIR (Map (Credential Staking) DeltaCoin -> MIRTarget)
-> Decoder s (Map (Credential Staking) DeltaCoin)
-> Decoder s MIRTarget
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Map (Credential Staking) DeltaCoin)
forall s. Decoder s (Map (Credential Staking) DeltaCoin)
forall a s. DecCBOR a => Decoder s a
decCBOR
      TokenType
TypeMapLen64 -> Map (Credential Staking) DeltaCoin -> MIRTarget
StakeAddressesMIR (Map (Credential Staking) DeltaCoin -> MIRTarget)
-> Decoder s (Map (Credential Staking) DeltaCoin)
-> Decoder s MIRTarget
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Map (Credential Staking) DeltaCoin)
forall s. Decoder s (Map (Credential Staking) DeltaCoin)
forall a s. DecCBOR a => Decoder s a
decCBOR
      TokenType
TypeMapLenIndef -> Map (Credential Staking) DeltaCoin -> MIRTarget
StakeAddressesMIR (Map (Credential Staking) DeltaCoin -> MIRTarget)
-> Decoder s (Map (Credential Staking) DeltaCoin)
-> Decoder s MIRTarget
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Map (Credential Staking) DeltaCoin)
forall s. Decoder s (Map (Credential Staking) DeltaCoin)
forall a s. DecCBOR a => Decoder s a
decCBOR
      TokenType
_ -> Coin -> MIRTarget
SendToOppositePotMIR (Coin -> MIRTarget) -> Decoder s Coin -> Decoder s MIRTarget
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Coin
forall s. Decoder s Coin
forall a s. DecCBOR a => Decoder s a
decCBOR

instance EncCBOR MIRTarget where
  encCBOR :: MIRTarget -> Encoding
encCBOR = \case
    StakeAddressesMIR Map (Credential Staking) DeltaCoin
m -> Map (Credential Staking) DeltaCoin -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Map (Credential Staking) DeltaCoin
m
    SendToOppositePotMIR Coin
c -> Coin -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Coin
c

instance ToJSON MIRTarget where
  toJSON :: MIRTarget -> Value
toJSON = \case
    StakeAddressesMIR Map (Credential Staking) DeltaCoin
mirAddresses ->
      Text -> [Pair] -> Value
kindObject Text
"StakeAddressesMIR" [Key
"addresses" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map (Credential Staking) DeltaCoin -> Value
forall a. ToJSON a => a -> Value
toJSON Map (Credential Staking) DeltaCoin
mirAddresses]
    SendToOppositePotMIR Coin
c ->
      Text -> [Pair] -> Value
kindObject Text
"SendToOppositePotMIR" [Key
"coin" 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
c]

-- | Move instantaneous rewards certificate
data MIRCert = MIRCert
  { MIRCert -> MIRPot
mirPot :: !MIRPot
  , MIRCert -> MIRTarget
mirRewards :: !MIRTarget
  }
  deriving (Int -> MIRCert -> ShowS
[MIRCert] -> ShowS
MIRCert -> [Char]
(Int -> MIRCert -> ShowS)
-> (MIRCert -> [Char]) -> ([MIRCert] -> ShowS) -> Show MIRCert
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MIRCert -> ShowS
showsPrec :: Int -> MIRCert -> ShowS
$cshow :: MIRCert -> [Char]
show :: MIRCert -> [Char]
$cshowList :: [MIRCert] -> ShowS
showList :: [MIRCert] -> ShowS
Show, (forall x. MIRCert -> Rep MIRCert x)
-> (forall x. Rep MIRCert x -> MIRCert) -> Generic MIRCert
forall x. Rep MIRCert x -> MIRCert
forall x. MIRCert -> Rep MIRCert x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MIRCert -> Rep MIRCert x
from :: forall x. MIRCert -> Rep MIRCert x
$cto :: forall x. Rep MIRCert x -> MIRCert
to :: forall x. Rep MIRCert x -> MIRCert
Generic, MIRCert -> MIRCert -> Bool
(MIRCert -> MIRCert -> Bool)
-> (MIRCert -> MIRCert -> Bool) -> Eq MIRCert
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MIRCert -> MIRCert -> Bool
== :: MIRCert -> MIRCert -> Bool
$c/= :: MIRCert -> MIRCert -> Bool
/= :: MIRCert -> MIRCert -> Bool
Eq, Eq MIRCert
Eq MIRCert =>
(MIRCert -> MIRCert -> Ordering)
-> (MIRCert -> MIRCert -> Bool)
-> (MIRCert -> MIRCert -> Bool)
-> (MIRCert -> MIRCert -> Bool)
-> (MIRCert -> MIRCert -> Bool)
-> (MIRCert -> MIRCert -> MIRCert)
-> (MIRCert -> MIRCert -> MIRCert)
-> Ord MIRCert
MIRCert -> MIRCert -> Bool
MIRCert -> MIRCert -> Ordering
MIRCert -> MIRCert -> MIRCert
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 :: MIRCert -> MIRCert -> Ordering
compare :: MIRCert -> MIRCert -> Ordering
$c< :: MIRCert -> MIRCert -> Bool
< :: MIRCert -> MIRCert -> Bool
$c<= :: MIRCert -> MIRCert -> Bool
<= :: MIRCert -> MIRCert -> Bool
$c> :: MIRCert -> MIRCert -> Bool
> :: MIRCert -> MIRCert -> Bool
$c>= :: MIRCert -> MIRCert -> Bool
>= :: MIRCert -> MIRCert -> Bool
$cmax :: MIRCert -> MIRCert -> MIRCert
max :: MIRCert -> MIRCert -> MIRCert
$cmin :: MIRCert -> MIRCert -> MIRCert
min :: MIRCert -> MIRCert -> MIRCert
Ord, MIRCert -> ()
(MIRCert -> ()) -> NFData MIRCert
forall a. (a -> ()) -> NFData a
$crnf :: MIRCert -> ()
rnf :: MIRCert -> ()
NFData)

instance NoThunks MIRCert

instance DecCBOR MIRCert where
  decCBOR :: forall s. Decoder s MIRCert
decCBOR =
    Text -> (MIRCert -> Int) -> Decoder s MIRCert -> Decoder s MIRCert
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"MIRCert" (Int -> MIRCert -> Int
forall a b. a -> b -> a
const Int
2) (MIRPot -> MIRTarget -> MIRCert
MIRCert (MIRPot -> MIRTarget -> MIRCert)
-> Decoder s MIRPot -> Decoder s (MIRTarget -> MIRCert)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s MIRPot
forall s. Decoder s MIRPot
forall a s. DecCBOR a => Decoder s a
decCBOR Decoder s (MIRTarget -> MIRCert)
-> Decoder s MIRTarget -> Decoder s MIRCert
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 MIRTarget
forall s. Decoder s MIRTarget
forall a s. DecCBOR a => Decoder s a
decCBOR)

instance EncCBOR MIRCert where
  encCBOR :: MIRCert -> Encoding
encCBOR (MIRCert MIRPot
pot MIRTarget
targets) =
    Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> MIRPot -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR MIRPot
pot Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> MIRTarget -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR MIRTarget
targets

instance ToJSON MIRCert where
  toJSON :: MIRCert -> Value
toJSON MIRCert {MIRPot
mirPot :: MIRCert -> MIRPot
mirPot :: MIRPot
mirPot, MIRTarget
mirRewards :: MIRCert -> MIRTarget
mirRewards :: MIRTarget
mirRewards} =
    Text -> [Pair] -> Value
kindObject Text
"MIRCert" ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
      [ Key
"pot" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MIRPot -> Value
forall a. ToJSON a => a -> Value
toJSON MIRPot
mirPot
      , Key
"rewards" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MIRTarget -> Value
forall a. ToJSON a => a -> Value
toJSON MIRTarget
mirRewards
      ]

-- | A heavyweight certificate.
data ShelleyTxCert era
  = ShelleyTxCertDelegCert !ShelleyDelegCert
  | ShelleyTxCertPool !PoolCert
  | ShelleyTxCertGenesisDeleg !GenesisDelegCert
  | ShelleyTxCertMir !MIRCert
  deriving (Int -> ShelleyTxCert era -> ShowS
[ShelleyTxCert era] -> ShowS
ShelleyTxCert era -> [Char]
(Int -> ShelleyTxCert era -> ShowS)
-> (ShelleyTxCert era -> [Char])
-> ([ShelleyTxCert era] -> ShowS)
-> Show (ShelleyTxCert era)
forall era. Int -> ShelleyTxCert era -> ShowS
forall era. [ShelleyTxCert era] -> ShowS
forall era. ShelleyTxCert era -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era. Int -> ShelleyTxCert era -> ShowS
showsPrec :: Int -> ShelleyTxCert era -> ShowS
$cshow :: forall era. ShelleyTxCert era -> [Char]
show :: ShelleyTxCert era -> [Char]
$cshowList :: forall era. [ShelleyTxCert era] -> ShowS
showList :: [ShelleyTxCert era] -> ShowS
Show, (forall x. ShelleyTxCert era -> Rep (ShelleyTxCert era) x)
-> (forall x. Rep (ShelleyTxCert era) x -> ShelleyTxCert era)
-> Generic (ShelleyTxCert era)
forall x. Rep (ShelleyTxCert era) x -> ShelleyTxCert era
forall x. ShelleyTxCert era -> Rep (ShelleyTxCert era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (ShelleyTxCert era) x -> ShelleyTxCert era
forall era x. ShelleyTxCert era -> Rep (ShelleyTxCert era) x
$cfrom :: forall era x. ShelleyTxCert era -> Rep (ShelleyTxCert era) x
from :: forall x. ShelleyTxCert era -> Rep (ShelleyTxCert era) x
$cto :: forall era x. Rep (ShelleyTxCert era) x -> ShelleyTxCert era
to :: forall x. Rep (ShelleyTxCert era) x -> ShelleyTxCert era
Generic, ShelleyTxCert era -> ShelleyTxCert era -> Bool
(ShelleyTxCert era -> ShelleyTxCert era -> Bool)
-> (ShelleyTxCert era -> ShelleyTxCert era -> Bool)
-> Eq (ShelleyTxCert era)
forall era. ShelleyTxCert era -> ShelleyTxCert era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall era. ShelleyTxCert era -> ShelleyTxCert era -> Bool
== :: ShelleyTxCert era -> ShelleyTxCert era -> Bool
$c/= :: forall era. ShelleyTxCert era -> ShelleyTxCert era -> Bool
/= :: ShelleyTxCert era -> ShelleyTxCert era -> Bool
Eq, Eq (ShelleyTxCert era)
Eq (ShelleyTxCert era) =>
(ShelleyTxCert era -> ShelleyTxCert era -> Ordering)
-> (ShelleyTxCert era -> ShelleyTxCert era -> Bool)
-> (ShelleyTxCert era -> ShelleyTxCert era -> Bool)
-> (ShelleyTxCert era -> ShelleyTxCert era -> Bool)
-> (ShelleyTxCert era -> ShelleyTxCert era -> Bool)
-> (ShelleyTxCert era -> ShelleyTxCert era -> ShelleyTxCert era)
-> (ShelleyTxCert era -> ShelleyTxCert era -> ShelleyTxCert era)
-> Ord (ShelleyTxCert era)
ShelleyTxCert era -> ShelleyTxCert era -> Bool
ShelleyTxCert era -> ShelleyTxCert era -> Ordering
ShelleyTxCert era -> ShelleyTxCert era -> ShelleyTxCert era
forall era. Eq (ShelleyTxCert 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. ShelleyTxCert era -> ShelleyTxCert era -> Bool
forall era. ShelleyTxCert era -> ShelleyTxCert era -> Ordering
forall era.
ShelleyTxCert era -> ShelleyTxCert era -> ShelleyTxCert era
$ccompare :: forall era. ShelleyTxCert era -> ShelleyTxCert era -> Ordering
compare :: ShelleyTxCert era -> ShelleyTxCert era -> Ordering
$c< :: forall era. ShelleyTxCert era -> ShelleyTxCert era -> Bool
< :: ShelleyTxCert era -> ShelleyTxCert era -> Bool
$c<= :: forall era. ShelleyTxCert era -> ShelleyTxCert era -> Bool
<= :: ShelleyTxCert era -> ShelleyTxCert era -> Bool
$c> :: forall era. ShelleyTxCert era -> ShelleyTxCert era -> Bool
> :: ShelleyTxCert era -> ShelleyTxCert era -> Bool
$c>= :: forall era. ShelleyTxCert era -> ShelleyTxCert era -> Bool
>= :: ShelleyTxCert era -> ShelleyTxCert era -> Bool
$cmax :: forall era.
ShelleyTxCert era -> ShelleyTxCert era -> ShelleyTxCert era
max :: ShelleyTxCert era -> ShelleyTxCert era -> ShelleyTxCert era
$cmin :: forall era.
ShelleyTxCert era -> ShelleyTxCert era -> ShelleyTxCert era
min :: ShelleyTxCert era -> ShelleyTxCert era -> ShelleyTxCert era
Ord, ShelleyTxCert era -> ()
(ShelleyTxCert era -> ()) -> NFData (ShelleyTxCert era)
forall era. ShelleyTxCert era -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall era. ShelleyTxCert era -> ()
rnf :: ShelleyTxCert era -> ()
NFData)

instance NoThunks (ShelleyTxCert era)

instance Era era => ToJSON (ShelleyTxCert era) where
  toJSON :: ShelleyTxCert era -> Value
toJSON = \case
    ShelleyTxCertDelegCert ShelleyDelegCert
delegCert -> ShelleyDelegCert -> Value
forall a. ToJSON a => a -> Value
toJSON ShelleyDelegCert
delegCert
    ShelleyTxCertPool PoolCert
poolCert -> PoolCert -> Value
forall a. ToJSON a => a -> Value
toJSON PoolCert
poolCert
    ShelleyTxCertGenesisDeleg GenesisDelegCert
genDelegCert -> GenesisDelegCert -> Value
forall a. ToJSON a => a -> Value
toJSON GenesisDelegCert
genDelegCert
    ShelleyTxCertMir MIRCert
mirCert -> MIRCert -> Value
forall a. ToJSON a => a -> Value
toJSON MIRCert
mirCert

upgradeShelleyTxCert ::
  ShelleyTxCert era1 ->
  ShelleyTxCert era2
upgradeShelleyTxCert :: forall era1 era2. ShelleyTxCert era1 -> ShelleyTxCert era2
upgradeShelleyTxCert = \case
  ShelleyTxCertDelegCert ShelleyDelegCert
cert -> ShelleyDelegCert -> ShelleyTxCert era2
forall era. ShelleyDelegCert -> ShelleyTxCert era
ShelleyTxCertDelegCert ShelleyDelegCert
cert
  ShelleyTxCertPool PoolCert
cert -> PoolCert -> ShelleyTxCert era2
forall era. PoolCert -> ShelleyTxCert era
ShelleyTxCertPool PoolCert
cert
  ShelleyTxCertGenesisDeleg GenesisDelegCert
cert -> GenesisDelegCert -> ShelleyTxCert era2
forall era. GenesisDelegCert -> ShelleyTxCert era
ShelleyTxCertGenesisDeleg GenesisDelegCert
cert
  ShelleyTxCertMir MIRCert
cert -> MIRCert -> ShelleyTxCert era2
forall era. MIRCert -> ShelleyTxCert era
ShelleyTxCertMir MIRCert
cert

-- CBOR

instance Era era => EncCBOR (ShelleyTxCert era) where
  encCBOR :: ShelleyTxCert era -> Encoding
encCBOR = \case
    ShelleyTxCertDelegCert ShelleyDelegCert
delegCert -> ShelleyDelegCert -> Encoding
encodeShelleyDelegCert ShelleyDelegCert
delegCert
    ShelleyTxCertPool PoolCert
poolCert -> PoolCert -> Encoding
encodePoolCert PoolCert
poolCert
    ShelleyTxCertGenesisDeleg GenesisDelegCert
constCert -> GenesisDelegCert -> Encoding
encodeGenesisDelegCert GenesisDelegCert
constCert
    ShelleyTxCertMir MIRCert
mir ->
      Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
encodeWord8 Word8
6 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> MIRCert -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR MIRCert
mir

encodeShelleyDelegCert :: ShelleyDelegCert -> Encoding
encodeShelleyDelegCert :: ShelleyDelegCert -> Encoding
encodeShelleyDelegCert = \case
  ShelleyRegCert Credential Staking
cred ->
    Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
encodeWord8 Word8
0 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Credential Staking -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Credential Staking
cred
  ShelleyUnRegCert Credential Staking
cred ->
    Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
encodeWord8 Word8
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Credential Staking -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Credential Staking
cred
  ShelleyDelegCert Credential Staking
cred KeyHash StakePool
poolId ->
    Word -> Encoding
encodeListLen Word
3 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
encodeWord8 Word8
2 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

encodePoolCert :: PoolCert -> Encoding
encodePoolCert :: PoolCert -> Encoding
encodePoolCert = \case
  RegPool StakePoolParams
poolParams ->
    Word -> Encoding
encodeListLen (Word
1 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ StakePoolParams -> Word
forall a. EncCBORGroup a => a -> Word
listLen StakePoolParams
poolParams)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
encodeWord8 Word8
3
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> StakePoolParams -> Encoding
forall a. EncCBORGroup a => a -> Encoding
encCBORGroup StakePoolParams
poolParams
  RetirePool KeyHash StakePool
vk EpochNo
epoch ->
    Word -> Encoding
encodeListLen Word
3
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
encodeWord8 Word8
4
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> KeyHash StakePool -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR KeyHash StakePool
vk
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> EpochNo -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR EpochNo
epoch

encodeGenesisDelegCert :: GenesisDelegCert -> Encoding
encodeGenesisDelegCert :: GenesisDelegCert -> Encoding
encodeGenesisDelegCert (GenesisDelegCert KeyHash GenesisRole
gk KeyHash GenesisDelegate
kh VRFVerKeyHash GenDelegVRF
vrf) =
  Word -> Encoding
encodeListLen Word
4
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
encodeWord8 Word8
5
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> KeyHash GenesisRole -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR KeyHash GenesisRole
gk
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> KeyHash GenesisDelegate -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR KeyHash GenesisDelegate
kh
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> VRFVerKeyHash GenDelegVRF -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR VRFVerKeyHash GenDelegVRF
vrf

instance Era era => ToCBOR (ShelleyTxCert era) where
  toCBOR :: ShelleyTxCert era -> Encoding
toCBOR = forall era t. (Era era, EncCBOR t) => t -> Encoding
toEraCBOR @era

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

instance
  ( ShelleyEraTxCert era
  , TxCert era ~ ShelleyTxCert era
  ) =>
  DecCBOR (ShelleyTxCert era)
  where
  decCBOR :: forall s. Decoder s (ShelleyTxCert era)
decCBOR = Text
-> (Word -> Decoder s (Int, ShelleyTxCert era))
-> Decoder s (ShelleyTxCert era)
forall s a. Text -> (Word -> Decoder s (Int, a)) -> Decoder s a
decodeRecordSum Text
"ShelleyTxCert" ((Word -> Decoder s (Int, ShelleyTxCert era))
 -> Decoder s (ShelleyTxCert era))
-> (Word -> Decoder s (Int, ShelleyTxCert era))
-> Decoder s (ShelleyTxCert 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
5 -> do
      gen <- Decoder s (KeyHash GenesisRole)
forall s. Decoder s (KeyHash GenesisRole)
forall a s. DecCBOR a => Decoder s a
decCBOR
      genDeleg <- decCBOR
      vrf <- decCBOR
      pure (4, ShelleyTxCertGenesisDeleg $ GenesisDelegCert gen genDeleg vrf)
    Word
6 -> do
      x <- Decoder s MIRCert
forall s. Decoder s MIRCert
forall a s. DecCBOR a => Decoder s a
decCBOR
      pure (2, ShelleyTxCertMir x)
    Word
x -> Word -> Decoder s (Int, ShelleyTxCert era)
forall a (m :: * -> *). (Typeable a, MonadFail m) => Word -> m a
invalidKey Word
x
  {-# INLINE decCBOR #-}

shelleyTxCertDelegDecoder ::
  ShelleyEraTxCert era =>
  Word ->
  Decoder s (Int, TxCert era)
shelleyTxCertDelegDecoder :: forall era s.
ShelleyEraTxCert era =>
Word -> Decoder s (Int, TxCert era)
shelleyTxCertDelegDecoder = \case
  Word
0 -> do
    cred <- Decoder s (Credential Staking)
forall s. Decoder s (Credential Staking)
forall a s. DecCBOR a => Decoder s a
decCBOR
    pure (2, RegTxCert cred)
  Word
1 -> do
    cred <- Decoder s (Credential Staking)
forall s. Decoder s (Credential Staking)
forall a s. DecCBOR a => Decoder s a
decCBOR
    pure (2, UnRegTxCert cred)
  Word
2 -> do
    cred <- Decoder s (Credential Staking)
forall s. Decoder s (Credential Staking)
forall a s. DecCBOR a => Decoder s a
decCBOR
    stakePool <- decCBOR
    pure (3, DelegStakeTxCert cred stakePool)
  Word
k -> Word -> Decoder s (Int, TxCert era)
forall a (m :: * -> *). (Typeable a, MonadFail m) => Word -> m a
invalidKey Word
k
{-# INLINE shelleyTxCertDelegDecoder #-}

poolTxCertDecoder :: EraTxCert era => Word -> Decoder s (Int, TxCert era)
poolTxCertDecoder :: forall era s. EraTxCert era => Word -> Decoder s (Int, TxCert era)
poolTxCertDecoder = \case
  Word
3 -> do
    group <- Decoder s StakePoolParams
forall s. Decoder s StakePoolParams
forall a s. DecCBORGroup a => Decoder s a
decCBORGroup
    pure (1 + listLenInt group, RegPoolTxCert group)
  Word
4 -> do
    a <- Decoder s (KeyHash StakePool)
forall s. Decoder s (KeyHash StakePool)
forall a s. DecCBOR a => Decoder s a
decCBOR
    b <- decCBOR
    pure (3, RetirePoolTxCert a b)
  Word
k -> Word -> Decoder s (Int, TxCert era)
forall a (m :: * -> *). (Typeable a, MonadFail m) => Word -> m a
invalidKey Word
k
{-# INLINE poolTxCertDecoder #-}

data ShelleyDelegCert
  = -- | A stake credential registration certificate.
    ShelleyRegCert !(Credential Staking)
  | -- | A stake credential deregistration certificate.
    ShelleyUnRegCert !(Credential Staking)
  | -- | A stake delegation certificate.
    ShelleyDelegCert !(Credential Staking) !(KeyHash StakePool)
  deriving (Int -> ShelleyDelegCert -> ShowS
[ShelleyDelegCert] -> ShowS
ShelleyDelegCert -> [Char]
(Int -> ShelleyDelegCert -> ShowS)
-> (ShelleyDelegCert -> [Char])
-> ([ShelleyDelegCert] -> ShowS)
-> Show ShelleyDelegCert
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShelleyDelegCert -> ShowS
showsPrec :: Int -> ShelleyDelegCert -> ShowS
$cshow :: ShelleyDelegCert -> [Char]
show :: ShelleyDelegCert -> [Char]
$cshowList :: [ShelleyDelegCert] -> ShowS
showList :: [ShelleyDelegCert] -> ShowS
Show, (forall x. ShelleyDelegCert -> Rep ShelleyDelegCert x)
-> (forall x. Rep ShelleyDelegCert x -> ShelleyDelegCert)
-> Generic ShelleyDelegCert
forall x. Rep ShelleyDelegCert x -> ShelleyDelegCert
forall x. ShelleyDelegCert -> Rep ShelleyDelegCert x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ShelleyDelegCert -> Rep ShelleyDelegCert x
from :: forall x. ShelleyDelegCert -> Rep ShelleyDelegCert x
$cto :: forall x. Rep ShelleyDelegCert x -> ShelleyDelegCert
to :: forall x. Rep ShelleyDelegCert x -> ShelleyDelegCert
Generic, ShelleyDelegCert -> ShelleyDelegCert -> Bool
(ShelleyDelegCert -> ShelleyDelegCert -> Bool)
-> (ShelleyDelegCert -> ShelleyDelegCert -> Bool)
-> Eq ShelleyDelegCert
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShelleyDelegCert -> ShelleyDelegCert -> Bool
== :: ShelleyDelegCert -> ShelleyDelegCert -> Bool
$c/= :: ShelleyDelegCert -> ShelleyDelegCert -> Bool
/= :: ShelleyDelegCert -> ShelleyDelegCert -> Bool
Eq, Eq ShelleyDelegCert
Eq ShelleyDelegCert =>
(ShelleyDelegCert -> ShelleyDelegCert -> Ordering)
-> (ShelleyDelegCert -> ShelleyDelegCert -> Bool)
-> (ShelleyDelegCert -> ShelleyDelegCert -> Bool)
-> (ShelleyDelegCert -> ShelleyDelegCert -> Bool)
-> (ShelleyDelegCert -> ShelleyDelegCert -> Bool)
-> (ShelleyDelegCert -> ShelleyDelegCert -> ShelleyDelegCert)
-> (ShelleyDelegCert -> ShelleyDelegCert -> ShelleyDelegCert)
-> Ord ShelleyDelegCert
ShelleyDelegCert -> ShelleyDelegCert -> Bool
ShelleyDelegCert -> ShelleyDelegCert -> Ordering
ShelleyDelegCert -> ShelleyDelegCert -> ShelleyDelegCert
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 :: ShelleyDelegCert -> ShelleyDelegCert -> Ordering
compare :: ShelleyDelegCert -> ShelleyDelegCert -> Ordering
$c< :: ShelleyDelegCert -> ShelleyDelegCert -> Bool
< :: ShelleyDelegCert -> ShelleyDelegCert -> Bool
$c<= :: ShelleyDelegCert -> ShelleyDelegCert -> Bool
<= :: ShelleyDelegCert -> ShelleyDelegCert -> Bool
$c> :: ShelleyDelegCert -> ShelleyDelegCert -> Bool
> :: ShelleyDelegCert -> ShelleyDelegCert -> Bool
$c>= :: ShelleyDelegCert -> ShelleyDelegCert -> Bool
>= :: ShelleyDelegCert -> ShelleyDelegCert -> Bool
$cmax :: ShelleyDelegCert -> ShelleyDelegCert -> ShelleyDelegCert
max :: ShelleyDelegCert -> ShelleyDelegCert -> ShelleyDelegCert
$cmin :: ShelleyDelegCert -> ShelleyDelegCert -> ShelleyDelegCert
min :: ShelleyDelegCert -> ShelleyDelegCert -> ShelleyDelegCert
Ord)

instance ToJSON ShelleyDelegCert where
  toJSON :: ShelleyDelegCert -> Value
toJSON = \case
    ShelleyRegCert Credential Staking
cred -> Text -> [Pair] -> Value
kindObject Text
"RegCert" [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]
    ShelleyUnRegCert Credential Staking
cred -> Text -> [Pair] -> Value
kindObject Text
"UnRegCert" [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]
    ShelleyDelegCert Credential Staking
cred KeyHash StakePool
poolId ->
      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
"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
        ]

instance NoThunks ShelleyDelegCert

instance NFData ShelleyDelegCert where
  rnf :: ShelleyDelegCert -> ()
rnf = ShelleyDelegCert -> ()
forall a. a -> ()
rwhnf

-- | Check for 'ShelleyDelegCert' constructor
isDelegation :: ShelleyEraTxCert era => TxCert era -> Bool
isDelegation :: forall era. ShelleyEraTxCert era => TxCert era -> Bool
isDelegation (DelegStakeTxCert Credential Staking
_ KeyHash StakePool
_) = Bool
True
isDelegation TxCert era
_ = Bool
False

-- | Check for GenesisDelegate' constructor
isGenesisDelegation :: (ShelleyEraTxCert era, AtMostEra "Babbage" era) => TxCert era -> Bool
isGenesisDelegation :: forall era.
(ShelleyEraTxCert era, AtMostEra "Babbage" era) =>
TxCert era -> Bool
isGenesisDelegation = Maybe GenesisDelegCert -> Bool
forall a. Maybe a -> Bool
isJust (Maybe GenesisDelegCert -> Bool)
-> (TxCert era -> Maybe GenesisDelegCert) -> TxCert era -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxCert era -> Maybe GenesisDelegCert
forall era.
(ShelleyEraTxCert era, AtMostEra "Babbage" era) =>
TxCert era -> Maybe GenesisDelegCert
getGenesisDelegTxCert

-- | Check for 'RegPool' constructor
isRegPool :: EraTxCert era => TxCert era -> Bool
isRegPool :: forall era. EraTxCert era => TxCert era -> Bool
isRegPool (RegPoolTxCert StakePoolParams
_) = Bool
True
isRegPool TxCert era
_ = Bool
False

-- | Check for 'RetirePool' constructor
isRetirePool :: EraTxCert era => TxCert era -> Bool
isRetirePool :: forall era. EraTxCert era => TxCert era -> Bool
isRetirePool (RetirePoolTxCert KeyHash StakePool
_ EpochNo
_) = Bool
True
isRetirePool TxCert era
_ = Bool
False

isInstantaneousRewards :: (ShelleyEraTxCert era, AtMostEra "Babbage" era) => TxCert era -> Bool
isInstantaneousRewards :: forall era.
(ShelleyEraTxCert era, AtMostEra "Babbage" era) =>
TxCert era -> Bool
isInstantaneousRewards = Maybe MIRCert -> Bool
forall a. Maybe a -> Bool
isJust (Maybe MIRCert -> Bool)
-> (TxCert era -> Maybe MIRCert) -> TxCert era -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxCert era -> Maybe MIRCert
forall era.
(ShelleyEraTxCert era, AtMostEra "Babbage" era) =>
TxCert era -> Maybe MIRCert
getMirTxCert

isReservesMIRCert :: (ShelleyEraTxCert era, AtMostEra "Babbage" era) => TxCert era -> Bool
isReservesMIRCert :: forall era.
(ShelleyEraTxCert era, AtMostEra "Babbage" era) =>
TxCert era -> Bool
isReservesMIRCert TxCert era
x = case TxCert era -> Maybe MIRCert
forall era.
(ShelleyEraTxCert era, AtMostEra "Babbage" era) =>
TxCert era -> Maybe MIRCert
getMirTxCert TxCert era
x of
  Just (MIRCert MIRPot
ReservesMIR MIRTarget
_) -> Bool
True
  Maybe MIRCert
_ -> Bool
False

isTreasuryMIRCert :: (ShelleyEraTxCert era, AtMostEra "Babbage" era) => TxCert era -> Bool
isTreasuryMIRCert :: forall era.
(ShelleyEraTxCert era, AtMostEra "Babbage" era) =>
TxCert era -> Bool
isTreasuryMIRCert TxCert era
x = case TxCert era -> Maybe MIRCert
forall era.
(ShelleyEraTxCert era, AtMostEra "Babbage" era) =>
TxCert era -> Maybe MIRCert
getMirTxCert TxCert era
x of
  Just (MIRCert MIRPot
TreasuryMIR MIRTarget
_) -> Bool
True
  Maybe MIRCert
_ -> Bool
False

getScriptWitnessShelleyTxCert ::
  ShelleyTxCert era ->
  Maybe ScriptHash
getScriptWitnessShelleyTxCert :: forall era. ShelleyTxCert era -> Maybe ScriptHash
getScriptWitnessShelleyTxCert = \case
  ShelleyTxCertDelegCert ShelleyDelegCert
delegCert ->
    case ShelleyDelegCert
delegCert of
      ShelleyRegCert Credential Staking
_ -> Maybe ScriptHash
forall a. Maybe a
Nothing
      ShelleyUnRegCert Credential Staking
cred -> Credential Staking -> Maybe ScriptHash
forall (kr :: KeyRole). Credential kr -> Maybe ScriptHash
credScriptHash Credential Staking
cred
      ShelleyDelegCert Credential Staking
cred KeyHash StakePool
_ -> Credential Staking -> Maybe ScriptHash
forall (kr :: KeyRole). Credential kr -> Maybe ScriptHash
credScriptHash Credential Staking
cred
  ShelleyTxCert era
_ -> Maybe ScriptHash
forall a. Maybe a
Nothing

getVKeyWitnessShelleyTxCert :: ShelleyTxCert era -> Maybe (KeyHash Witness)
getVKeyWitnessShelleyTxCert :: forall era. ShelleyTxCert era -> Maybe (KeyHash Witness)
getVKeyWitnessShelleyTxCert = \case
  ShelleyTxCertDelegCert ShelleyDelegCert
delegCert ->
    case ShelleyDelegCert
delegCert of
      -- Registration certificates do not require a witness
      ShelleyRegCert Credential Staking
_ -> Maybe (KeyHash Witness)
forall a. Maybe a
Nothing
      ShelleyUnRegCert Credential Staking
cred -> Credential Staking -> Maybe (KeyHash Witness)
forall (r :: KeyRole). Credential r -> Maybe (KeyHash Witness)
credKeyHashWitness Credential Staking
cred
      ShelleyDelegCert Credential Staking
cred KeyHash StakePool
_ -> Credential Staking -> Maybe (KeyHash Witness)
forall (r :: KeyRole). Credential r -> Maybe (KeyHash Witness)
credKeyHashWitness Credential Staking
cred
  ShelleyTxCertPool 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
  ShelleyTxCertGenesisDeleg GenesisDelegCert
genesisCert -> 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
$ GenesisDelegCert -> KeyHash Witness
genesisKeyHashWitness GenesisDelegCert
genesisCert
  ShelleyTxCertMir {} -> Maybe (KeyHash Witness)
forall a. Maybe a
Nothing

-- | 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.
shelleyTotalDepositsTxCerts ::
  (EraPParams era, Foldable f, EraTxCert era) =>
  PParams era ->
  -- | Check whether a pool with a supplied PoolStakeId is already registered.
  (KeyHash StakePool -> Bool) ->
  f (TxCert era) ->
  Coin
shelleyTotalDepositsTxCerts :: 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 =
  Int
numKeys
    Int -> Coin -> Coin
forall i. Integral i => i -> Coin -> Coin
forall t i. (Val t, Integral i) => i -> t -> t
<×> (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. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL)
    Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Int
numNewRegPoolCerts
    Int -> Coin -> Coin
forall i. Integral i => i -> Coin -> Coin
forall t i. (Val t, Integral i) => i -> t -> t
<×> (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.
(EraPParams era, HasCallStack) =>
Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppPoolDepositL)
  where
    numKeys :: Int
numKeys = forall a. Sum a -> a
getSum @Int (Sum Int -> Int) -> Sum Int -> Int
forall a b. (a -> b) -> a -> b
$ (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' (\TxCert era
x -> if TxCert era -> Bool
forall era. EraTxCert era => TxCert era -> Bool
isRegStakeTxCert TxCert era
x then Sum Int
1 else Sum Int
0) f (TxCert era)
certs
    numNewRegPoolCerts :: Int
numNewRegPoolCerts = Set (KeyHash StakePool) -> Int
forall a. Set a -> Int
Set.size ((Set (KeyHash StakePool) -> TxCert era -> Set (KeyHash StakePool))
-> Set (KeyHash StakePool)
-> f (TxCert era)
-> Set (KeyHash StakePool)
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' Set (KeyHash StakePool) -> TxCert era -> Set (KeyHash StakePool)
addNewPoolIds Set (KeyHash StakePool)
forall a. Set a
Set.empty f (TxCert era)
certs)
    addNewPoolIds :: Set (KeyHash StakePool) -> TxCert era -> Set (KeyHash StakePool)
addNewPoolIds Set (KeyHash StakePool)
regPoolIds = \case
      RegPoolTxCert (StakePoolParams {KeyHash StakePool
sppId :: KeyHash StakePool
sppId :: StakePoolParams -> KeyHash StakePool
sppId})
        -- We don't pay a deposit on a pool that is already registered or duplicated in the certs
        | Bool -> Bool
not (KeyHash StakePool -> Bool
isRegPoolRegistered KeyHash StakePool
sppId Bool -> Bool -> Bool
|| KeyHash StakePool -> Set (KeyHash StakePool) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member KeyHash StakePool
sppId Set (KeyHash StakePool)
regPoolIds) -> KeyHash StakePool
-> Set (KeyHash StakePool) -> Set (KeyHash StakePool)
forall a. Ord a => a -> Set a -> Set a
Set.insert KeyHash StakePool
sppId Set (KeyHash StakePool)
regPoolIds
      TxCert era
_ -> Set (KeyHash StakePool)
regPoolIds

-- | Compute the key deregistration refunds in a transaction
shelleyTotalRefundsTxCerts ::
  (EraPParams era, Foldable f, EraTxCert era) =>
  PParams era ->
  -- | Function that can lookup current deposit, in case when the stake key is registered.
  (Credential Staking -> Maybe Coin) ->
  f (TxCert era) ->
  Coin
shelleyTotalRefundsTxCerts :: 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
lookupDeposit = (Set (Credential Staking), Coin) -> Coin
forall a b. (a, b) -> b
snd ((Set (Credential Staking), Coin) -> Coin)
-> (f (TxCert era) -> (Set (Credential Staking), Coin))
-> f (TxCert era)
-> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Set (Credential Staking), Coin)
 -> TxCert era -> (Set (Credential Staking), Coin))
-> (Set (Credential Staking), Coin)
-> f (TxCert era)
-> (Set (Credential Staking), 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' (Set (Credential Staking), Coin)
-> TxCert era -> (Set (Credential Staking), Coin)
accum (Set (Credential Staking)
forall a. Monoid a => a
mempty, Integer -> Coin
Coin Integer
0)
  where
    keyDeposit :: Coin
keyDeposit = 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. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL
    accum :: (Set (Credential Staking), Coin)
-> TxCert era -> (Set (Credential Staking), Coin)
accum (!Set (Credential Staking)
regCreds, !Coin
totalRefunds) TxCert era
cert =
      case TxCert era -> Maybe (Credential Staking)
forall era.
EraTxCert era =>
TxCert era -> Maybe (Credential Staking)
lookupRegStakeTxCert TxCert era
cert of
        Just Credential Staking
k ->
          -- Need to track new delegations in case that the same key is later deregistered in
          -- the same transaction.
          (Credential Staking
-> Set (Credential Staking) -> Set (Credential Staking)
forall a. Ord a => a -> Set a -> Set a
Set.insert Credential Staking
k Set (Credential Staking)
regCreds, Coin
totalRefunds)
        Maybe (Credential Staking)
Nothing ->
          case TxCert era -> Maybe (Credential Staking)
forall era.
EraTxCert era =>
TxCert era -> Maybe (Credential Staking)
lookupUnRegStakeTxCert TxCert era
cert of
            Just Credential Staking
cred
              -- We first check if there was already a registration certificate in this
              -- transaction.
              | Credential Staking -> Set (Credential Staking) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Credential Staking
cred Set (Credential Staking)
regCreds -> (Credential Staking
-> Set (Credential Staking) -> Set (Credential Staking)
forall a. Ord a => a -> Set a -> Set a
Set.delete Credential Staking
cred Set (Credential Staking)
regCreds, Coin
totalRefunds Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Coin
keyDeposit)
              -- Check for the deposit left during registration in some previous
              -- transaction. This de-registration check will be matched first, despite being
              -- the last case to match, because registration is not possible without
              -- de-registration.
              | Just Coin
deposit <- Credential Staking -> Maybe Coin
lookupDeposit Credential Staking
cred -> (Set (Credential Staking)
regCreds, Coin
totalRefunds Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Coin
deposit)
            Maybe (Credential Staking)
_ -> (Set (Credential Staking)
regCreds, Coin
totalRefunds)