{-# LANGUAGE BangPatterns #-}
{-# 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 #-}

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 (..),
  StakeCredential,
  credKeyHashWitness,
  credScriptHash,
 )
import Cardano.Ledger.Crypto
import Cardano.Ledger.Keys (
  KeyHash (..),
  KeyRole (..),
  KeyRoleVRF (..),
  VRFVerKeyHash,
  asWitness,
 )
import Cardano.Ledger.PoolParams (PoolParams (..))
import Cardano.Ledger.Shelley.Era (ShelleyEra)
import Cardano.Ledger.Shelley.PParams ()
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 Crypto c => EraTxCert (ShelleyEra c) where
  {-# SPECIALIZE instance EraTxCert (ShelleyEra StandardCrypto) #-}

  type TxCert (ShelleyEra c) = ShelleyTxCert (ShelleyEra c)

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

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

  getScriptWitnessTxCert :: TxCert (ShelleyEra c)
-> Maybe (ScriptHash (EraCrypto (ShelleyEra c)))
getScriptWitnessTxCert = forall era. ShelleyTxCert era -> Maybe (ScriptHash (EraCrypto era))
getScriptWitnessShelleyTxCert

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

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

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

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

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

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

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

class EraTxCert era => ShelleyEraTxCert era where
  mkRegTxCert :: StakeCredential (EraCrypto era) -> TxCert era
  getRegTxCert :: TxCert era -> Maybe (StakeCredential (EraCrypto era))

  mkUnRegTxCert :: StakeCredential (EraCrypto era) -> TxCert era
  getUnRegTxCert :: TxCert era -> Maybe (StakeCredential (EraCrypto era))

  mkDelegStakeTxCert ::
    StakeCredential (EraCrypto era) -> KeyHash 'StakePool (EraCrypto era) -> TxCert era
  getDelegStakeTxCert ::
    TxCert era -> Maybe (StakeCredential (EraCrypto era), KeyHash 'StakePool (EraCrypto era))

  mkGenesisDelegTxCert :: ProtVerAtMost era 8 => GenesisDelegCert (EraCrypto era) -> TxCert era
  getGenesisDelegTxCert ::
    ProtVerAtMost era 8 => TxCert era -> Maybe (GenesisDelegCert (EraCrypto era))

  mkMirTxCert :: ProtVerAtMost era 8 => MIRCert (EraCrypto era) -> TxCert era
  getMirTxCert ::
    ProtVerAtMost era 8 => TxCert era -> Maybe (MIRCert (EraCrypto era))

instance Crypto c => ShelleyEraTxCert (ShelleyEra c) where
  {-# SPECIALIZE instance ShelleyEraTxCert (ShelleyEra StandardCrypto) #-}

  mkRegTxCert :: StakeCredential (EraCrypto (ShelleyEra c)) -> TxCert (ShelleyEra c)
mkRegTxCert = forall era. ShelleyDelegCert (EraCrypto era) -> ShelleyTxCert era
ShelleyTxCertDelegCert forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. StakeCredential c -> ShelleyDelegCert c
ShelleyRegCert

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

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

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

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

  getDelegStakeTxCert :: TxCert (ShelleyEra c)
-> Maybe
     (StakeCredential (EraCrypto (ShelleyEra c)),
      KeyHash 'StakePool (EraCrypto (ShelleyEra c)))
getDelegStakeTxCert (ShelleyTxCertDelegCert (ShelleyDelegCert StakeCredential (EraCrypto (ShelleyEra c))
c KeyHash 'StakePool (EraCrypto (ShelleyEra c))
kh)) = forall a. a -> Maybe a
Just (StakeCredential (EraCrypto (ShelleyEra c))
c, KeyHash 'StakePool (EraCrypto (ShelleyEra c))
kh)
  getDelegStakeTxCert TxCert (ShelleyEra c)
_ = forall a. Maybe a
Nothing

  mkGenesisDelegTxCert :: ProtVerAtMost (ShelleyEra c) 8 =>
GenesisDelegCert (EraCrypto (ShelleyEra c))
-> TxCert (ShelleyEra c)
mkGenesisDelegTxCert = forall era. GenesisDelegCert (EraCrypto era) -> ShelleyTxCert era
ShelleyTxCertGenesisDeleg

  getGenesisDelegTxCert :: ProtVerAtMost (ShelleyEra c) 8 =>
TxCert (ShelleyEra c)
-> Maybe (GenesisDelegCert (EraCrypto (ShelleyEra c)))
getGenesisDelegTxCert (ShelleyTxCertGenesisDeleg GenesisDelegCert (EraCrypto (ShelleyEra c))
c) = forall a. a -> Maybe a
Just GenesisDelegCert (EraCrypto (ShelleyEra c))
c
  getGenesisDelegTxCert TxCert (ShelleyEra c)
_ = forall a. Maybe a
Nothing

  mkMirTxCert :: ProtVerAtMost (ShelleyEra c) 8 =>
MIRCert (EraCrypto (ShelleyEra c)) -> TxCert (ShelleyEra c)
mkMirTxCert = forall era. MIRCert (EraCrypto era) -> ShelleyTxCert era
ShelleyTxCertMir

  getMirTxCert :: ProtVerAtMost (ShelleyEra c) 8 =>
TxCert (ShelleyEra c) -> Maybe (MIRCert (EraCrypto (ShelleyEra c)))
getMirTxCert (ShelleyTxCertMir MIRCert (EraCrypto (ShelleyEra c))
c) = forall a. a -> Maybe a
Just MIRCert (EraCrypto (ShelleyEra c))
c
  getMirTxCert TxCert (ShelleyEra c)
_ = forall a. Maybe a
Nothing

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

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

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

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

pattern GenesisDelegTxCert ::
  (ShelleyEraTxCert era, ProtVerAtMost era 8) =>
  KeyHash 'Genesis (EraCrypto era) ->
  KeyHash 'GenesisDelegate (EraCrypto era) ->
  VRFVerKeyHash 'GenDelegVRF (EraCrypto era) ->
  TxCert era
pattern $bGenesisDelegTxCert :: forall era.
(ShelleyEraTxCert era, ProtVerAtMost era 8) =>
KeyHash 'Genesis (EraCrypto era)
-> KeyHash 'GenesisDelegate (EraCrypto era)
-> VRFVerKeyHash 'GenDelegVRF (EraCrypto era)
-> TxCert era
$mGenesisDelegTxCert :: forall {r} {era}.
(ShelleyEraTxCert era, ProtVerAtMost era 8) =>
TxCert era
-> (KeyHash 'Genesis (EraCrypto era)
    -> KeyHash 'GenesisDelegate (EraCrypto era)
    -> VRFVerKeyHash 'GenDelegVRF (EraCrypto era)
    -> r)
-> ((# #) -> r)
-> r
GenesisDelegTxCert genKey genDelegKey vrfKeyHash <-
  (getGenesisDelegTxCert -> Just (GenesisDelegCert genKey genDelegKey vrfKeyHash))
  where
    GenesisDelegTxCert KeyHash 'Genesis (EraCrypto era)
genKey KeyHash 'GenesisDelegate (EraCrypto era)
genDelegKey VRFVerKeyHash 'GenDelegVRF (EraCrypto era)
vrfKeyHash =
      forall era.
(ShelleyEraTxCert era, ProtVerAtMost era 8) =>
GenesisDelegCert (EraCrypto era) -> TxCert era
mkGenesisDelegTxCert forall a b. (a -> b) -> a -> b
$ forall c.
KeyHash 'Genesis c
-> KeyHash 'GenesisDelegate c
-> VRFVerKeyHash 'GenDelegVRF c
-> GenesisDelegCert c
GenesisDelegCert KeyHash 'Genesis (EraCrypto era)
genKey KeyHash 'GenesisDelegate (EraCrypto era)
genDelegKey VRFVerKeyHash 'GenDelegVRF (EraCrypto era)
vrfKeyHash

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

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

instance NoThunks (GenesisDelegCert c)

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

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

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

genesisCWitness :: GenesisDelegCert c -> KeyHash 'Genesis c
genesisCWitness :: forall c. GenesisDelegCert c -> KeyHash 'Genesis c
genesisCWitness (GenesisDelegCert KeyHash 'Genesis c
gk KeyHash 'GenesisDelegate c
_ VRFVerKeyHash 'GenDelegVRF c
_) = KeyHash 'Genesis c
gk

data MIRPot = ReservesMIR | TreasuryMIR
  deriving (Int -> MIRPot -> ShowS
[MIRPot] -> ShowS
MIRPot -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [MIRPot] -> ShowS
$cshowList :: [MIRPot] -> ShowS
show :: MIRPot -> [Char]
$cshow :: MIRPot -> [Char]
showsPrec :: Int -> MIRPot -> ShowS
$cshowsPrec :: Int -> MIRPot -> ShowS
Show, 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
$cto :: forall x. Rep MIRPot x -> MIRPot
$cfrom :: forall x. MIRPot -> Rep MIRPot x
Generic, MIRPot -> MIRPot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MIRPot -> MIRPot -> Bool
$c/= :: MIRPot -> MIRPot -> Bool
== :: MIRPot -> MIRPot -> Bool
$c== :: MIRPot -> MIRPot -> Bool
Eq, MIRPot -> ()
forall a. (a -> ()) -> NFData a
rnf :: MIRPot -> ()
$crnf :: MIRPot -> ()
NFData, Eq 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
min :: MIRPot -> MIRPot -> MIRPot
$cmin :: MIRPot -> MIRPot -> MIRPot
max :: MIRPot -> MIRPot -> MIRPot
$cmax :: MIRPot -> MIRPot -> MIRPot
>= :: MIRPot -> MIRPot -> Bool
$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
compare :: MIRPot -> MIRPot -> Ordering
$ccompare :: MIRPot -> MIRPot -> Ordering
Ord, Int -> MIRPot
MIRPot -> Int
MIRPot -> [MIRPot]
MIRPot -> MIRPot
MIRPot -> MIRPot -> [MIRPot]
MIRPot -> MIRPot -> MIRPot -> [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
enumFromThenTo :: MIRPot -> MIRPot -> MIRPot -> [MIRPot]
$cenumFromThenTo :: MIRPot -> MIRPot -> MIRPot -> [MIRPot]
enumFromTo :: MIRPot -> MIRPot -> [MIRPot]
$cenumFromTo :: MIRPot -> MIRPot -> [MIRPot]
enumFromThen :: MIRPot -> MIRPot -> [MIRPot]
$cenumFromThen :: MIRPot -> MIRPot -> [MIRPot]
enumFrom :: MIRPot -> [MIRPot]
$cenumFrom :: MIRPot -> [MIRPot]
fromEnum :: MIRPot -> Int
$cfromEnum :: MIRPot -> Int
toEnum :: Int -> MIRPot
$ctoEnum :: Int -> MIRPot
pred :: MIRPot -> MIRPot
$cpred :: MIRPot -> MIRPot
succ :: MIRPot -> MIRPot
$csucc :: MIRPot -> MIRPot
Enum, MIRPot
forall a. a -> a -> Bounded a
maxBound :: MIRPot
$cmaxBound :: MIRPot
minBound :: MIRPot
$cminBound :: 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 =
    forall s. Decoder s Word
decodeWord forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Word
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure MIRPot
ReservesMIR
      Word
1 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure MIRPot
TreasuryMIR
      Word
k -> forall (m :: * -> *) 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 c
  = StakeAddressesMIR !(Map (Credential 'Staking c) DeltaCoin)
  | SendToOppositePotMIR !Coin
  deriving (Int -> MIRTarget c -> ShowS
forall c. Int -> MIRTarget c -> ShowS
forall c. [MIRTarget c] -> ShowS
forall c. MIRTarget c -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [MIRTarget c] -> ShowS
$cshowList :: forall c. [MIRTarget c] -> ShowS
show :: MIRTarget c -> [Char]
$cshow :: forall c. MIRTarget c -> [Char]
showsPrec :: Int -> MIRTarget c -> ShowS
$cshowsPrec :: forall c. Int -> MIRTarget c -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (MIRTarget c) x -> MIRTarget c
forall c x. MIRTarget c -> Rep (MIRTarget c) x
$cto :: forall c x. Rep (MIRTarget c) x -> MIRTarget c
$cfrom :: forall c x. MIRTarget c -> Rep (MIRTarget c) x
Generic, MIRTarget c -> MIRTarget c -> Bool
forall c. MIRTarget c -> MIRTarget c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MIRTarget c -> MIRTarget c -> Bool
$c/= :: forall c. MIRTarget c -> MIRTarget c -> Bool
== :: MIRTarget c -> MIRTarget c -> Bool
$c== :: forall c. MIRTarget c -> MIRTarget c -> Bool
Eq, MIRTarget c -> MIRTarget c -> Bool
MIRTarget c -> MIRTarget c -> Ordering
forall c. Eq (MIRTarget 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. MIRTarget c -> MIRTarget c -> Bool
forall c. MIRTarget c -> MIRTarget c -> Ordering
forall c. MIRTarget c -> MIRTarget c -> MIRTarget c
min :: MIRTarget c -> MIRTarget c -> MIRTarget c
$cmin :: forall c. MIRTarget c -> MIRTarget c -> MIRTarget c
max :: MIRTarget c -> MIRTarget c -> MIRTarget c
$cmax :: forall c. MIRTarget c -> MIRTarget c -> MIRTarget c
>= :: MIRTarget c -> MIRTarget c -> Bool
$c>= :: forall c. MIRTarget c -> MIRTarget c -> Bool
> :: MIRTarget c -> MIRTarget c -> Bool
$c> :: forall c. MIRTarget c -> MIRTarget c -> Bool
<= :: MIRTarget c -> MIRTarget c -> Bool
$c<= :: forall c. MIRTarget c -> MIRTarget c -> Bool
< :: MIRTarget c -> MIRTarget c -> Bool
$c< :: forall c. MIRTarget c -> MIRTarget c -> Bool
compare :: MIRTarget c -> MIRTarget c -> Ordering
$ccompare :: forall c. MIRTarget c -> MIRTarget c -> Ordering
Ord, forall c. MIRTarget c -> ()
forall a. (a -> ()) -> NFData a
rnf :: MIRTarget c -> ()
$crnf :: forall c. MIRTarget c -> ()
NFData)

deriving instance NoThunks (MIRTarget c)

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

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

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

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

instance NoThunks (MIRCert c)

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

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

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

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

instance NoThunks (ShelleyTxCert era)

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

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

-- CBOR

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

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

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

encodeGenesisDelegCert :: Crypto c => GenesisDelegCert c -> Encoding
encodeGenesisDelegCert :: forall c. Crypto c => GenesisDelegCert c -> Encoding
encodeGenesisDelegCert (GenesisDelegCert KeyHash 'Genesis c
gk KeyHash 'GenesisDelegate c
kh VRFVerKeyHash 'GenDelegVRF c
vrf) =
  Word -> Encoding
encodeListLen Word
4
    forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
encodeWord8 Word8
5
    forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR KeyHash 'Genesis c
gk
    forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR KeyHash 'GenesisDelegate c
kh
    forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR VRFVerKeyHash 'GenDelegVRF c
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 = forall s a. Text -> (Word -> Decoder s (Int, a)) -> Decoder s a
decodeRecordSum Text
"ShelleyTxCert" 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
5 -> do
      KeyHash 'Genesis (EraCrypto era)
gen <- forall a s. DecCBOR a => Decoder s a
decCBOR
      KeyHash 'GenesisDelegate (EraCrypto era)
genDeleg <- forall a s. DecCBOR a => Decoder s a
decCBOR
      VRFVerKeyHash 'GenDelegVRF (EraCrypto era)
vrf <- forall a s. DecCBOR a => Decoder s a
decCBOR
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
4, forall era. GenesisDelegCert (EraCrypto era) -> ShelleyTxCert era
ShelleyTxCertGenesisDeleg forall a b. (a -> b) -> a -> b
$ forall c.
KeyHash 'Genesis c
-> KeyHash 'GenesisDelegate c
-> VRFVerKeyHash 'GenDelegVRF c
-> GenesisDelegCert c
GenesisDelegCert KeyHash 'Genesis (EraCrypto era)
gen KeyHash 'GenesisDelegate (EraCrypto era)
genDeleg VRFVerKeyHash 'GenDelegVRF (EraCrypto era)
vrf)
    Word
6 -> do
      MIRCert (EraCrypto era)
x <- forall a s. DecCBOR a => Decoder s a
decCBOR
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
2, forall era. MIRCert (EraCrypto era) -> ShelleyTxCert era
ShelleyTxCertMir MIRCert (EraCrypto era)
x)
    Word
x -> forall (m :: * -> *) 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
    StakeCredential (EraCrypto era)
cred <- forall a s. DecCBOR a => Decoder s a
decCBOR
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
2, forall era.
ShelleyEraTxCert era =>
StakeCredential (EraCrypto era) -> TxCert era
RegTxCert StakeCredential (EraCrypto era)
cred)
  Word
1 -> do
    StakeCredential (EraCrypto era)
cred <- forall a s. DecCBOR a => Decoder s a
decCBOR
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
2, forall era.
ShelleyEraTxCert era =>
StakeCredential (EraCrypto era) -> TxCert era
UnRegTxCert StakeCredential (EraCrypto era)
cred)
  Word
2 -> do
    StakeCredential (EraCrypto era)
cred <- forall a s. DecCBOR a => Decoder s a
decCBOR
    KeyHash 'StakePool (EraCrypto era)
stakePool <- forall a s. DecCBOR a => Decoder s a
decCBOR
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
3, forall era.
ShelleyEraTxCert era =>
StakeCredential (EraCrypto era)
-> KeyHash 'StakePool (EraCrypto era) -> TxCert era
DelegStakeTxCert StakeCredential (EraCrypto era)
cred KeyHash 'StakePool (EraCrypto era)
stakePool)
  Word
k -> forall (m :: * -> *) 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
    PoolParams (EraCrypto era)
group <- forall a s. DecCBORGroup a => Decoder s a
decCBORGroup
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
1 forall a. Num a => a -> a -> a
+ forall a. EncCBORGroup a => a -> Int
listLenInt PoolParams (EraCrypto era)
group, forall era.
EraTxCert era =>
PoolParams (EraCrypto era) -> TxCert era
RegPoolTxCert PoolParams (EraCrypto era)
group)
  Word
4 -> do
    KeyHash 'StakePool (EraCrypto era)
a <- forall a s. DecCBOR a => Decoder s a
decCBOR
    EpochNo
b <- forall a s. DecCBOR a => Decoder s a
decCBOR
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
3, forall era.
EraTxCert era =>
KeyHash 'StakePool (EraCrypto era) -> EpochNo -> TxCert era
RetirePoolTxCert KeyHash 'StakePool (EraCrypto era)
a EpochNo
b)
  Word
k -> forall (m :: * -> *) a. MonadFail m => Word -> m a
invalidKey Word
k
{-# INLINE poolTxCertDecoder #-}

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

instance Crypto c => ToJSON (ShelleyDelegCert c) where
  toJSON :: ShelleyDelegCert c -> Value
toJSON = \case
    ShelleyRegCert StakeCredential c
cred -> Text -> [Pair] -> Value
kindObject Text
"RegCert" [Key
"credential" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON StakeCredential c
cred]
    ShelleyUnRegCert StakeCredential c
cred -> Text -> [Pair] -> Value
kindObject Text
"UnRegCert" [Key
"credential" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON StakeCredential c
cred]
    ShelleyDelegCert StakeCredential c
cred KeyHash 'StakePool c
poolId ->
      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
"poolId" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON KeyHash 'StakePool c
poolId
        ]

instance NoThunks (ShelleyDelegCert c)

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

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

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

-- | Check for 'RegPool' constructor
isRegPool :: EraTxCert era => TxCert era -> Bool
isRegPool :: forall era. EraTxCert era => TxCert era -> Bool
isRegPool (RegPoolTxCert PoolParams (EraCrypto era)
_) = 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 (EraCrypto era)
_ EpochNo
_) = Bool
True
isRetirePool TxCert era
_ = Bool
False

isInstantaneousRewards :: (ShelleyEraTxCert era, ProtVerAtMost era 8) => TxCert era -> Bool
isInstantaneousRewards :: forall era.
(ShelleyEraTxCert era, ProtVerAtMost era 8) =>
TxCert era -> Bool
isInstantaneousRewards = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(ShelleyEraTxCert era, ProtVerAtMost era 8) =>
TxCert era -> Maybe (MIRCert (EraCrypto era))
getMirTxCert

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

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

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

getVKeyWitnessShelleyTxCert :: ShelleyTxCert era -> Maybe (KeyHash 'Witness (EraCrypto era))
getVKeyWitnessShelleyTxCert :: forall era.
ShelleyTxCert era -> Maybe (KeyHash 'Witness (EraCrypto era))
getVKeyWitnessShelleyTxCert = \case
  ShelleyTxCertDelegCert ShelleyDelegCert (EraCrypto era)
delegCert ->
    case ShelleyDelegCert (EraCrypto era)
delegCert of
      -- Registration certificates do not require a witness
      ShelleyRegCert StakeCredential (EraCrypto era)
_ -> forall a. Maybe a
Nothing
      ShelleyUnRegCert StakeCredential (EraCrypto era)
cred -> forall (r :: KeyRole) c.
Credential r c -> Maybe (KeyHash 'Witness c)
credKeyHashWitness StakeCredential (EraCrypto era)
cred
      ShelleyDelegCert StakeCredential (EraCrypto era)
cred KeyHash 'StakePool (EraCrypto era)
_ -> forall (r :: KeyRole) c.
Credential r c -> Maybe (KeyHash 'Witness c)
credKeyHashWitness StakeCredential (EraCrypto era)
cred
  ShelleyTxCertPool 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
  ShelleyTxCertGenesisDeleg GenesisDelegCert (EraCrypto era)
genesisCert -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall c. GenesisDelegCert c -> KeyHash 'Witness c
genesisKeyHashWitness GenesisDelegCert (EraCrypto era)
genesisCert
  ShelleyTxCertMir {} -> 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 (EraCrypto era) -> Bool) ->
  f (TxCert era) ->
  Coin
shelleyTotalDepositsTxCerts :: 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 =
  Int
numKeys
    forall t i. (Val t, Integral i) => i -> t -> t
<×> (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Coin
ppKeyDepositL)
    forall t. Val t => t -> t -> t
<+> Int
numNewRegPoolCerts
    forall t i. (Val t, Integral i) => i -> t -> t
<×> (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Coin
ppPoolDepositL)
  where
    numKeys :: Int
numKeys = forall a. Sum a -> a
getSum @Int forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' (\TxCert era
x -> if 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 = forall a. Set a -> Int
Set.size (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' Set (KeyHash 'StakePool (EraCrypto era))
-> TxCert era -> Set (KeyHash 'StakePool (EraCrypto era))
addNewPoolIds forall a. Set a
Set.empty f (TxCert era)
certs)
    addNewPoolIds :: Set (KeyHash 'StakePool (EraCrypto era))
-> TxCert era -> Set (KeyHash 'StakePool (EraCrypto era))
addNewPoolIds Set (KeyHash 'StakePool (EraCrypto era))
regPoolIds = \case
      RegPoolTxCert (PoolParams {KeyHash 'StakePool (EraCrypto era)
ppId :: forall c. PoolParams c -> KeyHash 'StakePool c
ppId :: KeyHash 'StakePool (EraCrypto era)
ppId})
        -- We don't pay a deposit on a pool that is already registered or duplicated in the certs
        | Bool -> Bool
not (KeyHash 'StakePool (EraCrypto era) -> Bool
isRegPoolRegistered KeyHash 'StakePool (EraCrypto era)
ppId Bool -> Bool -> Bool
|| forall a. Ord a => a -> Set a -> Bool
Set.member KeyHash 'StakePool (EraCrypto era)
ppId Set (KeyHash 'StakePool (EraCrypto era))
regPoolIds) -> forall a. Ord a => a -> Set a -> Set a
Set.insert KeyHash 'StakePool (EraCrypto era)
ppId Set (KeyHash 'StakePool (EraCrypto era))
regPoolIds
      TxCert era
_ -> Set (KeyHash 'StakePool (EraCrypto era))
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.
  (StakeCredential (EraCrypto era) -> Maybe Coin) ->
  f (TxCert era) ->
  Coin
shelleyTotalRefundsTxCerts :: 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
lookupDeposit = 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' (Set (Credential 'Staking (EraCrypto era)), Coin)
-> TxCert era -> (Set (Credential 'Staking (EraCrypto era)), Coin)
accum (forall a. Monoid a => a
mempty, Integer -> Coin
Coin Integer
0)
  where
    keyDeposit :: Coin
keyDeposit = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Coin
ppKeyDepositL
    accum :: (Set (Credential 'Staking (EraCrypto era)), Coin)
-> TxCert era -> (Set (Credential 'Staking (EraCrypto era)), Coin)
accum (!Set (Credential 'Staking (EraCrypto era))
regCreds, !Coin
totalRefunds) TxCert era
cert =
      case forall era.
EraTxCert era =>
TxCert era -> Maybe (Credential 'Staking (EraCrypto era))
lookupRegStakeTxCert TxCert era
cert of
        Just Credential 'Staking (EraCrypto era)
k ->
          -- Need to track new delegations in case that the same key is later deregistered in
          -- the same transaction.
          (forall a. Ord a => a -> Set a -> Set a
Set.insert Credential 'Staking (EraCrypto era)
k Set (Credential 'Staking (EraCrypto era))
regCreds, Coin
totalRefunds)
        Maybe (Credential 'Staking (EraCrypto era))
Nothing ->
          case forall era.
EraTxCert era =>
TxCert era -> Maybe (Credential 'Staking (EraCrypto era))
lookupUnRegStakeTxCert TxCert era
cert of
            Just Credential 'Staking (EraCrypto era)
cred
              -- We first check if there was already a registration certificate in this
              -- transaction.
              | forall a. Ord a => a -> Set a -> Bool
Set.member Credential 'Staking (EraCrypto era)
cred Set (Credential 'Staking (EraCrypto era))
regCreds -> (forall a. Ord a => a -> Set a -> Set a
Set.delete Credential 'Staking (EraCrypto era)
cred Set (Credential 'Staking (EraCrypto era))
regCreds, Coin
totalRefunds 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 (EraCrypto era) -> Maybe Coin
lookupDeposit Credential 'Staking (EraCrypto era)
cred -> (Set (Credential 'Staking (EraCrypto era))
regCreds, Coin
totalRefunds forall t. Val t => t -> t -> t
<+> Coin
deposit)
            Maybe (Credential 'Staking (EraCrypto era))
_ -> (Set (Credential 'Staking (EraCrypto era))
regCreds, Coin
totalRefunds)