{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
module Cardano.Ledger.Shelley.API.Wallet (
getUTxO,
getUTxOSubset,
getFilteredUTxO,
getPools,
getPoolParameters,
getTotalStake,
poolsByTotalStakeFraction,
RewardInfoPool (..),
RewardParams (..),
getRewardInfoPools,
getRewardProvenance,
getNonMyopicMemberRewards,
addKeyWitnesses,
AdaPots (..),
totalAdaES,
totalAdaPotsES,
) where
import Cardano.Ledger.Address (Addr (..), compactAddr)
import Cardano.Ledger.BaseTypes (
Globals (..),
NonNegativeInterval,
UnitInterval,
epochInfoPure,
(%?),
)
import Cardano.Ledger.Binary (
DecCBOR (..),
EncCBOR (..),
decodeDouble,
encodeDouble,
)
import Cardano.Ledger.Binary.Coders (
Decode (..),
Encode (..),
decode,
encode,
(!>),
(<!),
)
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Compactible (fromCompact)
import Cardano.Ledger.Credential (Credential (..))
import Cardano.Ledger.Keys (WitVKey (..))
import Cardano.Ledger.PoolParams (PoolParams (..))
import Cardano.Ledger.Shelley.AdaPots (
AdaPots (..),
totalAdaES,
totalAdaPotsES,
)
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.LedgerState (
EpochState (..),
LedgerState (..),
NewEpochState (..),
RewardUpdate,
UTxOState (..),
circulation,
createRUpd,
curPParamsEpochStateL,
esLStateL,
lsCertStateL,
nesEsL,
)
import Cardano.Ledger.Shelley.PoolRank (
NonMyopic (..),
PerformanceEstimate (..),
getTopRankedPoolsVMap,
nonMyopicMemberRew,
percentile',
)
import Cardano.Ledger.Shelley.RewardProvenance (RewardProvenance)
import Cardano.Ledger.Shelley.Rewards (StakeShare (..))
import Cardano.Ledger.Shelley.State
import Cardano.Ledger.Slot (epochInfoSize)
import qualified Cardano.Ledger.State as EB
import Cardano.Ledger.TxIn (TxIn (..))
import Cardano.Slotting.Slot (EpochSize)
import Control.DeepSeq (NFData)
import Control.Monad.Trans.Reader (runReader)
import Data.Aeson (FromJSON, ToJSON)
import Data.Default (Default (def))
import Data.Foldable (foldMap')
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.VMap as VMap
import Data.Word (Word16)
import GHC.Generics (Generic)
import Lens.Micro
import NoThunks.Class (NoThunks (..))
getUTxO ::
NewEpochState era ->
UTxO era
getUTxO :: forall era. NewEpochState era -> UTxO era
getUTxO = UTxOState era -> UTxO era
forall era. UTxOState era -> UTxO era
utxosUtxo (UTxOState era -> UTxO era)
-> (NewEpochState era -> UTxOState era)
-> NewEpochState era
-> UTxO era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState era -> UTxOState era
forall era. LedgerState era -> UTxOState era
lsUTxOState (LedgerState era -> UTxOState era)
-> (NewEpochState era -> LedgerState era)
-> NewEpochState era
-> UTxOState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState (EpochState era -> LedgerState era)
-> (NewEpochState era -> EpochState era)
-> NewEpochState era
-> LedgerState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs
getFilteredUTxO ::
EraTxOut era =>
NewEpochState era ->
Set Addr ->
UTxO era
getFilteredUTxO :: forall era.
EraTxOut era =>
NewEpochState era -> Set Addr -> UTxO era
getFilteredUTxO NewEpochState era
ss Set Addr
addrSet =
Map TxIn (TxOut era) -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO (Map TxIn (TxOut era) -> UTxO era)
-> Map TxIn (TxOut era) -> UTxO era
forall a b. (a -> b) -> a -> b
$ (TxOut era -> Bool) -> Map TxIn (TxOut era) -> Map TxIn (TxOut era)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter TxOut era -> Bool
checkAddr Map TxIn (TxOut era)
fullUTxO
where
UTxO Map TxIn (TxOut era)
fullUTxO = NewEpochState era -> UTxO era
forall era. NewEpochState era -> UTxO era
getUTxO NewEpochState era
ss
compactAddrSet :: Set CompactAddr
compactAddrSet = (Addr -> CompactAddr) -> Set Addr -> Set CompactAddr
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Addr -> CompactAddr
compactAddr Set Addr
addrSet
checkAddr :: TxOut era -> Bool
checkAddr TxOut era
out =
case TxOut era
out TxOut era
-> Getting
(Either Addr CompactAddr) (TxOut era) (Either Addr CompactAddr)
-> Either Addr CompactAddr
forall s a. s -> Getting a s a -> a
^. Getting
(Either Addr CompactAddr) (TxOut era) (Either Addr CompactAddr)
forall era.
EraTxOut era =>
Lens' (TxOut era) (Either Addr CompactAddr)
Lens' (TxOut era) (Either Addr CompactAddr)
addrEitherTxOutL of
Left Addr
addr -> Addr
addr Addr -> Set Addr -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Addr
addrSet
Right CompactAddr
cAddr -> CompactAddr
cAddr CompactAddr -> Set CompactAddr -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set CompactAddr
compactAddrSet
{-# INLINEABLE getFilteredUTxO #-}
getUTxOSubset ::
NewEpochState era ->
Set TxIn ->
UTxO era
getUTxOSubset :: forall era. NewEpochState era -> Set TxIn -> UTxO era
getUTxOSubset NewEpochState era
nes = UTxO era -> Set TxIn -> UTxO era
forall era. UTxO era -> Set TxIn -> UTxO era
txInsFilter (NewEpochState era -> UTxO era
forall era. NewEpochState era -> UTxO era
getUTxO NewEpochState era
nes)
getPools ::
EraCertState era =>
NewEpochState era ->
Set (KeyHash 'StakePool)
getPools :: forall era.
EraCertState era =>
NewEpochState era -> Set (KeyHash 'StakePool)
getPools = Map (KeyHash 'StakePool) PoolParams -> Set (KeyHash 'StakePool)
forall k a. Map k a -> Set k
Map.keysSet (Map (KeyHash 'StakePool) PoolParams -> Set (KeyHash 'StakePool))
-> (NewEpochState era -> Map (KeyHash 'StakePool) PoolParams)
-> NewEpochState era
-> Set (KeyHash 'StakePool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> Map (KeyHash 'StakePool) PoolParams
forall {era}.
(Assert
(OrdCond
(CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
(TypeError ...),
Assert
(OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
(TypeError ...),
Assert
(OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
(TypeError ...),
EraCertState era) =>
NewEpochState era -> Map (KeyHash 'StakePool) PoolParams
f
where
f :: NewEpochState era -> Map (KeyHash 'StakePool) PoolParams
f NewEpochState era
nes = NewEpochState era
nes NewEpochState era
-> Getting
(Map (KeyHash 'StakePool) PoolParams)
(NewEpochState era)
(Map (KeyHash 'StakePool) PoolParams)
-> Map (KeyHash 'StakePool) PoolParams
forall s a. s -> Getting a s a -> a
^. (EpochState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (EpochState era))
-> NewEpochState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (EpochState era))
-> NewEpochState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (NewEpochState era))
-> ((Map (KeyHash 'StakePool) PoolParams
-> Const
(Map (KeyHash 'StakePool) PoolParams)
(Map (KeyHash 'StakePool) PoolParams))
-> EpochState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (EpochState era))
-> Getting
(Map (KeyHash 'StakePool) PoolParams)
(NewEpochState era)
(Map (KeyHash 'StakePool) PoolParams)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (LedgerState era))
-> EpochState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (LedgerState era))
-> EpochState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (EpochState era))
-> ((Map (KeyHash 'StakePool) PoolParams
-> Const
(Map (KeyHash 'StakePool) PoolParams)
(Map (KeyHash 'StakePool) PoolParams))
-> LedgerState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (LedgerState era))
-> (Map (KeyHash 'StakePool) PoolParams
-> Const
(Map (KeyHash 'StakePool) PoolParams)
(Map (KeyHash 'StakePool) PoolParams))
-> EpochState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (CertState era))
-> LedgerState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (CertState era))
-> LedgerState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (LedgerState era))
-> ((Map (KeyHash 'StakePool) PoolParams
-> Const
(Map (KeyHash 'StakePool) PoolParams)
(Map (KeyHash 'StakePool) PoolParams))
-> CertState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (CertState era))
-> (Map (KeyHash 'StakePool) PoolParams
-> Const
(Map (KeyHash 'StakePool) PoolParams)
(Map (KeyHash 'StakePool) PoolParams))
-> LedgerState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (PState era))
-> CertState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (CertState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
certPStateL ((PState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (PState era))
-> CertState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (CertState era))
-> ((Map (KeyHash 'StakePool) PoolParams
-> Const
(Map (KeyHash 'StakePool) PoolParams)
(Map (KeyHash 'StakePool) PoolParams))
-> PState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (PState era))
-> (Map (KeyHash 'StakePool) PoolParams
-> Const
(Map (KeyHash 'StakePool) PoolParams)
(Map (KeyHash 'StakePool) PoolParams))
-> CertState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (KeyHash 'StakePool) PoolParams
-> Const
(Map (KeyHash 'StakePool) PoolParams)
(Map (KeyHash 'StakePool) PoolParams))
-> PState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (PState era)
forall era (f :: * -> *).
Functor f =>
(Map (KeyHash 'StakePool) PoolParams
-> f (Map (KeyHash 'StakePool) PoolParams))
-> PState era -> f (PState era)
psStakePoolParamsL
getPoolParameters ::
EraCertState era =>
NewEpochState era ->
Set (KeyHash 'StakePool) ->
Map (KeyHash 'StakePool) PoolParams
getPoolParameters :: forall era.
EraCertState era =>
NewEpochState era
-> Set (KeyHash 'StakePool) -> Map (KeyHash 'StakePool) PoolParams
getPoolParameters = Map (KeyHash 'StakePool) PoolParams
-> Set (KeyHash 'StakePool) -> Map (KeyHash 'StakePool) PoolParams
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys (Map (KeyHash 'StakePool) PoolParams
-> Set (KeyHash 'StakePool) -> Map (KeyHash 'StakePool) PoolParams)
-> (NewEpochState era -> Map (KeyHash 'StakePool) PoolParams)
-> NewEpochState era
-> Set (KeyHash 'StakePool)
-> Map (KeyHash 'StakePool) PoolParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> Map (KeyHash 'StakePool) PoolParams
forall {era}.
(Assert
(OrdCond
(CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
(TypeError ...),
Assert
(OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
(TypeError ...),
Assert
(OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
(TypeError ...),
EraCertState era) =>
NewEpochState era -> Map (KeyHash 'StakePool) PoolParams
f
where
f :: NewEpochState era -> Map (KeyHash 'StakePool) PoolParams
f NewEpochState era
nes = NewEpochState era
nes NewEpochState era
-> Getting
(Map (KeyHash 'StakePool) PoolParams)
(NewEpochState era)
(Map (KeyHash 'StakePool) PoolParams)
-> Map (KeyHash 'StakePool) PoolParams
forall s a. s -> Getting a s a -> a
^. (EpochState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (EpochState era))
-> NewEpochState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (EpochState era))
-> NewEpochState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (NewEpochState era))
-> ((Map (KeyHash 'StakePool) PoolParams
-> Const
(Map (KeyHash 'StakePool) PoolParams)
(Map (KeyHash 'StakePool) PoolParams))
-> EpochState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (EpochState era))
-> Getting
(Map (KeyHash 'StakePool) PoolParams)
(NewEpochState era)
(Map (KeyHash 'StakePool) PoolParams)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (LedgerState era))
-> EpochState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (LedgerState era))
-> EpochState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (EpochState era))
-> ((Map (KeyHash 'StakePool) PoolParams
-> Const
(Map (KeyHash 'StakePool) PoolParams)
(Map (KeyHash 'StakePool) PoolParams))
-> LedgerState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (LedgerState era))
-> (Map (KeyHash 'StakePool) PoolParams
-> Const
(Map (KeyHash 'StakePool) PoolParams)
(Map (KeyHash 'StakePool) PoolParams))
-> EpochState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (CertState era))
-> LedgerState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (CertState era))
-> LedgerState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (LedgerState era))
-> ((Map (KeyHash 'StakePool) PoolParams
-> Const
(Map (KeyHash 'StakePool) PoolParams)
(Map (KeyHash 'StakePool) PoolParams))
-> CertState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (CertState era))
-> (Map (KeyHash 'StakePool) PoolParams
-> Const
(Map (KeyHash 'StakePool) PoolParams)
(Map (KeyHash 'StakePool) PoolParams))
-> LedgerState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (PState era))
-> CertState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (CertState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
certPStateL ((PState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (PState era))
-> CertState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (CertState era))
-> ((Map (KeyHash 'StakePool) PoolParams
-> Const
(Map (KeyHash 'StakePool) PoolParams)
(Map (KeyHash 'StakePool) PoolParams))
-> PState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (PState era))
-> (Map (KeyHash 'StakePool) PoolParams
-> Const
(Map (KeyHash 'StakePool) PoolParams)
(Map (KeyHash 'StakePool) PoolParams))
-> CertState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (KeyHash 'StakePool) PoolParams
-> Const
(Map (KeyHash 'StakePool) PoolParams)
(Map (KeyHash 'StakePool) PoolParams))
-> PState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (PState era)
forall era (f :: * -> *).
Functor f =>
(Map (KeyHash 'StakePool) PoolParams
-> f (Map (KeyHash 'StakePool) PoolParams))
-> PState era -> f (PState era)
psStakePoolParamsL
poolsByTotalStakeFraction ::
(EraGov era, EraStake era, EraCertState era) =>
Globals ->
NewEpochState era ->
PoolDistr
poolsByTotalStakeFraction :: forall era.
(EraGov era, EraStake era, EraCertState era) =>
Globals -> NewEpochState era -> PoolDistr
poolsByTotalStakeFraction Globals
globals NewEpochState era
ss =
Map (KeyHash 'StakePool) IndividualPoolStake
-> CompactForm Coin -> PoolDistr
PoolDistr Map (KeyHash 'StakePool) IndividualPoolStake
poolsByTotalStake CompactForm Coin
totalActiveStake
where
snap :: SnapShot
snap = NewEpochState era -> SnapShot
forall era.
(EraGov era, EraStake era, EraCertState era) =>
NewEpochState era -> SnapShot
currentSnapshot NewEpochState era
ss
Coin Integer
totalStake = Globals -> NewEpochState era -> Coin
forall era. Globals -> NewEpochState era -> Coin
getTotalStake Globals
globals NewEpochState era
ss
stakeRatio :: Rational
stakeRatio = Coin -> Integer
unCoin (CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm Coin
totalActiveStake) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%? Integer
totalStake
PoolDistr Map (KeyHash 'StakePool) IndividualPoolStake
poolsByActiveStake CompactForm Coin
totalActiveStake = SnapShot -> PoolDistr
calculatePoolDistr SnapShot
snap
poolsByTotalStake :: Map (KeyHash 'StakePool) IndividualPoolStake
poolsByTotalStake = (IndividualPoolStake -> IndividualPoolStake)
-> Map (KeyHash 'StakePool) IndividualPoolStake
-> Map (KeyHash 'StakePool) IndividualPoolStake
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map IndividualPoolStake -> IndividualPoolStake
toTotalStakeFrac Map (KeyHash 'StakePool) IndividualPoolStake
poolsByActiveStake
toTotalStakeFrac ::
IndividualPoolStake ->
IndividualPoolStake
toTotalStakeFrac :: IndividualPoolStake -> IndividualPoolStake
toTotalStakeFrac (IndividualPoolStake Rational
s CompactForm Coin
c VRFVerKeyHash 'StakePoolVRF
vrf) =
Rational
-> CompactForm Coin
-> VRFVerKeyHash 'StakePoolVRF
-> IndividualPoolStake
IndividualPoolStake (Rational
s Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
stakeRatio) CompactForm Coin
c VRFVerKeyHash 'StakePoolVRF
vrf
getTotalStake :: Globals -> NewEpochState era -> Coin
getTotalStake :: forall era. Globals -> NewEpochState era -> Coin
getTotalStake Globals
globals NewEpochState era
ss =
let supply :: Coin
supply = Integer -> Coin
Coin (Integer -> Coin) -> (Word64 -> Integer) -> Word64 -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Coin) -> Word64 -> Coin
forall a b. (a -> b) -> a -> b
$ Globals -> Word64
maxLovelaceSupply Globals
globals
es :: EpochState era
es = NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
ss
in EpochState era -> Coin -> Coin
forall era. EpochState era -> Coin -> Coin
circulation EpochState era
es Coin
supply
getNonMyopicMemberRewards ::
(EraGov era, EraStake era, EraCertState era) =>
Globals ->
NewEpochState era ->
Set (Either Coin (Credential 'Staking)) ->
Map
(Either Coin (Credential 'Staking))
(Map (KeyHash 'StakePool) Coin)
getNonMyopicMemberRewards :: forall era.
(EraGov era, EraStake era, EraCertState era) =>
Globals
-> NewEpochState era
-> Set (Either Coin (Credential 'Staking))
-> Map
(Either Coin (Credential 'Staking)) (Map (KeyHash 'StakePool) Coin)
getNonMyopicMemberRewards Globals
globals NewEpochState era
ss =
(Either Coin (Credential 'Staking)
-> Map (KeyHash 'StakePool) Coin)
-> Set (Either Coin (Credential 'Staking))
-> Map
(Either Coin (Credential 'Staking)) (Map (KeyHash 'StakePool) Coin)
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (\Either Coin (Credential 'Staking)
cred -> ((PerformanceEstimate, PoolParams, StakeShare) -> Coin)
-> Map
(KeyHash 'StakePool) (PerformanceEstimate, PoolParams, StakeShare)
-> Map (KeyHash 'StakePool) Coin
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (StakeShare -> (PerformanceEstimate, PoolParams, StakeShare) -> Coin
mkNMMRewards (StakeShare
-> (PerformanceEstimate, PoolParams, StakeShare) -> Coin)
-> StakeShare
-> (PerformanceEstimate, PoolParams, StakeShare)
-> Coin
forall a b. (a -> b) -> a -> b
$ Either Coin (Credential 'Staking) -> StakeShare
memShare Either Coin (Credential 'Staking)
cred) Map
(KeyHash 'StakePool) (PerformanceEstimate, PoolParams, StakeShare)
poolData)
where
maxSupply :: Coin
maxSupply = Integer -> Coin
Coin (Integer -> Coin) -> (Word64 -> Integer) -> Word64 -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Coin) -> Word64 -> Coin
forall a b. (a -> b) -> a -> b
$ Globals -> Word64
maxLovelaceSupply Globals
globals
totalStakeCoin :: Coin
totalStakeCoin@(Coin Integer
totalStake) = EpochState era -> Coin -> Coin
forall era. EpochState era -> Coin -> Coin
circulation EpochState era
es Coin
maxSupply
toShare :: Coin -> StakeShare
toShare (Coin Integer
x) = Rational -> StakeShare
StakeShare (Rational -> StakeShare) -> Rational -> StakeShare
forall a b. (a -> b) -> a -> b
$ Integer
x Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%? Integer
totalStake
memShare :: Either Coin (Credential 'Staking) -> StakeShare
memShare (Right Credential 'Staking
cred) =
Coin -> StakeShare
toShare (Coin -> StakeShare) -> Coin -> StakeShare
forall a b. (a -> b) -> a -> b
$ Coin
-> (CompactForm Coin -> Coin) -> Maybe (CompactForm Coin) -> Coin
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Coin
forall a. Monoid a => a
mempty CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact (Maybe (CompactForm Coin) -> Coin)
-> Maybe (CompactForm Coin) -> Coin
forall a b. (a -> b) -> a -> b
$ Credential 'Staking
-> VMap VB VP (Credential 'Staking) (CompactForm Coin)
-> Maybe (CompactForm Coin)
forall k (kv :: * -> *) (vv :: * -> *) v.
(Ord k, Vector kv k, Vector vv v) =>
k -> VMap kv vv k v -> Maybe v
VMap.lookup Credential 'Staking
cred (Stake -> VMap VB VP (Credential 'Staking) (CompactForm Coin)
EB.unStake Stake
stake)
memShare (Left Coin
coin) = Coin -> StakeShare
toShare Coin
coin
es :: EpochState era
es = NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
ss
pp :: PParams era
pp = EpochState era
es EpochState era
-> Getting (PParams era) (EpochState era) (PParams era)
-> PParams era
forall s a. s -> Getting a s a -> a
^. Getting (PParams era) (EpochState era) (PParams era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL
NonMyopic {likelihoodsNM :: NonMyopic -> Map (KeyHash 'StakePool) Likelihood
likelihoodsNM = Map (KeyHash 'StakePool) Likelihood
ls, rewardPotNM :: NonMyopic -> Coin
rewardPotNM = Coin
rPot} = EpochState era -> NonMyopic
forall era. EpochState era -> NonMyopic
esNonMyopic EpochState era
es
EB.SnapShot Stake
stake VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
delegs VMap VB VB (KeyHash 'StakePool) PoolParams
poolParams = NewEpochState era -> SnapShot
forall era.
(EraGov era, EraStake era, EraCertState era) =>
NewEpochState era -> SnapShot
currentSnapshot NewEpochState era
ss
poolData :: Map
(KeyHash 'StakePool) (PerformanceEstimate, PoolParams, StakeShare)
poolData =
[(KeyHash 'StakePool,
(PerformanceEstimate, PoolParams, StakeShare))]
-> Map
(KeyHash 'StakePool) (PerformanceEstimate, PoolParams, StakeShare)
forall k a. [(k, a)] -> Map k a
Map.fromDistinctAscList
[ ( KeyHash 'StakePool
k
,
( Likelihood -> PerformanceEstimate
percentile' (KeyHash 'StakePool -> Likelihood
histLookup KeyHash 'StakePool
k)
, PoolParams
p
, Coin -> StakeShare
toShare (Coin -> StakeShare) -> (Stake -> Coin) -> Stake -> StakeShare
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stake -> Coin
EB.sumAllStake (Stake -> StakeShare) -> Stake -> StakeShare
forall a b. (a -> b) -> a -> b
$ KeyHash 'StakePool
-> VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
-> Stake
-> Stake
EB.poolStake KeyHash 'StakePool
k VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
delegs Stake
stake
)
)
| (KeyHash 'StakePool
k, PoolParams
p) <- VMap VB VB (KeyHash 'StakePool) PoolParams
-> [(KeyHash 'StakePool, PoolParams)]
forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
VMap kv vv k v -> [(k, v)]
VMap.toAscList VMap VB VB (KeyHash 'StakePool) PoolParams
poolParams
]
histLookup :: KeyHash 'StakePool -> Likelihood
histLookup KeyHash 'StakePool
k = Likelihood
-> KeyHash 'StakePool
-> Map (KeyHash 'StakePool) Likelihood
-> Likelihood
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Likelihood
forall a. Monoid a => a
mempty KeyHash 'StakePool
k Map (KeyHash 'StakePool) Likelihood
ls
topPools :: Set (KeyHash 'StakePool)
topPools =
Coin
-> Coin
-> PParams era
-> VMap VB VB (KeyHash 'StakePool) PoolParams
-> Map (KeyHash 'StakePool) PerformanceEstimate
-> Set (KeyHash 'StakePool)
forall era.
EraPParams era =>
Coin
-> Coin
-> PParams era
-> VMap VB VB (KeyHash 'StakePool) PoolParams
-> Map (KeyHash 'StakePool) PerformanceEstimate
-> Set (KeyHash 'StakePool)
getTopRankedPoolsVMap
Coin
rPot
Coin
totalStakeCoin
PParams era
pp
VMap VB VB (KeyHash 'StakePool) PoolParams
poolParams
((Likelihood -> PerformanceEstimate)
-> Map (KeyHash 'StakePool) Likelihood
-> Map (KeyHash 'StakePool) PerformanceEstimate
forall a b.
(a -> b)
-> Map (KeyHash 'StakePool) a -> Map (KeyHash 'StakePool) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Likelihood -> PerformanceEstimate
percentile' Map (KeyHash 'StakePool) Likelihood
ls)
mkNMMRewards :: StakeShare -> (PerformanceEstimate, PoolParams, StakeShare) -> Coin
mkNMMRewards StakeShare
t (PerformanceEstimate
hitRateEst, PoolParams
poolp, StakeShare
sigma) =
if PoolParams -> Bool
checkPledge PoolParams
poolp
then PParams era
-> Coin
-> PoolParams
-> StakeShare
-> StakeShare
-> StakeShare
-> Set (KeyHash 'StakePool)
-> PerformanceEstimate
-> Coin
forall era.
EraPParams era =>
PParams era
-> Coin
-> PoolParams
-> StakeShare
-> StakeShare
-> StakeShare
-> Set (KeyHash 'StakePool)
-> PerformanceEstimate
-> Coin
nonMyopicMemberRew PParams era
pp Coin
rPot PoolParams
poolp StakeShare
s StakeShare
sigma StakeShare
t Set (KeyHash 'StakePool)
topPools PerformanceEstimate
hitRateEst
else Coin
forall a. Monoid a => a
mempty
where
s :: StakeShare
s = (Coin -> StakeShare
toShare (Coin -> StakeShare)
-> (PoolParams -> Coin) -> PoolParams -> StakeShare
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoolParams -> Coin
ppPledge) PoolParams
poolp
checkPledge :: PoolParams -> Bool
checkPledge PoolParams
pool =
let ostake :: Coin
ostake = PoolParams -> Stake -> Coin
sumPoolOwnersStake PoolParams
pool Stake
stake
in PoolParams -> Coin
ppPledge PoolParams
poolp Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
<= Coin
ostake
sumPoolOwnersStake :: PoolParams -> EB.Stake -> Coin
PoolParams
pool Stake
stake =
let getStakeFor :: KeyHash 'Staking -> Coin
getStakeFor KeyHash 'Staking
o =
Coin
-> (CompactForm Coin -> Coin) -> Maybe (CompactForm Coin) -> Coin
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Coin
forall a. Monoid a => a
mempty CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact (Maybe (CompactForm Coin) -> Coin)
-> Maybe (CompactForm Coin) -> Coin
forall a b. (a -> b) -> a -> b
$ Credential 'Staking
-> VMap VB VP (Credential 'Staking) (CompactForm Coin)
-> Maybe (CompactForm Coin)
forall k (kv :: * -> *) (vv :: * -> *) v.
(Ord k, Vector kv k, Vector vv v) =>
k -> VMap kv vv k v -> Maybe v
VMap.lookup (KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
o) (Stake -> VMap VB VP (Credential 'Staking) (CompactForm Coin)
EB.unStake Stake
stake)
in (KeyHash 'Staking -> Coin) -> Set (KeyHash 'Staking) -> Coin
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' KeyHash 'Staking -> Coin
getStakeFor (PoolParams -> Set (KeyHash 'Staking)
ppOwners PoolParams
pool)
currentSnapshot :: (EraGov era, EraStake era, EraCertState era) => NewEpochState era -> EB.SnapShot
currentSnapshot :: forall era.
(EraGov era, EraStake era, EraCertState era) =>
NewEpochState era -> SnapShot
currentSnapshot NewEpochState era
ss =
InstantStake era -> DState era -> PState era -> SnapShot
forall era.
EraStake era =>
InstantStake era -> DState era -> PState era -> SnapShot
snapShotFromInstantStake InstantStake era
instantStake DState era
dstate PState era
pstate
where
_pp :: PParams era
_pp = NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
ss EpochState era
-> Getting (PParams era) (EpochState era) (PParams era)
-> PParams era
forall s a. s -> Getting a s a -> a
^. Getting (PParams era) (EpochState era) (PParams era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL
ledgerState :: LedgerState era
ledgerState = EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState (EpochState era -> LedgerState era)
-> EpochState era -> LedgerState era
forall a b. (a -> b) -> a -> b
$ NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
ss
instantStake :: InstantStake era
instantStake = LedgerState era
ledgerState LedgerState era
-> Getting (InstantStake era) (LedgerState era) (InstantStake era)
-> InstantStake era
forall s a. s -> Getting a s a -> a
^. Getting (InstantStake era) (LedgerState era) (InstantStake era)
forall era. SimpleGetter (LedgerState era) (InstantStake era)
forall (t :: * -> *) era.
CanGetInstantStake t =>
SimpleGetter (t era) (InstantStake era)
instantStakeG
dstate :: DState era
dstate = LedgerState era
ledgerState LedgerState era
-> Getting (DState era) (LedgerState era) (DState era)
-> DState era
forall s a. s -> Getting a s a -> a
^. (CertState era -> Const (DState era) (CertState era))
-> LedgerState era -> Const (DState era) (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era -> Const (DState era) (CertState era))
-> LedgerState era -> Const (DState era) (LedgerState era))
-> ((DState era -> Const (DState era) (DState era))
-> CertState era -> Const (DState era) (CertState era))
-> Getting (DState era) (LedgerState era) (DState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DState era -> Const (DState era) (DState era))
-> CertState era -> Const (DState era) (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL
pstate :: PState era
pstate = LedgerState era
ledgerState LedgerState era
-> Getting (PState era) (LedgerState era) (PState era)
-> PState era
forall s a. s -> Getting a s a -> a
^. (CertState era -> Const (PState era) (CertState era))
-> LedgerState era -> Const (PState era) (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era -> Const (PState era) (CertState era))
-> LedgerState era -> Const (PState era) (LedgerState era))
-> ((PState era -> Const (PState era) (PState era))
-> CertState era -> Const (PState era) (CertState era))
-> Getting (PState era) (LedgerState era) (PState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PState era -> Const (PState era) (PState era))
-> CertState era -> Const (PState era) (CertState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
certPStateL
data RewardInfoPool = RewardInfoPool
{ RewardInfoPool -> Coin
stake :: Coin
, RewardInfoPool -> Coin
ownerPledge :: Coin
, RewardInfoPool -> Coin
ownerStake :: Coin
, RewardInfoPool -> Coin
cost :: Coin
, RewardInfoPool -> UnitInterval
margin :: UnitInterval
, RewardInfoPool -> Double
performanceEstimate :: Double
}
deriving (RewardInfoPool -> RewardInfoPool -> Bool
(RewardInfoPool -> RewardInfoPool -> Bool)
-> (RewardInfoPool -> RewardInfoPool -> Bool) -> Eq RewardInfoPool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RewardInfoPool -> RewardInfoPool -> Bool
== :: RewardInfoPool -> RewardInfoPool -> Bool
$c/= :: RewardInfoPool -> RewardInfoPool -> Bool
/= :: RewardInfoPool -> RewardInfoPool -> Bool
Eq, Int -> RewardInfoPool -> ShowS
[RewardInfoPool] -> ShowS
RewardInfoPool -> String
(Int -> RewardInfoPool -> ShowS)
-> (RewardInfoPool -> String)
-> ([RewardInfoPool] -> ShowS)
-> Show RewardInfoPool
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RewardInfoPool -> ShowS
showsPrec :: Int -> RewardInfoPool -> ShowS
$cshow :: RewardInfoPool -> String
show :: RewardInfoPool -> String
$cshowList :: [RewardInfoPool] -> ShowS
showList :: [RewardInfoPool] -> ShowS
Show, (forall x. RewardInfoPool -> Rep RewardInfoPool x)
-> (forall x. Rep RewardInfoPool x -> RewardInfoPool)
-> Generic RewardInfoPool
forall x. Rep RewardInfoPool x -> RewardInfoPool
forall x. RewardInfoPool -> Rep RewardInfoPool x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RewardInfoPool -> Rep RewardInfoPool x
from :: forall x. RewardInfoPool -> Rep RewardInfoPool x
$cto :: forall x. Rep RewardInfoPool x -> RewardInfoPool
to :: forall x. Rep RewardInfoPool x -> RewardInfoPool
Generic)
instance NoThunks RewardInfoPool
instance NFData RewardInfoPool
deriving instance FromJSON RewardInfoPool
deriving instance ToJSON RewardInfoPool
data RewardParams = RewardParams
{ RewardParams -> Word16
nOpt :: Word16
, RewardParams -> NonNegativeInterval
a0 :: NonNegativeInterval
, RewardParams -> Coin
rPot :: Coin
, RewardParams -> Coin
totalStake :: Coin
}
deriving (RewardParams -> RewardParams -> Bool
(RewardParams -> RewardParams -> Bool)
-> (RewardParams -> RewardParams -> Bool) -> Eq RewardParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RewardParams -> RewardParams -> Bool
== :: RewardParams -> RewardParams -> Bool
$c/= :: RewardParams -> RewardParams -> Bool
/= :: RewardParams -> RewardParams -> Bool
Eq, Int -> RewardParams -> ShowS
[RewardParams] -> ShowS
RewardParams -> String
(Int -> RewardParams -> ShowS)
-> (RewardParams -> String)
-> ([RewardParams] -> ShowS)
-> Show RewardParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RewardParams -> ShowS
showsPrec :: Int -> RewardParams -> ShowS
$cshow :: RewardParams -> String
show :: RewardParams -> String
$cshowList :: [RewardParams] -> ShowS
showList :: [RewardParams] -> ShowS
Show, (forall x. RewardParams -> Rep RewardParams x)
-> (forall x. Rep RewardParams x -> RewardParams)
-> Generic RewardParams
forall x. Rep RewardParams x -> RewardParams
forall x. RewardParams -> Rep RewardParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RewardParams -> Rep RewardParams x
from :: forall x. RewardParams -> Rep RewardParams x
$cto :: forall x. Rep RewardParams x -> RewardParams
to :: forall x. Rep RewardParams x -> RewardParams
Generic)
instance NoThunks RewardParams
instance NFData RewardParams
deriving instance FromJSON RewardParams
deriving instance ToJSON RewardParams
getRewardInfoPools ::
(EraGov era, EraStake era, EraCertState era) =>
Globals ->
NewEpochState era ->
(RewardParams, Map (KeyHash 'StakePool) RewardInfoPool)
getRewardInfoPools :: forall era.
(EraGov era, EraStake era, EraCertState era) =>
Globals
-> NewEpochState era
-> (RewardParams, Map (KeyHash 'StakePool) RewardInfoPool)
getRewardInfoPools Globals
globals NewEpochState era
ss =
(RewardParams
mkRewardParams, VMap VB VB (KeyHash 'StakePool) RewardInfoPool
-> Map (KeyHash 'StakePool) RewardInfoPool
forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
VMap kv vv k v -> Map k v
VMap.toMap ((KeyHash 'StakePool -> PoolParams -> RewardInfoPool)
-> VMap VB VB (KeyHash 'StakePool) PoolParams
-> VMap VB VB (KeyHash 'StakePool) RewardInfoPool
forall (kv :: * -> *) k (vv :: * -> *) a b.
(Vector kv k, Vector vv a, Vector vv b) =>
(k -> a -> b) -> VMap kv vv k a -> VMap kv vv k b
VMap.mapWithKey KeyHash 'StakePool -> PoolParams -> RewardInfoPool
mkRewardInfoPool VMap VB VB (KeyHash 'StakePool) PoolParams
poolParams))
where
es :: EpochState era
es = NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
ss
pp :: PParams era
pp = EpochState era
es EpochState era
-> Getting (PParams era) (EpochState era) (PParams era)
-> PParams era
forall s a. s -> Getting a s a -> a
^. Getting (PParams era) (EpochState era) (PParams era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL
NonMyopic
{ likelihoodsNM :: NonMyopic -> Map (KeyHash 'StakePool) Likelihood
likelihoodsNM = Map (KeyHash 'StakePool) Likelihood
ls
, rewardPotNM :: NonMyopic -> Coin
rewardPotNM = Coin
rPot
} = EpochState era -> NonMyopic
forall era. EpochState era -> NonMyopic
esNonMyopic EpochState era
es
histLookup :: KeyHash 'StakePool -> Likelihood
histLookup KeyHash 'StakePool
key = Likelihood
-> KeyHash 'StakePool
-> Map (KeyHash 'StakePool) Likelihood
-> Likelihood
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Likelihood
forall a. Monoid a => a
mempty KeyHash 'StakePool
key Map (KeyHash 'StakePool) Likelihood
ls
EB.SnapShot Stake
stakes VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
delegs VMap VB VB (KeyHash 'StakePool) PoolParams
poolParams = NewEpochState era -> SnapShot
forall era.
(EraGov era, EraStake era, EraCertState era) =>
NewEpochState era -> SnapShot
currentSnapshot NewEpochState era
ss
mkRewardParams :: RewardParams
mkRewardParams =
RewardParams
{ a0 :: NonNegativeInterval
a0 = PParams era
pp PParams era
-> Getting NonNegativeInterval (PParams era) NonNegativeInterval
-> NonNegativeInterval
forall s a. s -> Getting a s a -> a
^. Getting NonNegativeInterval (PParams era) NonNegativeInterval
forall era.
EraPParams era =>
Lens' (PParams era) NonNegativeInterval
Lens' (PParams era) NonNegativeInterval
ppA0L
, nOpt :: Word16
nOpt = PParams era
pp PParams era -> Getting Word16 (PParams era) Word16 -> Word16
forall s a. s -> Getting a s a -> a
^. Getting Word16 (PParams era) Word16
forall era. EraPParams era => Lens' (PParams era) Word16
Lens' (PParams era) Word16
ppNOptL
, totalStake :: Coin
totalStake = Globals -> NewEpochState era -> Coin
forall era. Globals -> NewEpochState era -> Coin
getTotalStake Globals
globals NewEpochState era
ss
, rPot :: Coin
rPot = Coin
rPot
}
mkRewardInfoPool :: KeyHash 'StakePool -> PoolParams -> RewardInfoPool
mkRewardInfoPool KeyHash 'StakePool
key PoolParams
poolp =
RewardInfoPool
{ stake :: Coin
stake = Coin
pstake
, ownerStake :: Coin
ownerStake = Coin
ostake
, ownerPledge :: Coin
ownerPledge = PoolParams -> Coin
ppPledge PoolParams
poolp
, margin :: UnitInterval
margin = PoolParams -> UnitInterval
ppMargin PoolParams
poolp
, cost :: Coin
cost = PoolParams -> Coin
ppCost PoolParams
poolp
, performanceEstimate :: Double
performanceEstimate =
PerformanceEstimate -> Double
unPerformanceEstimate (PerformanceEstimate -> Double) -> PerformanceEstimate -> Double
forall a b. (a -> b) -> a -> b
$ Likelihood -> PerformanceEstimate
percentile' (Likelihood -> PerformanceEstimate)
-> Likelihood -> PerformanceEstimate
forall a b. (a -> b) -> a -> b
$ KeyHash 'StakePool -> Likelihood
histLookup KeyHash 'StakePool
key
}
where
pstake :: Coin
pstake = Stake -> Coin
EB.sumAllStake (Stake -> Coin) -> Stake -> Coin
forall a b. (a -> b) -> a -> b
$ KeyHash 'StakePool
-> VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
-> Stake
-> Stake
EB.poolStake KeyHash 'StakePool
key VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
delegs Stake
stakes
ostake :: Coin
ostake = PoolParams -> Stake -> Coin
sumPoolOwnersStake PoolParams
poolp Stake
stakes
getRewardProvenance ::
forall era.
(EraGov era, EraCertState era) =>
Globals ->
NewEpochState era ->
(RewardUpdate, RewardProvenance)
getRewardProvenance :: forall era.
(EraGov era, EraCertState era) =>
Globals -> NewEpochState era -> (RewardUpdate, RewardProvenance)
getRewardProvenance Globals
globals NewEpochState era
newEpochState =
( Reader Globals RewardUpdate -> Globals -> RewardUpdate
forall r a. Reader r a -> r -> a
runReader
(EpochSize
-> BlocksMade
-> EpochState era
-> Coin
-> ActiveSlotCoeff
-> NonZero Word64
-> Reader Globals RewardUpdate
forall era.
(EraGov era, EraCertState era) =>
EpochSize
-> BlocksMade
-> EpochState era
-> Coin
-> ActiveSlotCoeff
-> NonZero Word64
-> Reader Globals RewardUpdate
createRUpd EpochSize
slotsPerEpoch BlocksMade
blocksMade EpochState era
epochState Coin
maxSupply ActiveSlotCoeff
asc NonZero Word64
secparam)
Globals
globals
, RewardProvenance
forall a. Default a => a
def
)
where
epochState :: EpochState era
epochState = NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
newEpochState
maxSupply :: Coin
maxSupply = Integer -> Coin
Coin (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Globals -> Word64
maxLovelaceSupply Globals
globals))
blocksMade :: BlocksMade
blocksMade = NewEpochState era -> BlocksMade
forall era. NewEpochState era -> BlocksMade
nesBprev NewEpochState era
newEpochState
epochNo :: EpochNo
epochNo = NewEpochState era -> EpochNo
forall era. NewEpochState era -> EpochNo
nesEL NewEpochState era
newEpochState
slotsPerEpoch :: EpochSize
slotsPerEpoch :: EpochSize
slotsPerEpoch = HasCallStack => EpochInfo Identity -> EpochNo -> EpochSize
EpochInfo Identity -> EpochNo -> EpochSize
epochInfoSize (Globals -> EpochInfo Identity
epochInfoPure Globals
globals) EpochNo
epochNo
asc :: ActiveSlotCoeff
asc = Globals -> ActiveSlotCoeff
activeSlotCoeff Globals
globals
secparam :: NonZero Word64
secparam = Globals -> NonZero Word64
securityParameter Globals
globals
addKeyWitnesses :: EraTx era => Tx era -> Set (WitVKey 'Witness) -> Tx era
addKeyWitnesses :: forall era. EraTx era => Tx era -> Set (WitVKey 'Witness) -> Tx era
addKeyWitnesses Tx era
tx Set (WitVKey 'Witness)
newWits = Tx era
tx Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era))
-> ((Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
-> TxWits era -> Identity (TxWits era))
-> (Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
-> TxWits era -> Identity (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness))
Lens' (TxWits era) (Set (WitVKey 'Witness))
addrTxWitsL ((Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
-> Tx era -> Identity (Tx era))
-> (Set (WitVKey 'Witness) -> Set (WitVKey 'Witness))
-> Tx era
-> Tx era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Set (WitVKey 'Witness)
-> Set (WitVKey 'Witness) -> Set (WitVKey 'Witness)
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set (WitVKey 'Witness)
newWits
instance EncCBOR RewardParams where
encCBOR :: RewardParams -> Encoding
encCBOR (RewardParams Word16
p1 NonNegativeInterval
p2 Coin
p3 Coin
p4) =
Encode ('Closed 'Dense) RewardParams -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) RewardParams -> Encoding)
-> Encode ('Closed 'Dense) RewardParams -> Encoding
forall a b. (a -> b) -> a -> b
$
(Word16 -> NonNegativeInterval -> Coin -> Coin -> RewardParams)
-> Encode
('Closed 'Dense)
(Word16 -> NonNegativeInterval -> Coin -> Coin -> RewardParams)
forall t. t -> Encode ('Closed 'Dense) t
Rec Word16 -> NonNegativeInterval -> Coin -> Coin -> RewardParams
RewardParams
Encode
('Closed 'Dense)
(Word16 -> NonNegativeInterval -> Coin -> Coin -> RewardParams)
-> Encode ('Closed 'Dense) Word16
-> Encode
('Closed 'Dense)
(NonNegativeInterval -> Coin -> Coin -> RewardParams)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word16 -> Encode ('Closed 'Dense) Word16
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Word16
p1
Encode
('Closed 'Dense)
(NonNegativeInterval -> Coin -> Coin -> RewardParams)
-> Encode ('Closed 'Dense) NonNegativeInterval
-> Encode ('Closed 'Dense) (Coin -> Coin -> RewardParams)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> NonNegativeInterval -> Encode ('Closed 'Dense) NonNegativeInterval
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To NonNegativeInterval
p2
Encode ('Closed 'Dense) (Coin -> Coin -> RewardParams)
-> Encode ('Closed 'Dense) Coin
-> Encode ('Closed 'Dense) (Coin -> RewardParams)
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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
p3
Encode ('Closed 'Dense) (Coin -> RewardParams)
-> Encode ('Closed 'Dense) Coin
-> Encode ('Closed 'Dense) RewardParams
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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
p4
instance DecCBOR RewardParams where
decCBOR :: forall s. Decoder s RewardParams
decCBOR =
Decode ('Closed 'Dense) RewardParams -> Decoder s RewardParams
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) RewardParams -> Decoder s RewardParams)
-> Decode ('Closed 'Dense) RewardParams -> Decoder s RewardParams
forall a b. (a -> b) -> a -> b
$
(Word16 -> NonNegativeInterval -> Coin -> Coin -> RewardParams)
-> Decode
('Closed 'Dense)
(Word16 -> NonNegativeInterval -> Coin -> Coin -> RewardParams)
forall t. t -> Decode ('Closed 'Dense) t
RecD Word16 -> NonNegativeInterval -> Coin -> Coin -> RewardParams
RewardParams
Decode
('Closed 'Dense)
(Word16 -> NonNegativeInterval -> Coin -> Coin -> RewardParams)
-> Decode ('Closed Any) Word16
-> Decode
('Closed 'Dense)
(NonNegativeInterval -> Coin -> Coin -> RewardParams)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Word16
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Decode
('Closed 'Dense)
(NonNegativeInterval -> Coin -> Coin -> RewardParams)
-> Decode ('Closed Any) NonNegativeInterval
-> Decode ('Closed 'Dense) (Coin -> Coin -> RewardParams)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) NonNegativeInterval
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Decode ('Closed 'Dense) (Coin -> Coin -> RewardParams)
-> Decode ('Closed Any) Coin
-> Decode ('Closed 'Dense) (Coin -> RewardParams)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Coin
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Decode ('Closed 'Dense) (Coin -> RewardParams)
-> Decode ('Closed Any) Coin
-> Decode ('Closed 'Dense) RewardParams
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Coin
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
instance EncCBOR RewardInfoPool where
encCBOR :: RewardInfoPool -> Encoding
encCBOR (RewardInfoPool Coin
p1 Coin
p2 Coin
p3 Coin
p4 UnitInterval
p5 Double
d6) =
Encode ('Closed 'Dense) RewardInfoPool -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) RewardInfoPool -> Encoding)
-> Encode ('Closed 'Dense) RewardInfoPool -> Encoding
forall a b. (a -> b) -> a -> b
$
(Coin
-> Coin
-> Coin
-> Coin
-> UnitInterval
-> Double
-> RewardInfoPool)
-> Encode
('Closed 'Dense)
(Coin
-> Coin
-> Coin
-> Coin
-> UnitInterval
-> Double
-> RewardInfoPool)
forall t. t -> Encode ('Closed 'Dense) t
Rec Coin
-> Coin -> Coin -> Coin -> UnitInterval -> Double -> RewardInfoPool
RewardInfoPool
Encode
('Closed 'Dense)
(Coin
-> Coin
-> Coin
-> Coin
-> UnitInterval
-> Double
-> RewardInfoPool)
-> Encode ('Closed 'Dense) Coin
-> Encode
('Closed 'Dense)
(Coin -> Coin -> Coin -> UnitInterval -> Double -> RewardInfoPool)
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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
p1
Encode
('Closed 'Dense)
(Coin -> Coin -> Coin -> UnitInterval -> Double -> RewardInfoPool)
-> Encode ('Closed 'Dense) Coin
-> Encode
('Closed 'Dense)
(Coin -> Coin -> UnitInterval -> Double -> RewardInfoPool)
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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
p2
Encode
('Closed 'Dense)
(Coin -> Coin -> UnitInterval -> Double -> RewardInfoPool)
-> Encode ('Closed 'Dense) Coin
-> Encode
('Closed 'Dense) (Coin -> UnitInterval -> Double -> RewardInfoPool)
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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
p3
Encode
('Closed 'Dense) (Coin -> UnitInterval -> Double -> RewardInfoPool)
-> Encode ('Closed 'Dense) Coin
-> Encode
('Closed 'Dense) (UnitInterval -> Double -> RewardInfoPool)
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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
p4
Encode ('Closed 'Dense) (UnitInterval -> Double -> RewardInfoPool)
-> Encode ('Closed 'Dense) UnitInterval
-> Encode ('Closed 'Dense) (Double -> RewardInfoPool)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> UnitInterval -> Encode ('Closed 'Dense) UnitInterval
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To UnitInterval
p5
Encode ('Closed 'Dense) (Double -> RewardInfoPool)
-> Encode ('Closed 'Dense) Double
-> Encode ('Closed 'Dense) RewardInfoPool
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (Double -> Encoding) -> Double -> Encode ('Closed 'Dense) Double
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E Double -> Encoding
encodeDouble Double
d6
instance DecCBOR RewardInfoPool where
decCBOR :: forall s. Decoder s RewardInfoPool
decCBOR =
Decode ('Closed 'Dense) RewardInfoPool -> Decoder s RewardInfoPool
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) RewardInfoPool
-> Decoder s RewardInfoPool)
-> Decode ('Closed 'Dense) RewardInfoPool
-> Decoder s RewardInfoPool
forall a b. (a -> b) -> a -> b
$
(Coin
-> Coin
-> Coin
-> Coin
-> UnitInterval
-> Double
-> RewardInfoPool)
-> Decode
('Closed 'Dense)
(Coin
-> Coin
-> Coin
-> Coin
-> UnitInterval
-> Double
-> RewardInfoPool)
forall t. t -> Decode ('Closed 'Dense) t
RecD Coin
-> Coin -> Coin -> Coin -> UnitInterval -> Double -> RewardInfoPool
RewardInfoPool
Decode
('Closed 'Dense)
(Coin
-> Coin
-> Coin
-> Coin
-> UnitInterval
-> Double
-> RewardInfoPool)
-> Decode ('Closed Any) Coin
-> Decode
('Closed 'Dense)
(Coin -> Coin -> Coin -> UnitInterval -> Double -> RewardInfoPool)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Coin
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Decode
('Closed 'Dense)
(Coin -> Coin -> Coin -> UnitInterval -> Double -> RewardInfoPool)
-> Decode ('Closed Any) Coin
-> Decode
('Closed 'Dense)
(Coin -> Coin -> UnitInterval -> Double -> RewardInfoPool)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Coin
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Decode
('Closed 'Dense)
(Coin -> Coin -> UnitInterval -> Double -> RewardInfoPool)
-> Decode ('Closed Any) Coin
-> Decode
('Closed 'Dense) (Coin -> UnitInterval -> Double -> RewardInfoPool)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Coin
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Decode
('Closed 'Dense) (Coin -> UnitInterval -> Double -> RewardInfoPool)
-> Decode ('Closed Any) Coin
-> Decode
('Closed 'Dense) (UnitInterval -> Double -> RewardInfoPool)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Coin
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Decode ('Closed 'Dense) (UnitInterval -> Double -> RewardInfoPool)
-> Decode ('Closed Any) UnitInterval
-> Decode ('Closed 'Dense) (Double -> RewardInfoPool)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) UnitInterval
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Decode ('Closed 'Dense) (Double -> RewardInfoPool)
-> Decode ('Closed 'Dense) Double
-> Decode ('Closed 'Dense) RewardInfoPool
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s. Decoder s Double) -> Decode ('Closed 'Dense) Double
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D Decoder s Double
forall s. Decoder s Double
decodeDouble