{-# 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 (..),
genesisCWitness,
genesisKeyHashWitness,
MIRCert (..),
MIRPot (..),
MIRTarget (..),
isDelegation,
isRegPool,
isRetirePool,
isGenesisDelegation,
isInstantaneousRewards,
isReservesMIRCert,
isTreasuryMIRCert,
shelleyTxCertDelegDecoder,
poolTxCertDecoder,
encodeShelleyDelegCert,
encodePoolCert,
encodeGenesisDelegCert,
shelleyTotalDepositsTxCerts,
shelleyTotalRefundsTxCerts,
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.Keys (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 EraTxCert ShelleyEra where
type TxCert ShelleyEra = ShelleyTxCert ShelleyEra
upgradeTxCert :: EraTxCert (PreviousEra ShelleyEra) =>
TxCert (PreviousEra ShelleyEra)
-> Either (TxCertUpgradeError ShelleyEra) (TxCert ShelleyEra)
upgradeTxCert = forall a. HasCallStack => [Char] -> a
error [Char]
"Byron does not have any TxCerts to upgrade with 'upgradeTxCert'"
getVKeyWitnessTxCert :: TxCert ShelleyEra -> Maybe (KeyHash 'Witness)
getVKeyWitnessTxCert = forall era. ShelleyTxCert era -> Maybe (KeyHash 'Witness)
getVKeyWitnessShelleyTxCert
getScriptWitnessTxCert :: TxCert ShelleyEra -> Maybe ScriptHash
getScriptWitnessTxCert = forall era. ShelleyTxCert era -> Maybe ScriptHash
getScriptWitnessShelleyTxCert
mkRegPoolTxCert :: PoolParams -> TxCert ShelleyEra
mkRegPoolTxCert = forall era. PoolCert -> ShelleyTxCert era
ShelleyTxCertPool forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoolParams -> PoolCert
RegPool
getRegPoolTxCert :: TxCert ShelleyEra -> Maybe PoolParams
getRegPoolTxCert (ShelleyTxCertPool (RegPool PoolParams
poolParams)) = forall a. a -> Maybe a
Just PoolParams
poolParams
getRegPoolTxCert TxCert ShelleyEra
_ = forall a. Maybe a
Nothing
mkRetirePoolTxCert :: KeyHash 'StakePool -> EpochNo -> TxCert ShelleyEra
mkRetirePoolTxCert KeyHash 'StakePool
poolId EpochNo
epochNo = forall era. PoolCert -> ShelleyTxCert era
ShelleyTxCertPool forall a b. (a -> b) -> a -> b
$ KeyHash 'StakePool -> EpochNo -> PoolCert
RetirePool KeyHash 'StakePool
poolId EpochNo
epochNo
getRetirePoolTxCert :: TxCert ShelleyEra -> Maybe (KeyHash 'StakePool, EpochNo)
getRetirePoolTxCert (ShelleyTxCertPool (RetirePool KeyHash 'StakePool
poolId EpochNo
epochNo)) = forall a. a -> Maybe a
Just (KeyHash 'StakePool
poolId, EpochNo
epochNo)
getRetirePoolTxCert TxCert ShelleyEra
_ = forall a. Maybe a
Nothing
lookupRegStakeTxCert :: TxCert ShelleyEra -> Maybe (Credential 'Staking)
lookupRegStakeTxCert = \case
RegTxCert Credential 'Staking
c -> forall a. a -> Maybe a
Just Credential 'Staking
c
TxCert ShelleyEra
_ -> forall a. Maybe a
Nothing
lookupUnRegStakeTxCert :: TxCert ShelleyEra -> Maybe (Credential 'Staking)
lookupUnRegStakeTxCert = \case
UnRegTxCert Credential 'Staking
c -> forall a. a -> Maybe a
Just Credential 'Staking
c
TxCert ShelleyEra
_ -> forall a. Maybe a
Nothing
getTotalDepositsTxCerts :: forall (f :: * -> *).
Foldable f =>
PParams ShelleyEra
-> (KeyHash 'StakePool -> Bool) -> f (TxCert ShelleyEra) -> Coin
getTotalDepositsTxCerts = forall era (f :: * -> *).
(EraPParams era, Foldable f, EraTxCert era) =>
PParams era
-> (KeyHash 'StakePool -> Bool) -> f (TxCert era) -> Coin
shelleyTotalDepositsTxCerts
getTotalRefundsTxCerts :: forall (f :: * -> *).
Foldable f =>
PParams ShelleyEra
-> (Credential 'Staking -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe Coin)
-> f (TxCert ShelleyEra)
-> Coin
getTotalRefundsTxCerts PParams ShelleyEra
pp Credential 'Staking -> Maybe Coin
lookupStakeDeposit Credential 'DRepRole -> Maybe Coin
_ = forall era (f :: * -> *).
(EraPParams era, Foldable f, EraTxCert era) =>
PParams era
-> (Credential 'Staking -> Maybe Coin) -> f (TxCert era) -> Coin
shelleyTotalRefundsTxCerts PParams ShelleyEra
pp Credential 'Staking -> Maybe Coin
lookupStakeDeposit
class EraTxCert era => ShelleyEraTxCert era where
mkRegTxCert :: StakeCredential -> TxCert era
getRegTxCert :: TxCert era -> Maybe StakeCredential
mkUnRegTxCert :: StakeCredential -> TxCert era
getUnRegTxCert :: TxCert era -> Maybe StakeCredential
mkDelegStakeTxCert :: StakeCredential -> KeyHash 'StakePool -> TxCert era
getDelegStakeTxCert :: TxCert era -> Maybe (StakeCredential, KeyHash 'StakePool)
mkGenesisDelegTxCert :: ProtVerAtMost era 8 => GenesisDelegCert -> TxCert era
getGenesisDelegTxCert :: ProtVerAtMost era 8 => TxCert era -> Maybe GenesisDelegCert
mkMirTxCert :: ProtVerAtMost era 8 => MIRCert -> TxCert era
getMirTxCert :: ProtVerAtMost era 8 => TxCert era -> Maybe MIRCert
instance ShelleyEraTxCert ShelleyEra where
mkRegTxCert :: Credential 'Staking -> TxCert ShelleyEra
mkRegTxCert = forall era. ShelleyDelegCert -> ShelleyTxCert era
ShelleyTxCertDelegCert forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential 'Staking -> ShelleyDelegCert
ShelleyRegCert
getRegTxCert :: TxCert ShelleyEra -> Maybe (Credential 'Staking)
getRegTxCert (ShelleyTxCertDelegCert (ShelleyRegCert Credential 'Staking
c)) = forall a. a -> Maybe a
Just Credential 'Staking
c
getRegTxCert TxCert ShelleyEra
_ = forall a. Maybe a
Nothing
mkUnRegTxCert :: Credential 'Staking -> TxCert ShelleyEra
mkUnRegTxCert = forall era. ShelleyDelegCert -> ShelleyTxCert era
ShelleyTxCertDelegCert forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential 'Staking -> ShelleyDelegCert
ShelleyUnRegCert
getUnRegTxCert :: TxCert ShelleyEra -> Maybe (Credential 'Staking)
getUnRegTxCert (ShelleyTxCertDelegCert (ShelleyUnRegCert Credential 'Staking
c)) = forall a. a -> Maybe a
Just Credential 'Staking
c
getUnRegTxCert TxCert ShelleyEra
_ = forall a. Maybe a
Nothing
mkDelegStakeTxCert :: Credential 'Staking -> KeyHash 'StakePool -> TxCert ShelleyEra
mkDelegStakeTxCert Credential 'Staking
c KeyHash 'StakePool
kh = forall era. ShelleyDelegCert -> ShelleyTxCert era
ShelleyTxCertDelegCert forall a b. (a -> b) -> a -> b
$ Credential 'Staking -> KeyHash 'StakePool -> ShelleyDelegCert
ShelleyDelegCert Credential 'Staking
c KeyHash 'StakePool
kh
getDelegStakeTxCert :: TxCert ShelleyEra
-> Maybe (Credential 'Staking, KeyHash 'StakePool)
getDelegStakeTxCert (ShelleyTxCertDelegCert (ShelleyDelegCert Credential 'Staking
c KeyHash 'StakePool
kh)) = forall a. a -> Maybe a
Just (Credential 'Staking
c, KeyHash 'StakePool
kh)
getDelegStakeTxCert TxCert ShelleyEra
_ = forall a. Maybe a
Nothing
mkGenesisDelegTxCert :: ProtVerAtMost ShelleyEra 8 => GenesisDelegCert -> TxCert ShelleyEra
mkGenesisDelegTxCert = forall era. GenesisDelegCert -> ShelleyTxCert era
ShelleyTxCertGenesisDeleg
getGenesisDelegTxCert :: ProtVerAtMost ShelleyEra 8 =>
TxCert ShelleyEra -> Maybe GenesisDelegCert
getGenesisDelegTxCert (ShelleyTxCertGenesisDeleg GenesisDelegCert
c) = forall a. a -> Maybe a
Just GenesisDelegCert
c
getGenesisDelegTxCert TxCert ShelleyEra
_ = forall a. Maybe a
Nothing
mkMirTxCert :: ProtVerAtMost ShelleyEra 8 => MIRCert -> TxCert ShelleyEra
mkMirTxCert = forall era. MIRCert -> ShelleyTxCert era
ShelleyTxCertMir
getMirTxCert :: ProtVerAtMost ShelleyEra 8 => TxCert ShelleyEra -> Maybe MIRCert
getMirTxCert (ShelleyTxCertMir MIRCert
c) = forall a. a -> Maybe a
Just MIRCert
c
getMirTxCert TxCert ShelleyEra
_ = forall a. Maybe a
Nothing
pattern RegTxCert :: ShelleyEraTxCert era => StakeCredential -> TxCert era
pattern $bRegTxCert :: forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> TxCert era
$mRegTxCert :: forall {r} {era}.
ShelleyEraTxCert era =>
TxCert era -> (Credential 'Staking -> r) -> ((# #) -> r) -> r
RegTxCert c <- (getRegTxCert -> Just c)
where
RegTxCert Credential 'Staking
c = forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> TxCert era
mkRegTxCert Credential 'Staking
c
pattern UnRegTxCert :: ShelleyEraTxCert era => StakeCredential -> TxCert era
pattern $bUnRegTxCert :: forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> TxCert era
$mUnRegTxCert :: forall {r} {era}.
ShelleyEraTxCert era =>
TxCert era -> (Credential 'Staking -> r) -> ((# #) -> r) -> r
UnRegTxCert c <- (getUnRegTxCert -> Just c)
where
UnRegTxCert Credential 'Staking
c = forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> TxCert era
mkUnRegTxCert Credential 'Staking
c
pattern DelegStakeTxCert ::
ShelleyEraTxCert era =>
StakeCredential ->
KeyHash 'StakePool ->
TxCert era
pattern $bDelegStakeTxCert :: forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> KeyHash 'StakePool -> TxCert era
$mDelegStakeTxCert :: forall {r} {era}.
ShelleyEraTxCert era =>
TxCert era
-> (Credential 'Staking -> KeyHash 'StakePool -> r)
-> ((# #) -> r)
-> r
DelegStakeTxCert c kh <- (getDelegStakeTxCert -> Just (c, kh))
where
DelegStakeTxCert Credential 'Staking
c KeyHash 'StakePool
kh = forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> KeyHash 'StakePool -> TxCert era
mkDelegStakeTxCert Credential 'Staking
c KeyHash 'StakePool
kh
pattern MirTxCert ::
(ShelleyEraTxCert era, ProtVerAtMost era 8) => MIRCert -> TxCert era
pattern $bMirTxCert :: forall era.
(ShelleyEraTxCert era, ProtVerAtMost era 8) =>
MIRCert -> TxCert era
$mMirTxCert :: forall {r} {era}.
(ShelleyEraTxCert era, ProtVerAtMost era 8) =>
TxCert era -> (MIRCert -> r) -> ((# #) -> r) -> r
MirTxCert d <- (getMirTxCert -> Just d)
where
MirTxCert MIRCert
d = forall era.
(ShelleyEraTxCert era, ProtVerAtMost era 8) =>
MIRCert -> TxCert era
mkMirTxCert MIRCert
d
pattern GenesisDelegTxCert ::
(ShelleyEraTxCert era, ProtVerAtMost era 8) =>
KeyHash 'Genesis ->
KeyHash 'GenesisDelegate ->
VRFVerKeyHash 'GenDelegVRF ->
TxCert era
pattern $bGenesisDelegTxCert :: forall era.
(ShelleyEraTxCert era, ProtVerAtMost era 8) =>
KeyHash 'Genesis
-> KeyHash 'GenesisDelegate
-> VRFVerKeyHash 'GenDelegVRF
-> TxCert era
$mGenesisDelegTxCert :: forall {r} {era}.
(ShelleyEraTxCert era, ProtVerAtMost era 8) =>
TxCert era
-> (KeyHash 'Genesis
-> KeyHash 'GenesisDelegate -> VRFVerKeyHash 'GenDelegVRF -> r)
-> ((# #) -> r)
-> r
GenesisDelegTxCert genKey genDelegKey vrfKeyHash <-
(getGenesisDelegTxCert -> Just (GenesisDelegCert genKey genDelegKey vrfKeyHash))
where
GenesisDelegTxCert KeyHash 'Genesis
genKey KeyHash 'GenesisDelegate
genDelegKey VRFVerKeyHash 'GenDelegVRF
vrfKeyHash =
forall era.
(ShelleyEraTxCert era, ProtVerAtMost era 8) =>
GenesisDelegCert -> TxCert era
mkGenesisDelegTxCert forall a b. (a -> b) -> a -> b
$ KeyHash 'Genesis
-> KeyHash 'GenesisDelegate
-> VRFVerKeyHash 'GenDelegVRF
-> GenesisDelegCert
GenesisDelegCert KeyHash 'Genesis
genKey KeyHash 'GenesisDelegate
genDelegKey VRFVerKeyHash 'GenDelegVRF
vrfKeyHash
{-# COMPLETE
RegPoolTxCert
, RetirePoolTxCert
, RegTxCert
, UnRegTxCert
, DelegStakeTxCert
, MirTxCert
, GenesisDelegTxCert
#-}
data GenesisDelegCert
= GenesisDelegCert
!(KeyHash 'Genesis)
!(KeyHash 'GenesisDelegate)
!(VRFVerKeyHash 'GenDelegVRF)
deriving (Int -> GenesisDelegCert -> ShowS
[GenesisDelegCert] -> ShowS
GenesisDelegCert -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [GenesisDelegCert] -> ShowS
$cshowList :: [GenesisDelegCert] -> ShowS
show :: GenesisDelegCert -> [Char]
$cshow :: GenesisDelegCert -> [Char]
showsPrec :: Int -> GenesisDelegCert -> ShowS
$cshowsPrec :: Int -> GenesisDelegCert -> ShowS
Show, forall x. Rep GenesisDelegCert x -> GenesisDelegCert
forall x. GenesisDelegCert -> Rep GenesisDelegCert x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GenesisDelegCert x -> GenesisDelegCert
$cfrom :: forall x. GenesisDelegCert -> Rep GenesisDelegCert x
Generic, GenesisDelegCert -> GenesisDelegCert -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenesisDelegCert -> GenesisDelegCert -> Bool
$c/= :: GenesisDelegCert -> GenesisDelegCert -> Bool
== :: GenesisDelegCert -> GenesisDelegCert -> Bool
$c== :: GenesisDelegCert -> GenesisDelegCert -> Bool
Eq, Eq GenesisDelegCert
GenesisDelegCert -> GenesisDelegCert -> Bool
GenesisDelegCert -> GenesisDelegCert -> Ordering
GenesisDelegCert -> GenesisDelegCert -> GenesisDelegCert
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GenesisDelegCert -> GenesisDelegCert -> GenesisDelegCert
$cmin :: GenesisDelegCert -> GenesisDelegCert -> GenesisDelegCert
max :: GenesisDelegCert -> GenesisDelegCert -> GenesisDelegCert
$cmax :: GenesisDelegCert -> GenesisDelegCert -> GenesisDelegCert
>= :: GenesisDelegCert -> GenesisDelegCert -> Bool
$c>= :: GenesisDelegCert -> GenesisDelegCert -> Bool
> :: GenesisDelegCert -> GenesisDelegCert -> Bool
$c> :: GenesisDelegCert -> GenesisDelegCert -> Bool
<= :: GenesisDelegCert -> GenesisDelegCert -> Bool
$c<= :: GenesisDelegCert -> GenesisDelegCert -> Bool
< :: GenesisDelegCert -> GenesisDelegCert -> Bool
$c< :: GenesisDelegCert -> GenesisDelegCert -> Bool
compare :: GenesisDelegCert -> GenesisDelegCert -> Ordering
$ccompare :: GenesisDelegCert -> GenesisDelegCert -> Ordering
Ord)
instance NoThunks GenesisDelegCert
instance NFData GenesisDelegCert where
rnf :: GenesisDelegCert -> ()
rnf = forall a. a -> ()
rwhnf
instance ToJSON GenesisDelegCert where
toJSON :: GenesisDelegCert -> Value
toJSON (GenesisDelegCert KeyHash 'Genesis
genKeyHash KeyHash 'GenesisDelegate
genDelegKeyHash VRFVerKeyHash 'GenDelegVRF
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
genKeyHash
, Key
"genDelegKeyHash" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON KeyHash 'GenesisDelegate
genDelegKeyHash
, Key
"hashVrf" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON VRFVerKeyHash 'GenDelegVRF
hashVrf
]
genesisKeyHashWitness :: GenesisDelegCert -> KeyHash 'Witness
genesisKeyHashWitness :: GenesisDelegCert -> KeyHash 'Witness
genesisKeyHashWitness (GenesisDelegCert KeyHash 'Genesis
gk KeyHash 'GenesisDelegate
_ VRFVerKeyHash 'GenDelegVRF
_) = forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyHash 'Genesis
gk
genesisCWitness :: GenesisDelegCert -> KeyHash 'Genesis
genesisCWitness :: GenesisDelegCert -> KeyHash 'Genesis
genesisCWitness (GenesisDelegCert KeyHash 'Genesis
gk KeyHash 'GenesisDelegate
_ VRFVerKeyHash 'GenDelegVRF
_) = KeyHash 'Genesis
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"
data MIRTarget
= StakeAddressesMIR !(Map (Credential 'Staking) DeltaCoin)
| SendToOppositePotMIR !Coin
deriving (Int -> MIRTarget -> ShowS
[MIRTarget] -> ShowS
MIRTarget -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [MIRTarget] -> ShowS
$cshowList :: [MIRTarget] -> ShowS
show :: MIRTarget -> [Char]
$cshow :: MIRTarget -> [Char]
showsPrec :: Int -> MIRTarget -> ShowS
$cshowsPrec :: Int -> MIRTarget -> ShowS
Show, forall x. Rep MIRTarget x -> MIRTarget
forall x. MIRTarget -> Rep MIRTarget x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MIRTarget x -> MIRTarget
$cfrom :: forall x. MIRTarget -> Rep MIRTarget x
Generic, MIRTarget -> MIRTarget -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MIRTarget -> MIRTarget -> Bool
$c/= :: MIRTarget -> MIRTarget -> Bool
== :: MIRTarget -> MIRTarget -> Bool
$c== :: MIRTarget -> MIRTarget -> Bool
Eq, Eq MIRTarget
MIRTarget -> MIRTarget -> Bool
MIRTarget -> MIRTarget -> Ordering
MIRTarget -> MIRTarget -> MIRTarget
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MIRTarget -> MIRTarget -> MIRTarget
$cmin :: MIRTarget -> MIRTarget -> MIRTarget
max :: MIRTarget -> MIRTarget -> MIRTarget
$cmax :: MIRTarget -> MIRTarget -> MIRTarget
>= :: MIRTarget -> MIRTarget -> Bool
$c>= :: MIRTarget -> MIRTarget -> Bool
> :: MIRTarget -> MIRTarget -> Bool
$c> :: MIRTarget -> MIRTarget -> Bool
<= :: MIRTarget -> MIRTarget -> Bool
$c<= :: MIRTarget -> MIRTarget -> Bool
< :: MIRTarget -> MIRTarget -> Bool
$c< :: MIRTarget -> MIRTarget -> Bool
compare :: MIRTarget -> MIRTarget -> Ordering
$ccompare :: MIRTarget -> MIRTarget -> Ordering
Ord, MIRTarget -> ()
forall a. (a -> ()) -> NFData a
rnf :: MIRTarget -> ()
$crnf :: MIRTarget -> ()
NFData)
deriving instance NoThunks MIRTarget
instance DecCBOR MIRTarget where
decCBOR :: forall s. Decoder s MIRTarget
decCBOR = do
forall s. Decoder s TokenType
peekTokenType forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
TokenType
TypeMapLen -> Map (Credential 'Staking) DeltaCoin -> MIRTarget
StakeAddressesMIR forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR
TokenType
TypeMapLen64 -> Map (Credential 'Staking) DeltaCoin -> MIRTarget
StakeAddressesMIR forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR
TokenType
TypeMapLenIndef -> Map (Credential 'Staking) DeltaCoin -> MIRTarget
StakeAddressesMIR forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR
TokenType
_ -> Coin -> MIRTarget
SendToOppositePotMIR forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR
instance EncCBOR MIRTarget where
encCBOR :: MIRTarget -> Encoding
encCBOR = \case
StakeAddressesMIR Map (Credential 'Staking) DeltaCoin
m -> forall a. EncCBOR a => a -> Encoding
encCBOR Map (Credential 'Staking) DeltaCoin
m
SendToOppositePotMIR Coin
c -> forall a. EncCBOR a => a -> Encoding
encCBOR Coin
c
instance ToJSON MIRTarget where
toJSON :: MIRTarget -> Value
toJSON = \case
StakeAddressesMIR Map (Credential 'Staking) DeltaCoin
mirAddresses ->
Text -> [Pair] -> Value
kindObject Text
"StakeAddressesMIR" [Key
"addresses" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON Map (Credential 'Staking) 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]
data MIRCert = MIRCert
{ MIRCert -> MIRPot
mirPot :: !MIRPot
, MIRCert -> MIRTarget
mirRewards :: !MIRTarget
}
deriving (Int -> MIRCert -> ShowS
[MIRCert] -> ShowS
MIRCert -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [MIRCert] -> ShowS
$cshowList :: [MIRCert] -> ShowS
show :: MIRCert -> [Char]
$cshow :: MIRCert -> [Char]
showsPrec :: Int -> MIRCert -> ShowS
$cshowsPrec :: Int -> MIRCert -> ShowS
Show, forall x. Rep MIRCert x -> MIRCert
forall x. MIRCert -> Rep MIRCert x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MIRCert x -> MIRCert
$cfrom :: forall x. MIRCert -> Rep MIRCert x
Generic, MIRCert -> MIRCert -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MIRCert -> MIRCert -> Bool
$c/= :: MIRCert -> MIRCert -> Bool
== :: MIRCert -> MIRCert -> Bool
$c== :: MIRCert -> MIRCert -> Bool
Eq, Eq MIRCert
MIRCert -> MIRCert -> Bool
MIRCert -> MIRCert -> Ordering
MIRCert -> MIRCert -> MIRCert
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MIRCert -> MIRCert -> MIRCert
$cmin :: MIRCert -> MIRCert -> MIRCert
max :: MIRCert -> MIRCert -> MIRCert
$cmax :: MIRCert -> MIRCert -> MIRCert
>= :: MIRCert -> MIRCert -> Bool
$c>= :: MIRCert -> MIRCert -> Bool
> :: MIRCert -> MIRCert -> Bool
$c> :: MIRCert -> MIRCert -> Bool
<= :: MIRCert -> MIRCert -> Bool
$c<= :: MIRCert -> MIRCert -> Bool
< :: MIRCert -> MIRCert -> Bool
$c< :: MIRCert -> MIRCert -> Bool
compare :: MIRCert -> MIRCert -> Ordering
$ccompare :: MIRCert -> MIRCert -> Ordering
Ord, MIRCert -> ()
forall a. (a -> ()) -> NFData a
rnf :: MIRCert -> ()
$crnf :: MIRCert -> ()
NFData)
instance NoThunks MIRCert
instance DecCBOR MIRCert where
decCBOR :: forall s. Decoder s MIRCert
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) (MIRPot -> MIRTarget -> MIRCert
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 EncCBOR MIRCert where
encCBOR :: MIRCert -> Encoding
encCBOR (MIRCert MIRPot
pot MIRTarget
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
targets
instance ToJSON MIRCert where
toJSON :: MIRCert -> Value
toJSON MIRCert {MIRPot
mirPot :: MIRPot
mirPot :: MIRCert -> MIRPot
mirPot, MIRTarget
mirRewards :: MIRTarget
mirRewards :: MIRCert -> MIRTarget
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
mirRewards
]
data ShelleyTxCert era
= ShelleyTxCertDelegCert !ShelleyDelegCert
| ShelleyTxCertPool !PoolCert
| ShelleyTxCertGenesisDeleg !GenesisDelegCert
| ShelleyTxCertMir !MIRCert
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
delegCert -> forall a. ToJSON a => a -> Value
toJSON ShelleyDelegCert
delegCert
ShelleyTxCertPool PoolCert
poolCert -> forall a. ToJSON a => a -> Value
toJSON PoolCert
poolCert
ShelleyTxCertGenesisDeleg GenesisDelegCert
genDelegCert -> forall a. ToJSON a => a -> Value
toJSON GenesisDelegCert
genDelegCert
ShelleyTxCertMir MIRCert
mirCert -> forall a. ToJSON a => a -> Value
toJSON MIRCert
mirCert
upgradeShelleyTxCert ::
ShelleyTxCert era1 ->
ShelleyTxCert era2
upgradeShelleyTxCert :: forall era1 era2. ShelleyTxCert era1 -> ShelleyTxCert era2
upgradeShelleyTxCert = \case
ShelleyTxCertDelegCert ShelleyDelegCert
cert -> forall era. ShelleyDelegCert -> ShelleyTxCert era
ShelleyTxCertDelegCert ShelleyDelegCert
cert
ShelleyTxCertPool PoolCert
cert -> forall era. PoolCert -> ShelleyTxCert era
ShelleyTxCertPool PoolCert
cert
ShelleyTxCertGenesisDeleg GenesisDelegCert
cert -> forall era. GenesisDelegCert -> ShelleyTxCert era
ShelleyTxCertGenesisDeleg GenesisDelegCert
cert
ShelleyTxCertMir MIRCert
cert -> forall era. MIRCert -> ShelleyTxCert era
ShelleyTxCertMir MIRCert
cert
instance Era era => EncCBOR (ShelleyTxCert era) where
encCBOR :: ShelleyTxCert era -> Encoding
encCBOR = \case
ShelleyTxCertDelegCert ShelleyDelegCert
delegCert -> ShelleyDelegCert -> Encoding
encodeShelleyDelegCert ShelleyDelegCert
delegCert
ShelleyTxCertPool PoolCert
poolCert -> PoolCert -> Encoding
encodePoolCert PoolCert
poolCert
ShelleyTxCertGenesisDeleg GenesisDelegCert
constCert -> GenesisDelegCert -> Encoding
encodeGenesisDelegCert GenesisDelegCert
constCert
ShelleyTxCertMir MIRCert
mir ->
Word -> Encoding
encodeListLen Word
2 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
mir
encodeShelleyDelegCert :: ShelleyDelegCert -> Encoding
encodeShelleyDelegCert :: ShelleyDelegCert -> Encoding
encodeShelleyDelegCert = \case
ShelleyRegCert Credential 'Staking
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 Credential 'Staking
cred
ShelleyUnRegCert Credential 'Staking
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 Credential 'Staking
cred
ShelleyDelegCert Credential 'Staking
cred KeyHash 'StakePool
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 Credential 'Staking
cred forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR KeyHash 'StakePool
poolId
encodePoolCert :: PoolCert -> Encoding
encodePoolCert :: PoolCert -> Encoding
encodePoolCert = \case
RegPool PoolParams
poolParams ->
Word -> Encoding
encodeListLen (Word
1 forall a. Num a => a -> a -> a
+ forall a. EncCBORGroup a => a -> Word
listLen PoolParams
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
poolParams
RetirePool KeyHash 'StakePool
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
vk
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR EpochNo
epoch
encodeGenesisDelegCert :: GenesisDelegCert -> Encoding
encodeGenesisDelegCert :: GenesisDelegCert -> Encoding
encodeGenesisDelegCert (GenesisDelegCert KeyHash 'Genesis
gk KeyHash 'GenesisDelegate
kh VRFVerKeyHash 'GenDelegVRF
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
gk
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR KeyHash 'GenesisDelegate
kh
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR VRFVerKeyHash 'GenDelegVRF
vrf
instance Era era => ToCBOR (ShelleyTxCert era) where
toCBOR :: ShelleyTxCert era -> Encoding
toCBOR = forall era t. (Era era, EncCBOR t) => t -> Encoding
toEraCBOR @era
instance
( ShelleyEraTxCert era
, TxCert era ~ ShelleyTxCert era
) =>
FromCBOR (ShelleyTxCert era)
where
fromCBOR :: forall s. Decoder s (ShelleyTxCert era)
fromCBOR = forall era t s. (Era era, DecCBOR t) => Decoder s t
fromEraCBOR @era
instance
( ShelleyEraTxCert era
, TxCert era ~ ShelleyTxCert era
) =>
DecCBOR (ShelleyTxCert era)
where
decCBOR :: forall s. Decoder s (ShelleyTxCert era)
decCBOR = 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
gen <- forall a s. DecCBOR a => Decoder s a
decCBOR
KeyHash 'GenesisDelegate
genDeleg <- forall a s. DecCBOR a => Decoder s a
decCBOR
VRFVerKeyHash 'GenDelegVRF
vrf <- forall a s. DecCBOR a => Decoder s a
decCBOR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
4, forall era. GenesisDelegCert -> ShelleyTxCert era
ShelleyTxCertGenesisDeleg forall a b. (a -> b) -> a -> b
$ KeyHash 'Genesis
-> KeyHash 'GenesisDelegate
-> VRFVerKeyHash 'GenDelegVRF
-> GenesisDelegCert
GenesisDelegCert KeyHash 'Genesis
gen KeyHash 'GenesisDelegate
genDeleg VRFVerKeyHash 'GenDelegVRF
vrf)
Word
6 -> do
MIRCert
x <- forall a s. DecCBOR a => Decoder s a
decCBOR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
2, forall era. MIRCert -> ShelleyTxCert era
ShelleyTxCertMir MIRCert
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
Credential 'Staking
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 =>
Credential 'Staking -> TxCert era
RegTxCert Credential 'Staking
cred)
Word
1 -> do
Credential 'Staking
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 =>
Credential 'Staking -> TxCert era
UnRegTxCert Credential 'Staking
cred)
Word
2 -> do
Credential 'Staking
cred <- forall a s. DecCBOR a => Decoder s a
decCBOR
KeyHash 'StakePool
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 =>
Credential 'Staking -> KeyHash 'StakePool -> TxCert era
DelegStakeTxCert Credential 'Staking
cred KeyHash 'StakePool
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
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
group, forall era. EraTxCert era => PoolParams -> TxCert era
RegPoolTxCert PoolParams
group)
Word
4 -> do
KeyHash 'StakePool
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 -> EpochNo -> TxCert era
RetirePoolTxCert KeyHash 'StakePool
a EpochNo
b)
Word
k -> forall (m :: * -> *) a. MonadFail m => Word -> m a
invalidKey Word
k
{-# INLINE poolTxCertDecoder #-}
data ShelleyDelegCert
=
ShelleyRegCert !StakeCredential
|
ShelleyUnRegCert !StakeCredential
|
ShelleyDelegCert !StakeCredential !(KeyHash 'StakePool)
deriving (Int -> ShelleyDelegCert -> ShowS
[ShelleyDelegCert] -> ShowS
ShelleyDelegCert -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ShelleyDelegCert] -> ShowS
$cshowList :: [ShelleyDelegCert] -> ShowS
show :: ShelleyDelegCert -> [Char]
$cshow :: ShelleyDelegCert -> [Char]
showsPrec :: Int -> ShelleyDelegCert -> ShowS
$cshowsPrec :: Int -> ShelleyDelegCert -> ShowS
Show, forall x. Rep ShelleyDelegCert x -> ShelleyDelegCert
forall x. ShelleyDelegCert -> Rep ShelleyDelegCert x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ShelleyDelegCert x -> ShelleyDelegCert
$cfrom :: forall x. ShelleyDelegCert -> Rep ShelleyDelegCert x
Generic, ShelleyDelegCert -> ShelleyDelegCert -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShelleyDelegCert -> ShelleyDelegCert -> Bool
$c/= :: ShelleyDelegCert -> ShelleyDelegCert -> Bool
== :: ShelleyDelegCert -> ShelleyDelegCert -> Bool
$c== :: ShelleyDelegCert -> ShelleyDelegCert -> Bool
Eq, Eq ShelleyDelegCert
ShelleyDelegCert -> ShelleyDelegCert -> Bool
ShelleyDelegCert -> ShelleyDelegCert -> Ordering
ShelleyDelegCert -> ShelleyDelegCert -> ShelleyDelegCert
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ShelleyDelegCert -> ShelleyDelegCert -> ShelleyDelegCert
$cmin :: ShelleyDelegCert -> ShelleyDelegCert -> ShelleyDelegCert
max :: ShelleyDelegCert -> ShelleyDelegCert -> ShelleyDelegCert
$cmax :: ShelleyDelegCert -> ShelleyDelegCert -> ShelleyDelegCert
>= :: ShelleyDelegCert -> ShelleyDelegCert -> Bool
$c>= :: ShelleyDelegCert -> ShelleyDelegCert -> Bool
> :: ShelleyDelegCert -> ShelleyDelegCert -> Bool
$c> :: ShelleyDelegCert -> ShelleyDelegCert -> Bool
<= :: ShelleyDelegCert -> ShelleyDelegCert -> Bool
$c<= :: ShelleyDelegCert -> ShelleyDelegCert -> Bool
< :: ShelleyDelegCert -> ShelleyDelegCert -> Bool
$c< :: ShelleyDelegCert -> ShelleyDelegCert -> Bool
compare :: ShelleyDelegCert -> ShelleyDelegCert -> Ordering
$ccompare :: ShelleyDelegCert -> ShelleyDelegCert -> Ordering
Ord)
instance ToJSON ShelleyDelegCert where
toJSON :: ShelleyDelegCert -> Value
toJSON = \case
ShelleyRegCert Credential 'Staking
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 Credential 'Staking
cred]
ShelleyUnRegCert Credential 'Staking
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 Credential 'Staking
cred]
ShelleyDelegCert Credential 'Staking
cred KeyHash 'StakePool
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 Credential 'Staking
cred
, Key
"poolId" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON KeyHash 'StakePool
poolId
]
instance NoThunks ShelleyDelegCert
instance NFData ShelleyDelegCert where
rnf :: ShelleyDelegCert -> ()
rnf = forall a. a -> ()
rwhnf
isDelegation :: ShelleyEraTxCert era => TxCert era -> Bool
isDelegation :: forall era. ShelleyEraTxCert era => TxCert era -> Bool
isDelegation (DelegStakeTxCert Credential 'Staking
_ KeyHash 'StakePool
_) = Bool
True
isDelegation TxCert era
_ = Bool
False
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
getGenesisDelegTxCert
isRegPool :: EraTxCert era => TxCert era -> Bool
isRegPool :: forall era. EraTxCert era => TxCert era -> Bool
isRegPool (RegPoolTxCert PoolParams
_) = Bool
True
isRegPool TxCert era
_ = Bool
False
isRetirePool :: EraTxCert era => TxCert era -> Bool
isRetirePool :: forall era. EraTxCert era => TxCert era -> Bool
isRetirePool (RetirePoolTxCert KeyHash 'StakePool
_ EpochNo
_) = Bool
True
isRetirePool TxCert era
_ = Bool
False
isInstantaneousRewards :: (ShelleyEraTxCert era, 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
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
getMirTxCert TxCert era
x of
Just (MIRCert MIRPot
ReservesMIR MIRTarget
_) -> Bool
True
Maybe MIRCert
_ -> 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
getMirTxCert TxCert era
x of
Just (MIRCert MIRPot
TreasuryMIR MIRTarget
_) -> Bool
True
Maybe MIRCert
_ -> Bool
False
getScriptWitnessShelleyTxCert ::
ShelleyTxCert era ->
Maybe ScriptHash
getScriptWitnessShelleyTxCert :: forall era. ShelleyTxCert era -> Maybe ScriptHash
getScriptWitnessShelleyTxCert = \case
ShelleyTxCertDelegCert ShelleyDelegCert
delegCert ->
case ShelleyDelegCert
delegCert of
ShelleyRegCert Credential 'Staking
_ -> forall a. Maybe a
Nothing
ShelleyUnRegCert Credential 'Staking
cred -> forall (kr :: KeyRole). Credential kr -> Maybe ScriptHash
credScriptHash Credential 'Staking
cred
ShelleyDelegCert Credential 'Staking
cred KeyHash 'StakePool
_ -> forall (kr :: KeyRole). Credential kr -> Maybe ScriptHash
credScriptHash Credential 'Staking
cred
ShelleyTxCert era
_ -> forall a. Maybe a
Nothing
getVKeyWitnessShelleyTxCert :: ShelleyTxCert era -> Maybe (KeyHash 'Witness)
getVKeyWitnessShelleyTxCert :: forall era. ShelleyTxCert era -> Maybe (KeyHash 'Witness)
getVKeyWitnessShelleyTxCert = \case
ShelleyTxCertDelegCert ShelleyDelegCert
delegCert ->
case ShelleyDelegCert
delegCert of
ShelleyRegCert Credential 'Staking
_ -> forall a. Maybe a
Nothing
ShelleyUnRegCert Credential 'Staking
cred -> forall (r :: KeyRole). Credential r -> Maybe (KeyHash 'Witness)
credKeyHashWitness Credential 'Staking
cred
ShelleyDelegCert Credential 'Staking
cred KeyHash 'StakePool
_ -> forall (r :: KeyRole). Credential r -> Maybe (KeyHash 'Witness)
credKeyHashWitness Credential 'Staking
cred
ShelleyTxCertPool PoolCert
poolCert -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ PoolCert -> KeyHash 'Witness
poolCertKeyHashWitness PoolCert
poolCert
ShelleyTxCertGenesisDeleg GenesisDelegCert
genesisCert -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ GenesisDelegCert -> KeyHash 'Witness
genesisKeyHashWitness GenesisDelegCert
genesisCert
ShelleyTxCertMir {} -> forall a. Maybe a
Nothing
shelleyTotalDepositsTxCerts ::
(EraPParams era, Foldable f, EraTxCert era) =>
PParams era ->
(KeyHash 'StakePool -> Bool) ->
f (TxCert era) ->
Coin
shelleyTotalDepositsTxCerts :: forall era (f :: * -> *).
(EraPParams era, Foldable f, EraTxCert era) =>
PParams era
-> (KeyHash 'StakePool -> Bool) -> f (TxCert era) -> Coin
shelleyTotalDepositsTxCerts PParams era
pp KeyHash 'StakePool -> Bool
isRegPoolRegistered f (TxCert era)
certs =
Int
numKeys
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) -> TxCert era -> Set (KeyHash 'StakePool)
addNewPoolIds forall a. Set a
Set.empty f (TxCert era)
certs)
addNewPoolIds :: Set (KeyHash 'StakePool) -> TxCert era -> Set (KeyHash 'StakePool)
addNewPoolIds Set (KeyHash 'StakePool)
regPoolIds = \case
RegPoolTxCert (PoolParams {KeyHash 'StakePool
ppId :: PoolParams -> KeyHash 'StakePool
ppId :: KeyHash 'StakePool
ppId})
| Bool -> Bool
not (KeyHash 'StakePool -> Bool
isRegPoolRegistered KeyHash 'StakePool
ppId Bool -> Bool -> Bool
|| forall a. Ord a => a -> Set a -> Bool
Set.member KeyHash 'StakePool
ppId Set (KeyHash 'StakePool)
regPoolIds) -> forall a. Ord a => a -> Set a -> Set a
Set.insert KeyHash 'StakePool
ppId Set (KeyHash 'StakePool)
regPoolIds
TxCert era
_ -> Set (KeyHash 'StakePool)
regPoolIds
shelleyTotalRefundsTxCerts ::
(EraPParams era, Foldable f, EraTxCert era) =>
PParams era ->
(StakeCredential -> Maybe Coin) ->
f (TxCert era) ->
Coin
shelleyTotalRefundsTxCerts :: forall era (f :: * -> *).
(EraPParams era, Foldable f, EraTxCert era) =>
PParams era
-> (Credential 'Staking -> Maybe Coin) -> f (TxCert era) -> Coin
shelleyTotalRefundsTxCerts PParams era
pp Credential 'Staking -> Maybe Coin
lookupDeposit = 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), Coin)
-> TxCert era -> (Set (Credential 'Staking), 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), Coin)
-> TxCert era -> (Set (Credential 'Staking), Coin)
accum (!Set (Credential 'Staking)
regCreds, !Coin
totalRefunds) TxCert era
cert =
case forall era.
EraTxCert era =>
TxCert era -> Maybe (Credential 'Staking)
lookupRegStakeTxCert TxCert era
cert of
Just Credential 'Staking
k ->
(forall a. Ord a => a -> Set a -> Set a
Set.insert Credential 'Staking
k Set (Credential 'Staking)
regCreds, Coin
totalRefunds)
Maybe (Credential 'Staking)
Nothing ->
case forall era.
EraTxCert era =>
TxCert era -> Maybe (Credential 'Staking)
lookupUnRegStakeTxCert TxCert era
cert of
Just Credential 'Staking
cred
| forall a. Ord a => a -> Set a -> Bool
Set.member Credential 'Staking
cred Set (Credential 'Staking)
regCreds -> (forall a. Ord a => a -> Set a -> Set a
Set.delete Credential 'Staking
cred Set (Credential 'Staking)
regCreds, Coin
totalRefunds forall t. Val t => t -> t -> t
<+> Coin
keyDeposit)
| Just Coin
deposit <- Credential 'Staking -> Maybe Coin
lookupDeposit Credential 'Staking
cred -> (Set (Credential 'Staking)
regCreds, Coin
totalRefunds forall t. Val t => t -> t -> t
<+> Coin
deposit)
Maybe (Credential 'Staking)
_ -> (Set (Credential 'Staking)
regCreds, Coin
totalRefunds)