{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# 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.Shelley.EpochBoundary
  ( Stake (..),
    sumAllStake,
    sumStakePerPool,
    SnapShot (..),
    SnapShots (..),
    emptySnapShot,
    emptySnapShots,
    poolStake,
    obligation,
    maxPool,
    maxPool',
  )
where

import Cardano.Binary (FromCBOR (..), ToCBOR (..), encodeListLen)
import Cardano.Ledger.BaseTypes (BoundedRational (..), NonNegativeInterval)
import Cardano.Ledger.Coin
  ( Coin (..),
    CompactForm (..),
    coinToRational,
    rationalToCoinViaFloor,
  )
import Cardano.Ledger.Compactible
import Cardano.Ledger.Credential (Credential)
import qualified Cardano.Ledger.Crypto as CC (Crypto)
import Cardano.Ledger.Keys (KeyHash, KeyRole (..))
import Cardano.Ledger.Serialization (decodeRecordNamedT)
import Cardano.Ledger.Shelley.TxBody (PoolParams)
import Cardano.Ledger.Val ((<+>), (<×>))
import Control.DeepSeq (NFData)
import Control.Monad.Trans (lift)
import Data.Default.Class (Default, def)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Ratio ((%))
import Data.Sharing
import Data.Typeable
import Data.VMap as VMap
import GHC.Generics (Generic)
import GHC.Records (HasField, getField)
import Lens.Micro (_1, _2)
import NoThunks.Class (NoThunks (..))
import Numeric.Natural (Natural)

-- | Type of stake as map from hash key to coins associated.
newtype Stake crypto = Stake
  { Stake crypto
-> VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
unStake :: VMap VB VP (Credential 'Staking crypto) (CompactForm 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, 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, (forall x. Stake crypto -> Rep (Stake crypto) x)
-> (forall x. Rep (Stake crypto) x -> Stake crypto)
-> Generic (Stake crypto)
forall x. Rep (Stake crypto) x -> Stake crypto
forall x. Stake crypto -> Rep (Stake crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x. Rep (Stake crypto) x -> Stake crypto
forall crypto x. Stake crypto -> Rep (Stake crypto) x
$cto :: forall crypto x. Rep (Stake crypto) x -> Stake crypto
$cfrom :: forall crypto x. Stake crypto -> Rep (Stake crypto) x
Generic)

deriving newtype instance Typeable crypto => NoThunks (Stake crypto)

deriving newtype instance
  CC.Crypto crypto => ToCBOR (Stake crypto)

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

sumAllStake :: Stake crypto -> Coin
sumAllStake :: Stake crypto -> Coin
sumAllStake = CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact (CompactForm Coin -> Coin)
-> (Stake crypto -> CompactForm Coin) -> Stake crypto -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> CompactForm Coin
CompactCoin (Word64 -> CompactForm Coin)
-> (Stake crypto -> Word64) -> Stake crypto -> CompactForm Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> CompactForm Coin -> Word64)
-> Word64
-> VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
-> Word64
forall (vv :: * -> *) v a (kv :: * -> *) k.
Vector vv v =>
(a -> v -> a) -> a -> VMap kv vv k v -> a
VMap.foldl (\Word64
acc (CompactCoin c) -> Word64
acc Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
c) Word64
0 (VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
 -> Word64)
-> (Stake crypto
    -> VMap VB VP (Credential 'Staking crypto) (CompactForm Coin))
-> Stake crypto
-> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stake crypto
-> VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
forall crypto.
Stake crypto
-> VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
unStake
{-# INLINE sumAllStake #-}

-- | Get stake of one pool
poolStake ::
  KeyHash 'StakePool crypto ->
  VMap VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto) ->
  Stake crypto ->
  Stake crypto
poolStake :: KeyHash 'StakePool crypto
-> VMap
     VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
-> Stake crypto
-> Stake crypto
poolStake KeyHash 'StakePool crypto
hk VMap VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
delegs (Stake VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
stake) =
  -- Stake $ (eval (dom (delegs ▷ setSingleton hk) ◁ stake))
  VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
-> Stake crypto
forall crypto.
VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
-> Stake crypto
Stake (VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
 -> Stake crypto)
-> VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
-> Stake crypto
forall a b. (a -> b) -> a -> b
$ (Credential 'Staking crypto -> CompactForm Coin -> Bool)
-> VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
-> VMap VB VP (Credential 'Staking crypto) (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 crypto
cred CompactForm Coin
_ -> Credential 'Staking crypto
-> VMap
     VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
-> Maybe (KeyHash 'StakePool crypto)
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 crypto
cred VMap VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
delegs Maybe (KeyHash 'StakePool crypto)
-> Maybe (KeyHash 'StakePool crypto) -> Bool
forall a. Eq a => a -> a -> Bool
== KeyHash 'StakePool crypto -> Maybe (KeyHash 'StakePool crypto)
forall a. a -> Maybe a
Just KeyHash 'StakePool crypto
hk) VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
stake

sumStakePerPool ::
  VMap VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto) ->
  Stake crypto ->
  Map (KeyHash 'StakePool crypto) Coin
sumStakePerPool :: VMap VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
-> Stake crypto -> Map (KeyHash 'StakePool crypto) Coin
sumStakePerPool VMap VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
delegs (Stake VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
stake) = (Map (KeyHash 'StakePool crypto) Coin
 -> Credential 'Staking crypto
 -> CompactForm Coin
 -> Map (KeyHash 'StakePool crypto) Coin)
-> Map (KeyHash 'StakePool crypto) Coin
-> VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
-> Map (KeyHash 'StakePool crypto) 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 crypto) Coin
-> Credential 'Staking crypto
-> CompactForm Coin
-> Map (KeyHash 'StakePool crypto) Coin
accum Map (KeyHash 'StakePool crypto) Coin
forall k a. Map k a
Map.empty VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
stake
  where
    accum :: Map (KeyHash 'StakePool crypto) Coin
-> Credential 'Staking crypto
-> CompactForm Coin
-> Map (KeyHash 'StakePool crypto) Coin
accum !Map (KeyHash 'StakePool crypto) Coin
acc Credential 'Staking crypto
cred CompactForm Coin
compactCoin =
      case Credential 'Staking crypto
-> VMap
     VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
-> Maybe (KeyHash 'StakePool crypto)
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 crypto
cred VMap VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
delegs of
        Maybe (KeyHash 'StakePool crypto)
Nothing -> Map (KeyHash 'StakePool crypto) Coin
acc
        Just KeyHash 'StakePool crypto
kh -> (Coin -> Coin -> Coin)
-> KeyHash 'StakePool crypto
-> Coin
-> Map (KeyHash 'StakePool crypto) Coin
-> Map (KeyHash 'StakePool crypto) 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 crypto
kh (CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm Coin
compactCoin) Map (KeyHash 'StakePool crypto) Coin
acc

-- | Calculate total possible refunds.
obligation ::
  forall crypto pp anymap.
  ( HasField "_keyDeposit" pp Coin,
    HasField "_poolDeposit" pp Coin,
    Foldable (anymap (Credential 'Staking crypto))
  ) =>
  pp ->
  anymap (Credential 'Staking crypto) Coin ->
  Map (KeyHash 'StakePool crypto) (PoolParams crypto) ->
  Coin
obligation :: pp
-> anymap (Credential 'Staking crypto) Coin
-> Map (KeyHash 'StakePool crypto) (PoolParams crypto)
-> Coin
obligation pp
pp anymap (Credential 'Staking crypto) Coin
rewards Map (KeyHash 'StakePool crypto) (PoolParams crypto)
stakePools =
  (anymap (Credential 'Staking crypto) Coin -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length anymap (Credential 'Staking crypto) Coin
rewards Int -> Coin -> Coin
forall t i. (Val t, Integral i) => i -> t -> t
<×> pp -> Coin
forall k (x :: k) r a. HasField x r a => r -> a
getField @"_keyDeposit" pp
pp)
    Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> (Map (KeyHash 'StakePool crypto) (PoolParams crypto) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Map (KeyHash 'StakePool crypto) (PoolParams crypto)
stakePools Int -> Coin -> Coin
forall t i. (Val t, Integral i) => i -> t -> t
<×> pp -> Coin
forall k (x :: k) r a. HasField x r a => r -> a
getField @"_poolDeposit" pp
pp)

-- | Calculate maximal pool reward
maxPool' ::
  NonNegativeInterval ->
  Natural ->
  Coin ->
  Rational ->
  Rational ->
  Coin
maxPool' :: NonNegativeInterval
-> Natural -> Coin -> Rational -> Rational -> Coin
maxPool' NonNegativeInterval
a0 Natural
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
    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
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
+ 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 -> 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

-- | Version of maxPool' that extracts a0 and nOpt from a PParam with the right HasField instances
maxPool ::
  (HasField "_a0" pp NonNegativeInterval, HasField "_nOpt" pp Natural) =>
  pp ->
  Coin ->
  Rational ->
  Rational ->
  Coin
maxPool :: pp -> Coin -> Rational -> Rational -> Coin
maxPool pp
pc Coin
r Rational
sigma Rational
pR = NonNegativeInterval
-> Natural -> Coin -> Rational -> Rational -> Coin
maxPool' NonNegativeInterval
a0 Natural
nOpt Coin
r Rational
sigma Rational
pR
  where
    a0 :: NonNegativeInterval
a0 = pp -> NonNegativeInterval
forall k (x :: k) r a. HasField x r a => r -> a
getField @"_a0" pp
pc
    nOpt :: Natural
nOpt = pp -> Natural
forall k (x :: k) r a. HasField x r a => r -> a
getField @"_nOpt" pp
pc

-- | Snapshot of the stake distribution.
data SnapShot crypto = SnapShot
  { SnapShot crypto -> Stake crypto
_stake :: !(Stake crypto),
    SnapShot crypto
-> VMap
     VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
_delegations :: !(VMap VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)),
    SnapShot crypto
-> VMap VB VB (KeyHash 'StakePool crypto) (PoolParams crypto)
_poolParams :: !(VMap VB VB (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 Typeable crypto => 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
-> VMap
     VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
_delegations = VMap VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
d,
        $sel:_poolParams:SnapShot :: forall crypto.
SnapShot crypto
-> VMap VB VB (KeyHash 'StakePool crypto) (PoolParams crypto)
_poolParams = VMap VB VB (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
<> VMap VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
-> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR VMap VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
d
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> VMap VB VB (KeyHash 'StakePool crypto) (PoolParams crypto)
-> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR VMap VB VB (KeyHash 'StakePool crypto) (PoolParams crypto)
p

instance CC.Crypto crypto => FromSharedCBOR (SnapShot crypto) where
  type
    Share (SnapShot crypto) =
      (Interns (Credential 'Staking crypto), Interns (KeyHash 'StakePool crypto))
  fromSharedPlusCBOR :: StateT (Share (SnapShot crypto)) (Decoder s) (SnapShot crypto)
fromSharedPlusCBOR = Text
-> (SnapShot crypto -> Int)
-> StateT
     (Interns (Credential 'Staking crypto),
      Interns (KeyHash 'StakePool crypto))
     (Decoder s)
     (SnapShot crypto)
-> StateT
     (Interns (Credential 'Staking crypto),
      Interns (KeyHash 'StakePool crypto))
     (Decoder s)
     (SnapShot crypto)
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 crypto -> Int
forall a b. a -> b -> a
const Int
3) (StateT
   (Interns (Credential 'Staking crypto),
    Interns (KeyHash 'StakePool crypto))
   (Decoder s)
   (SnapShot crypto)
 -> StateT
      (Interns (Credential 'Staking crypto),
       Interns (KeyHash 'StakePool crypto))
      (Decoder s)
      (SnapShot crypto))
-> StateT
     (Interns (Credential 'Staking crypto),
      Interns (KeyHash 'StakePool crypto))
     (Decoder s)
     (SnapShot crypto)
-> StateT
     (Interns (Credential 'Staking crypto),
      Interns (KeyHash 'StakePool crypto))
     (Decoder s)
     (SnapShot crypto)
forall a b. (a -> b) -> a -> b
$ do
    Stake crypto
_stake <- Lens'
  (Interns (Credential 'Staking crypto),
   Interns (KeyHash 'StakePool crypto))
  (Share (Stake crypto))
-> StateT
     (Interns (Credential 'Staking crypto),
      Interns (KeyHash 'StakePool crypto))
     (Decoder s)
     (Stake crypto)
forall b bs s.
FromSharedCBOR b =>
Lens' bs (Share b) -> StateT bs (Decoder s) b
fromSharedPlusLensCBOR forall s t a b. Field1 s t a b => Lens s t a b
Lens'
  (Interns (Credential 'Staking crypto),
   Interns (KeyHash 'StakePool crypto))
  (Share (Stake crypto))
_1
    VMap VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
_delegations <- StateT
  (Interns (Credential 'Staking crypto),
   Interns (KeyHash 'StakePool crypto))
  (Decoder s)
  (VMap
     VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto))
forall a s. FromSharedCBOR a => StateT (Share a) (Decoder s) a
fromSharedPlusCBOR
    VMap VB VB (KeyHash 'StakePool crypto) (PoolParams crypto)
_poolParams <- Lens'
  (Interns (Credential 'Staking crypto),
   Interns (KeyHash 'StakePool crypto))
  (Share
     (VMap VB VB (KeyHash 'StakePool crypto) (PoolParams crypto)))
-> StateT
     (Interns (Credential 'Staking crypto),
      Interns (KeyHash 'StakePool crypto))
     (Decoder s)
     (VMap VB VB (KeyHash 'StakePool crypto) (PoolParams crypto))
forall b bs s.
FromSharedCBOR b =>
Lens' bs (Share b) -> StateT bs (Decoder s) b
fromSharedPlusLensCBOR (Lens'
  (Interns (KeyHash 'StakePool crypto), Interns (PoolParams crypto))
  (Interns (KeyHash 'StakePool crypto))
-> Lens'
     (Interns (Credential 'Staking crypto),
      Interns (KeyHash 'StakePool crypto))
     (Interns (KeyHash 'StakePool crypto))
-> Lens'
     (Interns (Credential 'Staking crypto),
      Interns (KeyHash 'StakePool crypto))
     (Interns (KeyHash 'StakePool crypto), Interns (PoolParams crypto))
forall a b c. Monoid a => Lens' a b -> Lens' c b -> Lens' c a
toMemptyLens forall s t a b. Field1 s t a b => Lens s t a b
Lens'
  (Interns (KeyHash 'StakePool crypto), Interns (PoolParams crypto))
  (Interns (KeyHash 'StakePool crypto))
_1 forall s t a b. Field2 s t a b => Lens s t a b
Lens'
  (Interns (Credential 'Staking crypto),
   Interns (KeyHash 'StakePool crypto))
  (Interns (KeyHash 'StakePool crypto))
_2)
    SnapShot crypto
-> StateT
     (Interns (Credential 'Staking crypto),
      Interns (KeyHash 'StakePool crypto))
     (Decoder s)
     (SnapShot crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure SnapShot :: forall crypto.
Stake crypto
-> VMap
     VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
-> VMap VB VB (KeyHash 'StakePool crypto) (PoolParams crypto)
-> SnapShot crypto
SnapShot {Stake crypto
_stake :: Stake crypto
$sel:_stake:SnapShot :: Stake crypto
_stake, VMap VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
_delegations :: VMap VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
$sel:_delegations:SnapShot :: VMap VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
_delegations, VMap VB VB (KeyHash 'StakePool crypto) (PoolParams crypto)
_poolParams :: VMap VB VB (KeyHash 'StakePool crypto) (PoolParams crypto)
$sel:_poolParams:SnapShot :: VMap VB VB (KeyHash 'StakePool crypto) (PoolParams crypto)
_poolParams}

-- | Snapshots of the stake distribution.
data SnapShots crypto = SnapShots
  { SnapShots crypto -> SnapShot crypto
_pstakeMark :: SnapShot crypto, -- Lazy on purpose
    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 Typeable crypto => NoThunks (SnapShots crypto)

instance NFData (SnapShots crypto)

instance
  CC.Crypto crypto =>
  ToCBOR (SnapShots crypto)
  where
  toCBOR :: SnapShots crypto -> Encoding
toCBOR (SnapShots {SnapShot crypto
_pstakeMark :: SnapShot crypto
$sel:_pstakeMark:SnapShots :: forall crypto. SnapShots crypto -> SnapShot crypto
_pstakeMark, SnapShot crypto
_pstakeSet :: SnapShot crypto
$sel:_pstakeSet:SnapShots :: forall crypto. SnapShots crypto -> SnapShot crypto
_pstakeSet, SnapShot crypto
_pstakeGo :: SnapShot crypto
$sel:_pstakeGo:SnapShots :: forall crypto. SnapShots crypto -> SnapShot crypto
_pstakeGo, Coin
_feeSS :: Coin
$sel:_feeSS:SnapShots :: forall crypto. SnapShots crypto -> Coin
_feeSS}) =
    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
_pstakeMark
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SnapShot crypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR SnapShot crypto
_pstakeSet
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SnapShot crypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR SnapShot crypto
_pstakeGo
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Coin -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Coin
_feeSS

instance CC.Crypto crypto => FromSharedCBOR (SnapShots crypto) where
  type Share (SnapShots crypto) = Share (SnapShot crypto)
  fromSharedPlusCBOR :: StateT (Share (SnapShots crypto)) (Decoder s) (SnapShots crypto)
fromSharedPlusCBOR = Text
-> (SnapShots crypto -> Int)
-> StateT
     (Interns (Credential 'Staking crypto),
      Interns (KeyHash 'StakePool crypto))
     (Decoder s)
     (SnapShots crypto)
-> StateT
     (Interns (Credential 'Staking crypto),
      Interns (KeyHash 'StakePool crypto))
     (Decoder s)
     (SnapShots crypto)
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 crypto -> Int
forall a b. a -> b -> a
const Int
4) (StateT
   (Interns (Credential 'Staking crypto),
    Interns (KeyHash 'StakePool crypto))
   (Decoder s)
   (SnapShots crypto)
 -> StateT
      (Interns (Credential 'Staking crypto),
       Interns (KeyHash 'StakePool crypto))
      (Decoder s)
      (SnapShots crypto))
-> StateT
     (Interns (Credential 'Staking crypto),
      Interns (KeyHash 'StakePool crypto))
     (Decoder s)
     (SnapShots crypto)
-> StateT
     (Interns (Credential 'Staking crypto),
      Interns (KeyHash 'StakePool crypto))
     (Decoder s)
     (SnapShots crypto)
forall a b. (a -> b) -> a -> b
$ do
    !SnapShot crypto
_pstakeMark <- StateT
  (Interns (Credential 'Staking crypto),
   Interns (KeyHash 'StakePool crypto))
  (Decoder s)
  (SnapShot crypto)
forall a s. FromSharedCBOR a => StateT (Share a) (Decoder s) a
fromSharedPlusCBOR
    SnapShot crypto
_pstakeSet <- StateT
  (Interns (Credential 'Staking crypto),
   Interns (KeyHash 'StakePool crypto))
  (Decoder s)
  (SnapShot crypto)
forall a s. FromSharedCBOR a => StateT (Share a) (Decoder s) a
fromSharedPlusCBOR
    SnapShot crypto
_pstakeGo <- StateT
  (Interns (Credential 'Staking crypto),
   Interns (KeyHash 'StakePool crypto))
  (Decoder s)
  (SnapShot crypto)
forall a s. FromSharedCBOR a => StateT (Share a) (Decoder s) a
fromSharedPlusCBOR
    Coin
_feeSS <- Decoder s Coin
-> StateT
     (Interns (Credential 'Staking crypto),
      Interns (KeyHash 'StakePool crypto))
     (Decoder s)
     Coin
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Decoder s Coin
forall a s. FromCBOR a => Decoder s a
fromCBOR
    SnapShots crypto
-> StateT
     (Interns (Credential 'Staking crypto),
      Interns (KeyHash 'StakePool crypto))
     (Decoder s)
     (SnapShots crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure SnapShots :: forall crypto.
SnapShot crypto
-> SnapShot crypto -> SnapShot crypto -> Coin -> SnapShots crypto
SnapShots {SnapShot crypto
_pstakeMark :: SnapShot crypto
$sel:_pstakeMark:SnapShots :: SnapShot crypto
_pstakeMark, SnapShot crypto
_pstakeSet :: SnapShot crypto
$sel:_pstakeSet:SnapShots :: SnapShot crypto
_pstakeSet, SnapShot crypto
_pstakeGo :: SnapShot crypto
$sel:_pstakeGo:SnapShots :: SnapShot crypto
_pstakeGo, Coin
_feeSS :: Coin
$sel:_feeSS:SnapShots :: Coin
_feeSS}

instance Default (SnapShots crypto) where
  def :: SnapShots crypto
def = SnapShots crypto
forall crypto. SnapShots crypto
emptySnapShots

emptySnapShot :: SnapShot crypto
emptySnapShot :: SnapShot crypto
emptySnapShot = Stake crypto
-> VMap
     VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
-> VMap VB VB (KeyHash 'StakePool crypto) (PoolParams crypto)
-> SnapShot crypto
forall crypto.
Stake crypto
-> VMap
     VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
-> VMap VB VB (KeyHash 'StakePool crypto) (PoolParams crypto)
-> SnapShot crypto
SnapShot (VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
-> Stake crypto
forall crypto.
VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
-> Stake crypto
Stake VMap VB VP (Credential 'Staking crypto) (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 crypto) (KeyHash 'StakePool crypto)
forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
VMap kv vv k v
VMap.empty VMap VB VB (KeyHash 'StakePool crypto) (PoolParams crypto)
forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
VMap kv vv k v
VMap.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)