{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

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

import Cardano.Binary
  ( FromCBOR (fromCBOR),
    ToCBOR (toCBOR),
    decodeDouble,
    encodeDouble,
  )
import Cardano.Ledger.BaseTypes (BlocksMade (..))
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Credential (Credential (..))
import qualified Cardano.Ledger.Crypto as CC
import Cardano.Ledger.Keys (KeyHash (..), KeyRole (..))
import Cardano.Ledger.SafeHash (SafeHash, unsafeMakeSafeHash)
import Cardano.Ledger.Shelley.Orphans ()
import Cardano.Ledger.Shelley.TxBody (PoolParams (..), RewardAcnt (..))
import Control.DeepSeq (NFData)
import Data.Aeson (FromJSON, ToJSON)
import Data.Coders
  ( Decode (..),
    Encode (..),
    decode,
    encode,
    (!>),
    (<!),
  )
import Data.Default.Class (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 crypto = RewardProvenancePool
  { -- | The number of blocks the pool produced.
    RewardProvenancePool crypto -> Natural
poolBlocksP :: !Natural,
    -- | The stake pool's stake share (portion of the total stake).
    RewardProvenancePool crypto -> Rational
sigmaP :: !Rational,
    -- | The stake pool's active stake share (portion of the active stake).
    RewardProvenancePool crypto -> Rational
sigmaAP :: !Rational,
    -- | 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 crypto -> Coin
ownerStakeP :: !Coin,
    -- | The stake pool's registered parameters.
    RewardProvenancePool crypto -> PoolParams crypto
poolParamsP :: !(PoolParams crypto),
    -- | The stake pool's pledge.
    RewardProvenancePool crypto -> Rational
pledgeRatioP :: !Rational,
    -- | The maximum number of Lovelace this stake pool can earn.
    RewardProvenancePool crypto -> Coin
maxPP :: !Coin,
    -- | The stake pool's apparent performance.
    -- See Section 5.5.2 of the
    --  <https://hydra.iohk.io/job/Cardano/cardano-ledger/delegationDesignSpec/latest/download-by-type/doc-pdf/delegation_design_spec Design Specification>.
    RewardProvenancePool crypto -> Rational
appPerfP :: !Rational,
    -- | The total Lovelace earned by the stake pool.
    RewardProvenancePool crypto -> Coin
poolRP :: !Coin,
    -- | The total Lovelace earned by the stake pool leader.
    RewardProvenancePool crypto -> Coin
lRewardP :: !Coin
  }
  deriving (RewardProvenancePool crypto -> RewardProvenancePool crypto -> Bool
(RewardProvenancePool crypto
 -> RewardProvenancePool crypto -> Bool)
-> (RewardProvenancePool crypto
    -> RewardProvenancePool crypto -> Bool)
-> Eq (RewardProvenancePool crypto)
forall crypto.
RewardProvenancePool crypto -> RewardProvenancePool crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RewardProvenancePool crypto -> RewardProvenancePool crypto -> Bool
$c/= :: forall crypto.
RewardProvenancePool crypto -> RewardProvenancePool crypto -> Bool
== :: RewardProvenancePool crypto -> RewardProvenancePool crypto -> Bool
$c== :: forall crypto.
RewardProvenancePool crypto -> RewardProvenancePool crypto -> Bool
Eq, (forall x.
 RewardProvenancePool crypto -> Rep (RewardProvenancePool crypto) x)
-> (forall x.
    Rep (RewardProvenancePool crypto) x -> RewardProvenancePool crypto)
-> Generic (RewardProvenancePool crypto)
forall x.
Rep (RewardProvenancePool crypto) x -> RewardProvenancePool crypto
forall x.
RewardProvenancePool crypto -> Rep (RewardProvenancePool crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x.
Rep (RewardProvenancePool crypto) x -> RewardProvenancePool crypto
forall crypto x.
RewardProvenancePool crypto -> Rep (RewardProvenancePool crypto) x
$cto :: forall crypto x.
Rep (RewardProvenancePool crypto) x -> RewardProvenancePool crypto
$cfrom :: forall crypto x.
RewardProvenancePool crypto -> Rep (RewardProvenancePool crypto) x
Generic)

instance NoThunks (RewardProvenancePool crypto)

instance NFData (RewardProvenancePool crypto)

deriving instance (CC.Crypto crypto) => FromJSON (RewardProvenancePool crypto)

deriving instance (CC.Crypto crypto) => ToJSON (RewardProvenancePool crypto)

instance CC.Crypto crypto => Default (RewardProvenancePool crypto) where
  def :: RewardProvenancePool crypto
def = Natural
-> Rational
-> Rational
-> Coin
-> PoolParams crypto
-> Rational
-> Coin
-> Rational
-> Coin
-> Coin
-> RewardProvenancePool crypto
forall crypto.
Natural
-> Rational
-> Rational
-> Coin
-> PoolParams crypto
-> Rational
-> Coin
-> Rational
-> Coin
-> Coin
-> RewardProvenancePool crypto
RewardProvenancePool Natural
0 Rational
0 Rational
0 (Integer -> Coin
Coin Integer
0) PoolParams crypto
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://hydra.iohk.io/job/Cardano/cardano-ledger/specs.pool-ranking/latest/download-by-type/doc-pdf/pool-ranking stake pool ranking document> is included.
data Desirability = Desirability
  { Desirability -> Double
desirabilityScore :: !Double,
    Desirability -> Double
hitRateEstimate :: !Double
  }
  deriving (Desirability -> Desirability -> Bool
(Desirability -> Desirability -> Bool)
-> (Desirability -> Desirability -> Bool) -> Eq Desirability
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
(Int -> Desirability -> ShowS)
-> (Desirability -> String)
-> ([Desirability] -> ShowS)
-> Show Desirability
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. Desirability -> Rep Desirability x)
-> (forall x. Rep Desirability x -> Desirability)
-> Generic Desirability
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://hydra.iohk.io/job/Cardano/cardano-ledger/shelleyLedgerSpec/latest/download-by-type/doc-pdf/ledger-spec the formal specification>.
--  The variable names here align with those in the specification.
--  See also Section 5 of the
--  <https://hydra.iohk.io/job/Cardano/cardano-ledger/delegationDesignSpec/latest/download-by-type/doc-pdf/delegation_design_spec Design Specification>.
data RewardProvenance crypto = RewardProvenance
  { -- | The number of slots per epoch.
    RewardProvenance crypto -> Word64
spe :: !Word64,
    -- | 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 crypto -> BlocksMade crypto
blocks :: !(BlocksMade crypto),
    -- | The maximum Lovelace supply. On mainnet, this value is equal to
    -- 45 * 10^15 (45 billion ADA).
    RewardProvenance crypto -> Coin
maxLL :: !Coin,
    -- | The maximum amount of Lovelace which can be removed from the reserves
    -- to be given out as rewards for the given epoch.
    RewardProvenance crypto -> Coin
deltaR1 :: !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 crypto -> Coin
deltaR2 :: !Coin,
    -- | The total Lovelace available for rewards for the given epoch,
    -- equal to 'rPot' less 'deltaT1'.
    RewardProvenance crypto -> Coin
r :: !Coin,
    -- | The maximum Lovelace supply ('maxLL') less the current value of the reserves.
    RewardProvenance crypto -> Coin
totalStake :: !Coin,
    -- | The total number of blocks produced during the given epoch.
    RewardProvenance crypto -> Integer
blocksCount :: !Integer,
    -- | The decentralization parameter.
    RewardProvenance crypto -> Rational
d :: !Rational,
    -- | The number of blocks expected to be produced during the given epoch.
    RewardProvenance crypto -> Integer
expBlocks :: !Integer,
    -- | The ratio of the number of blocks actually made versus the number
    -- of blocks that were expected.
    RewardProvenance crypto -> Rational
eta :: !Rational,
    -- | The reward pot for the given epoch, equal to 'deltaR1' plus the fee pot.
    RewardProvenance crypto -> Coin
rPot :: !Coin,
    -- | The amount of Lovelace taken from the treasury for the given epoch.
    RewardProvenance crypto -> Coin
deltaT1 :: !Coin,
    -- | The amount of Lovelace that is delegated during the given epoch.
    RewardProvenance crypto -> Coin
activeStake :: !Coin,
    -- | Individual stake pool provenance.
    RewardProvenance crypto
-> Map (KeyHash 'StakePool crypto) (RewardProvenancePool crypto)
pools ::
      !( Map
           (KeyHash 'StakePool crypto)
           (RewardProvenancePool crypto)
       ),
    -- | A map from pool ID to the desirability score.
    -- See the <https://hydra.iohk.io/job/Cardano/cardano-ledger/specs.pool-ranking/latest/download-by-type/doc-pdf/pool-ranking stake pool ranking document>.
    RewardProvenance crypto
-> Map (KeyHash 'StakePool crypto) Desirability
desirabilities ::
      !(Map (KeyHash 'StakePool crypto) Desirability)
  }
  deriving (RewardProvenance crypto -> RewardProvenance crypto -> Bool
(RewardProvenance crypto -> RewardProvenance crypto -> Bool)
-> (RewardProvenance crypto -> RewardProvenance crypto -> Bool)
-> Eq (RewardProvenance crypto)
forall crypto.
RewardProvenance crypto -> RewardProvenance crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RewardProvenance crypto -> RewardProvenance crypto -> Bool
$c/= :: forall crypto.
RewardProvenance crypto -> RewardProvenance crypto -> Bool
== :: RewardProvenance crypto -> RewardProvenance crypto -> Bool
$c== :: forall crypto.
RewardProvenance crypto -> RewardProvenance crypto -> Bool
Eq, (forall x.
 RewardProvenance crypto -> Rep (RewardProvenance crypto) x)
-> (forall x.
    Rep (RewardProvenance crypto) x -> RewardProvenance crypto)
-> Generic (RewardProvenance crypto)
forall x.
Rep (RewardProvenance crypto) x -> RewardProvenance crypto
forall x.
RewardProvenance crypto -> Rep (RewardProvenance crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x.
Rep (RewardProvenance crypto) x -> RewardProvenance crypto
forall crypto x.
RewardProvenance crypto -> Rep (RewardProvenance crypto) x
$cto :: forall crypto x.
Rep (RewardProvenance crypto) x -> RewardProvenance crypto
$cfrom :: forall crypto x.
RewardProvenance crypto -> Rep (RewardProvenance crypto) x
Generic)

deriving instance FromJSON Desirability

deriving instance ToJSON Desirability

deriving instance (CC.Crypto crypto) => FromJSON (RewardProvenance crypto)

deriving instance (CC.Crypto crypto) => ToJSON (RewardProvenance crypto)

instance NoThunks (RewardProvenance crypto)

instance NFData (RewardProvenance crypto)

instance Default (RewardProvenance crypto) where
  def :: RewardProvenance crypto
def =
    Word64
-> BlocksMade crypto
-> Coin
-> Coin
-> Coin
-> Coin
-> Coin
-> Integer
-> Rational
-> Integer
-> Rational
-> Coin
-> Coin
-> Coin
-> Map (KeyHash 'StakePool crypto) (RewardProvenancePool crypto)
-> Map (KeyHash 'StakePool crypto) Desirability
-> RewardProvenance crypto
forall crypto.
Word64
-> BlocksMade crypto
-> Coin
-> Coin
-> Coin
-> Coin
-> Coin
-> Integer
-> Rational
-> Integer
-> Rational
-> Coin
-> Coin
-> Coin
-> Map (KeyHash 'StakePool crypto) (RewardProvenancePool crypto)
-> Map (KeyHash 'StakePool crypto) Desirability
-> RewardProvenance crypto
RewardProvenance
      Word64
0
      (Map (KeyHash 'StakePool crypto) Natural -> BlocksMade crypto
forall crypto.
Map (KeyHash 'StakePool crypto) Natural -> BlocksMade crypto
BlocksMade Map (KeyHash 'StakePool crypto) Natural
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)
      Map (KeyHash 'StakePool crypto) (RewardProvenancePool crypto)
forall a. Default a => a
def
      Map (KeyHash 'StakePool crypto) Desirability
forall a. Default a => a
def

instance CC.Crypto crypto => Default (PoolParams crypto) where
  def :: PoolParams crypto
def = KeyHash 'StakePool crypto
-> Hash crypto (VerKeyVRF crypto)
-> Coin
-> Coin
-> UnitInterval
-> RewardAcnt crypto
-> Set (KeyHash 'Staking crypto)
-> StrictSeq StakePoolRelay
-> StrictMaybe PoolMetadata
-> PoolParams crypto
forall crypto.
KeyHash 'StakePool crypto
-> Hash crypto (VerKeyVRF crypto)
-> Coin
-> Coin
-> UnitInterval
-> RewardAcnt crypto
-> Set (KeyHash 'Staking crypto)
-> StrictSeq StakePoolRelay
-> StrictMaybe PoolMetadata
-> PoolParams crypto
PoolParams KeyHash 'StakePool crypto
forall a. Default a => a
def Hash crypto (VerKeyVRF crypto)
forall a. Default a => a
def (Integer -> Coin
Coin Integer
0) (Integer -> Coin
Coin Integer
0) UnitInterval
forall a. Default a => a
def RewardAcnt crypto
forall a. Default a => a
def Set (KeyHash 'Staking crypto)
forall a. Default a => a
def StrictSeq StakePoolRelay
forall a. Default a => a
def StrictMaybe PoolMetadata
forall a. Default a => a
def

instance CC.Crypto e => Default (Credential r e) where
  def :: Credential r e
def = KeyHash r e -> Credential r e
forall (kr :: KeyRole) crypto.
KeyHash kr crypto -> Credential kr crypto
KeyHashObj KeyHash r e
forall a. Default a => a
def

instance CC.Crypto crypto => Default (RewardAcnt crypto) where
  def :: RewardAcnt crypto
def = Network -> Credential 'Staking crypto -> RewardAcnt crypto
forall crypto.
Network -> Credential 'Staking crypto -> RewardAcnt crypto
RewardAcnt Network
forall a. Default a => a
def Credential 'Staking crypto
forall a. Default a => a
def

instance CC.Crypto c => Default (SafeHash c i) where
  def :: SafeHash c i
def = Hash (HASH c) i -> SafeHash c i
forall crypto index.
Hash (HASH crypto) index -> SafeHash crypto index
unsafeMakeSafeHash Hash (HASH c) i
forall a. Default a => a
def

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

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

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

showPoolParams :: PoolParams crypto -> String
showPoolParams :: PoolParams crypto -> String
showPoolParams PoolParams crypto
x =
  String
"PoolParams\n"
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Context -> String
mylines
      Int
6
      [ String
"poolId = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ KeyHash 'StakePool crypto -> String
forall a. Show a => a -> String
show (PoolParams crypto -> KeyHash 'StakePool crypto
forall crypto. PoolParams crypto -> KeyHash 'StakePool crypto
_poolId PoolParams crypto
x),
        String
"poolVrf = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Hash (HASH crypto) (VerKeyVRF (VRF crypto)) -> String
forall a. Show a => a -> String
show (PoolParams crypto -> Hash (HASH crypto) (VerKeyVRF (VRF crypto))
forall crypto. PoolParams crypto -> Hash crypto (VerKeyVRF crypto)
_poolVrf PoolParams crypto
x),
        String
"poolPledge = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Coin -> String
forall a. Show a => a -> String
show (PoolParams crypto -> Coin
forall crypto. PoolParams crypto -> Coin
_poolPledge PoolParams crypto
x),
        String
"poolCost = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Coin -> String
forall a. Show a => a -> String
show (PoolParams crypto -> Coin
forall crypto. PoolParams crypto -> Coin
_poolCost PoolParams crypto
x),
        String
"poolMargin = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ UnitInterval -> String
forall a. Show a => a -> String
show (PoolParams crypto -> UnitInterval
forall crypto. PoolParams crypto -> UnitInterval
_poolMargin PoolParams crypto
x),
        String
"poolRAcnt = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ RewardAcnt crypto -> String
forall a. Show a => a -> String
show (PoolParams crypto -> RewardAcnt crypto
forall crypto. PoolParams crypto -> RewardAcnt crypto
_poolRAcnt PoolParams crypto
x),
        String
"poolOwners = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Set (KeyHash 'Staking crypto) -> String
forall a. Show a => a -> String
show (PoolParams crypto -> Set (KeyHash 'Staking crypto)
forall crypto. PoolParams crypto -> Set (KeyHash 'Staking crypto)
_poolOwners PoolParams crypto
x),
        String
"poolRelays = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ StrictSeq StakePoolRelay -> String
forall a. Show a => a -> String
show (PoolParams crypto -> StrictSeq StakePoolRelay
forall crypto. PoolParams crypto -> StrictSeq StakePoolRelay
_poolRelays PoolParams crypto
x),
        String
"poolMD = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ StrictMaybe PoolMetadata -> String
forall a. Show a => a -> String
show (PoolParams crypto -> StrictMaybe PoolMetadata
forall crypto. PoolParams crypto -> StrictMaybe PoolMetadata
_poolMD PoolParams crypto
x)
      ]

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

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

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

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

instance
  (CC.Crypto crypto) =>
  ToCBOR (RewardProvenancePool crypto)
  where
  toCBOR :: RewardProvenancePool crypto -> Encoding
toCBOR (RewardProvenancePool Natural
p1 Rational
p2 Rational
p3 Coin
p4 PoolParams crypto
p5 Rational
p6 Coin
p7 Rational
p8 Coin
p9 Coin
p10) =
    Encode ('Closed 'Dense) (RewardProvenancePool crypto) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) (RewardProvenancePool crypto) -> Encoding)
-> Encode ('Closed 'Dense) (RewardProvenancePool crypto)
-> Encoding
forall a b. (a -> b) -> a -> b
$
      (Natural
 -> Rational
 -> Rational
 -> Coin
 -> PoolParams crypto
 -> Rational
 -> Coin
 -> Rational
 -> Coin
 -> Coin
 -> RewardProvenancePool crypto)
-> Encode
     ('Closed 'Dense)
     (Natural
      -> Rational
      -> Rational
      -> Coin
      -> PoolParams crypto
      -> Rational
      -> Coin
      -> Rational
      -> Coin
      -> Coin
      -> RewardProvenancePool crypto)
forall t. t -> Encode ('Closed 'Dense) t
Rec Natural
-> Rational
-> Rational
-> Coin
-> PoolParams crypto
-> Rational
-> Coin
-> Rational
-> Coin
-> Coin
-> RewardProvenancePool crypto
forall crypto.
Natural
-> Rational
-> Rational
-> Coin
-> PoolParams crypto
-> Rational
-> Coin
-> Rational
-> Coin
-> Coin
-> RewardProvenancePool crypto
RewardProvenancePool
        Encode
  ('Closed 'Dense)
  (Natural
   -> Rational
   -> Rational
   -> Coin
   -> PoolParams crypto
   -> Rational
   -> Coin
   -> Rational
   -> Coin
   -> Coin
   -> RewardProvenancePool crypto)
-> Encode ('Closed 'Dense) Natural
-> Encode
     ('Closed 'Dense)
     (Rational
      -> Rational
      -> Coin
      -> PoolParams crypto
      -> Rational
      -> Coin
      -> Rational
      -> Coin
      -> Coin
      -> RewardProvenancePool crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Natural -> Encode ('Closed 'Dense) Natural
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Natural
p1
        Encode
  ('Closed 'Dense)
  (Rational
   -> Rational
   -> Coin
   -> PoolParams crypto
   -> Rational
   -> Coin
   -> Rational
   -> Coin
   -> Coin
   -> RewardProvenancePool crypto)
-> Encode ('Closed 'Dense) Rational
-> Encode
     ('Closed 'Dense)
     (Rational
      -> Coin
      -> PoolParams crypto
      -> Rational
      -> Coin
      -> Rational
      -> Coin
      -> Coin
      -> RewardProvenancePool crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Rational -> Encode ('Closed 'Dense) Rational
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Rational
p2
        Encode
  ('Closed 'Dense)
  (Rational
   -> Coin
   -> PoolParams crypto
   -> Rational
   -> Coin
   -> Rational
   -> Coin
   -> Coin
   -> RewardProvenancePool crypto)
-> Encode ('Closed 'Dense) Rational
-> Encode
     ('Closed 'Dense)
     (Coin
      -> PoolParams crypto
      -> Rational
      -> Coin
      -> Rational
      -> Coin
      -> Coin
      -> RewardProvenancePool crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Rational -> Encode ('Closed 'Dense) Rational
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Rational
p3
        Encode
  ('Closed 'Dense)
  (Coin
   -> PoolParams crypto
   -> Rational
   -> Coin
   -> Rational
   -> Coin
   -> Coin
   -> RewardProvenancePool crypto)
-> Encode ('Closed 'Dense) Coin
-> Encode
     ('Closed 'Dense)
     (PoolParams crypto
      -> Rational
      -> Coin
      -> Rational
      -> Coin
      -> Coin
      -> RewardProvenancePool 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
p4
        Encode
  ('Closed 'Dense)
  (PoolParams crypto
   -> Rational
   -> Coin
   -> Rational
   -> Coin
   -> Coin
   -> RewardProvenancePool crypto)
-> Encode ('Closed 'Dense) (PoolParams crypto)
-> Encode
     ('Closed 'Dense)
     (Rational
      -> Coin -> Rational -> Coin -> Coin -> RewardProvenancePool crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> PoolParams crypto -> Encode ('Closed 'Dense) (PoolParams crypto)
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To PoolParams crypto
p5
        Encode
  ('Closed 'Dense)
  (Rational
   -> Coin -> Rational -> Coin -> Coin -> RewardProvenancePool crypto)
-> Encode ('Closed 'Dense) Rational
-> Encode
     ('Closed 'Dense)
     (Coin -> Rational -> Coin -> Coin -> RewardProvenancePool crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Rational -> Encode ('Closed 'Dense) Rational
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Rational
p6
        Encode
  ('Closed 'Dense)
  (Coin -> Rational -> Coin -> Coin -> RewardProvenancePool crypto)
-> Encode ('Closed 'Dense) Coin
-> Encode
     ('Closed 'Dense)
     (Rational -> Coin -> Coin -> RewardProvenancePool 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
p7
        Encode
  ('Closed 'Dense)
  (Rational -> Coin -> Coin -> RewardProvenancePool crypto)
-> Encode ('Closed 'Dense) Rational
-> Encode
     ('Closed 'Dense) (Coin -> Coin -> RewardProvenancePool crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Rational -> Encode ('Closed 'Dense) Rational
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Rational
p8
        Encode
  ('Closed 'Dense) (Coin -> Coin -> RewardProvenancePool crypto)
-> Encode ('Closed 'Dense) Coin
-> Encode ('Closed 'Dense) (Coin -> RewardProvenancePool 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
p9
        Encode ('Closed 'Dense) (Coin -> RewardProvenancePool crypto)
-> Encode ('Closed 'Dense) Coin
-> Encode ('Closed 'Dense) (RewardProvenancePool 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
p10

instance
  (CC.Crypto crypto) =>
  FromCBOR (RewardProvenancePool crypto)
  where
  fromCBOR :: Decoder s (RewardProvenancePool crypto)
fromCBOR =
    Decode ('Closed 'Dense) (RewardProvenancePool crypto)
-> Decoder s (RewardProvenancePool crypto)
forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) (RewardProvenancePool crypto)
 -> Decoder s (RewardProvenancePool crypto))
-> Decode ('Closed 'Dense) (RewardProvenancePool crypto)
-> Decoder s (RewardProvenancePool crypto)
forall a b. (a -> b) -> a -> b
$
      (Natural
 -> Rational
 -> Rational
 -> Coin
 -> PoolParams crypto
 -> Rational
 -> Coin
 -> Rational
 -> Coin
 -> Coin
 -> RewardProvenancePool crypto)
-> Decode
     ('Closed 'Dense)
     (Natural
      -> Rational
      -> Rational
      -> Coin
      -> PoolParams crypto
      -> Rational
      -> Coin
      -> Rational
      -> Coin
      -> Coin
      -> RewardProvenancePool crypto)
forall t. t -> Decode ('Closed 'Dense) t
RecD Natural
-> Rational
-> Rational
-> Coin
-> PoolParams crypto
-> Rational
-> Coin
-> Rational
-> Coin
-> Coin
-> RewardProvenancePool crypto
forall crypto.
Natural
-> Rational
-> Rational
-> Coin
-> PoolParams crypto
-> Rational
-> Coin
-> Rational
-> Coin
-> Coin
-> RewardProvenancePool crypto
RewardProvenancePool
        Decode
  ('Closed 'Dense)
  (Natural
   -> Rational
   -> Rational
   -> Coin
   -> PoolParams crypto
   -> Rational
   -> Coin
   -> Rational
   -> Coin
   -> Coin
   -> RewardProvenancePool crypto)
-> Decode ('Closed Any) Natural
-> Decode
     ('Closed 'Dense)
     (Rational
      -> Rational
      -> Coin
      -> PoolParams crypto
      -> Rational
      -> Coin
      -> Rational
      -> Coin
      -> Coin
      -> RewardProvenancePool crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Natural
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (Rational
   -> Rational
   -> Coin
   -> PoolParams crypto
   -> Rational
   -> Coin
   -> Rational
   -> Coin
   -> Coin
   -> RewardProvenancePool crypto)
-> Decode ('Closed Any) Rational
-> Decode
     ('Closed 'Dense)
     (Rational
      -> Coin
      -> PoolParams crypto
      -> Rational
      -> Coin
      -> Rational
      -> Coin
      -> Coin
      -> RewardProvenancePool crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Rational
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (Rational
   -> Coin
   -> PoolParams crypto
   -> Rational
   -> Coin
   -> Rational
   -> Coin
   -> Coin
   -> RewardProvenancePool crypto)
-> Decode ('Closed Any) Rational
-> Decode
     ('Closed 'Dense)
     (Coin
      -> PoolParams crypto
      -> Rational
      -> Coin
      -> Rational
      -> Coin
      -> Coin
      -> RewardProvenancePool crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Rational
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (Coin
   -> PoolParams crypto
   -> Rational
   -> Coin
   -> Rational
   -> Coin
   -> Coin
   -> RewardProvenancePool crypto)
-> Decode ('Closed Any) Coin
-> Decode
     ('Closed 'Dense)
     (PoolParams crypto
      -> Rational
      -> Coin
      -> Rational
      -> Coin
      -> Coin
      -> RewardProvenancePool 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)
  (PoolParams crypto
   -> Rational
   -> Coin
   -> Rational
   -> Coin
   -> Coin
   -> RewardProvenancePool crypto)
-> Decode ('Closed Any) (PoolParams crypto)
-> Decode
     ('Closed 'Dense)
     (Rational
      -> Coin -> Rational -> Coin -> Coin -> RewardProvenancePool crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (PoolParams crypto)
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (Rational
   -> Coin -> Rational -> Coin -> Coin -> RewardProvenancePool crypto)
-> Decode ('Closed Any) Rational
-> Decode
     ('Closed 'Dense)
     (Coin -> Rational -> Coin -> Coin -> RewardProvenancePool crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Rational
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (Coin -> Rational -> Coin -> Coin -> RewardProvenancePool crypto)
-> Decode ('Closed Any) Coin
-> Decode
     ('Closed 'Dense)
     (Rational -> Coin -> Coin -> RewardProvenancePool 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)
  (Rational -> Coin -> Coin -> RewardProvenancePool crypto)
-> Decode ('Closed Any) Rational
-> Decode
     ('Closed 'Dense) (Coin -> Coin -> RewardProvenancePool crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Rational
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense) (Coin -> Coin -> RewardProvenancePool crypto)
-> Decode ('Closed Any) Coin
-> Decode ('Closed 'Dense) (Coin -> RewardProvenancePool 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 -> RewardProvenancePool crypto)
-> Decode ('Closed Any) Coin
-> Decode ('Closed 'Dense) (RewardProvenancePool 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

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

instance
  (CC.Crypto crypto) =>
  FromCBOR (RewardProvenance crypto)
  where
  fromCBOR :: Decoder s (RewardProvenance crypto)
fromCBOR =
    Decode ('Closed 'Dense) (RewardProvenance crypto)
-> Decoder s (RewardProvenance crypto)
forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) (RewardProvenance crypto)
 -> Decoder s (RewardProvenance crypto))
-> Decode ('Closed 'Dense) (RewardProvenance crypto)
-> Decoder s (RewardProvenance crypto)
forall a b. (a -> b) -> a -> b
$
      (Word64
 -> BlocksMade crypto
 -> Coin
 -> Coin
 -> Coin
 -> Coin
 -> Coin
 -> Integer
 -> Rational
 -> Integer
 -> Rational
 -> Coin
 -> Coin
 -> Coin
 -> Map (KeyHash 'StakePool crypto) (RewardProvenancePool crypto)
 -> Map (KeyHash 'StakePool crypto) Desirability
 -> RewardProvenance crypto)
-> Decode
     ('Closed 'Dense)
     (Word64
      -> BlocksMade crypto
      -> Coin
      -> Coin
      -> Coin
      -> Coin
      -> Coin
      -> Integer
      -> Rational
      -> Integer
      -> Rational
      -> Coin
      -> Coin
      -> Coin
      -> Map (KeyHash 'StakePool crypto) (RewardProvenancePool crypto)
      -> Map (KeyHash 'StakePool crypto) Desirability
      -> RewardProvenance crypto)
forall t. t -> Decode ('Closed 'Dense) t
RecD Word64
-> BlocksMade crypto
-> Coin
-> Coin
-> Coin
-> Coin
-> Coin
-> Integer
-> Rational
-> Integer
-> Rational
-> Coin
-> Coin
-> Coin
-> Map (KeyHash 'StakePool crypto) (RewardProvenancePool crypto)
-> Map (KeyHash 'StakePool crypto) Desirability
-> RewardProvenance crypto
forall crypto.
Word64
-> BlocksMade crypto
-> Coin
-> Coin
-> Coin
-> Coin
-> Coin
-> Integer
-> Rational
-> Integer
-> Rational
-> Coin
-> Coin
-> Coin
-> Map (KeyHash 'StakePool crypto) (RewardProvenancePool crypto)
-> Map (KeyHash 'StakePool crypto) Desirability
-> RewardProvenance crypto
RewardProvenance
        Decode
  ('Closed 'Dense)
  (Word64
   -> BlocksMade crypto
   -> Coin
   -> Coin
   -> Coin
   -> Coin
   -> Coin
   -> Integer
   -> Rational
   -> Integer
   -> Rational
   -> Coin
   -> Coin
   -> Coin
   -> Map (KeyHash 'StakePool crypto) (RewardProvenancePool crypto)
   -> Map (KeyHash 'StakePool crypto) Desirability
   -> RewardProvenance crypto)
-> Decode ('Closed Any) Word64
-> Decode
     ('Closed 'Dense)
     (BlocksMade crypto
      -> Coin
      -> Coin
      -> Coin
      -> Coin
      -> Coin
      -> Integer
      -> Rational
      -> Integer
      -> Rational
      -> Coin
      -> Coin
      -> Coin
      -> Map (KeyHash 'StakePool crypto) (RewardProvenancePool crypto)
      -> Map (KeyHash 'StakePool crypto) Desirability
      -> RewardProvenance crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Word64
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (BlocksMade crypto
   -> Coin
   -> Coin
   -> Coin
   -> Coin
   -> Coin
   -> Integer
   -> Rational
   -> Integer
   -> Rational
   -> Coin
   -> Coin
   -> Coin
   -> Map (KeyHash 'StakePool crypto) (RewardProvenancePool crypto)
   -> Map (KeyHash 'StakePool crypto) Desirability
   -> RewardProvenance crypto)
-> Decode ('Closed Any) (BlocksMade crypto)
-> Decode
     ('Closed 'Dense)
     (Coin
      -> Coin
      -> Coin
      -> Coin
      -> Coin
      -> Integer
      -> Rational
      -> Integer
      -> Rational
      -> Coin
      -> Coin
      -> Coin
      -> Map (KeyHash 'StakePool crypto) (RewardProvenancePool crypto)
      -> Map (KeyHash 'StakePool crypto) Desirability
      -> RewardProvenance crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (BlocksMade crypto)
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (Coin
   -> Coin
   -> Coin
   -> Coin
   -> Coin
   -> Integer
   -> Rational
   -> Integer
   -> Rational
   -> Coin
   -> Coin
   -> Coin
   -> Map (KeyHash 'StakePool crypto) (RewardProvenancePool crypto)
   -> Map (KeyHash 'StakePool crypto) Desirability
   -> RewardProvenance crypto)
-> Decode ('Closed Any) Coin
-> Decode
     ('Closed 'Dense)
     (Coin
      -> Coin
      -> Coin
      -> Coin
      -> Integer
      -> Rational
      -> Integer
      -> Rational
      -> Coin
      -> Coin
      -> Coin
      -> Map (KeyHash 'StakePool crypto) (RewardProvenancePool crypto)
      -> Map (KeyHash 'StakePool crypto) Desirability
      -> RewardProvenance 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
   -> Coin
   -> Coin
   -> Integer
   -> Rational
   -> Integer
   -> Rational
   -> Coin
   -> Coin
   -> Coin
   -> Map (KeyHash 'StakePool crypto) (RewardProvenancePool crypto)
   -> Map (KeyHash 'StakePool crypto) Desirability
   -> RewardProvenance crypto)
-> Decode ('Closed Any) Coin
-> Decode
     ('Closed 'Dense)
     (Coin
      -> Coin
      -> Coin
      -> Integer
      -> Rational
      -> Integer
      -> Rational
      -> Coin
      -> Coin
      -> Coin
      -> Map (KeyHash 'StakePool crypto) (RewardProvenancePool crypto)
      -> Map (KeyHash 'StakePool crypto) Desirability
      -> RewardProvenance 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
   -> Coin
   -> Integer
   -> Rational
   -> Integer
   -> Rational
   -> Coin
   -> Coin
   -> Coin
   -> Map (KeyHash 'StakePool crypto) (RewardProvenancePool crypto)
   -> Map (KeyHash 'StakePool crypto) Desirability
   -> RewardProvenance crypto)
-> Decode ('Closed Any) Coin
-> Decode
     ('Closed 'Dense)
     (Coin
      -> Coin
      -> Integer
      -> Rational
      -> Integer
      -> Rational
      -> Coin
      -> Coin
      -> Coin
      -> Map (KeyHash 'StakePool crypto) (RewardProvenancePool crypto)
      -> Map (KeyHash 'StakePool crypto) Desirability
      -> RewardProvenance 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
   -> Integer
   -> Rational
   -> Integer
   -> Rational
   -> Coin
   -> Coin
   -> Coin
   -> Map (KeyHash 'StakePool crypto) (RewardProvenancePool crypto)
   -> Map (KeyHash 'StakePool crypto) Desirability
   -> RewardProvenance crypto)
-> Decode ('Closed Any) Coin
-> Decode
     ('Closed 'Dense)
     (Coin
      -> Integer
      -> Rational
      -> Integer
      -> Rational
      -> Coin
      -> Coin
      -> Coin
      -> Map (KeyHash 'StakePool crypto) (RewardProvenancePool crypto)
      -> Map (KeyHash 'StakePool crypto) Desirability
      -> RewardProvenance 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
   -> Integer
   -> Rational
   -> Integer
   -> Rational
   -> Coin
   -> Coin
   -> Coin
   -> Map (KeyHash 'StakePool crypto) (RewardProvenancePool crypto)
   -> Map (KeyHash 'StakePool crypto) Desirability
   -> RewardProvenance crypto)
-> Decode ('Closed Any) Coin
-> Decode
     ('Closed 'Dense)
     (Integer
      -> Rational
      -> Integer
      -> Rational
      -> Coin
      -> Coin
      -> Coin
      -> Map (KeyHash 'StakePool crypto) (RewardProvenancePool crypto)
      -> Map (KeyHash 'StakePool crypto) Desirability
      -> RewardProvenance 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)
  (Integer
   -> Rational
   -> Integer
   -> Rational
   -> Coin
   -> Coin
   -> Coin
   -> Map (KeyHash 'StakePool crypto) (RewardProvenancePool crypto)
   -> Map (KeyHash 'StakePool crypto) Desirability
   -> RewardProvenance crypto)
-> Decode ('Closed Any) Integer
-> Decode
     ('Closed 'Dense)
     (Rational
      -> Integer
      -> Rational
      -> Coin
      -> Coin
      -> Coin
      -> Map (KeyHash 'StakePool crypto) (RewardProvenancePool crypto)
      -> Map (KeyHash 'StakePool crypto) Desirability
      -> RewardProvenance 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
        Decode
  ('Closed 'Dense)
  (Rational
   -> Integer
   -> Rational
   -> Coin
   -> Coin
   -> Coin
   -> Map (KeyHash 'StakePool crypto) (RewardProvenancePool crypto)
   -> Map (KeyHash 'StakePool crypto) Desirability
   -> RewardProvenance crypto)
-> Decode ('Closed Any) Rational
-> Decode
     ('Closed 'Dense)
     (Integer
      -> Rational
      -> Coin
      -> Coin
      -> Coin
      -> Map (KeyHash 'StakePool crypto) (RewardProvenancePool crypto)
      -> Map (KeyHash 'StakePool crypto) Desirability
      -> RewardProvenance crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Rational
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (Integer
   -> Rational
   -> Coin
   -> Coin
   -> Coin
   -> Map (KeyHash 'StakePool crypto) (RewardProvenancePool crypto)
   -> Map (KeyHash 'StakePool crypto) Desirability
   -> RewardProvenance crypto)
-> Decode ('Closed Any) Integer
-> Decode
     ('Closed 'Dense)
     (Rational
      -> Coin
      -> Coin
      -> Coin
      -> Map (KeyHash 'StakePool crypto) (RewardProvenancePool crypto)
      -> Map (KeyHash 'StakePool crypto) Desirability
      -> RewardProvenance 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
        Decode
  ('Closed 'Dense)
  (Rational
   -> Coin
   -> Coin
   -> Coin
   -> Map (KeyHash 'StakePool crypto) (RewardProvenancePool crypto)
   -> Map (KeyHash 'StakePool crypto) Desirability
   -> RewardProvenance crypto)
-> Decode ('Closed Any) Rational
-> Decode
     ('Closed 'Dense)
     (Coin
      -> Coin
      -> Coin
      -> Map (KeyHash 'StakePool crypto) (RewardProvenancePool crypto)
      -> Map (KeyHash 'StakePool crypto) Desirability
      -> RewardProvenance crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Rational
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (Coin
   -> Coin
   -> Coin
   -> Map (KeyHash 'StakePool crypto) (RewardProvenancePool crypto)
   -> Map (KeyHash 'StakePool crypto) Desirability
   -> RewardProvenance crypto)
-> Decode ('Closed Any) Coin
-> Decode
     ('Closed 'Dense)
     (Coin
      -> Coin
      -> Map (KeyHash 'StakePool crypto) (RewardProvenancePool crypto)
      -> Map (KeyHash 'StakePool crypto) Desirability
      -> RewardProvenance 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) (RewardProvenancePool crypto)
   -> Map (KeyHash 'StakePool crypto) Desirability
   -> RewardProvenance crypto)
-> Decode ('Closed Any) Coin
-> Decode
     ('Closed 'Dense)
     (Coin
      -> Map (KeyHash 'StakePool crypto) (RewardProvenancePool crypto)
      -> Map (KeyHash 'StakePool crypto) Desirability
      -> RewardProvenance 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) (RewardProvenancePool crypto)
   -> Map (KeyHash 'StakePool crypto) Desirability
   -> RewardProvenance crypto)
-> Decode ('Closed Any) Coin
-> Decode
     ('Closed 'Dense)
     (Map (KeyHash 'StakePool crypto) (RewardProvenancePool crypto)
      -> Map (KeyHash 'StakePool crypto) Desirability
      -> RewardProvenance 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) (RewardProvenancePool crypto)
   -> Map (KeyHash 'StakePool crypto) Desirability
   -> RewardProvenance crypto)
-> Decode
     ('Closed Any)
     (Map (KeyHash 'StakePool crypto) (RewardProvenancePool crypto))
-> Decode
     ('Closed 'Dense)
     (Map (KeyHash 'StakePool crypto) Desirability
      -> RewardProvenance crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode
  ('Closed Any)
  (Map (KeyHash 'StakePool crypto) (RewardProvenancePool crypto))
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (Map (KeyHash 'StakePool crypto) Desirability
   -> RewardProvenance crypto)
-> Decode
     ('Closed Any) (Map (KeyHash 'StakePool crypto) Desirability)
-> Decode ('Closed 'Dense) (RewardProvenance crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (Map (KeyHash 'StakePool crypto) Desirability)
forall t (w :: Wrapped). FromCBOR t => Decode w t
From