{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE StandaloneDeriving #-}

module Cardano.Ledger.Shelley.RewardProvenance (
  RewardProvenance (..),
  RewardProvenancePool (..),
  Desirability (..),
)
where

import Cardano.Ledger.BaseTypes (BlocksMade (..))
import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..))
import Cardano.Ledger.Binary.Coders
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Keys (KeyHash (..), KeyRole (..))
import Cardano.Ledger.PoolParams (PoolParams (..))
import Control.DeepSeq (NFData)
import Data.Aeson (FromJSON, ToJSON)
import Data.Default (Default (..))
import Data.Map.Strict (Map)
import Data.Word (Word64)
import GHC.Generics
import NoThunks.Class (NoThunks (..))
import Numeric.Natural (Natural)

-- instances only
-- ==========================================================

-- | Provenance for an individual stake pool's reward calculation.
data RewardProvenancePool = RewardProvenancePool
  { RewardProvenancePool -> Natural
poolBlocksP :: !Natural
  -- ^ The number of blocks the pool produced.
  , RewardProvenancePool -> Rational
sigmaP :: !Rational
  -- ^ The stake pool's stake share (portion of the total stake).
  , RewardProvenancePool -> Rational
sigmaAP :: !Rational
  -- ^ The stake pool's active stake share (portion of the active stake).
  , RewardProvenancePool -> Coin
ownerStakeP :: !Coin
  -- ^ The number of Lovelace owned by the stake pool owners.
  -- If this value is not at least as large as the 'pledgeRatioP',
  -- the stake pool will not earn any rewards for the given epoch.
  , RewardProvenancePool -> PoolParams
poolParamsP :: !PoolParams
  -- ^ The stake pool's registered parameters.
  , RewardProvenancePool -> Rational
pledgeRatioP :: !Rational
  -- ^ The stake pool's pledge.
  , RewardProvenancePool -> Coin
maxPP :: !Coin
  -- ^ The maximum number of Lovelace this stake pool can earn.
  , RewardProvenancePool -> Rational
appPerfP :: !Rational
  -- ^ The stake pool's apparent performance.
  -- See Section 5.5.2 of the
  --  <https://github.com/intersectmbo/cardano-ledger/releases/latest/download/shelley-delegation.pdf>
  , RewardProvenancePool -> Coin
poolRP :: !Coin
  -- ^ The total Lovelace earned by the stake pool.
  , RewardProvenancePool -> Coin
lRewardP :: !Coin
  -- ^ The total Lovelace earned by the stake pool leader.
  }
  deriving (RewardProvenancePool -> RewardProvenancePool -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RewardProvenancePool -> RewardProvenancePool -> Bool
$c/= :: RewardProvenancePool -> RewardProvenancePool -> Bool
== :: RewardProvenancePool -> RewardProvenancePool -> Bool
$c== :: RewardProvenancePool -> RewardProvenancePool -> Bool
Eq, forall x. Rep RewardProvenancePool x -> RewardProvenancePool
forall x. RewardProvenancePool -> Rep RewardProvenancePool x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RewardProvenancePool x -> RewardProvenancePool
$cfrom :: forall x. RewardProvenancePool -> Rep RewardProvenancePool x
Generic)

instance NoThunks RewardProvenancePool

instance NFData RewardProvenancePool

instance FromJSON RewardProvenancePool

instance ToJSON RewardProvenancePool

instance Default RewardProvenancePool where
  def :: RewardProvenancePool
def = Natural
-> Rational
-> Rational
-> Coin
-> PoolParams
-> Rational
-> Coin
-> Rational
-> Coin
-> Coin
-> RewardProvenancePool
RewardProvenancePool Natural
0 Rational
0 Rational
0 (Integer -> Coin
Coin Integer
0) forall a. Default a => a
def Rational
0 (Integer -> Coin
Coin Integer
0) Rational
0 (Integer -> Coin
Coin Integer
0) (Integer -> Coin
Coin Integer
0)

