{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Cardano.Ledger.Shelley.API.Wallet
  ( -- * UTxOs
    getUTxO,
    getUTxOSubset,
    getFilteredUTxO,

    -- * Stake Pools
    getPools,
    getPoolParameters,
    getTotalStake,
    poolsByTotalStakeFraction,
    RewardInfoPool (..),
    RewardParams (..),
    getRewardInfoPools,
    getRewardProvenance,
    getNonMyopicMemberRewards,

    -- * Transaction helpers
    CLI (..),
    addShelleyKeyWitnesses,
    -- -- * Ada pots
    AdaPots (..),
    totalAdaES,
    totalAdaPotsES,
  )
where

import Cardano.Binary
  ( FromCBOR (..),
    ToCBOR (..),
    decodeDouble,
    decodeFull,
    decodeFullDecoder,
    encodeDouble,
    serialize,
  )
import Cardano.Crypto.DSIGN.Class (decodeSignedDSIGN, sizeSigDSIGN, sizeVerKeyDSIGN)
import Cardano.Ledger.Address (Addr (..))
import Cardano.Ledger.BaseTypes
  ( BlocksMade,
    Globals (..),
    NonNegativeInterval,
    ProtVer,
    UnitInterval,
    epochInfoPure,
  )
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.CompactAddress (compactAddr)
import Cardano.Ledger.Compactible (fromCompact)
import qualified Cardano.Ledger.Core as Core
import Cardano.Ledger.Credential (Credential (..))
import Cardano.Ledger.Crypto (DSIGN)
import qualified Cardano.Ledger.Crypto as CC (Crypto)
import Cardano.Ledger.Era (Era (Crypto, getTxOutEitherAddr))
import Cardano.Ledger.Keys (KeyHash, KeyRole (..))
import Cardano.Ledger.PoolDistr
  ( IndividualPoolStake (..),
    PoolDistr (..),
  )
import Cardano.Ledger.Shelley (ShelleyEra)
import Cardano.Ledger.Shelley.AdaPots
  ( AdaPots (..),
    totalAdaES,
    totalAdaPotsES,
  )
import qualified Cardano.Ledger.Shelley.EpochBoundary as EB
import Cardano.Ledger.Shelley.LedgerState
  ( DPState (..),
    EpochState (..),
    LedgerState (..),
    NewEpochState (..),
    PState (..),
    RewardUpdate,
    UTxOState (..),
    circulation,
    consumed,
    createRUpd,
    incrementalStakeDistr,
    minfee,
    produced,
  )
import Cardano.Ledger.Shelley.PParams (PParams' (..))
import Cardano.Ledger.Shelley.PoolRank
  ( NonMyopic (..),
    PerformanceEstimate (..),
    getTopRankedPoolsVMap,
    nonMyopicMemberRew,
    percentile',
  )
import Cardano.Ledger.Shelley.RewardProvenance (RewardProvenance)
import Cardano.Ledger.Shelley.Rewards (StakeShare (..))
import Cardano.Ledger.Shelley.Rules.NewEpoch (calculatePoolDistr)
import Cardano.Ledger.Shelley.Tx (Tx (..), WitnessSet, WitnessSetHKD (..))
import Cardano.Ledger.Shelley.TxBody (DCert, PoolParams (..), WitVKey (..))
import Cardano.Ledger.Shelley.UTxO (UTxO (..))
import Cardano.Ledger.Slot (epochInfoSize)
import Cardano.Ledger.TxIn (TxIn (..))
import Cardano.Ledger.Val ((<->))
import Cardano.Slotting.Slot (EpochSize)
import Control.DeepSeq (NFData)
import Control.Monad.Trans.Reader (runReader)
import Control.Provenance (runWithProvM)
import Data.Aeson (FromJSON, ToJSON)
import qualified Data.ByteString.Lazy as LBS
import Data.Coders
  ( Decode (..),
    Encode (..),
    decode,
    encode,
    (!>),
    (<!),
  )
import Data.Default.Class (Default (..))
import Data.Either (fromRight)
import Data.Foldable (foldMap')
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Proxy (Proxy (..))
import Data.Ratio ((%))
import Data.Sequence.Strict (StrictSeq)
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.VMap as VMap
import GHC.Generics (Generic)
import GHC.Records (HasField (..), getField)
import NoThunks.Class (NoThunks (..))
import Numeric.Natural (Natural)

--------------------------------------------------------------------------------
-- UTxOs
--------------------------------------------------------------------------------

-- | Get the full UTxO.
getUTxO ::
  NewEpochState era ->
  UTxO era
getUTxO :: NewEpochState era -> UTxO era
getUTxO = UTxOState era -> UTxO era
forall era. UTxOState era -> UTxO era
_utxo (UTxOState era -> UTxO era)
-> (NewEpochState era -> UTxOState era)
-> NewEpochState era
-> UTxO era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState era -> UTxOState era
forall era. LedgerState era -> UTxOState era
lsUTxOState (LedgerState era -> UTxOState era)
-> (NewEpochState era -> LedgerState era)
-> NewEpochState era
-> UTxOState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState (EpochState era -> LedgerState era)
-> (NewEpochState era -> EpochState era)
-> NewEpochState era
-> LedgerState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs

-- | Get the UTxO filtered by address.
getFilteredUTxO ::
  Era era =>
  NewEpochState era ->
  Set (Addr (Crypto era)) ->
  UTxO era
getFilteredUTxO :: NewEpochState era -> Set (Addr (Crypto era)) -> UTxO era
getFilteredUTxO NewEpochState era
ss Set (Addr (Crypto era))
addrSet =
  Map (TxIn (Crypto era)) (TxOut era) -> UTxO era
forall era. Map (TxIn (Crypto era)) (TxOut era) -> UTxO era
UTxO (Map (TxIn (Crypto era)) (TxOut era) -> UTxO era)
-> Map (TxIn (Crypto era)) (TxOut era) -> UTxO era
forall a b. (a -> b) -> a -> b
$ (TxOut era -> Bool)
-> Map (TxIn (Crypto era)) (TxOut era)
-> Map (TxIn (Crypto era)) (TxOut era)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter TxOut era -> Bool
checkAddr Map (TxIn (Crypto era)) (TxOut era)
fullUTxO
  where
    UTxO Map (TxIn (Crypto era)) (TxOut era)
fullUTxO = NewEpochState era -> UTxO era
forall era. NewEpochState era -> UTxO era
getUTxO NewEpochState era
ss
    compactAddrSet :: Set (CompactAddr (Crypto era))
compactAddrSet = (Addr (Crypto era) -> CompactAddr (Crypto era))
-> Set (Addr (Crypto era)) -> Set (CompactAddr (Crypto era))
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Addr (Crypto era) -> CompactAddr (Crypto era)
forall crypto. Addr crypto -> CompactAddr crypto
compactAddr Set (Addr (Crypto era))
addrSet
    checkAddr :: TxOut era -> Bool
checkAddr TxOut era
out =
      case TxOut era -> Either (Addr (Crypto era)) (CompactAddr (Crypto era))
forall e.
Era e =>
TxOut e -> Either (Addr (Crypto e)) (CompactAddr (Crypto e))
getTxOutEitherAddr TxOut era
out of
        Left Addr (Crypto era)
addr -> Addr (Crypto era)
addr Addr (Crypto era) -> Set (Addr (Crypto era)) -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set (Addr (Crypto era))
addrSet
        Right CompactAddr (Crypto era)
cAddr -> CompactAddr (Crypto era)
cAddr CompactAddr (Crypto era) -> Set (CompactAddr (Crypto era)) -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set (CompactAddr (Crypto era))
compactAddrSet
{-# INLINEABLE getFilteredUTxO #-}

getUTxOSubset ::
  NewEpochState era ->
  Set (TxIn (Crypto era)) ->
  UTxO era
getUTxOSubset :: NewEpochState era -> Set (TxIn (Crypto era)) -> UTxO era
getUTxOSubset NewEpochState era
ss Set (TxIn (Crypto era))
txins =
  Map (TxIn (Crypto era)) (TxOut era) -> UTxO era
forall era. Map (TxIn (Crypto era)) (TxOut era) -> UTxO era
UTxO (Map (TxIn (Crypto era)) (TxOut era) -> UTxO era)
-> Map (TxIn (Crypto era)) (TxOut era) -> UTxO era
forall a b. (a -> b) -> a -> b
$ Map (TxIn (Crypto era)) (TxOut era)
fullUTxO Map (TxIn (Crypto era)) (TxOut era)
-> Set (TxIn (Crypto era)) -> Map (TxIn (Crypto era)) (TxOut era)
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` Set (TxIn (Crypto era))
txins
  where
    UTxO Map (TxIn (Crypto era)) (TxOut era)
fullUTxO = NewEpochState era -> UTxO era
forall era. NewEpochState era -> UTxO era
getUTxO NewEpochState era
ss

--------------------------------------------------------------------------------
-- Stake pools and pool rewards
--------------------------------------------------------------------------------

-- | Get the /current/ registered stake pools.
getPools ::
  NewEpochState era ->
  Set (KeyHash 'StakePool (Crypto era))
getPools :: NewEpochState era -> Set (KeyHash 'StakePool (Crypto era))
getPools = Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
-> Set (KeyHash 'StakePool (Crypto era))
forall k a. Map k a -> Set k
Map.keysSet (Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
 -> Set (KeyHash 'StakePool (Crypto era)))
-> (NewEpochState era
    -> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era)))
-> NewEpochState era
-> Set (KeyHash 'StakePool (Crypto era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
forall era.
NewEpochState era
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
f
  where
    f :: NewEpochState era
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
f = PState (Crypto era)
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
forall crypto.
PState crypto
-> Map (KeyHash 'StakePool crypto) (PoolParams crypto)
_pParams (PState (Crypto era)
 -> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era)))
-> (NewEpochState era -> PState (Crypto era))
-> NewEpochState era
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DPState (Crypto era) -> PState (Crypto era)
forall crypto. DPState crypto -> PState crypto
dpsPState (DPState (Crypto era) -> PState (Crypto era))
-> (NewEpochState era -> DPState (Crypto era))
-> NewEpochState era
-> PState (Crypto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState era -> DPState (Crypto era)
forall era. LedgerState era -> DPState (Crypto era)
lsDPState (LedgerState era -> DPState (Crypto era))
-> (NewEpochState era -> LedgerState era)
-> NewEpochState era
-> DPState (Crypto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState (EpochState era -> LedgerState era)
-> (NewEpochState era -> EpochState era)
-> NewEpochState era
-> LedgerState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs

-- | Get the /current/ registered stake pool parameters for a given set of
-- stake pools. The result map will contain entries for all the given stake
-- pools that are currently registered.
getPoolParameters ::
  NewEpochState era ->
  Set (KeyHash 'StakePool (Crypto era)) ->
  Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
getPoolParameters :: NewEpochState era
-> Set (KeyHash 'StakePool (Crypto era))
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
getPoolParameters = Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
-> Set (KeyHash 'StakePool (Crypto era))
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys (Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
 -> Set (KeyHash 'StakePool (Crypto era))
 -> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era)))
-> (NewEpochState era
    -> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era)))
-> NewEpochState era
-> Set (KeyHash 'StakePool (Crypto era))
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
forall era.
NewEpochState era
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
f
  where
    f :: NewEpochState era
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
f = PState (Crypto era)
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
forall crypto.
PState crypto
-> Map (KeyHash 'StakePool crypto) (PoolParams crypto)
_pParams (PState (Crypto era)
 -> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era)))
-> (NewEpochState era -> PState (Crypto era))
-> NewEpochState era
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DPState (Crypto era) -> PState (Crypto era)
forall crypto. DPState crypto -> PState crypto
dpsPState (DPState (Crypto era) -> PState (Crypto era))
-> (NewEpochState era -> DPState (Crypto era))
-> NewEpochState era
-> PState (Crypto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState era -> DPState (Crypto era)
forall era. LedgerState era -> DPState (Crypto era)
lsDPState (LedgerState era -> DPState (Crypto era))
-> (NewEpochState era -> LedgerState era)
-> NewEpochState era
-> DPState (Crypto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState (EpochState era -> LedgerState era)
-> (NewEpochState era -> EpochState era)
-> NewEpochState era
-> LedgerState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs

-- | Get pool sizes, but in terms of total stake
--
-- The stake distribution uses active stake (so that the leader schedule is not
-- affected by undelegated stake), but the wallet wants to display pool
-- saturation for rewards purposes. For that, it needs the fraction of total
-- stake.
--
-- This is not based on any snapshot, but uses the current ledger state.
poolsByTotalStakeFraction ::
  forall era.
  Globals ->
  NewEpochState era ->
  PoolDistr (Crypto era)
poolsByTotalStakeFraction :: Globals -> NewEpochState era -> PoolDistr (Crypto era)
poolsByTotalStakeFraction Globals
globals NewEpochState era
ss =
  Map
  (KeyHash 'StakePool (Crypto era))
  (IndividualPoolStake (Crypto era))
-> PoolDistr (Crypto era)
forall crypto.
Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto)
-> PoolDistr crypto
PoolDistr Map
  (KeyHash 'StakePool (Crypto era))
  (IndividualPoolStake (Crypto era))
poolsByTotalStake
  where
    snap :: SnapShot (Crypto era)
snap@(EB.SnapShot Stake (Crypto era)
stake VMap
  VB
  VB
  (Credential 'Staking (Crypto era))
  (KeyHash 'StakePool (Crypto era))
_ VMap
  VB VB (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
_) = NewEpochState era -> SnapShot (Crypto era)
forall era. NewEpochState era -> SnapShot (Crypto era)
currentSnapshot NewEpochState era
ss
    Coin Integer
totalStake = Globals -> NewEpochState era -> Coin
forall era. Globals -> NewEpochState era -> Coin
getTotalStake Globals
globals NewEpochState era
ss
    Coin Integer
activeStake = Stake (Crypto era) -> Coin
forall crypto. Stake crypto -> Coin
EB.sumAllStake Stake (Crypto era)
stake
    stakeRatio :: Ratio Integer
stakeRatio = Integer
activeStake Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
totalStake
    PoolDistr Map
  (KeyHash 'StakePool (Crypto era))
  (IndividualPoolStake (Crypto era))
poolsByActiveStake = SnapShot (Crypto era) -> PoolDistr (Crypto era)
forall crypto. SnapShot crypto -> PoolDistr crypto
calculatePoolDistr SnapShot (Crypto era)
snap
    poolsByTotalStake :: Map
  (KeyHash 'StakePool (Crypto era))
  (IndividualPoolStake (Crypto era))
poolsByTotalStake = (IndividualPoolStake (Crypto era)
 -> IndividualPoolStake (Crypto era))
-> Map
     (KeyHash 'StakePool (Crypto era))
     (IndividualPoolStake (Crypto era))
-> Map
     (KeyHash 'StakePool (Crypto era))
     (IndividualPoolStake (Crypto era))
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map IndividualPoolStake (Crypto era)
-> IndividualPoolStake (Crypto era)
toTotalStakeFrac Map
  (KeyHash 'StakePool (Crypto era))
  (IndividualPoolStake (Crypto era))
poolsByActiveStake
    toTotalStakeFrac ::
      IndividualPoolStake (Crypto era) ->
      IndividualPoolStake (Crypto era)
    toTotalStakeFrac :: IndividualPoolStake (Crypto era)
-> IndividualPoolStake (Crypto era)
toTotalStakeFrac (IndividualPoolStake Ratio Integer
s Hash (Crypto era) (VerKeyVRF (Crypto era))
vrf) =
      Ratio Integer
-> Hash (Crypto era) (VerKeyVRF (Crypto era))
-> IndividualPoolStake (Crypto era)
forall crypto.
Ratio Integer
-> Hash crypto (VerKeyVRF crypto) -> IndividualPoolStake crypto
IndividualPoolStake (Ratio Integer
s Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
* Ratio Integer
stakeRatio) Hash (Crypto era) (VerKeyVRF (Crypto era))
vrf

-- | Calculate the current total stake.
getTotalStake :: Globals -> NewEpochState era -> Coin
getTotalStake :: Globals -> NewEpochState era -> Coin
getTotalStake Globals
globals NewEpochState era
ss =
  let supply :: Coin
supply = Integer -> Coin
Coin (Integer -> Coin) -> (Word64 -> Integer) -> Word64 -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Coin) -> Word64 -> Coin
forall a b. (a -> b) -> a -> b
$ Globals -> Word64
maxLovelaceSupply Globals
globals
      es :: EpochState era
es = NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
ss
   in EpochState era -> Coin -> Coin
forall era. EpochState era -> Coin -> Coin
circulation EpochState era
es Coin
supply

-- | Calculate the Non-Myopic Pool Member Rewards for a set of credentials.
-- For each given credential, this function returns a map from each stake
-- pool (identified by the key hash of the pool operator) to the
-- non-myopic pool member reward for that stake pool.
--
-- This is not based on any snapshot, but uses the current ledger state.
getNonMyopicMemberRewards ::
  ( HasField "_a0" (Core.PParams era) NonNegativeInterval,
    HasField "_nOpt" (Core.PParams era) Natural
  ) =>
  Globals ->
  NewEpochState era ->
  Set (Either Coin (Credential 'Staking (Crypto era))) ->
  Map
    (Either Coin (Credential 'Staking (Crypto era)))
    (Map (KeyHash 'StakePool (Crypto era)) Coin)
getNonMyopicMemberRewards :: Globals
-> NewEpochState era
-> Set (Either Coin (Credential 'Staking (Crypto era)))
-> Map
     (Either Coin (Credential 'Staking (Crypto era)))
     (Map (KeyHash 'StakePool (Crypto era)) Coin)
getNonMyopicMemberRewards Globals
globals NewEpochState era
ss Set (Either Coin (Credential 'Staking (Crypto era)))
creds =
  (Either Coin (Credential 'Staking (Crypto era))
 -> Map (KeyHash 'StakePool (Crypto era)) Coin)
-> Set (Either Coin (Credential 'Staking (Crypto era)))
-> Map
     (Either Coin (Credential 'Staking (Crypto era)))
     (Map (KeyHash 'StakePool (Crypto era)) Coin)
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (\Either Coin (Credential 'Staking (Crypto era))
cred -> ((PerformanceEstimate, PoolParams (Crypto era), StakeShare)
 -> Coin)
-> Map
     (KeyHash 'StakePool (Crypto era))
     (PerformanceEstimate, PoolParams (Crypto era), StakeShare)
-> Map (KeyHash 'StakePool (Crypto era)) Coin
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (StakeShare
-> (PerformanceEstimate, PoolParams (Crypto era), StakeShare)
-> Coin
mkNMMRewards (StakeShare
 -> (PerformanceEstimate, PoolParams (Crypto era), StakeShare)
 -> Coin)
-> StakeShare
-> (PerformanceEstimate, PoolParams (Crypto era), StakeShare)
-> Coin
forall a b. (a -> b) -> a -> b
$ Either Coin (Credential 'Staking (Crypto era)) -> StakeShare
memShare Either Coin (Credential 'Staking (Crypto era))
cred) Map
  (KeyHash 'StakePool (Crypto era))
  (PerformanceEstimate, PoolParams (Crypto era), StakeShare)
poolData) Set (Either Coin (Credential 'Staking (Crypto era)))
creds
  where
    maxSupply :: Coin
maxSupply = Integer -> Coin
Coin (Integer -> Coin) -> (Word64 -> Integer) -> Word64 -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Coin) -> Word64 -> Coin
forall a b. (a -> b) -> a -> b
$ Globals -> Word64
maxLovelaceSupply Globals
globals
    Coin Integer
totalStake = EpochState era -> Coin -> Coin
forall era. EpochState era -> Coin -> Coin
circulation EpochState era
es Coin
maxSupply
    toShare :: Coin -> StakeShare
toShare (Coin Integer
x) = Ratio Integer -> StakeShare
StakeShare (Integer
x Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
totalStake)
    memShare :: Either Coin (Credential 'Staking (Crypto era)) -> StakeShare
memShare (Right Credential 'Staking (Crypto era)
cred) =
      Coin -> StakeShare
toShare (Coin -> StakeShare) -> Coin -> StakeShare
forall a b. (a -> b) -> a -> b
$ Coin
-> (CompactForm Coin -> Coin) -> Maybe (CompactForm Coin) -> Coin
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Coin
forall a. Monoid a => a
mempty CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact (Maybe (CompactForm Coin) -> Coin)
-> Maybe (CompactForm Coin) -> Coin
forall a b. (a -> b) -> a -> b
$ Credential 'Staking (Crypto era)
-> VMap VB VP (Credential 'Staking (Crypto era)) (CompactForm Coin)
-> Maybe (CompactForm Coin)
forall k (kv :: * -> *) (vv :: * -> *) v.
(Ord k, Vector kv k, Vector vv v) =>
k -> VMap kv vv k v -> Maybe v
VMap.lookup Credential 'Staking (Crypto era)
cred (Stake (Crypto era)
-> VMap VB VP (Credential 'Staking (Crypto era)) (CompactForm Coin)
forall crypto.
Stake crypto
-> VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
EB.unStake Stake (Crypto era)
stake)
    memShare (Left Coin
coin) = Coin -> StakeShare
toShare Coin
coin
    es :: EpochState era
es = NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
ss
    pp :: PParams era
pp = EpochState era -> PParams era
forall era. EpochState era -> PParams era
esPp EpochState era
es
    NonMyopic {likelihoodsNM :: forall crypto.
NonMyopic crypto -> Map (KeyHash 'StakePool crypto) Likelihood
likelihoodsNM = Map (KeyHash 'StakePool (Crypto era)) Likelihood
ls, rewardPotNM :: forall crypto. NonMyopic crypto -> Coin
rewardPotNM = Coin
rPot} = EpochState era -> NonMyopic (Crypto era)
forall era. EpochState era -> NonMyopic (Crypto era)
esNonMyopic EpochState era
es
    EB.SnapShot Stake (Crypto era)
stake VMap
  VB
  VB
  (Credential 'Staking (Crypto era))
  (KeyHash 'StakePool (Crypto era))
delegs VMap
  VB VB (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
poolParams = NewEpochState era -> SnapShot (Crypto era)
forall era. NewEpochState era -> SnapShot (Crypto era)
currentSnapshot NewEpochState era
ss
    poolData :: Map
  (KeyHash 'StakePool (Crypto era))
  (PerformanceEstimate, PoolParams (Crypto era), StakeShare)
poolData =
      [(KeyHash 'StakePool (Crypto era),
  (PerformanceEstimate, PoolParams (Crypto era), StakeShare))]
-> Map
     (KeyHash 'StakePool (Crypto era))
     (PerformanceEstimate, PoolParams (Crypto era), StakeShare)
forall k a. [(k, a)] -> Map k a
Map.fromDistinctAscList
        [ ( KeyHash 'StakePool (Crypto era)
k,
            ( Likelihood -> PerformanceEstimate
percentile' (KeyHash 'StakePool (Crypto era) -> Likelihood
histLookup KeyHash 'StakePool (Crypto era)
k),
              PoolParams (Crypto era)
p,
              Coin -> StakeShare
toShare (Coin -> StakeShare)
-> (Stake (Crypto era) -> Coin) -> Stake (Crypto era) -> StakeShare
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stake (Crypto era) -> Coin
forall crypto. Stake crypto -> Coin
EB.sumAllStake (Stake (Crypto era) -> StakeShare)
-> Stake (Crypto era) -> StakeShare
forall a b. (a -> b) -> a -> b
$ KeyHash 'StakePool (Crypto era)
-> VMap
     VB
     VB
     (Credential 'Staking (Crypto era))
     (KeyHash 'StakePool (Crypto era))
-> Stake (Crypto era)
-> Stake (Crypto era)
forall crypto.
KeyHash 'StakePool crypto
-> VMap
     VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
-> Stake crypto
-> Stake crypto
EB.poolStake KeyHash 'StakePool (Crypto era)
k VMap
  VB
  VB
  (Credential 'Staking (Crypto era))
  (KeyHash 'StakePool (Crypto era))
delegs Stake (Crypto era)
stake
            )
          )
          | (KeyHash 'StakePool (Crypto era)
k, PoolParams (Crypto era)
p) <- VMap
  VB VB (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
-> [(KeyHash 'StakePool (Crypto era), PoolParams (Crypto era))]
forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
VMap kv vv k v -> [(k, v)]
VMap.toAscList VMap
  VB VB (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
poolParams
        ]
    histLookup :: KeyHash 'StakePool (Crypto era) -> Likelihood
histLookup KeyHash 'StakePool (Crypto era)
k = Likelihood
-> KeyHash 'StakePool (Crypto era)
-> Map (KeyHash 'StakePool (Crypto era)) Likelihood
-> Likelihood
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Likelihood
forall a. Monoid a => a
mempty KeyHash 'StakePool (Crypto era)
k Map (KeyHash 'StakePool (Crypto era)) Likelihood
ls
    topPools :: Set (KeyHash 'StakePool (Crypto era))
topPools =
      Coin
-> Coin
-> PParams era
-> VMap
     VB VB (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
-> Map (KeyHash 'StakePool (Crypto era)) PerformanceEstimate
-> Set (KeyHash 'StakePool (Crypto era))
forall pp crypto.
(HasField "_a0" pp NonNegativeInterval,
 HasField "_nOpt" pp Natural) =>
Coin
-> Coin
-> pp
-> VMap VB VB (KeyHash 'StakePool crypto) (PoolParams crypto)
-> Map (KeyHash 'StakePool crypto) PerformanceEstimate
-> Set (KeyHash 'StakePool crypto)
getTopRankedPoolsVMap
        Coin
rPot
        (Integer -> Coin
Coin Integer
totalStake)
        PParams era
pp
        VMap
  VB VB (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
poolParams
        ((Likelihood -> PerformanceEstimate)
-> Map (KeyHash 'StakePool (Crypto era)) Likelihood
-> Map (KeyHash 'StakePool (Crypto era)) PerformanceEstimate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Likelihood -> PerformanceEstimate
percentile' Map (KeyHash 'StakePool (Crypto era)) Likelihood
ls)
    mkNMMRewards :: StakeShare
-> (PerformanceEstimate, PoolParams (Crypto era), StakeShare)
-> Coin
mkNMMRewards StakeShare
t (PerformanceEstimate
hitRateEst, PoolParams (Crypto era)
poolp, StakeShare
sigma) =
      if PoolParams (Crypto era) -> Bool
checkPledge PoolParams (Crypto era)
poolp
        then PParams era
-> Coin
-> PoolParams (Crypto era)
-> StakeShare
-> StakeShare
-> StakeShare
-> Set (KeyHash 'StakePool (Crypto era))
-> PerformanceEstimate
-> Coin
forall pp c.
(HasField "_a0" pp NonNegativeInterval,
 HasField "_nOpt" pp Natural) =>
pp
-> Coin
-> PoolParams c
-> StakeShare
-> StakeShare
-> StakeShare
-> Set (KeyHash 'StakePool c)
-> PerformanceEstimate
-> Coin
nonMyopicMemberRew PParams era
pp Coin
rPot PoolParams (Crypto era)
poolp StakeShare
s StakeShare
sigma StakeShare
t Set (KeyHash 'StakePool (Crypto era))
topPools PerformanceEstimate
hitRateEst
        else Coin
forall a. Monoid a => a
mempty
      where
        s :: StakeShare
s = (Coin -> StakeShare
toShare (Coin -> StakeShare)
-> (PoolParams (Crypto era) -> Coin)
-> PoolParams (Crypto era)
-> StakeShare
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoolParams (Crypto era) -> Coin
forall crypto. PoolParams crypto -> Coin
_poolPledge) PoolParams (Crypto era)
poolp
        checkPledge :: PoolParams (Crypto era) -> Bool
checkPledge PoolParams (Crypto era)
pool =
          let ostake :: Coin
ostake = PoolParams (Crypto era) -> Stake (Crypto era) -> Coin
forall crypto. PoolParams crypto -> Stake crypto -> Coin
sumPoolOwnersStake PoolParams (Crypto era)
pool Stake (Crypto era)
stake
           in PoolParams (Crypto era) -> Coin
forall crypto. PoolParams crypto -> Coin
_poolPledge PoolParams (Crypto era)
poolp Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
<= Coin
ostake

sumPoolOwnersStake :: PoolParams crypto -> EB.Stake crypto -> Coin
sumPoolOwnersStake :: PoolParams crypto -> Stake crypto -> Coin
sumPoolOwnersStake PoolParams crypto
pool Stake crypto
stake =
  let getStakeFor :: KeyHash 'Staking crypto -> Coin
getStakeFor KeyHash 'Staking crypto
o =
        Coin
-> (CompactForm Coin -> Coin) -> Maybe (CompactForm Coin) -> Coin
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Coin
forall a. Monoid a => a
mempty CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact (Maybe (CompactForm Coin) -> Coin)
-> Maybe (CompactForm Coin) -> Coin
forall a b. (a -> b) -> a -> b
$ Credential 'Staking crypto
-> VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
-> Maybe (CompactForm Coin)
forall k (kv :: * -> *) (vv :: * -> *) v.
(Ord k, Vector kv k, Vector vv v) =>
k -> VMap kv vv k v -> Maybe v
VMap.lookup (KeyHash 'Staking crypto -> Credential 'Staking crypto
forall (kr :: KeyRole) crypto.
KeyHash kr crypto -> Credential kr crypto
KeyHashObj KeyHash 'Staking crypto
o) (Stake crypto
-> VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
forall crypto.
Stake crypto
-> VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
EB.unStake Stake crypto
stake)
   in (KeyHash 'Staking crypto -> Coin)
-> Set (KeyHash 'Staking crypto) -> Coin
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' KeyHash 'Staking crypto -> Coin
getStakeFor (PoolParams crypto -> Set (KeyHash 'Staking crypto)
forall crypto. PoolParams crypto -> Set (KeyHash 'Staking crypto)
_poolOwners PoolParams crypto
pool)

-- | Create a current snapshot of the ledger state.
--
-- When ranking pools, and reporting their saturation level, in the wallet, we
-- do not want to use one of the regular snapshots, but rather the most recent
-- ledger state.
currentSnapshot :: NewEpochState era -> EB.SnapShot (Crypto era)
currentSnapshot :: NewEpochState era -> SnapShot (Crypto era)
currentSnapshot NewEpochState era
ss =
  IncrementalStake (Crypto era)
-> DState (Crypto era)
-> PState (Crypto era)
-> SnapShot (Crypto era)
forall crypto.
IncrementalStake crypto
-> DState crypto -> PState crypto -> SnapShot crypto
incrementalStakeDistr IncrementalStake (Crypto era)
incrementalStake DState (Crypto era)
dstate PState (Crypto era)
pstate
  where
    ledgerState :: LedgerState era
ledgerState = EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState (EpochState era -> LedgerState era)
-> EpochState era -> LedgerState era
forall a b. (a -> b) -> a -> b
$ NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
ss
    incrementalStake :: IncrementalStake (Crypto era)
incrementalStake = UTxOState era -> IncrementalStake (Crypto era)
forall era. UTxOState era -> IncrementalStake (Crypto era)
_stakeDistro (UTxOState era -> IncrementalStake (Crypto era))
-> UTxOState era -> IncrementalStake (Crypto era)
forall a b. (a -> b) -> a -> b
$ LedgerState era -> UTxOState era
forall era. LedgerState era -> UTxOState era
lsUTxOState LedgerState era
ledgerState
    dstate :: DState (Crypto era)
dstate = DPState (Crypto era) -> DState (Crypto era)
forall crypto. DPState crypto -> DState crypto
dpsDState (DPState (Crypto era) -> DState (Crypto era))
-> DPState (Crypto era) -> DState (Crypto era)
forall a b. (a -> b) -> a -> b
$ LedgerState era -> DPState (Crypto era)
forall era. LedgerState era -> DPState (Crypto era)
lsDPState LedgerState era
ledgerState
    pstate :: PState (Crypto era)
pstate = DPState (Crypto era) -> PState (Crypto era)
forall crypto. DPState crypto -> PState crypto
dpsPState (DPState (Crypto era) -> PState (Crypto era))
-> DPState (Crypto era) -> PState (Crypto era)
forall a b. (a -> b) -> a -> b
$ LedgerState era -> DPState (Crypto era)
forall era. LedgerState era -> DPState (Crypto era)
lsDPState LedgerState era
ledgerState

-- | Information about a stake pool
data RewardInfoPool = RewardInfoPool
  { -- | Absolute stake delegated to this pool
    RewardInfoPool -> Coin
stake :: Coin,
    -- | Pledge of pool owner(s)
    RewardInfoPool -> Coin
ownerPledge :: Coin,
    -- | Absolute stake delegated by pool owner(s)
    RewardInfoPool -> Coin
ownerStake :: Coin,
    -- | Pool cost
    RewardInfoPool -> Coin
cost :: Coin,
    -- | Pool margin
    RewardInfoPool -> UnitInterval
margin :: UnitInterval,
    -- | Number of blocks produced divided by expected number of blocks.
    -- Can be larger than @1.0@ for pool that gets lucky.
    -- (If some pools get unlucky, some pools must get lucky.)
    RewardInfoPool -> Double
performanceEstimate :: Double
  }
  deriving (RewardInfoPool -> RewardInfoPool -> Bool
(RewardInfoPool -> RewardInfoPool -> Bool)
-> (RewardInfoPool -> RewardInfoPool -> Bool) -> Eq RewardInfoPool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RewardInfoPool -> RewardInfoPool -> Bool
$c/= :: RewardInfoPool -> RewardInfoPool -> Bool
== :: RewardInfoPool -> RewardInfoPool -> Bool
$c== :: RewardInfoPool -> RewardInfoPool -> Bool
Eq, Int -> RewardInfoPool -> ShowS
[RewardInfoPool] -> ShowS
RewardInfoPool -> String
(Int -> RewardInfoPool -> ShowS)
-> (RewardInfoPool -> String)
-> ([RewardInfoPool] -> ShowS)
-> Show RewardInfoPool
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RewardInfoPool] -> ShowS
$cshowList :: [RewardInfoPool] -> ShowS
show :: RewardInfoPool -> String
$cshow :: RewardInfoPool -> String
showsPrec :: Int -> RewardInfoPool -> ShowS
$cshowsPrec :: Int -> RewardInfoPool -> ShowS
Show, (forall x. RewardInfoPool -> Rep RewardInfoPool x)
-> (forall x. Rep RewardInfoPool x -> RewardInfoPool)
-> Generic RewardInfoPool
forall x. Rep RewardInfoPool x -> RewardInfoPool
forall x. RewardInfoPool -> Rep RewardInfoPool x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RewardInfoPool x -> RewardInfoPool
$cfrom :: forall x. RewardInfoPool -> Rep RewardInfoPool x
Generic)

instance NoThunks RewardInfoPool

instance NFData RewardInfoPool

deriving instance FromJSON RewardInfoPool

deriving instance ToJSON RewardInfoPool

-- | Global information that influences stake pool rewards
data RewardParams = RewardParams
  { -- | Desired number of stake pools
    RewardParams -> Natural
nOpt :: Natural,
    -- | Influence of the pool owner's pledge on rewards
    RewardParams -> NonNegativeInterval
a0 :: NonNegativeInterval,
    -- | Total rewards available for the given epoch
    RewardParams -> Coin
rPot :: Coin,
    -- | Maximum lovelace supply minus treasury
    RewardParams -> Coin
totalStake :: Coin
  }
  deriving (RewardParams -> RewardParams -> Bool
(RewardParams -> RewardParams -> Bool)
-> (RewardParams -> RewardParams -> Bool) -> Eq RewardParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RewardParams -> RewardParams -> Bool
$c/= :: RewardParams -> RewardParams -> Bool
== :: RewardParams -> RewardParams -> Bool
$c== :: RewardParams -> RewardParams -> Bool
Eq, Int -> RewardParams -> ShowS
[RewardParams] -> ShowS
RewardParams -> String
(Int -> RewardParams -> ShowS)
-> (RewardParams -> String)
-> ([RewardParams] -> ShowS)
-> Show RewardParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RewardParams] -> ShowS
$cshowList :: [RewardParams] -> ShowS
show :: RewardParams -> String
$cshow :: RewardParams -> String
showsPrec :: Int -> RewardParams -> ShowS
$cshowsPrec :: Int -> RewardParams -> ShowS
Show, (forall x. RewardParams -> Rep RewardParams x)
-> (forall x. Rep RewardParams x -> RewardParams)
-> Generic RewardParams
forall x. Rep RewardParams x -> RewardParams
forall x. RewardParams -> Rep RewardParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RewardParams x -> RewardParams
$cfrom :: forall x. RewardParams -> Rep RewardParams x
Generic)

instance NoThunks RewardParams

instance NFData RewardParams

deriving instance FromJSON RewardParams

deriving instance ToJSON RewardParams

-- | Retrieve the information necessary to calculate stake pool member rewards
-- from the /current/ stake distribution.
--
-- This information includes the current stake distribution aggregated
-- by stake pools and pool owners,
-- the `current` pool costs and margins,
-- and performance estimates.
-- Also included are global information such as
-- the total stake or protocol parameters.
getRewardInfoPools ::
  ( HasField "_a0" (Core.PParams era) NonNegativeInterval,
    HasField "_nOpt" (Core.PParams era) Natural
  ) =>
  Globals ->
  NewEpochState era ->
  (RewardParams, Map (KeyHash 'StakePool (Crypto era)) RewardInfoPool)
getRewardInfoPools :: Globals
-> NewEpochState era
-> (RewardParams,
    Map (KeyHash 'StakePool (Crypto era)) RewardInfoPool)
getRewardInfoPools Globals
globals NewEpochState era
ss =
  (RewardParams
mkRewardParams, VMap VB VB (KeyHash 'StakePool (Crypto era)) RewardInfoPool
-> Map (KeyHash 'StakePool (Crypto era)) RewardInfoPool
forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
VMap kv vv k v -> Map k v
VMap.toMap ((KeyHash 'StakePool (Crypto era)
 -> PoolParams (Crypto era) -> RewardInfoPool)
-> VMap
     VB VB (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
-> VMap VB VB (KeyHash 'StakePool (Crypto era)) RewardInfoPool
forall (kv :: * -> *) k (vv :: * -> *) a b.
(Vector kv k, Vector vv a, Vector vv b) =>
(k -> a -> b) -> VMap kv vv k a -> VMap kv vv k b
VMap.mapWithKey KeyHash 'StakePool (Crypto era)
-> PoolParams (Crypto era) -> RewardInfoPool
mkRewardInfoPool VMap
  VB VB (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
poolParams))
  where
    es :: EpochState era
es = NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
ss
    pp :: PParams era
pp = EpochState era -> PParams era
forall era. EpochState era -> PParams era
esPp EpochState era
es
    NonMyopic
      { likelihoodsNM :: forall crypto.
NonMyopic crypto -> Map (KeyHash 'StakePool crypto) Likelihood
likelihoodsNM = Map (KeyHash 'StakePool (Crypto era)) Likelihood
ls,
        rewardPotNM :: forall crypto. NonMyopic crypto -> Coin
rewardPotNM = Coin
rPot
      } = EpochState era -> NonMyopic (Crypto era)
forall era. EpochState era -> NonMyopic (Crypto era)
esNonMyopic EpochState era
es
    histLookup :: KeyHash 'StakePool (Crypto era) -> Likelihood
histLookup KeyHash 'StakePool (Crypto era)
key = Likelihood
-> KeyHash 'StakePool (Crypto era)
-> Map (KeyHash 'StakePool (Crypto era)) Likelihood
-> Likelihood
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Likelihood
forall a. Monoid a => a
mempty KeyHash 'StakePool (Crypto era)
key Map (KeyHash 'StakePool (Crypto era)) Likelihood
ls

    EB.SnapShot Stake (Crypto era)
stakes VMap
  VB
  VB
  (Credential 'Staking (Crypto era))
  (KeyHash 'StakePool (Crypto era))
delegs VMap
  VB VB (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
poolParams = NewEpochState era -> SnapShot (Crypto era)
forall era. NewEpochState era -> SnapShot (Crypto era)
currentSnapshot NewEpochState era
ss

    mkRewardParams :: RewardParams
mkRewardParams =
      RewardParams :: Natural -> NonNegativeInterval -> Coin -> Coin -> RewardParams
RewardParams
        { a0 :: NonNegativeInterval
a0 = PParams era -> NonNegativeInterval
forall k (x :: k) r a. HasField x r a => r -> a
getField @"_a0" PParams era
pp,
          nOpt :: Natural
nOpt = PParams era -> Natural
forall k (x :: k) r a. HasField x r a => r -> a
getField @"_nOpt" PParams era
pp,
          totalStake :: Coin
totalStake = Globals -> NewEpochState era -> Coin
forall era. Globals -> NewEpochState era -> Coin
getTotalStake Globals
globals NewEpochState era
ss,
          rPot :: Coin
rPot = Coin
rPot
        }
    mkRewardInfoPool :: KeyHash 'StakePool (Crypto era)
-> PoolParams (Crypto era) -> RewardInfoPool
mkRewardInfoPool KeyHash 'StakePool (Crypto era)
key PoolParams (Crypto era)
poolp =
      RewardInfoPool :: Coin
-> Coin -> Coin -> Coin -> UnitInterval -> Double -> RewardInfoPool
RewardInfoPool
        { stake :: Coin
stake = Coin
pstake,
          ownerStake :: Coin
ownerStake = Coin
ostake,
          ownerPledge :: Coin
ownerPledge = PoolParams (Crypto era) -> Coin
forall crypto. PoolParams crypto -> Coin
_poolPledge PoolParams (Crypto era)
poolp,
          margin :: UnitInterval
margin = PoolParams (Crypto era) -> UnitInterval
forall crypto. PoolParams crypto -> UnitInterval
_poolMargin PoolParams (Crypto era)
poolp,
          cost :: Coin
cost = PoolParams (Crypto era) -> Coin
forall crypto. PoolParams crypto -> Coin
_poolCost PoolParams (Crypto era)
poolp,
          performanceEstimate :: Double
performanceEstimate =
            PerformanceEstimate -> Double
unPerformanceEstimate (PerformanceEstimate -> Double) -> PerformanceEstimate -> Double
forall a b. (a -> b) -> a -> b
$ Likelihood -> PerformanceEstimate
percentile' (Likelihood -> PerformanceEstimate)
-> Likelihood -> PerformanceEstimate
forall a b. (a -> b) -> a -> b
$ KeyHash 'StakePool (Crypto era) -> Likelihood
histLookup KeyHash 'StakePool (Crypto era)
key
        }
      where
        pstake :: Coin
pstake = Stake (Crypto era) -> Coin
forall crypto. Stake crypto -> Coin
EB.sumAllStake (Stake (Crypto era) -> Coin) -> Stake (Crypto era) -> Coin
forall a b. (a -> b) -> a -> b
$ KeyHash 'StakePool (Crypto era)
-> VMap
     VB
     VB
     (Credential 'Staking (Crypto era))
     (KeyHash 'StakePool (Crypto era))
-> Stake (Crypto era)
-> Stake (Crypto era)
forall crypto.
KeyHash 'StakePool crypto
-> VMap
     VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
-> Stake crypto
-> Stake crypto
EB.poolStake KeyHash 'StakePool (Crypto era)
key VMap
  VB
  VB
  (Credential 'Staking (Crypto era))
  (KeyHash 'StakePool (Crypto era))
delegs Stake (Crypto era)
stakes
        ostake :: Coin
ostake = PoolParams (Crypto era) -> Stake (Crypto era) -> Coin
forall crypto. PoolParams crypto -> Stake crypto -> Coin
sumPoolOwnersStake PoolParams (Crypto era)
poolp Stake (Crypto era)
stakes

-- | Calculate stake pool rewards from the snapshot labeled `go`.
-- Also includes information on how the rewards were calculated
-- ('RewardProvenance').
--
-- For a calculation of rewards based on the current stake distribution,
-- see 'getRewardInfoPools'.
--
-- TODO: Deprecate 'getRewardProvenance', because wallets are more
-- likely to use 'getRewardInfoPools' for up-to-date information
-- on stake pool rewards.
getRewardProvenance ::
  forall era.
  ( HasField "_a0" (Core.PParams era) NonNegativeInterval,
    HasField "_d" (Core.PParams era) UnitInterval,
    HasField "_nOpt" (Core.PParams era) Natural,
    HasField "_protocolVersion" (Core.PParams era) ProtVer,
    HasField "_rho" (Core.PParams era) UnitInterval,
    HasField "_tau" (Core.PParams era) UnitInterval
  ) =>
  Globals ->
  NewEpochState era ->
  (RewardUpdate (Crypto era), RewardProvenance (Crypto era))
getRewardProvenance :: Globals
-> NewEpochState era
-> (RewardUpdate (Crypto era), RewardProvenance (Crypto era))
getRewardProvenance Globals
globals NewEpochState era
newepochstate =
  Reader
  Globals (RewardUpdate (Crypto era), RewardProvenance (Crypto era))
-> Globals
-> (RewardUpdate (Crypto era), RewardProvenance (Crypto era))
forall r a. Reader r a -> r -> a
runReader
    ( RewardProvenance (Crypto era)
-> ProvM
     (RewardProvenance (Crypto era))
     ShelleyBase
     (RewardUpdate (Crypto era))
-> Reader
     Globals (RewardUpdate (Crypto era), RewardProvenance (Crypto era))
forall (m :: * -> *) s a. Monad m => s -> ProvM s m a -> m (a, s)
runWithProvM RewardProvenance (Crypto era)
forall a. Default a => a
def (ProvM
   (RewardProvenance (Crypto era))
   ShelleyBase
   (RewardUpdate (Crypto era))
 -> Reader
      Globals (RewardUpdate (Crypto era), RewardProvenance (Crypto era)))
-> ProvM
     (RewardProvenance (Crypto era))
     ShelleyBase
     (RewardUpdate (Crypto era))
-> Reader
     Globals (RewardUpdate (Crypto era), RewardProvenance (Crypto era))
forall a b. (a -> b) -> a -> b
$
        EpochSize
-> BlocksMade (Crypto era)
-> EpochState era
-> Coin
-> ActiveSlotCoeff
-> Word64
-> ProvM
     (RewardProvenance (Crypto era))
     ShelleyBase
     (RewardUpdate (Crypto era))
forall era.
UsesPP era =>
EpochSize
-> BlocksMade (Crypto era)
-> EpochState era
-> Coin
-> ActiveSlotCoeff
-> Word64
-> ProvM
     (RewardProvenance (Crypto era))
     ShelleyBase
     (RewardUpdate (Crypto era))
createRUpd EpochSize
slotsPerEpoch BlocksMade (Crypto era)
blocksmade EpochState era
epochstate Coin
maxsupply ActiveSlotCoeff
asc Word64
secparam
    )
    Globals
globals
  where
    epochstate :: EpochState era
epochstate = NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
newepochstate
    maxsupply :: Coin
    maxsupply :: Coin
maxsupply = Integer -> Coin
Coin (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Globals -> Word64
maxLovelaceSupply Globals
globals))
    blocksmade :: BlocksMade (Crypto era)
    blocksmade :: BlocksMade (Crypto era)
blocksmade = NewEpochState era -> BlocksMade (Crypto era)
forall era. NewEpochState era -> BlocksMade (Crypto era)
nesBprev NewEpochState era
newepochstate
    epochnumber :: EpochNo
epochnumber = NewEpochState era -> EpochNo
forall era. NewEpochState era -> EpochNo
nesEL NewEpochState era
newepochstate
    slotsPerEpoch :: EpochSize
    slotsPerEpoch :: EpochSize
slotsPerEpoch = Reader Globals EpochSize -> Globals -> EpochSize
forall r a. Reader r a -> r -> a
runReader (HasCallStack =>
EpochInfo Identity -> EpochNo -> Reader Globals EpochSize
EpochInfo Identity -> EpochNo -> Reader Globals EpochSize
epochInfoSize (Globals -> EpochInfo Identity
epochInfoPure Globals
globals) EpochNo
epochnumber) Globals
globals
    asc :: ActiveSlotCoeff
asc = Globals -> ActiveSlotCoeff
activeSlotCoeff Globals
globals
    secparam :: Word64
secparam = Globals -> Word64
securityParameter Globals
globals

--------------------------------------------------------------------------------
-- Transaction helpers
--------------------------------------------------------------------------------

-- | A collection of functons to help construction transactions
--  from the cardano-cli.
class
  ( Era era,
    HasField "_minfeeA" (Core.PParams era) Natural,
    HasField "_keyDeposit" (Core.PParams era) Coin,
    HasField "_poolDeposit" (Core.PParams era) Coin,
    HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era)))
  ) =>
  CLI era
  where
  -- | The minimum fee calculation.
  -- Used for the default implentation of 'evaluateTransactionFee'.
  evaluateMinFee :: Core.PParams era -> Core.Tx era -> Coin

  -- | The consumed calculation.
  -- Used for the default implentation of 'evaluateTransactionBalance'.
  evaluateConsumed :: Core.PParams era -> UTxO era -> Core.TxBody era -> Core.Value era

  addKeyWitnesses :: Core.Tx era -> Set (WitVKey 'Witness (Crypto era)) -> Core.Tx era

  -- | Evaluate the difference between the value currently being consumed by
  -- a transaction and the number of lovelace being produced.
  -- This value will be zero for a valid transaction.
  evaluateTransactionBalance ::
    -- | The current protocol parameters.
    Core.PParams era ->
    -- | The UTxO relevant to the transaction.
    UTxO era ->
    -- | A predicate that a stake pool ID is new (i.e. unregistered).
    -- Typically this will be:
    --
    -- @
    --   (`Map.notMember` stakepools)
    -- @
    (KeyHash 'StakePool (Crypto era) -> Bool) ->
    -- | The transaction being evaluated for balance.
    Core.TxBody era ->
    -- | The difference between what the transaction consumes and what it produces.
    Core.Value era
  evaluateTransactionBalance PParams era
pp UTxO era
u KeyHash 'StakePool (Crypto era) -> Bool
isNewPool TxBody era
txb =
    PParams era -> UTxO era -> TxBody era -> Value era
forall era.
CLI era =>
PParams era -> UTxO era -> TxBody era -> Value era
evaluateConsumed PParams era
pp UTxO era
u TxBody era
txb Value era -> Value era -> Value era
forall t. Val t => t -> t -> t
<-> PParams era
-> (KeyHash 'StakePool (Crypto era) -> Bool)
-> TxBody era
-> Value era
forall era pp.
(Era era,
 HasField "certs" (TxBody era) (StrictSeq (DCert (Crypto era))),
 HasField "_keyDeposit" pp Coin, HasField "_poolDeposit" pp Coin) =>
pp
-> (KeyHash 'StakePool (Crypto era) -> Bool)
-> TxBody era
-> Value era
produced @era PParams era
pp KeyHash 'StakePool (Crypto era) -> Bool
isNewPool TxBody era
txb

  -- | Evaluate the fee for a given transaction.
  evaluateTransactionFee ::
    -- | The current protocol parameters.
    Core.PParams era ->
    -- | The transaction.
    Core.Tx era ->
    -- | The number of key witnesses still to be added to the transaction.
    Word ->
    -- | The required fee.
    Coin
  evaluateTransactionFee PParams era
pp Tx era
tx Word
numKeyWits =
    PParams era -> Tx era -> Coin
forall era. CLI era => PParams era -> Tx era -> Coin
evaluateMinFee @era PParams era
pp Tx era
tx'
    where
      sigSize :: Int64
sigSize = Word -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Int64) -> Word -> Int64
forall a b. (a -> b) -> a -> b
$ Proxy (DSIGN (Crypto era)) -> Word
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeSigDSIGN (Proxy (DSIGN (Crypto era))
forall k (t :: k). Proxy t
Proxy @(DSIGN (Crypto era)))
      dummySig :: SignedDSIGN
  (DSIGN (Crypto era))
  (Hash (HASH (Crypto era)) EraIndependentTxBody)
dummySig =
        SignedDSIGN
  (DSIGN (Crypto era))
  (Hash (HASH (Crypto era)) EraIndependentTxBody)
-> Either
     DecoderError
     (SignedDSIGN
        (DSIGN (Crypto era))
        (Hash (HASH (Crypto era)) EraIndependentTxBody))
-> SignedDSIGN
     (DSIGN (Crypto era))
     (Hash (HASH (Crypto era)) EraIndependentTxBody)
forall b a. b -> Either a b -> b
fromRight
          (String
-> SignedDSIGN
     (DSIGN (Crypto era))
     (Hash (HASH (Crypto era)) EraIndependentTxBody)
forall a. HasCallStack => String -> a
error String
"corrupt dummy signature")
          (Text
-> (forall s.
    Decoder
      s
      (SignedDSIGN
         (DSIGN (Crypto era))
         (Hash (HASH (Crypto era)) EraIndependentTxBody)))
-> LByteString
-> Either
     DecoderError
     (SignedDSIGN
        (DSIGN (Crypto era))
        (Hash (HASH (Crypto era)) EraIndependentTxBody))
forall a.
Text
-> (forall s. Decoder s a) -> LByteString -> Either DecoderError a
decodeFullDecoder Text
"dummy signature" forall s.
Decoder
  s
  (SignedDSIGN
     (DSIGN (Crypto era))
     (Hash (HASH (Crypto era)) EraIndependentTxBody))
forall v s a. DSIGNAlgorithm v => Decoder s (SignedDSIGN v a)
decodeSignedDSIGN (LByteString -> LByteString
forall a. ToCBOR a => a -> LByteString
serialize (LByteString -> LByteString) -> LByteString -> LByteString
forall a b. (a -> b) -> a -> b
$ Int64 -> Word8 -> LByteString
LBS.replicate Int64
sigSize Word8
0))
      vkeySize :: Int64
vkeySize = Word -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Int64) -> Word -> Int64
forall a b. (a -> b) -> a -> b
$ Proxy (DSIGN (Crypto era)) -> Word
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeVerKeyDSIGN (Proxy (DSIGN (Crypto era))
forall k (t :: k). Proxy t
Proxy @(DSIGN (Crypto era)))
      dummyVKey :: Word -> VKey 'Witness (Crypto era)
dummyVKey Word
w =
        let padding :: LByteString
padding = Int64 -> Word8 -> LByteString
LBS.replicate Int64
paddingSize Word8
0
            paddingSize :: Int64
paddingSize = Int64
vkeySize Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- LByteString -> Int64
LBS.length LByteString
sw
            sw :: LByteString
sw = Word -> LByteString
forall a. ToCBOR a => a -> LByteString
serialize Word
w
            keyBytes :: LByteString
keyBytes = LByteString -> LByteString
forall a. ToCBOR a => a -> LByteString
serialize (LByteString -> LByteString) -> LByteString -> LByteString
forall a b. (a -> b) -> a -> b
$ LByteString
padding LByteString -> LByteString -> LByteString
forall a. Semigroup a => a -> a -> a
<> LByteString
sw
         in VKey 'Witness (Crypto era)
-> Either DecoderError (VKey 'Witness (Crypto era))
-> VKey 'Witness (Crypto era)
forall b a. b -> Either a b -> b
fromRight (String -> VKey 'Witness (Crypto era)
forall a. HasCallStack => String -> a
error String
"corrupt dummy vkey") (LByteString -> Either DecoderError (VKey 'Witness (Crypto era))
forall a. FromCBOR a => LByteString -> Either DecoderError a
decodeFull LByteString
keyBytes)
      dummyKeyWits :: Set (WitVKey 'Witness (Crypto era))
dummyKeyWits = [WitVKey 'Witness (Crypto era)]
-> Set (WitVKey 'Witness (Crypto era))
forall a. Ord a => [a] -> Set a
Set.fromList ([WitVKey 'Witness (Crypto era)]
 -> Set (WitVKey 'Witness (Crypto era)))
-> [WitVKey 'Witness (Crypto era)]
-> Set (WitVKey 'Witness (Crypto era))
forall a b. (a -> b) -> a -> b
$
        ((Word -> WitVKey 'Witness (Crypto era))
 -> [Word] -> [WitVKey 'Witness (Crypto era)])
-> [Word]
-> (Word -> WitVKey 'Witness (Crypto era))
-> [WitVKey 'Witness (Crypto era)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Word -> WitVKey 'Witness (Crypto era))
-> [Word] -> [WitVKey 'Witness (Crypto era)]
forall a b. (a -> b) -> [a] -> [b]
map [Word
1 .. Word
numKeyWits] ((Word -> WitVKey 'Witness (Crypto era))
 -> [WitVKey 'Witness (Crypto era)])
-> (Word -> WitVKey 'Witness (Crypto era))
-> [WitVKey 'Witness (Crypto era)]
forall a b. (a -> b) -> a -> b
$
          \Word
x -> VKey 'Witness (Crypto era)
-> SignedDSIGN
     (DSIGN (Crypto era))
     (Hash (HASH (Crypto era)) EraIndependentTxBody)
-> WitVKey 'Witness (Crypto era)
forall (kr :: KeyRole) crypto.
(Typeable kr, Crypto crypto) =>
VKey kr crypto
-> SignedDSIGN crypto (Hash crypto EraIndependentTxBody)
-> WitVKey kr crypto
WitVKey (Word -> VKey 'Witness (Crypto era)
dummyVKey Word
x) SignedDSIGN
  (DSIGN (Crypto era))
  (Hash (HASH (Crypto era)) EraIndependentTxBody)
dummySig

      tx' :: Tx era
tx' = Tx era -> Set (WitVKey 'Witness (Crypto era)) -> Tx era
forall era.
CLI era =>
Tx era -> Set (WitVKey 'Witness (Crypto era)) -> Tx era
addKeyWitnesses @era Tx era
tx Set (WitVKey 'Witness (Crypto era))
dummyKeyWits

  -- | Evaluate the minimum lovelace that a given transaciton output must contain.
  evaluateMinLovelaceOutput :: Core.PParams era -> Core.TxOut era -> Coin

--------------------------------------------------------------------------------
-- Shelley specifics
--------------------------------------------------------------------------------

addShelleyKeyWitnesses ::
  ( Era era,
    Core.Witnesses era ~ WitnessSet era,
    Core.AnnotatedData (Core.Script era),
    ToCBOR (Core.AuxiliaryData era),
    ToCBOR (Core.TxBody era)
  ) =>
  Tx era ->
  Set (WitVKey 'Witness (Crypto era)) ->
  Tx era
addShelleyKeyWitnesses :: Tx era -> Set (WitVKey 'Witness (Crypto era)) -> Tx era
addShelleyKeyWitnesses (Tx TxBody era
b Witnesses era
ws StrictMaybe (AuxiliaryData era)
aux) Set (WitVKey 'Witness (Crypto era))
newWits = TxBody era
-> Witnesses era -> StrictMaybe (AuxiliaryData era) -> Tx era
forall era.
(Era era, ToCBOR (AuxiliaryData era), ToCBOR (TxBody era),
 ToCBOR (Witnesses era)) =>
TxBody era
-> Witnesses era -> StrictMaybe (AuxiliaryData era) -> Tx era
Tx TxBody era
b Witnesses era
WitnessSet era
ws' StrictMaybe (AuxiliaryData era)
aux
  where
    ws' :: WitnessSet era
ws' = Witnesses era
WitnessSet era
ws {addrWits :: Set (WitVKey 'Witness (Crypto era))
addrWits = Set (WitVKey 'Witness (Crypto era))
-> Set (WitVKey 'Witness (Crypto era))
-> Set (WitVKey 'Witness (Crypto era))
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set (WitVKey 'Witness (Crypto era))
newWits (WitnessSet era
-> (Era era, AnnotatedData (Script era)) =>
   Set (WitVKey 'Witness (Crypto era))
forall era.
WitnessSet era
-> (Era era, AnnotatedData (Script era)) =>
   Set (WitVKey 'Witness (Crypto era))
addrWits Witnesses era
WitnessSet era
ws)}

instance CC.Crypto c => CLI (ShelleyEra c) where
  evaluateMinFee :: PParams (ShelleyEra c) -> Tx (ShelleyEra c) -> Coin
evaluateMinFee = PParams (ShelleyEra c) -> Tx (ShelleyEra c) -> Coin
forall pp tx.
(HasField "_minfeeA" pp Natural, HasField "_minfeeB" pp Natural,
 HasField "txsize" tx Integer) =>
pp -> tx -> Coin
minfee

  evaluateConsumed :: PParams (ShelleyEra c)
-> UTxO (ShelleyEra c)
-> TxBody (ShelleyEra c)
-> Value (ShelleyEra c)
evaluateConsumed = PParams (ShelleyEra c)
-> UTxO (ShelleyEra c)
-> TxBody (ShelleyEra c)
-> Value (ShelleyEra c)
forall era pp.
(Era era,
 HasField "certs" (TxBody era) (StrictSeq (DCert (Crypto era))),
 HasField "inputs" (TxBody era) (Set (TxIn (Crypto era))),
 HasField "wdrls" (TxBody era) (Wdrl (Crypto era)),
 HasField "_keyDeposit" pp Coin) =>
pp -> UTxO era -> TxBody era -> Value era
consumed

  addKeyWitnesses :: Tx (ShelleyEra c)
-> Set (WitVKey 'Witness (Crypto (ShelleyEra c)))
-> Tx (ShelleyEra c)
addKeyWitnesses = Tx (ShelleyEra c)
-> Set (WitVKey 'Witness (Crypto (ShelleyEra c)))
-> Tx (ShelleyEra c)
forall era.
(Era era, Witnesses era ~ WitnessSet era,
 AnnotatedData (Script era), ToCBOR (AuxiliaryData era),
 ToCBOR (TxBody era)) =>
Tx era -> Set (WitVKey 'Witness (Crypto era)) -> Tx era
addShelleyKeyWitnesses

  evaluateMinLovelaceOutput :: PParams (ShelleyEra c) -> TxOut (ShelleyEra c) -> Coin
evaluateMinLovelaceOutput PParams (ShelleyEra c)
pp TxOut (ShelleyEra c)
_out = PParams' Identity (ShelleyEra c) -> HKD Identity Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_minUTxOValue PParams (ShelleyEra c)
PParams' Identity (ShelleyEra c)
pp

--------------------------------------------------------------------------------
-- CBOR instances
--------------------------------------------------------------------------------

instance ToCBOR RewardParams where
  toCBOR :: RewardParams -> Encoding
toCBOR (RewardParams Natural
p1 NonNegativeInterval
p2 Coin
p3 Coin
p4) =
    Encode ('Closed 'Dense) RewardParams -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) RewardParams -> Encoding)
-> Encode ('Closed 'Dense) RewardParams -> Encoding
forall a b. (a -> b) -> a -> b
$
      (Natural -> NonNegativeInterval -> Coin -> Coin -> RewardParams)
-> Encode
     ('Closed 'Dense)
     (Natural -> NonNegativeInterval -> Coin -> Coin -> RewardParams)
forall t. t -> Encode ('Closed 'Dense) t
Rec Natural -> NonNegativeInterval -> Coin -> Coin -> RewardParams
RewardParams
        Encode
  ('Closed 'Dense)
  (Natural -> NonNegativeInterval -> Coin -> Coin -> RewardParams)
-> Encode ('Closed 'Dense) Natural
-> Encode
     ('Closed 'Dense)
     (NonNegativeInterval -> Coin -> Coin -> RewardParams)
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)
  (NonNegativeInterval -> Coin -> Coin -> RewardParams)
-> Encode ('Closed 'Dense) NonNegativeInterval
-> Encode ('Closed 'Dense) (Coin -> Coin -> RewardParams)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> NonNegativeInterval -> Encode ('Closed 'Dense) NonNegativeInterval
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To NonNegativeInterval
p2
        Encode ('Closed 'Dense) (Coin -> Coin -> RewardParams)
-> Encode ('Closed 'Dense) Coin
-> Encode ('Closed 'Dense) (Coin -> RewardParams)
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 -> RewardParams)
-> Encode ('Closed 'Dense) Coin
-> Encode ('Closed 'Dense) RewardParams
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

instance FromCBOR RewardParams where
  fromCBOR :: Decoder s RewardParams
fromCBOR =
    Decode ('Closed 'Dense) RewardParams -> Decoder s RewardParams
forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) RewardParams -> Decoder s RewardParams)
-> Decode ('Closed 'Dense) RewardParams -> Decoder s RewardParams
forall a b. (a -> b) -> a -> b
$
      (Natural -> NonNegativeInterval -> Coin -> Coin -> RewardParams)
-> Decode
     ('Closed 'Dense)
     (Natural -> NonNegativeInterval -> Coin -> Coin -> RewardParams)
forall t. t -> Decode ('Closed 'Dense) t
RecD Natural -> NonNegativeInterval -> Coin -> Coin -> RewardParams
RewardParams
        Decode
  ('Closed 'Dense)
  (Natural -> NonNegativeInterval -> Coin -> Coin -> RewardParams)
-> Decode ('Closed Any) Natural
-> Decode
     ('Closed 'Dense)
     (NonNegativeInterval -> Coin -> Coin -> RewardParams)
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)
  (NonNegativeInterval -> Coin -> Coin -> RewardParams)
-> Decode ('Closed Any) NonNegativeInterval
-> Decode ('Closed 'Dense) (Coin -> Coin -> RewardParams)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) NonNegativeInterval
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
        Decode ('Closed 'Dense) (Coin -> Coin -> RewardParams)
-> Decode ('Closed Any) Coin
-> Decode ('Closed 'Dense) (Coin -> RewardParams)
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 -> RewardParams)
-> Decode ('Closed Any) Coin
-> Decode ('Closed 'Dense) RewardParams
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 ToCBOR RewardInfoPool where
  toCBOR :: RewardInfoPool -> Encoding
toCBOR (RewardInfoPool Coin
p1 Coin
p2 Coin
p3 Coin
p4 UnitInterval
p5 Double
d6) =
    Encode ('Closed 'Dense) RewardInfoPool -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) RewardInfoPool -> Encoding)
-> Encode ('Closed 'Dense) RewardInfoPool -> Encoding
forall a b. (a -> b) -> a -> b
$
      (Coin
 -> Coin
 -> Coin
 -> Coin
 -> UnitInterval
 -> Double
 -> RewardInfoPool)
-> Encode
     ('Closed 'Dense)
     (Coin
      -> Coin
      -> Coin
      -> Coin
      -> UnitInterval
      -> Double
      -> RewardInfoPool)
forall t. t -> Encode ('Closed 'Dense) t
Rec Coin
-> Coin -> Coin -> Coin -> UnitInterval -> Double -> RewardInfoPool
RewardInfoPool
        Encode
  ('Closed 'Dense)
  (Coin
   -> Coin
   -> Coin
   -> Coin
   -> UnitInterval
   -> Double
   -> RewardInfoPool)
-> Encode ('Closed 'Dense) Coin
-> Encode
     ('Closed 'Dense)
     (Coin -> Coin -> Coin -> UnitInterval -> Double -> RewardInfoPool)
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
p1
        Encode
  ('Closed 'Dense)
  (Coin -> Coin -> Coin -> UnitInterval -> Double -> RewardInfoPool)
-> Encode ('Closed 'Dense) Coin
-> Encode
     ('Closed 'Dense)
     (Coin -> Coin -> UnitInterval -> Double -> RewardInfoPool)
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
p2
        Encode
  ('Closed 'Dense)
  (Coin -> Coin -> UnitInterval -> Double -> RewardInfoPool)
-> Encode ('Closed 'Dense) Coin
-> Encode
     ('Closed 'Dense) (Coin -> UnitInterval -> Double -> RewardInfoPool)
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 -> UnitInterval -> Double -> RewardInfoPool)
-> Encode ('Closed 'Dense) Coin
-> Encode
     ('Closed 'Dense) (UnitInterval -> Double -> RewardInfoPool)
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) (UnitInterval -> Double -> RewardInfoPool)
-> Encode ('Closed 'Dense) UnitInterval
-> Encode ('Closed 'Dense) (Double -> RewardInfoPool)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> UnitInterval -> Encode ('Closed 'Dense) UnitInterval
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To UnitInterval
p5
        Encode ('Closed 'Dense) (Double -> RewardInfoPool)
-> Encode ('Closed 'Dense) Double
-> Encode ('Closed 'Dense) RewardInfoPool
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
d6

instance FromCBOR RewardInfoPool where
  fromCBOR :: Decoder s RewardInfoPool
fromCBOR =
    Decode ('Closed 'Dense) RewardInfoPool -> Decoder s RewardInfoPool
forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) RewardInfoPool
 -> Decoder s RewardInfoPool)
-> Decode ('Closed 'Dense) RewardInfoPool
-> Decoder s RewardInfoPool
forall a b. (a -> b) -> a -> b
$
      (Coin
 -> Coin
 -> Coin
 -> Coin
 -> UnitInterval
 -> Double
 -> RewardInfoPool)
-> Decode
     ('Closed 'Dense)
     (Coin
      -> Coin
      -> Coin
      -> Coin
      -> UnitInterval
      -> Double
      -> RewardInfoPool)
forall t. t -> Decode ('Closed 'Dense) t
RecD Coin
-> Coin -> Coin -> Coin -> UnitInterval -> Double -> RewardInfoPool
RewardInfoPool
        Decode
  ('Closed 'Dense)
  (Coin
   -> Coin
   -> Coin
   -> Coin
   -> UnitInterval
   -> Double
   -> RewardInfoPool)
-> Decode ('Closed Any) Coin
-> Decode
     ('Closed 'Dense)
     (Coin -> Coin -> Coin -> UnitInterval -> Double -> RewardInfoPool)
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 -> UnitInterval -> Double -> RewardInfoPool)
-> Decode ('Closed Any) Coin
-> Decode
     ('Closed 'Dense)
     (Coin -> Coin -> UnitInterval -> Double -> RewardInfoPool)
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 -> UnitInterval -> Double -> RewardInfoPool)
-> Decode ('Closed Any) Coin
-> Decode
     ('Closed 'Dense) (Coin -> UnitInterval -> Double -> RewardInfoPool)
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 -> UnitInterval -> Double -> RewardInfoPool)
-> Decode ('Closed Any) Coin
-> Decode
     ('Closed 'Dense) (UnitInterval -> Double -> RewardInfoPool)
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) (UnitInterval -> Double -> RewardInfoPool)
-> Decode ('Closed Any) UnitInterval
-> Decode ('Closed 'Dense) (Double -> RewardInfoPool)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) UnitInterval
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
        Decode ('Closed 'Dense) (Double -> RewardInfoPool)
-> Decode ('Closed 'Dense) Double
-> Decode ('Closed 'Dense) RewardInfoPool
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