{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
module Shelley.Spec.Ledger.Delegation.Certificates
( DCert (..),
DelegCert (..),
PoolCert (..),
GenesisDelegCert (..),
MIRCert (..),
StakeCreds (..),
PoolDistr (..),
IndividualPoolStake (..),
delegCWitness,
poolCWitness,
genesisCWitness,
isRegKey,
isDeRegKey,
isDelegation,
isGenesisDelegation,
isRegPool,
isRetirePool,
isInstantaneousRewards,
isReservesMIRCert,
isTreasuryMIRCert,
requiresVKeyWitness,
)
where
import Cardano.Binary (FromCBOR (..), ToCBOR (..), encodeListLen)
import qualified Cardano.Ledger.Crypto as CC
import qualified Cardano.Ledger.Era as ERA
import Control.DeepSeq (NFData)
import Control.Iterate.SetAlgebra
( BaseRep (MapR),
Embed (..),
Exp (Base),
HasExp (toExp),
)
import Data.Map.Strict (Map)
import Data.Relation (Relation (..))
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks (..))
import Shelley.Spec.Ledger.Credential (Credential (..))
import Shelley.Spec.Ledger.Keys (Hash, KeyHash, KeyRole (..), VerKeyVRF)
import Shelley.Spec.Ledger.Serialization (decodeRecordNamed)
import Shelley.Spec.Ledger.TxBody
( DCert (..),
DelegCert (..),
Delegation (..),
GenesisDelegCert (..),
MIRCert (..),
MIRPot (..),
PoolCert (..),
PoolParams (..),
StakeCreds (..),
)
instance
HasExp
(PoolDistr crypto)
( Map
(KeyHash 'StakePool crypto)
(IndividualPoolStake crypto)
)
where
toExp :: PoolDistr crypto
-> Exp
(Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto))
toExp (PoolDistr Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto)
x) = BaseRep
Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto)
-> Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto)
-> Exp
(Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto))
forall k (f :: * -> * -> *) v.
(Ord k, Basic f) =>
BaseRep f k v -> f k v -> Exp (f k v)
Base BaseRep
Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto)
forall k v. Basic Map => BaseRep Map k v
MapR Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto)
x
instance
Embed
(PoolDistr crypto)
( Map
(KeyHash 'StakePool crypto)
(IndividualPoolStake crypto)
)
where
toBase :: PoolDistr crypto
-> Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto)
toBase (PoolDistr Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto)
x) = Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto)
x
fromBase :: Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto)
-> PoolDistr crypto
fromBase Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto)
x = (Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto)
-> PoolDistr crypto
forall crypto.
Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto)
-> PoolDistr crypto
PoolDistr Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto)
x)
delegCWitness :: DelegCert era -> Credential 'Staking era
delegCWitness :: DelegCert era -> Credential 'Staking era
delegCWitness (RegKey Credential 'Staking era
_) = [Char] -> Credential 'Staking era
forall a. HasCallStack => [Char] -> a
error [Char]
"no witness in key registration certificate"
delegCWitness (DeRegKey Credential 'Staking era
hk) = Credential 'Staking era
hk
delegCWitness (Delegate Delegation era
delegation) = Delegation era -> Credential 'Staking era
forall era. Delegation era -> StakeCredential era
_delegator Delegation era
delegation
poolCWitness :: PoolCert era -> Credential 'StakePool era
poolCWitness :: PoolCert era -> Credential 'StakePool era
poolCWitness (RegPool PoolParams era
pool) = KeyHash 'StakePool (Crypto era) -> Credential 'StakePool era
forall (kr :: KeyRole) era.
KeyHash kr (Crypto era) -> Credential kr era
KeyHashObj (KeyHash 'StakePool (Crypto era) -> Credential 'StakePool era)
-> KeyHash 'StakePool (Crypto era) -> Credential 'StakePool era
forall a b. (a -> b) -> a -> b
$ PoolParams era -> KeyHash 'StakePool (Crypto era)
forall era. PoolParams era -> KeyHash 'StakePool (Crypto era)
_poolId PoolParams era
pool
poolCWitness (RetirePool KeyHash 'StakePool (Crypto era)
k EpochNo
_) = KeyHash 'StakePool (Crypto era) -> Credential 'StakePool era
forall (kr :: KeyRole) era.
KeyHash kr (Crypto era) -> Credential kr era
KeyHashObj KeyHash 'StakePool (Crypto era)
k
genesisCWitness :: GenesisDelegCert era -> KeyHash 'Genesis (ERA.Crypto era)
genesisCWitness :: GenesisDelegCert era -> KeyHash 'Genesis (Crypto era)
genesisCWitness (GenesisDelegCert KeyHash 'Genesis (Crypto era)
gk KeyHash 'GenesisDelegate (Crypto era)
_ Hash (Crypto era) (VerKeyVRF (Crypto era))
_) = KeyHash 'Genesis (Crypto era)
gk
isRegKey :: DCert era -> Bool
isRegKey :: DCert era -> Bool
isRegKey (DCertDeleg (RegKey StakeCredential era
_)) = Bool
True
isRegKey DCert era
_ = Bool
False
isDeRegKey :: DCert era -> Bool
isDeRegKey :: DCert era -> Bool
isDeRegKey (DCertDeleg (DeRegKey StakeCredential era
_)) = Bool
True
isDeRegKey DCert era
_ = Bool
False
isDelegation :: DCert era -> Bool
isDelegation :: DCert era -> Bool
isDelegation (DCertDeleg (Delegate Delegation era
_)) = Bool
True
isDelegation DCert era
_ = Bool
False
isGenesisDelegation :: DCert era -> Bool
isGenesisDelegation :: DCert era -> Bool
isGenesisDelegation (DCertGenesis (GenesisDelegCert {})) = Bool
True
isGenesisDelegation DCert era
_ = Bool
False
isRegPool :: DCert era -> Bool
isRegPool :: DCert era -> Bool
isRegPool (DCertPool (RegPool PoolParams era
_)) = Bool
True
isRegPool DCert era
_ = Bool
False
isRetirePool :: DCert era -> Bool
isRetirePool :: DCert era -> Bool
isRetirePool (DCertPool (RetirePool KeyHash 'StakePool (Crypto era)
_ EpochNo
_)) = Bool
True
isRetirePool DCert era
_ = Bool
False
newtype PoolDistr crypto = PoolDistr
{ PoolDistr crypto
-> Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto)
unPoolDistr ::
Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto)
}
deriving stock (Int -> PoolDistr crypto -> ShowS
[PoolDistr crypto] -> ShowS
PoolDistr crypto -> [Char]
(Int -> PoolDistr crypto -> ShowS)
-> (PoolDistr crypto -> [Char])
-> ([PoolDistr crypto] -> ShowS)
-> Show (PoolDistr crypto)
forall crypto. Int -> PoolDistr crypto -> ShowS
forall crypto. [PoolDistr crypto] -> ShowS
forall crypto. PoolDistr crypto -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PoolDistr crypto] -> ShowS
$cshowList :: forall crypto. [PoolDistr crypto] -> ShowS
show :: PoolDistr crypto -> [Char]
$cshow :: forall crypto. PoolDistr crypto -> [Char]
showsPrec :: Int -> PoolDistr crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> PoolDistr crypto -> ShowS
Show, PoolDistr crypto -> PoolDistr crypto -> Bool
(PoolDistr crypto -> PoolDistr crypto -> Bool)
-> (PoolDistr crypto -> PoolDistr crypto -> Bool)
-> Eq (PoolDistr crypto)
forall crypto. PoolDistr crypto -> PoolDistr crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PoolDistr crypto -> PoolDistr crypto -> Bool
$c/= :: forall crypto. PoolDistr crypto -> PoolDistr crypto -> Bool
== :: PoolDistr crypto -> PoolDistr crypto -> Bool
$c== :: forall crypto. PoolDistr crypto -> PoolDistr crypto -> Bool
Eq)
deriving newtype (Typeable (PoolDistr crypto)
Typeable (PoolDistr crypto)
-> (PoolDistr crypto -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (PoolDistr crypto) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PoolDistr crypto] -> Size)
-> ToCBOR (PoolDistr crypto)
PoolDistr crypto -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PoolDistr crypto] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (PoolDistr crypto) -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
forall crypto. Crypto crypto => Typeable (PoolDistr crypto)
forall crypto. Crypto crypto => PoolDistr crypto -> Encoding
forall crypto.
Crypto crypto =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PoolDistr crypto] -> Size
forall crypto.
Crypto crypto =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (PoolDistr crypto) -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PoolDistr crypto] -> Size
$cencodedListSizeExpr :: forall crypto.
Crypto crypto =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PoolDistr crypto] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (PoolDistr crypto) -> Size
$cencodedSizeExpr :: forall crypto.
Crypto crypto =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (PoolDistr crypto) -> Size
toCBOR :: PoolDistr crypto -> Encoding
$ctoCBOR :: forall crypto. Crypto crypto => PoolDistr crypto -> Encoding
$cp1ToCBOR :: forall crypto. Crypto crypto => Typeable (PoolDistr crypto)
ToCBOR, Typeable (PoolDistr crypto)
Decoder s (PoolDistr crypto)
Typeable (PoolDistr crypto)
-> (forall s. Decoder s (PoolDistr crypto))
-> (Proxy (PoolDistr crypto) -> Text)
-> FromCBOR (PoolDistr crypto)
Proxy (PoolDistr crypto) -> Text
forall s. Decoder s (PoolDistr crypto)
forall a.
Typeable a
-> (forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
forall crypto. Crypto crypto => Typeable (PoolDistr crypto)
forall crypto. Crypto crypto => Proxy (PoolDistr crypto) -> Text
forall crypto s. Crypto crypto => Decoder s (PoolDistr crypto)
label :: Proxy (PoolDistr crypto) -> Text
$clabel :: forall crypto. Crypto crypto => Proxy (PoolDistr crypto) -> Text
fromCBOR :: Decoder s (PoolDistr crypto)
$cfromCBOR :: forall crypto s. Crypto crypto => Decoder s (PoolDistr crypto)
$cp1FromCBOR :: forall crypto. Crypto crypto => Typeable (PoolDistr crypto)
FromCBOR, PoolDistr crypto -> ()
(PoolDistr crypto -> ()) -> NFData (PoolDistr crypto)
forall crypto. PoolDistr crypto -> ()
forall a. (a -> ()) -> NFData a
rnf :: PoolDistr crypto -> ()
$crnf :: forall crypto. PoolDistr crypto -> ()
NFData, Context -> PoolDistr crypto -> IO (Maybe ThunkInfo)
Proxy (PoolDistr crypto) -> [Char]
(Context -> PoolDistr crypto -> IO (Maybe ThunkInfo))
-> (Context -> PoolDistr crypto -> IO (Maybe ThunkInfo))
-> (Proxy (PoolDistr crypto) -> [Char])
-> NoThunks (PoolDistr crypto)
forall crypto. Context -> PoolDistr crypto -> IO (Maybe ThunkInfo)
forall crypto. Proxy (PoolDistr crypto) -> [Char]
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> [Char])
-> NoThunks a
showTypeOf :: Proxy (PoolDistr crypto) -> [Char]
$cshowTypeOf :: forall crypto. Proxy (PoolDistr crypto) -> [Char]
wNoThunks :: Context -> PoolDistr crypto -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall crypto. Context -> PoolDistr crypto -> IO (Maybe ThunkInfo)
noThunks :: Context -> PoolDistr crypto -> IO (Maybe ThunkInfo)
$cnoThunks :: forall crypto. Context -> PoolDistr crypto -> IO (Maybe ThunkInfo)
NoThunks, Ord (Range (PoolDistr crypto)) =>
PoolDistr crypto -> Set (Range (PoolDistr crypto))
Ord (Range (PoolDistr crypto)) =>
PoolDistr crypto
-> Set (Range (PoolDistr crypto)) -> PoolDistr crypto
(Ord (Domain (PoolDistr crypto)),
Ord (Range (PoolDistr crypto))) =>
Domain (PoolDistr crypto)
-> Range (PoolDistr crypto) -> PoolDistr crypto -> PoolDistr crypto
(Ord (Domain (PoolDistr crypto)),
Ord (Range (PoolDistr crypto))) =>
PoolDistr crypto -> PoolDistr crypto -> PoolDistr crypto
Ord (Domain (PoolDistr crypto)) =>
Set (Domain (PoolDistr crypto))
-> PoolDistr crypto -> PoolDistr crypto
Ord (Domain (PoolDistr crypto)) =>
Domain (PoolDistr crypto) -> PoolDistr crypto -> Bool
Ord (Domain (PoolDistr crypto)) =>
Domain (PoolDistr crypto) -> PoolDistr crypto -> PoolDistr crypto
Ord (Domain (PoolDistr crypto)) =>
PoolDistr crypto -> Set (Domain (PoolDistr crypto))
Set (Domain (PoolDistr crypto))
-> PoolDistr crypto -> PoolDistr crypto
Domain (PoolDistr crypto)
-> Range (PoolDistr crypto) -> PoolDistr crypto
Domain (PoolDistr crypto)
-> Range (PoolDistr crypto) -> PoolDistr crypto -> PoolDistr crypto
Domain (PoolDistr crypto) -> PoolDistr crypto -> Bool
Domain (PoolDistr crypto) -> PoolDistr crypto -> PoolDistr crypto
PoolDistr crypto -> n
PoolDistr crypto -> Set (Range (PoolDistr crypto))
PoolDistr crypto -> Set (Domain (PoolDistr crypto))
PoolDistr crypto
-> Set (Range (PoolDistr crypto)) -> PoolDistr crypto
PoolDistr crypto -> PoolDistr crypto -> PoolDistr crypto
(Domain (PoolDistr crypto)
-> Range (PoolDistr crypto) -> PoolDistr crypto)
-> (Ord (Domain (PoolDistr crypto)) =>
PoolDistr crypto -> Set (Domain (PoolDistr crypto)))
-> (Ord (Range (PoolDistr crypto)) =>
PoolDistr crypto -> Set (Range (PoolDistr crypto)))
-> (Ord (Domain (PoolDistr crypto)) =>
Set (Domain (PoolDistr crypto))
-> PoolDistr crypto -> PoolDistr crypto)
-> (Ord (Domain (PoolDistr crypto)) =>
Set (Domain (PoolDistr crypto))
-> PoolDistr crypto -> PoolDistr crypto)
-> (Ord (Domain (PoolDistr crypto)) =>
Set (Domain (PoolDistr crypto))
-> PoolDistr crypto -> PoolDistr crypto)
-> (Ord (Domain (PoolDistr crypto)) =>
Set (Domain (PoolDistr crypto))
-> PoolDistr crypto -> PoolDistr crypto)
-> (Ord (Range (PoolDistr crypto)) =>
PoolDistr crypto
-> Set (Range (PoolDistr crypto)) -> PoolDistr crypto)
-> (Ord (Range (PoolDistr crypto)) =>
PoolDistr crypto
-> Set (Range (PoolDistr crypto)) -> PoolDistr crypto)
-> (Ord (Range (PoolDistr crypto)) =>
PoolDistr crypto
-> Set (Range (PoolDistr crypto)) -> PoolDistr crypto)
-> (Ord (Range (PoolDistr crypto)) =>
PoolDistr crypto
-> Set (Range (PoolDistr crypto)) -> PoolDistr crypto)
-> ((Ord (Domain (PoolDistr crypto)),
Ord (Range (PoolDistr crypto))) =>
PoolDistr crypto -> PoolDistr crypto -> PoolDistr crypto)
-> ((Ord (Domain (PoolDistr crypto)),
Ord (Range (PoolDistr crypto))) =>
PoolDistr crypto -> PoolDistr crypto -> PoolDistr crypto)
-> (forall n. Integral n => PoolDistr crypto -> n)
-> (Ord (Domain (PoolDistr crypto)) =>
Domain (PoolDistr crypto) -> PoolDistr crypto -> Bool)
-> ((Ord (Domain (PoolDistr crypto)),
Ord (Range (PoolDistr crypto))) =>
Domain (PoolDistr crypto)
-> Range (PoolDistr crypto)
-> PoolDistr crypto
-> PoolDistr crypto)
-> (Ord (Domain (PoolDistr crypto)) =>
Domain (PoolDistr crypto) -> PoolDistr crypto -> PoolDistr crypto)
-> Relation (PoolDistr crypto)
forall n. Integral n => PoolDistr crypto -> n
forall crypto.
Ord (Range (PoolDistr crypto)) =>
PoolDistr crypto -> Set (Range (PoolDistr crypto))
forall crypto.
Ord (Range (PoolDistr crypto)) =>
PoolDistr crypto
-> Set (Range (PoolDistr crypto)) -> PoolDistr crypto
forall crypto.
(Ord (Domain (PoolDistr crypto)),
Ord (Range (PoolDistr crypto))) =>
Domain (PoolDistr crypto)
-> Range (PoolDistr crypto) -> PoolDistr crypto -> PoolDistr crypto
forall crypto.
(Ord (Domain (PoolDistr crypto)),
Ord (Range (PoolDistr crypto))) =>
PoolDistr crypto -> PoolDistr crypto -> PoolDistr crypto
forall crypto.
Ord (Domain (PoolDistr crypto)) =>
Set (Domain (PoolDistr crypto))
-> PoolDistr crypto -> PoolDistr crypto
forall crypto.
Ord (Domain (PoolDistr crypto)) =>
Domain (PoolDistr crypto) -> PoolDistr crypto -> Bool
forall crypto.
Ord (Domain (PoolDistr crypto)) =>
Domain (PoolDistr crypto) -> PoolDistr crypto -> PoolDistr crypto
forall crypto.
Ord (Domain (PoolDistr crypto)) =>
PoolDistr crypto -> Set (Domain (PoolDistr crypto))
forall crypto.
Domain (PoolDistr crypto)
-> Range (PoolDistr crypto) -> PoolDistr crypto
forall m.
(Domain m -> Range m -> m)
-> (Ord (Domain m) => m -> Set (Domain m))
-> (Ord (Range m) => m -> Set (Range m))
-> (Ord (Domain m) => Set (Domain m) -> m -> m)
-> (Ord (Domain m) => Set (Domain m) -> m -> m)
-> (Ord (Domain m) => Set (Domain m) -> m -> m)
-> (Ord (Domain m) => Set (Domain m) -> m -> m)
-> (Ord (Range m) => m -> Set (Range m) -> m)
-> (Ord (Range m) => m -> Set (Range m) -> m)
-> (Ord (Range m) => m -> Set (Range m) -> m)
-> (Ord (Range m) => m -> Set (Range m) -> m)
-> ((Ord (Domain m), Ord (Range m)) => m -> m -> m)
-> ((Ord (Domain m), Ord (Range m)) => m -> m -> m)
-> (forall n. Integral n => m -> n)
-> (Ord (Domain m) => Domain m -> m -> Bool)
-> ((Ord (Domain m), Ord (Range m)) =>
Domain m -> Range m -> m -> m)
-> (Ord (Domain m) => Domain m -> m -> m)
-> Relation m
forall crypto n. Integral n => PoolDistr crypto -> n
removekey :: Domain (PoolDistr crypto) -> PoolDistr crypto -> PoolDistr crypto
$cremovekey :: forall crypto.
Ord (Domain (PoolDistr crypto)) =>
Domain (PoolDistr crypto) -> PoolDistr crypto -> PoolDistr crypto
addpair :: Domain (PoolDistr crypto)
-> Range (PoolDistr crypto) -> PoolDistr crypto -> PoolDistr crypto
$caddpair :: forall crypto.
(Ord (Domain (PoolDistr crypto)),
Ord (Range (PoolDistr crypto))) =>
Domain (PoolDistr crypto)
-> Range (PoolDistr crypto) -> PoolDistr crypto -> PoolDistr crypto
haskey :: Domain (PoolDistr crypto) -> PoolDistr crypto -> Bool
$chaskey :: forall crypto.
Ord (Domain (PoolDistr crypto)) =>
Domain (PoolDistr crypto) -> PoolDistr crypto -> Bool
size :: PoolDistr crypto -> n
$csize :: forall crypto n. Integral n => PoolDistr crypto -> n
⨃ :: PoolDistr crypto -> PoolDistr crypto -> PoolDistr crypto
$c⨃ :: forall crypto.
(Ord (Domain (PoolDistr crypto)),
Ord (Range (PoolDistr crypto))) =>
PoolDistr crypto -> PoolDistr crypto -> PoolDistr crypto
∪ :: PoolDistr crypto -> PoolDistr crypto -> PoolDistr crypto
$c∪ :: forall crypto.
(Ord (Domain (PoolDistr crypto)),
Ord (Range (PoolDistr crypto))) =>
PoolDistr crypto -> PoolDistr crypto -> PoolDistr crypto
|/> :: PoolDistr crypto
-> Set (Range (PoolDistr crypto)) -> PoolDistr crypto
$c|/> :: forall crypto.
Ord (Range (PoolDistr crypto)) =>
PoolDistr crypto
-> Set (Range (PoolDistr crypto)) -> PoolDistr crypto
⋫ :: PoolDistr crypto
-> Set (Range (PoolDistr crypto)) -> PoolDistr crypto
$c⋫ :: forall crypto.
Ord (Range (PoolDistr crypto)) =>
PoolDistr crypto
-> Set (Range (PoolDistr crypto)) -> PoolDistr crypto
|> :: PoolDistr crypto
-> Set (Range (PoolDistr crypto)) -> PoolDistr crypto
$c|> :: forall crypto.
Ord (Range (PoolDistr crypto)) =>
PoolDistr crypto
-> Set (Range (PoolDistr crypto)) -> PoolDistr crypto
▷ :: PoolDistr crypto
-> Set (Range (PoolDistr crypto)) -> PoolDistr crypto
$c▷ :: forall crypto.
Ord (Range (PoolDistr crypto)) =>
PoolDistr crypto
-> Set (Range (PoolDistr crypto)) -> PoolDistr crypto
</| :: Set (Domain (PoolDistr crypto))
-> PoolDistr crypto -> PoolDistr crypto
$c</| :: forall crypto.
Ord (Domain (PoolDistr crypto)) =>
Set (Domain (PoolDistr crypto))
-> PoolDistr crypto -> PoolDistr crypto
⋪ :: Set (Domain (PoolDistr crypto))
-> PoolDistr crypto -> PoolDistr crypto
$c⋪ :: forall crypto.
Ord (Domain (PoolDistr crypto)) =>
Set (Domain (PoolDistr crypto))
-> PoolDistr crypto -> PoolDistr crypto
<| :: Set (Domain (PoolDistr crypto))
-> PoolDistr crypto -> PoolDistr crypto
$c<| :: forall crypto.
Ord (Domain (PoolDistr crypto)) =>
Set (Domain (PoolDistr crypto))
-> PoolDistr crypto -> PoolDistr crypto
◁ :: Set (Domain (PoolDistr crypto))
-> PoolDistr crypto -> PoolDistr crypto
$c◁ :: forall crypto.
Ord (Domain (PoolDistr crypto)) =>
Set (Domain (PoolDistr crypto))
-> PoolDistr crypto -> PoolDistr crypto
range :: PoolDistr crypto -> Set (Range (PoolDistr crypto))
$crange :: forall crypto.
Ord (Range (PoolDistr crypto)) =>
PoolDistr crypto -> Set (Range (PoolDistr crypto))
dom :: PoolDistr crypto -> Set (Domain (PoolDistr crypto))
$cdom :: forall crypto.
Ord (Domain (PoolDistr crypto)) =>
PoolDistr crypto -> Set (Domain (PoolDistr crypto))
singleton :: Domain (PoolDistr crypto)
-> Range (PoolDistr crypto) -> PoolDistr crypto
$csingleton :: forall crypto.
Domain (PoolDistr crypto)
-> Range (PoolDistr crypto) -> PoolDistr crypto
Relation)
data IndividualPoolStake crypto = IndividualPoolStake
{ IndividualPoolStake crypto -> Rational
individualPoolStake :: !Rational,
IndividualPoolStake crypto -> Hash crypto (VerKeyVRF crypto)
individualPoolStakeVrf :: !(Hash crypto (VerKeyVRF crypto))
}
deriving stock (Int -> IndividualPoolStake crypto -> ShowS
[IndividualPoolStake crypto] -> ShowS
IndividualPoolStake crypto -> [Char]
(Int -> IndividualPoolStake crypto -> ShowS)
-> (IndividualPoolStake crypto -> [Char])
-> ([IndividualPoolStake crypto] -> ShowS)
-> Show (IndividualPoolStake crypto)
forall crypto. Int -> IndividualPoolStake crypto -> ShowS
forall crypto. [IndividualPoolStake crypto] -> ShowS
forall crypto. IndividualPoolStake crypto -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [IndividualPoolStake crypto] -> ShowS
$cshowList :: forall crypto. [IndividualPoolStake crypto] -> ShowS
show :: IndividualPoolStake crypto -> [Char]
$cshow :: forall crypto. IndividualPoolStake crypto -> [Char]
showsPrec :: Int -> IndividualPoolStake crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> IndividualPoolStake crypto -> ShowS
Show, IndividualPoolStake crypto -> IndividualPoolStake crypto -> Bool
(IndividualPoolStake crypto -> IndividualPoolStake crypto -> Bool)
-> (IndividualPoolStake crypto
-> IndividualPoolStake crypto -> Bool)
-> Eq (IndividualPoolStake crypto)
forall crypto.
IndividualPoolStake crypto -> IndividualPoolStake crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndividualPoolStake crypto -> IndividualPoolStake crypto -> Bool
$c/= :: forall crypto.
IndividualPoolStake crypto -> IndividualPoolStake crypto -> Bool
== :: IndividualPoolStake crypto -> IndividualPoolStake crypto -> Bool
$c== :: forall crypto.
IndividualPoolStake crypto -> IndividualPoolStake crypto -> Bool
Eq, (forall x.
IndividualPoolStake crypto -> Rep (IndividualPoolStake crypto) x)
-> (forall x.
Rep (IndividualPoolStake crypto) x -> IndividualPoolStake crypto)
-> Generic (IndividualPoolStake crypto)
forall x.
Rep (IndividualPoolStake crypto) x -> IndividualPoolStake crypto
forall x.
IndividualPoolStake crypto -> Rep (IndividualPoolStake crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x.
Rep (IndividualPoolStake crypto) x -> IndividualPoolStake crypto
forall crypto x.
IndividualPoolStake crypto -> Rep (IndividualPoolStake crypto) x
$cto :: forall crypto x.
Rep (IndividualPoolStake crypto) x -> IndividualPoolStake crypto
$cfrom :: forall crypto x.
IndividualPoolStake crypto -> Rep (IndividualPoolStake crypto) x
Generic)
deriving anyclass (IndividualPoolStake crypto -> ()
(IndividualPoolStake crypto -> ())
-> NFData (IndividualPoolStake crypto)
forall crypto. IndividualPoolStake crypto -> ()
forall a. (a -> ()) -> NFData a
rnf :: IndividualPoolStake crypto -> ()
$crnf :: forall crypto. IndividualPoolStake crypto -> ()
NFData, Context -> IndividualPoolStake crypto -> IO (Maybe ThunkInfo)
Proxy (IndividualPoolStake crypto) -> [Char]
(Context -> IndividualPoolStake crypto -> IO (Maybe ThunkInfo))
-> (Context -> IndividualPoolStake crypto -> IO (Maybe ThunkInfo))
-> (Proxy (IndividualPoolStake crypto) -> [Char])
-> NoThunks (IndividualPoolStake crypto)
forall crypto.
Context -> IndividualPoolStake crypto -> IO (Maybe ThunkInfo)
forall crypto. Proxy (IndividualPoolStake crypto) -> [Char]
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> [Char])
-> NoThunks a
showTypeOf :: Proxy (IndividualPoolStake crypto) -> [Char]
$cshowTypeOf :: forall crypto. Proxy (IndividualPoolStake crypto) -> [Char]
wNoThunks :: Context -> IndividualPoolStake crypto -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall crypto.
Context -> IndividualPoolStake crypto -> IO (Maybe ThunkInfo)
noThunks :: Context -> IndividualPoolStake crypto -> IO (Maybe ThunkInfo)
$cnoThunks :: forall crypto.
Context -> IndividualPoolStake crypto -> IO (Maybe ThunkInfo)
NoThunks)
instance CC.Crypto crypto => ToCBOR (IndividualPoolStake crypto) where
toCBOR :: IndividualPoolStake crypto -> Encoding
toCBOR (IndividualPoolStake Rational
stake Hash crypto (VerKeyVRF crypto)
vrf) =
[Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat
[ Word -> Encoding
encodeListLen Word
2,
Rational -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Rational
stake,
Hash crypto (VerKeyVRF crypto) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Hash crypto (VerKeyVRF crypto)
vrf
]
instance CC.Crypto crypto => FromCBOR (IndividualPoolStake crypto) where
fromCBOR :: Decoder s (IndividualPoolStake crypto)
fromCBOR =
Text
-> (IndividualPoolStake crypto -> Int)
-> Decoder s (IndividualPoolStake crypto)
-> Decoder s (IndividualPoolStake crypto)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"IndividualPoolStake" (Int -> IndividualPoolStake crypto -> Int
forall a b. a -> b -> a
const Int
2) (Decoder s (IndividualPoolStake crypto)
-> Decoder s (IndividualPoolStake crypto))
-> Decoder s (IndividualPoolStake crypto)
-> Decoder s (IndividualPoolStake crypto)
forall a b. (a -> b) -> a -> b
$
Rational
-> Hash (HASH crypto) (VerKeyVRF (VRF crypto))
-> IndividualPoolStake crypto
forall crypto.
Rational
-> Hash crypto (VerKeyVRF crypto) -> IndividualPoolStake crypto
IndividualPoolStake
(Rational
-> Hash (HASH crypto) (VerKeyVRF (VRF crypto))
-> IndividualPoolStake crypto)
-> Decoder s Rational
-> Decoder
s
(Hash (HASH crypto) (VerKeyVRF (VRF crypto))
-> IndividualPoolStake crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Rational
forall a s. FromCBOR a => Decoder s a
fromCBOR
Decoder
s
(Hash (HASH crypto) (VerKeyVRF (VRF crypto))
-> IndividualPoolStake crypto)
-> Decoder s (Hash (HASH crypto) (VerKeyVRF (VRF crypto)))
-> Decoder s (IndividualPoolStake crypto)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Hash (HASH crypto) (VerKeyVRF (VRF crypto)))
forall a s. FromCBOR a => Decoder s a
fromCBOR
isInstantaneousRewards :: DCert era -> Bool
isInstantaneousRewards :: DCert era -> Bool
isInstantaneousRewards (DCertMir MIRCert era
_) = Bool
True
isInstantaneousRewards DCert era
_ = Bool
False
isReservesMIRCert :: DCert era -> Bool
isReservesMIRCert :: DCert era -> Bool
isReservesMIRCert (DCertMir (MIRCert MIRPot
ReservesMIR Map (Credential 'Staking era) Coin
_)) = Bool
True
isReservesMIRCert DCert era
_ = Bool
False
isTreasuryMIRCert :: DCert era -> Bool
isTreasuryMIRCert :: DCert era -> Bool
isTreasuryMIRCert (DCertMir (MIRCert MIRPot
TreasuryMIR Map (Credential 'Staking era) Coin
_)) = Bool
True
isTreasuryMIRCert DCert era
_ = Bool
False
requiresVKeyWitness :: DCert era -> Bool
requiresVKeyWitness :: DCert era -> Bool
requiresVKeyWitness (DCertMir (MIRCert MIRPot
_ Map (Credential 'Staking era) Coin
_)) = Bool
False
requiresVKeyWitness (DCertDeleg (RegKey Credential 'Staking era
_)) = Bool
False
requiresVKeyWitness DCert era
_ = Bool
True