-- | The desirability score of a stake pool, as described
-- in <https://arxiv.org/abs/1807.11218 "Reward Sharing Schemes for Stake Pools">.
-- Additionally, the hit rate estimation described in the
-- <https://github.com/intersectmbo/cardano-ledger/releases/latest/download/pool-ranking.pdf stake pool ranking document> is included.
data Desirability = Desirability
  { Desirability -> Double
desirabilityScore :: !Double
  , Desirability -> Double
hitRateEstimate :: !Double
  }
  deriving (Desirability -> Desirability -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Desirability -> Desirability -> Bool
$c/= :: Desirability -> Desirability -> Bool
== :: Desirability -> Desirability -> Bool
$c== :: Desirability -> Desirability -> Bool
Eq, Int -> Desirability -> ShowS
[Desirability] -> ShowS
Desirability -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Desirability] -> ShowS
$cshowList :: [Desirability] -> ShowS
show :: Desirability -> String
$cshow :: Desirability -> String
showsPrec :: Int -> Desirability -> ShowS
$cshowsPrec :: Int -> Desirability -> ShowS
Show, forall x. Rep Desirability x -> Desirability
forall x. Desirability -> Rep Desirability x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Desirability x -> Desirability
$cfrom :: forall x. Desirability -> Rep Desirability x
Generic)

instance NoThunks Desirability

instance NFData Desirability

