{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# 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 Cardano.Ledger.State.SnapShots (
  Stake (..),
  sumAllStake,
  sumAllStakeCompact,
  sumStakePerPool,
  SnapShot (..),
  SnapShots (..),
  emptySnapShot,
  emptySnapShots,
  poolStake,
  maxPool,
  maxPool',
  calculatePoolDistr,
  calculatePoolDistr',
  calculatePoolStake,
  ssStakeMarkL,
  ssStakeMarkPoolDistrL,
  ssStakeSetL,
  ssStakeGoL,
  ssFeeL,
  ssStakeL,
  ssStakeDistrL,
  ssDelegationsL,
  ssPoolParamsL,
) where

import Cardano.Ledger.BaseTypes (
  BoundedRational (..),
  KeyValuePairs (..),
  NonNegativeInterval,
  NonZero (..),
  ToKeyValuePairs (..),
  knownNonZeroBounded,
  nonZeroOr,
  recipNonZero,
  toIntegerNonZero,
  toRatioNonZero,
  (%.),
  (/.),
 )
import Cardano.Ledger.Binary (
  DecCBOR (decCBOR),
  DecShareCBOR (..),
  EncCBOR (encCBOR),
  Interns,
  decNoShareCBOR,
  decSharePlusLensCBOR,
  decodeRecordNamedT,
  encodeListLen,
  toMemptyLens,
 )
import Cardano.Ledger.Coin (
  Coin (..),
  CompactForm (..),
  coinToRational,
  compactCoinNonZero,
  fromCompactCoinNonZero,
  rationalToCoinViaFloor,
  unCoinNonZero,
 )
