{-# 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      : EpochBoundary
-- Description : Functions and definitions for rules at epoch boundary.
--
-- This modules implements the necessary functions for the changes that can happen at epoch boundaries.
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 (..))

-- | Blocks made
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)

-- | Type of stake as map from hash key to coins associated.
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)

-- A TxOut has 4 different shapes, depending on the shape its embedded of Addr.
-- Credentials are stored in only 2 of the 4 cases.
-- 1) TxOut (Addr _ _ (StakeRefBase cred)) coin   -> HERE
-- 2) TxOut (Addr _ _ (StakeRefPtr ptr)) coin     -> HERE
-- 3) TxOut (Addr _ _ StakeRefNull) coin          -> NOT HERE
-- 4) TxOut (AddrBootstrap _) coin                -> NOT HERE
-- Unfortunately TxOut is a pattern, that deserializes the address. This can be expensive, so if
-- we only deserialize the parts that we need, for the 2 cases that count, we can speed
-- things up considerably. That is the role of deserialiseAddrStakeRef. It returns (Just stake)
-- for the two cases that matter, and Nothing for the other two cases.

-- | Sum up all the Coin for each staking Credential
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

-- | Get stake of one pool
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)

-- | Calculate total possible refunds.
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)

-- | Calculate maximal pool reward
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

-- | Snapshot of the stake distribution.
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

-- | Snapshots of the stake distribution.
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)