-- | 'RewardProvenenace' captures some of the intermediate calculations when computing
--     the staking reward distribution. Most of these fields are simple scalar
--     values, computed from the current State, and are fixed before we start to compute
--     the distribution. Two of them are aggregates computed when we compute the distribution
--     ('pools' and 'desirabilities').
--
--  For more background, see "Figure 48: The Reward Calculation" and
--  "Figure 51: Reward Update Creation" of the
--  <https://github.com/intersectmbo/cardano-ledger/releases/latest/download/shelley-ledger.pdf the formal specification>.
--  The variable names here align with those in the specification.
--  See also Section 5 of the
--  <https://github.com/intersectmbo/cardano-ledger/releases/latest/download/shelley-delegation.pdf>
data RewardProvenance = RewardProvenance
  { RewardProvenance -> Word64
spe :: !Word64
  -- ^ The number of slots per epoch.
  , RewardProvenance -> BlocksMade
blocks :: !BlocksMade
  -- ^ A map from pool ID (the key hash of the stake pool operator's
  -- verification key) to the number of blocks made in the given epoch.
  , RewardProvenance -> Coin
maxLL :: !Coin
  -- ^ The maximum Lovelace supply. On mainnet, this value is equal to
  -- 45 * 10^15 (45 billion ADA).
  , RewardProvenance -> Coin
deltaR1 :: !Coin
  -- ^ The maximum amount of Lovelace which can be removed from the reserves
  -- to be given out as rewards for the given epoch.
  , RewardProvenance -> Coin
deltaR2 :: !Coin
  -- ^ The difference between the total Lovelace that could have been
  -- distributed as rewards this epoch (which is 'r') and what was actually distributed.
  , RewardProvenance -> Coin
r :: !Coin
  -- ^ The total Lovelace available for rewards for the given epoch,
  -- equal to 'rPot' less 'deltaT1'.
  , RewardProvenance -> Coin
totalStake :: !Coin
  -- ^ The maximum Lovelace supply ('maxLL') less the current value of the reserves.
  , RewardProvenance -> Integer
blocksCount :: !Integer
  -- ^ The total number of blocks produced during the given epoch.
  , RewardProvenance -> Rational
d :: !Rational
  -- ^ The decentralization parameter.
  , RewardProvenance -> Integer
expBlocks :: !Integer
  -- ^ The number of blocks expected to be produced during the given epoch.
  , RewardProvenance -> Rational
eta :: !Rational
  -- ^ The ratio of the number of blocks actually made versus the number
  -- of blocks that were expected.
  , RewardProvenance -> Coin
rPot :: !Coin
  -- ^ The reward pot for the given epoch, equal to 'deltaR1' plus the fee pot.
  , RewardProvenance -> Coin
deltaT1 :: !Coin
  -- ^ The amount of Lovelace taken from the treasury for the given epoch.
  , RewardProvenance -> Coin
activeStake :: !Coin
  -- ^ The amount of Lovelace that is delegated during the given epoch.
  , RewardProvenance -> Map (KeyHash 'StakePool) RewardProvenancePool
pools :: !(Map (KeyHash 'StakePool) RewardProvenancePool)
  -- ^ Individual stake pool provenance.
  , RewardProvenance -> Map (KeyHash 'StakePool) Desirability
desirabilities :: !(Map (KeyHash 'StakePool) Desirability)
  -- ^ A map from pool ID to the desirability score.
  -- See the <https://github.com/intersectmbo/cardano-ledger/releases/latest/download/pool-ranking.pdf stake pool ranking document>.
  }
  deriving (RewardProvenance -> RewardProvenance -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RewardProvenance -> RewardProvenance -> Bool
$c/= :: RewardProvenance -> RewardProvenance -> Bool
== :: RewardProvenance -> RewardProvenance -> Bool
$c== :: RewardProvenance -> RewardProvenance -> Bool
Eq, forall x. Rep RewardProvenance x -> RewardProvenance
forall x. RewardProvenance -> Rep RewardProvenance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RewardProvenance x -> RewardProvenance
$cfrom :: forall x. RewardProvenance -> Rep RewardProvenance x
Generic)

instance FromJSON Desirability

instance ToJSON Desirability

instance FromJSON RewardProvenance

instance ToJSON RewardProvenance

instance NoThunks RewardProvenance

instance NFData RewardProvenance

instance Default RewardProvenance where
  def :: RewardProvenance
def =
    Word64
-> BlocksMade
-> Coin
-> Coin
-> Coin
-> Coin
-> Coin
-> Integer
-> Rational
-> Integer
-> Rational
-> Coin
-> Coin
-> Coin
-> Map (KeyHash 'StakePool) RewardProvenancePool
-> Map (KeyHash 'StakePool) Desirability
-> RewardProvenance
RewardProvenance
      Word64
0
      (Map (KeyHash 'StakePool) Natural -> BlocksMade
BlocksMade forall a. Default a => a
def)
      (Integer -> Coin
Coin Integer
0)
      (Integer -> Coin
Coin Integer
0)
      (Integer -> Coin
Coin Integer
0)
      (Integer -> Coin
Coin Integer
0)
      (Integer -> Coin
Coin Integer
0)
      Integer
0
      Rational
0
      Integer
0
      Rational
0
      (Integer -> Coin
Coin Integer
0)
      (Integer -> Coin
Coin Integer
0)
      (Integer -> Coin
Coin Integer
0)
      forall a. Default a => a
def
      forall a. Default a => a
def

-- =======================================================
-- Show instances

mylines :: Int -> [String] -> String
mylines :: Int -> Context -> String
mylines Int
n Context
xs = Context -> String
unlines (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Int -> a -> [a]
replicate Int
n Char
' ' forall a. [a] -> [a] -> [a]
++) Context
xs)

instance Show RewardProvenancePool where
  show :: RewardProvenancePool -> String
show RewardProvenancePool
t =
    String
"RewardProvenancePool\n"
      forall a. [a] -> [a] -> [a]
++ Int -> Context -> String
mylines
        Int
3
        [ String
"poolBlocks = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (RewardProvenancePool -> Natural
poolBlocksP RewardProvenancePool
t)
        , String
"sigma = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (RewardProvenancePool -> Rational
sigmaP RewardProvenancePool
t)
        , String
"sigmaA = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (RewardProvenancePool -> Rational
sigmaAP RewardProvenancePool
t)
        , String
"ownerStake = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (RewardProvenancePool -> Coin
ownerStakeP RewardProvenancePool
t)
        , String
"poolParams = " forall a. [a] -> [a] -> [a]
++ PoolParams -> String
showPoolParams (RewardProvenancePool -> PoolParams
poolParamsP RewardProvenancePool
t)
        , String
"pledgeRatio = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (RewardProvenancePool -> Rational
pledgeRatioP RewardProvenancePool
t)
        , String
"maxP = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (RewardProvenancePool -> Coin
maxPP RewardProvenancePool
t)
        , String
"appPerf = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (RewardProvenancePool -> Rational
appPerfP RewardProvenancePool
t)
        , String
"poolR = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (RewardProvenancePool -> Coin
poolRP RewardProvenancePool
t)
        , String
"lReward = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (RewardProvenancePool -> Coin
lRewardP RewardProvenancePool
t)
        ]

