{-# 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 #-}
-- Due to Delegation usage.
-- TODO: remove when Delegation is gone
{-# OPTIONS_GHC -Wno-deprecations #-}
{-# OPTIONS_GHC -Wno-orphans #-}
-- Due to deprecated requiresVKeyWitness.
-- TODO: remove when requiresVKeyWitness is gone:
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

module Cardano.Ledger.Shelley.TxCert (
  ShelleyEraTxCert (..),
  pattern MirTxCert,
  pattern GenesisDelegTxCert,
  pattern RegTxCert,
  pattern UnRegTxCert,
  pattern DelegStakeTxCert,
  ShelleyDelegCert (.., RegKey, DeRegKey, Delegate),
  getVKeyWitnessShelleyTxCert,
  getScriptWitnessShelleyTxCert,
  delegCWitness,
  ShelleyTxCert (..),
  upgradeShelleyTxCert,

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

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

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

  -- ** Deposits and Refunds
  shelleyTotalDepositsTxCerts,
  shelleyTotalRefundsTxCerts,

  -- * Re-exports
  EraTxCert (..),
  pattern RegPoolTxCert,
  pattern RetirePoolTxCert,
  Delegation (..),
  PoolCert (..),
  poolCWitness,
  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 (Hash, KeyHash (..), KeyRole (..), VerKeyVRF, 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, isNothing)
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) ->
  Hash (EraCrypto era) (VerKeyVRF (EraCrypto era)) ->
  TxCert era
pattern $bGenesisDelegTxCert :: forall era.
(ShelleyEraTxCert era, ProtVerAtMost era 8) =>
KeyHash 'Genesis (EraCrypto era)
-> KeyHash 'GenesisDelegate (EraCrypto era)
-> Hash (EraCrypto era) (VerKeyVRF (EraCrypto era))
-> TxCert era
$mGenesisDelegTxCert :: forall {r} {era}.
(ShelleyEraTxCert era, ProtVerAtMost era 8) =>
TxCert era
-> (KeyHash 'Genesis (EraCrypto era)
    -> KeyHash 'GenesisDelegate (EraCrypto era)
    -> Hash (EraCrypto era) (VerKeyVRF (EraCrypto era))
    -> r)
-> ((# #) -> r)
-> r
GenesisDelegTxCert genKey genDelegKey vrf <-
  (getGenesisDelegTxCert -> Just (GenesisDelegCert genKey genDelegKey vrf))
  where
    GenesisDelegTxCert KeyHash 'Genesis (EraCrypto era)
genKey KeyHash 'GenesisDelegate (EraCrypto era)
genDelegKey Hash (EraCrypto era) (VerKeyVRF (EraCrypto era))
vrf =
      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
-> Hash c (VerKeyVRF c)
-> GenesisDelegCert c
GenesisDelegCert KeyHash 'Genesis (EraCrypto era)
genKey KeyHash 'GenesisDelegate (EraCrypto era)
genDelegKey Hash (EraCrypto era) (VerKeyVRF (EraCrypto era))
vrf

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

-- | Genesis key delegation certificate
data GenesisDelegCert c
  = GenesisDelegCert
      !(KeyHash 'Genesis c)
      !(KeyHash 'GenesisDelegate c)
      !(Hash c (VerKeyVRF 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 Hash (HASH c) (VerKeyVRF (VRF 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 Hash (HASH c) (VerKeyVRF (VRF 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
_ Hash c (VerKeyVRF 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
_ Hash c (VerKeyVRF 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 Hash (HASH c) (VerKeyVRF (VRF 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 Hash (HASH c) (VerKeyVRF (VRF 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
      Hash (HASH (EraCrypto era)) (VerKeyVRF (VRF (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
-> Hash c (VerKeyVRF c)
-> GenesisDelegCert c
GenesisDelegCert KeyHash 'Genesis (EraCrypto era)
gen KeyHash 'GenesisDelegate (EraCrypto era)
genDeleg Hash (HASH (EraCrypto era)) (VerKeyVRF (VRF (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
        ]

pattern RegKey :: StakeCredential c -> ShelleyDelegCert c
pattern $bRegKey :: forall c. StakeCredential c -> ShelleyDelegCert c
$mRegKey :: forall {r} {c}.
ShelleyDelegCert c -> (StakeCredential c -> r) -> ((# #) -> r) -> r
RegKey cred = ShelleyRegCert cred
{-# DEPRECATED RegKey "In favor of `ShelleyRegCert`" #-}

pattern DeRegKey :: StakeCredential c -> ShelleyDelegCert c
pattern $bDeRegKey :: forall c. StakeCredential c -> ShelleyDelegCert c
$mDeRegKey :: forall {r} {c}.
ShelleyDelegCert c -> (StakeCredential c -> r) -> ((# #) -> r) -> r
DeRegKey cred = ShelleyUnRegCert cred
{-# DEPRECATED DeRegKey "In favor of `ShelleyUnRegCert`" #-}

pattern Delegate :: Delegation c -> ShelleyDelegCert c
pattern $bDelegate :: forall c. Delegation c -> ShelleyDelegCert c
$mDelegate :: forall {r} {c}.
ShelleyDelegCert c -> (Delegation c -> r) -> ((# #) -> r) -> r
Delegate delegation <- (mkDelegation -> Just delegation)
  where
    Delegate (Delegation StakeCredential c
cred KeyHash 'StakePool c
poolId) = forall c.
StakeCredential c -> KeyHash 'StakePool c -> ShelleyDelegCert c
ShelleyDelegCert StakeCredential c
cred KeyHash 'StakePool c
poolId
{-# DEPRECATED Delegate "In favor of `ShelleyDelegCert`" #-}

{-# COMPLETE RegKey, DeRegKey, Delegate #-}

mkDelegation :: ShelleyDelegCert c -> Maybe (Delegation c)
mkDelegation :: forall c. ShelleyDelegCert c -> Maybe (Delegation c)
mkDelegation (ShelleyDelegCert StakeCredential c
cred KeyHash 'StakePool c
poolId) = forall a. a -> Maybe a
Just (forall c. StakeCredential c -> KeyHash 'StakePool c -> Delegation c
Delegation StakeCredential c
cred KeyHash 'StakePool c
poolId)
mkDelegation ShelleyDelegCert c
_ = forall a. Maybe a
Nothing

instance NoThunks (ShelleyDelegCert c)

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

-- | Determine the certificate author
delegCWitness :: ShelleyDelegCert c -> Credential 'Staking c
delegCWitness :: forall c. ShelleyDelegCert c -> Credential 'Staking c
delegCWitness (ShelleyRegCert StakeCredential c
_) = forall a. HasCallStack => [Char] -> a
error [Char]
"no witness in key registration certificate"
delegCWitness (ShelleyUnRegCert StakeCredential c
cred) = StakeCredential c
cred
delegCWitness (ShelleyDelegCert StakeCredential c
cred KeyHash 'StakePool c
_) = StakeCredential c
cred
{-# DEPRECATED delegCWitness "This was a partial function, logic rewritten in a safer way" #-}

-- | Check for 'ShelleyRegCert' constructor
isRegKey :: ShelleyEraTxCert era => TxCert era -> Bool
isRegKey :: forall era. ShelleyEraTxCert era => TxCert era -> Bool
isRegKey (RegTxCert StakeCredential (EraCrypto era)
_) = Bool
True
isRegKey TxCert era
_ = Bool
False
{-# DEPRECATED isRegKey "Use `isRegStakeTxCert` instead" #-}

-- | Check for 'ShelleyUnRegCert' constructor
isDeRegKey :: ShelleyEraTxCert era => TxCert era -> Bool
isDeRegKey :: forall era. ShelleyEraTxCert era => TxCert era -> Bool
isDeRegKey (UnRegTxCert StakeCredential (EraCrypto era)
_) = Bool
True
isDeRegKey TxCert era
_ = Bool
False
{-# DEPRECATED isDeRegKey "Use `isUnRegStakeTxCert` instead" #-}

-- | 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

-- | Returns True for delegation certificates that require at least
-- one witness, and False otherwise. It is mainly used to ensure
-- that calling a variant of 'cwitness' is safe.
--
-- Note: This will not compile for Conway, because it is incorrect for Conway, use
-- `getVKeyWitnessTxCert` instead.
requiresVKeyWitness :: (ShelleyEraTxCert era, ProtVerAtMost era 8) => TxCert era -> Bool
requiresVKeyWitness :: forall era.
(ShelleyEraTxCert era, ProtVerAtMost era 8) =>
TxCert era -> Bool
requiresVKeyWitness (RegTxCert StakeCredential (EraCrypto era)
_) = Bool
False
requiresVKeyWitness TxCert era
x = forall a. Maybe a -> Bool
isNothing forall a b. (a -> b) -> a -> b
$ forall era.
(ShelleyEraTxCert era, ProtVerAtMost era 8) =>
TxCert era -> Maybe (MIRCert (EraCrypto era))
getMirTxCert TxCert era
x
{-# DEPRECATED requiresVKeyWitness "In favor of `getVKeyWitnessTxCert`" #-}

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)