{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module Cardano.Ledger.Shelley.LedgerState.IncrementalStake (
updateStakeDistribution,
incrementalStakeDistr,
applyRUpd,
applyRUpdFiltered,
smartUTxOState,
filterAllRewards,
FilteredRewards (..),
)
where
import Cardano.Ledger.Address (Addr (..))
import Cardano.Ledger.BaseTypes (ProtVer)
import Cardano.Ledger.CertState (
CertState (..),
DState (..),
PState (..),
delegations,
rewards,
)
import Cardano.Ledger.Coin (
Coin (..),
CompactForm (CompactCoin),
addDeltaCoin,
)
import Cardano.Ledger.Compactible
import Cardano.Ledger.Core
import Cardano.Ledger.Credential (
Credential (..),
StakeReference (StakeRefBase, StakeRefPtr),
)
import Cardano.Ledger.EpochBoundary (
SnapShot (..),
Stake (..),
)
import Cardano.Ledger.Keys (
KeyRole (..),
)
import Cardano.Ledger.Shelley.Governance (EraGov (GovState))
import qualified Cardano.Ledger.Shelley.HardForks as HardForks
import Cardano.Ledger.Shelley.LedgerState.Types
import Cardano.Ledger.Shelley.RewardUpdate (RewardUpdate (..))
import Cardano.Ledger.Shelley.Rewards (
aggregateCompactRewards,
aggregateRewards,
filterRewards,
)
import Cardano.Ledger.UMap (
UMElem,
UMap (..),
member,
)
import qualified Cardano.Ledger.UMap as UM
import Cardano.Ledger.UTxO (
UTxO (..),
)
import Control.DeepSeq (NFData (rnf), deepseq)
import Control.Exception (assert)
import Data.Coerce (coerce)
import Data.Foldable (fold)
import Data.Map.Internal.Debug as Map (valid)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Set (Set)
import qualified Data.VMap as VMap
import Data.Word
import Lens.Micro
updateStakeDistribution ::
EraTxOut era =>
PParams era ->
IncrementalStake (EraCrypto era) ->
UTxO era ->
UTxO era ->
IncrementalStake (EraCrypto era)
updateStakeDistribution :: forall era.
EraTxOut era =>
PParams era
-> IncrementalStake (EraCrypto era)
-> UTxO era
-> UTxO era
-> IncrementalStake (EraCrypto era)
updateStakeDistribution PParams era
pp IncrementalStake (EraCrypto era)
incStake0 UTxO era
utxoDel UTxO era
utxoAdd = IncrementalStake (EraCrypto era)
incStake2
where
incStake1 :: IncrementalStake (EraCrypto era)
incStake1 = forall era.
EraTxOut era =>
PParams era
-> (CompactForm Coin -> CompactForm Coin -> CompactForm Coin)
-> UTxO era
-> IncrementalStake (EraCrypto era)
-> IncrementalStake (EraCrypto era)
incAggUtxoCoinByCred PParams era
pp (coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Num a => a -> a -> a
(+) @Word64)) UTxO era
utxoAdd IncrementalStake (EraCrypto era)
incStake0
incStake2 :: IncrementalStake (EraCrypto era)
incStake2 = forall era.
EraTxOut era =>
PParams era
-> (CompactForm Coin -> CompactForm Coin -> CompactForm Coin)
-> UTxO era
-> IncrementalStake (EraCrypto era)
-> IncrementalStake (EraCrypto era)
incAggUtxoCoinByCred PParams era
pp (coerce :: forall a b. Coercible a b => a -> b
coerce ((-) @Word64)) UTxO era
utxoDel IncrementalStake (EraCrypto era)
incStake1
incAggUtxoCoinByCred ::
forall era.
EraTxOut era =>
PParams era ->
(CompactForm Coin -> CompactForm Coin -> CompactForm Coin) ->
UTxO era ->
IncrementalStake (EraCrypto era) ->
IncrementalStake (EraCrypto era)
incAggUtxoCoinByCred :: forall era.
EraTxOut era =>
PParams era
-> (CompactForm Coin -> CompactForm Coin -> CompactForm Coin)
-> UTxO era
-> IncrementalStake (EraCrypto era)
-> IncrementalStake (EraCrypto era)
incAggUtxoCoinByCred PParams era
pp CompactForm Coin -> CompactForm Coin -> CompactForm Coin
f (UTxO Map (TxIn (EraCrypto era)) (TxOut era)
u) IncrementalStake (EraCrypto era)
initial =
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' IncrementalStake (EraCrypto era)
-> TxOut era -> IncrementalStake (EraCrypto era)
accum IncrementalStake (EraCrypto era)
initial Map (TxIn (EraCrypto era)) (TxOut era)
u
where
keepOrDeleteCompact :: CompactForm Coin
-> Maybe (CompactForm Coin) -> Maybe (CompactForm Coin)
keepOrDeleteCompact CompactForm Coin
new = \case
Maybe (CompactForm Coin)
Nothing ->
case CompactForm Coin
new of
CompactCoin Word64
0 -> forall a. Maybe a
Nothing
CompactForm Coin
final -> forall a. a -> Maybe a
Just CompactForm Coin
final
Just CompactForm Coin
old ->
case CompactForm Coin
old CompactForm Coin -> CompactForm Coin -> CompactForm Coin
`f` CompactForm Coin
new of
CompactCoin Word64
0 -> forall a. Maybe a
Nothing
CompactForm Coin
final -> forall a. a -> Maybe a
Just CompactForm Coin
final
ignorePtrs :: Bool
ignorePtrs = ProtVer -> Bool
HardForks.forgoPointerAddressResolution (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) ProtVer
ppProtocolVersionL)
accum :: IncrementalStake (EraCrypto era)
-> TxOut era -> IncrementalStake (EraCrypto era)
accum ans :: IncrementalStake (EraCrypto era)
ans@(IStake Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
stake Map Ptr (CompactForm Coin)
ptrs) TxOut era
out =
let cc :: CompactForm Coin
cc = TxOut era
out forall s a. s -> Getting a s a -> a
^. forall era.
(HasCallStack, EraTxOut era) =>
Lens' (TxOut era) (CompactForm Coin)
compactCoinTxOutL
in case TxOut era
out forall s a. s -> Getting a s a -> a
^. forall era.
EraTxOut era =>
Lens' (TxOut era) (Addr (EraCrypto era))
addrTxOutL of
Addr Network
_ PaymentCredential (EraCrypto era)
_ (StakeRefPtr Ptr
p)
| Bool -> Bool
not Bool
ignorePtrs ->
forall c.
Map (Credential 'Staking c) (CompactForm Coin)
-> Map Ptr (CompactForm Coin) -> IncrementalStake c
IStake Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
stake (forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (CompactForm Coin
-> Maybe (CompactForm Coin) -> Maybe (CompactForm Coin)
keepOrDeleteCompact CompactForm Coin
cc) Ptr
p Map Ptr (CompactForm Coin)
ptrs)
Addr Network
_ PaymentCredential (EraCrypto era)
_ (StakeRefBase Credential 'Staking (EraCrypto era)
hk) ->
forall c.
Map (Credential 'Staking c) (CompactForm Coin)
-> Map Ptr (CompactForm Coin) -> IncrementalStake c
IStake (forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (CompactForm Coin
-> Maybe (CompactForm Coin) -> Maybe (CompactForm Coin)
keepOrDeleteCompact CompactForm Coin
cc) Credential 'Staking (EraCrypto era)
hk Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
stake) Map Ptr (CompactForm Coin)
ptrs
Addr (EraCrypto era)
_other -> IncrementalStake (EraCrypto era)
ans
smartUTxOState ::
EraTxOut era =>
PParams era ->
UTxO era ->
Coin ->
Coin ->
GovState era ->
Coin ->
UTxOState era
smartUTxOState :: forall era.
EraTxOut era =>
PParams era
-> UTxO era
-> Coin
-> Coin
-> GovState era
-> Coin
-> UTxOState era
smartUTxOState PParams era
pp UTxO era
utxo Coin
c1 Coin
c2 GovState era
st =
forall era.
UTxO era
-> Coin
-> Coin
-> GovState era
-> IncrementalStake (EraCrypto era)
-> Coin
-> UTxOState era
UTxOState
UTxO era
utxo
Coin
c1
Coin
c2
GovState era
st
(forall era.
EraTxOut era =>
PParams era
-> IncrementalStake (EraCrypto era)
-> UTxO era
-> UTxO era
-> IncrementalStake (EraCrypto era)
updateStakeDistribution PParams era
pp forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty UTxO era
utxo)
incrementalStakeDistr ::
forall era.
EraPParams era =>
PParams era ->
IncrementalStake (EraCrypto era) ->
DState era ->
PState era ->
SnapShot (EraCrypto era)
incrementalStakeDistr :: forall era.
EraPParams era =>
PParams era
-> IncrementalStake (EraCrypto era)
-> DState era
-> PState era
-> SnapShot (EraCrypto era)
incrementalStakeDistr PParams era
pp (IStake Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
credStake Map Ptr (CompactForm Coin)
ptrStake) DState era
ds PState era
ps =
forall c.
Stake c
-> VMap VB VB (Credential 'Staking c) (KeyHash 'StakePool c)
-> VMap VB VB (KeyHash 'StakePool c) (PoolParams c)
-> SnapShot c
SnapShot
(forall c.
VMap VB VP (Credential 'Staking c) (CompactForm Coin) -> Stake c
Stake forall a b. (a -> b) -> a -> b
$ forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
Map k v -> VMap kv vv k v
VMap.fromMap Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
step2)
VMap
VB
VB
(Credential 'Staking (EraCrypto era))
(KeyHash 'StakePool (EraCrypto era))
delegs_
(forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
Map k v -> VMap kv vv k v
VMap.fromMap Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
poolParams)
where
UMap Map (Credential 'Staking (EraCrypto era)) (UMElem (EraCrypto era))
triplesMap Map Ptr (Credential 'Staking (EraCrypto era))
ptrsMap = forall era. DState era -> UMap (EraCrypto era)
dsUnified DState era
ds
PState {psStakePoolParams :: forall era.
PState era
-> Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
psStakePoolParams = Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
poolParams} = PState era
ps
delegs_ :: VMap
VB
VB
(Credential 'Staking (EraCrypto era))
(KeyHash 'StakePool (EraCrypto era))
delegs_ = forall c k v. UView c k v -> VMap VB VB k v
UM.unUnifyToVMap (forall era.
DState era
-> UView
(EraCrypto era)
(Credential 'Staking (EraCrypto era))
(KeyHash 'StakePool (EraCrypto era))
delegations DState era
ds)
activeCreds :: Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
activeCreds = forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\Credential 'Staking (EraCrypto era)
k CompactForm Coin
_ -> forall k (kv :: * -> *) (vv :: * -> *) v.
(Ord k, Vector kv k) =>
k -> VMap kv vv k v -> Bool
VMap.member Credential 'Staking (EraCrypto era)
k VMap
VB
VB
(Credential 'Staking (EraCrypto era))
(KeyHash 'StakePool (EraCrypto era))
delegs_) Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
credStake
ignorePtrs :: Bool
ignorePtrs = ProtVer -> Bool
HardForks.forgoPointerAddressResolution (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) ProtVer
ppProtocolVersionL)
step1 :: Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
step1 =
if Bool
ignorePtrs
then Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
activeCreds
else
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
-> Ptr
-> CompactForm Coin
-> Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
addResolvedPointer Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
activeCreds Map Ptr (CompactForm Coin)
ptrStake
step2 :: Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
step2 = forall k c.
Ord k =>
Map k (UMElem c)
-> Map k (CompactForm Coin) -> Map k (CompactForm Coin)
aggregateActiveStake Map (Credential 'Staking (EraCrypto era)) (UMElem (EraCrypto era))
triplesMap Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
step1
addResolvedPointer :: Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
-> Ptr
-> CompactForm Coin
-> Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
addResolvedPointer Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
ans Ptr
ptr CompactForm Coin
ccoin =
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ptr
ptr Map Ptr (Credential 'Staking (EraCrypto era))
ptrsMap of
Just Credential 'Staking (EraCrypto era)
cred | forall k (kv :: * -> *) (vv :: * -> *) v.
(Ord k, Vector kv k) =>
k -> VMap kv vv k v -> Bool
VMap.member Credential 'Staking (EraCrypto era)
cred VMap
VB
VB
(Credential 'Staking (EraCrypto era))
(KeyHash 'StakePool (EraCrypto era))
delegs_ -> forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith forall a. Semigroup a => a -> a -> a
(<>) Credential 'Staking (EraCrypto era)
cred CompactForm Coin
ccoin Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
ans
Maybe (Credential 'Staking (EraCrypto era))
_ -> Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
ans
aggregateActiveStake ::
Ord k => Map k (UMElem c) -> Map k (CompactForm Coin) -> Map k (CompactForm Coin)
aggregateActiveStake :: forall k c.
Ord k =>
Map k (UMElem c)
-> Map k (CompactForm Coin) -> Map k (CompactForm Coin)
aggregateActiveStake Map k (UMElem c)
m1 Map k (CompactForm Coin)
m2 = forall a. HasCallStack => Bool -> a -> a
assert (forall k a. Ord k => Map k a -> Bool
Map.valid Map k (CompactForm Coin)
m) Map k (CompactForm Coin)
m
where
m :: Map k (CompactForm Coin)
m =
forall k a b c.
Ord k =>
(k -> a -> b -> Maybe c)
-> (Map k a -> Map k c)
-> (Map k b -> Map k c)
-> Map k a
-> Map k b
-> Map k c
Map.mergeWithKey
(\k
_k UMElem c
trip CompactForm Coin
coin2 -> CompactForm Coin -> RDPair -> CompactForm Coin
extractAndAdd CompactForm Coin
coin2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c. UMElem c -> Maybe RDPair
UM.umElemRDActive UMElem c
trip)
(forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe (\UMElem c
trip -> RDPair -> CompactForm Coin
UM.rdReward forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c. UMElem c -> Maybe RDPair
UM.umElemRDActive UMElem c
trip))
forall a. a -> a
id
Map k (UMElem c)
m1
Map k (CompactForm Coin)
m2
extractAndAdd :: CompactForm Coin -> UM.RDPair -> CompactForm Coin
extractAndAdd :: CompactForm Coin -> RDPair -> CompactForm Coin
extractAndAdd CompactForm Coin
coin (UM.RDPair CompactForm Coin
rew CompactForm Coin
_dep) = CompactForm Coin
coin forall a. Semigroup a => a -> a -> a
<> CompactForm Coin
rew
applyRUpd ::
EraGov era =>
RewardUpdate (EraCrypto era) ->
EpochState era ->
EpochState era
applyRUpd :: forall era.
EraGov era =>
RewardUpdate (EraCrypto era) -> EpochState era -> EpochState era
applyRUpd RewardUpdate (EraCrypto era)
ru EpochState era
es =
let (!EpochState era
es', FilteredRewards era
_) = forall era.
EraGov era =>
RewardUpdate (EraCrypto era)
-> EpochState era -> (EpochState era, FilteredRewards era)
applyRUpdFiltered RewardUpdate (EraCrypto era)
ru EpochState era
es
in EpochState era
es'
applyRUpdFiltered ::
EraGov era =>
RewardUpdate (EraCrypto era) ->
EpochState era ->
(EpochState era, FilteredRewards era)
applyRUpdFiltered :: forall era.
EraGov era =>
RewardUpdate (EraCrypto era)
-> EpochState era -> (EpochState era, FilteredRewards era)
applyRUpdFiltered
RewardUpdate (EraCrypto era)
ru
es :: EpochState era
es@(EpochState AccountState
as LedgerState era
ls SnapShots (EraCrypto era)
ss NonMyopic (EraCrypto era)
_nm) = (EpochState era
epochStateAns, FilteredRewards era
filteredRewards)
where
!epochStateAns :: EpochState era
epochStateAns =
forall era.
AccountState
-> LedgerState era
-> SnapShots (EraCrypto era)
-> NonMyopic (EraCrypto era)
-> EpochState era
EpochState AccountState
as' LedgerState era
ls' SnapShots (EraCrypto era)
ss NonMyopic (EraCrypto era)
nm'
forall a b. a -> (a -> b) -> b
& forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall s t a b. ASetter s t a b -> b -> s -> t
.~ EpochState era
es forall s a. s -> Getting a s a -> a
^. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL
forall a b. a -> (a -> b) -> b
& forall era. EraGov era => Lens' (EpochState era) (PParams era)
prevPParamsEpochStateL forall s t a b. ASetter s t a b -> b -> s -> t
.~ EpochState era
es forall s a. s -> Getting a s a -> a
^. forall era. EraGov era => Lens' (EpochState era) (PParams era)
prevPParamsEpochStateL
utxoState_ :: UTxOState era
utxoState_ = forall era. LedgerState era -> UTxOState era
lsUTxOState LedgerState era
ls
dpState :: CertState era
dpState = forall era. LedgerState era -> CertState era
lsCertState LedgerState era
ls
dState :: DState era
dState = forall era. CertState era -> DState era
certDState CertState era
dpState
prevPParams :: PParams era
prevPParams = EpochState era
es forall s a. s -> Getting a s a -> a
^. forall era. EraGov era => Lens' (EpochState era) (PParams era)
prevPParamsEpochStateL
prevProVer :: ProtVer
prevProVer = PParams era
prevPParams forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) ProtVer
ppProtocolVersionL
filteredRewards :: FilteredRewards era
filteredRewards@FilteredRewards
{ Map
(Credential 'Staking (EraCrypto era))
(Set (Reward (EraCrypto era)))
frRegistered :: forall era.
FilteredRewards era
-> Map
(Credential 'Staking (EraCrypto era))
(Set (Reward (EraCrypto era)))
frRegistered :: Map
(Credential 'Staking (EraCrypto era))
(Set (Reward (EraCrypto era)))
frRegistered
, Coin
frTotalUnregistered :: forall era. FilteredRewards era -> Coin
frTotalUnregistered :: Coin
frTotalUnregistered
} = forall era.
Map
(Credential 'Staking (EraCrypto era))
(Set (Reward (EraCrypto era)))
-> ProtVer -> DState era -> FilteredRewards era
filterAllRewards' (forall c.
RewardUpdate c -> Map (Credential 'Staking c) (Set (Reward c))
rs RewardUpdate (EraCrypto era)
ru) ProtVer
prevProVer DState era
dState
registeredAggregated :: Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
registeredAggregated = forall c.
ProtVer
-> Map (Credential 'Staking c) (Set (Reward c))
-> Map (Credential 'Staking c) (CompactForm Coin)
aggregateCompactRewards ProtVer
prevProVer Map
(Credential 'Staking (EraCrypto era))
(Set (Reward (EraCrypto era)))
frRegistered
as' :: AccountState
as' =
AccountState
as
{ asTreasury :: Coin
asTreasury = Coin -> DeltaCoin -> Coin
addDeltaCoin (AccountState -> Coin
asTreasury AccountState
as) (forall c. RewardUpdate c -> DeltaCoin
deltaT RewardUpdate (EraCrypto era)
ru) forall a. Semigroup a => a -> a -> a
<> Coin
frTotalUnregistered
, asReserves :: Coin
asReserves = Coin -> DeltaCoin -> Coin
addDeltaCoin (AccountState -> Coin
asReserves AccountState
as) (forall c. RewardUpdate c -> DeltaCoin
deltaR RewardUpdate (EraCrypto era)
ru)
}
ls' :: LedgerState era
ls' =
LedgerState era
ls
{ lsUTxOState :: UTxOState era
lsUTxOState =
UTxOState era
utxoState_ {utxosFees :: Coin
utxosFees = forall era. UTxOState era -> Coin
utxosFees UTxOState era
utxoState_ Coin -> DeltaCoin -> Coin
`addDeltaCoin` forall c. RewardUpdate c -> DeltaCoin
deltaF RewardUpdate (EraCrypto era)
ru}
, lsCertState :: CertState era
lsCertState =
CertState era
dpState
{ certDState :: DState era
certDState =
DState era
dState
{ dsUnified :: UMap (EraCrypto era)
dsUnified = forall era.
DState era
-> UView
(EraCrypto era) (Credential 'Staking (EraCrypto era)) RDPair
rewards DState era
dState forall c.
UView c (Credential 'Staking c) RDPair
-> Map (Credential 'Staking c) (CompactForm Coin) -> UMap c
UM.∪+ Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
registeredAggregated
}
}
}
nm' :: NonMyopic (EraCrypto era)
nm' = forall c. RewardUpdate c -> NonMyopic c
nonMyopic RewardUpdate (EraCrypto era)
ru
data FilteredRewards era = FilteredRewards
{
forall era.
FilteredRewards era
-> Map
(Credential 'Staking (EraCrypto era))
(Set (Reward (EraCrypto era)))
frRegistered :: !(Map (Credential 'Staking (EraCrypto era)) (Set (Reward (EraCrypto era))))
, forall era.
FilteredRewards era
-> Map
(Credential 'Staking (EraCrypto era))
(Set (Reward (EraCrypto era)))
frShelleyIgnored :: Map (Credential 'Staking (EraCrypto era)) (Set (Reward (EraCrypto era)))
, forall era.
FilteredRewards era -> Set (Credential 'Staking (EraCrypto era))
frUnregistered :: Set (Credential 'Staking (EraCrypto era))
, forall era. FilteredRewards era -> Coin
frTotalUnregistered :: Coin
}
instance NFData (FilteredRewards era) where
rnf :: FilteredRewards era -> ()
rnf (FilteredRewards Map
(Credential 'Staking (EraCrypto era))
(Set (Reward (EraCrypto era)))
a Map
(Credential 'Staking (EraCrypto era))
(Set (Reward (EraCrypto era)))
b Set (Credential 'Staking (EraCrypto era))
c Coin
d) = Map
(Credential 'Staking (EraCrypto era))
(Set (Reward (EraCrypto era)))
a forall a b. NFData a => a -> b -> b
`deepseq` Map
(Credential 'Staking (EraCrypto era))
(Set (Reward (EraCrypto era)))
b forall a b. NFData a => a -> b -> b
`deepseq` Set (Credential 'Staking (EraCrypto era))
c forall a b. NFData a => a -> b -> b
`deepseq` forall a. NFData a => a -> ()
rnf Coin
d
filterAllRewards' ::
Map (Credential 'Staking (EraCrypto era)) (Set (Reward (EraCrypto era))) ->
ProtVer ->
DState era ->
FilteredRewards era
filterAllRewards' :: forall era.
Map
(Credential 'Staking (EraCrypto era))
(Set (Reward (EraCrypto era)))
-> ProtVer -> DState era -> FilteredRewards era
filterAllRewards' Map
(Credential 'Staking (EraCrypto era))
(Set (Reward (EraCrypto era)))
rs ProtVer
protVer DState era
dState =
forall era.
Map
(Credential 'Staking (EraCrypto era))
(Set (Reward (EraCrypto era)))
-> Map
(Credential 'Staking (EraCrypto era))
(Set (Reward (EraCrypto era)))
-> Set (Credential 'Staking (EraCrypto era))
-> Coin
-> FilteredRewards era
FilteredRewards Map
(Credential 'Staking (EraCrypto era))
(Set (Reward (EraCrypto era)))
registered Map
(Credential 'Staking (EraCrypto era))
(Set (Reward (EraCrypto era)))
shelleyIgnored Set (Credential 'Staking (EraCrypto era))
unregistered Coin
totalUnregistered
where
(Map
(Credential 'Staking (EraCrypto era))
(Set (Reward (EraCrypto era)))
regRU, Map
(Credential 'Staking (EraCrypto era))
(Set (Reward (EraCrypto era)))
unregRU) = forall k a. (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
Map.partitionWithKey (\Credential 'Staking (EraCrypto era)
k Set (Reward (EraCrypto era))
_ -> forall k c v. k -> UView c k v -> Bool
member Credential 'Staking (EraCrypto era)
k (forall era.
DState era
-> UView
(EraCrypto era) (Credential 'Staking (EraCrypto era)) RDPair
rewards DState era
dState)) Map
(Credential 'Staking (EraCrypto era))
(Set (Reward (EraCrypto era)))
rs
totalUnregistered :: Coin
totalUnregistered = forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall a b. (a -> b) -> a -> b
$ forall c.
ProtVer
-> Map (Credential 'Staking c) (Set (Reward c))
-> Map (Credential 'Staking c) Coin
aggregateRewards ProtVer
protVer Map
(Credential 'Staking (EraCrypto era))
(Set (Reward (EraCrypto era)))
unregRU
unregistered :: Set (Credential 'Staking (EraCrypto era))
unregistered = forall k a. Map k a -> Set k
Map.keysSet Map
(Credential 'Staking (EraCrypto era))
(Set (Reward (EraCrypto era)))
unregRU
(Map
(Credential 'Staking (EraCrypto era))
(Set (Reward (EraCrypto era)))
registered, Map
(Credential 'Staking (EraCrypto era))
(Set (Reward (EraCrypto era)))
shelleyIgnored) = forall c.
ProtVer
-> Map (Credential 'Staking c) (Set (Reward c))
-> (Map (Credential 'Staking c) (Set (Reward c)),
Map (Credential 'Staking c) (Set (Reward c)))
filterRewards ProtVer
protVer Map
(Credential 'Staking (EraCrypto era))
(Set (Reward (EraCrypto era)))
regRU
filterAllRewards ::
EraGov era =>
Map (Credential 'Staking (EraCrypto era)) (Set (Reward (EraCrypto era))) ->
EpochState era ->
FilteredRewards era
filterAllRewards :: forall era.
EraGov era =>
Map
(Credential 'Staking (EraCrypto era))
(Set (Reward (EraCrypto era)))
-> EpochState era -> FilteredRewards era
filterAllRewards Map
(Credential 'Staking (EraCrypto era))
(Set (Reward (EraCrypto era)))
mp EpochState era
epochstate = forall era.
Map
(Credential 'Staking (EraCrypto era))
(Set (Reward (EraCrypto era)))
-> ProtVer -> DState era -> FilteredRewards era
filterAllRewards' Map
(Credential 'Staking (EraCrypto era))
(Set (Reward (EraCrypto era)))
mp ProtVer
prevPP DState era
dState
where
prevPP :: ProtVer
prevPP = EpochState era
epochstate forall s a. s -> Getting a s a -> a
^. forall era. EraGov era => Lens' (EpochState era) (PParams era)
prevPParamsEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => Lens' (PParams era) ProtVer
ppProtocolVersionL
dState :: DState era
dState = (forall era. CertState era -> DState era
certDState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. LedgerState era -> CertState era
lsCertState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EpochState era -> LedgerState era
esLState) EpochState era
epochstate