showPoolParams :: PoolParams -> String
showPoolParams :: PoolParams -> String
showPoolParams PoolParams
x =
  String
"PoolParams\n"
    forall a. [a] -> [a] -> [a]
++ Int -> Context -> String
mylines
      Int
6
      [ String
"poolId = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (PoolParams -> KeyHash 'StakePool
ppId PoolParams
x)
      , String
"poolVrf = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (PoolParams -> VRFVerKeyHash 'StakePoolVRF
ppVrf PoolParams
x)
      , String
"poolPledge = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (PoolParams -> Coin
ppPledge PoolParams
x)
      , String
"poolCost = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (PoolParams -> Coin
ppCost PoolParams
x)
      , String
"poolMargin = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (PoolParams -> UnitInterval
ppMargin PoolParams
x)
      , String
"poolRAcnt = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (PoolParams -> RewardAccount
ppRewardAccount PoolParams
x)
      , String
"poolOwners = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (PoolParams -> Set (KeyHash 'Staking)
ppOwners PoolParams
x)
      , String
"poolRelays = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (PoolParams -> StrictSeq StakePoolRelay
ppRelays PoolParams
x)
      , String
"poolMD = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (PoolParams -> StrictMaybe PoolMetadata
ppMetadata PoolParams
x)
      ]

instance Show RewardProvenance where
  show :: RewardProvenance -> String
show RewardProvenance
t =
    String
"RewardProvenance\n"
      forall a. [a] -> [a] -> [a]
++ Int -> Context -> String
mylines
        Int
3
        [ String
"spe = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (RewardProvenance -> Word64
spe RewardProvenance
t)
        , String
"blocks = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (RewardProvenance -> BlocksMade
blocks RewardProvenance
t)
        , String
"maxLL = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (RewardProvenance -> Coin
maxLL RewardProvenance
t)
        , String
"deltaR1 = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (RewardProvenance -> Coin
deltaR1 RewardProvenance
t)
        , String
"deltaR2 = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (RewardProvenance -> Coin
deltaR2 RewardProvenance
t)
        , String
"r = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (RewardProvenance -> Coin
r RewardProvenance
t)
        , String
"totalStake = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (RewardProvenance -> Coin
totalStake RewardProvenance
t)
        , String
"blocksCount = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (RewardProvenance -> Integer
blocksCount RewardProvenance
t)
        , String
"d = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (RewardProvenance -> Rational
d RewardProvenance
t)
        , String
"expBlocks = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (RewardProvenance -> Integer
expBlocks RewardProvenance
t)
        , String
"eta = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (RewardProvenance -> Rational
eta RewardProvenance
t)
        , String
"rPot = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (RewardProvenance -> Coin
rPot RewardProvenance
t)
        , String
"deltaT1 = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (RewardProvenance -> Coin
deltaT1 RewardProvenance
t)
        , String
"activeStake = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (RewardProvenance -> Coin
activeStake RewardProvenance
t)
        , String
"pools = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (RewardProvenance -> Map (KeyHash 'StakePool) RewardProvenancePool
pools RewardProvenance
t)
        , String
"desirabilities = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (RewardProvenance -> Map (KeyHash 'StakePool) Desirability
desirabilities RewardProvenance
t)
        ]

-- =======================================================
-- CBOR instances

