{-# 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.Core as Core
import Cardano.Ledger.Era
import Cardano.Ledger.Shelley (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 era = BlocksMade
  { BlocksMade era -> Map (KeyHash 'StakePool (Crypto era)) Natural
unBlocksMade :: Map (KeyHash 'StakePool (Crypto era)) Natural
  }
  deriving (BlocksMade era -> BlocksMade era -> Bool
(BlocksMade era -> BlocksMade era -> Bool)
-> (BlocksMade era -> BlocksMade era -> Bool)
-> Eq (BlocksMade era)
forall era. BlocksMade era -> BlocksMade era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlocksMade era -> BlocksMade era -> Bool
$c/= :: forall era. BlocksMade era -> BlocksMade era -> Bool
== :: BlocksMade era -> BlocksMade era -> Bool
$c== :: forall era. BlocksMade era -> BlocksMade era -> Bool
Eq, Context -> BlocksMade era -> IO (Maybe ThunkInfo)
Proxy (BlocksMade era) -> String
(Context -> BlocksMade era -> IO (Maybe ThunkInfo))
-> (Context -> BlocksMade era -> IO (Maybe ThunkInfo))
-> (Proxy (BlocksMade era) -> String)
-> NoThunks (BlocksMade era)
forall era. Context -> BlocksMade era -> IO (Maybe ThunkInfo)
forall era. Proxy (BlocksMade era) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (BlocksMade era) -> String
$cshowTypeOf :: forall era. Proxy (BlocksMade era) -> String
wNoThunks :: Context -> BlocksMade era -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall era. Context -> BlocksMade era -> IO (Maybe ThunkInfo)
noThunks :: Context -> BlocksMade era -> IO (Maybe ThunkInfo)
$cnoThunks :: forall era. Context -> BlocksMade era -> IO (Maybe ThunkInfo)
NoThunks, (forall x. BlocksMade era -> Rep (BlocksMade era) x)
-> (forall x. Rep (BlocksMade era) x -> BlocksMade era)
-> Generic (BlocksMade era)
forall x. Rep (BlocksMade era) x -> BlocksMade era
forall x. BlocksMade era -> Rep (BlocksMade era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (BlocksMade era) x -> BlocksMade era
forall era x. BlocksMade era -> Rep (BlocksMade era) x
$cto :: forall era x. Rep (BlocksMade era) x -> BlocksMade era
$cfrom :: forall era x. BlocksMade era -> Rep (BlocksMade era) x
Generic, BlocksMade era -> ()
(BlocksMade era -> ()) -> NFData (BlocksMade era)
forall era. BlocksMade era -> ()
forall a. (a -> ()) -> NFData a
rnf :: BlocksMade era -> ()
$crnf :: forall era. BlocksMade era -> ()
NFData)
  deriving (Int -> BlocksMade era -> ShowS
[BlocksMade era] -> ShowS
BlocksMade era -> String
(Int -> BlocksMade era -> ShowS)
-> (BlocksMade era -> String)
-> ([BlocksMade era] -> ShowS)
-> Show (BlocksMade era)
forall era. Int -> BlocksMade era -> ShowS
forall era. [BlocksMade era] -> ShowS
forall era. BlocksMade era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlocksMade era] -> ShowS
$cshowList :: forall era. [BlocksMade era] -> ShowS
show :: BlocksMade era -> String
$cshow :: forall era. BlocksMade era -> String
showsPrec :: Int -> BlocksMade era -> ShowS
$cshowsPrec :: forall era. Int -> BlocksMade era -> ShowS
Show) via Quiet (BlocksMade era)

deriving instance (Era era) => ToCBOR (BlocksMade era)

deriving instance (Era era) => FromCBOR (BlocksMade era)

-- | Type of stake as map from hash key to coins associated.
newtype Stake era = Stake
  { Stake era -> Map (Credential 'Staking era) Coin
unStake :: (Map (Credential 'Staking era) Coin)
  }
  deriving (Int -> Stake era -> ShowS
[Stake era] -> ShowS
Stake era -> String
(Int -> Stake era -> ShowS)
-> (Stake era -> String)
-> ([Stake era] -> ShowS)
-> Show (Stake era)
forall era. Int -> Stake era -> ShowS
forall era. [Stake era] -> ShowS
forall era. Stake era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Stake era] -> ShowS
$cshowList :: forall era. [Stake era] -> ShowS
show :: Stake era -> String
$cshow :: forall era. Stake era -> String
showsPrec :: Int -> Stake era -> ShowS
$cshowsPrec :: forall era. Int -> Stake era -> ShowS
Show, Stake era -> Stake era -> Bool
(Stake era -> Stake era -> Bool)
-> (Stake era -> Stake era -> Bool) -> Eq (Stake era)
forall era. Stake era -> Stake era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Stake era -> Stake era -> Bool
$c/= :: forall era. Stake era -> Stake era -> Bool
== :: Stake era -> Stake era -> Bool
$c== :: forall era. Stake era -> Stake era -> Bool
Eq, Eq (Stake era)
Eq (Stake era)
-> (Stake era -> Stake era -> Ordering)
-> (Stake era -> Stake era -> Bool)
-> (Stake era -> Stake era -> Bool)
-> (Stake era -> Stake era -> Bool)
-> (Stake era -> Stake era -> Bool)
-> (Stake era -> Stake era -> Stake era)
-> (Stake era -> Stake era -> Stake era)
-> Ord (Stake era)
Stake era -> Stake era -> Bool
Stake era -> Stake era -> Ordering
Stake era -> Stake era -> Stake era
forall era. Eq (Stake 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. Stake era -> Stake era -> Bool
forall era. Stake era -> Stake era -> Ordering
forall era. Stake era -> Stake era -> Stake era
min :: Stake era -> Stake era -> Stake era
$cmin :: forall era. Stake era -> Stake era -> Stake era
max :: Stake era -> Stake era -> Stake era
$cmax :: forall era. Stake era -> Stake era -> Stake era
>= :: Stake era -> Stake era -> Bool
$c>= :: forall era. Stake era -> Stake era -> Bool
> :: Stake era -> Stake era -> Bool
$c> :: forall era. Stake era -> Stake era -> Bool
<= :: Stake era -> Stake era -> Bool
$c<= :: forall era. Stake era -> Stake era -> Bool
< :: Stake era -> Stake era -> Bool
$c< :: forall era. Stake era -> Stake era -> Bool
compare :: Stake era -> Stake era -> Ordering
$ccompare :: forall era. Stake era -> Stake era -> Ordering
$cp1Ord :: forall era. Eq (Stake era)
Ord, Context -> Stake era -> IO (Maybe ThunkInfo)
Proxy (Stake era) -> String
(Context -> Stake era -> IO (Maybe ThunkInfo))
-> (Context -> Stake era -> IO (Maybe ThunkInfo))
-> (Proxy (Stake era) -> String)
-> NoThunks (Stake era)
forall era. Context -> Stake era -> IO (Maybe ThunkInfo)
forall era. Proxy (Stake era) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (Stake era) -> String
$cshowTypeOf :: forall era. Proxy (Stake era) -> String
wNoThunks :: Context -> Stake era -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall era. Context -> Stake era -> IO (Maybe ThunkInfo)
noThunks :: Context -> Stake era -> IO (Maybe ThunkInfo)
$cnoThunks :: forall era. Context -> Stake era -> IO (Maybe ThunkInfo)
NoThunks, Stake era -> ()
(Stake era -> ()) -> NFData (Stake era)
forall era. Stake era -> ()
forall a. (a -> ()) -> NFData a
rnf :: Stake era -> ()
$crnf :: forall era. Stake era -> ()
NFData)

deriving newtype instance
  (Era era, Core.AnnotatedData (Core.Script era)) =>
  ToCBOR (Stake era)

deriving newtype instance
  (Era era, Core.AnnotatedData (Core.Script era)) =>
  FromCBOR (Stake era)

-- 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 era) ->
  UTxO era ->
  Map (Credential 'Staking era) Coin ->
  Map (Credential 'Staking era) Coin
aggregateUtxoCoinByCredential :: Map Ptr (Credential 'Staking era)
-> UTxO era
-> Map (Credential 'Staking era) Coin
-> Map (Credential 'Staking era) Coin
aggregateUtxoCoinByCredential Map Ptr (Credential 'Staking era)
ptrs (UTxO Map (TxIn era) (TxOut era)
u) Map (Credential 'Staking era) Coin
initial =
  (TxOut era
 -> Map (Credential 'Staking era) Coin
 -> Map (Credential 'Staking era) Coin)
-> Map (Credential 'Staking era) Coin
-> Map (TxIn era) (TxOut era)
-> Map (Credential 'Staking era) Coin
forall a b k. (a -> b -> b) -> b -> Map k a -> b
Map.foldr TxOut era
-> Map (Credential 'Staking era) Coin
-> Map (Credential 'Staking era) Coin
accum Map (Credential 'Staking era) Coin
initial Map (TxIn era) (TxOut era)
u
  where
    accum :: TxOut era
-> Map (Credential 'Staking era) Coin
-> Map (Credential 'Staking era) Coin
accum (TxOut (Addr Network
_ PaymentCredential era
_ (StakeRefPtr Ptr
p)) Value era
c) Map (Credential 'Staking era) Coin
ans =
      case Ptr
-> Map Ptr (Credential 'Staking era)
-> Maybe (Credential 'Staking era)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ptr
p Map Ptr (Credential 'Staking era)
ptrs of
        Just Credential 'Staking era
cred -> (Coin -> Coin -> Coin)
-> Credential 'Staking era
-> Coin
-> Map (Credential 'Staking era) Coin
-> Map (Credential 'Staking 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 era
cred (Value era -> Coin
forall t. Val t => t -> Coin
Val.coin Value era
c) Map (Credential 'Staking era) Coin
ans
        Maybe (Credential 'Staking era)
Nothing -> Map (Credential 'Staking era) Coin
ans
    accum (TxOut (Addr Network
_ PaymentCredential era
_ (StakeRefBase Credential 'Staking era
hk)) Value era
c) Map (Credential 'Staking era) Coin
ans =
      (Coin -> Coin -> Coin)
-> Credential 'Staking era
-> Coin
-> Map (Credential 'Staking era) Coin
-> Map (Credential 'Staking 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 era
hk (Value era -> Coin
forall t. Val t => t -> Coin
Val.coin Value era
c) Map (Credential 'Staking era) Coin
ans
    accum TxOut era
_other Map (Credential 'Staking era) Coin
ans = Map (Credential 'Staking era) Coin
ans

-- | Get stake of one pool
poolStake ::
  KeyHash 'StakePool (Crypto era) ->
  Map (Credential 'Staking era) (KeyHash 'StakePool (Crypto era)) ->
  Stake era ->
  Stake era
poolStake :: KeyHash 'StakePool (Crypto era)
-> Map (Credential 'Staking era) (KeyHash 'StakePool (Crypto era))
-> Stake era
-> Stake era
poolStake KeyHash 'StakePool (Crypto era)
hk Map (Credential 'Staking era) (KeyHash 'StakePool (Crypto era))
delegs (Stake Map (Credential 'Staking era) Coin
stake) =
  Map (Credential 'Staking era) Coin -> Stake era
forall era. Map (Credential 'Staking era) Coin -> Stake era
Stake (Map (Credential 'Staking era) Coin -> Stake era)
-> Map (Credential 'Staking era) Coin -> Stake era
forall a b. (a -> b) -> a -> b
$ Exp (Map (Credential 'Staking era) Coin)
-> Map (Credential 'Staking era) Coin
forall s t. Embed s t => Exp t -> s
eval (Exp
  (Map (Credential 'Staking era) (KeyHash 'StakePool (Crypto era)))
-> Exp (Sett (Credential 'Staking era) ())
forall k s (f :: * -> * -> *) v.
(Ord k, HasExp s (f k v)) =>
s -> Exp (Sett k ())
dom (Map (Credential 'Staking era) (KeyHash 'StakePool (Crypto era))
delegs Map (Credential 'Staking era) (KeyHash 'StakePool (Crypto era))
-> Exp (Single (KeyHash 'StakePool (Crypto era)) ())
-> Exp
     (Map (Credential 'Staking era) (KeyHash 'StakePool (Crypto era)))
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 era)
-> Exp (Single (KeyHash 'StakePool (Crypto era)) ())
forall k. Ord k => k -> Exp (Single k ())
setSingleton KeyHash 'StakePool (Crypto era)
hk) Exp (Sett (Credential 'Staking era) ())
-> Map (Credential 'Staking era) Coin
-> Exp (Map (Credential 'Staking era) 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 era) Coin
stake)

-- | Calculate total possible refunds.
obligation ::
  PParams era ->
  Map (Credential 'Staking era) Coin ->
  Map (KeyHash 'StakePool (Crypto era)) (PoolParams era) ->
  Coin
obligation :: PParams era
-> Map (Credential 'Staking era) Coin
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams era)
-> Coin
obligation PParams era
pp Map (Credential 'Staking era) Coin
rewards Map (KeyHash 'StakePool (Crypto era)) (PoolParams era)
stakePools =
  (Map (Credential 'Staking era) Coin -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Map (Credential 'Staking 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 era) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Map (KeyHash 'StakePool (Crypto era)) (PoolParams 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 era = SnapShot
  { SnapShot era -> Stake era
_stake :: !(Stake era),
    SnapShot era
-> Map (Credential 'Staking era) (KeyHash 'StakePool (Crypto era))
_delegations :: !(Map (Credential 'Staking era) (KeyHash 'StakePool (Crypto era))),
    SnapShot era
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams era)
_poolParams :: !(Map (KeyHash 'StakePool (Crypto era)) (PoolParams era))
  }
  deriving (Int -> SnapShot era -> ShowS
[SnapShot era] -> ShowS
SnapShot era -> String
(Int -> SnapShot era -> ShowS)
-> (SnapShot era -> String)
-> ([SnapShot era] -> ShowS)
-> Show (SnapShot era)
forall era. Int -> SnapShot era -> ShowS
forall era. [SnapShot era] -> ShowS
forall era. SnapShot era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SnapShot era] -> ShowS
$cshowList :: forall era. [SnapShot era] -> ShowS
show :: SnapShot era -> String
$cshow :: forall era. SnapShot era -> String
showsPrec :: Int -> SnapShot era -> ShowS
$cshowsPrec :: forall era. Int -> SnapShot era -> ShowS
Show, SnapShot era -> SnapShot era -> Bool
(SnapShot era -> SnapShot era -> Bool)
-> (SnapShot era -> SnapShot era -> Bool) -> Eq (SnapShot era)
forall era. SnapShot era -> SnapShot era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SnapShot era -> SnapShot era -> Bool
$c/= :: forall era. SnapShot era -> SnapShot era -> Bool
== :: SnapShot era -> SnapShot era -> Bool
$c== :: forall era. SnapShot era -> SnapShot era -> Bool
Eq, (forall x. SnapShot era -> Rep (SnapShot era) x)
-> (forall x. Rep (SnapShot era) x -> SnapShot era)
-> Generic (SnapShot era)
forall x. Rep (SnapShot era) x -> SnapShot era
forall x. SnapShot era -> Rep (SnapShot era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (SnapShot era) x -> SnapShot era
forall era x. SnapShot era -> Rep (SnapShot era) x
$cto :: forall era x. Rep (SnapShot era) x -> SnapShot era
$cfrom :: forall era x. SnapShot era -> Rep (SnapShot era) x
Generic)

instance NoThunks (SnapShot era)

instance NFData (SnapShot era)

instance
  (Era era, Core.AnnotatedData (Core.Script era)) =>
  ToCBOR (SnapShot era)
  where
  toCBOR :: SnapShot era -> Encoding
toCBOR
    ( SnapShot
        { $sel:_stake:SnapShot :: forall era. SnapShot era -> Stake era
_stake = Stake era
s,
          $sel:_delegations:SnapShot :: forall era.
SnapShot era
-> Map (Credential 'Staking era) (KeyHash 'StakePool (Crypto era))
_delegations = Map (Credential 'Staking era) (KeyHash 'StakePool (Crypto era))
d,
          $sel:_poolParams:SnapShot :: forall era.
SnapShot era
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams era)
_poolParams = Map (KeyHash 'StakePool (Crypto era)) (PoolParams era)
p
        }
      ) =
      Word -> Encoding
encodeListLen Word
3
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Stake era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Stake era
s
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map (Credential 'Staking era) (KeyHash 'StakePool (Crypto era))
-> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Map (Credential 'Staking era) (KeyHash 'StakePool (Crypto era))
d
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map (KeyHash 'StakePool (Crypto era)) (PoolParams era) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Map (KeyHash 'StakePool (Crypto era)) (PoolParams era)
p

instance
  (Era era, Core.AnnotatedData (Core.Script era)) =>
  FromCBOR (SnapShot era)
  where
  fromCBOR :: Decoder s (SnapShot era)
fromCBOR = do
    Text
-> (SnapShot era -> Int)
-> Decoder s (SnapShot era)
-> Decoder s (SnapShot era)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"SnapShot" (Int -> SnapShot era -> Int
forall a b. a -> b -> a
const Int
3) (Decoder s (SnapShot era) -> Decoder s (SnapShot era))
-> Decoder s (SnapShot era) -> Decoder s (SnapShot era)
forall a b. (a -> b) -> a -> b
$ do
      Stake era
s <- Decoder s (Stake era)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Map (Credential 'Staking era) (KeyHash 'StakePool (Crypto era))
d <- Decoder
  s (Map (Credential 'Staking era) (KeyHash 'StakePool (Crypto era)))
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Map (KeyHash 'StakePool (Crypto era)) (PoolParams era)
p <- Decoder s (Map (KeyHash 'StakePool (Crypto era)) (PoolParams era))
forall a s. FromCBOR a => Decoder s a
fromCBOR
      SnapShot era -> Decoder s (SnapShot era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SnapShot era -> Decoder s (SnapShot era))
-> SnapShot era -> Decoder s (SnapShot era)
forall a b. (a -> b) -> a -> b
$ Stake era
-> Map (Credential 'Staking era) (KeyHash 'StakePool (Crypto era))
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams era)
-> SnapShot era
forall era.
Stake era
-> Map (Credential 'Staking era) (KeyHash 'StakePool (Crypto era))
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams era)
-> SnapShot era
SnapShot Stake era
s Map (Credential 'Staking era) (KeyHash 'StakePool (Crypto era))
d Map (KeyHash 'StakePool (Crypto era)) (PoolParams era)
p

-- | Snapshots of the stake distribution.
data SnapShots era = SnapShots
  { SnapShots era -> SnapShot era
_pstakeMark :: !(SnapShot era),
    SnapShots era -> SnapShot era
_pstakeSet :: !(SnapShot era),
    SnapShots era -> SnapShot era
_pstakeGo :: !(SnapShot era),
    SnapShots era -> Coin
_feeSS :: !Coin
  }
  deriving (Int -> SnapShots era -> ShowS
[SnapShots era] -> ShowS
SnapShots era -> String
(Int -> SnapShots era -> ShowS)
-> (SnapShots era -> String)
-> ([SnapShots era] -> ShowS)
-> Show (SnapShots era)
forall era. Int -> SnapShots era -> ShowS
forall era. [SnapShots era] -> ShowS
forall era. SnapShots era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SnapShots era] -> ShowS
$cshowList :: forall era. [SnapShots era] -> ShowS
show :: SnapShots era -> String
$cshow :: forall era. SnapShots era -> String
showsPrec :: Int -> SnapShots era -> ShowS
$cshowsPrec :: forall era. Int -> SnapShots era -> ShowS
Show, SnapShots era -> SnapShots era -> Bool
(SnapShots era -> SnapShots era -> Bool)
-> (SnapShots era -> SnapShots era -> Bool) -> Eq (SnapShots era)
forall era. SnapShots era -> SnapShots era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SnapShots era -> SnapShots era -> Bool
$c/= :: forall era. SnapShots era -> SnapShots era -> Bool
== :: SnapShots era -> SnapShots era -> Bool
$c== :: forall era. SnapShots era -> SnapShots era -> Bool
Eq, (forall x. SnapShots era -> Rep (SnapShots era) x)
-> (forall x. Rep (SnapShots era) x -> SnapShots era)
-> Generic (SnapShots era)
forall x. Rep (SnapShots era) x -> SnapShots era
forall x. SnapShots era -> Rep (SnapShots era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (SnapShots era) x -> SnapShots era
forall era x. SnapShots era -> Rep (SnapShots era) x
$cto :: forall era x. Rep (SnapShots era) x -> SnapShots era
$cfrom :: forall era x. SnapShots era -> Rep (SnapShots era) x
Generic)

instance NoThunks (SnapShots era)

instance NFData (SnapShots era)

instance
  (Era era, Core.AnnotatedData (Core.Script era)) =>
  ToCBOR (SnapShots era)
  where
  toCBOR :: SnapShots era -> Encoding
toCBOR (SnapShots SnapShot era
mark SnapShot era
set SnapShot era
go Coin
fs) =
    Word -> Encoding
encodeListLen Word
4
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SnapShot era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR SnapShot era
mark
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SnapShot era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR SnapShot era
set
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SnapShot era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR SnapShot era
go
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Coin -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Coin
fs

instance
  (Era era, Core.AnnotatedData (Core.Script era)) =>
  FromCBOR (SnapShots era)
  where
  fromCBOR :: Decoder s (SnapShots era)
fromCBOR = do
    Text
-> (SnapShots era -> Int)
-> Decoder s (SnapShots era)
-> Decoder s (SnapShots era)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"SnapShots" (Int -> SnapShots era -> Int
forall a b. a -> b -> a
const Int
4) (Decoder s (SnapShots era) -> Decoder s (SnapShots era))
-> Decoder s (SnapShots era) -> Decoder s (SnapShots era)
forall a b. (a -> b) -> a -> b
$ do
      SnapShot era
mark <- Decoder s (SnapShot era)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      SnapShot era
set <- Decoder s (SnapShot era)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      SnapShot era
go <- Decoder s (SnapShot era)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Coin
f <- Decoder s Coin
forall a s. FromCBOR a => Decoder s a
fromCBOR
      SnapShots era -> Decoder s (SnapShots era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SnapShots era -> Decoder s (SnapShots era))
-> SnapShots era -> Decoder s (SnapShots era)
forall a b. (a -> b) -> a -> b
$ SnapShot era
-> SnapShot era -> SnapShot era -> Coin -> SnapShots era
forall era.
SnapShot era
-> SnapShot era -> SnapShot era -> Coin -> SnapShots era
SnapShots SnapShot era
mark SnapShot era
set SnapShot era
go Coin
f

emptySnapShot :: SnapShot era
emptySnapShot :: SnapShot era
emptySnapShot = Stake era
-> Map (Credential 'Staking era) (KeyHash 'StakePool (Crypto era))
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams era)
-> SnapShot era
forall era.
Stake era
-> Map (Credential 'Staking era) (KeyHash 'StakePool (Crypto era))
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams era)
-> SnapShot era
SnapShot (Map (Credential 'Staking era) Coin -> Stake era
forall era. Map (Credential 'Staking era) Coin -> Stake era
Stake Map (Credential 'Staking era) Coin
forall k a. Map k a
Map.empty) Map (Credential 'Staking era) (KeyHash 'StakePool (Crypto era))
forall k a. Map k a
Map.empty Map (KeyHash 'StakePool (Crypto era)) (PoolParams era)
forall k a. Map k a
Map.empty

emptySnapShots :: SnapShots era
emptySnapShots :: SnapShots era
emptySnapShots = SnapShot era
-> SnapShot era -> SnapShot era -> Coin -> SnapShots era
forall era.
SnapShot era
-> SnapShot era -> SnapShot era -> Coin -> SnapShots era
SnapShots SnapShot era
forall era. SnapShot era
emptySnapShot SnapShot era
forall era. SnapShot era
emptySnapShot SnapShot era
forall era. SnapShot era
emptySnapShot (Integer -> Coin
Coin Integer
0)