{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.Ledger.Shelley.Rewards
  ( StakeShare (..),
    PoolRewardInfo (..),
    mkApparentPerformance,
    RewardType (..),
    LeaderOnlyReward (..),
    leaderRewardToGeneral,
    Reward (..),
    leaderRew,
    memberRew,
    aggregateRewards,
    filterRewards,
    sumRewards,
    rewardOnePoolMember,
    mkPoolRewardInfo,
  )
where

import Cardano.Binary
  ( FromCBOR (..),
    ToCBOR (..),
    decodeWord,
    encodeWord,
  )
import Cardano.Ledger.BaseTypes
  ( BlocksMade (..),
    BoundedRational (..),
    NonNegativeInterval,
    ProtVer,
    UnitInterval,
    invalidKey,
  )
import Cardano.Ledger.Coin
  ( Coin (..),
    coinToRational,
    rationalToCoinViaFloor,
  )
import Cardano.Ledger.Compactible (fromCompact)
import qualified Cardano.Ledger.Core as Core
import Cardano.Ledger.Credential (Credential (..))
import qualified Cardano.Ledger.Crypto as CC (Crypto)
import Cardano.Ledger.Era (Crypto)
import Cardano.Ledger.Keys (KeyHash, KeyRole (..))
import Cardano.Ledger.Shelley.Delegation.PoolParams (poolSpec)
import Cardano.Ledger.Shelley.EpochBoundary (Stake (..), maxPool')
import qualified Cardano.Ledger.Shelley.HardForks as HardForks
import Cardano.Ledger.Shelley.TxBody (PoolParams (..))
import Cardano.Ledger.Val ((<->))
import Control.DeepSeq (NFData)
import Control.Monad (guard)
import Data.Coders (Decode (..), Encode (..), decode, encode, (!>), (<!))
import Data.Foldable (fold, foldMap')
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Ratio ((%))
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.VMap as VMap
import GHC.Generics (Generic)
import GHC.Records (HasField (getField))
import NoThunks.Class (NoThunks (..))
import Numeric.Natural (Natural)
import Quiet

-- | StakeShare type
newtype StakeShare = StakeShare {StakeShare -> Rational
unStakeShare :: Rational}
  deriving ((forall x. StakeShare -> Rep StakeShare x)
-> (forall x. Rep StakeShare x -> StakeShare) -> Generic StakeShare
forall x. Rep StakeShare x -> StakeShare
forall x. StakeShare -> Rep StakeShare x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StakeShare x -> StakeShare
$cfrom :: forall x. StakeShare -> Rep StakeShare x
Generic, Eq StakeShare
Eq StakeShare
-> (StakeShare -> StakeShare -> Ordering)
-> (StakeShare -> StakeShare -> Bool)
-> (StakeShare -> StakeShare -> Bool)
-> (StakeShare -> StakeShare -> Bool)
-> (StakeShare -> StakeShare -> Bool)
-> (StakeShare -> StakeShare -> StakeShare)
-> (StakeShare -> StakeShare -> StakeShare)
-> Ord StakeShare
StakeShare -> StakeShare -> Bool
StakeShare -> StakeShare -> Ordering
StakeShare -> StakeShare -> StakeShare
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
min :: StakeShare -> StakeShare -> StakeShare
$cmin :: StakeShare -> StakeShare -> StakeShare
max :: StakeShare -> StakeShare -> StakeShare
$cmax :: StakeShare -> StakeShare -> StakeShare
>= :: StakeShare -> StakeShare -> Bool
$c>= :: StakeShare -> StakeShare -> Bool
> :: StakeShare -> StakeShare -> Bool
$c> :: StakeShare -> StakeShare -> Bool
<= :: StakeShare -> StakeShare -> Bool
$c<= :: StakeShare -> StakeShare -> Bool
< :: StakeShare -> StakeShare -> Bool
$c< :: StakeShare -> StakeShare -> Bool
compare :: StakeShare -> StakeShare -> Ordering
$ccompare :: StakeShare -> StakeShare -> Ordering
$cp1Ord :: Eq StakeShare
Ord, StakeShare -> StakeShare -> Bool
(StakeShare -> StakeShare -> Bool)
-> (StakeShare -> StakeShare -> Bool) -> Eq StakeShare
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StakeShare -> StakeShare -> Bool
$c/= :: StakeShare -> StakeShare -> Bool
== :: StakeShare -> StakeShare -> Bool
$c== :: StakeShare -> StakeShare -> Bool
Eq, Context -> StakeShare -> IO (Maybe ThunkInfo)
Proxy StakeShare -> String
(Context -> StakeShare -> IO (Maybe ThunkInfo))
-> (Context -> StakeShare -> IO (Maybe ThunkInfo))
-> (Proxy StakeShare -> String)
-> NoThunks StakeShare
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy StakeShare -> String
$cshowTypeOf :: Proxy StakeShare -> String
wNoThunks :: Context -> StakeShare -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> StakeShare -> IO (Maybe ThunkInfo)
noThunks :: Context -> StakeShare -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> StakeShare -> IO (Maybe ThunkInfo)
NoThunks)
  deriving (Int -> StakeShare -> ShowS
[StakeShare] -> ShowS
StakeShare -> String
(Int -> StakeShare -> ShowS)
-> (StakeShare -> String)
-> ([StakeShare] -> ShowS)
-> Show StakeShare
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StakeShare] -> ShowS
$cshowList :: [StakeShare] -> ShowS
show :: StakeShare -> String
$cshow :: StakeShare -> String
showsPrec :: Int -> StakeShare -> ShowS
$cshowsPrec :: Int -> StakeShare -> ShowS
Show) via Quiet StakeShare

instance NFData StakeShare

-- | Calculate pool reward
mkApparentPerformance ::
  UnitInterval ->
  Rational ->
  Natural ->
  Natural ->
  Rational
mkApparentPerformance :: UnitInterval -> Rational -> Natural -> Natural -> Rational
mkApparentPerformance UnitInterval
d_ Rational
sigma Natural
blocksN Natural
blocksTotal
  | Rational
sigma Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
0 = Rational
0
  | UnitInterval -> Rational
forall r. BoundedRational r => r -> Rational
unboundRational UnitInterval
d_ Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
0.8 = Rational
beta Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
sigma
  | Bool
otherwise = Rational
1
  where
    beta :: Rational
beta = Natural -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
blocksN Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Natural -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Natural -> Natural
forall a. Ord a => a -> a -> a
max Natural
1 Natural
blocksTotal)

-- | Calculate pool leader reward
leaderRew ::
  Coin ->
  PoolParams crypto ->
  StakeShare ->
  StakeShare ->
  Coin
leaderRew :: Coin -> PoolParams crypto -> StakeShare -> StakeShare -> Coin
leaderRew Coin
f PoolParams crypto
pool (StakeShare Rational
s) (StakeShare Rational
sigma)
  | Coin
f Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
<= Coin
c = Coin
f
  | Bool
otherwise =
      Coin
c
        Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> Rational -> Coin
rationalToCoinViaFloor
          (Coin -> Rational
coinToRational (Coin
f Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Coin
c) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (Rational
m' Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
m') Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
s Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
sigma))
  where
    (Coin
c, UnitInterval
m, Coin
_) = PoolParams crypto -> (Coin, UnitInterval, Coin)
forall crypto. PoolParams crypto -> (Coin, UnitInterval, Coin)
poolSpec PoolParams crypto
pool
    m' :: Rational
m' = UnitInterval -> Rational
forall r. BoundedRational r => r -> Rational
unboundRational UnitInterval
m

-- | Calculate pool member reward
memberRew ::
  Coin ->
  PoolParams crypto ->
  StakeShare ->
  StakeShare ->
  Coin
memberRew :: Coin -> PoolParams crypto -> StakeShare -> StakeShare -> Coin
memberRew (Coin Integer
f') PoolParams crypto
pool (StakeShare Rational
t) (StakeShare Rational
sigma)
  | Integer
f' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
c = Coin
forall a. Monoid a => a
mempty
  | Bool
otherwise =
      Rational -> Coin
rationalToCoinViaFloor (Rational -> Coin) -> Rational -> Coin
forall a b. (a -> b) -> a -> b
$
        Integer -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
f' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
c) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
m') Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
t Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
sigma
  where
    (Coin Integer
c, UnitInterval
m, Coin
_) = PoolParams crypto -> (Coin, UnitInterval, Coin)
forall crypto. PoolParams crypto -> (Coin, UnitInterval, Coin)
poolSpec PoolParams crypto
pool
    m' :: Rational
m' = UnitInterval -> Rational
forall r. BoundedRational r => r -> Rational
unboundRational UnitInterval
m

data RewardType = MemberReward | LeaderReward
  deriving (RewardType -> RewardType -> Bool
(RewardType -> RewardType -> Bool)
-> (RewardType -> RewardType -> Bool) -> Eq RewardType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RewardType -> RewardType -> Bool
$c/= :: RewardType -> RewardType -> Bool
== :: RewardType -> RewardType -> Bool
$c== :: RewardType -> RewardType -> Bool
Eq, Int -> RewardType -> ShowS
[RewardType] -> ShowS
RewardType -> String
(Int -> RewardType -> ShowS)
-> (RewardType -> String)
-> ([RewardType] -> ShowS)
-> Show RewardType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RewardType] -> ShowS
$cshowList :: [RewardType] -> ShowS
show :: RewardType -> String
$cshow :: RewardType -> String
showsPrec :: Int -> RewardType -> ShowS
$cshowsPrec :: Int -> RewardType -> ShowS
Show, Eq RewardType
Eq RewardType
-> (RewardType -> RewardType -> Ordering)
-> (RewardType -> RewardType -> Bool)
-> (RewardType -> RewardType -> Bool)
-> (RewardType -> RewardType -> Bool)
-> (RewardType -> RewardType -> Bool)
-> (RewardType -> RewardType -> RewardType)
-> (RewardType -> RewardType -> RewardType)
-> Ord RewardType
RewardType -> RewardType -> Bool
RewardType -> RewardType -> Ordering
RewardType -> RewardType -> RewardType
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
min :: RewardType -> RewardType -> RewardType
$cmin :: RewardType -> RewardType -> RewardType
max :: RewardType -> RewardType -> RewardType
$cmax :: RewardType -> RewardType -> RewardType
>= :: RewardType -> RewardType -> Bool
$c>= :: RewardType -> RewardType -> Bool
> :: RewardType -> RewardType -> Bool
$c> :: RewardType -> RewardType -> Bool
<= :: RewardType -> RewardType -> Bool
$c<= :: RewardType -> RewardType -> Bool
< :: RewardType -> RewardType -> Bool
$c< :: RewardType -> RewardType -> Bool
compare :: RewardType -> RewardType -> Ordering
$ccompare :: RewardType -> RewardType -> Ordering
$cp1Ord :: Eq RewardType
Ord, (forall x. RewardType -> Rep RewardType x)
-> (forall x. Rep RewardType x -> RewardType) -> Generic RewardType
forall x. Rep RewardType x -> RewardType
forall x. RewardType -> Rep RewardType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RewardType x -> RewardType
$cfrom :: forall x. RewardType -> Rep RewardType x
Generic)

