{-# 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 (
KeyValuePairs (..),
ProtVer (..),
ShelleyBase,
ToKeyValuePairs (..),
)
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 (ToJSON (..), Value (Null), (.=))
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
(Int -> RewardAns -> ShowS)
-> (RewardAns -> String)
-> ([RewardAns] -> ShowS)
-> Show RewardAns
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RewardAns -> ShowS
showsPrec :: Int -> RewardAns -> ShowS
$cshow :: RewardAns -> String
show :: RewardAns -> String
$cshowList :: [RewardAns] -> ShowS
showList :: [RewardAns] -> ShowS
Show, RewardAns -> RewardAns -> Bool
(RewardAns -> RewardAns -> Bool)
-> (RewardAns -> RewardAns -> Bool) -> Eq RewardAns
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RewardAns -> RewardAns -> Bool
== :: RewardAns -> RewardAns -> Bool
$c/= :: RewardAns -> RewardAns -> Bool
/= :: RewardAns -> RewardAns -> Bool
Eq, (forall x. RewardAns -> Rep RewardAns x)
-> (forall x. Rep RewardAns x -> RewardAns) -> Generic RewardAns
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
$cfrom :: forall x. RewardAns -> Rep RewardAns x
from :: forall x. RewardAns -> Rep RewardAns x
$cto :: forall x. Rep RewardAns x -> RewardAns
to :: forall x. Rep RewardAns x -> RewardAns
Generic)
deriving (RewardAns -> ()
(RewardAns -> ()) -> NFData RewardAns
forall a. (a -> ()) -> NFData a
$crnf :: RewardAns -> ()
rnf :: 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 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map (Credential Staking) Reward -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Map (Credential Staking) Reward
accum Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> RewardEvent -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR RewardEvent
recent
instance DecCBOR RewardAns where
decCBOR :: forall s. Decoder s RewardAns
decCBOR = Text
-> (RewardAns -> Int) -> Decoder s RewardAns -> Decoder s RewardAns
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"RewardAns" (Int -> RewardAns -> Int
forall a b. a -> b -> a
const Int
2) (Map (Credential Staking) Reward -> RewardEvent -> RewardAns
RewardAns (Map (Credential Staking) Reward -> RewardEvent -> RewardAns)
-> Decoder s (Map (Credential Staking) Reward)
-> Decoder s (RewardEvent -> RewardAns)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Map (Credential Staking) Reward)
forall s. Decoder s (Map (Credential Staking) Reward)
forall a s. DecCBOR a => Decoder s a
decCBOR Decoder s (RewardEvent -> RewardAns)
-> Decoder s RewardEvent -> Decoder s RewardAns
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s RewardEvent
forall s. Decoder s RewardEvent
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
(Int -> RewardUpdate -> ShowS)
-> (RewardUpdate -> String)
-> ([RewardUpdate] -> ShowS)
-> Show RewardUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RewardUpdate -> ShowS
showsPrec :: Int -> RewardUpdate -> ShowS
$cshow :: RewardUpdate -> String
show :: RewardUpdate -> String
$cshowList :: [RewardUpdate] -> ShowS
showList :: [RewardUpdate] -> ShowS
Show, RewardUpdate -> RewardUpdate -> Bool
(RewardUpdate -> RewardUpdate -> Bool)
-> (RewardUpdate -> RewardUpdate -> Bool) -> Eq RewardUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RewardUpdate -> RewardUpdate -> Bool
== :: RewardUpdate -> RewardUpdate -> Bool
$c/= :: RewardUpdate -> RewardUpdate -> Bool
/= :: RewardUpdate -> RewardUpdate -> Bool
Eq, (forall x. RewardUpdate -> Rep RewardUpdate x)
-> (forall x. Rep RewardUpdate x -> RewardUpdate)
-> Generic RewardUpdate
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
$cfrom :: forall x. RewardUpdate -> Rep RewardUpdate x
from :: forall x. RewardUpdate -> Rep RewardUpdate x
$cto :: forall x. Rep RewardUpdate x -> RewardUpdate
to :: forall x. Rep RewardUpdate x -> RewardUpdate
Generic)
deriving ([RewardUpdate] -> Value
[RewardUpdate] -> Encoding
RewardUpdate -> Bool
RewardUpdate -> Value
RewardUpdate -> Encoding
(RewardUpdate -> Value)
-> (RewardUpdate -> Encoding)
-> ([RewardUpdate] -> Value)
-> ([RewardUpdate] -> Encoding)
-> (RewardUpdate -> Bool)
-> ToJSON RewardUpdate
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: RewardUpdate -> Value
toJSON :: RewardUpdate -> Value
$ctoEncoding :: RewardUpdate -> Encoding
toEncoding :: RewardUpdate -> Encoding
$ctoJSONList :: [RewardUpdate] -> Value
toJSONList :: [RewardUpdate] -> Value
$ctoEncodingList :: [RewardUpdate] -> Encoding
toEncodingList :: [RewardUpdate] -> Encoding
$comitField :: RewardUpdate -> Bool
omitField :: RewardUpdate -> Bool
ToJSON) via KeyValuePairs RewardUpdate
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
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> DeltaCoin -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR DeltaCoin
dt
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> DeltaCoin -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (DeltaCoin -> DeltaCoin
forall m. Group m => m -> m
invert DeltaCoin
dr)
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> RewardEvent -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR RewardEvent
rw
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> DeltaCoin -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (DeltaCoin -> DeltaCoin
forall m. Group m => m -> m
invert DeltaCoin
df)
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> NonMyopic -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR NonMyopic
nm
instance DecCBOR RewardUpdate where
decCBOR :: forall s. Decoder s RewardUpdate
decCBOR = do
Text
-> (RewardUpdate -> Int)
-> Decoder s RewardUpdate
-> Decoder s RewardUpdate
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"RewardUpdate" (Int -> RewardUpdate -> Int
forall a b. a -> b -> a
const Int
5) (Decoder s RewardUpdate -> Decoder s RewardUpdate)
-> Decoder s RewardUpdate -> Decoder s RewardUpdate
forall a b. (a -> b) -> a -> b
$ do
dt <- Decoder s DeltaCoin
forall s. Decoder s DeltaCoin
forall a s. DecCBOR a => Decoder s a
decCBOR
dr <- decCBOR
rw <- decCBOR
df <- decCBOR
nm <- decNoShareCBOR
pure $ RewardUpdate dt (invert dr) rw (invert df) nm
instance ToKeyValuePairs RewardUpdate where
toKeyValuePairs :: forall e kv. KeyValue e kv => RewardUpdate -> [kv]
toKeyValuePairs ru :: RewardUpdate
ru@(RewardUpdate DeltaCoin
_ DeltaCoin
_ RewardEvent
_ DeltaCoin
_ NonMyopic
_) =
let RewardUpdate {RewardEvent
DeltaCoin
NonMyopic
deltaT :: RewardUpdate -> DeltaCoin
deltaR :: RewardUpdate -> DeltaCoin
rs :: RewardUpdate -> RewardEvent
deltaF :: RewardUpdate -> DeltaCoin
nonMyopic :: RewardUpdate -> NonMyopic
deltaT :: DeltaCoin
deltaR :: DeltaCoin
rs :: RewardEvent
deltaF :: DeltaCoin
nonMyopic :: NonMyopic
..} = RewardUpdate
ru
in [ Key
"deltaT" Key -> DeltaCoin -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DeltaCoin
deltaT
, Key
"deltaR" Key -> DeltaCoin -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DeltaCoin
deltaR
, Key
"rs" Key -> RewardEvent -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= RewardEvent
rs
, Key
"deltaF" Key -> DeltaCoin -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DeltaCoin
deltaF
, Key
"nonMyopic" Key -> NonMyopic -> kv
forall v. ToJSON v => Key -> v -> kv
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) RewardEvent
forall k a. Map k a
Map.empty (Integer -> DeltaCoin
DeltaCoin Integer
0) NonMyopic
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
(Int -> RewardSnapShot -> ShowS)
-> (RewardSnapShot -> String)
-> ([RewardSnapShot] -> ShowS)
-> Show RewardSnapShot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RewardSnapShot -> ShowS
showsPrec :: Int -> RewardSnapShot -> ShowS
$cshow :: RewardSnapShot -> String
show :: RewardSnapShot -> String
$cshowList :: [RewardSnapShot] -> ShowS
showList :: [RewardSnapShot] -> ShowS
Show, RewardSnapShot -> RewardSnapShot -> Bool
(RewardSnapShot -> RewardSnapShot -> Bool)
-> (RewardSnapShot -> RewardSnapShot -> Bool) -> Eq RewardSnapShot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RewardSnapShot -> RewardSnapShot -> Bool
== :: RewardSnapShot -> RewardSnapShot -> Bool
$c/= :: RewardSnapShot -> RewardSnapShot -> Bool
/= :: RewardSnapShot -> RewardSnapShot -> Bool
Eq, (forall x. RewardSnapShot -> Rep RewardSnapShot x)
-> (forall x. Rep RewardSnapShot x -> RewardSnapShot)
-> Generic RewardSnapShot
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
$cfrom :: forall x. RewardSnapShot -> Rep RewardSnapShot x
from :: forall x. RewardSnapShot -> Rep RewardSnapShot x
$cto :: forall x. Rep RewardSnapShot x -> RewardSnapShot
to :: forall x. Rep RewardSnapShot x -> RewardSnapShot
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) =
Encode (Closed Dense) RewardSnapShot -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode
( (Coin
-> ProtVer
-> NonMyopic
-> Coin
-> Coin
-> Coin
-> Map (KeyHash StakePool) Likelihood
-> RewardEvent
-> RewardSnapShot)
-> Encode
(Closed Dense)
(Coin
-> ProtVer
-> NonMyopic
-> Coin
-> Coin
-> Coin
-> Map (KeyHash StakePool) Likelihood
-> RewardEvent
-> RewardSnapShot)
forall t. t -> Encode (Closed Dense) t
Rec Coin
-> ProtVer
-> NonMyopic
-> Coin
-> Coin
-> Coin
-> Map (KeyHash StakePool) Likelihood
-> RewardEvent
-> RewardSnapShot
RewardSnapShot
Encode
(Closed Dense)
(Coin
-> ProtVer
-> NonMyopic
-> Coin
-> Coin
-> Coin
-> Map (KeyHash StakePool) Likelihood
-> RewardEvent
-> RewardSnapShot)
-> Encode (Closed Dense) Coin
-> Encode
(Closed Dense)
(ProtVer
-> NonMyopic
-> Coin
-> Coin
-> Coin
-> Map (KeyHash StakePool) Likelihood
-> RewardEvent
-> RewardSnapShot)
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
fees
Encode
(Closed Dense)
(ProtVer
-> NonMyopic
-> Coin
-> Coin
-> Coin
-> Map (KeyHash StakePool) Likelihood
-> RewardEvent
-> RewardSnapShot)
-> Encode (Closed Dense) ProtVer
-> Encode
(Closed Dense)
(NonMyopic
-> Coin
-> Coin
-> Coin
-> Map (KeyHash StakePool) Likelihood
-> RewardEvent
-> RewardSnapShot)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> ProtVer -> Encode (Closed Dense) ProtVer
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To ProtVer
ver
Encode
(Closed Dense)
(NonMyopic
-> Coin
-> Coin
-> Coin
-> Map (KeyHash StakePool) Likelihood
-> RewardEvent
-> RewardSnapShot)
-> Encode (Closed Dense) NonMyopic
-> Encode
(Closed Dense)
(Coin
-> Coin
-> Coin
-> Map (KeyHash StakePool) Likelihood
-> RewardEvent
-> RewardSnapShot)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> NonMyopic -> Encode (Closed Dense) NonMyopic
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To NonMyopic
nm
Encode
(Closed Dense)
(Coin
-> Coin
-> Coin
-> Map (KeyHash StakePool) Likelihood
-> RewardEvent
-> RewardSnapShot)
-> Encode (Closed Dense) Coin
-> Encode
(Closed Dense)
(Coin
-> Coin
-> Map (KeyHash StakePool) Likelihood
-> RewardEvent
-> RewardSnapShot)
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
dr1
Encode
(Closed Dense)
(Coin
-> Coin
-> Map (KeyHash StakePool) Likelihood
-> RewardEvent
-> RewardSnapShot)
-> Encode (Closed Dense) Coin
-> Encode
(Closed Dense)
(Coin
-> Map (KeyHash StakePool) Likelihood
-> RewardEvent
-> RewardSnapShot)
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
r
Encode
(Closed Dense)
(Coin
-> Map (KeyHash StakePool) Likelihood
-> RewardEvent
-> RewardSnapShot)
-> Encode (Closed Dense) Coin
-> Encode
(Closed Dense)
(Map (KeyHash StakePool) Likelihood
-> RewardEvent -> RewardSnapShot)
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
dt1
Encode
(Closed Dense)
(Map (KeyHash StakePool) Likelihood
-> RewardEvent -> RewardSnapShot)
-> Encode (Closed Dense) (Map (KeyHash StakePool) Likelihood)
-> Encode (Closed Dense) (RewardEvent -> RewardSnapShot)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Map (KeyHash StakePool) Likelihood
-> Encode (Closed Dense) (Map (KeyHash StakePool) Likelihood)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Map (KeyHash StakePool) Likelihood
lhs
Encode (Closed Dense) (RewardEvent -> RewardSnapShot)
-> Encode (Closed Dense) RewardEvent
-> Encode (Closed Dense) RewardSnapShot
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> RewardEvent -> Encode (Closed Dense) RewardEvent
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To RewardEvent
lrs
)
instance DecCBOR RewardSnapShot where
decCBOR :: forall s. Decoder s RewardSnapShot
decCBOR =
Decode (Closed Dense) RewardSnapShot -> Decoder s RewardSnapShot
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode
( (Coin
-> ProtVer
-> NonMyopic
-> Coin
-> Coin
-> Coin
-> Map (KeyHash StakePool) Likelihood
-> RewardEvent
-> RewardSnapShot)
-> Decode
(Closed Dense)
(Coin
-> ProtVer
-> NonMyopic
-> Coin
-> Coin
-> Coin
-> Map (KeyHash StakePool) Likelihood
-> RewardEvent
-> RewardSnapShot)
forall t. t -> Decode (Closed Dense) t
RecD Coin
-> ProtVer
-> NonMyopic
-> Coin
-> Coin
-> Coin
-> Map (KeyHash StakePool) Likelihood
-> RewardEvent
-> RewardSnapShot
RewardSnapShot
Decode
(Closed Dense)
(Coin
-> ProtVer
-> NonMyopic
-> Coin
-> Coin
-> Coin
-> Map (KeyHash StakePool) Likelihood
-> RewardEvent
-> RewardSnapShot)
-> Decode (Closed (ZonkAny 18)) Coin
-> Decode
(Closed Dense)
(ProtVer
-> NonMyopic
-> Coin
-> Coin
-> Coin
-> Map (KeyHash StakePool) Likelihood
-> RewardEvent
-> RewardSnapShot)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 18)) Coin
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Decode
(Closed Dense)
(ProtVer
-> NonMyopic
-> Coin
-> Coin
-> Coin
-> Map (KeyHash StakePool) Likelihood
-> RewardEvent
-> RewardSnapShot)
-> Decode (Closed (ZonkAny 17)) ProtVer
-> Decode
(Closed Dense)
(NonMyopic
-> Coin
-> Coin
-> Coin
-> Map (KeyHash StakePool) Likelihood
-> RewardEvent
-> RewardSnapShot)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 17)) ProtVer
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Decode
(Closed Dense)
(NonMyopic
-> Coin
-> Coin
-> Coin
-> Map (KeyHash StakePool) Likelihood
-> RewardEvent
-> RewardSnapShot)
-> Decode (Closed Dense) NonMyopic
-> Decode
(Closed Dense)
(Coin
-> Coin
-> Coin
-> Map (KeyHash StakePool) Likelihood
-> RewardEvent
-> RewardSnapShot)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! (forall s. Decoder s NonMyopic) -> Decode (Closed Dense) NonMyopic
forall t. (forall s. Decoder s t) -> Decode (Closed Dense) t
D Decoder s NonMyopic
forall s. Decoder s NonMyopic
forall a s. DecShareCBOR a => Decoder s a
decNoShareCBOR
Decode
(Closed Dense)
(Coin
-> Coin
-> Coin
-> Map (KeyHash StakePool) Likelihood
-> RewardEvent
-> RewardSnapShot)
-> Decode (Closed (ZonkAny 16)) Coin
-> Decode
(Closed Dense)
(Coin
-> Coin
-> Map (KeyHash StakePool) Likelihood
-> RewardEvent
-> RewardSnapShot)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 16)) Coin
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Decode
(Closed Dense)
(Coin
-> Coin
-> Map (KeyHash StakePool) Likelihood
-> RewardEvent
-> RewardSnapShot)
-> Decode (Closed (ZonkAny 15)) Coin
-> Decode
(Closed Dense)
(Coin
-> Map (KeyHash StakePool) Likelihood
-> RewardEvent
-> RewardSnapShot)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 15)) Coin
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Decode
(Closed Dense)
(Coin
-> Map (KeyHash StakePool) Likelihood
-> RewardEvent
-> RewardSnapShot)
-> Decode (Closed (ZonkAny 14)) Coin
-> Decode
(Closed Dense)
(Map (KeyHash StakePool) Likelihood
-> RewardEvent -> RewardSnapShot)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 14)) Coin
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Decode
(Closed Dense)
(Map (KeyHash StakePool) Likelihood
-> RewardEvent -> RewardSnapShot)
-> Decode
(Closed (ZonkAny 13)) (Map (KeyHash StakePool) Likelihood)
-> Decode (Closed Dense) (RewardEvent -> RewardSnapShot)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 13)) (Map (KeyHash StakePool) Likelihood)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Decode (Closed Dense) (RewardEvent -> RewardSnapShot)
-> Decode (Closed (ZonkAny 12)) RewardEvent
-> Decode (Closed Dense) RewardSnapShot
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 12)) RewardEvent
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
(FreeVars -> FreeVars -> Bool)
-> (FreeVars -> FreeVars -> Bool) -> Eq FreeVars
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FreeVars -> FreeVars -> Bool
== :: FreeVars -> FreeVars -> Bool
$c/= :: FreeVars -> FreeVars -> Bool
/= :: FreeVars -> FreeVars -> Bool
Eq, Int -> FreeVars -> ShowS
[FreeVars] -> ShowS
FreeVars -> String
(Int -> FreeVars -> ShowS)
-> (FreeVars -> String) -> ([FreeVars] -> ShowS) -> Show FreeVars
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FreeVars -> ShowS
showsPrec :: Int -> FreeVars -> ShowS
$cshow :: FreeVars -> String
show :: FreeVars -> String
$cshowList :: [FreeVars] -> ShowS
showList :: [FreeVars] -> ShowS
Show, (forall x. FreeVars -> Rep FreeVars x)
-> (forall x. Rep FreeVars x -> FreeVars) -> Generic FreeVars
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
$cfrom :: forall x. FreeVars -> Rep FreeVars x
from :: forall x. FreeVars -> Rep FreeVars x
$cto :: forall x. Rep FreeVars x -> FreeVars
to :: forall x. Rep FreeVars x -> FreeVars
Generic)
deriving (Context -> FreeVars -> IO (Maybe ThunkInfo)
Proxy FreeVars -> String
(Context -> FreeVars -> IO (Maybe ThunkInfo))
-> (Context -> FreeVars -> IO (Maybe ThunkInfo))
-> (Proxy FreeVars -> String)
-> NoThunks FreeVars
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> FreeVars -> IO (Maybe ThunkInfo)
noThunks :: Context -> FreeVars -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> FreeVars -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> FreeVars -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy FreeVars -> String
showTypeOf :: Proxy FreeVars -> String
NoThunks)
instance NFData FreeVars
instance EncCBOR FreeVars where
encCBOR :: FreeVars -> Encoding
encCBOR
FreeVars
{ VMap VB VB (Credential Staking) (KeyHash StakePool)
fvDelegs :: FreeVars -> VMap VB VB (Credential Staking) (KeyHash StakePool)
fvDelegs :: VMap VB VB (Credential Staking) (KeyHash StakePool)
fvDelegs
, Set (Credential Staking)
fvAddrsRew :: FreeVars -> Set (Credential Staking)
fvAddrsRew :: Set (Credential Staking)
fvAddrsRew
, Coin
fvTotalStake :: FreeVars -> Coin
fvTotalStake :: Coin
fvTotalStake
, ProtVer
fvProtVer :: FreeVars -> ProtVer
fvProtVer :: ProtVer
fvProtVer
, Map (KeyHash StakePool) PoolRewardInfo
fvPoolRewardInfo :: FreeVars -> Map (KeyHash StakePool) PoolRewardInfo
fvPoolRewardInfo :: Map (KeyHash StakePool) PoolRewardInfo
fvPoolRewardInfo
} =
Encode (Closed Dense) FreeVars -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode
( (VMap VB VB (Credential Staking) (KeyHash StakePool)
-> Set (Credential Staking)
-> Coin
-> ProtVer
-> Map (KeyHash StakePool) PoolRewardInfo
-> FreeVars)
-> Encode
(Closed Dense)
(VMap VB VB (Credential Staking) (KeyHash StakePool)
-> Set (Credential Staking)
-> Coin
-> ProtVer
-> Map (KeyHash StakePool) PoolRewardInfo
-> FreeVars)
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
Encode
(Closed Dense)
(VMap VB VB (Credential Staking) (KeyHash StakePool)
-> Set (Credential Staking)
-> Coin
-> ProtVer
-> Map (KeyHash StakePool) PoolRewardInfo
-> FreeVars)
-> Encode
(Closed Dense)
(VMap VB VB (Credential Staking) (KeyHash StakePool))
-> Encode
(Closed Dense)
(Set (Credential Staking)
-> Coin
-> ProtVer
-> Map (KeyHash StakePool) PoolRewardInfo
-> FreeVars)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> VMap VB VB (Credential Staking) (KeyHash StakePool)
-> Encode
(Closed Dense)
(VMap VB VB (Credential Staking) (KeyHash StakePool))
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To VMap VB VB (Credential Staking) (KeyHash StakePool)
fvDelegs
Encode
(Closed Dense)
(Set (Credential Staking)
-> Coin
-> ProtVer
-> Map (KeyHash StakePool) PoolRewardInfo
-> FreeVars)
-> Encode (Closed Dense) (Set (Credential Staking))
-> Encode
(Closed Dense)
(Coin
-> ProtVer -> Map (KeyHash StakePool) PoolRewardInfo -> FreeVars)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Set (Credential Staking)
-> Encode (Closed Dense) (Set (Credential Staking))
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Set (Credential Staking)
fvAddrsRew
Encode
(Closed Dense)
(Coin
-> ProtVer -> Map (KeyHash StakePool) PoolRewardInfo -> FreeVars)
-> Encode (Closed Dense) Coin
-> Encode
(Closed Dense)
(ProtVer -> Map (KeyHash StakePool) PoolRewardInfo -> FreeVars)
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
fvTotalStake
Encode
(Closed Dense)
(ProtVer -> Map (KeyHash StakePool) PoolRewardInfo -> FreeVars)
-> Encode (Closed Dense) ProtVer
-> Encode
(Closed Dense) (Map (KeyHash StakePool) PoolRewardInfo -> FreeVars)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> ProtVer -> Encode (Closed Dense) ProtVer
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To ProtVer
fvProtVer
Encode
(Closed Dense) (Map (KeyHash StakePool) PoolRewardInfo -> FreeVars)
-> Encode (Closed Dense) (Map (KeyHash StakePool) PoolRewardInfo)
-> Encode (Closed Dense) FreeVars
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Map (KeyHash StakePool) PoolRewardInfo
-> Encode (Closed Dense) (Map (KeyHash StakePool) PoolRewardInfo)
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 =
Decode (Closed Dense) FreeVars -> Decoder s FreeVars
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode
( (VMap VB VB (Credential Staking) (KeyHash StakePool)
-> Set (Credential Staking)
-> Coin
-> ProtVer
-> Map (KeyHash StakePool) PoolRewardInfo
-> FreeVars)
-> Decode
(Closed Dense)
(VMap VB VB (Credential Staking) (KeyHash StakePool)
-> Set (Credential Staking)
-> Coin
-> ProtVer
-> Map (KeyHash StakePool) PoolRewardInfo
-> FreeVars)
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
Decode
(Closed Dense)
(VMap VB VB (Credential Staking) (KeyHash StakePool)
-> Set (Credential Staking)
-> Coin
-> ProtVer
-> Map (KeyHash StakePool) PoolRewardInfo
-> FreeVars)
-> Decode
(Closed (ZonkAny 11))
(VMap VB VB (Credential Staking) (KeyHash StakePool))
-> Decode
(Closed Dense)
(Set (Credential Staking)
-> Coin
-> ProtVer
-> Map (KeyHash StakePool) PoolRewardInfo
-> FreeVars)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode
(Closed (ZonkAny 11))
(VMap VB VB (Credential Staking) (KeyHash StakePool))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Decode
(Closed Dense)
(Set (Credential Staking)
-> Coin
-> ProtVer
-> Map (KeyHash StakePool) PoolRewardInfo
-> FreeVars)
-> Decode (Closed (ZonkAny 10)) (Set (Credential Staking))
-> Decode
(Closed Dense)
(Coin
-> ProtVer -> Map (KeyHash StakePool) PoolRewardInfo -> FreeVars)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 10)) (Set (Credential Staking))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Decode
(Closed Dense)
(Coin
-> ProtVer -> Map (KeyHash StakePool) PoolRewardInfo -> FreeVars)
-> Decode (Closed (ZonkAny 9)) Coin
-> Decode
(Closed Dense)
(ProtVer -> Map (KeyHash StakePool) PoolRewardInfo -> FreeVars)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 9)) Coin
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Decode
(Closed Dense)
(ProtVer -> Map (KeyHash StakePool) PoolRewardInfo -> FreeVars)
-> Decode (Closed (ZonkAny 8)) ProtVer
-> Decode
(Closed Dense) (Map (KeyHash StakePool) PoolRewardInfo -> FreeVars)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 8)) ProtVer
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Decode
(Closed Dense) (Map (KeyHash StakePool) PoolRewardInfo -> FreeVars)
-> Decode
(Closed (ZonkAny 7)) (Map (KeyHash StakePool) PoolRewardInfo)
-> Decode (Closed Dense) FreeVars
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode
(Closed (ZonkAny 7)) (Map (KeyHash StakePool) PoolRewardInfo)
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
freeVars inputAnswer :: RewardAns
inputAnswer@(RewardAns Map (Credential Staking) Reward
accum RewardEvent
recent) Credential Staking
cred CompactForm Coin
c =
RewardAns -> Maybe RewardAns -> RewardAns
forall a. a -> Maybe a -> a
fromMaybe RewardAns
inputAnswer (Maybe RewardAns -> RewardAns) -> Maybe RewardAns -> RewardAns
forall a b. (a -> b) -> a -> b
$ do
let FreeVars
{ VMap VB VB (Credential Staking) (KeyHash StakePool)
fvDelegs :: FreeVars -> VMap VB VB (Credential Staking) (KeyHash StakePool)
fvDelegs :: VMap VB VB (Credential Staking) (KeyHash StakePool)
fvDelegs
, Set (Credential Staking)
fvAddrsRew :: FreeVars -> Set (Credential Staking)
fvAddrsRew :: Set (Credential Staking)
fvAddrsRew
, Coin
fvTotalStake :: FreeVars -> Coin
fvTotalStake :: Coin
fvTotalStake
, Map (KeyHash StakePool) PoolRewardInfo
fvPoolRewardInfo :: FreeVars -> Map (KeyHash StakePool) PoolRewardInfo
fvPoolRewardInfo :: Map (KeyHash StakePool) PoolRewardInfo
fvPoolRewardInfo
, ProtVer
fvProtVer :: FreeVars -> ProtVer
fvProtVer :: ProtVer
fvProtVer
} = FreeVars
freeVars
poolId <- Credential Staking
-> VMap VB VB (Credential Staking) (KeyHash StakePool)
-> Maybe (KeyHash StakePool)
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
poolRI <- Map.lookup poolId fvPoolRewardInfo
r <- rewardOnePoolMember fvProtVer fvTotalStake fvAddrsRew poolRI cred (fromCompact c)
let ans = RewardType -> KeyHash StakePool -> Coin -> Reward
Reward RewardType
MemberReward KeyHash StakePool
poolId Coin
r
pure $ RewardAns (Map.insert cred ans accum) (Map.insert cred (Set.singleton ans) 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 RewardEvent
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) = VMap VB VP (Credential Staking) (CompactForm Coin) -> Bool
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 (ans -> RewardAns
RewardAns -> RewardAns
clearRecent -> RewardAns
ans)) =
if VMap VB VP (Credential Staking) (CompactForm Coin) -> Bool
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 RewardPulser m ans -> m (RewardPulser m ans)
forall a. a -> m a
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') = Int
-> VMap VB VP (Credential Staking) (CompactForm Coin)
-> (VMap VB VP (Credential Staking) (CompactForm Coin),
VMap VB VP (Credential Staking) (CompactForm Coin))
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' = (RewardAns -> Credential Staking -> CompactForm Coin -> RewardAns)
-> RewardAns
-> VMap VB VP (Credential Staking) (CompactForm Coin)
-> RewardAns
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
RewardPulser m ans -> m (RewardPulser m ans)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RewardPulser m ans -> m (RewardPulser m ans))
-> RewardPulser m ans -> m (RewardPulser m ans)
forall a b. (a -> b) -> a -> b
$! Int
-> FreeVars
-> VMap VB VP (Credential Staking) (CompactForm Coin)
-> ans
-> RewardPulser m ans
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' ans
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 (ans -> RewardAns
RewardAns -> RewardAns
clearRecent -> RewardAns
ans)) =
ans -> m ans
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ans -> m ans) -> ans -> m ans
forall a b. (a -> b) -> a -> b
$ (ans -> Credential Staking -> CompactForm Coin -> ans)
-> ans -> VMap VB VP (Credential Staking) (CompactForm Coin) -> 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) ans
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
[ Context -> Int -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt Int
n
, Context -> FreeVars -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt FreeVars
free
, Context
-> VMap VB VP (Credential Staking) (CompactForm Coin)
-> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt VMap VB VP (Credential Staking) (CompactForm Coin)
balance
, Context -> RewardAns -> IO (Maybe ThunkInfo)
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) = () -> () -> ()
forall a b. a -> b -> b
seq (Int -> ()
forall a. NFData a => a -> ()
rnf Int
n1) (() -> () -> ()
forall a b. a -> b -> b
seq (FreeVars -> ()
forall a. NFData a => a -> ()
rnf FreeVars
c1) (() -> () -> ()
forall a b. a -> b -> b
seq (VMap VB VP (Credential Staking) (CompactForm Coin) -> ()
forall a. NFData a => a -> ()
rnf VMap VB VP (Credential Staking) (CompactForm Coin)
b1) (RewardAns -> ()
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) =
Encode (Closed Dense) Pulser -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode ((Int
-> FreeVars
-> VMap VB VP (Credential Staking) (CompactForm Coin)
-> RewardAns
-> Pulser)
-> Encode
(Closed Dense)
(Int
-> FreeVars
-> VMap VB VP (Credential Staking) (CompactForm Coin)
-> RewardAns
-> Pulser)
forall t. t -> Encode (Closed Dense) t
Rec Int
-> FreeVars
-> VMap VB VP (Credential Staking) (CompactForm Coin)
-> RewardAns
-> Pulser
forall ans (m :: * -> *).
(ans ~ RewardAns, m ~ ShelleyBase) =>
Int
-> FreeVars
-> VMap VB VP (Credential Staking) (CompactForm Coin)
-> ans
-> RewardPulser m ans
RSLP Encode
(Closed Dense)
(Int
-> FreeVars
-> VMap VB VP (Credential Staking) (CompactForm Coin)
-> RewardAns
-> Pulser)
-> Encode (Closed Dense) Int
-> Encode
(Closed Dense)
(FreeVars
-> VMap VB VP (Credential Staking) (CompactForm Coin)
-> RewardAns
-> Pulser)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Int -> Encode (Closed Dense) Int
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Int
n Encode
(Closed Dense)
(FreeVars
-> VMap VB VP (Credential Staking) (CompactForm Coin)
-> RewardAns
-> Pulser)
-> Encode (Closed Dense) FreeVars
-> Encode
(Closed Dense)
(VMap VB VP (Credential Staking) (CompactForm Coin)
-> RewardAns -> Pulser)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> FreeVars -> Encode (Closed Dense) FreeVars
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To FreeVars
free Encode
(Closed Dense)
(VMap VB VP (Credential Staking) (CompactForm Coin)
-> RewardAns -> Pulser)
-> Encode
(Closed Dense) (VMap VB VP (Credential Staking) (CompactForm Coin))
-> Encode (Closed Dense) (RewardAns -> Pulser)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> VMap VB VP (Credential Staking) (CompactForm Coin)
-> Encode
(Closed Dense) (VMap VB VP (Credential Staking) (CompactForm Coin))
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To VMap VB VP (Credential Staking) (CompactForm Coin)
balance Encode (Closed Dense) (RewardAns -> Pulser)
-> Encode (Closed Dense) RewardAns -> Encode (Closed Dense) Pulser
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> RewardAns -> Encode (Closed Dense) RewardAns
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To RewardAns
ans)
instance DecCBOR Pulser where
decCBOR :: forall s. Decoder s Pulser
decCBOR =
Decode (Closed Dense) Pulser -> Decoder s Pulser
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode ((Int
-> FreeVars
-> VMap VB VP (Credential Staking) (CompactForm Coin)
-> RewardAns
-> Pulser)
-> Decode
(Closed Dense)
(Int
-> FreeVars
-> VMap VB VP (Credential Staking) (CompactForm Coin)
-> RewardAns
-> Pulser)
forall t. t -> Decode (Closed Dense) t
RecD Int
-> FreeVars
-> VMap VB VP (Credential Staking) (CompactForm Coin)
-> RewardAns
-> Pulser
forall ans (m :: * -> *).
(ans ~ RewardAns, m ~ ShelleyBase) =>
Int
-> FreeVars
-> VMap VB VP (Credential Staking) (CompactForm Coin)
-> ans
-> RewardPulser m ans
RSLP Decode
(Closed Dense)
(Int
-> FreeVars
-> VMap VB VP (Credential Staking) (CompactForm Coin)
-> RewardAns
-> Pulser)
-> Decode (Closed (ZonkAny 6)) Int
-> Decode
(Closed Dense)
(FreeVars
-> VMap VB VP (Credential Staking) (CompactForm Coin)
-> RewardAns
-> Pulser)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 6)) Int
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode
(Closed Dense)
(FreeVars
-> VMap VB VP (Credential Staking) (CompactForm Coin)
-> RewardAns
-> Pulser)
-> Decode (Closed (ZonkAny 5)) FreeVars
-> Decode
(Closed Dense)
(VMap VB VP (Credential Staking) (CompactForm Coin)
-> RewardAns -> Pulser)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 5)) FreeVars
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode
(Closed Dense)
(VMap VB VP (Credential Staking) (CompactForm Coin)
-> RewardAns -> Pulser)
-> Decode
(Closed (ZonkAny 4))
(VMap VB VP (Credential Staking) (CompactForm Coin))
-> Decode (Closed Dense) (RewardAns -> Pulser)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode
(Closed (ZonkAny 4))
(VMap VB VP (Credential Staking) (CompactForm Coin))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode (Closed Dense) (RewardAns -> Pulser)
-> Decode (Closed (ZonkAny 3)) RewardAns
-> Decode (Closed Dense) Pulser
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 3)) RewardAns
forall t (w :: Wrapped). DecCBOR t => Decode w t
From)
data PulsingRewUpdate
= Pulsing !RewardSnapShot !Pulser
| Complete !RewardUpdate
deriving (PulsingRewUpdate -> PulsingRewUpdate -> Bool
(PulsingRewUpdate -> PulsingRewUpdate -> Bool)
-> (PulsingRewUpdate -> PulsingRewUpdate -> Bool)
-> Eq PulsingRewUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PulsingRewUpdate -> PulsingRewUpdate -> Bool
== :: PulsingRewUpdate -> PulsingRewUpdate -> Bool
$c/= :: PulsingRewUpdate -> PulsingRewUpdate -> Bool
/= :: PulsingRewUpdate -> PulsingRewUpdate -> Bool
Eq, Int -> PulsingRewUpdate -> ShowS
[PulsingRewUpdate] -> ShowS
PulsingRewUpdate -> String
(Int -> PulsingRewUpdate -> ShowS)
-> (PulsingRewUpdate -> String)
-> ([PulsingRewUpdate] -> ShowS)
-> Show PulsingRewUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PulsingRewUpdate -> ShowS
showsPrec :: Int -> PulsingRewUpdate -> ShowS
$cshow :: PulsingRewUpdate -> String
show :: PulsingRewUpdate -> String
$cshowList :: [PulsingRewUpdate] -> ShowS
showList :: [PulsingRewUpdate] -> ShowS
Show, (forall x. PulsingRewUpdate -> Rep PulsingRewUpdate x)
-> (forall x. Rep PulsingRewUpdate x -> PulsingRewUpdate)
-> Generic PulsingRewUpdate
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
$cfrom :: forall x. PulsingRewUpdate -> Rep PulsingRewUpdate x
from :: forall x. PulsingRewUpdate -> Rep PulsingRewUpdate x
$cto :: forall x. Rep PulsingRewUpdate x -> PulsingRewUpdate
to :: forall x. Rep PulsingRewUpdate x -> PulsingRewUpdate
Generic, Context -> PulsingRewUpdate -> IO (Maybe ThunkInfo)
Proxy PulsingRewUpdate -> String
(Context -> PulsingRewUpdate -> IO (Maybe ThunkInfo))
-> (Context -> PulsingRewUpdate -> IO (Maybe ThunkInfo))
-> (Proxy PulsingRewUpdate -> String)
-> NoThunks PulsingRewUpdate
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> PulsingRewUpdate -> IO (Maybe ThunkInfo)
noThunks :: Context -> PulsingRewUpdate -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> PulsingRewUpdate -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> PulsingRewUpdate -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy PulsingRewUpdate -> String
showTypeOf :: Proxy PulsingRewUpdate -> String
NoThunks)
instance EncCBOR PulsingRewUpdate where
encCBOR :: PulsingRewUpdate -> Encoding
encCBOR (Pulsing RewardSnapShot
s Pulser
p) = Encode Open PulsingRewUpdate -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode ((RewardSnapShot -> Pulser -> PulsingRewUpdate)
-> Word
-> Encode Open (RewardSnapShot -> Pulser -> PulsingRewUpdate)
forall t. t -> Word -> Encode Open t
Sum RewardSnapShot -> Pulser -> PulsingRewUpdate
Pulsing Word
0 Encode Open (RewardSnapShot -> Pulser -> PulsingRewUpdate)
-> Encode (Closed Dense) RewardSnapShot
-> Encode Open (Pulser -> PulsingRewUpdate)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> RewardSnapShot -> Encode (Closed Dense) RewardSnapShot
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To RewardSnapShot
s Encode Open (Pulser -> PulsingRewUpdate)
-> Encode (Closed Dense) Pulser -> Encode Open PulsingRewUpdate
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Pulser -> Encode (Closed Dense) Pulser
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Pulser
p)
encCBOR (Complete RewardUpdate
r) = Encode Open PulsingRewUpdate -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode ((RewardUpdate -> PulsingRewUpdate)
-> Word -> Encode Open (RewardUpdate -> PulsingRewUpdate)
forall t. t -> Word -> Encode Open t
Sum RewardUpdate -> PulsingRewUpdate
Complete Word
1 Encode Open (RewardUpdate -> PulsingRewUpdate)
-> Encode (Closed Dense) RewardUpdate
-> Encode Open PulsingRewUpdate
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> RewardUpdate -> Encode (Closed Dense) RewardUpdate
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To RewardUpdate
r)
instance DecCBOR PulsingRewUpdate where
decCBOR :: forall s. Decoder s PulsingRewUpdate
decCBOR = Decode (Closed Dense) PulsingRewUpdate
-> Decoder s PulsingRewUpdate
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Text
-> (Word -> Decode Open PulsingRewUpdate)
-> Decode (Closed Dense) PulsingRewUpdate
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 = (RewardSnapShot -> Pulser -> PulsingRewUpdate)
-> Decode Open (RewardSnapShot -> Pulser -> PulsingRewUpdate)
forall t. t -> Decode Open t
SumD RewardSnapShot -> Pulser -> PulsingRewUpdate
Pulsing Decode Open (RewardSnapShot -> Pulser -> PulsingRewUpdate)
-> Decode (Closed (ZonkAny 1)) RewardSnapShot
-> Decode Open (Pulser -> PulsingRewUpdate)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 1)) RewardSnapShot
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode Open (Pulser -> PulsingRewUpdate)
-> Decode (Closed (ZonkAny 0)) Pulser
-> Decode Open PulsingRewUpdate
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 0)) Pulser
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
decPS Word
1 = (RewardUpdate -> PulsingRewUpdate)
-> Decode Open (RewardUpdate -> PulsingRewUpdate)
forall t. t -> Decode Open t
SumD RewardUpdate -> PulsingRewUpdate
Complete Decode Open (RewardUpdate -> PulsingRewUpdate)
-> Decode (Closed (ZonkAny 2)) RewardUpdate
-> Decode Open PulsingRewUpdate
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 2)) RewardUpdate
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
decPS Word
n = Word -> Decode Open PulsingRewUpdate
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 -> RewardUpdate -> Value
forall a. ToJSON a => a -> Value
toJSON RewardUpdate
ru
toEncoding :: PulsingRewUpdate -> Encoding
toEncoding = \case
Pulsing RewardSnapShot
_ Pulser
_ -> Value -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding Value
Null
Complete RewardUpdate
ru -> RewardUpdate -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding RewardUpdate
ru