instance EncCBOR Desirability where
  encCBOR :: Desirability -> Encoding
encCBOR (Desirability Double
p1 Double
p2) =
    forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall a b. (a -> b) -> a -> b
$ forall t. t -> Encode ('Closed 'Dense) t
Rec Double -> Double -> Desirability
Desirability forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Double
p1 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Double
p2

instance DecCBOR Desirability where
  decCBOR :: forall s. Decoder s Desirability
decCBOR = forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode forall a b. (a -> b) -> a -> b
$ forall t. t -> Decode ('Closed 'Dense) t
RecD Double -> Double -> Desirability
Desirability forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From

instance EncCBOR RewardProvenancePool where
  encCBOR :: RewardProvenancePool -> Encoding
encCBOR (RewardProvenancePool Natural
p1 Rational
p2 Rational
p3 Coin
p4 PoolParams
p5 Rational
p6 Coin
p7 Rational
p8 Coin
p9 Coin
p10) =
    forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall a b. (a -> b) -> a -> b
$
      forall t. t -> Encode ('Closed 'Dense) t
Rec Natural
-> Rational
-> Rational
-> Coin
-> PoolParams
-> Rational
-> Coin
-> Rational
-> Coin
-> Coin
-> RewardProvenancePool
RewardProvenancePool
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Natural
p1
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Rational
p2
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Rational
p3
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
p4
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To PoolParams
p5
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Rational
p6
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
p7
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Rational
p8
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
p9
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
p10

instance DecCBOR RewardProvenancePool where
  decCBOR :: forall s. Decoder s RewardProvenancePool
decCBOR =
    forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode forall a b. (a -> b) -> a -> b
$
      forall t. t -> Decode ('Closed 'Dense) t
RecD Natural
-> Rational
-> Rational
-> Coin
-> PoolParams
-> Rational
-> Coin
-> Rational
-> Coin
-> Coin
-> RewardProvenancePool
RewardProvenancePool
        forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From

instance EncCBOR RewardProvenance where
  encCBOR :: RewardProvenance -> Encoding
encCBOR (RewardProvenance Word64
p1 BlocksMade
p2 Coin
p3 Coin
p4 Coin
p5 Coin
p6 Coin
p7 Integer
p8 Rational
p9 Integer
p10 Rational
p11 Coin
p12 Coin
p13 Coin
p14 Map (KeyHash 'StakePool) RewardProvenancePool
p15 Map (KeyHash 'StakePool) Desirability
p16) =
    forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall a b. (a -> b) -> a -> b
$
      forall t. t -> Encode ('Closed 'Dense) t
Rec Word64
-> BlocksMade
-> Coin
-> Coin
-> Coin
-> Coin
-> Coin
-> Integer
-> Rational
-> Integer
-> Rational
-> Coin
-> Coin
-> Coin
-> Map (KeyHash 'StakePool) RewardProvenancePool
-> Map (KeyHash 'StakePool) Desirability
-> RewardProvenance
RewardProvenance
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Word64
p1
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To BlocksMade
p2
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
p3
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
p4
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
p5
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
p6
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
p7
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Integer
p8
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Rational
p9
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Integer
p10
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Rational
p11
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
p12
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
p13
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
p14
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Map (KeyHash 'StakePool) RewardProvenancePool
p15
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Map (KeyHash 'StakePool) Desirability
p16

instance DecCBOR RewardProvenance where
  decCBOR :: forall s. Decoder s RewardProvenance
decCBOR =
    forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode forall a b. (a -> b) -> a -> b
$
      forall t. t -> Decode ('Closed 'Dense) t
RecD Word64
-> BlocksMade
-> Coin
-> Coin
-> Coin
-> Coin
-> Coin
-> Integer
-> Rational
-> Integer
-> Rational
-> Coin
-> Coin
-> Coin
-> Map (KeyHash 'StakePool) RewardProvenancePool
-> Map (KeyHash 'StakePool) Desirability
-> RewardProvenance
RewardProvenance
        forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From