instance NoThunks RewardType

instance NFData RewardType

instance ToCBOR RewardType where
  toCBOR :: RewardType -> Encoding
toCBOR RewardType
MemberReward = Word -> Encoding
encodeWord Word
0
  toCBOR RewardType
LeaderReward = Word -> Encoding
encodeWord Word
1

instance FromCBOR RewardType where
  fromCBOR :: Decoder s RewardType
fromCBOR =
    Decoder s Word
forall s. Decoder s Word
decodeWord Decoder s Word
-> (Word -> Decoder s RewardType) -> Decoder s RewardType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Word
0 -> RewardType -> Decoder s RewardType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RewardType
MemberReward
      Word
1 -> RewardType -> Decoder s RewardType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RewardType
LeaderReward
      Word
n -> Word -> Decoder s RewardType
forall s a. Word -> Decoder s a
invalidKey Word
n

data Reward crypto = Reward
  { Reward crypto -> RewardType
rewardType :: RewardType,
    Reward crypto -> KeyHash 'StakePool crypto
rewardPool :: KeyHash 'StakePool crypto,
    Reward crypto -> Coin
rewardAmount :: Coin
  }
  deriving (Reward crypto -> Reward crypto -> Bool
(Reward crypto -> Reward crypto -> Bool)
-> (Reward crypto -> Reward crypto -> Bool) -> Eq (Reward crypto)
forall crypto. Reward crypto -> Reward crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Reward crypto -> Reward crypto -> Bool
$c/= :: forall crypto. Reward crypto -> Reward crypto -> Bool
== :: Reward crypto -> Reward crypto -> Bool
$c== :: forall crypto. Reward crypto -> Reward crypto -> Bool
Eq, Int -> Reward crypto -> ShowS
[Reward crypto] -> ShowS
Reward crypto -> String
(Int -> Reward crypto -> ShowS)
-> (Reward crypto -> String)
-> ([Reward crypto] -> ShowS)
-> Show (Reward crypto)
forall crypto. Int -> Reward crypto -> ShowS
forall crypto. [Reward crypto] -> ShowS
forall crypto. Reward crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Reward crypto] -> ShowS
$cshowList :: forall crypto. [Reward crypto] -> ShowS
show :: Reward crypto -> String
$cshow :: forall crypto. Reward crypto -> String
showsPrec :: Int -> Reward crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> Reward crypto -> ShowS
Show, (forall x. Reward crypto -> Rep (Reward crypto) x)
-> (forall x. Rep (Reward crypto) x -> Reward crypto)
-> Generic (Reward crypto)
forall x. Rep (Reward crypto) x -> Reward crypto
forall x. Reward crypto -> Rep (Reward crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x. Rep (Reward crypto) x -> Reward crypto
forall crypto x. Reward crypto -> Rep (Reward crypto) x
$cto :: forall crypto x. Rep (Reward crypto) x -> Reward crypto
$cfrom :: forall crypto x. Reward crypto -> Rep (Reward crypto) x
Generic)

-- | Note that this Ord instance is chosen to align precisely
--  with the Allegra reward aggregation, as given by the
--  function 'aggregateRewards' so that 'Set.findMax' returns
--  the expected value.
instance Ord (Reward crypto) where
  compare :: Reward crypto -> Reward crypto -> Ordering
compare (Reward RewardType
MemberReward KeyHash 'StakePool crypto
_ Coin
_) (Reward RewardType
LeaderReward KeyHash 'StakePool crypto
_ Coin
_) = Ordering
GT
  compare (Reward RewardType
LeaderReward KeyHash 'StakePool crypto
_ Coin
_) (Reward RewardType
MemberReward KeyHash 'StakePool crypto
_ Coin
_) = Ordering
LT
  compare (Reward RewardType
_ KeyHash 'StakePool crypto
pool1 Coin
_) (Reward RewardType
_ KeyHash 'StakePool crypto
pool2 Coin
_) = KeyHash 'StakePool crypto -> KeyHash 'StakePool crypto -> Ordering
forall a. Ord a => a -> a -> Ordering
compare KeyHash 'StakePool crypto
pool1 KeyHash 'StakePool crypto
pool2

instance NoThunks (Reward crypto)

instance NFData (Reward crypto)

instance CC.Crypto crypto => ToCBOR (Reward crypto) where
  toCBOR :: Reward crypto -> Encoding
toCBOR (Reward RewardType
rt KeyHash 'StakePool crypto
pool Coin
c) =
    Encode ('Closed 'Dense) (Reward crypto) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) (Reward crypto) -> Encoding)