import Cardano.Ledger.Compactible
import Cardano.Ledger.Core
import Cardano.Ledger.Credential (Credential)
import Cardano.Ledger.State.PoolDistr (IndividualPoolStake (..), PoolDistr (..))
import Cardano.Ledger.State.StakePool (StakePoolParams (sppVrf))
import Cardano.Ledger.Val ((<+>))
import Control.DeepSeq (NFData)
import Control.Monad.Trans (lift)
import Data.Aeson (ToJSON (..), (.=))
import Data.Default (Default, def)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe)
import Data.VMap as VMap
import Data.Word (Word16)
import GHC.Generics (Generic)
import GHC.Word (Word64)
import Lens.Micro (Lens', lens, (^.), _1, _2)
import NoThunks.Class (AllowThunksIn (..), NoThunks (..))

-- | Type of stake as map from staking credential to coins associated. Any staking credential that
-- has no stake will not appear in this Map, even if it is registered. For this reason, this data
-- type should not be used for infering whether credential is registered or not.
newtype Stake = Stake
  { Stake -> VMap VB VP (Credential Staking) (CompactForm Coin)
unStake :: VMap VB VP (Credential Staking) (CompactForm Coin)
  }
  deriving (Int -> Stake -> ShowS
[Stake] -> ShowS
Stake -> String
(Int -> Stake -> ShowS)
-> (Stake -> String) -> ([Stake] -> ShowS) -> Show Stake
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Stake -> ShowS
showsPrec :: Int -> Stake -> ShowS
$cshow :: Stake -> String
show :: Stake -> String
$cshowList :: [Stake] -> ShowS
showList :: [Stake] -> ShowS
Show, Stake -> Stake -> Bool
(Stake -> Stake -> Bool) -> (Stake -> Stake -> Bool) -> Eq Stake
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Stake -> Stake -> Bool
== :: Stake -> Stake -> Bool
$c/= :: Stake -> Stake -> Bool
/= :: Stake -> Stake -> Bool
Eq, Stake -> ()
(Stake -> ()) -> NFData Stake
forall a. (a -> ()) -> NFData a
$crnf :: Stake -> ()
rnf :: Stake -> ()
NFData, (forall x. Stake -> Rep Stake x)
-> (forall x. Rep Stake x -> Stake) -> Generic Stake
forall x. Rep Stake x -> Stake
forall x. Stake -> Rep Stake x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Stake -> Rep Stake x
from :: forall x. Stake -> Rep Stake x
$cto :: forall x. Rep Stake x -> Stake
to :: forall x. Rep Stake x -> Stake
Generic, [Stake] -> Value
[Stake] -> Encoding
Stake -> Bool
Stake -> Value
Stake -> Encoding
(Stake -> Value)
-> (Stake -> Encoding)
-> ([Stake] -> Value)
-> ([Stake] -> Encoding)
-> (Stake -> Bool)
-> ToJSON Stake
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Stake -> Value
toJSON :: Stake -> Value
$ctoEncoding :: Stake -> Encoding
toEncoding :: Stake -> Encoding
$ctoJSONList :: [Stake] -> Value
toJSONList :: [Stake] -> Value
$ctoEncodingList :: [Stake] -> Encoding
toEncodingList :: [Stake] -> Encoding
$comitField :: Stake -> Bool
omitField :: Stake -> Bool
ToJSON, Context -> Stake -> IO (Maybe ThunkInfo)
Proxy Stake -> String
(Context -> Stake -> IO (Maybe ThunkInfo))
-> (Context -> Stake -> IO (Maybe ThunkInfo))
-> (Proxy Stake -> String)
-> NoThunks Stake
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> Stake -> IO (Maybe ThunkInfo)
noThunks :: Context -> Stake -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> Stake -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> Stake -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy Stake -> String
showTypeOf :: Proxy Stake -> String
NoThunks, Stake -> Encoding
(Stake -> Encoding) -> EncCBOR Stake
forall a. (a -> Encoding) -> EncCBOR a
$cencCBOR :: Stake -> Encoding
encCBOR :: Stake -> Encoding
EncCBOR)

instance DecShareCBOR Stake where
  type Share Stake = Share (VMap VB VP (Credential Staking) (CompactForm Coin))
  getShare :: Stake -> Share Stake
getShare = VMap VB VP (Credential Staking) (CompactForm Coin)
-> Share (VMap VB VP (Credential Staking) (CompactForm Coin))
VMap VB VP (Credential Staking) (CompactForm Coin)
-> Interns (Credential Staking)
forall a. DecShareCBOR a => a -> Share a
getShare (VMap VB VP (Credential Staking) (CompactForm Coin)
 -> Interns (Credential Staking))
-> (Stake -> VMap VB VP (Credential Staking) (CompactForm Coin))
-> Stake
-> Interns (Credential Staking)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stake -> VMap VB VP (Credential Staking) (CompactForm Coin)
unStake
  decShareCBOR :: forall s. Share Stake -> Decoder s Stake
decShareCBOR = (VMap VB VP (Credential Staking) (CompactForm Coin) -> Stake)
-> Decoder s (VMap VB VP (Credential Staking) (CompactForm Coin))
-> Decoder s Stake
forall a b. (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap VMap VB VP (Credential Staking) (CompactForm Coin) -> Stake
Stake (Decoder s (VMap VB VP (Credential Staking) (CompactForm Coin))
 -> Decoder s Stake)
-> (Interns (Credential Staking)
    -> Decoder s (VMap VB VP (Credential Staking) (CompactForm Coin)))
-> Interns (Credential Staking)
-> Decoder s Stake
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Share (VMap VB VP (Credential Staking) (CompactForm Coin))
-> Decoder s (VMap VB VP (Credential Staking) (CompactForm Coin))
Interns (Credential Staking)
-> Decoder s (VMap VB VP (Credential Staking) (CompactForm Coin))
forall a s. DecShareCBOR a => Share a -> Decoder s a
forall s.
Share (VMap VB VP (Credential Staking) (CompactForm Coin))
-> Decoder s (VMap VB VP (Credential Staking) (CompactForm Coin))
decShareCBOR

sumAllStake :: Stake -> Coin
sumAllStake :: Stake -> Coin
sumAllStake = CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact (CompactForm Coin -> Coin)
-> (Stake -> CompactForm Coin) -> Stake -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stake -> CompactForm Coin
sumAllStakeCompact
{-# INLINE sumAllStake #-}

sumAllStakeCompact :: Stake -> CompactForm Coin
sumAllStakeCompact :: Stake -> CompactForm Coin
sumAllStakeCompact = (CompactForm Coin -> CompactForm Coin -> CompactForm Coin)
-> CompactForm Coin
-> VMap VB VP (Credential Staking) (CompactForm Coin)
-> CompactForm Coin
forall (vv :: * -> *) v a (kv :: * -> *) k.
Vector vv v =>
(a -> v -> a) -> a -> VMap kv vv k v -> a
VMap.foldl CompactForm Coin -> CompactForm Coin -> CompactForm Coin
forall a. Semigroup a => a -> a -> a
(<>) CompactForm Coin
forall a. Monoid a => a
mempty (VMap VB VP (Credential Staking) (CompactForm Coin)
 -> CompactForm Coin)
-> (Stake -> VMap VB VP (Credential Staking) (CompactForm Coin))
-> Stake
-> CompactForm Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stake -> VMap VB VP (Credential Staking) (CompactForm Coin)
unStake
{-# INLINE sumAllStakeCompact #-}

-- | Get stake of one pool
poolStake ::
  KeyHash StakePool ->
  VMap VB VB (Credential Staking) (KeyHash StakePool) ->
  Stake ->
  Stake
poolStake :: KeyHash StakePool
-> VMap VB VB (Credential Staking) (KeyHash StakePool)
-> Stake
-> Stake
poolStake KeyHash StakePool
hk VMap VB VB (Credential Staking) (KeyHash StakePool)
delegs (Stake VMap VB VP (Credential Staking) (CompactForm Coin)
stake) =
  -- Stake $ (eval (dom (delegs ▷ setSingleton hk) ◁ stake))
  VMap VB VP (Credential Staking) (CompactForm Coin) -> Stake
Stake (VMap VB VP (Credential Staking) (CompactForm Coin) -> Stake)
-> VMap VB VP (Credential Staking) (CompactForm Coin) -> Stake
forall a b. (a -> b) -> a -> b
$ (Credential Staking -> CompactForm Coin -> Bool)
-> VMap VB VP (Credential Staking) (CompactForm Coin)
-> VMap VB VP (Credential Staking) (CompactForm Coin)
forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
(k -> v -> Bool) -> VMap kv vv k v -> VMap kv vv k v
VMap.filter (\Credential Staking
cred CompactForm Coin
_ -> Credential Staking
-> VMap VB VB (Credential Staking) (KeyHash StakePool)
-> Maybe (KeyHash StakePool)
forall k (kv :: * -> *) (vv :: * -> *) v.
(Ord k, Vector kv k, Vector vv v) =>
k -> VMap kv vv k v -> Maybe v
VMap.lookup Credential Staking
cred VMap VB VB (Credential Staking) (KeyHash StakePool)
delegs Maybe (KeyHash StakePool) -> Maybe (KeyHash StakePool) -> Bool
forall a. Eq a => a -> a -> Bool
== KeyHash StakePool -> Maybe (KeyHash StakePool)
forall a. a -> Maybe a
Just KeyHash StakePool
hk) VMap VB VP (Credential Staking) (CompactForm Coin)
stake

-- | Compute amount of stake each pool has. Any registered stake pool that has no stake will not be
-- included in the resulting map
sumStakePerPool ::
  VMap VB VB (Credential Staking) (KeyHash StakePool) ->
  Stake ->
  Map (KeyHash StakePool) Coin
sumStakePerPool :: VMap VB VB (Credential Staking) (KeyHash StakePool)
-> Stake -> Map (KeyHash StakePool) Coin
sumStakePerPool VMap VB VB (Credential Staking) (KeyHash StakePool)
delegs (Stake VMap VB VP (Credential Staking) (CompactForm Coin)
stake) = (Map (KeyHash StakePool) Coin
 -> Credential Staking
 -> CompactForm Coin
 -> Map (KeyHash StakePool) Coin)
-> Map (KeyHash StakePool) Coin
-> VMap VB VP (Credential Staking) (CompactForm Coin)
-> Map (KeyHash StakePool) Coin
forall (kv :: * -> *) k (vv :: * -> *) v a.
(Vector kv k, Vector vv v) =>
(a -> k -> v -> a) -> a -> VMap kv vv k v -> a
VMap.foldlWithKey Map (KeyHash StakePool) Coin
-> Credential Staking
-> CompactForm Coin
-> Map (KeyHash StakePool) Coin
accum Map (KeyHash StakePool) Coin
forall k a. Map k a
Map.empty VMap VB VP (Credential Staking) (CompactForm Coin)
stake
  where
    accum :: Map (KeyHash StakePool) Coin
-> Credential Staking
-> CompactForm Coin
-> Map (KeyHash StakePool) Coin
accum !Map (KeyHash StakePool) Coin
acc Credential Staking
cred CompactForm Coin
compactCoin =
      case Credential Staking
-> VMap VB VB (Credential Staking) (KeyHash StakePool)
-> Maybe (KeyHash StakePool)
forall k (kv :: * -> *) (vv :: * -> *) v.
(Ord k, Vector kv k, Vector vv v) =>
k -> VMap kv vv k v -> Maybe v
VMap.lookup Credential Staking
cred VMap VB VB (Credential Staking) (KeyHash StakePool)
delegs of
        Maybe (KeyHash StakePool)
Nothing -> Map (KeyHash StakePool) Coin
acc
        Just KeyHash StakePool
kh -> (Coin -> Coin -> Coin)
-> KeyHash StakePool
-> Coin
-> Map (KeyHash StakePool) Coin
-> Map (KeyHash StakePool) Coin
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
(<+>) KeyHash StakePool
kh (CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm Coin
compactCoin) Map (KeyHash StakePool) Coin
acc

-- | Calculate maximal pool reward
maxPool' ::
  NonNegativeInterval ->
  NonZero Word16 ->
  Coin ->
  Rational ->
  Rational ->
  Coin
maxPool' :: NonNegativeInterval
-> NonZero Word16 -> Coin -> Rational -> Rational -> Coin
maxPool' NonNegativeInterval
a0 NonZero Word16
nOpt 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
    nonZeroZ0 :: NonZero Rational
nonZeroZ0 = NonZero Rational -> NonZero Rational
forall a. Integral a => NonZero (Ratio a) -> NonZero (Ratio a)
recipNonZero (NonZero Rational -> NonZero Rational)
-> (NonZero Integer -> NonZero Rational)
-> NonZero Integer
-> NonZero Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonZero Integer -> NonZero Rational
forall a. Integral a => NonZero a -> NonZero (Ratio a)
toRatioNonZero (NonZero Integer -> NonZero Rational)
-> NonZero Integer -> NonZero Rational
forall a b. (a -> b) -> a -> b
$ NonZero Word16 -> NonZero Integer
forall a. Integral a => NonZero a -> NonZero Integer
toIntegerNonZero NonZero Word16
nOpt
    z0 :: Rational
z0 = NonZero Rational -> Rational
forall a. NonZero a -> a
unNonZero NonZero Rational
nonZeroZ0
    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 =
      -- This division is safe, because a0 is non-negative and we're adding one
      -- to it
      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
+ NonNegativeInterval -> Rational
forall r. BoundedRational r => r -> Rational
unboundRational NonNegativeInterval
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
* NonNegativeInterval -> Rational
forall r. BoundedRational r => r -> Rational
unboundRational NonNegativeInterval
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 -> NonZero Rational -> Rational
forall a. Fractional a => a -> NonZero a -> a
/. NonZero Rational
nonZeroZ0
    factor4 :: Rational
factor4 = (Rational
z0 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
sigma') Rational -> NonZero Rational -> Rational
forall a. Fractional a => a -> NonZero a -> a
/. NonZero Rational
nonZeroZ0

-- | Version of `maxPool'` that extracts `ppA0L` and `ppNOptL` from a `PParams`
maxPool ::
  EraPParams era =>
  PParams era ->
  Coin ->
  Rational ->
  Rational ->
  Coin
maxPool :: forall era.
EraPParams era =>
PParams era -> Coin -> Rational -> Rational -> Coin
maxPool PParams era
pp Coin
r Rational
sigma Rational
pR = NonNegativeInterval
-> NonZero Word16 -> Coin -> Rational -> Rational -> Coin
maxPool' NonNegativeInterval
a0 NonZero Word16
nOpt Coin
r Rational
sigma Rational
pR
  where
    a0 :: NonNegativeInterval
a0 = PParams era
pp PParams era
-> Getting NonNegativeInterval (PParams era) NonNegativeInterval
-> NonNegativeInterval
forall s a. s -> Getting a s a -> a
^. Getting NonNegativeInterval (PParams era) NonNegativeInterval
forall era.
EraPParams era =>
Lens' (PParams era) NonNegativeInterval
Lens' (PParams era) NonNegativeInterval
ppA0L
    nOpt :: NonZero Word16
nOpt = (PParams era
pp PParams era -> Getting Word16 (PParams era) Word16 -> Word16
forall s a. s -> Getting a s a -> a
^. Getting Word16 (PParams era) Word16
forall era. EraPParams era => Lens' (PParams era) Word16
Lens' (PParams era) Word16
ppNOptL) Word16 -> NonZero Word16 -> NonZero Word16
forall a. HasZero a => a -> NonZero a -> NonZero a
`nonZeroOr` forall (n :: Natural) a.
(KnownNat n, 1 <= n, WithinBounds n a, Num a) =>
NonZero a
knownNonZeroBounded @1

-- | Snapshot of the stake distribution.
data SnapShot = SnapShot
  { SnapShot -> Stake
ssStake :: !Stake
  , SnapShot -> VMap VB VB (Credential Staking) (KeyHash StakePool)
ssDelegations :: !(VMap VB VB (Credential Staking) (KeyHash StakePool))
  , SnapShot -> VMap VB VB (KeyHash StakePool) StakePoolParams
ssPoolParams :: !(VMap VB VB (KeyHash StakePool) StakePoolParams)
  }
  deriving (Int -> SnapShot -> ShowS
[SnapShot] -> ShowS
SnapShot -> String
(Int -> SnapShot -> ShowS)
-> (SnapShot -> String) -> ([SnapShot] -> ShowS) -> Show SnapShot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SnapShot -> ShowS
showsPrec :: Int -> SnapShot -> ShowS
$cshow :: SnapShot -> String
show :: SnapShot -> String
$cshowList :: [SnapShot] -> ShowS
showList :: [SnapShot] -> ShowS
Show, SnapShot -> SnapShot -> Bool
(SnapShot -> SnapShot -> Bool)
-> (SnapShot -> SnapShot -> Bool) -> Eq SnapShot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SnapShot -> SnapShot -> Bool
== :: SnapShot -> SnapShot -> Bool
$c/= :: SnapShot -> SnapShot -> Bool
/= :: SnapShot -> SnapShot -> Bool
Eq, (forall x. SnapShot -> Rep SnapShot x)
-> (forall x. Rep SnapShot x -> SnapShot) -> Generic SnapShot
forall x. Rep SnapShot x -> SnapShot
forall x. SnapShot -> Rep SnapShot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SnapShot -> Rep SnapShot x
from :: forall x. SnapShot -> Rep SnapShot x
$cto :: forall x. Rep SnapShot x -> SnapShot
to :: forall x. Rep SnapShot x -> SnapShot
Generic)
  deriving ([SnapShot] -> Value
[SnapShot] -> Encoding
SnapShot -> Bool
SnapShot -> Value
SnapShot -> Encoding
(SnapShot -> Value)
-> (SnapShot -> Encoding)
-> ([SnapShot] -> Value)
-> ([SnapShot] -> Encoding)
-> (SnapShot -> Bool)
-> ToJSON SnapShot
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: SnapShot -> Value
toJSON :: SnapShot -> Value
$ctoEncoding :: SnapShot -> Encoding
toEncoding :: SnapShot -> Encoding
$ctoJSONList :: [SnapShot] -> Value
toJSONList :: [SnapShot] -> Value
$ctoEncodingList :: [SnapShot] -> Encoding
toEncodingList :: [SnapShot] -> Encoding
$comitField :: SnapShot -> Bool
omitField :: SnapShot -> Bool
ToJSON) via KeyValuePairs SnapShot

instance NoThunks SnapShot

instance NFData SnapShot

instance EncCBOR SnapShot where
  encCBOR :: SnapShot -> Encoding
encCBOR SnapShot {Stake
ssStake :: SnapShot -> Stake
ssStake :: Stake
ssStake, VMap VB VB (Credential Staking) (KeyHash StakePool)
ssDelegations :: SnapShot -> VMap VB VB (Credential Staking) (KeyHash StakePool)
ssDelegations :: VMap VB VB (Credential Staking) (KeyHash StakePool)
ssDelegations, VMap VB VB (KeyHash StakePool) StakePoolParams
ssPoolParams :: SnapShot -> VMap VB VB (KeyHash StakePool) StakePoolParams
ssPoolParams :: VMap VB VB (KeyHash StakePool) StakePoolParams
ssPoolParams} =
    Word -> Encoding
encodeListLen Word
3
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Stake -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Stake
ssStake
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> VMap VB VB (Credential Staking) (KeyHash StakePool) -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR VMap VB VB (Credential Staking) (KeyHash StakePool)
ssDelegations
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> VMap VB VB (KeyHash StakePool) StakePoolParams -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR VMap VB VB (KeyHash StakePool) StakePoolParams
ssPoolParams

instance DecShareCBOR SnapShot where
  type Share SnapShot = (Interns (Credential Staking), Interns (KeyHash StakePool))
  decSharePlusCBOR :: forall s. StateT (Share SnapShot) (Decoder s) SnapShot
decSharePlusCBOR = Text
-> (SnapShot -> Int)
-> StateT (Share SnapShot) (Decoder s) SnapShot
-> StateT (Share SnapShot) (Decoder s) SnapShot
forall (m :: (* -> *) -> * -> *) s a.
(MonadTrans m, Monad (m (Decoder s))) =>
Text -> (a -> Int) -> m (Decoder s) a -> m (Decoder s) a
decodeRecordNamedT Text
"SnapShot" (Int -> SnapShot -> Int
forall a b. a -> b -> a
const Int
3) (StateT (Share SnapShot) (Decoder s) SnapShot
 -> StateT (Share SnapShot) (Decoder s) SnapShot)
-> StateT (Share SnapShot) (Decoder s) SnapShot
-> StateT (Share SnapShot) (Decoder s) SnapShot
forall a b. (a -> b) -> a -> b
$ do
    ssStake <- Lens'
  (Interns (Credential Staking), Interns (KeyHash StakePool))
  (Share Stake)
-> StateT
     (Interns (Credential Staking), Interns (KeyHash StakePool))
     (Decoder s)
     Stake
forall b bs s.
DecShareCBOR b =>
Lens' bs (Share b) -> StateT bs (Decoder s) b
decSharePlusLensCBOR (Share Stake -> f (Share Stake))
-> (Interns (Credential Staking), Interns (KeyHash StakePool))
-> f (Interns (Credential Staking), Interns (KeyHash StakePool))
(Interns (Credential Staking) -> f (Interns (Credential Staking)))
-> (Interns (Credential Staking), Interns (KeyHash StakePool))
-> f (Interns (Credential Staking), Interns (KeyHash StakePool))
forall s t a b. Field1 s t a b => Lens s t a b
Lens'
  (Interns (Credential Staking), Interns (KeyHash StakePool))
  (Share Stake)
Lens
  (Interns (Credential Staking), Interns (KeyHash StakePool))
  (Interns (Credential Staking), Interns (KeyHash StakePool))
  (Interns (Credential Staking))
  (Interns (Credential Staking))
_1
    ssDelegations <- decSharePlusCBOR
    ssPoolParams <- decSharePlusLensCBOR (toMemptyLens _1 _2)
    pure SnapShot {ssStake, ssDelegations, ssPoolParams}

instance ToKeyValuePairs SnapShot where
  toKeyValuePairs :: forall e kv. KeyValue e kv => SnapShot -> [kv]
toKeyValuePairs ss :: SnapShot
ss@(SnapShot Stake
_ VMap VB VB (Credential Staking) (KeyHash StakePool)
_ VMap VB VB (KeyHash StakePool) StakePoolParams
_) =
    let SnapShot {VMap VB VB (KeyHash StakePool) StakePoolParams
VMap VB VB (Credential Staking) (KeyHash StakePool)
Stake
ssStake :: SnapShot -> Stake
ssDelegations :: SnapShot -> VMap VB VB (Credential Staking) (KeyHash StakePool)
ssPoolParams :: SnapShot -> VMap VB VB (KeyHash StakePool) StakePoolParams
ssStake :: Stake
ssDelegations :: VMap VB VB (Credential Staking) (KeyHash StakePool)
ssPoolParams :: VMap VB VB (KeyHash StakePool) StakePoolParams
..} = SnapShot
ss
     in [ Key
"stake" Key -> Stake -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Stake
ssStake
        , Key
"delegations" Key -> VMap VB VB (Credential Staking) (KeyHash StakePool) -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= VMap VB VB (Credential Staking) (KeyHash StakePool)
ssDelegations
        , Key
"poolParams" Key -> VMap VB VB (KeyHash StakePool) StakePoolParams -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= VMap VB VB (KeyHash StakePool) StakePoolParams
ssPoolParams
        ]

-- | Snapshots of the stake distribution.
--
-- Note that ssStakeMark and ssStakeMarkPoolDistr are lazy on
-- purpose since we only want to force the thunk after one stability window
-- when we know that they are stable (so that we do not compute them if we do not have to).
-- See more info in the [Optimize TICKF ADR](https://github.com/intersectmbo/cardano-ledger/blob/master/docs/adr/2022-12-12_007-optimize-ledger-view.md)
data SnapShots = SnapShots
  { SnapShots -> SnapShot
ssStakeMark :: SnapShot -- Lazy on purpose
  , SnapShots -> PoolDistr
ssStakeMarkPoolDistr :: PoolDistr -- Lazy on purpose
  , SnapShots -> SnapShot
ssStakeSet :: !SnapShot
  , SnapShots -> SnapShot
ssStakeGo :: !SnapShot
  , SnapShots -> Coin
ssFee :: !Coin
  }
  deriving (Int -> SnapShots -> ShowS
[SnapShots] -> ShowS
SnapShots -> String
(Int -> SnapShots -> ShowS)
-> (SnapShots -> String)
-> ([SnapShots] -> ShowS)
-> Show SnapShots
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SnapShots -> ShowS
showsPrec :: Int -> SnapShots -> ShowS
$cshow :: SnapShots -> String
show :: SnapShots -> String
$cshowList :: [SnapShots] -> ShowS
showList :: [SnapShots] -> ShowS
Show, SnapShots -> SnapShots -> Bool
(SnapShots -> SnapShots -> Bool)
-> (SnapShots -> SnapShots -> Bool) -> Eq SnapShots
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SnapShots -> SnapShots -> Bool
== :: SnapShots -> SnapShots -> Bool
$c/= :: SnapShots -> SnapShots -> Bool
/= :: SnapShots -> SnapShots -> Bool
Eq, (forall x. SnapShots -> Rep SnapShots x)
-> (forall x. Rep SnapShots x -> SnapShots) -> Generic SnapShots
forall x. Rep SnapShots x -> SnapShots
forall x. SnapShots -> Rep SnapShots x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SnapShots -> Rep SnapShots x
from :: forall x. SnapShots -> Rep SnapShots x
$cto :: forall x. Rep SnapShots x -> SnapShots
to :: forall x. Rep SnapShots x -> SnapShots
Generic)
  deriving ([SnapShots] -> Value
[SnapShots] -> Encoding
SnapShots -> Bool
SnapShots -> Value
SnapShots -> Encoding
(SnapShots -> Value)
-> (SnapShots -> Encoding)
-> ([SnapShots] -> Value)
-> ([SnapShots] -> Encoding)
-> (SnapShots -> Bool)
-> ToJSON SnapShots
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: SnapShots -> Value
toJSON :: SnapShots -> Value
$ctoEncoding :: SnapShots -> Encoding
toEncoding :: SnapShots -> Encoding
$ctoJSONList :: [SnapShots] -> Value
toJSONList :: [SnapShots] -> Value
$ctoEncodingList :: [SnapShots] -> Encoding
toEncodingList :: [SnapShots] -> Encoding
$comitField :: SnapShots -> Bool
omitField :: SnapShots -> Bool
ToJSON) via KeyValuePairs SnapShots
  -- TODO: switch `AllowThunksIn` to `OnlyCheckWhnfNamed`
  deriving (Context -> SnapShots -> IO (Maybe ThunkInfo)
Proxy SnapShots -> String
(Context -> SnapShots -> IO (Maybe ThunkInfo))
-> (Context -> SnapShots -> IO (Maybe ThunkInfo))
-> (Proxy SnapShots -> String)
-> NoThunks SnapShots
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> SnapShots -> IO (Maybe ThunkInfo)
noThunks :: Context -> SnapShots -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> SnapShots -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> SnapShots -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy SnapShots -> String
showTypeOf :: Proxy SnapShots -> String
NoThunks) via AllowThunksIn '["ssStakeMark", "ssStakeMarkPoolDistr"] SnapShots

instance NFData SnapShots

instance EncCBOR SnapShots where
  encCBOR :: SnapShots -> Encoding
encCBOR (SnapShots {SnapShot
ssStakeMark :: SnapShots -> SnapShot
ssStakeMark :: SnapShot
ssStakeMark, SnapShot
ssStakeSet :: SnapShots -> SnapShot
ssStakeSet :: SnapShot
ssStakeSet, SnapShot
ssStakeGo :: SnapShots -> SnapShot
ssStakeGo :: SnapShot
ssStakeGo, Coin
ssFee :: SnapShots -> Coin
ssFee :: Coin
ssFee}) =
    Word -> Encoding
encodeListLen Word
4
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SnapShot -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR SnapShot
ssStakeMark
      -- We intentionaly do not serialize the redundant ssStakeMarkPoolDistr
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SnapShot -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR SnapShot
ssStakeSet
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SnapShot -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR SnapShot
ssStakeGo
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Coin -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Coin
ssFee

instance DecCBOR SnapShots where
  decCBOR :: forall s. Decoder s SnapShots
decCBOR = Decoder s SnapShots
forall a s. DecShareCBOR a => Decoder s a
decNoShareCBOR

instance DecShareCBOR SnapShots where
  type Share SnapShots = Share SnapShot
  decSharePlusCBOR :: forall s. StateT (Share SnapShots) (Decoder s) SnapShots
decSharePlusCBOR = Text
-> (SnapShots -> Int)
-> StateT (Share SnapShots) (Decoder s) SnapShots
-> StateT (Share SnapShots) (Decoder s) SnapShots
forall (m :: (* -> *) -> * -> *) s a.
(MonadTrans m, Monad (m (Decoder s))) =>
Text -> (a -> Int) -> m (Decoder s) a -> m (Decoder s) a
decodeRecordNamedT Text
"SnapShots" (Int -> SnapShots -> Int
forall a b. a -> b -> a
const Int
4) (StateT (Share SnapShots) (Decoder s) SnapShots
 -> StateT (Share SnapShots) (Decoder s) SnapShots)
-> StateT (Share SnapShots) (Decoder s) SnapShots
-> StateT (Share SnapShots) (Decoder s) SnapShots
forall a b. (a -> b) -> a -> b
$ do
    !ssStakeMark <- StateT
  (Interns (Credential Staking), Interns (KeyHash StakePool))
  (Decoder s)
  SnapShot
StateT (Share SnapShot) (Decoder s) SnapShot
forall s. StateT (Share SnapShot) (Decoder s) SnapShot
forall a s. DecShareCBOR a => StateT (Share a) (Decoder s) a
decSharePlusCBOR
    ssStakeSet <- decSharePlusCBOR
    ssStakeGo <- decSharePlusCBOR
    ssFee <- lift decCBOR
    let ssStakeMarkPoolDistr = SnapShot -> PoolDistr
calculatePoolDistr SnapShot
ssStakeMark
    pure SnapShots {ssStakeMark, ssStakeMarkPoolDistr, ssStakeSet, ssStakeGo, ssFee}

instance Default SnapShots where
  def :: SnapShots
def = SnapShots
emptySnapShots

instance ToKeyValuePairs SnapShots where
  toKeyValuePairs :: forall e kv. KeyValue e kv => SnapShots -> [kv]
toKeyValuePairs ss :: SnapShots
ss@(SnapShots !SnapShot
_ PoolDistr
_ SnapShot
_ SnapShot
_ Coin
_) =
    -- ssStakeMarkPoolDistr is omitted on purpose
    let SnapShots {SnapShot
ssStakeMark :: SnapShots -> SnapShot
ssStakeMark :: SnapShot
ssStakeMark, SnapShot
ssStakeSet :: SnapShots -> SnapShot
ssStakeSet :: SnapShot
ssStakeSet, SnapShot
ssStakeGo :: SnapShots -> SnapShot
ssStakeGo :: SnapShot
ssStakeGo, Coin
ssFee :: SnapShots -> Coin
ssFee :: Coin
ssFee} = SnapShots
ss
     in [ Key
"pstakeMark" Key -> SnapShot -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SnapShot
ssStakeMark
        , Key
"pstakeSet" Key -> SnapShot -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SnapShot
ssStakeSet
        , Key
"pstakeGo" Key -> SnapShot -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SnapShot
ssStakeGo
        , Key
"feeSS" Key -> Coin -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin
ssFee
        ]

emptySnapShot :: SnapShot
emptySnapShot :: SnapShot
emptySnapShot = Stake
-> VMap VB VB (Credential Staking) (KeyHash StakePool)
-> VMap VB VB (KeyHash StakePool) StakePoolParams
-> SnapShot
SnapShot (VMap VB VP (Credential Staking) (CompactForm Coin) -> Stake
Stake VMap VB VP (Credential Staking) (CompactForm Coin)
forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
VMap kv vv k v
VMap.empty) VMap VB VB (Credential Staking) (KeyHash StakePool)
forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
VMap kv vv k v
VMap.empty VMap VB VB (KeyHash StakePool) StakePoolParams
forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
VMap kv vv k v
VMap.empty

emptySnapShots :: SnapShots
emptySnapShots :: SnapShots
emptySnapShots =
  SnapShot -> PoolDistr -> SnapShot -> SnapShot -> Coin -> SnapShots
SnapShots SnapShot
emptySnapShot (SnapShot -> PoolDistr
calculatePoolDistr SnapShot
emptySnapShot) SnapShot
emptySnapShot SnapShot
emptySnapShot (Integer -> Coin
Coin Integer
0)

-- =======================================

-- | Sum up the Coin (as CompactForm Coin = Word64) for each StakePool
calculatePoolStake ::
  (KeyHash StakePool -> Bool) ->
  VMap VB VB (Credential Staking) (KeyHash StakePool) ->
  Stake ->
  Map.Map (KeyHash StakePool) Word64
calculatePoolStake :: (KeyHash StakePool -> Bool)
-> VMap VB VB (Credential Staking) (KeyHash StakePool)
-> Stake
-> Map (KeyHash StakePool) Word64
calculatePoolStake KeyHash StakePool -> Bool
includeHash VMap VB VB (Credential Staking) (KeyHash StakePool)
delegs Stake
stake = (Map (KeyHash StakePool) Word64
 -> Credential Staking
 -> KeyHash StakePool
 -> Map (KeyHash StakePool) Word64)
-> Map (KeyHash StakePool) Word64
-> VMap VB VB (Credential Staking) (KeyHash StakePool)
-> Map (KeyHash StakePool) Word64
forall (kv :: * -> *) k (vv :: * -> *) v a.
(Vector kv k, Vector vv v) =>
(a -> k -> v -> a) -> a -> VMap kv vv k v -> a
VMap.foldlWithKey Map (KeyHash StakePool) Word64
-> Credential Staking
-> KeyHash StakePool
-> Map (KeyHash StakePool) Word64
accum Map (KeyHash StakePool) Word64
forall k a. Map k a
Map.empty VMap VB VB (Credential Staking) (KeyHash StakePool)
delegs
  where
    accum :: Map (KeyHash StakePool) Word64
-> Credential Staking
-> KeyHash StakePool
-> Map (KeyHash StakePool) Word64
accum Map (KeyHash StakePool) Word64
ans Credential Staking
cred KeyHash StakePool
keyHash =
      if KeyHash StakePool -> Bool
includeHash KeyHash StakePool
keyHash
        then
          let CompactCoin Word64
c = CompactForm Coin -> Maybe (CompactForm Coin) -> CompactForm Coin
forall a. a -> Maybe a -> a
fromMaybe CompactForm Coin
forall a. Monoid a => a
mempty (Maybe (CompactForm Coin) -> CompactForm Coin)
-> Maybe (CompactForm Coin) -> CompactForm Coin
forall a b. (a -> b) -> a -> b
$ Credential Staking
-> VMap VB VP (Credential Staking) (CompactForm Coin)
-> Maybe (CompactForm Coin)
forall k (kv :: * -> *) (vv :: * -> *) v.
(Ord k, Vector kv k, Vector vv v) =>
k -> VMap kv vv k v -> Maybe v
VMap.lookup Credential Staking
cred (Stake -> VMap VB VP (Credential Staking) (CompactForm Coin)
unStake Stake
stake)
           in (Word64 -> Word64 -> Word64)
-> KeyHash StakePool
-> Word64
-> Map (KeyHash StakePool) Word64
-> Map (KeyHash StakePool) Word64
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
(+) KeyHash StakePool
keyHash Word64
c Map (KeyHash StakePool) Word64
ans
        else Map (KeyHash StakePool) Word64
ans

calculatePoolDistr :: SnapShot -> PoolDistr
calculatePoolDistr :: SnapShot -> PoolDistr
calculatePoolDistr = (KeyHash StakePool -> Bool) -> SnapShot -> PoolDistr
calculatePoolDistr' (Bool -> KeyHash StakePool -> Bool
forall a b. a -> b -> a
const Bool
True)

calculatePoolDistr' :: (KeyHash StakePool -> Bool) -> SnapShot -> PoolDistr
calculatePoolDistr' :: (KeyHash StakePool -> Bool) -> SnapShot -> PoolDistr
calculatePoolDistr' KeyHash StakePool -> Bool
includeHash (SnapShot Stake
stake VMap VB VB (Credential Staking) (KeyHash StakePool)
delegs VMap VB VB (KeyHash StakePool) StakePoolParams
poolParams) =
  let CompactCoin Word64
total = Stake -> CompactForm Coin
sumAllStakeCompact Stake
stake
      -- total could be zero (in particular when shrinking)
      nonZeroTotalCompact :: NonZero (CompactForm Coin)
nonZeroTotalCompact = NonZero Word64 -> NonZero (CompactForm Coin)
compactCoinNonZero (NonZero Word64 -> NonZero (CompactForm Coin))
-> NonZero Word64 -> NonZero (CompactForm Coin)
forall a b. (a -> b) -> a -> b
$ Word64
total Word64 -> NonZero Word64 -> NonZero Word64
forall a. HasZero a => a -> NonZero a -> NonZero a
`nonZeroOr` forall (n :: Natural) a.
(KnownNat n, 1 <= n, WithinBounds n a, Num a) =>
NonZero a
knownNonZeroBounded @1
      nonZeroTotalInteger :: NonZero Integer
nonZeroTotalInteger = NonZero Coin -> NonZero Integer
unCoinNonZero (NonZero Coin -> NonZero Integer)
-> NonZero Coin -> NonZero Integer
forall a b. (a -> b) -> a -> b
$ NonZero (CompactForm Coin) -> NonZero Coin
fromCompactCoinNonZero NonZero (CompactForm Coin)
nonZeroTotalCompact
      poolStakeMap :: Map (KeyHash StakePool) Word64
poolStakeMap = (KeyHash StakePool -> Bool)
-> VMap VB VB (Credential Staking) (KeyHash StakePool)
-> Stake
-> Map (KeyHash StakePool) Word64
calculatePoolStake KeyHash StakePool -> Bool
includeHash VMap VB VB (Credential Staking) (KeyHash StakePool)
delegs Stake
stake
   in Map (KeyHash StakePool) IndividualPoolStake
-> CompactForm Coin -> PoolDistr
PoolDistr
        ( (Word64 -> StakePoolParams -> IndividualPoolStake)
-> Map (KeyHash StakePool) Word64
-> Map (KeyHash StakePool) StakePoolParams
-> Map (KeyHash StakePool) IndividualPoolStake
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith
            ( \Word64
word64 StakePoolParams
poolparam ->
                Rational
-> CompactForm Coin
-> VRFVerKeyHash StakePoolVRF
-> IndividualPoolStake
IndividualPoolStake
                  (Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger Word64
word64 Integer -> NonZero Integer -> Rational
forall a. Integral a => a -> NonZero a -> Ratio a
%. NonZero Integer
nonZeroTotalInteger)
                  (Word64 -> CompactForm Coin
CompactCoin Word64
word64)
                  (StakePoolParams -> VRFVerKeyHash StakePoolVRF
sppVrf StakePoolParams
poolparam)
            )
            Map (KeyHash StakePool) Word64
poolStakeMap
            (VMap VB VB (KeyHash StakePool) StakePoolParams
-> Map (KeyHash StakePool) StakePoolParams
forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
VMap kv vv k v -> Map k v
VMap.toMap VMap VB VB (KeyHash StakePool) StakePoolParams
poolParams)
        )
        (NonZero (CompactForm Coin) -> CompactForm Coin
forall a. NonZero a -> a
unNonZero NonZero (CompactForm Coin)
nonZeroTotalCompact)

-- ======================================================
-- Lenses
-- ===============================================

-- SnapShots

ssStakeMarkL :: Lens' SnapShots SnapShot
ssStakeMarkL :: Lens' SnapShots SnapShot
ssStakeMarkL = (SnapShots -> SnapShot)
-> (SnapShots -> SnapShot -> SnapShots) -> Lens' SnapShots SnapShot
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapShots -> SnapShot
ssStakeMark (\SnapShots
ds SnapShot
u -> SnapShots
ds {ssStakeMark = u})

ssStakeMarkPoolDistrL :: Lens' SnapShots PoolDistr
ssStakeMarkPoolDistrL :: Lens' SnapShots PoolDistr
ssStakeMarkPoolDistrL = (SnapShots -> PoolDistr)
-> (SnapShots -> PoolDistr -> SnapShots)
-> Lens' SnapShots PoolDistr
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapShots -> PoolDistr
ssStakeMarkPoolDistr (\SnapShots
ds PoolDistr
u -> SnapShots
ds {ssStakeMarkPoolDistr = u})

ssStakeSetL :: Lens' SnapShots SnapShot
ssStakeSetL :: Lens' SnapShots SnapShot
ssStakeSetL = (SnapShots -> SnapShot)
-> (SnapShots -> SnapShot -> SnapShots) -> Lens' SnapShots SnapShot
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapShots -> SnapShot
ssStakeSet (\SnapShots
ds SnapShot
u -> SnapShots
ds {ssStakeSet = u})

ssStakeGoL :: Lens' SnapShots SnapShot
ssStakeGoL :: Lens' SnapShots SnapShot
ssStakeGoL = (SnapShots -> SnapShot)
-> (SnapShots -> SnapShot -> SnapShots) -> Lens' SnapShots SnapShot
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapShots -> SnapShot
ssStakeGo (\SnapShots
ds SnapShot
u -> SnapShots
ds {ssStakeGo = u})

ssFeeL :: Lens' SnapShots Coin
ssFeeL :: Lens' SnapShots Coin
ssFeeL = (SnapShots -> Coin)
-> (SnapShots -> Coin -> SnapShots) -> Lens' SnapShots Coin
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapShots -> Coin
ssFee (\SnapShots
ds Coin
u -> SnapShots
ds {ssFee = u})

-- SnapShot

ssStakeL :: Lens' SnapShot Stake
ssStakeL :: Lens' SnapShot Stake
ssStakeL = (SnapShot -> Stake)
-> (SnapShot -> Stake -> SnapShot) -> Lens' SnapShot Stake
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapShot -> Stake
ssStake (\SnapShot
ds Stake
u -> SnapShot
ds {ssStake = u})

ssStakeDistrL :: Lens' SnapShot (VMap VB VP (Credential Staking) (CompactForm Coin))
ssStakeDistrL :: Lens' SnapShot (VMap VB VP (Credential Staking) (CompactForm Coin))
ssStakeDistrL = (SnapShot -> VMap VB VP (Credential Staking) (CompactForm Coin))
-> (SnapShot
    -> VMap VB VP (Credential Staking) (CompactForm Coin) -> SnapShot)
-> Lens'
     SnapShot (VMap VB VP (Credential Staking) (CompactForm Coin))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (Stake -> VMap VB VP (Credential Staking) (CompactForm Coin)
unStake (Stake -> VMap VB VP (Credential Staking) (CompactForm Coin))
-> (SnapShot -> Stake)
-> SnapShot
-> VMap VB VP (Credential Staking) (CompactForm Coin)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SnapShot -> Stake
ssStake) (\SnapShot
ds VMap VB VP (Credential Staking) (CompactForm Coin)
u -> SnapShot
ds {ssStake = Stake u})

ssDelegationsL :: Lens' SnapShot (VMap VB VB (Credential Staking) (KeyHash StakePool))
ssDelegationsL :: Lens'
  SnapShot (VMap VB VB (Credential Staking) (KeyHash StakePool))
ssDelegationsL = (SnapShot -> VMap VB VB (Credential Staking) (KeyHash StakePool))
-> (SnapShot
    -> VMap VB VB (Credential Staking) (KeyHash StakePool) -> SnapShot)
-> Lens'
     SnapShot (VMap VB VB (Credential Staking) (KeyHash StakePool))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapShot -> VMap VB VB (Credential Staking) (KeyHash StakePool)
ssDelegations (\SnapShot
ds VMap VB VB (Credential Staking) (KeyHash StakePool)
u -> SnapShot
ds {ssDelegations = u})

ssPoolParamsL :: Lens' SnapShot (VMap VB VB (KeyHash StakePool) StakePoolParams)
ssPoolParamsL :: Lens' SnapShot (VMap VB VB (KeyHash StakePool) StakePoolParams)
ssPoolParamsL = (SnapShot -> VMap VB VB (KeyHash StakePool) StakePoolParams)
-> (SnapShot
    -> VMap VB VB (KeyHash StakePool) StakePoolParams -> SnapShot)
-> Lens' SnapShot (VMap VB VB (KeyHash StakePool) StakePoolParams)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapShot -> VMap VB VB (KeyHash StakePool) StakePoolParams
ssPoolParams (\SnapShot
ds VMap VB VB (KeyHash StakePool) StakePoolParams
u -> SnapShot
ds {ssPoolParams = u})