{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-}
module Cardano.Ledger.Shelley.RewardUpdate (
RewardEvent,
RewardAns (..),
Pulser,
RewardUpdate (..),
emptyRewardUpdate,
RewardSnapShot (..),
FreeVars (..),
rewardStakePoolMember,
RewardPulser (..),
clearRecent,
PulsingRewUpdate (..),
) where
import Cardano.Ledger.BaseTypes (ProtVer (..), ShelleyBase)
import Cardano.Ledger.Binary (
DecCBOR (..),
EncCBOR (..),
decNoShareCBOR,
decodeRecordNamed,
encodeListLen,
)
import Cardano.Ledger.Binary.Coders (
Decode (..),
Encode (..),
decode,
encode,
(!>),
(<!),
)
import Cardano.Ledger.Coin (Coin (..), CompactForm, DeltaCoin (..))
import Cardano.Ledger.Compactible (Compactible (fromCompact))
import Cardano.Ledger.Core (Reward (..), RewardType (MemberReward))
import Cardano.Ledger.Credential (Credential (..))
import Cardano.Ledger.Keys (KeyHash, KeyRole (..))
import Cardano.Ledger.Shelley.PoolRank (Likelihood, NonMyopic)
import Cardano.Ledger.Shelley.Rewards (
PoolRewardInfo (..),
rewardOnePoolMember,
)
import Control.DeepSeq (NFData (..))
import Data.Aeson (KeyValue, ToJSON (..), Value (Null), object, pairs, (.=))
import Data.Default (def)
import Data.Group (invert)
import Data.Kind (Type)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe)
import Data.Pulse (Pulsable (..), completeM)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.VMap as VMap
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks (..), allNoThunks)
type RewardEvent = Map (Credential 'Staking) (Set Reward)
data RewardAns = RewardAns
{ RewardAns -> Map (Credential 'Staking) Reward
accumRewardAns :: !(Map (Credential 'Staking) Reward)
, RewardAns -> RewardEvent
recentRewardAns :: !RewardEvent
}
deriving (Int -> RewardAns -> ShowS
[RewardAns] -> ShowS
RewardAns -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RewardAns] -> ShowS
$cshowList :: [RewardAns] -> ShowS
show :: RewardAns -> String
$cshow :: RewardAns -> String
showsPrec :: Int -> RewardAns -> ShowS
$cshowsPrec :: Int -> RewardAns -> ShowS
Show, RewardAns -> RewardAns -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RewardAns -> RewardAns -> Bool
$c/= :: RewardAns -> RewardAns -> Bool
== :: RewardAns -> RewardAns -> Bool
$c== :: RewardAns -> RewardAns -> Bool
Eq, forall x. Rep RewardAns x -> RewardAns
forall x. RewardAns -> Rep RewardAns x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RewardAns x -> RewardAns
$cfrom :: forall x. RewardAns -> Rep RewardAns x
Generic)
deriving (RewardAns -> ()
forall a. (a -> ()) -> NFData a
rnf :: RewardAns -> ()
$crnf :: RewardAns -> ()
NFData)
instance NoThunks RewardAns
instance EncCBOR RewardAns where
encCBOR :: RewardAns -> Encoding
encCBOR (RewardAns Map (Credential 'Staking) Reward
accum RewardEvent
recent) = Word -> Encoding
encodeListLen Word
2 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Map (Credential 'Staking) Reward
accum forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR RewardEvent
recent
instance DecCBOR RewardAns where
decCBOR :: forall s. Decoder s RewardAns
decCBOR = forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"RewardAns" (forall a b. a -> b -> a
const Int
2) (Map (Credential 'Staking) Reward -> RewardEvent -> RewardAns
RewardAns forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR)
type Pulser = RewardPulser ShelleyBase RewardAns
data RewardUpdate = RewardUpdate
{ RewardUpdate -> DeltaCoin
deltaT :: !DeltaCoin
, RewardUpdate -> DeltaCoin
deltaR :: !DeltaCoin
, RewardUpdate -> RewardEvent
rs :: !(Map (Credential 'Staking) (Set Reward))
, RewardUpdate -> DeltaCoin
deltaF :: !DeltaCoin
, RewardUpdate -> NonMyopic
nonMyopic :: !NonMyopic
}
deriving (Int -> RewardUpdate -> ShowS
[RewardUpdate] -> ShowS
RewardUpdate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RewardUpdate] -> ShowS
$cshowList :: [RewardUpdate] -> ShowS
show :: RewardUpdate -> String
$cshow :: RewardUpdate -> String
showsPrec :: Int -> RewardUpdate -> ShowS
$cshowsPrec :: Int -> RewardUpdate -> ShowS
Show, RewardUpdate -> RewardUpdate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RewardUpdate -> RewardUpdate -> Bool
$c/= :: RewardUpdate -> RewardUpdate -> Bool
== :: RewardUpdate -> RewardUpdate -> Bool
$c== :: RewardUpdate -> RewardUpdate -> Bool
Eq, forall x. Rep RewardUpdate x -> RewardUpdate
forall x. RewardUpdate -> Rep RewardUpdate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RewardUpdate x -> RewardUpdate
$cfrom :: forall x. RewardUpdate -> Rep RewardUpdate x
Generic)
instance NoThunks RewardUpdate
instance NFData RewardUpdate
instance EncCBOR RewardUpdate where
encCBOR :: RewardUpdate -> Encoding
encCBOR (RewardUpdate DeltaCoin
dt DeltaCoin
dr RewardEvent
rw DeltaCoin
df NonMyopic
nm) =
Word -> Encoding
encodeListLen Word
5
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR DeltaCoin
dt
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall m. Group m => m -> m
invert DeltaCoin
dr)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR RewardEvent
rw
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall m. Group m => m -> m
invert DeltaCoin
df)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR NonMyopic
nm
instance DecCBOR RewardUpdate where
decCBOR :: forall s. Decoder s RewardUpdate
decCBOR = do
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"RewardUpdate" (forall a b. a -> b -> a
const Int
5) forall a b. (a -> b) -> a -> b
$ do
DeltaCoin
dt <- forall a s. DecCBOR a => Decoder s a
decCBOR
DeltaCoin
dr <- forall a s. DecCBOR a => Decoder s a
decCBOR
RewardEvent
rw <- forall a s. DecCBOR a => Decoder s a
decCBOR
DeltaCoin
df <- forall a s. DecCBOR a => Decoder s a
decCBOR
NonMyopic
nm <- forall a s. DecShareCBOR a => Decoder s a
decNoShareCBOR
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ DeltaCoin
-> DeltaCoin
-> RewardEvent
-> DeltaCoin
-> NonMyopic
-> RewardUpdate
RewardUpdate DeltaCoin
dt (forall m. Group m => m -> m
invert DeltaCoin
dr) RewardEvent
rw (forall m. Group m => m -> m
invert DeltaCoin
df) NonMyopic
nm
instance ToJSON RewardUpdate where
toJSON :: RewardUpdate -> Value
toJSON = [Pair] -> Value
object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. KeyValue e a => RewardUpdate -> [a]
toRewardUpdatePair
toEncoding :: RewardUpdate -> Encoding
toEncoding = Series -> Encoding
pairs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. KeyValue e a => RewardUpdate -> [a]
toRewardUpdatePair
toRewardUpdatePair :: KeyValue e a => RewardUpdate -> [a]
toRewardUpdatePair :: forall e a. KeyValue e a => RewardUpdate -> [a]
toRewardUpdatePair ru :: RewardUpdate
ru@(RewardUpdate DeltaCoin
_ DeltaCoin
_ RewardEvent
_ DeltaCoin
_ NonMyopic
_) =
let RewardUpdate {RewardEvent
DeltaCoin
NonMyopic
nonMyopic :: NonMyopic
deltaF :: DeltaCoin
rs :: RewardEvent
deltaR :: DeltaCoin
deltaT :: DeltaCoin
nonMyopic :: RewardUpdate -> NonMyopic
deltaF :: RewardUpdate -> DeltaCoin
rs :: RewardUpdate -> RewardEvent
deltaR :: RewardUpdate -> DeltaCoin
deltaT :: RewardUpdate -> DeltaCoin
..} = RewardUpdate
ru
in [ Key
"deltaT" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DeltaCoin
deltaT
, Key
"deltaR" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DeltaCoin
deltaR
, Key
"rs" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= RewardEvent
rs
, Key
"deltaF" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DeltaCoin
deltaF
, Key
"nonMyopic" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NonMyopic
nonMyopic
]
emptyRewardUpdate :: RewardUpdate
emptyRewardUpdate :: RewardUpdate
emptyRewardUpdate =
DeltaCoin
-> DeltaCoin
-> RewardEvent
-> DeltaCoin
-> NonMyopic
-> RewardUpdate
RewardUpdate (Integer -> DeltaCoin
DeltaCoin Integer
0) (Integer -> DeltaCoin
DeltaCoin Integer
0) forall k a. Map k a
Map.empty (Integer -> DeltaCoin
DeltaCoin Integer
0) forall a. Default a => a
def
data RewardSnapShot = RewardSnapShot
{ RewardSnapShot -> Coin
rewFees :: !Coin
, RewardSnapShot -> ProtVer
rewProtocolVersion :: !ProtVer
, RewardSnapShot -> NonMyopic
rewNonMyopic :: !NonMyopic
, RewardSnapShot -> Coin
rewDeltaR1 :: !Coin
, RewardSnapShot -> Coin
rewR :: !Coin
, RewardSnapShot -> Coin
rewDeltaT1 :: !Coin
, RewardSnapShot -> Map (KeyHash 'StakePool) Likelihood
rewLikelihoods :: !(Map (KeyHash 'StakePool) Likelihood)
, RewardSnapShot -> RewardEvent
rewLeaders :: !(Map (Credential 'Staking) (Set Reward))
}
deriving (Int -> RewardSnapShot -> ShowS
[RewardSnapShot] -> ShowS
RewardSnapShot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RewardSnapShot] -> ShowS
$cshowList :: [RewardSnapShot] -> ShowS
show :: RewardSnapShot -> String
$cshow :: RewardSnapShot -> String
showsPrec :: Int -> RewardSnapShot -> ShowS
$cshowsPrec :: Int -> RewardSnapShot -> ShowS
Show, RewardSnapShot -> RewardSnapShot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RewardSnapShot -> RewardSnapShot -> Bool
$c/= :: RewardSnapShot -> RewardSnapShot -> Bool
== :: RewardSnapShot -> RewardSnapShot -> Bool
$c== :: RewardSnapShot -> RewardSnapShot -> Bool
Eq, forall x. Rep RewardSnapShot x -> RewardSnapShot
forall x. RewardSnapShot -> Rep RewardSnapShot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RewardSnapShot x -> RewardSnapShot
$cfrom :: forall x. RewardSnapShot -> Rep RewardSnapShot x
Generic)
instance NoThunks RewardSnapShot
instance NFData RewardSnapShot
instance EncCBOR RewardSnapShot where
encCBOR :: RewardSnapShot -> Encoding
encCBOR (RewardSnapShot Coin
fees ProtVer
ver NonMyopic
nm Coin
dr1 Coin
r Coin
dt1 Map (KeyHash 'StakePool) Likelihood
lhs RewardEvent
lrs) =
forall (w :: Wrapped) t. Encode w t -> Encoding
encode
( forall t. t -> Encode ('Closed 'Dense) t
Rec Coin
-> ProtVer
-> NonMyopic
-> Coin
-> Coin
-> Coin
-> Map (KeyHash 'StakePool) Likelihood
-> RewardEvent
-> RewardSnapShot
RewardSnapShot
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
fees
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To ProtVer
ver
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To NonMyopic
nm
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
dr1
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
r
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
dt1
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Map (KeyHash 'StakePool) Likelihood
lhs
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To RewardEvent
lrs
)
instance DecCBOR RewardSnapShot where
decCBOR :: forall s. Decoder s RewardSnapShot
decCBOR =
forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode
( forall t. t -> Decode ('Closed 'Dense) t
RecD Coin
-> ProtVer
-> NonMyopic
-> Coin
-> Coin
-> Coin
-> Map (KeyHash 'StakePool) Likelihood
-> RewardEvent
-> RewardSnapShot
RewardSnapShot
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D forall a s. DecShareCBOR a => Decoder s a
decNoShareCBOR
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
)
data FreeVars = FreeVars
{ FreeVars -> VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
fvDelegs :: !(VMap VB VB (Credential 'Staking) (KeyHash 'StakePool))
, FreeVars -> Set (Credential 'Staking)
fvAddrsRew :: !(Set (Credential 'Staking))
, FreeVars -> Coin
fvTotalStake :: !Coin
, FreeVars -> ProtVer
fvProtVer :: !ProtVer
, FreeVars -> Map (KeyHash 'StakePool) PoolRewardInfo
fvPoolRewardInfo :: !(Map (KeyHash 'StakePool) PoolRewardInfo)
}
deriving (FreeVars -> FreeVars -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FreeVars -> FreeVars -> Bool
$c/= :: FreeVars -> FreeVars -> Bool
== :: FreeVars -> FreeVars -> Bool
$c== :: FreeVars -> FreeVars -> Bool
Eq, Int -> FreeVars -> ShowS
[FreeVars] -> ShowS
FreeVars -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FreeVars] -> ShowS
$cshowList :: [FreeVars] -> ShowS
show :: FreeVars -> String
$cshow :: FreeVars -> String
showsPrec :: Int -> FreeVars -> ShowS
$cshowsPrec :: Int -> FreeVars -> ShowS
Show, forall x. Rep FreeVars x -> FreeVars
forall x. FreeVars -> Rep FreeVars x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FreeVars x -> FreeVars
$cfrom :: forall x. FreeVars -> Rep FreeVars x
Generic)
deriving (Context -> FreeVars -> IO (Maybe ThunkInfo)
Proxy FreeVars -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy FreeVars -> String
$cshowTypeOf :: Proxy FreeVars -> String
wNoThunks :: Context -> FreeVars -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> FreeVars -> IO (Maybe ThunkInfo)
noThunks :: Context -> FreeVars -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> FreeVars -> IO (Maybe ThunkInfo)
NoThunks)
instance NFData FreeVars
instance EncCBOR FreeVars where
encCBOR :: FreeVars -> Encoding
encCBOR
FreeVars
{ VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
fvDelegs :: VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
fvDelegs :: FreeVars -> VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
fvDelegs
, Set (Credential 'Staking)
fvAddrsRew :: Set (Credential 'Staking)
fvAddrsRew :: FreeVars -> Set (Credential 'Staking)
fvAddrsRew
, Coin
fvTotalStake :: Coin
fvTotalStake :: FreeVars -> Coin
fvTotalStake
, ProtVer
fvProtVer :: ProtVer
fvProtVer :: FreeVars -> ProtVer
fvProtVer
, Map (KeyHash 'StakePool) PoolRewardInfo
fvPoolRewardInfo :: Map (KeyHash 'StakePool) PoolRewardInfo
fvPoolRewardInfo :: FreeVars -> Map (KeyHash 'StakePool) PoolRewardInfo
fvPoolRewardInfo
} =
forall (w :: Wrapped) t. Encode w t -> Encoding
encode
( forall t. t -> Encode ('Closed 'Dense) t
Rec VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
-> Set (Credential 'Staking)
-> Coin
-> ProtVer
-> Map (KeyHash 'StakePool) PoolRewardInfo
-> FreeVars
FreeVars
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
fvDelegs
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Set (Credential 'Staking)
fvAddrsRew
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
fvTotalStake
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To ProtVer
fvProtVer
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Map (KeyHash 'StakePool) PoolRewardInfo
fvPoolRewardInfo
)
instance DecCBOR FreeVars where
decCBOR :: forall s. Decoder s FreeVars
decCBOR =
forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode
( forall t. t -> Decode ('Closed 'Dense) t
RecD VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
-> Set (Credential 'Staking)
-> Coin
-> ProtVer
-> Map (KeyHash 'StakePool) PoolRewardInfo
-> FreeVars
FreeVars
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
)
rewardStakePoolMember ::
FreeVars ->
RewardAns ->
Credential 'Staking ->
CompactForm Coin ->
RewardAns
rewardStakePoolMember :: FreeVars
-> RewardAns
-> Credential 'Staking
-> CompactForm Coin
-> RewardAns
rewardStakePoolMember
FreeVars
{ VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
fvDelegs :: VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
fvDelegs :: FreeVars -> VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
fvDelegs
, Set (Credential 'Staking)
fvAddrsRew :: Set (Credential 'Staking)
fvAddrsRew :: FreeVars -> Set (Credential 'Staking)
fvAddrsRew
, Coin
fvTotalStake :: Coin
fvTotalStake :: FreeVars -> Coin
fvTotalStake
, Map (KeyHash 'StakePool) PoolRewardInfo
fvPoolRewardInfo :: Map (KeyHash 'StakePool) PoolRewardInfo
fvPoolRewardInfo :: FreeVars -> Map (KeyHash 'StakePool) PoolRewardInfo
fvPoolRewardInfo
, ProtVer
fvProtVer :: ProtVer
fvProtVer :: FreeVars -> ProtVer
fvProtVer
}
inputanswer :: RewardAns
inputanswer@(RewardAns Map (Credential 'Staking) Reward
accum RewardEvent
recent)
Credential 'Staking
cred
CompactForm Coin
c = forall a. a -> Maybe a -> a
fromMaybe RewardAns
inputanswer forall a b. (a -> b) -> a -> b
$ do
KeyHash 'StakePool
poolID <- forall k (kv :: * -> *) (vv :: * -> *) v.
(Ord k, Vector kv k, Vector vv v) =>
k -> VMap kv vv k v -> Maybe v
VMap.lookup Credential 'Staking
cred VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
fvDelegs
PoolRewardInfo
poolRI <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash 'StakePool
poolID Map (KeyHash 'StakePool) PoolRewardInfo
fvPoolRewardInfo
Coin
r <- ProtVer
-> Coin
-> Set (Credential 'Staking)
-> PoolRewardInfo
-> Credential 'Staking
-> Coin
-> Maybe Coin
rewardOnePoolMember ProtVer
fvProtVer Coin
fvTotalStake Set (Credential 'Staking)
fvAddrsRew PoolRewardInfo
poolRI Credential 'Staking
cred (forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm Coin
c)
let ans :: Reward
ans = RewardType -> KeyHash 'StakePool -> Coin -> Reward
Reward RewardType
MemberReward KeyHash 'StakePool
poolID Coin
r
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Map (Credential 'Staking) Reward -> RewardEvent -> RewardAns
RewardAns (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Credential 'Staking
cred Reward
ans Map (Credential 'Staking) Reward
accum) (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Credential 'Staking
cred (forall a. a -> Set a
Set.singleton Reward
ans) RewardEvent
recent)
data RewardPulser (m :: Type -> Type) ans where
RSLP ::
(ans ~ RewardAns, m ~ ShelleyBase) =>
!Int ->
!FreeVars ->
!(VMap.VMap VMap.VB VMap.VP (Credential 'Staking) (CompactForm Coin)) ->
!ans ->
RewardPulser m ans
clearRecent :: RewardAns -> RewardAns
clearRecent :: RewardAns -> RewardAns
clearRecent (RewardAns Map (Credential 'Staking) Reward
accum RewardEvent
_) = Map (Credential 'Staking) Reward -> RewardEvent -> RewardAns
RewardAns Map (Credential 'Staking) Reward
accum forall k a. Map k a
Map.empty
instance Pulsable RewardPulser where
done :: forall (m :: * -> *) ans. RewardPulser m ans -> Bool
done (RSLP Int
_n FreeVars
_free VMap VB VP (Credential 'Staking) (CompactForm Coin)
zs ans
_ans) = forall (vv :: * -> *) v (kv :: * -> *) k.
(Vector vv v, Vector kv k) =>
VMap kv vv k v -> Bool
VMap.null VMap VB VP (Credential 'Staking) (CompactForm Coin)
zs
current :: forall (m :: * -> *) ans. RewardPulser m ans -> ans
current (RSLP Int
_ FreeVars
_ VMap VB VP (Credential 'Staking) (CompactForm Coin)
_ ans
ans) = ans
ans
pulseM :: forall (m :: * -> *) ans.
Monad m =>
RewardPulser m ans -> m (RewardPulser m ans)
pulseM p :: RewardPulser m ans
p@(RSLP Int
n FreeVars
free VMap VB VP (Credential 'Staking) (CompactForm Coin)
balance (RewardAns -> RewardAns
clearRecent -> RewardAns
ans)) =
if forall (vv :: * -> *) v (kv :: * -> *) k.
(Vector vv v, Vector kv k) =>
VMap kv vv k v -> Bool
VMap.null VMap VB VP (Credential 'Staking) (CompactForm Coin)
balance
then forall (f :: * -> *) a. Applicative f => a -> f a
pure RewardPulser m ans
p
else do
let !(VMap VB VP (Credential 'Staking) (CompactForm Coin)
steps, !VMap VB VP (Credential 'Staking) (CompactForm Coin)
balance') = forall (vv :: * -> *) v (kv :: * -> *) k.
(Vector vv v, Vector kv k) =>
Int -> VMap kv vv k v -> (VMap kv vv k v, VMap kv vv k v)
VMap.splitAt Int
n VMap VB VP (Credential 'Staking) (CompactForm Coin)
balance
ans' :: RewardAns
ans' = forall (kv :: * -> *) k (vv :: * -> *) v a.
(Vector kv k, Vector vv v) =>
(a -> k -> v -> a) -> a -> VMap kv vv k v -> a
VMap.foldlWithKey (FreeVars
-> RewardAns
-> Credential 'Staking
-> CompactForm Coin
-> RewardAns
rewardStakePoolMember FreeVars
free) RewardAns
ans VMap VB VP (Credential 'Staking) (CompactForm Coin)
steps
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall ans (m :: * -> *).
(ans ~ RewardAns, m ~ ShelleyBase) =>
Int
-> FreeVars
-> VMap VB VP (Credential 'Staking) (CompactForm Coin)
-> ans
-> RewardPulser m ans
RSLP Int
n FreeVars
free VMap VB VP (Credential 'Staking) (CompactForm Coin)
balance' RewardAns
ans'
completeM :: forall (m :: * -> *) ans. Monad m => RewardPulser m ans -> m ans
completeM (RSLP Int
_ FreeVars
free VMap VB VP (Credential 'Staking) (CompactForm Coin)
balance (RewardAns -> RewardAns
clearRecent -> RewardAns
ans)) =
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (kv :: * -> *) k (vv :: * -> *) v a.
(Vector kv k, Vector vv v) =>
(a -> k -> v -> a) -> a -> VMap kv vv k v -> a
VMap.foldlWithKey (FreeVars
-> RewardAns
-> Credential 'Staking
-> CompactForm Coin
-> RewardAns
rewardStakePoolMember FreeVars
free) RewardAns
ans VMap VB VP (Credential 'Staking) (CompactForm Coin)
balance
deriving instance Eq ans => Eq (RewardPulser m ans)
deriving instance Show ans => Show (RewardPulser m ans)
instance NoThunks Pulser where
showTypeOf :: Proxy Pulser -> String
showTypeOf Proxy Pulser
_ = String
"RewardPulser"
wNoThunks :: Context -> Pulser -> IO (Maybe ThunkInfo)
wNoThunks Context
ctxt (RSLP Int
n FreeVars
free VMap VB VP (Credential 'Staking) (CompactForm Coin)
balance RewardAns
ans) =
[IO (Maybe ThunkInfo)] -> IO (Maybe ThunkInfo)
allNoThunks
[ forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt Int
n
, forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt FreeVars
free
, forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt VMap VB VP (Credential 'Staking) (CompactForm Coin)
balance
, forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt RewardAns
ans
]
instance NFData Pulser where
rnf :: Pulser -> ()
rnf (RSLP Int
n1 FreeVars
c1 VMap VB VP (Credential 'Staking) (CompactForm Coin)
b1 RewardAns
a1) = seq :: forall a b. a -> b -> b
seq (forall a. NFData a => a -> ()
rnf Int
n1) (seq :: forall a b. a -> b -> b
seq (forall a. NFData a => a -> ()
rnf FreeVars
c1) (seq :: forall a b. a -> b -> b
seq (forall a. NFData a => a -> ()
rnf VMap VB VP (Credential 'Staking) (CompactForm Coin)
b1) (forall a. NFData a => a -> ()
rnf RewardAns
a1)))
instance EncCBOR Pulser where
encCBOR :: Pulser -> Encoding
encCBOR (RSLP Int
n FreeVars
free VMap VB VP (Credential 'Staking) (CompactForm Coin)
balance RewardAns
ans) =
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (forall t. t -> Encode ('Closed 'Dense) t
Rec forall ans (m :: * -> *).
(ans ~ RewardAns, m ~ ShelleyBase) =>
Int
-> FreeVars
-> VMap VB VP (Credential 'Staking) (CompactForm Coin)
-> ans
-> RewardPulser m ans
RSLP forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Int
n forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To FreeVars
free forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To VMap VB VP (Credential 'Staking) (CompactForm Coin)
balance forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To RewardAns
ans)
instance DecCBOR Pulser where
decCBOR :: forall s. Decoder s Pulser
decCBOR =
forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode (forall t. t -> Decode ('Closed 'Dense) t
RecD forall ans (m :: * -> *).
(ans ~ RewardAns, m ~ ShelleyBase) =>
Int
-> FreeVars
-> VMap VB VP (Credential 'Staking) (CompactForm Coin)
-> ans
-> RewardPulser m ans
RSLP forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From)
data PulsingRewUpdate
= Pulsing !RewardSnapShot !Pulser
| Complete !RewardUpdate
deriving (PulsingRewUpdate -> PulsingRewUpdate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PulsingRewUpdate -> PulsingRewUpdate -> Bool
$c/= :: PulsingRewUpdate -> PulsingRewUpdate -> Bool
== :: PulsingRewUpdate -> PulsingRewUpdate -> Bool
$c== :: PulsingRewUpdate -> PulsingRewUpdate -> Bool
Eq, Int -> PulsingRewUpdate -> ShowS
[PulsingRewUpdate] -> ShowS
PulsingRewUpdate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PulsingRewUpdate] -> ShowS
$cshowList :: [PulsingRewUpdate] -> ShowS
show :: PulsingRewUpdate -> String
$cshow :: PulsingRewUpdate -> String
showsPrec :: Int -> PulsingRewUpdate -> ShowS
$cshowsPrec :: Int -> PulsingRewUpdate -> ShowS
Show, forall x. Rep PulsingRewUpdate x -> PulsingRewUpdate
forall x. PulsingRewUpdate -> Rep PulsingRewUpdate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PulsingRewUpdate x -> PulsingRewUpdate
$cfrom :: forall x. PulsingRewUpdate -> Rep PulsingRewUpdate x
Generic, Context -> PulsingRewUpdate -> IO (Maybe ThunkInfo)
Proxy PulsingRewUpdate -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy PulsingRewUpdate -> String
$cshowTypeOf :: Proxy PulsingRewUpdate -> String
wNoThunks :: Context -> PulsingRewUpdate -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> PulsingRewUpdate -> IO (Maybe ThunkInfo)
noThunks :: Context -> PulsingRewUpdate -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> PulsingRewUpdate -> IO (Maybe ThunkInfo)
NoThunks)
instance EncCBOR PulsingRewUpdate where
encCBOR :: PulsingRewUpdate -> Encoding
encCBOR (Pulsing RewardSnapShot
s Pulser
p) = forall (w :: Wrapped) t. Encode w t -> Encoding
encode (forall t. t -> Word -> Encode 'Open t
Sum RewardSnapShot -> Pulser -> PulsingRewUpdate
Pulsing Word
0 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To RewardSnapShot
s forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Pulser
p)
encCBOR (Complete RewardUpdate
r) = forall (w :: Wrapped) t. Encode w t -> Encoding
encode (forall t. t -> Word -> Encode 'Open t
Sum RewardUpdate -> PulsingRewUpdate
Complete Word
1 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To RewardUpdate
r)
instance DecCBOR PulsingRewUpdate where
decCBOR :: forall s. Decoder s PulsingRewUpdate
decCBOR = forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode (forall t.
Text -> (Word -> Decode 'Open t) -> Decode ('Closed 'Dense) t
Summands Text
"PulsingRewUpdate" Word -> Decode 'Open PulsingRewUpdate
decPS)
where
decPS :: Word -> Decode 'Open PulsingRewUpdate
decPS Word
0 = forall t. t -> Decode 'Open t
SumD RewardSnapShot -> Pulser -> PulsingRewUpdate
Pulsing forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
decPS Word
1 = forall t. t -> Decode 'Open t
SumD RewardUpdate -> PulsingRewUpdate
Complete forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
decPS Word
n = forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
n
instance NFData PulsingRewUpdate
instance ToJSON PulsingRewUpdate where
toJSON :: PulsingRewUpdate -> Value
toJSON = \case
Pulsing RewardSnapShot
_ Pulser
_ -> Value
Null
Complete RewardUpdate
ru -> forall a. ToJSON a => a -> Value
toJSON RewardUpdate
ru
toEncoding :: PulsingRewUpdate -> Encoding
toEncoding = \case
Pulsing RewardSnapShot
_ Pulser
_ -> forall a. ToJSON a => a -> Encoding
toEncoding Value
Null
Complete RewardUpdate
ru -> forall a. ToJSON a => a -> Encoding
toEncoding RewardUpdate
ru