-> Encode ('Closed 'Dense) (Reward crypto) -> Encoding
forall a b. (a -> b) -> a -> b
$ (RewardType -> KeyHash 'StakePool crypto -> Coin -> Reward crypto)
-> Encode
     ('Closed 'Dense)
     (RewardType -> KeyHash 'StakePool crypto -> Coin -> Reward crypto)
forall t. t -> Encode ('Closed 'Dense) t
Rec RewardType -> KeyHash 'StakePool crypto -> Coin -> Reward crypto
forall crypto.
RewardType -> KeyHash 'StakePool crypto -> Coin -> Reward crypto
Reward Encode
  ('Closed 'Dense)
  (RewardType -> KeyHash 'StakePool crypto -> Coin -> Reward crypto)
-> Encode ('Closed 'Dense) RewardType
-> Encode
     ('Closed 'Dense)
     (KeyHash 'StakePool crypto -> Coin -> Reward crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> RewardType -> Encode ('Closed 'Dense) RewardType
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To RewardType
rt Encode
  ('Closed 'Dense)
  (KeyHash 'StakePool crypto -> Coin -> Reward crypto)
-> Encode ('Closed 'Dense) (KeyHash 'StakePool crypto)
-> Encode ('Closed 'Dense) (Coin -> Reward crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> KeyHash 'StakePool crypto
-> Encode ('Closed 'Dense) (KeyHash 'StakePool crypto)
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To KeyHash 'StakePool crypto
pool Encode ('Closed 'Dense) (Coin -> Reward crypto)
-> Encode ('Closed 'Dense) Coin
-> Encode ('Closed 'Dense) (Reward crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Coin -> Encode ('Closed 'Dense) Coin
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
c

instance CC.Crypto crypto => FromCBOR (Reward crypto) where
  fromCBOR :: Decoder s (Reward crypto)
fromCBOR =
    Decode ('Closed 'Dense) (Reward crypto)
-> Decoder s (Reward crypto)
forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) (Reward crypto)
 -> Decoder s (Reward crypto))
-> Decode ('Closed 'Dense) (Reward crypto)
-> Decoder s (Reward crypto)
forall a b. (a -> b) -> a -> b
$ (RewardType -> KeyHash 'StakePool crypto -> Coin -> Reward crypto)
-> Decode
     ('Closed 'Dense)
     (RewardType -> KeyHash 'StakePool crypto -> Coin -> Reward crypto)
forall t. t -> Decode ('Closed 'Dense) t
RecD RewardType -> KeyHash 'StakePool crypto -> Coin -> Reward crypto
forall crypto.
RewardType -> KeyHash 'StakePool crypto -> Coin -> Reward crypto
Reward Decode
  ('Closed 'Dense)
  (RewardType -> KeyHash 'StakePool crypto -> Coin -> Reward crypto)
-> Decode ('Closed Any) RewardType
-> Decode
     ('Closed 'Dense)
     (KeyHash 'StakePool crypto -> Coin -> Reward crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) RewardType
forall t (w :: Wrapped). FromCBOR t => Decode w t
From Decode
  ('Closed 'Dense)
  (KeyHash 'StakePool crypto -> Coin -> Reward crypto)
-> Decode ('Closed Any) (KeyHash 'StakePool crypto)
-> Decode ('Closed 'Dense) (Coin -> Reward crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (KeyHash 'StakePool crypto)
forall t (w :: Wrapped). FromCBOR t => Decode w t
From Decode ('Closed 'Dense) (Coin -> Reward crypto)
-> Decode ('Closed Any) Coin
-> Decode ('Closed 'Dense) (Reward crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Coin
forall t (w :: Wrapped). FromCBOR t => Decode w t
From

sumRewards ::
  forall crypto pp.
  (HasField "_protocolVersion" pp ProtVer) =>
  pp ->
  Map (Credential 'Staking crypto) (Set (Reward crypto)) ->
  Coin
sumRewards :: pp
-> Map (Credential 'Staking crypto) (Set (Reward crypto)) -> Coin
sumRewards pp
protocolVersion Map (Credential 'Staking crypto) (Set (Reward crypto))
rs = Map (Credential 'Staking crypto) Coin -> Coin
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Map (Credential 'Staking crypto) Coin -> Coin)
-> Map (Credential 'Staking crypto) Coin -> Coin
forall a b. (a -> b) -> a -> b
$ pp
-> Map (Credential 'Staking crypto) (Set (Reward crypto))
-> Map (Credential 'Staking crypto) Coin
forall crypto pp.
HasField "_protocolVersion" pp ProtVer =>
pp
-> Map (Credential 'Staking crypto) (Set (Reward crypto))
-> Map (Credential 'Staking crypto) Coin
aggregateRewards pp
protocolVersion Map (Credential 'Staking crypto) (Set (Reward crypto))
rs

-- | Filter the reward payments to those that will actually be delivered. This
-- function exists since in Shelley, a stake credential earning rewards from
-- multiple sources would only receive one reward.
filterRewards ::
  forall crypto pp.
  (HasField "_protocolVersion" pp ProtVer) =>
  pp ->
  Map (Credential 'Staking crypto) (Set (Reward crypto)) ->
  ( Map (Credential 'Staking crypto) (Set (Reward crypto)),
    Map (Credential 'Staking crypto) (Set (Reward crypto))
  )
filterRewards :: pp
-> Map (Credential 'Staking crypto) (Set (Reward crypto))
-> (Map (Credential 'Staking crypto) (Set (Reward crypto)),
    Map (Credential 'Staking crypto) (Set (Reward crypto)))
filterRewards pp
pp Map (Credential 'Staking crypto) (Set (Reward crypto))
rewards =
  if pp -> Bool
forall pp. HasField "_protocolVersion" pp ProtVer => pp -> Bool
HardForks.aggregatedRewards pp
pp
    then (Map (Credential 'Staking crypto) (Set (Reward crypto))
rewards, Map (Credential 'Staking crypto) (Set (Reward crypto))
forall k a. Map k a
Map.empty)
    else
      let mp :: Map
  (Credential 'Staking crypto) (Reward crypto, Set (Reward crypto))
mp = (Set (Reward crypto) -> (Reward crypto, Set (Reward crypto)))
-> Map (Credential 'Staking crypto) (Set (Reward crypto))
-> Map
     (Credential 'Staking crypto) (Reward crypto, Set (Reward crypto))
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Set (Reward crypto) -> (Reward crypto, Set (Reward crypto))
forall a. Set a -> (a, Set a)
Set.deleteFindMin Map (Credential 'Staking crypto) (Set (Reward crypto))
rewards
       in (((Reward crypto, Set (Reward crypto)) -> Set (Reward crypto))
-> Map
     (Credential 'Staking crypto) (Reward crypto, Set (Reward crypto))
-> Map (Credential 'Staking crypto) (Set (Reward crypto))
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Reward crypto -> Set (Reward crypto)
forall a. a -> Set a
Set.singleton (Reward crypto -> Set (Reward crypto))
-> ((Reward crypto, Set (Reward crypto)) -> Reward crypto)
-> (Reward crypto, Set (Reward crypto))
-> Set (Reward crypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reward crypto, Set (Reward crypto)) -> Reward crypto
forall a b. (a, b) -> a
fst) Map
  (Credential 'Staking crypto) (Reward crypto, Set (Reward crypto))
mp, (Set (Reward crypto) -> Bool)
-> Map (Credential 'Staking crypto) (Set (Reward crypto))
-> Map (Credential 'Staking crypto) (Set (Reward crypto))
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Bool -> Bool
not (Bool -> Bool)
-> (Set (Reward crypto) -> Bool) -> Set (Reward crypto) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (Reward crypto) -> Bool
forall a. Set a -> Bool
Set.null) (Map (Credential 'Staking crypto) (Set (Reward crypto))
 -> Map (Credential 'Staking crypto) (Set (Reward crypto)))
-> Map (Credential 'Staking crypto) (Set (Reward crypto))
-> Map (Credential 'Staking crypto) (Set (Reward crypto))
forall a b. (a -> b) -> a -> b
$ ((Reward crypto, Set (Reward crypto)) -> Set (Reward crypto))
-> Map
     (Credential 'Staking crypto) (Reward crypto, Set (Reward crypto))
-> Map (Credential 'Staking crypto) (Set (Reward crypto))
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Reward crypto, Set (Reward crypto)) -> Set (Reward crypto)
forall a b. (a, b) -> b
snd Map
  (Credential 'Staking crypto) (Reward crypto, Set (Reward crypto))
mp)

aggregateRewards ::
  forall crypto pp.
  (HasField "_protocolVersion" pp ProtVer) =>
  pp ->
  Map (Credential 'Staking crypto) (Set (Reward crypto)) ->
  Map (Credential 'Staking crypto) Coin
aggregateRewards :: pp
-> Map (Credential 'Staking crypto) (Set (Reward crypto))
-> Map (Credential 'Staking crypto) Coin
aggregateRewards pp
pp Map (Credential 'Staking crypto) (Set (Reward crypto))
rewards =
  (Set (Reward crypto) -> Coin)
-> Map (Credential 'Staking crypto) (Set (Reward crypto))
-> Map (Credential 'Staking crypto) Coin
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((Reward crypto -> Coin) -> Set (Reward crypto) -> Coin
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' Reward crypto -> Coin
forall crypto. Reward crypto -> Coin
rewardAmount) (Map (Credential 'Staking crypto) (Set (Reward crypto))
 -> Map (Credential 'Staking crypto) Coin)
-> Map (Credential 'Staking crypto) (Set (Reward crypto))
-> Map (Credential 'Staking crypto) Coin
forall a b. (a -> b) -> a -> b
$ (Map (Credential 'Staking crypto) (Set (Reward crypto)),
 Map (Credential 'Staking crypto) (Set (Reward crypto)))
-> Map (Credential 'Staking crypto) (Set (Reward crypto))
forall a b. (a, b) -> a
fst ((Map (Credential 'Staking crypto) (Set (Reward crypto)),
  Map (Credential 'Staking crypto) (Set (Reward crypto)))
 -> Map (Credential 'Staking crypto) (Set (Reward crypto)))
-> (Map (Credential 'Staking crypto) (Set (Reward crypto)),
    Map (Credential 'Staking crypto) (Set (Reward crypto)))
-> Map (Credential 'Staking crypto) (Set (Reward crypto))
forall a b. (a -> b) -> a -> b
$ pp
-> Map (Credential 'Staking crypto) (Set (Reward crypto))
-> (Map (Credential 'Staking crypto) (Set (Reward crypto)),
    Map (Credential 'Staking crypto) (Set (Reward crypto)))
forall crypto pp.
HasField "_protocolVersion" pp ProtVer =>
pp
-> Map (Credential 'Staking crypto) (Set (Reward crypto))
-> (Map (Credential 'Staking crypto) (Set (Reward crypto)),
    Map (Credential 'Staking crypto) (Set (Reward crypto)))
filterRewards pp
pp Map (Credential 'Staking crypto) (Set (Reward crypto))
rewards

data LeaderOnlyReward crypto = LeaderOnlyReward
  { LeaderOnlyReward crypto -> KeyHash 'StakePool crypto
lRewardPool :: !(KeyHash 'StakePool crypto),
    LeaderOnlyReward crypto -> Coin
lRewardAmount :: !Coin
  }
  deriving (LeaderOnlyReward crypto -> LeaderOnlyReward crypto -> Bool
(LeaderOnlyReward crypto -> LeaderOnlyReward crypto -> Bool)
-> (LeaderOnlyReward crypto -> LeaderOnlyReward crypto -> Bool)
-> Eq (LeaderOnlyReward crypto)
forall crypto.
LeaderOnlyReward crypto -> LeaderOnlyReward crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LeaderOnlyReward crypto -> LeaderOnlyReward crypto -> Bool
$c/= :: forall crypto.
LeaderOnlyReward crypto -> LeaderOnlyReward crypto -> Bool
== :: LeaderOnlyReward crypto -> LeaderOnlyReward crypto -> Bool
$c== :: forall crypto.
LeaderOnlyReward crypto -> LeaderOnlyReward crypto -> Bool
Eq, Eq (LeaderOnlyReward crypto)
Eq (LeaderOnlyReward crypto)
-> (LeaderOnlyReward crypto -> LeaderOnlyReward crypto -> Ordering)
-> (LeaderOnlyReward crypto -> LeaderOnlyReward crypto -> Bool)
-> (LeaderOnlyReward crypto -> LeaderOnlyReward crypto -> Bool)
-> (LeaderOnlyReward crypto -> LeaderOnlyReward crypto -> Bool)
-> (LeaderOnlyReward crypto -> LeaderOnlyReward crypto -> Bool)
-> (LeaderOnlyReward crypto
    -> LeaderOnlyReward crypto -> LeaderOnlyReward crypto)
-> (LeaderOnlyReward crypto
    -> LeaderOnlyReward crypto -> LeaderOnlyReward crypto)
-> Ord (LeaderOnlyReward crypto)
LeaderOnlyReward crypto -> LeaderOnlyReward crypto -> Bool
LeaderOnlyReward crypto -> LeaderOnlyReward crypto -> Ordering
LeaderOnlyReward crypto
-> LeaderOnlyReward crypto -> LeaderOnlyReward crypto
forall crypto. Eq (LeaderOnlyReward crypto)
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall crypto.
LeaderOnlyReward crypto -> LeaderOnlyReward crypto -> Bool
forall crypto.
LeaderOnlyReward crypto -> LeaderOnlyReward crypto -> Ordering
forall crypto.
LeaderOnlyReward crypto
-> LeaderOnlyReward crypto -> LeaderOnlyReward crypto
min :: LeaderOnlyReward crypto
-> LeaderOnlyReward crypto -> LeaderOnlyReward crypto
$cmin :: forall crypto.
LeaderOnlyReward crypto
-> LeaderOnlyReward crypto -> LeaderOnlyReward crypto
max :: LeaderOnlyReward crypto
-> LeaderOnlyReward crypto -> LeaderOnlyReward crypto
$cmax :: forall crypto.
LeaderOnlyReward crypto
-> LeaderOnlyReward crypto -> LeaderOnlyReward crypto
>= :: LeaderOnlyReward crypto -> LeaderOnlyReward crypto -> Bool
$c>= :: forall crypto.
LeaderOnlyReward crypto -> LeaderOnlyReward crypto -> Bool
> :: LeaderOnlyReward crypto -> LeaderOnlyReward crypto -> Bool
$c> :: forall crypto.
LeaderOnlyReward crypto -> LeaderOnlyReward crypto -> Bool
<= :: LeaderOnlyReward crypto -> LeaderOnlyReward crypto -> Bool
$c<= :: forall crypto.
LeaderOnlyReward crypto -> LeaderOnlyReward crypto -> Bool
< :: LeaderOnlyReward crypto -> LeaderOnlyReward crypto -> Bool
$c< :: forall crypto.
LeaderOnlyReward crypto -> LeaderOnlyReward crypto -> Bool
compare :: LeaderOnlyReward crypto -> LeaderOnlyReward crypto -> Ordering
$ccompare :: forall crypto.
LeaderOnlyReward crypto -> LeaderOnlyReward crypto -> Ordering
$cp1Ord :: forall crypto. Eq (LeaderOnlyReward crypto)
Ord, Int -> LeaderOnlyReward crypto -> ShowS
[LeaderOnlyReward crypto] -> ShowS
LeaderOnlyReward crypto -> String
(Int -> LeaderOnlyReward crypto -> ShowS)
-> (LeaderOnlyReward crypto -> String)
-> ([LeaderOnlyReward crypto] -> ShowS)
-> Show (LeaderOnlyReward crypto)
forall crypto. Int -> LeaderOnlyReward crypto -> ShowS
forall crypto. [LeaderOnlyReward crypto] -> ShowS
forall crypto. LeaderOnlyReward crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LeaderOnlyReward crypto] -> ShowS
$cshowList :: forall crypto. [LeaderOnlyReward crypto] -> ShowS
show :: LeaderOnlyReward crypto -> String
$cshow :: forall crypto. LeaderOnlyReward crypto -> String
showsPrec :: Int -> LeaderOnlyReward crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> LeaderOnlyReward crypto -> ShowS
Show, (forall x.
 LeaderOnlyReward crypto -> Rep (LeaderOnlyReward crypto) x)
-> (forall x.
    Rep (LeaderOnlyReward crypto) x -> LeaderOnlyReward crypto)
-> Generic (LeaderOnlyReward crypto)
forall x.
Rep (LeaderOnlyReward crypto) x -> LeaderOnlyReward crypto
forall x.
LeaderOnlyReward crypto -> Rep (LeaderOnlyReward crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x.
Rep (LeaderOnlyReward crypto) x -> LeaderOnlyReward crypto
forall crypto x.
LeaderOnlyReward crypto -> Rep (LeaderOnlyReward crypto) x
$cto :: forall crypto x.
Rep (LeaderOnlyReward crypto) x -> LeaderOnlyReward crypto
$cfrom :: forall crypto x.
LeaderOnlyReward crypto -> Rep (LeaderOnlyReward crypto) x
Generic)

instance NoThunks (LeaderOnlyReward crypto)

instance NFData (LeaderOnlyReward crypto)

instance CC.Crypto crypto => ToCBOR (LeaderOnlyReward crypto) where
  toCBOR :: LeaderOnlyReward crypto -> Encoding
toCBOR (LeaderOnlyReward KeyHash 'StakePool crypto
pool Coin
c) = Encode ('Closed 'Dense) (LeaderOnlyReward crypto) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) (LeaderOnlyReward crypto) -> Encoding)
-> Encode ('Closed 'Dense) (LeaderOnlyReward crypto) -> Encoding
forall a b. (a -> b) -> a -> b
$ (KeyHash 'StakePool crypto -> Coin -> LeaderOnlyReward crypto)
-> Encode
     ('Closed 'Dense)
     (KeyHash 'StakePool crypto -> Coin -> LeaderOnlyReward crypto)
forall t. t -> Encode ('Closed 'Dense) t
Rec KeyHash 'StakePool crypto -> Coin -> LeaderOnlyReward crypto
forall crypto.
KeyHash 'StakePool crypto -> Coin -> LeaderOnlyReward crypto
LeaderOnlyReward Encode
  ('Closed 'Dense)
  (KeyHash 'StakePool crypto -> Coin -> LeaderOnlyReward crypto)
-> Encode ('Closed 'Dense) (KeyHash 'StakePool crypto)
-> Encode ('Closed 'Dense) (Coin -> LeaderOnlyReward crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> KeyHash 'StakePool crypto
-> Encode ('Closed 'Dense) (KeyHash 'StakePool crypto)
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To KeyHash 'StakePool crypto
pool Encode ('Closed 'Dense) (Coin -> LeaderOnlyReward crypto)
-> Encode ('Closed 'Dense) Coin
-> Encode ('Closed 'Dense) (LeaderOnlyReward crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Coin -> Encode ('Closed 'Dense) Coin
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
c

instance CC.Crypto crypto => FromCBOR (LeaderOnlyReward crypto) where
  fromCBOR :: Decoder s (LeaderOnlyReward crypto)
fromCBOR = Decode ('Closed 'Dense) (LeaderOnlyReward crypto)
-> Decoder s (LeaderOnlyReward crypto)
forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) (LeaderOnlyReward crypto)
 -> Decoder s (LeaderOnlyReward crypto))
-> Decode ('Closed 'Dense) (LeaderOnlyReward crypto)
-> Decoder s (LeaderOnlyReward crypto)
forall a b. (a -> b) -> a -> b
$ (KeyHash 'StakePool crypto -> Coin -> LeaderOnlyReward crypto)
-> Decode
     ('Closed 'Dense)
     (KeyHash 'StakePool crypto -> Coin -> LeaderOnlyReward crypto)
forall t. t -> Decode ('Closed 'Dense) t
RecD KeyHash 'StakePool crypto -> Coin -> LeaderOnlyReward crypto
forall crypto.
KeyHash 'StakePool crypto -> Coin -> LeaderOnlyReward crypto
LeaderOnlyReward Decode
  ('Closed 'Dense)
  (KeyHash 'StakePool crypto -> Coin -> LeaderOnlyReward crypto)
-> Decode ('Closed Any) (KeyHash 'StakePool crypto)
-> Decode ('Closed 'Dense) (Coin -> LeaderOnlyReward crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (KeyHash 'StakePool crypto)
forall t (w :: Wrapped). FromCBOR t => Decode w t
From Decode ('Closed 'Dense) (Coin -> LeaderOnlyReward crypto)
-> Decode ('Closed Any) Coin
-> Decode ('Closed 'Dense) (LeaderOnlyReward crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Coin
forall t (w :: Wrapped). FromCBOR t => Decode w t
From

leaderRewardToGeneral :: LeaderOnlyReward c -> Reward c
leaderRewardToGeneral :: LeaderOnlyReward c -> Reward c
leaderRewardToGeneral (LeaderOnlyReward KeyHash 'StakePool c
poolId Coin
r) = RewardType -> KeyHash 'StakePool c -> Coin -> Reward c
forall crypto.
RewardType -> KeyHash 'StakePool crypto -> Coin -> Reward crypto
Reward RewardType
LeaderReward KeyHash 'StakePool c
poolId Coin
r

-- | Stake Pool specific information needed to compute the rewards
-- for its members.
data PoolRewardInfo crypto = PoolRewardInfo
  { -- | The stake pool's stake divided by the total stake
    PoolRewardInfo crypto -> StakeShare
poolRelativeStake :: !StakeShare,
    -- | The maximum rewards available for the entire pool
    PoolRewardInfo crypto -> Coin
poolPot :: !Coin,
    -- | The stake pool parameters
    PoolRewardInfo crypto -> PoolParams crypto
poolPs :: !(PoolParams crypto),
    -- | The number of blocks the stake pool produced
    PoolRewardInfo crypto -> Natural
poolBlocks :: !Natural,
    -- | The leader reward
    PoolRewardInfo crypto -> LeaderOnlyReward crypto
poolLeaderReward :: !(LeaderOnlyReward crypto)
  }
  deriving (Int -> PoolRewardInfo crypto -> ShowS
[PoolRewardInfo crypto] -> ShowS
PoolRewardInfo crypto -> String
(Int -> PoolRewardInfo crypto -> ShowS)
-> (PoolRewardInfo crypto -> String)
-> ([PoolRewardInfo crypto] -> ShowS)
-> Show (PoolRewardInfo crypto)
forall crypto. Int -> PoolRewardInfo crypto -> ShowS
forall crypto. [PoolRewardInfo crypto] -> ShowS
forall crypto. PoolRewardInfo crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PoolRewardInfo crypto] -> ShowS
$cshowList :: forall crypto. [PoolRewardInfo crypto] -> ShowS
show :: PoolRewardInfo crypto -> String
$cshow :: forall crypto. PoolRewardInfo crypto -> String
showsPrec :: Int -> PoolRewardInfo crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> PoolRewardInfo crypto -> ShowS
Show, PoolRewardInfo crypto -> PoolRewardInfo crypto -> Bool
(PoolRewardInfo crypto -> PoolRewardInfo crypto -> Bool)
-> (PoolRewardInfo crypto -> PoolRewardInfo crypto -> Bool)
-> Eq (PoolRewardInfo crypto)
forall crypto.
PoolRewardInfo crypto -> PoolRewardInfo crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PoolRewardInfo crypto -> PoolRewardInfo crypto -> Bool
$c/= :: forall crypto.
PoolRewardInfo crypto -> PoolRewardInfo crypto -> Bool
== :: PoolRewardInfo crypto -> PoolRewardInfo crypto -> Bool
$c== :: forall crypto.
PoolRewardInfo crypto -> PoolRewardInfo crypto -> Bool
Eq, Eq (PoolRewardInfo crypto)
Eq (PoolRewardInfo crypto)
-> (PoolRewardInfo crypto -> PoolRewardInfo crypto -> Ordering)
-> (PoolRewardInfo crypto -> PoolRewardInfo crypto -> Bool)
-> (PoolRewardInfo crypto -> PoolRewardInfo crypto -> Bool)
-> (PoolRewardInfo crypto -> PoolRewardInfo crypto -> Bool)
-> (PoolRewardInfo crypto -> PoolRewardInfo crypto -> Bool)
-> (PoolRewardInfo crypto
    -> PoolRewardInfo crypto -> PoolRewardInfo crypto)
-> (PoolRewardInfo crypto
    -> PoolRewardInfo crypto -> PoolRewardInfo crypto)
-> Ord (PoolRewardInfo crypto)
PoolRewardInfo crypto -> PoolRewardInfo crypto -> Bool
PoolRewardInfo crypto -> PoolRewardInfo crypto -> Ordering
PoolRewardInfo crypto
-> PoolRewardInfo crypto -> PoolRewardInfo crypto
forall crypto. Eq (PoolRewardInfo crypto)
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall crypto.
PoolRewardInfo crypto -> PoolRewardInfo crypto -> Bool
forall crypto.
PoolRewardInfo crypto -> PoolRewardInfo crypto -> Ordering
forall crypto.
PoolRewardInfo crypto
-> PoolRewardInfo crypto -> PoolRewardInfo crypto
min :: PoolRewardInfo crypto
-> PoolRewardInfo crypto -> PoolRewardInfo crypto
$cmin :: forall crypto.
PoolRewardInfo crypto
-> PoolRewardInfo crypto -> PoolRewardInfo crypto
max :: PoolRewardInfo crypto
-> PoolRewardInfo crypto -> PoolRewardInfo crypto
$cmax :: forall crypto.
PoolRewardInfo crypto
-> PoolRewardInfo crypto -> PoolRewardInfo crypto
>= :: PoolRewardInfo crypto -> PoolRewardInfo crypto -> Bool
$c>= :: forall crypto.
PoolRewardInfo crypto -> PoolRewardInfo crypto -> Bool
> :: PoolRewardInfo crypto -> PoolRewardInfo crypto -> Bool
$c> :: forall crypto.
PoolRewardInfo crypto -> PoolRewardInfo crypto -> Bool
<= :: PoolRewardInfo crypto -> PoolRewardInfo crypto -> Bool
$c<= :: forall crypto.
PoolRewardInfo crypto -> PoolRewardInfo crypto -> Bool
< :: PoolRewardInfo crypto -> PoolRewardInfo crypto -> Bool
$c< :: forall crypto.
PoolRewardInfo crypto -> PoolRewardInfo crypto -> Bool
compare :: PoolRewardInfo crypto -> PoolRewardInfo crypto -> Ordering
$ccompare :: forall crypto.
PoolRewardInfo crypto -> PoolRewardInfo crypto -> Ordering
$cp1Ord :: forall crypto. Eq (PoolRewardInfo crypto)
Ord, (forall x. PoolRewardInfo crypto -> Rep (PoolRewardInfo crypto) x)
-> (forall x.
    Rep (PoolRewardInfo crypto) x -> PoolRewardInfo crypto)
-> Generic (PoolRewardInfo crypto)
forall x. Rep (PoolRewardInfo crypto) x -> PoolRewardInfo crypto
forall x. PoolRewardInfo crypto -> Rep (PoolRewardInfo crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x.
Rep (PoolRewardInfo crypto) x -> PoolRewardInfo crypto
forall crypto x.
PoolRewardInfo crypto -> Rep (PoolRewardInfo crypto) x
$cto :: forall crypto x.
Rep (PoolRewardInfo crypto) x -> PoolRewardInfo crypto
$cfrom :: forall crypto x.
PoolRewardInfo crypto -> Rep (PoolRewardInfo crypto) x
Generic)

instance NoThunks (PoolRewardInfo crypto)

instance NFData (PoolRewardInfo crypto)

instance CC.Crypto crypto => ToCBOR (PoolRewardInfo crypto) where
  toCBOR :: PoolRewardInfo crypto -> Encoding
toCBOR
    (PoolRewardInfo StakeShare
a Coin
b PoolParams crypto
c Natural
d LeaderOnlyReward crypto
e) =
      Encode ('Closed 'Dense) (PoolRewardInfo crypto) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) (PoolRewardInfo crypto) -> Encoding)
-> Encode ('Closed 'Dense) (PoolRewardInfo crypto) -> Encoding
forall a b. (a -> b) -> a -> b
$
        (StakeShare
 -> Coin
 -> PoolParams crypto
 -> Natural
 -> LeaderOnlyReward crypto
 -> PoolRewardInfo crypto)
-> Encode
     ('Closed 'Dense)
     (StakeShare
      -> Coin
      -> PoolParams crypto
      -> Natural
      -> LeaderOnlyReward crypto
      -> PoolRewardInfo crypto)
forall t. t -> Encode ('Closed 'Dense) t
Rec StakeShare
-> Coin
-> PoolParams crypto
-> Natural
-> LeaderOnlyReward crypto
-> PoolRewardInfo crypto
forall crypto.
StakeShare
-> Coin
-> PoolParams crypto
-> Natural
-> LeaderOnlyReward crypto
-> PoolRewardInfo crypto
PoolRewardInfo
          Encode
  ('Closed 'Dense)
  (StakeShare
   -> Coin
   -> PoolParams crypto
   -> Natural
   -> LeaderOnlyReward crypto
   -> PoolRewardInfo crypto)
-> Encode ('Closed 'Dense) StakeShare
-> Encode
     ('Closed 'Dense)
     (Coin
      -> PoolParams crypto
      -> Natural
      -> LeaderOnlyReward crypto
      -> PoolRewardInfo crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (StakeShare -> Encoding)
-> StakeShare -> Encode ('Closed 'Dense) StakeShare
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E (Rational -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Rational -> Encoding)
-> (StakeShare -> Rational) -> StakeShare -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StakeShare -> Rational
unStakeShare) StakeShare
a
          Encode
  ('Closed 'Dense)
  (Coin
   -> PoolParams crypto
   -> Natural
   -> LeaderOnlyReward crypto
   -> PoolRewardInfo crypto)
-> Encode ('Closed 'Dense) Coin
-> Encode
     ('Closed 'Dense)
     (PoolParams crypto
      -> Natural -> LeaderOnlyReward crypto -> PoolRewardInfo crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Coin -> Encode ('Closed 'Dense) Coin
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
b
          Encode
  ('Closed 'Dense)
  (PoolParams crypto
   -> Natural -> LeaderOnlyReward crypto -> PoolRewardInfo crypto)
-> Encode ('Closed 'Dense) (PoolParams crypto)
-> Encode
     ('Closed 'Dense)
     (Natural -> LeaderOnlyReward crypto -> PoolRewardInfo crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> PoolParams crypto -> Encode ('Closed 'Dense) (PoolParams crypto)
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To PoolParams crypto
c
          Encode
  ('Closed 'Dense)
  (Natural -> LeaderOnlyReward crypto -> PoolRewardInfo crypto)
-> Encode ('Closed 'Dense) Natural
-> Encode
     ('Closed 'Dense) (LeaderOnlyReward crypto -> PoolRewardInfo crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Natural -> Encode ('Closed 'Dense) Natural
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Natural
d
          Encode
  ('Closed 'Dense) (LeaderOnlyReward crypto -> PoolRewardInfo crypto)
-> Encode ('Closed 'Dense) (LeaderOnlyReward crypto)
-> Encode ('Closed 'Dense) (PoolRewardInfo crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> LeaderOnlyReward crypto
-> Encode ('Closed 'Dense) (LeaderOnlyReward crypto)
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To LeaderOnlyReward crypto
e

instance CC.Crypto crypto => FromCBOR (PoolRewardInfo crypto) where
  fromCBOR :: Decoder s (PoolRewardInfo crypto)
fromCBOR =
    Decode ('Closed 'Dense) (PoolRewardInfo crypto)
-> Decoder s (PoolRewardInfo crypto)
forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode
      ( (StakeShare
 -> Coin
 -> PoolParams crypto
 -> Natural
 -> LeaderOnlyReward crypto
 -> PoolRewardInfo crypto)
-> Decode
     ('Closed 'Dense)
     (StakeShare
      -> Coin
      -> PoolParams crypto
      -> Natural
      -> LeaderOnlyReward crypto
      -> PoolRewardInfo crypto)
forall t. t -> Decode ('Closed 'Dense) t
RecD StakeShare
-> Coin
-> PoolParams crypto
-> Natural
-> LeaderOnlyReward crypto
-> PoolRewardInfo crypto
forall crypto.
StakeShare
-> Coin
-> PoolParams crypto
-> Natural
-> LeaderOnlyReward crypto
-> PoolRewardInfo crypto
PoolRewardInfo
          Decode
  ('Closed 'Dense)
  (StakeShare
   -> Coin
   -> PoolParams crypto
   -> Natural
   -> LeaderOnlyReward crypto
   -> PoolRewardInfo crypto)
-> Decode ('Closed 'Dense) StakeShare
-> Decode
     ('Closed 'Dense)
     (Coin
      -> PoolParams crypto
      -> Natural
      -> LeaderOnlyReward crypto
      -> PoolRewardInfo crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s. Decoder s StakeShare)
-> Decode ('Closed 'Dense) StakeShare
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Rational -> StakeShare
StakeShare (Rational -> StakeShare)
-> Decoder s Rational -> Decoder s StakeShare
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Rational
forall a s. FromCBOR a => Decoder s a
fromCBOR)
          Decode
  ('Closed 'Dense)
  (Coin
   -> PoolParams crypto
   -> Natural
   -> LeaderOnlyReward crypto
   -> PoolRewardInfo crypto)
-> Decode ('Closed Any) Coin
-> Decode
     ('Closed 'Dense)
     (PoolParams crypto
      -> Natural -> LeaderOnlyReward crypto -> PoolRewardInfo crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Coin
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
          Decode
  ('Closed 'Dense)
  (PoolParams crypto
   -> Natural -> LeaderOnlyReward crypto -> PoolRewardInfo crypto)
-> Decode ('Closed Any) (PoolParams crypto)
-> Decode
     ('Closed 'Dense)
     (Natural -> LeaderOnlyReward crypto -> PoolRewardInfo crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (PoolParams crypto)
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
          Decode
  ('Closed 'Dense)
  (Natural -> LeaderOnlyReward crypto -> PoolRewardInfo crypto)
-> Decode ('Closed Any) Natural
-> Decode
     ('Closed 'Dense) (LeaderOnlyReward crypto -> PoolRewardInfo crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Natural
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
          Decode
  ('Closed 'Dense) (LeaderOnlyReward crypto -> PoolRewardInfo crypto)
-> Decode ('Closed Any) (LeaderOnlyReward crypto)
-> Decode ('Closed 'Dense) (PoolRewardInfo crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (LeaderOnlyReward crypto)
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
      )

notPoolOwner ::
  HasField "_protocolVersion" pp ProtVer =>
  pp ->
  PoolParams crypto ->
  Credential 'Staking crypto ->
  Bool
notPoolOwner :: pp -> PoolParams crypto -> Credential 'Staking crypto -> Bool
notPoolOwner pp
pp PoolParams crypto
pps = \case
  KeyHashObj KeyHash 'Staking crypto
hk -> KeyHash 'Staking crypto
hk KeyHash 'Staking crypto -> Set (KeyHash 'Staking crypto) -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` PoolParams crypto -> Set (KeyHash 'Staking crypto)
forall crypto. PoolParams crypto -> Set (KeyHash 'Staking crypto)
_poolOwners PoolParams crypto
pps
  ScriptHashObj ScriptHash crypto
_ -> pp -> Bool
forall pp. HasField "_protocolVersion" pp ProtVer => pp -> Bool
HardForks.allowScriptStakeCredsToEarnRewards pp
pp

-- | The stake pool member reward calculation
rewardOnePoolMember ::
  HasField "_protocolVersion" pp ProtVer =>
  -- | The protocol parameters
  pp ->
  -- | The total amount of stake in the system
  Coin ->
  -- | The set of registered stake credentials
  Set (Credential 'Staking c) ->
  -- | Stake pool specific intermediate values needed
  -- to compute member rewards.
  PoolRewardInfo c ->
  -- | The stake credential whose reward is being calculated.
  Credential 'Staking c ->
  -- | The stake controlled by the stake credential
  -- in the previous parameter above.
  Coin ->
  -- | The reward for the given stake credential.
  -- This could be Nothing if the credential is no longer registered,
  -- if it is an owner, or if the reward is zero.
  Maybe Coin
rewardOnePoolMember :: pp
-> Coin
-> Set (Credential 'Staking c)
-> PoolRewardInfo c
-> Credential 'Staking c
-> Coin
-> Maybe Coin
rewardOnePoolMember
  pp
pp
  (Coin Integer
totalStake)
  Set (Credential 'Staking c)
addrsRew
  PoolRewardInfo c
rewardInfo
  Credential 'Staking c
hk
  (Coin Integer
c) =
    if Bool
prefilter Bool -> Bool -> Bool
&& pp -> PoolParams c -> Credential 'Staking c -> Bool
forall pp crypto.
HasField "_protocolVersion" pp ProtVer =>
pp -> PoolParams crypto -> Credential 'Staking crypto -> Bool
notPoolOwner pp
pp (PoolRewardInfo c -> PoolParams c
forall crypto. PoolRewardInfo crypto -> PoolParams crypto
poolPs PoolRewardInfo c
rewardInfo) Credential 'Staking c
hk Bool -> Bool -> Bool
&& Coin
r Coin -> Coin -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer -> Coin
Coin Integer
0
      then Coin -> Maybe Coin
forall a. a -> Maybe a
Just Coin
r
      else Maybe Coin
forall a. Maybe a
Nothing
    where
      prefilter :: Bool
prefilter = pp -> Bool
forall pp. HasField "_protocolVersion" pp ProtVer => pp -> Bool
HardForks.forgoRewardPrefilter pp
pp Bool -> Bool -> Bool
|| Credential 'Staking c
hk Credential 'Staking c -> Set (Credential 'Staking c) -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set (Credential 'Staking c)
addrsRew
      pool :: PoolParams c
pool = PoolRewardInfo c -> PoolParams c
forall crypto. PoolRewardInfo crypto -> PoolParams crypto
poolPs PoolRewardInfo c
rewardInfo
      sigma :: StakeShare
sigma = PoolRewardInfo c -> StakeShare
forall crypto. PoolRewardInfo crypto -> StakeShare
poolRelativeStake PoolRewardInfo c
rewardInfo
      poolR :: Coin
poolR = PoolRewardInfo c -> Coin
forall crypto. PoolRewardInfo crypto -> Coin
poolPot PoolRewardInfo c
rewardInfo
      r :: Coin
r = Coin -> PoolParams c -> StakeShare -> StakeShare -> Coin
forall crypto.
Coin -> PoolParams crypto -> StakeShare -> StakeShare -> Coin
memberRew Coin
poolR PoolParams c
pool (Rational -> StakeShare
StakeShare (Integer
c Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
totalStake)) StakeShare
sigma

-- | Calculate single stake pool specific values for the reward computation.
--
-- Note that if a stake pool has made no blocks in the given epoch, it will
-- get no rewards, and so we do not need to return 'PoolRewardInfo'. We do,
-- however, need to return the relative stake of the pool in order to
-- compute data for the stake pool ranking. Eventually we will remove
-- the ranking information out of the ledger code and into a separate service,
-- and at that point we can simplify this function to not care about ranking.
mkPoolRewardInfo ::
  ( HasField "_d" (Core.PParams era) UnitInterval,
    HasField "_a0" (Core.PParams era) NonNegativeInterval,
    HasField "_nOpt" (Core.PParams era) Natural
  ) =>
  Core.PParams era ->
  Coin ->
  BlocksMade (Crypto era) ->
  Natural ->
  Stake (Crypto era) ->
  VMap.VMap VMap.VB VMap.VB (Credential 'Staking (Crypto era)) (KeyHash 'StakePool (Crypto era)) ->
  Map (KeyHash 'StakePool (Crypto era)) Coin ->
  Coin ->
  Coin ->
  PoolParams (Crypto era) ->
  Either StakeShare (PoolRewardInfo (Crypto era))
mkPoolRewardInfo :: PParams era
-> Coin
-> BlocksMade (Crypto era)
-> Natural
-> Stake (Crypto era)
-> VMap
     VB
     VB
     (Credential 'Staking (Crypto era))
     (KeyHash 'StakePool (Crypto era))
-> Map (KeyHash 'StakePool (Crypto era)) Coin
-> Coin
-> Coin
-> PoolParams (Crypto era)
-> Either StakeShare (PoolRewardInfo (Crypto era))
mkPoolRewardInfo
  PParams era
pp
  Coin
r
  BlocksMade (Crypto era)
blocks
  Natural
blocksTotal
  Stake (Crypto era)
stake
  VMap
  VB
  VB
  (Credential 'Staking (Crypto era))
  (KeyHash 'StakePool (Crypto era))
delegs
  Map (KeyHash 'StakePool (Crypto era)) Coin
stakePerPool
  (Coin Integer
totalStake)
  (Coin Integer
activeStake)
  PoolParams (Crypto era)
pool = case KeyHash 'StakePool (Crypto era)
-> Map (KeyHash 'StakePool (Crypto era)) Natural -> Maybe Natural
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (PoolParams (Crypto era) -> KeyHash 'StakePool (Crypto era)
forall crypto. PoolParams crypto -> KeyHash 'StakePool crypto
_poolId PoolParams (Crypto era)
pool) (BlocksMade (Crypto era)
-> Map (KeyHash 'StakePool (Crypto era)) Natural
forall crypto.
BlocksMade crypto -> Map (KeyHash 'StakePool crypto) Natural
unBlocksMade BlocksMade (Crypto era)
blocks) of
    -- This pool made no blocks this epoch. For the purposes of stake pool
    -- ranking only, we return the relative stake of this pool so that we
    -- can judge how likely it was that this pool made no blocks.
    Maybe Natural
Nothing -> StakeShare -> Either StakeShare (PoolRewardInfo (Crypto era))
forall a b. a -> Either a b
Left (StakeShare -> Either StakeShare (PoolRewardInfo (Crypto era)))
-> StakeShare -> Either StakeShare (PoolRewardInfo (Crypto era))
forall a b. (a -> b) -> a -> b
$! Rational -> StakeShare
StakeShare Rational
sigma
    -- This pool made no blocks, so we can proceed to calculate the
    -- intermediate values needed for the individual reward calculations.
    Just Natural
blocksN ->
      let Coin Integer
pledge = PoolParams (Crypto era) -> Coin
forall crypto. PoolParams crypto -> Coin
_poolPledge PoolParams (Crypto era)
pool
          pledgeRelative :: Rational
pledgeRelative = Integer
pledge Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
totalStake
          sigmaA :: Rational
sigmaA = if Integer
activeStake Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then Rational
0 else Integer
pstakeTot Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
activeStake
          Coin Integer
maxP =
            if Integer
pledge Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
ostake
              then NonNegativeInterval
-> Natural -> Coin -> Rational -> Rational -> Coin
maxPool' NonNegativeInterval
pp_a0 Natural
pp_nOpt Coin
r Rational
sigma Rational
pledgeRelative
              else Coin
forall a. Monoid a => a
mempty
          appPerf :: Rational
appPerf = UnitInterval -> Rational -> Natural -> Natural -> Rational
mkApparentPerformance UnitInterval
pp_d Rational
sigmaA Natural
blocksN Natural
blocksTotal
          poolR :: Coin
poolR = Rational -> Coin
rationalToCoinViaFloor (Rational
appPerf Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Integer -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
maxP)
          lreward :: Coin
lreward =
            Coin -> PoolParams (Crypto era) -> StakeShare -> StakeShare -> Coin
forall crypto.
Coin -> PoolParams crypto -> StakeShare -> StakeShare -> Coin
leaderRew
              Coin
poolR
              PoolParams (Crypto era)
pool
              (Rational -> StakeShare
StakeShare (Rational -> StakeShare) -> Rational -> StakeShare
forall a b. (a -> b) -> a -> b
$ if Integer
totalStake Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then Rational
0 else Integer
ostake Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
totalStake)
              (Rational -> StakeShare
StakeShare Rational
sigma)
          rewardInfo :: PoolRewardInfo (Crypto era)
rewardInfo =
            PoolRewardInfo :: forall crypto.
StakeShare
-> Coin
-> PoolParams crypto
-> Natural
-> LeaderOnlyReward crypto
-> PoolRewardInfo crypto
PoolRewardInfo
              { poolRelativeStake :: StakeShare
poolRelativeStake = Rational -> StakeShare
StakeShare Rational
sigma,
                poolPot :: Coin
poolPot = Coin
poolR,
                poolPs :: PoolParams (Crypto era)
poolPs = PoolParams (Crypto era)
pool,
                poolBlocks :: Natural
poolBlocks = Natural
blocksN,
                poolLeaderReward :: LeaderOnlyReward (Crypto era)
poolLeaderReward = KeyHash 'StakePool (Crypto era)
-> Coin -> LeaderOnlyReward (Crypto era)
forall crypto.
KeyHash 'StakePool crypto -> Coin -> LeaderOnlyReward crypto
LeaderOnlyReward (PoolParams (Crypto era) -> KeyHash 'StakePool (Crypto era)
forall crypto. PoolParams crypto -> KeyHash 'StakePool crypto
_poolId PoolParams (Crypto era)
pool) Coin
lreward
              }
       in PoolRewardInfo (Crypto era)
-> Either StakeShare (PoolRewardInfo (Crypto era))
forall a b. b -> Either a b
Right (PoolRewardInfo (Crypto era)
 -> Either StakeShare (PoolRewardInfo (Crypto era)))
-> PoolRewardInfo (Crypto era)
-> Either StakeShare (PoolRewardInfo (Crypto era))
forall a b. (a -> b) -> a -> b
$! PoolRewardInfo (Crypto era)
rewardInfo
    where
      pp_d :: UnitInterval
pp_d = PParams era -> UnitInterval
forall k (x :: k) r a. HasField x r a => r -> a
getField @"_d" PParams era
pp
      pp_a0 :: NonNegativeInterval
pp_a0 = PParams era -> NonNegativeInterval
forall k (x :: k) r a. HasField x r a => r -> a
getField @"_a0" PParams era
pp
      pp_nOpt :: Natural
pp_nOpt = PParams era -> Natural
forall k (x :: k) r a. HasField x r a => r -> a
getField @"_nOpt" PParams era
pp
      Coin Integer
pstakeTot = Coin
-> KeyHash 'StakePool (Crypto era)
-> Map (KeyHash 'StakePool (Crypto era)) Coin
-> Coin
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Coin
forall a. Monoid a => a
mempty (PoolParams (Crypto era) -> KeyHash 'StakePool (Crypto era)
forall crypto. PoolParams crypto -> KeyHash 'StakePool crypto
_poolId PoolParams (Crypto era)
pool) Map (KeyHash 'StakePool (Crypto era)) Coin
stakePerPool
      accOwnerStake :: Coin -> KeyHash 'Staking (Crypto era) -> Coin
accOwnerStake Coin
c KeyHash 'Staking (Crypto era)
o = Coin -> (Coin -> Coin) -> Maybe Coin -> Coin
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Coin
c (Coin
c Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<>) (Maybe Coin -> Coin) -> Maybe Coin -> Coin
forall a b. (a -> b) -> a -> b
$ do
        KeyHash 'StakePool (Crypto era)
hk <- Credential 'Staking (Crypto era)
-> VMap
     VB
     VB
     (Credential 'Staking (Crypto era))
     (KeyHash 'StakePool (Crypto era))
-> Maybe (KeyHash 'StakePool (Crypto era))
forall k (kv :: * -> *) (vv :: * -> *) v.
(Ord k, Vector kv k, Vector vv v) =>
k -> VMap kv vv k v -> Maybe v
VMap.lookup (KeyHash 'Staking (Crypto era) -> Credential 'Staking (Crypto era)
forall (kr :: KeyRole) crypto.
KeyHash kr crypto -> Credential kr crypto
KeyHashObj KeyHash 'Staking (Crypto era)
o) VMap
  VB
  VB
  (Credential 'Staking (Crypto era))
  (KeyHash 'StakePool (Crypto era))
delegs
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (KeyHash 'StakePool (Crypto era)
hk KeyHash 'StakePool (Crypto era)
-> KeyHash 'StakePool (Crypto era) -> Bool
forall a. Eq a => a -> a -> Bool
== PoolParams (Crypto era) -> KeyHash 'StakePool (Crypto era)
forall crypto. PoolParams crypto -> KeyHash 'StakePool crypto
_poolId PoolParams (Crypto era)
pool)
        CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact (CompactForm Coin -> Coin)
-> Maybe (CompactForm Coin) -> Maybe Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Credential 'Staking (Crypto era)
-> VMap VB VP (Credential 'Staking (Crypto era)) (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 (KeyHash 'Staking (Crypto era) -> Credential 'Staking (Crypto era)
forall (kr :: KeyRole) crypto.
KeyHash kr crypto -> Credential kr crypto
KeyHashObj KeyHash 'Staking (Crypto era)
o) (Stake (Crypto era)
-> VMap VB VP (Credential 'Staking (Crypto era)) (CompactForm Coin)
forall crypto.
Stake crypto
-> VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
unStake Stake (Crypto era)
stake)
      Coin Integer
ostake = (Coin -> KeyHash 'Staking (Crypto era) -> Coin)
-> Coin -> Set (KeyHash 'Staking (Crypto era)) -> Coin
forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl' Coin -> KeyHash 'Staking (Crypto era) -> Coin
accOwnerStake Coin
forall a. Monoid a => a
mempty (PoolParams (Crypto era) -> Set (KeyHash 'Staking (Crypto era))
forall crypto. PoolParams crypto -> Set (KeyHash 'Staking crypto)
_poolOwners PoolParams (Crypto era)
pool)
      sigma :: Rational
sigma = if Integer
totalStake Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then Rational
0 else Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
pstakeTot Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
totalStake