{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Shelley.Spec.Ledger.EpochBoundary
( Stake (..),
BlocksMade (..),
SnapShot (..),
SnapShots (..),
emptySnapShot,
emptySnapShots,
aggregateUtxoCoinByCredential,
poolStake,
obligation,
maxPool,
)
where
import Cardano.Binary (FromCBOR (..), ToCBOR (..), encodeListLen)
import qualified Cardano.Ledger.Crypto as CC (Crypto)
import Cardano.Ledger.Era
import Cardano.Ledger.Shelley.Constraints (ShelleyBased)
import Cardano.Ledger.Val ((<+>), (<×>))
import qualified Cardano.Ledger.Val as Val
import Control.DeepSeq (NFData)
import Control.SetAlgebra (dom, eval, setSingleton, (▷), (◁))
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Ratio ((%))
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks (..))
import Numeric.Natural (Natural)
import Quiet
import Shelley.Spec.Ledger.Address (Addr (..))
import Shelley.Spec.Ledger.Coin
( Coin (..),
coinToRational,
rationalToCoinViaFloor,
)
import Shelley.Spec.Ledger.Credential (Credential, Ptr, StakeReference (..))
import Shelley.Spec.Ledger.Keys (KeyHash, KeyRole (..))
import Shelley.Spec.Ledger.PParams (PParams, PParams' (..), _a0, _nOpt)
import Shelley.Spec.Ledger.Serialization (decodeRecordNamed)
import Shelley.Spec.Ledger.TxBody (PoolParams, TxOut (TxOut))
import Shelley.Spec.Ledger.UTxO (UTxO (..))
newtype BlocksMade crypto = BlocksMade
{ BlocksMade crypto -> Map (KeyHash 'StakePool crypto) Natural
unBlocksMade :: Map (KeyHash 'StakePool crypto) Natural
}
deriving (BlocksMade crypto -> BlocksMade crypto -> Bool
(BlocksMade crypto -> BlocksMade crypto -> Bool)
-> (BlocksMade crypto -> BlocksMade crypto -> Bool)
-> Eq (BlocksMade crypto)
forall crypto. BlocksMade crypto -> BlocksMade crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlocksMade crypto -> BlocksMade crypto -> Bool
$c/= :: forall crypto. BlocksMade crypto -> BlocksMade crypto -> Bool
== :: BlocksMade crypto -> BlocksMade crypto -> Bool
$c== :: forall crypto. BlocksMade crypto -> BlocksMade crypto -> Bool
Eq, Context -> BlocksMade crypto -> IO (Maybe ThunkInfo)
Proxy (BlocksMade crypto) -> String
(Context -> BlocksMade crypto -> IO (Maybe ThunkInfo))
-> (Context -> BlocksMade crypto -> IO (Maybe ThunkInfo))
-> (Proxy (BlocksMade crypto) -> String)
-> NoThunks (BlocksMade crypto)
forall crypto. Context -> BlocksMade crypto -> IO (Maybe ThunkInfo)
forall crypto. Proxy (BlocksMade crypto) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (BlocksMade crypto) -> String
$cshowTypeOf :: forall crypto. Proxy (BlocksMade crypto) -> String
wNoThunks :: Context -> BlocksMade crypto -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall crypto. Context -> BlocksMade crypto -> IO (Maybe ThunkInfo)
noThunks :: Context -> BlocksMade crypto -> IO (Maybe ThunkInfo)
$cnoThunks :: forall crypto. Context -> BlocksMade crypto -> IO (Maybe ThunkInfo)
NoThunks, (forall x. BlocksMade crypto -> Rep (BlocksMade crypto) x)
-> (forall x. Rep (BlocksMade crypto) x -> BlocksMade crypto)
-> Generic (BlocksMade crypto)
forall x. Rep (BlocksMade crypto) x -> BlocksMade crypto
forall x. BlocksMade crypto -> Rep (BlocksMade crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x. Rep (BlocksMade crypto) x -> BlocksMade crypto
forall crypto x. BlocksMade crypto -> Rep (BlocksMade crypto) x
$cto :: forall crypto x. Rep (BlocksMade crypto) x -> BlocksMade crypto
$cfrom :: forall crypto x. BlocksMade crypto -> Rep (BlocksMade crypto) x
Generic, BlocksMade crypto -> ()
(BlocksMade crypto -> ()) -> NFData (BlocksMade crypto)
forall crypto. BlocksMade crypto -> ()
forall a. (a -> ()) -> NFData a
rnf :: BlocksMade crypto -> ()
$crnf :: forall crypto. BlocksMade crypto -> ()
NFData)
deriving (Int -> BlocksMade crypto -> ShowS
[BlocksMade crypto] -> ShowS
BlocksMade crypto -> String
(Int -> BlocksMade crypto -> ShowS)
-> (BlocksMade crypto -> String)
-> ([BlocksMade crypto] -> ShowS)
-> Show (BlocksMade crypto)
forall crypto. Int -> BlocksMade crypto -> ShowS
forall crypto. [BlocksMade crypto] -> ShowS
forall crypto. BlocksMade crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlocksMade crypto] -> ShowS
$cshowList :: forall crypto. [BlocksMade crypto] -> ShowS
show :: BlocksMade crypto -> String
$cshow :: forall crypto. BlocksMade crypto -> String
showsPrec :: Int -> BlocksMade crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> BlocksMade crypto -> ShowS
Show) via Quiet (BlocksMade crypto)
deriving instance CC.Crypto crypto => ToCBOR (BlocksMade crypto)
deriving instance CC.Crypto crypto => FromCBOR (BlocksMade crypto)
newtype Stake crypto = Stake
{ Stake crypto -> Map (Credential 'Staking crypto) Coin
unStake :: Map (Credential 'Staking crypto) Coin
}
deriving (Int -> Stake crypto -> ShowS
[Stake crypto] -> ShowS
Stake crypto -> String
(Int -> Stake crypto -> ShowS)
-> (Stake crypto -> String)
-> ([Stake crypto] -> ShowS)
-> Show (Stake crypto)
forall crypto. Int -> Stake crypto -> ShowS
forall crypto. [Stake crypto] -> ShowS
forall crypto. Stake crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Stake crypto] -> ShowS
$cshowList :: forall crypto. [Stake crypto] -> ShowS
show :: Stake crypto -> String
$cshow :: forall crypto. Stake crypto -> String
showsPrec :: Int -> Stake crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> Stake crypto -> ShowS
Show, Stake crypto -> Stake crypto -> Bool
(Stake crypto -> Stake crypto -> Bool)
-> (Stake crypto -> Stake crypto -> Bool) -> Eq (Stake crypto)
forall crypto. Stake crypto -> Stake crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Stake crypto -> Stake crypto -> Bool
$c/= :: forall crypto. Stake crypto -> Stake crypto -> Bool
== :: Stake crypto -> Stake crypto -> Bool
$c== :: forall crypto. Stake crypto -> Stake crypto -> Bool
Eq, Eq (Stake crypto)
Eq (Stake crypto)
-> (Stake crypto -> Stake crypto -> Ordering)
-> (Stake crypto -> Stake crypto -> Bool)
-> (Stake crypto -> Stake crypto -> Bool)
-> (Stake crypto -> Stake crypto -> Bool)
-> (Stake crypto -> Stake crypto -> Bool)
-> (Stake crypto -> Stake crypto -> Stake crypto)
-> (Stake crypto -> Stake crypto -> Stake crypto)
-> Ord (Stake crypto)
Stake crypto -> Stake crypto -> Bool
Stake crypto -> Stake crypto -> Ordering
Stake crypto -> Stake crypto -> Stake crypto
forall crypto. Eq (Stake crypto)
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 crypto. Stake crypto -> Stake crypto -> Bool
forall crypto. Stake crypto -> Stake crypto -> Ordering
forall crypto. Stake crypto -> Stake crypto -> Stake crypto
min :: Stake crypto -> Stake crypto -> Stake crypto
$cmin :: forall crypto. Stake crypto -> Stake crypto -> Stake crypto
max :: Stake crypto -> Stake crypto -> Stake crypto
$cmax :: forall crypto. Stake crypto -> Stake crypto -> Stake crypto
>= :: Stake crypto -> Stake crypto -> Bool
$c>= :: forall crypto. Stake crypto -> Stake crypto -> Bool
> :: Stake crypto -> Stake crypto -> Bool
$c> :: forall crypto. Stake crypto -> Stake crypto -> Bool
<= :: Stake crypto -> Stake crypto -> Bool
$c<= :: forall crypto. Stake crypto -> Stake crypto -> Bool
< :: Stake crypto -> Stake crypto -> Bool
$c< :: forall crypto. Stake crypto -> Stake crypto -> Bool
compare :: Stake crypto -> Stake crypto -> Ordering
$ccompare :: forall crypto. Stake crypto -> Stake crypto -> Ordering
$cp1Ord :: forall crypto. Eq (Stake crypto)
Ord, Context -> Stake crypto -> IO (Maybe ThunkInfo)
Proxy (Stake crypto) -> String
(Context -> Stake crypto -> IO (Maybe ThunkInfo))
-> (Context -> Stake crypto -> IO (Maybe ThunkInfo))
-> (Proxy (Stake crypto) -> String)
-> NoThunks (Stake crypto)
forall crypto. Context -> Stake crypto -> IO (Maybe ThunkInfo)
forall crypto. Proxy (Stake crypto) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (Stake crypto) -> String
$cshowTypeOf :: forall crypto. Proxy (Stake crypto) -> String
wNoThunks :: Context -> Stake crypto -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall crypto. Context -> Stake crypto -> IO (Maybe ThunkInfo)
noThunks :: Context -> Stake crypto -> IO (Maybe ThunkInfo)
$cnoThunks :: forall crypto. Context -> Stake crypto -> IO (Maybe ThunkInfo)
NoThunks, Stake crypto -> ()
(Stake crypto -> ()) -> NFData (Stake crypto)
forall crypto. Stake crypto -> ()
forall a. (a -> ()) -> NFData a
rnf :: Stake crypto -> ()
$crnf :: forall crypto. Stake crypto -> ()
NFData)
deriving newtype instance
CC.Crypto crypto => ToCBOR (Stake crypto)
deriving newtype instance
CC.Crypto crypto => FromCBOR (Stake crypto)
aggregateUtxoCoinByCredential ::
forall era.
ShelleyBased era =>
Map Ptr (Credential 'Staking (Crypto era)) ->
UTxO era ->
Map (Credential 'Staking (Crypto era)) Coin ->
Map (Credential 'Staking (Crypto era)) Coin
aggregateUtxoCoinByCredential :: Map Ptr (Credential 'Staking (Crypto era))
-> UTxO era
-> Map (Credential 'Staking (Crypto era)) Coin
-> Map (Credential 'Staking (Crypto era)) Coin
aggregateUtxoCoinByCredential Map Ptr (Credential 'Staking (Crypto era))
ptrs (UTxO Map (TxIn (Crypto era)) (TxOut era)
u) Map (Credential 'Staking (Crypto era)) Coin
initial =
(TxOut era
-> Map (Credential 'Staking (Crypto era)) Coin
-> Map (Credential 'Staking (Crypto era)) Coin)
-> Map (Credential 'Staking (Crypto era)) Coin
-> Map (TxIn (Crypto era)) (TxOut era)
-> Map (Credential 'Staking (Crypto era)) Coin
forall a b k. (a -> b -> b) -> b -> Map k a -> b
Map.foldr TxOut era
-> Map (Credential 'Staking (Crypto era)) Coin
-> Map (Credential 'Staking (Crypto era)) Coin
accum Map (Credential 'Staking (Crypto era)) Coin
initial Map (TxIn (Crypto era)) (TxOut era)
u
where
accum :: TxOut era
-> Map (Credential 'Staking (Crypto era)) Coin
-> Map (Credential 'Staking (Crypto era)) Coin
accum (TxOut (Addr Network
_ PaymentCredential (Crypto era)
_ (StakeRefPtr Ptr
p)) Value era
c) Map (Credential 'Staking (Crypto era)) Coin
ans =
case Ptr
-> Map Ptr (Credential 'Staking (Crypto era))
-> Maybe (Credential 'Staking (Crypto era))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ptr
p Map Ptr (Credential 'Staking (Crypto era))
ptrs of
Just Credential 'Staking (Crypto era)
cred -> (Coin -> Coin -> Coin)
-> Credential 'Staking (Crypto era)
-> Coin
-> Map (Credential 'Staking (Crypto era)) Coin
-> Map (Credential 'Staking (Crypto era)) Coin
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
(<>) Credential 'Staking (Crypto era)
cred (Value era -> Coin
forall t. Val t => t -> Coin
Val.coin Value era
c) Map (Credential 'Staking (Crypto era)) Coin
ans
Maybe (Credential 'Staking (Crypto era))
Nothing -> Map (Credential 'Staking (Crypto era)) Coin
ans
accum (TxOut (Addr Network
_ PaymentCredential (Crypto era)
_ (StakeRefBase Credential 'Staking (Crypto era)
hk)) Value era
c) Map (Credential 'Staking (Crypto era)) Coin
ans =
(Coin -> Coin -> Coin)
-> Credential 'Staking (Crypto era)
-> Coin
-> Map (Credential 'Staking (Crypto era)) Coin
-> Map (Credential 'Staking (Crypto era)) Coin
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
(<>) Credential 'Staking (Crypto era)
hk (Value era -> Coin
forall t. Val t => t -> Coin
Val.coin Value era
c) Map (Credential 'Staking (Crypto era)) Coin
ans
accum TxOut era
_other Map (Credential 'Staking (Crypto era)) Coin
ans = Map (Credential 'Staking (Crypto era)) Coin
ans
poolStake ::
KeyHash 'StakePool crypto ->
Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto) ->
Stake crypto ->
Stake crypto
poolStake :: KeyHash 'StakePool crypto
-> Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
-> Stake crypto
-> Stake crypto
poolStake KeyHash 'StakePool crypto
hk Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
delegs (Stake Map (Credential 'Staking crypto) Coin
stake) =
Map (Credential 'Staking crypto) Coin -> Stake crypto
forall crypto.
Map (Credential 'Staking crypto) Coin -> Stake crypto
Stake (Map (Credential 'Staking crypto) Coin -> Stake crypto)
-> Map (Credential 'Staking crypto) Coin -> Stake crypto
forall a b. (a -> b) -> a -> b
$ Exp (Map (Credential 'Staking crypto) Coin)
-> Map (Credential 'Staking crypto) Coin
forall s t. Embed s t => Exp t -> s
eval (Exp (Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto))
-> Exp (Sett (Credential 'Staking crypto) ())
forall k s (f :: * -> * -> *) v.
(Ord k, HasExp s (f k v)) =>
s -> Exp (Sett k ())
dom (Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
delegs Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
-> Exp (Single (KeyHash 'StakePool crypto) ())
-> Exp
(Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto))
forall k (g :: * -> * -> *) v s1 (f :: * -> * -> *) s2.
(Ord k, Iter g, Ord v, HasExp s1 (f k v), HasExp s2 (g v ())) =>
s1 -> s2 -> Exp (f k v)
▷ KeyHash 'StakePool crypto
-> Exp (Single (KeyHash 'StakePool crypto) ())
forall k. Ord k => k -> Exp (Single k ())
setSingleton KeyHash 'StakePool crypto
hk) Exp (Sett (Credential 'Staking crypto) ())
-> Map (Credential 'Staking crypto) Coin
-> Exp (Map (Credential 'Staking crypto) Coin)
forall k s1 s2 (f :: * -> * -> *) v.
(Ord k, HasExp s1 (Sett k ()), HasExp s2 (f k v)) =>
s1 -> s2 -> Exp (f k v)
◁ Map (Credential 'Staking crypto) Coin
stake)
obligation ::
PParams era ->
Map (Credential 'Staking (Crypto era)) Coin ->
Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era)) ->
Coin
obligation :: PParams era
-> Map (Credential 'Staking (Crypto era)) Coin
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
-> Coin
obligation PParams era
pp Map (Credential 'Staking (Crypto era)) Coin
rewards Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
stakePools =
(Map (Credential 'Staking (Crypto era)) Coin -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Map (Credential 'Staking (Crypto era)) Coin
rewards Int -> Coin -> Coin
forall t i. (Val t, Integral i) => i -> t -> t
<×> PParams era -> HKD Identity Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_keyDeposit PParams era
pp) Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> (Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
-> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
stakePools Int -> Coin -> Coin
forall t i. (Val t, Integral i) => i -> t -> t
<×> PParams era -> HKD Identity Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_poolDeposit PParams era
pp)
maxPool :: PParams era -> Coin -> Rational -> Rational -> Coin
maxPool :: PParams era -> Coin -> Rational -> Rational -> Coin
maxPool PParams era
pc Coin
r Rational
sigma Rational
pR = Rational -> Coin
rationalToCoinViaFloor (Rational -> Coin) -> Rational -> Coin
forall a b. (a -> b) -> a -> b
$ Rational
factor1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
factor2
where
a0 :: HKD Identity Rational
a0 = PParams era -> HKD Identity Rational
forall (f :: * -> *) era. PParams' f era -> HKD f Rational
_a0 PParams era
pc
nOpt :: HKD Identity Natural
nOpt = PParams era -> HKD Identity Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_nOpt PParams era
pc
z0 :: Rational
z0 = Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
HKD Identity Natural
nOpt
sigma' :: Rational
sigma' = Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
min Rational
sigma Rational
z0
p' :: Rational
p' = Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
min Rational
pR Rational
z0
factor1 :: Rational
factor1 = Coin -> Rational
coinToRational Coin
r Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
HKD Identity Rational
a0)
factor2 :: Rational
factor2 = Rational
sigma' Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
p' Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
HKD Identity Rational
a0 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
factor3
factor3 :: Rational
factor3 = (Rational
sigma' Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
p' Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
factor4) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
z0
factor4 :: Rational
factor4 = (Rational
z0 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
sigma') Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
z0
data SnapShot crypto = SnapShot
{ SnapShot crypto -> Stake crypto
_stake :: !(Stake crypto),
SnapShot crypto
-> Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
_delegations :: !(Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto)),
SnapShot crypto
-> Map (KeyHash 'StakePool crypto) (PoolParams crypto)
_poolParams :: !(Map (KeyHash 'StakePool crypto) (PoolParams crypto))
}
deriving (Int -> SnapShot crypto -> ShowS
[SnapShot crypto] -> ShowS
SnapShot crypto -> String
(Int -> SnapShot crypto -> ShowS)
-> (SnapShot crypto -> String)
-> ([SnapShot crypto] -> ShowS)
-> Show (SnapShot crypto)
forall crypto. Int -> SnapShot crypto -> ShowS
forall crypto. [SnapShot crypto] -> ShowS
forall crypto. SnapShot crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SnapShot crypto] -> ShowS
$cshowList :: forall crypto. [SnapShot crypto] -> ShowS
show :: SnapShot crypto -> String
$cshow :: forall crypto. SnapShot crypto -> String
showsPrec :: Int -> SnapShot crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> SnapShot crypto -> ShowS
Show, SnapShot crypto -> SnapShot crypto -> Bool
(SnapShot crypto -> SnapShot crypto -> Bool)
-> (SnapShot crypto -> SnapShot crypto -> Bool)
-> Eq (SnapShot crypto)
forall crypto. SnapShot crypto -> SnapShot crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SnapShot crypto -> SnapShot crypto -> Bool
$c/= :: forall crypto. SnapShot crypto -> SnapShot crypto -> Bool
== :: SnapShot crypto -> SnapShot crypto -> Bool
$c== :: forall crypto. SnapShot crypto -> SnapShot crypto -> Bool
Eq, (forall x. SnapShot crypto -> Rep (SnapShot crypto) x)
-> (forall x. Rep (SnapShot crypto) x -> SnapShot crypto)
-> Generic (SnapShot crypto)
forall x. Rep (SnapShot crypto) x -> SnapShot crypto
forall x. SnapShot crypto -> Rep (SnapShot crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x. Rep (SnapShot crypto) x -> SnapShot crypto
forall crypto x. SnapShot crypto -> Rep (SnapShot crypto) x
$cto :: forall crypto x. Rep (SnapShot crypto) x -> SnapShot crypto
$cfrom :: forall crypto x. SnapShot crypto -> Rep (SnapShot crypto) x
Generic)
instance NoThunks (SnapShot crypto)
instance NFData (SnapShot crypto)
instance
CC.Crypto crypto =>
ToCBOR (SnapShot crypto)
where
toCBOR :: SnapShot crypto -> Encoding
toCBOR
( SnapShot
{ $sel:_stake:SnapShot :: forall crypto. SnapShot crypto -> Stake crypto
_stake = Stake crypto
s,
$sel:_delegations:SnapShot :: forall crypto.
SnapShot crypto
-> Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
_delegations = Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
d,
$sel:_poolParams:SnapShot :: forall crypto.
SnapShot crypto
-> Map (KeyHash 'StakePool crypto) (PoolParams crypto)
_poolParams = Map (KeyHash 'StakePool crypto) (PoolParams crypto)
p
}
) =
Word -> Encoding
encodeListLen Word
3
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Stake crypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Stake crypto
s
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
-> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
d
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map (KeyHash 'StakePool crypto) (PoolParams crypto) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Map (KeyHash 'StakePool crypto) (PoolParams crypto)
p
instance
CC.Crypto crypto =>
FromCBOR (SnapShot crypto)
where
fromCBOR :: Decoder s (SnapShot crypto)
fromCBOR = do
Text
-> (SnapShot crypto -> Int)
-> Decoder s (SnapShot crypto)
-> Decoder s (SnapShot crypto)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"SnapShot" (Int -> SnapShot crypto -> Int
forall a b. a -> b -> a
const Int
3) (Decoder s (SnapShot crypto) -> Decoder s (SnapShot crypto))
-> Decoder s (SnapShot crypto) -> Decoder s (SnapShot crypto)
forall a b. (a -> b) -> a -> b
$ do
Stake crypto
s <- Decoder s (Stake crypto)
forall a s. FromCBOR a => Decoder s a
fromCBOR
Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
d <- Decoder
s (Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto))
forall a s. FromCBOR a => Decoder s a
fromCBOR
Map (KeyHash 'StakePool crypto) (PoolParams crypto)
p <- Decoder s (Map (KeyHash 'StakePool crypto) (PoolParams crypto))
forall a s. FromCBOR a => Decoder s a
fromCBOR
SnapShot crypto -> Decoder s (SnapShot crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SnapShot crypto -> Decoder s (SnapShot crypto))
-> SnapShot crypto -> Decoder s (SnapShot crypto)
forall a b. (a -> b) -> a -> b
$ Stake crypto
-> Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
-> Map (KeyHash 'StakePool crypto) (PoolParams crypto)
-> SnapShot crypto
forall crypto.
Stake crypto
-> Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
-> Map (KeyHash 'StakePool crypto) (PoolParams crypto)
-> SnapShot crypto
SnapShot Stake crypto
s Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
d Map (KeyHash 'StakePool crypto) (PoolParams crypto)
p
data SnapShots crypto = SnapShots
{ SnapShots crypto -> SnapShot crypto
_pstakeMark :: !(SnapShot crypto),
SnapShots crypto -> SnapShot crypto
_pstakeSet :: !(SnapShot crypto),
SnapShots crypto -> SnapShot crypto
_pstakeGo :: !(SnapShot crypto),
SnapShots crypto -> Coin
_feeSS :: !Coin
}
deriving (Int -> SnapShots crypto -> ShowS
[SnapShots crypto] -> ShowS
SnapShots crypto -> String
(Int -> SnapShots crypto -> ShowS)
-> (SnapShots crypto -> String)
-> ([SnapShots crypto] -> ShowS)
-> Show (SnapShots crypto)
forall crypto. Int -> SnapShots crypto -> ShowS
forall crypto. [SnapShots crypto] -> ShowS
forall crypto. SnapShots crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SnapShots crypto] -> ShowS
$cshowList :: forall crypto. [SnapShots crypto] -> ShowS
show :: SnapShots crypto -> String
$cshow :: forall crypto. SnapShots crypto -> String
showsPrec :: Int -> SnapShots crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> SnapShots crypto -> ShowS
Show, SnapShots crypto -> SnapShots crypto -> Bool
(SnapShots crypto -> SnapShots crypto -> Bool)
-> (SnapShots crypto -> SnapShots crypto -> Bool)
-> Eq (SnapShots crypto)
forall crypto. SnapShots crypto -> SnapShots crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SnapShots crypto -> SnapShots crypto -> Bool
$c/= :: forall crypto. SnapShots crypto -> SnapShots crypto -> Bool
== :: SnapShots crypto -> SnapShots crypto -> Bool
$c== :: forall crypto. SnapShots crypto -> SnapShots crypto -> Bool
Eq, (forall x. SnapShots crypto -> Rep (SnapShots crypto) x)
-> (forall x. Rep (SnapShots crypto) x -> SnapShots crypto)
-> Generic (SnapShots crypto)
forall x. Rep (SnapShots crypto) x -> SnapShots crypto
forall x. SnapShots crypto -> Rep (SnapShots crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x. Rep (SnapShots crypto) x -> SnapShots crypto
forall crypto x. SnapShots crypto -> Rep (SnapShots crypto) x
$cto :: forall crypto x. Rep (SnapShots crypto) x -> SnapShots crypto
$cfrom :: forall crypto x. SnapShots crypto -> Rep (SnapShots crypto) x
Generic)
instance NoThunks (SnapShots crypto)
instance NFData (SnapShots crypto)
instance
CC.Crypto crypto =>
ToCBOR (SnapShots crypto)
where
toCBOR :: SnapShots crypto -> Encoding
toCBOR (SnapShots SnapShot crypto
mark SnapShot crypto
set SnapShot crypto
go Coin
fs) =
Word -> Encoding
encodeListLen Word
4
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SnapShot crypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR SnapShot crypto
mark
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SnapShot crypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR SnapShot crypto
set
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SnapShot crypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR SnapShot crypto
go
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Coin -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Coin
fs
instance
CC.Crypto crypto =>
FromCBOR (SnapShots crypto)
where
fromCBOR :: Decoder s (SnapShots crypto)
fromCBOR = do
Text
-> (SnapShots crypto -> Int)
-> Decoder s (SnapShots crypto)
-> Decoder s (SnapShots crypto)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"SnapShots" (Int -> SnapShots crypto -> Int
forall a b. a -> b -> a
const Int
4) (Decoder s (SnapShots crypto) -> Decoder s (SnapShots crypto))
-> Decoder s (SnapShots crypto) -> Decoder s (SnapShots crypto)
forall a b. (a -> b) -> a -> b
$ do
SnapShot crypto
mark <- Decoder s (SnapShot crypto)
forall a s. FromCBOR a => Decoder s a
fromCBOR
SnapShot crypto
set <- Decoder s (SnapShot crypto)
forall a s. FromCBOR a => Decoder s a
fromCBOR
SnapShot crypto
go <- Decoder s (SnapShot crypto)
forall a s. FromCBOR a => Decoder s a
fromCBOR
Coin
f <- Decoder s Coin
forall a s. FromCBOR a => Decoder s a
fromCBOR
SnapShots crypto -> Decoder s (SnapShots crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SnapShots crypto -> Decoder s (SnapShots crypto))
-> SnapShots crypto -> Decoder s (SnapShots crypto)
forall a b. (a -> b) -> a -> b
$ SnapShot crypto
-> SnapShot crypto -> SnapShot crypto -> Coin -> SnapShots crypto
forall crypto.
SnapShot crypto
-> SnapShot crypto -> SnapShot crypto -> Coin -> SnapShots crypto
SnapShots SnapShot crypto
mark SnapShot crypto
set SnapShot crypto
go Coin
f
emptySnapShot :: SnapShot crypto
emptySnapShot :: SnapShot crypto
emptySnapShot = Stake crypto
-> Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
-> Map (KeyHash 'StakePool crypto) (PoolParams crypto)
-> SnapShot crypto
forall crypto.
Stake crypto
-> Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
-> Map (KeyHash 'StakePool crypto) (PoolParams crypto)
-> SnapShot crypto
SnapShot (Map (Credential 'Staking crypto) Coin -> Stake crypto
forall crypto.
Map (Credential 'Staking crypto) Coin -> Stake crypto
Stake Map (Credential 'Staking crypto) Coin
forall k a. Map k a
Map.empty) Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
forall k a. Map k a
Map.empty Map (KeyHash 'StakePool crypto) (PoolParams crypto)
forall k a. Map k a
Map.empty
emptySnapShots :: SnapShots crypto
emptySnapShots :: SnapShots crypto
emptySnapShots = SnapShot crypto
-> SnapShot crypto -> SnapShot crypto -> Coin -> SnapShots crypto
forall crypto.
SnapShot crypto
-> SnapShot crypto -> SnapShot crypto -> Coin -> SnapShots crypto
SnapShots SnapShot crypto
forall crypto. SnapShot crypto
emptySnapShot SnapShot crypto
forall crypto. SnapShot crypto
emptySnapShot SnapShot crypto
forall crypto. SnapShot crypto
emptySnapShot (Integer -> Coin
Coin Integer
0)