{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE ViewPatterns #-}

-- | How to compute the reward update compuation. Also, how to spread the
--     compuation over many blocks, once the chain reaches a stability point.
module Cardano.Ledger.Shelley.RewardUpdate where

import Cardano.Binary
  ( FromCBOR (..),
    ToCBOR (..),
    encodeListLen,
  )
import Cardano.Ledger.BaseTypes (ProtVer (..), ShelleyBase)
import Cardano.Ledger.Coin (Coin (..), CompactForm, DeltaCoin (..))
import Cardano.Ledger.Compactible (Compactible (fromCompact))
import Cardano.Ledger.Credential (Credential (..))
import qualified Cardano.Ledger.Crypto as CC (Crypto)
import Cardano.Ledger.Keys (KeyHash, KeyRole (..))
import Cardano.Ledger.Serialization (decodeRecordNamed)
import Cardano.Ledger.Shelley.PoolRank (Likelihood, NonMyopic)
import Cardano.Ledger.Shelley.RewardProvenance (RewardProvenancePool (..))
import Cardano.Ledger.Shelley.Rewards
  ( PoolRewardInfo (..),
    Reward (..),
    RewardType (..),
    rewardOnePoolMember,
  )
import Control.DeepSeq (NFData (..))
import Data.Coders
  ( Decode (..),
    Encode (..),
    decode,
    encode,
    mapDecode,
    mapEncode,
    setDecode,
    setEncode,
    vMapDecode,
    vMapEncode,
    (!>),
    (<!),
  )
import Data.Default.Class (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.Sharing (fromNotSharedCBOR)
import Data.Typeable
import Data.VMap as VMap
import GHC.Generics (Generic)
import GHC.Records (HasField (..))
import NoThunks.Class (NoThunks (..), allNoThunks)

-- ===============================================================

type RewardEvent c = (Map (Credential 'Staking c) (Set (Reward c)))

-- | The result of reward calculation is a pair of aggregate Maps.
--   One for the accumulated answer, and one for the answer since the last pulse
data RewardAns c = RewardAns
  { RewardAns c -> Map (Credential 'Staking c) (Reward c)
accumRewardAns :: !(Map (Credential 'Staking c) (Reward c)),
    RewardAns c -> RewardEvent c
recentRewardAns :: !(RewardEvent c)
  }
  deriving (Int -> RewardAns c -> ShowS
[RewardAns c] -> ShowS
RewardAns c -> String
(Int -> RewardAns c -> ShowS)
-> (RewardAns c -> String)
-> ([RewardAns c] -> ShowS)
-> Show (RewardAns c)
forall c. Int -> RewardAns c -> ShowS
forall c. [RewardAns c] -> ShowS
forall c. RewardAns c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RewardAns c] -> ShowS
$cshowList :: forall c. [RewardAns c] -> ShowS
show :: RewardAns c -> String
$cshow :: forall c. RewardAns c -> String
showsPrec :: Int -> RewardAns c -> ShowS
$cshowsPrec :: forall c. Int -> RewardAns c -> ShowS
Show, RewardAns c -> RewardAns c -> Bool
(RewardAns c -> RewardAns c -> Bool)
-> (RewardAns c -> RewardAns c -> Bool) -> Eq (RewardAns c)
forall c. RewardAns c -> RewardAns c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RewardAns c -> RewardAns c -> Bool
$c/= :: forall c. RewardAns c -> RewardAns c -> Bool
== :: RewardAns c -> RewardAns c -> Bool
$c== :: forall c. RewardAns c -> RewardAns c -> Bool
Eq, (forall x. RewardAns c -> Rep (RewardAns c) x)
-> (forall x. Rep (RewardAns c) x -> RewardAns c)
-> Generic (RewardAns c)
forall x. Rep (RewardAns c) x -> RewardAns c
forall x. RewardAns c -> Rep (RewardAns c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (RewardAns c) x -> RewardAns c
forall c x. RewardAns c -> Rep (RewardAns c) x
$cto :: forall c x. Rep (RewardAns c) x -> RewardAns c
$cfrom :: forall c x. RewardAns c -> Rep (RewardAns c) x
Generic)
  deriving (RewardAns c -> ()
(RewardAns c -> ()) -> NFData (RewardAns c)
forall c. RewardAns c -> ()
forall a. (a -> ()) -> NFData a
rnf :: RewardAns c -> ()
$crnf :: forall c. RewardAns c -> ()
NFData)

instance NoThunks (RewardAns crypto)

instance CC.Crypto c => ToCBOR (RewardAns c) where
  toCBOR :: RewardAns c -> Encoding
toCBOR (RewardAns Map (Credential 'Staking c) (Reward c)
accum RewardEvent c
recent) = Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map (Credential 'Staking c) (Reward c) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Map (Credential 'Staking c) (Reward c)
accum Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> RewardEvent c -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR RewardEvent c
recent

instance CC.Crypto c => FromCBOR (RewardAns c) where
  fromCBOR :: Decoder s (RewardAns c)
fromCBOR = Text
-> (RewardAns c -> Int)
-> Decoder s (RewardAns c)
-> Decoder s (RewardAns c)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"RewardAns" (Int -> RewardAns c -> Int
forall a b. a -> b -> a
const Int
2) (Map (Credential 'Staking c) (Reward c)
-> RewardEvent c -> RewardAns c
forall c.
Map (Credential 'Staking c) (Reward c)
-> RewardEvent c -> RewardAns c
RewardAns (Map (Credential 'Staking c) (Reward c)
 -> RewardEvent c -> RewardAns c)
-> Decoder s (Map (Credential 'Staking c) (Reward c))
-> Decoder s (RewardEvent c -> RewardAns c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Map (Credential 'Staking c) (Reward c))
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (RewardEvent c -> RewardAns c)
-> Decoder s (RewardEvent c) -> Decoder s (RewardAns c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (RewardEvent c)
forall a s. FromCBOR a => Decoder s a
fromCBOR)

-- | The provenance we collect
type KeyHashPoolProvenance c = Map (KeyHash 'StakePool c) (RewardProvenancePool c)

-- | The type of RewardPulser we pulse on.
type Pulser c = RewardPulser c ShelleyBase (RewardAns c)

-- =====================================

-- | The ultiate goal of a reward update computation.
--     Aggregating rewards for each staking credential.
data RewardUpdate crypto = RewardUpdate
  { RewardUpdate crypto -> DeltaCoin
deltaT :: !DeltaCoin,
    RewardUpdate crypto -> DeltaCoin
deltaR :: !DeltaCoin,
    RewardUpdate crypto
-> Map (Credential 'Staking crypto) (Set (Reward crypto))
rs :: !(Map (Credential 'Staking crypto) (Set (Reward crypto))),
    RewardUpdate crypto -> DeltaCoin
deltaF :: !DeltaCoin,
    RewardUpdate crypto -> NonMyopic crypto
nonMyopic :: !(NonMyopic crypto)
  }
  deriving (Int -> RewardUpdate crypto -> ShowS
[RewardUpdate crypto] -> ShowS
RewardUpdate crypto -> String
(Int -> RewardUpdate crypto -> ShowS)
-> (RewardUpdate crypto -> String)
-> ([RewardUpdate crypto] -> ShowS)
-> Show (RewardUpdate crypto)
forall crypto. Int -> RewardUpdate crypto -> ShowS
forall crypto. [RewardUpdate crypto] -> ShowS
forall crypto. RewardUpdate crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RewardUpdate crypto] -> ShowS
$cshowList :: forall crypto. [RewardUpdate crypto] -> ShowS
show :: RewardUpdate crypto -> String
$cshow :: forall crypto. RewardUpdate crypto -> String
showsPrec :: Int -> RewardUpdate crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> RewardUpdate crypto -> ShowS
Show, RewardUpdate crypto -> RewardUpdate crypto -> Bool
(RewardUpdate crypto -> RewardUpdate crypto -> Bool)
-> (RewardUpdate crypto -> RewardUpdate crypto -> Bool)
-> Eq (RewardUpdate crypto)
forall crypto. RewardUpdate crypto -> RewardUpdate crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RewardUpdate crypto -> RewardUpdate crypto -> Bool
$c/= :: forall crypto. RewardUpdate crypto -> RewardUpdate crypto -> Bool
== :: RewardUpdate crypto -> RewardUpdate crypto -> Bool
$c== :: forall crypto. RewardUpdate crypto -> RewardUpdate crypto -> Bool
Eq, (forall x. RewardUpdate crypto -> Rep (RewardUpdate crypto) x)
-> (forall x. Rep (RewardUpdate crypto) x -> RewardUpdate crypto)
-> Generic (RewardUpdate crypto)
forall x. Rep (RewardUpdate crypto) x -> RewardUpdate crypto
forall x. RewardUpdate crypto -> Rep (RewardUpdate crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x. Rep (RewardUpdate crypto) x -> RewardUpdate crypto
forall crypto x. RewardUpdate crypto -> Rep (RewardUpdate crypto) x
$cto :: forall crypto x. Rep (RewardUpdate crypto) x -> RewardUpdate crypto
$cfrom :: forall crypto x. RewardUpdate crypto -> Rep (RewardUpdate crypto) x
Generic)

instance NoThunks (RewardUpdate crypto)

instance NFData (RewardUpdate crypto)

instance
  CC.Crypto crypto =>
  ToCBOR (RewardUpdate crypto)
  where
  toCBOR :: RewardUpdate crypto -> Encoding
toCBOR (RewardUpdate DeltaCoin
dt DeltaCoin
dr Map (Credential 'Staking crypto) (Set (Reward crypto))
rw DeltaCoin
df NonMyopic crypto
nm) =
    Word -> Encoding
encodeListLen Word
5
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> DeltaCoin -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR DeltaCoin
dt
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> DeltaCoin -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (DeltaCoin -> DeltaCoin
forall m. Group m => m -> m
invert DeltaCoin
dr) -- TODO change Coin serialization to use integers?
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map (Credential 'Staking crypto) (Set (Reward crypto)) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Map (Credential 'Staking crypto) (Set (Reward crypto))
rw
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> DeltaCoin -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (DeltaCoin -> DeltaCoin
forall m. Group m => m -> m
invert DeltaCoin
df) -- TODO change Coin serialization to use integers?
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> NonMyopic crypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR NonMyopic crypto
nm

instance
  CC.Crypto crypto =>
  FromCBOR (RewardUpdate crypto)
  where
  fromCBOR :: Decoder s (RewardUpdate crypto)
fromCBOR = do
    Text
-> (RewardUpdate crypto -> Int)
-> Decoder s (RewardUpdate crypto)
-> Decoder s (RewardUpdate crypto)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"RewardUpdate" (Int -> RewardUpdate crypto -> Int
forall a b. a -> b -> a
const Int
5) (Decoder s (RewardUpdate crypto)
 -> Decoder s (RewardUpdate crypto))
-> Decoder s (RewardUpdate crypto)
-> Decoder s (RewardUpdate crypto)
forall a b. (a -> b) -> a -> b
$ do
      DeltaCoin
dt <- Decoder s DeltaCoin
forall a s. FromCBOR a => Decoder s a
fromCBOR
      DeltaCoin
dr <- Decoder s DeltaCoin
forall a s. FromCBOR a => Decoder s a
fromCBOR -- TODO change Coin serialization to use integers?
      Map (Credential 'Staking crypto) (Set (Reward crypto))
rw <- Decoder s (Map (Credential 'Staking crypto) (Set (Reward crypto)))
forall a s. FromCBOR a => Decoder s a
fromCBOR
      DeltaCoin
df <- Decoder s DeltaCoin
forall a s. FromCBOR a => Decoder s a
fromCBOR -- TODO change Coin serialization to use integers?
      NonMyopic crypto
nm <- Decoder s (NonMyopic crypto)
forall a s. FromSharedCBOR a => Decoder s a
fromNotSharedCBOR
      RewardUpdate crypto -> Decoder s (RewardUpdate crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RewardUpdate crypto -> Decoder s (RewardUpdate crypto))
-> RewardUpdate crypto -> Decoder s (RewardUpdate crypto)
forall a b. (a -> b) -> a -> b
$ DeltaCoin
-> DeltaCoin
-> Map (Credential 'Staking crypto) (Set (Reward crypto))
-> DeltaCoin
-> NonMyopic crypto
-> RewardUpdate crypto
forall crypto.
DeltaCoin
-> DeltaCoin
-> Map (Credential 'Staking crypto) (Set (Reward crypto))
-> DeltaCoin
-> NonMyopic crypto
-> RewardUpdate crypto
RewardUpdate DeltaCoin
dt (DeltaCoin -> DeltaCoin
forall m. Group m => m -> m
invert DeltaCoin
dr) Map (Credential 'Staking crypto) (Set (Reward crypto))
rw (DeltaCoin -> DeltaCoin
forall m. Group m => m -> m
invert DeltaCoin
df) NonMyopic crypto
nm

emptyRewardUpdate :: RewardUpdate crypto
emptyRewardUpdate :: RewardUpdate crypto
emptyRewardUpdate =
  DeltaCoin
-> DeltaCoin
-> Map (Credential 'Staking crypto) (Set (Reward crypto))
-> DeltaCoin
-> NonMyopic crypto
-> RewardUpdate crypto
forall crypto.
DeltaCoin
-> DeltaCoin
-> Map (Credential 'Staking crypto) (Set (Reward crypto))
-> DeltaCoin
-> NonMyopic crypto
-> RewardUpdate crypto
RewardUpdate (Integer -> DeltaCoin
DeltaCoin Integer
0) (Integer -> DeltaCoin
DeltaCoin Integer
0) Map (Credential 'Staking crypto) (Set (Reward crypto))
forall k a. Map k a
Map.empty (Integer -> DeltaCoin
DeltaCoin Integer
0) NonMyopic crypto
forall a. Default a => a
def

-- ===================================================

-- | To complete the reward update, we need a snap shot of the EpochState particular to this computation
data RewardSnapShot crypto = RewardSnapShot
  { RewardSnapShot crypto -> Coin
rewFees :: !Coin,
    RewardSnapShot crypto -> ProtVer
rewprotocolVersion :: !ProtVer,
    RewardSnapShot crypto -> NonMyopic crypto
rewNonMyopic :: !(NonMyopic crypto),
    RewardSnapShot crypto -> Coin
rewDeltaR1 :: !Coin, -- deltaR1
    RewardSnapShot crypto -> Coin
rewR :: !Coin, -- r
    RewardSnapShot crypto -> Coin
rewDeltaT1 :: !Coin, -- deltaT1
    RewardSnapShot crypto -> Map (KeyHash 'StakePool crypto) Likelihood
rewLikelihoods :: !(Map (KeyHash 'StakePool crypto) Likelihood),
    RewardSnapShot crypto
-> Map (Credential 'Staking crypto) (Set (Reward crypto))
rewLeaders :: !(Map (Credential 'Staking crypto) (Set (Reward crypto)))
  }
  deriving (Int -> RewardSnapShot crypto -> ShowS
[RewardSnapShot crypto] -> ShowS
RewardSnapShot crypto -> String
(Int -> RewardSnapShot crypto -> ShowS)
-> (RewardSnapShot crypto -> String)
-> ([RewardSnapShot crypto] -> ShowS)
-> Show (RewardSnapShot crypto)
forall crypto. Int -> RewardSnapShot crypto -> ShowS
forall crypto. [RewardSnapShot crypto] -> ShowS
forall crypto. RewardSnapShot crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RewardSnapShot crypto] -> ShowS
$cshowList :: forall crypto. [RewardSnapShot crypto] -> ShowS
show :: RewardSnapShot crypto -> String
$cshow :: forall crypto. RewardSnapShot crypto -> String
showsPrec :: Int -> RewardSnapShot crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> RewardSnapShot crypto -> ShowS
Show, RewardSnapShot crypto -> RewardSnapShot crypto -> Bool
(RewardSnapShot crypto -> RewardSnapShot crypto -> Bool)
-> (RewardSnapShot crypto -> RewardSnapShot crypto -> Bool)
-> Eq (RewardSnapShot crypto)
forall crypto.
RewardSnapShot crypto -> RewardSnapShot crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RewardSnapShot crypto -> RewardSnapShot crypto -> Bool
$c/= :: forall crypto.
RewardSnapShot crypto -> RewardSnapShot crypto -> Bool
== :: RewardSnapShot crypto -> RewardSnapShot crypto -> Bool
$c== :: forall crypto.
RewardSnapShot crypto -> RewardSnapShot crypto -> Bool
Eq, (forall x. RewardSnapShot crypto -> Rep (RewardSnapShot crypto) x)
-> (forall x.
    Rep (RewardSnapShot crypto) x -> RewardSnapShot crypto)
-> Generic (RewardSnapShot crypto)
forall x. Rep (RewardSnapShot crypto) x -> RewardSnapShot crypto
forall x. RewardSnapShot crypto -> Rep (RewardSnapShot crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x.
Rep (RewardSnapShot crypto) x -> RewardSnapShot crypto
forall crypto x.
RewardSnapShot crypto -> Rep (RewardSnapShot crypto) x
$cto :: forall crypto x.
Rep (RewardSnapShot crypto) x -> RewardSnapShot crypto
$cfrom :: forall crypto x.
RewardSnapShot crypto -> Rep (RewardSnapShot crypto) x
Generic)

instance Typeable crypto => NoThunks (RewardSnapShot crypto)

instance NFData (RewardSnapShot crypto)

instance CC.Crypto crypto => ToCBOR (RewardSnapShot crypto) where
  toCBOR :: RewardSnapShot crypto -> Encoding
toCBOR (RewardSnapShot Coin
fees ProtVer
ver NonMyopic crypto
nm Coin
dr1 Coin
r Coin
dt1 Map (KeyHash 'StakePool crypto) Likelihood
lhs Map (Credential 'Staking crypto) (Set (Reward crypto))
lrs) =
    Encode ('Closed 'Dense) (RewardSnapShot crypto) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode
      ( (Coin
 -> ProtVer
 -> NonMyopic crypto
 -> Coin
 -> Coin
 -> Coin
 -> Map (KeyHash 'StakePool crypto) Likelihood
 -> Map (Credential 'Staking crypto) (Set (Reward crypto))
 -> RewardSnapShot crypto)
-> Encode
     ('Closed 'Dense)
     (Coin
      -> ProtVer
      -> NonMyopic crypto
      -> Coin
      -> Coin
      -> Coin
      -> Map (KeyHash 'StakePool crypto) Likelihood
      -> Map (Credential 'Staking crypto) (Set (Reward crypto))
      -> RewardSnapShot crypto)
forall t. t -> Encode ('Closed 'Dense) t
Rec Coin
-> ProtVer
-> NonMyopic crypto
-> Coin
-> Coin
-> Coin
-> Map (KeyHash 'StakePool crypto) Likelihood
-> Map (Credential 'Staking crypto) (Set (Reward crypto))
-> RewardSnapShot crypto
forall crypto.
Coin
-> ProtVer
-> NonMyopic crypto
-> Coin
-> Coin
-> Coin
-> Map (KeyHash 'StakePool crypto) Likelihood
-> Map (Credential 'Staking crypto) (Set (Reward crypto))
-> RewardSnapShot crypto
RewardSnapShot
          Encode
  ('Closed 'Dense)
  (Coin
   -> ProtVer
   -> NonMyopic crypto
   -> Coin
   -> Coin
   -> Coin
   -> Map (KeyHash 'StakePool crypto) Likelihood
   -> Map (Credential 'Staking crypto) (Set (Reward crypto))
   -> RewardSnapShot crypto)
-> Encode ('Closed 'Dense) Coin
-> Encode
     ('Closed 'Dense)
     (ProtVer
      -> NonMyopic crypto
      -> Coin
      -> Coin
      -> Coin
      -> Map (KeyHash 'StakePool crypto) Likelihood
      -> Map (Credential 'Staking crypto) (Set (Reward crypto))
      -> RewardSnapShot crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Coin -> Encode ('Closed 'Dense) Coin
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
fees
          Encode
  ('Closed 'Dense)
  (ProtVer
   -> NonMyopic crypto
   -> Coin
   -> Coin
   -> Coin
   -> Map (KeyHash 'StakePool crypto) Likelihood
   -> Map (Credential 'Staking crypto) (Set (Reward crypto))
   -> RewardSnapShot crypto)
-> Encode ('Closed 'Dense) ProtVer
-> Encode
     ('Closed 'Dense)
     (NonMyopic crypto
      -> Coin
      -> Coin
      -> Coin
      -> Map (KeyHash 'StakePool crypto) Likelihood
      -> Map (Credential 'Staking crypto) (Set (Reward crypto))
      -> RewardSnapShot crypto)
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. ToCBOR t => t -> Encode ('Closed 'Dense) t
To ProtVer
ver
          Encode
  ('Closed 'Dense)
  (NonMyopic crypto
   -> Coin
   -> Coin
   -> Coin
   -> Map (KeyHash 'StakePool crypto) Likelihood
   -> Map (Credential 'Staking crypto) (Set (Reward crypto))
   -> RewardSnapShot crypto)
-> Encode ('Closed 'Dense) (NonMyopic crypto)
-> Encode
     ('Closed 'Dense)
     (Coin
      -> Coin
      -> Coin
      -> Map (KeyHash 'StakePool crypto) Likelihood
      -> Map (Credential 'Staking crypto) (Set (Reward crypto))
      -> RewardSnapShot crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> NonMyopic crypto -> Encode ('Closed 'Dense) (NonMyopic crypto)
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To NonMyopic crypto
nm
          Encode
  ('Closed 'Dense)
  (Coin
   -> Coin
   -> Coin
   -> Map (KeyHash 'StakePool crypto) Likelihood
   -> Map (Credential 'Staking crypto) (Set (Reward crypto))
   -> RewardSnapShot crypto)
-> Encode ('Closed 'Dense) Coin
-> Encode
     ('Closed 'Dense)
     (Coin
      -> Coin
      -> Map (KeyHash 'StakePool crypto) Likelihood
      -> Map (Credential 'Staking crypto) (Set (Reward crypto))
      -> RewardSnapShot crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Coin -> Encode ('Closed 'Dense) Coin
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
dr1
          Encode
  ('Closed 'Dense)
  (Coin
   -> Coin
   -> Map (KeyHash 'StakePool crypto) Likelihood
   -> Map (Credential 'Staking crypto) (Set (Reward crypto))
   -> RewardSnapShot crypto)
-> Encode ('Closed 'Dense) Coin
-> Encode
     ('Closed 'Dense)
     (Coin
      -> Map (KeyHash 'StakePool crypto) Likelihood
      -> Map (Credential 'Staking crypto) (Set (Reward crypto))
      -> RewardSnapShot crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Coin -> Encode ('Closed 'Dense) Coin
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
r
          Encode
  ('Closed 'Dense)
  (Coin
   -> Map (KeyHash 'StakePool crypto) Likelihood
   -> Map (Credential 'Staking crypto) (Set (Reward crypto))
   -> RewardSnapShot crypto)
-> Encode ('Closed 'Dense) Coin
-> Encode
     ('Closed 'Dense)
     (Map (KeyHash 'StakePool crypto) Likelihood
      -> Map (Credential 'Staking crypto) (Set (Reward crypto))
      -> RewardSnapShot crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Coin -> Encode ('Closed 'Dense) Coin
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
dt1
          Encode
  ('Closed 'Dense)
  (Map (KeyHash 'StakePool crypto) Likelihood
   -> Map (Credential 'Staking crypto) (Set (Reward crypto))
   -> RewardSnapShot crypto)
-> Encode
     ('Closed 'Dense) (Map (KeyHash 'StakePool crypto) Likelihood)
-> Encode
     ('Closed 'Dense)
     (Map (Credential 'Staking crypto) (Set (Reward crypto))
      -> RewardSnapShot crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Map (KeyHash 'StakePool crypto) Likelihood
-> Encode
     ('Closed 'Dense) (Map (KeyHash 'StakePool crypto) Likelihood)
forall k v.
(ToCBOR k, ToCBOR v) =>
Map k v -> Encode ('Closed 'Dense) (Map k v)
mapEncode Map (KeyHash 'StakePool crypto) Likelihood
lhs
          Encode
  ('Closed 'Dense)
  (Map (Credential 'Staking crypto) (Set (Reward crypto))
   -> RewardSnapShot crypto)
-> Encode
     ('Closed 'Dense)
     (Map (Credential 'Staking crypto) (Set (Reward crypto)))
-> Encode ('Closed 'Dense) (RewardSnapShot crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Map (Credential 'Staking crypto) (Set (Reward crypto))
-> Encode
     ('Closed 'Dense)
     (Map (Credential 'Staking crypto) (Set (Reward crypto)))
forall k v.
(ToCBOR k, ToCBOR v) =>
Map k v -> Encode ('Closed 'Dense) (Map k v)
mapEncode Map (Credential 'Staking crypto) (Set (Reward crypto))
lrs
      )

instance CC.Crypto crypto => FromCBOR (RewardSnapShot crypto) where
  fromCBOR :: Decoder s (RewardSnapShot crypto)
fromCBOR =
    Decode ('Closed 'Dense) (RewardSnapShot crypto)
-> Decoder s (RewardSnapShot crypto)
forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode
      ( (Coin
 -> ProtVer
 -> NonMyopic crypto
 -> Coin
 -> Coin
 -> Coin
 -> Map (KeyHash 'StakePool crypto) Likelihood
 -> Map (Credential 'Staking crypto) (Set (Reward crypto))
 -> RewardSnapShot crypto)
-> Decode
     ('Closed 'Dense)
     (Coin
      -> ProtVer
      -> NonMyopic crypto
      -> Coin
      -> Coin
      -> Coin
      -> Map (KeyHash 'StakePool crypto) Likelihood
      -> Map (Credential 'Staking crypto) (Set (Reward crypto))
      -> RewardSnapShot crypto)
forall t. t -> Decode ('Closed 'Dense) t
RecD Coin
-> ProtVer
-> NonMyopic crypto
-> Coin
-> Coin
-> Coin
-> Map (KeyHash 'StakePool crypto) Likelihood
-> Map (Credential 'Staking crypto) (Set (Reward crypto))
-> RewardSnapShot crypto
forall crypto.
Coin
-> ProtVer
-> NonMyopic crypto
-> Coin
-> Coin
-> Coin
-> Map (KeyHash 'StakePool crypto) Likelihood
-> Map (Credential 'Staking crypto) (Set (Reward crypto))
-> RewardSnapShot crypto
RewardSnapShot
          Decode
  ('Closed 'Dense)
  (Coin
   -> ProtVer
   -> NonMyopic crypto
   -> Coin
   -> Coin
   -> Coin
   -> Map (KeyHash 'StakePool crypto) Likelihood
   -> Map (Credential 'Staking crypto) (Set (Reward crypto))
   -> RewardSnapShot crypto)
-> Decode ('Closed Any) Coin
-> Decode
     ('Closed 'Dense)
     (ProtVer
      -> NonMyopic crypto
      -> Coin
      -> Coin
      -> Coin
      -> Map (KeyHash 'StakePool crypto) Likelihood
      -> Map (Credential 'Staking crypto) (Set (Reward crypto))
      -> RewardSnapShot crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Coin
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
          Decode
  ('Closed 'Dense)
  (ProtVer
   -> NonMyopic crypto
   -> Coin
   -> Coin
   -> Coin
   -> Map (KeyHash 'StakePool crypto) Likelihood
   -> Map (Credential 'Staking crypto) (Set (Reward crypto))
   -> RewardSnapShot crypto)
-> Decode ('Closed Any) ProtVer
-> Decode
     ('Closed 'Dense)
     (NonMyopic crypto
      -> Coin
      -> Coin
      -> Coin
      -> Map (KeyHash 'StakePool crypto) Likelihood
      -> Map (Credential 'Staking crypto) (Set (Reward crypto))
      -> RewardSnapShot crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) ProtVer
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
          Decode
  ('Closed 'Dense)
  (NonMyopic crypto
   -> Coin
   -> Coin
   -> Coin
   -> Map (KeyHash 'StakePool crypto) Likelihood
   -> Map (Credential 'Staking crypto) (Set (Reward crypto))
   -> RewardSnapShot crypto)
-> Decode ('Closed 'Dense) (NonMyopic crypto)
-> Decode
     ('Closed 'Dense)
     (Coin
      -> Coin
      -> Coin
      -> Map (KeyHash 'StakePool crypto) Likelihood
      -> Map (Credential 'Staking crypto) (Set (Reward crypto))
      -> RewardSnapShot crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s. Decoder s (NonMyopic crypto))
-> Decode ('Closed 'Dense) (NonMyopic crypto)
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D forall s. Decoder s (NonMyopic crypto)
forall a s. FromSharedCBOR a => Decoder s a
fromNotSharedCBOR
          Decode
  ('Closed 'Dense)
  (Coin
   -> Coin
   -> Coin
   -> Map (KeyHash 'StakePool crypto) Likelihood
   -> Map (Credential 'Staking crypto) (Set (Reward crypto))
   -> RewardSnapShot crypto)
-> Decode ('Closed Any) Coin
-> Decode
     ('Closed 'Dense)
     (Coin
      -> Coin
      -> Map (KeyHash 'StakePool crypto) Likelihood
      -> Map (Credential 'Staking crypto) (Set (Reward crypto))
      -> RewardSnapShot crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Coin
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
          Decode
  ('Closed 'Dense)
  (Coin
   -> Coin
   -> Map (KeyHash 'StakePool crypto) Likelihood
   -> Map (Credential 'Staking crypto) (Set (Reward crypto))
   -> RewardSnapShot crypto)
-> Decode ('Closed Any) Coin
-> Decode
     ('Closed 'Dense)
     (Coin
      -> Map (KeyHash 'StakePool crypto) Likelihood
      -> Map (Credential 'Staking crypto) (Set (Reward crypto))
      -> RewardSnapShot crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Coin
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
          Decode
  ('Closed 'Dense)
  (Coin
   -> Map (KeyHash 'StakePool crypto) Likelihood
   -> Map (Credential 'Staking crypto) (Set (Reward crypto))
   -> RewardSnapShot crypto)
-> Decode ('Closed Any) Coin
-> Decode
     ('Closed 'Dense)
     (Map (KeyHash 'StakePool crypto) Likelihood
      -> Map (Credential 'Staking crypto) (Set (Reward crypto))
      -> RewardSnapShot crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Coin
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
          Decode
  ('Closed 'Dense)
  (Map (KeyHash 'StakePool crypto) Likelihood
   -> Map (Credential 'Staking crypto) (Set (Reward crypto))
   -> RewardSnapShot crypto)
-> Decode
     ('Closed 'Dense) (Map (KeyHash 'StakePool crypto) Likelihood)
-> Decode
     ('Closed 'Dense)
     (Map (Credential 'Staking crypto) (Set (Reward crypto))
      -> RewardSnapShot crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode
  ('Closed 'Dense) (Map (KeyHash 'StakePool crypto) Likelihood)
forall k v.
(Ord k, FromCBOR k, FromCBOR v) =>
Decode ('Closed 'Dense) (Map k v)
mapDecode
          Decode
  ('Closed 'Dense)
  (Map (Credential 'Staking crypto) (Set (Reward crypto))
   -> RewardSnapShot crypto)
-> Decode
     ('Closed 'Dense)
     (Map (Credential 'Staking crypto) (Set (Reward crypto)))
-> Decode ('Closed 'Dense) (RewardSnapShot crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode
  ('Closed 'Dense)
  (Map (Credential 'Staking crypto) (Set (Reward crypto)))
forall k v.
(Ord k, FromCBOR k, FromCBOR v) =>
Decode ('Closed 'Dense) (Map k v)
mapDecode
      )

-- | RewardSnapShot can act as a Proxy for PParams when only the protocol version is needed.
instance HasField "_protocolVersion" (RewardSnapShot crypto) ProtVer where
  getField :: RewardSnapShot crypto -> ProtVer
getField RewardSnapShot crypto
x = RewardSnapShot crypto -> ProtVer
forall crypto. RewardSnapShot crypto -> ProtVer
rewprotocolVersion RewardSnapShot crypto
x

-- ========================================================
-- FreeVars is the set of variables needed to compute
-- rewardStakePool, so that it can be made into a serializable
-- Pulsable function.

data FreeVars crypto = FreeVars
  { FreeVars crypto
-> VMap
     VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
delegs :: !(VMap VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)),
    FreeVars crypto -> Set (Credential 'Staking crypto)
addrsRew :: !(Set (Credential 'Staking crypto)),
    FreeVars crypto -> Integer
totalStake :: !Integer,
    FreeVars crypto -> ProtVer
pp_pv :: !ProtVer,
    FreeVars crypto
-> Map (KeyHash 'StakePool crypto) (PoolRewardInfo crypto)
poolRewardInfo :: !(Map (KeyHash 'StakePool crypto) (PoolRewardInfo crypto))
  }
  deriving (FreeVars crypto -> FreeVars crypto -> Bool
(FreeVars crypto -> FreeVars crypto -> Bool)
-> (FreeVars crypto -> FreeVars crypto -> Bool)
-> Eq (FreeVars crypto)
forall crypto. FreeVars crypto -> FreeVars crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FreeVars crypto -> FreeVars crypto -> Bool
$c/= :: forall crypto. FreeVars crypto -> FreeVars crypto -> Bool
== :: FreeVars crypto -> FreeVars crypto -> Bool
$c== :: forall crypto. FreeVars crypto -> FreeVars crypto -> Bool
Eq, Int -> FreeVars crypto -> ShowS
[FreeVars crypto] -> ShowS
FreeVars crypto -> String
(Int -> FreeVars crypto -> ShowS)
-> (FreeVars crypto -> String)
-> ([FreeVars crypto] -> ShowS)
-> Show (FreeVars crypto)
forall crypto. Int -> FreeVars crypto -> ShowS
forall crypto. [FreeVars crypto] -> ShowS
forall crypto. FreeVars crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FreeVars crypto] -> ShowS
$cshowList :: forall crypto. [FreeVars crypto] -> ShowS
show :: FreeVars crypto -> String
$cshow :: forall crypto. FreeVars crypto -> String
showsPrec :: Int -> FreeVars crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> FreeVars crypto -> ShowS
Show, (forall x. FreeVars crypto -> Rep (FreeVars crypto) x)
-> (forall x. Rep (FreeVars crypto) x -> FreeVars crypto)
-> Generic (FreeVars crypto)
forall x. Rep (FreeVars crypto) x -> FreeVars crypto
forall x. FreeVars crypto -> Rep (FreeVars crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x. Rep (FreeVars crypto) x -> FreeVars crypto
forall crypto x. FreeVars crypto -> Rep (FreeVars crypto) x
$cto :: forall crypto x. Rep (FreeVars crypto) x -> FreeVars crypto
$cfrom :: forall crypto x. FreeVars crypto -> Rep (FreeVars crypto) x
Generic)
  deriving (Context -> FreeVars crypto -> IO (Maybe ThunkInfo)
Proxy (FreeVars crypto) -> String
(Context -> FreeVars crypto -> IO (Maybe ThunkInfo))
-> (Context -> FreeVars crypto -> IO (Maybe ThunkInfo))
-> (Proxy (FreeVars crypto) -> String)
-> NoThunks (FreeVars crypto)
forall crypto.
Typeable crypto =>
Context -> FreeVars crypto -> IO (Maybe ThunkInfo)
forall crypto. Typeable crypto => Proxy (FreeVars crypto) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (FreeVars crypto) -> String
$cshowTypeOf :: forall crypto. Typeable crypto => Proxy (FreeVars crypto) -> String
wNoThunks :: Context -> FreeVars crypto -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall crypto.
Typeable crypto =>
Context -> FreeVars crypto -> IO (Maybe ThunkInfo)
noThunks :: Context -> FreeVars crypto -> IO (Maybe ThunkInfo)
$cnoThunks :: forall crypto.
Typeable crypto =>
Context -> FreeVars crypto -> IO (Maybe ThunkInfo)
NoThunks)

-- | FreeVars can act as a Proxy for PParams when only the protocol version is needed.
instance HasField "_protocolVersion" (FreeVars crypto) ProtVer where
  getField :: FreeVars crypto -> ProtVer
getField = FreeVars crypto -> ProtVer
forall crypto. FreeVars crypto -> ProtVer
pp_pv

instance NFData (FreeVars crypto)

instance (CC.Crypto crypto) => ToCBOR (FreeVars crypto) where
  toCBOR :: FreeVars crypto -> Encoding
toCBOR
    FreeVars
      { VMap VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
delegs :: VMap VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
delegs :: forall crypto.
FreeVars crypto
-> VMap
     VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
delegs,
        Set (Credential 'Staking crypto)
addrsRew :: Set (Credential 'Staking crypto)
addrsRew :: forall crypto. FreeVars crypto -> Set (Credential 'Staking crypto)
addrsRew,
        Integer
totalStake :: Integer
totalStake :: forall crypto. FreeVars crypto -> Integer
totalStake,
        ProtVer
pp_pv :: ProtVer
pp_pv :: forall crypto. FreeVars crypto -> ProtVer
pp_pv,
        Map (KeyHash 'StakePool crypto) (PoolRewardInfo crypto)
poolRewardInfo :: Map (KeyHash 'StakePool crypto) (PoolRewardInfo crypto)
poolRewardInfo :: forall crypto.
FreeVars crypto
-> Map (KeyHash 'StakePool crypto) (PoolRewardInfo crypto)
poolRewardInfo
      } =
      Encode ('Closed 'Dense) (FreeVars crypto) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode
        ( (VMap
   VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
 -> Set (Credential 'Staking crypto)
 -> Integer
 -> ProtVer
 -> Map (KeyHash 'StakePool crypto) (PoolRewardInfo crypto)
 -> FreeVars crypto)
-> Encode
     ('Closed 'Dense)
     (VMap
        VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
      -> Set (Credential 'Staking crypto)
      -> Integer
      -> ProtVer
      -> Map (KeyHash 'StakePool crypto) (PoolRewardInfo crypto)
      -> FreeVars crypto)
forall t. t -> Encode ('Closed 'Dense) t
Rec VMap VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
-> Set (Credential 'Staking crypto)
-> Integer
-> ProtVer
-> Map (KeyHash 'StakePool crypto) (PoolRewardInfo crypto)
-> FreeVars crypto
forall crypto.
VMap VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
-> Set (Credential 'Staking crypto)
-> Integer
-> ProtVer
-> Map (KeyHash 'StakePool crypto) (PoolRewardInfo crypto)
-> FreeVars crypto
FreeVars
            Encode
  ('Closed 'Dense)
  (VMap
     VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
   -> Set (Credential 'Staking crypto)
   -> Integer
   -> ProtVer
   -> Map (KeyHash 'StakePool crypto) (PoolRewardInfo crypto)
   -> FreeVars crypto)
-> Encode
     ('Closed 'Dense)
     (VMap
        VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto))
-> Encode
     ('Closed 'Dense)
     (Set (Credential 'Staking crypto)
      -> Integer
      -> ProtVer
      -> Map (KeyHash 'StakePool crypto) (PoolRewardInfo crypto)
      -> FreeVars crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> VMap VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
-> Encode
     ('Closed 'Dense)
     (VMap
        VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto))
forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v, ToCBOR k, ToCBOR v) =>
VMap kv vv k v -> Encode ('Closed 'Dense) (VMap kv vv k v)
vMapEncode VMap VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
delegs
            Encode
  ('Closed 'Dense)
  (Set (Credential 'Staking crypto)
   -> Integer
   -> ProtVer
   -> Map (KeyHash 'StakePool crypto) (PoolRewardInfo crypto)
   -> FreeVars crypto)
-> Encode ('Closed 'Dense) (Set (Credential 'Staking crypto))
-> Encode
     ('Closed 'Dense)
     (Integer
      -> ProtVer
      -> Map (KeyHash 'StakePool crypto) (PoolRewardInfo crypto)
      -> FreeVars crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Set (Credential 'Staking crypto)
-> Encode ('Closed 'Dense) (Set (Credential 'Staking crypto))
forall v. ToCBOR v => Set v -> Encode ('Closed 'Dense) (Set v)
setEncode Set (Credential 'Staking crypto)
addrsRew
            Encode
  ('Closed 'Dense)
  (Integer
   -> ProtVer
   -> Map (KeyHash 'StakePool crypto) (PoolRewardInfo crypto)
   -> FreeVars crypto)
-> Encode ('Closed 'Dense) Integer
-> Encode
     ('Closed 'Dense)
     (ProtVer
      -> Map (KeyHash 'StakePool crypto) (PoolRewardInfo crypto)
      -> FreeVars crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Integer -> Encode ('Closed 'Dense) Integer
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Integer
totalStake
            Encode
  ('Closed 'Dense)
  (ProtVer
   -> Map (KeyHash 'StakePool crypto) (PoolRewardInfo crypto)
   -> FreeVars crypto)
-> Encode ('Closed 'Dense) ProtVer
-> Encode
     ('Closed 'Dense)
     (Map (KeyHash 'StakePool crypto) (PoolRewardInfo crypto)
      -> FreeVars crypto)
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. ToCBOR t => t -> Encode ('Closed 'Dense) t
To ProtVer
pp_pv
            Encode
  ('Closed 'Dense)
  (Map (KeyHash 'StakePool crypto) (PoolRewardInfo crypto)
   -> FreeVars crypto)
-> Encode
     ('Closed 'Dense)
     (Map (KeyHash 'StakePool crypto) (PoolRewardInfo crypto))
-> Encode ('Closed 'Dense) (FreeVars crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Map (KeyHash 'StakePool crypto) (PoolRewardInfo crypto)
-> Encode
     ('Closed 'Dense)
     (Map (KeyHash 'StakePool crypto) (PoolRewardInfo crypto))
forall k v.
(ToCBOR k, ToCBOR v) =>
Map k v -> Encode ('Closed 'Dense) (Map k v)
mapEncode Map (KeyHash 'StakePool crypto) (PoolRewardInfo crypto)
poolRewardInfo
        )

instance (CC.Crypto crypto) => FromCBOR (FreeVars crypto) where
  fromCBOR :: Decoder s (FreeVars crypto)
fromCBOR =
    Decode ('Closed 'Dense) (FreeVars crypto)
-> Decoder s (FreeVars crypto)
forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode
      ( (VMap
   VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
 -> Set (Credential 'Staking crypto)
 -> Integer
 -> ProtVer
 -> Map (KeyHash 'StakePool crypto) (PoolRewardInfo crypto)
 -> FreeVars crypto)
-> Decode
     ('Closed 'Dense)
     (VMap
        VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
      -> Set (Credential 'Staking crypto)
      -> Integer
      -> ProtVer
      -> Map (KeyHash 'StakePool crypto) (PoolRewardInfo crypto)
      -> FreeVars crypto)
forall t. t -> Decode ('Closed 'Dense) t
RecD VMap VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
-> Set (Credential 'Staking crypto)
-> Integer
-> ProtVer
-> Map (KeyHash 'StakePool crypto) (PoolRewardInfo crypto)
-> FreeVars crypto
forall crypto.
VMap VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
-> Set (Credential 'Staking crypto)
-> Integer
-> ProtVer
-> Map (KeyHash 'StakePool crypto) (PoolRewardInfo crypto)
-> FreeVars crypto
FreeVars
          Decode
  ('Closed 'Dense)
  (VMap
     VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
   -> Set (Credential 'Staking crypto)
   -> Integer
   -> ProtVer
   -> Map (KeyHash 'StakePool crypto) (PoolRewardInfo crypto)
   -> FreeVars crypto)
-> Decode
     ('Closed 'Dense)
     (VMap
        VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto))
-> Decode
     ('Closed 'Dense)
     (Set (Credential 'Staking crypto)
      -> Integer
      -> ProtVer
      -> Map (KeyHash 'StakePool crypto) (PoolRewardInfo crypto)
      -> FreeVars crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode
  ('Closed 'Dense)
  (VMap
     VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto))
forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v, Ord k, FromCBOR k, FromCBOR v) =>
Decode ('Closed 'Dense) (VMap kv vv k v)
vMapDecode {- delegs -}
          Decode
  ('Closed 'Dense)
  (Set (Credential 'Staking crypto)
   -> Integer
   -> ProtVer
   -> Map (KeyHash 'StakePool crypto) (PoolRewardInfo crypto)
   -> FreeVars crypto)
-> Decode ('Closed 'Dense) (Set (Credential 'Staking crypto))
-> Decode
     ('Closed 'Dense)
     (Integer
      -> ProtVer
      -> Map (KeyHash 'StakePool crypto) (PoolRewardInfo crypto)
      -> FreeVars crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed 'Dense) (Set (Credential 'Staking crypto))
forall v. (Ord v, FromCBOR v) => Decode ('Closed 'Dense) (Set v)
setDecode {- addrsRew -}
          Decode
  ('Closed 'Dense)
  (Integer
   -> ProtVer
   -> Map (KeyHash 'StakePool crypto) (PoolRewardInfo crypto)
   -> FreeVars crypto)
-> Decode ('Closed Any) Integer
-> Decode
     ('Closed 'Dense)
     (ProtVer
      -> Map (KeyHash 'StakePool crypto) (PoolRewardInfo crypto)
      -> FreeVars crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Integer
forall t (w :: Wrapped). FromCBOR t => Decode w t
From {- totalStake -}
          Decode
  ('Closed 'Dense)
  (ProtVer
   -> Map (KeyHash 'StakePool crypto) (PoolRewardInfo crypto)
   -> FreeVars crypto)
-> Decode ('Closed Any) ProtVer
-> Decode
     ('Closed 'Dense)
     (Map (KeyHash 'StakePool crypto) (PoolRewardInfo crypto)
      -> FreeVars crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) ProtVer
forall t (w :: Wrapped). FromCBOR t => Decode w t
From {- pp_pv -}
          Decode
  ('Closed 'Dense)
  (Map (KeyHash 'StakePool crypto) (PoolRewardInfo crypto)
   -> FreeVars crypto)
-> Decode
     ('Closed 'Dense)
     (Map (KeyHash 'StakePool crypto) (PoolRewardInfo crypto))
-> Decode ('Closed 'Dense) (FreeVars crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode
  ('Closed 'Dense)
  (Map (KeyHash 'StakePool crypto) (PoolRewardInfo crypto))
forall k v.
(Ord k, FromCBOR k, FromCBOR v) =>
Decode ('Closed 'Dense) (Map k v)
mapDecode {- poolRewardInfo -}
      )

-- =====================================================================

-- | The function to call on each reward update pulse. Called by the pulser.
rewardStakePoolMember ::
  FreeVars c ->
  RewardAns c ->
  Credential 'Staking c ->
  CompactForm Coin ->
  RewardAns c
rewardStakePoolMember :: FreeVars c
-> RewardAns c
-> Credential 'Staking c
-> CompactForm Coin
-> RewardAns c
rewardStakePoolMember
  pp :: FreeVars c
pp@FreeVars
    { VMap VB VB (Credential 'Staking c) (KeyHash 'StakePool c)
delegs :: VMap VB VB (Credential 'Staking c) (KeyHash 'StakePool c)
delegs :: forall crypto.
FreeVars crypto
-> VMap
     VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
delegs,
      Set (Credential 'Staking c)
addrsRew :: Set (Credential 'Staking c)
addrsRew :: forall crypto. FreeVars crypto -> Set (Credential 'Staking crypto)
addrsRew,
      Integer
totalStake :: Integer
totalStake :: forall crypto. FreeVars crypto -> Integer
totalStake,
      Map (KeyHash 'StakePool c) (PoolRewardInfo c)
poolRewardInfo :: Map (KeyHash 'StakePool c) (PoolRewardInfo c)
poolRewardInfo :: forall crypto.
FreeVars crypto
-> Map (KeyHash 'StakePool crypto) (PoolRewardInfo crypto)
poolRewardInfo
    }
  inputanswer :: RewardAns c
inputanswer@(RewardAns Map (Credential 'Staking c) (Reward c)
accum RewardEvent c
recent)
  Credential 'Staking c
cred
  CompactForm Coin
c = RewardAns c -> Maybe (RewardAns c) -> RewardAns c
forall a. a -> Maybe a -> a
fromMaybe RewardAns c
inputanswer (Maybe (RewardAns c) -> RewardAns c)
-> Maybe (RewardAns c) -> RewardAns c
forall a b. (a -> b) -> a -> b
$ do
    KeyHash 'StakePool c
poolID <- Credential 'Staking c
-> VMap VB VB (Credential 'Staking c) (KeyHash 'StakePool c)
-> Maybe (KeyHash 'StakePool c)
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 c
cred VMap VB VB (Credential 'Staking c) (KeyHash 'StakePool c)
delegs
    PoolRewardInfo c
poolRI <- KeyHash 'StakePool c
-> Map (KeyHash 'StakePool c) (PoolRewardInfo c)
-> Maybe (PoolRewardInfo c)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash 'StakePool c
poolID Map (KeyHash 'StakePool c) (PoolRewardInfo c)
poolRewardInfo
    Coin
r <- FreeVars c
-> Coin
-> Set (Credential 'Staking c)
-> PoolRewardInfo c
-> Credential 'Staking c
-> Coin
-> Maybe Coin
forall pp c.
HasField "_protocolVersion" pp ProtVer =>
pp
-> Coin
-> Set (Credential 'Staking c)
-> PoolRewardInfo c
-> Credential 'Staking c
-> Coin
-> Maybe Coin
rewardOnePoolMember FreeVars c
pp (Integer -> Coin
Coin Integer
totalStake) Set (Credential 'Staking c)
addrsRew PoolRewardInfo c
poolRI Credential 'Staking c
cred (CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm Coin
c)
    let ans :: Reward c
ans = RewardType -> KeyHash 'StakePool c -> Coin -> Reward c
forall crypto.
RewardType -> KeyHash 'StakePool crypto -> Coin -> Reward crypto
Reward RewardType
MemberReward KeyHash 'StakePool c
poolID Coin
r
    -- There is always just 1 member reward, so Set.singleton is appropriate
    RewardAns c -> Maybe (RewardAns c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RewardAns c -> Maybe (RewardAns c))
-> RewardAns c -> Maybe (RewardAns c)
forall a b. (a -> b) -> a -> b
$ Map (Credential 'Staking c) (Reward c)
-> RewardEvent c -> RewardAns c
forall c.
Map (Credential 'Staking c) (Reward c)
-> RewardEvent c -> RewardAns c
RewardAns (Credential 'Staking c
-> Reward c
-> Map (Credential 'Staking c) (Reward c)
-> Map (Credential 'Staking c) (Reward c)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Credential 'Staking c
cred Reward c
ans Map (Credential 'Staking c) (Reward c)
accum) (Credential 'Staking c
-> Set (Reward c) -> RewardEvent c -> RewardEvent c
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Credential 'Staking c
cred (Reward c -> Set (Reward c)
forall a. a -> Set a
Set.singleton Reward c
ans) RewardEvent c
recent)

-- ================================================================

-- | The type of a Pulser which uses 'rewardStakePoolMember' as its underlying function.
--     'rewardStakePool' will be partially applied to the component of type
--     (FreeVars c) when pulsing. Note that we use two type equality (~) constraints
--     to fix both the monad 'm' and the 'ans' type, to the context where we will use
--     the type as a Pulser. The type must have 'm' and 'ans' as its last two
--     parameters so we can make a Pulsable instance.
--     RSPL = Reward Serializable Listbased Pulser
data RewardPulser c (m :: Type -> Type) ans where
  RSLP ::
    (ans ~ RewardAns c, m ~ ShelleyBase) =>
    !Int ->
    !(FreeVars c) ->
    !(VMap.VMap VMap.VB VMap.VP (Credential 'Staking c) (CompactForm Coin)) ->
    !ans ->
    RewardPulser c m ans

-- Because of the constraints on the Constructor RSLP, there is really only one inhabited
-- type:  (RewardPulser c ShelleyBase (RewardAns c))
-- All of the instances are at that type. Though only the CBOR instances need make that explicit.

clearRecent :: RewardAns c -> RewardAns c
clearRecent :: RewardAns c -> RewardAns c
clearRecent (RewardAns Map (Credential 'Staking c) (Reward c)
accum RewardEvent c
_) = Map (Credential 'Staking c) (Reward c)
-> RewardEvent c -> RewardAns c
forall c.
Map (Credential 'Staking c) (Reward c)
-> RewardEvent c -> RewardAns c
RewardAns Map (Credential 'Staking c) (Reward c)
accum RewardEvent c
forall k a. Map k a
Map.empty

instance Pulsable (RewardPulser crypto) where
  done :: RewardPulser crypto m ans -> Bool
done (RSLP Int
_n FreeVars crypto
_free VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
zs ans
_ans) = VMap VB VP (Credential 'Staking crypto) (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 crypto) (CompactForm Coin)
zs
  current :: RewardPulser crypto m ans -> ans
current (RSLP Int
_ FreeVars crypto
_ VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
_ ans
ans) = ans
ans
  pulseM :: RewardPulser crypto m ans -> m (RewardPulser crypto m ans)
pulseM p :: RewardPulser crypto m ans
p@(RSLP Int
n FreeVars crypto
free VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
balance (ans -> RewardAns crypto
forall c. RewardAns c -> RewardAns c
clearRecent -> RewardAns crypto
ans)) =
    if VMap VB VP (Credential 'Staking crypto) (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 crypto) (CompactForm Coin)
balance
      then RewardPulser crypto m ans -> m (RewardPulser crypto m ans)
forall (f :: * -> *) a. Applicative f => a -> f a
pure RewardPulser crypto m ans
p
      else do
        let !(VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
steps, !VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
balance') = Int
-> VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
-> (VMap VB VP (Credential 'Staking crypto) (CompactForm Coin),
    VMap VB VP (Credential 'Staking crypto) (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 crypto) (CompactForm Coin)
balance
            ans' :: RewardAns crypto
ans' = (RewardAns crypto
 -> Credential 'Staking crypto
 -> CompactForm Coin
 -> RewardAns crypto)
-> RewardAns crypto
-> VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
-> RewardAns crypto
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 crypto
-> RewardAns crypto
-> Credential 'Staking crypto
-> CompactForm Coin
-> RewardAns crypto
forall c.
FreeVars c
-> RewardAns c
-> Credential 'Staking c
-> CompactForm Coin
-> RewardAns c
rewardStakePoolMember FreeVars crypto
free) RewardAns crypto
ans VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
steps
        RewardPulser crypto m (RewardAns crypto)
-> m (RewardPulser crypto m (RewardAns crypto))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RewardPulser crypto m (RewardAns crypto)
 -> m (RewardPulser crypto m (RewardAns crypto)))
-> RewardPulser crypto m (RewardAns crypto)
-> m (RewardPulser crypto m (RewardAns crypto))
forall a b. (a -> b) -> a -> b
$! Int
-> FreeVars crypto
-> VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
-> RewardAns crypto
-> RewardPulser crypto m (RewardAns crypto)
forall ans c (m :: * -> *).
(ans ~ RewardAns c, m ~ ShelleyBase) =>
Int
-> FreeVars c
-> VMap VB VP (Credential 'Staking c) (CompactForm Coin)
-> ans
-> RewardPulser c m ans
RSLP Int
n FreeVars crypto
free VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
balance' RewardAns crypto
ans'
  completeM :: RewardPulser crypto m ans -> m ans
completeM (RSLP Int
_ FreeVars crypto
free VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
balance (ans -> RewardAns crypto
forall c. RewardAns c -> RewardAns c
clearRecent -> RewardAns crypto
ans)) = RewardAns crypto -> m (RewardAns crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RewardAns crypto -> m (RewardAns crypto))
-> RewardAns crypto -> m (RewardAns crypto)
forall a b. (a -> b) -> a -> b
$ (RewardAns crypto
 -> Credential 'Staking crypto
 -> CompactForm Coin
 -> RewardAns crypto)
-> RewardAns crypto
-> VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
-> RewardAns crypto
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 crypto
-> RewardAns crypto
-> Credential 'Staking crypto
-> CompactForm Coin
-> RewardAns crypto
forall c.
FreeVars c
-> RewardAns c
-> Credential 'Staking c
-> CompactForm Coin
-> RewardAns c
rewardStakePoolMember FreeVars crypto
free) RewardAns crypto
ans VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
balance

deriving instance Eq ans => Eq (RewardPulser c m ans)

deriving instance Show ans => Show (RewardPulser c m ans)

instance Typeable c => NoThunks (Pulser c) where
  showTypeOf :: Proxy (Pulser c) -> String
showTypeOf Proxy (Pulser c)
_ = String
"RewardPulser"
  wNoThunks :: Context -> Pulser c -> IO (Maybe ThunkInfo)
wNoThunks Context
ctxt (RSLP Int
n FreeVars c
free VMap VB VP (Credential 'Staking c) (CompactForm Coin)
balance RewardAns c
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 c -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt FreeVars c
free,
        Context
-> VMap VB VP (Credential 'Staking c) (CompactForm Coin)
-> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt VMap VB VP (Credential 'Staking c) (CompactForm Coin)
balance,
        Context -> RewardAns c -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt RewardAns c
ans
      ]

instance NFData (Pulser c) where
  rnf :: Pulser c -> ()
rnf (RSLP Int
n1 FreeVars c
c1 VMap VB VP (Credential 'Staking c) (CompactForm Coin)
b1 RewardAns c
a1) = () -> () -> ()
seq (Int -> ()
forall a. NFData a => a -> ()
rnf Int
n1) (() -> () -> ()
seq (FreeVars c -> ()
forall a. NFData a => a -> ()
rnf FreeVars c
c1) (() -> () -> ()
seq (VMap VB VP (Credential 'Staking c) (CompactForm Coin) -> ()
forall a. NFData a => a -> ()
rnf VMap VB VP (Credential 'Staking c) (CompactForm Coin)
b1) (RewardAns c -> ()
forall a. NFData a => a -> ()
rnf RewardAns c
a1)))

instance (CC.Crypto c) => ToCBOR (Pulser c) where
  toCBOR :: Pulser c -> Encoding
toCBOR (RSLP Int
n FreeVars c
free VMap VB VP (Credential 'Staking c) (CompactForm Coin)
balance RewardAns c
ans) =
    Encode ('Closed 'Dense) (Pulser c) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode ((Int
 -> FreeVars c
 -> VMap VB VP (Credential 'Staking c) (CompactForm Coin)
 -> RewardAns c
 -> Pulser c)
-> Encode
     ('Closed 'Dense)
     (Int
      -> FreeVars c
      -> VMap VB VP (Credential 'Staking c) (CompactForm Coin)
      -> RewardAns c
      -> Pulser c)
forall t. t -> Encode ('Closed 'Dense) t
Rec Int
-> FreeVars c
-> VMap VB VP (Credential 'Staking c) (CompactForm Coin)
-> RewardAns c
-> Pulser c
forall ans c (m :: * -> *).
(ans ~ RewardAns c, m ~ ShelleyBase) =>
Int
-> FreeVars c
-> VMap VB VP (Credential 'Staking c) (CompactForm Coin)
-> ans
-> RewardPulser c m ans
RSLP Encode
  ('Closed 'Dense)
  (Int
   -> FreeVars c
   -> VMap VB VP (Credential 'Staking c) (CompactForm Coin)
   -> RewardAns c
   -> Pulser c)
-> Encode ('Closed 'Dense) Int
-> Encode
     ('Closed 'Dense)
     (FreeVars c
      -> VMap VB VP (Credential 'Staking c) (CompactForm Coin)
      -> RewardAns c
      -> Pulser c)
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. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Int
n Encode
  ('Closed 'Dense)
  (FreeVars c
   -> VMap VB VP (Credential 'Staking c) (CompactForm Coin)
   -> RewardAns c
   -> Pulser c)
-> Encode ('Closed 'Dense) (FreeVars c)
-> Encode
     ('Closed 'Dense)
     (VMap VB VP (Credential 'Staking c) (CompactForm Coin)
      -> RewardAns c -> Pulser c)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> FreeVars c -> Encode ('Closed 'Dense) (FreeVars c)
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To FreeVars c
free Encode
  ('Closed 'Dense)
  (VMap VB VP (Credential 'Staking c) (CompactForm Coin)
   -> RewardAns c -> Pulser c)
-> Encode
     ('Closed 'Dense)
     (VMap VB VP (Credential 'Staking c) (CompactForm Coin))
-> Encode ('Closed 'Dense) (RewardAns c -> Pulser c)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> VMap VB VP (Credential 'Staking c) (CompactForm Coin)
-> Encode
     ('Closed 'Dense)
     (VMap VB VP (Credential 'Staking c) (CompactForm Coin))
forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v, ToCBOR k, ToCBOR v) =>
VMap kv vv k v -> Encode ('Closed 'Dense) (VMap kv vv k v)
vMapEncode VMap VB VP (Credential 'Staking c) (CompactForm Coin)
balance Encode ('Closed 'Dense) (RewardAns c -> Pulser c)
-> Encode ('Closed 'Dense) (RewardAns c)
-> Encode ('Closed 'Dense) (Pulser c)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> RewardAns c -> Encode ('Closed 'Dense) (RewardAns c)
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To RewardAns c
ans)

instance (CC.Crypto c) => FromCBOR (Pulser c) where
  fromCBOR :: Decoder s (Pulser c)
fromCBOR =
    Decode ('Closed 'Dense) (Pulser c) -> Decoder s (Pulser c)
forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode
      ( (Int
 -> FreeVars c
 -> VMap VB VP (Credential 'Staking c) (CompactForm Coin)
 -> RewardAns c
 -> Pulser c)
-> Decode
     ('Closed 'Dense)
     (Int
      -> FreeVars c
      -> VMap VB VP (Credential 'Staking c) (CompactForm Coin)
      -> RewardAns c
      -> Pulser c)
forall t. t -> Decode ('Closed 'Dense) t
RecD Int
-> FreeVars c
-> VMap VB VP (Credential 'Staking c) (CompactForm Coin)
-> RewardAns c
-> Pulser c
forall ans c (m :: * -> *).
(ans ~ RewardAns c, m ~ ShelleyBase) =>
Int
-> FreeVars c
-> VMap VB VP (Credential 'Staking c) (CompactForm Coin)
-> ans
-> RewardPulser c m ans
RSLP Decode
  ('Closed 'Dense)
  (Int
   -> FreeVars c
   -> VMap VB VP (Credential 'Staking c) (CompactForm Coin)
   -> RewardAns c
   -> Pulser c)
-> Decode ('Closed Any) Int
-> Decode
     ('Closed 'Dense)
     (FreeVars c
      -> VMap VB VP (Credential 'Staking c) (CompactForm Coin)
      -> RewardAns c
      -> Pulser c)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Int
forall t (w :: Wrapped). FromCBOR t => Decode w t
From Decode
  ('Closed 'Dense)
  (FreeVars c
   -> VMap VB VP (Credential 'Staking c) (CompactForm Coin)
   -> RewardAns c
   -> Pulser c)
-> Decode ('Closed Any) (FreeVars c)
-> Decode
     ('Closed 'Dense)
     (VMap VB VP (Credential 'Staking c) (CompactForm Coin)
      -> RewardAns c -> Pulser c)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (FreeVars c)
forall t (w :: Wrapped). FromCBOR t => Decode w t
From Decode
  ('Closed 'Dense)
  (VMap VB VP (Credential 'Staking c) (CompactForm Coin)
   -> RewardAns c -> Pulser c)
-> Decode
     ('Closed 'Dense)
     (VMap VB VP (Credential 'Staking c) (CompactForm Coin))
-> Decode ('Closed 'Dense) (RewardAns c -> Pulser c)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode
  ('Closed 'Dense)
  (VMap VB VP (Credential 'Staking c) (CompactForm Coin))
forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v, Ord k, FromCBOR k, FromCBOR v) =>
Decode ('Closed 'Dense) (VMap kv vv k v)
vMapDecode Decode ('Closed 'Dense) (RewardAns c -> Pulser c)
-> Decode ('Closed Any) (RewardAns c)
-> Decode ('Closed 'Dense) (Pulser c)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (RewardAns c)
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
      )

-- =========================================================================

-- | The state used in the STS rules
data PulsingRewUpdate crypto
  = Pulsing !(RewardSnapShot crypto) !(Pulser crypto) -- Pulsing work still to do
  | Complete !(RewardUpdate crypto) -- Pulsing work completed, ultimate goal reached
  deriving (PulsingRewUpdate crypto -> PulsingRewUpdate crypto -> Bool
(PulsingRewUpdate crypto -> PulsingRewUpdate crypto -> Bool)
-> (PulsingRewUpdate crypto -> PulsingRewUpdate crypto -> Bool)
-> Eq (PulsingRewUpdate crypto)
forall crypto.
PulsingRewUpdate crypto -> PulsingRewUpdate crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PulsingRewUpdate crypto -> PulsingRewUpdate crypto -> Bool
$c/= :: forall crypto.
PulsingRewUpdate crypto -> PulsingRewUpdate crypto -> Bool
== :: PulsingRewUpdate crypto -> PulsingRewUpdate crypto -> Bool
$c== :: forall crypto.
PulsingRewUpdate crypto -> PulsingRewUpdate crypto -> Bool
Eq, Int -> PulsingRewUpdate crypto -> ShowS
[PulsingRewUpdate crypto] -> ShowS
PulsingRewUpdate crypto -> String
(Int -> PulsingRewUpdate crypto -> ShowS)
-> (PulsingRewUpdate crypto -> String)
-> ([PulsingRewUpdate crypto] -> ShowS)
-> Show (PulsingRewUpdate crypto)
forall crypto. Int -> PulsingRewUpdate crypto -> ShowS
forall crypto. [PulsingRewUpdate crypto] -> ShowS
forall crypto. PulsingRewUpdate crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PulsingRewUpdate crypto] -> ShowS
$cshowList :: forall crypto. [PulsingRewUpdate crypto] -> ShowS
show :: PulsingRewUpdate crypto -> String
$cshow :: forall crypto. PulsingRewUpdate crypto -> String
showsPrec :: Int -> PulsingRewUpdate crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> PulsingRewUpdate crypto -> ShowS
Show, (forall x.
 PulsingRewUpdate crypto -> Rep (PulsingRewUpdate crypto) x)
-> (forall x.
    Rep (PulsingRewUpdate crypto) x -> PulsingRewUpdate crypto)
-> Generic (PulsingRewUpdate crypto)
forall x.
Rep (PulsingRewUpdate crypto) x -> PulsingRewUpdate crypto
forall x.
PulsingRewUpdate crypto -> Rep (PulsingRewUpdate crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x.
Rep (PulsingRewUpdate crypto) x -> PulsingRewUpdate crypto
forall crypto x.
PulsingRewUpdate crypto -> Rep (PulsingRewUpdate crypto) x
$cto :: forall crypto x.
Rep (PulsingRewUpdate crypto) x -> PulsingRewUpdate crypto
$cfrom :: forall crypto x.
PulsingRewUpdate crypto -> Rep (PulsingRewUpdate crypto) x
Generic, Context -> PulsingRewUpdate crypto -> IO (Maybe ThunkInfo)
Proxy (PulsingRewUpdate crypto) -> String
(Context -> PulsingRewUpdate crypto -> IO (Maybe ThunkInfo))
-> (Context -> PulsingRewUpdate crypto -> IO (Maybe ThunkInfo))
-> (Proxy (PulsingRewUpdate crypto) -> String)
-> NoThunks (PulsingRewUpdate crypto)
forall crypto.
Typeable crypto =>
Context -> PulsingRewUpdate crypto -> IO (Maybe ThunkInfo)
forall crypto.
Typeable crypto =>
Proxy (PulsingRewUpdate crypto) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (PulsingRewUpdate crypto) -> String
$cshowTypeOf :: forall crypto.
Typeable crypto =>
Proxy (PulsingRewUpdate crypto) -> String
wNoThunks :: Context -> PulsingRewUpdate crypto -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall crypto.
Typeable crypto =>
Context -> PulsingRewUpdate crypto -> IO (Maybe ThunkInfo)
noThunks :: Context -> PulsingRewUpdate crypto -> IO (Maybe ThunkInfo)
$cnoThunks :: forall crypto.
Typeable crypto =>
Context -> PulsingRewUpdate crypto -> IO (Maybe ThunkInfo)
NoThunks)

instance (CC.Crypto crypto) => ToCBOR (PulsingRewUpdate crypto) where
  toCBOR :: PulsingRewUpdate crypto -> Encoding
toCBOR (Pulsing RewardSnapShot crypto
s Pulser crypto
p) = Encode 'Open (PulsingRewUpdate crypto) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode ((RewardSnapShot crypto -> Pulser crypto -> PulsingRewUpdate crypto)
-> Word
-> Encode
     'Open
     (RewardSnapShot crypto -> Pulser crypto -> PulsingRewUpdate crypto)
forall t. t -> Word -> Encode 'Open t
Sum RewardSnapShot crypto -> Pulser crypto -> PulsingRewUpdate crypto
forall crypto.
RewardSnapShot crypto -> Pulser crypto -> PulsingRewUpdate crypto
Pulsing Word
0 Encode
  'Open
  (RewardSnapShot crypto -> Pulser crypto -> PulsingRewUpdate crypto)
-> Encode ('Closed 'Dense) (RewardSnapShot crypto)
-> Encode 'Open (Pulser crypto -> PulsingRewUpdate crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> RewardSnapShot crypto
-> Encode ('Closed 'Dense) (RewardSnapShot crypto)
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To RewardSnapShot crypto
s Encode 'Open (Pulser crypto -> PulsingRewUpdate crypto)
-> Encode ('Closed 'Dense) (Pulser crypto)
-> Encode 'Open (PulsingRewUpdate crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Pulser crypto -> Encode ('Closed 'Dense) (Pulser crypto)
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Pulser crypto
p)
  toCBOR (Complete RewardUpdate crypto
r) = Encode 'Open (PulsingRewUpdate crypto) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode ((RewardUpdate crypto -> PulsingRewUpdate crypto)
-> Word
-> Encode 'Open (RewardUpdate crypto -> PulsingRewUpdate crypto)
forall t. t -> Word -> Encode 'Open t
Sum RewardUpdate crypto -> PulsingRewUpdate crypto
forall crypto. RewardUpdate crypto -> PulsingRewUpdate crypto
Complete Word
1 Encode 'Open (RewardUpdate crypto -> PulsingRewUpdate crypto)
-> Encode ('Closed 'Dense) (RewardUpdate crypto)
-> Encode 'Open (PulsingRewUpdate crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> RewardUpdate crypto
-> Encode ('Closed 'Dense) (RewardUpdate crypto)
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To RewardUpdate crypto
r)

instance (CC.Crypto crypto) => FromCBOR (PulsingRewUpdate crypto) where
  fromCBOR :: Decoder s (PulsingRewUpdate crypto)
fromCBOR = Decode ('Closed 'Dense) (PulsingRewUpdate crypto)
-> Decoder s (PulsingRewUpdate crypto)
forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode (String
-> (Word -> Decode 'Open (PulsingRewUpdate crypto))
-> Decode ('Closed 'Dense) (PulsingRewUpdate crypto)
forall t.
String -> (Word -> Decode 'Open t) -> Decode ('Closed 'Dense) t
Summands String
"PulsingRewUpdate" Word -> Decode 'Open (PulsingRewUpdate crypto)
forall crypto.
Crypto crypto =>
Word -> Decode 'Open (PulsingRewUpdate crypto)
decPS)
    where
      decPS :: Word -> Decode 'Open (PulsingRewUpdate crypto)
decPS Word
0 = (RewardSnapShot crypto -> Pulser crypto -> PulsingRewUpdate crypto)
-> Decode
     'Open
     (RewardSnapShot crypto -> Pulser crypto -> PulsingRewUpdate crypto)
forall t. t -> Decode 'Open t
SumD RewardSnapShot crypto -> Pulser crypto -> PulsingRewUpdate crypto
forall crypto.
RewardSnapShot crypto -> Pulser crypto -> PulsingRewUpdate crypto
Pulsing Decode
  'Open
  (RewardSnapShot crypto -> Pulser crypto -> PulsingRewUpdate crypto)
-> Decode ('Closed Any) (RewardSnapShot crypto)
-> Decode 'Open (Pulser crypto -> PulsingRewUpdate crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (RewardSnapShot crypto)
forall t (w :: Wrapped). FromCBOR t => Decode w t
From Decode 'Open (Pulser crypto -> PulsingRewUpdate crypto)
-> Decode ('Closed Any) (Pulser crypto)
-> Decode 'Open (PulsingRewUpdate crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (Pulser crypto)
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
      decPS Word
1 = (RewardUpdate crypto -> PulsingRewUpdate crypto)
-> Decode 'Open (RewardUpdate crypto -> PulsingRewUpdate crypto)
forall t. t -> Decode 'Open t
SumD RewardUpdate crypto -> PulsingRewUpdate crypto
forall crypto. RewardUpdate crypto -> PulsingRewUpdate crypto
Complete Decode 'Open (RewardUpdate crypto -> PulsingRewUpdate crypto)
-> Decode ('Closed Any) (RewardUpdate crypto)
-> Decode 'Open (PulsingRewUpdate crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (RewardUpdate crypto)
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
      decPS Word
n = Word -> Decode 'Open (PulsingRewUpdate crypto)
forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
n

instance NFData (PulsingRewUpdate crypto)