{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- |
-- Module      : LedgerState
-- Description : Operational Rules
--
-- This module implements the operation rules for treating UTxO transactions ('Tx')
-- as state transformations on a ledger state ('LedgerState'),
-- as specified in /A Simplified Formal Specification of a UTxO Ledger/.
module Shelley.Spec.Ledger.LedgerState
  ( AccountState (..),
    DPState (..),
    DState (..),
    EpochState (..),
    FutureGenDeleg (..),
    InstantaneousRewards (..),
    Ix,
    KeyPairs,
    LedgerState (..),
    PPUPState (..),
    PState (..),
    RewardAccounts,
    RewardUpdate (..),
    UTxOState (..),
    depositPoolChange,
    emptyAccount,
    emptyDPState,
    emptyDState,
    emptyEpochState,
    emptyInstantaneousRewards,
    emptyLedgerState,
    emptyPPUPState,
    emptyPState,
    emptyRewardUpdate,
    emptyUTxOState,
    pvCanFollow,
    reapRewards,
    totalInstantaneousReservesRewards,
    updatePpup,

    -- * state transitions
    emptyDelegation,

    -- * Genesis State
    genesisState,

    -- * Validation
    WitHashes (..),
    nullWitHashes,
    diffWitHashes,
    minfee,
    minfeeBound,
    txsize,
    txsizeBound,
    produced,
    consumed,
    verifiedWits,
    witsVKeyNeeded,
    witsFromWitnessSet,

    -- * DelegationState
    keyRefunds,

    -- * Epoch boundary
    stakeDistr,
    applyRUpd,
    createRUpd,
    --
    NewEpochState (..),
    getGKeys,
    updateNES,
    circulation,

    -- * Decay
    decayFactor,

    -- * Remove Bootstrap Redeem Addresses
    returnRedeemAddrsToReserves,
  )
where

import Cardano.Binary
  ( FromCBOR (..),
    ToCBOR (..),
    encodeListLen,
  )
import qualified Cardano.Ledger.Core as Core
import qualified Cardano.Ledger.Crypto as CC (Crypto)
import Cardano.Ledger.Era (Crypto, Era)
import Cardano.Ledger.Shelley.Constraints (ShelleyBased, TxBodyConstraints)
import Cardano.Ledger.Val ((<+>), (<->), (<×>))
import qualified Cardano.Ledger.Val as Val
import Control.DeepSeq (NFData)
import Control.Monad.Trans.Reader (asks)
import Control.SetAlgebra (Bimap, biMapEmpty, dom, eval, forwards, range, (∈), (∪+), (▷), (◁))
import qualified Data.ByteString.Lazy as BSL (length)
import Data.Coerce (coerce)
import Data.Foldable (fold, toList)
import Data.Group (invert)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe)
import Data.Ratio ((%))
import Data.Sequence.Strict (StrictSeq)
import Data.Set (Set)
import qualified Data.Set as Set
import GHC.Generics (Generic)
import GHC.Records (HasField (..))
import NoThunks.Class (NoThunks (..))
import Quiet
import Shelley.Spec.Ledger.Address (Addr (..), bootstrapKeyHash, isBootstrapRedeemer)
import Shelley.Spec.Ledger.Address.Bootstrap
  ( BootstrapWitness (..),
    bootstrapWitKeyHash,
    verifyBootstrapWit,
  )
import Shelley.Spec.Ledger.BaseTypes
  ( Globals (..),
    ShelleyBase,
    StrictMaybe (..),
    activeSlotVal,
    intervalValue,
    unitIntervalToRational,
  )
import Shelley.Spec.Ledger.Coin
  ( Coin (..),
    DeltaCoin (..),
    addDeltaCoin,
    rationalToCoinViaFloor,
    toDeltaCoin,
  )
import Shelley.Spec.Ledger.Credential (Credential (..))
import Shelley.Spec.Ledger.Delegation.Certificates
  ( DCert (..),
    PoolDistr (..),
    delegCWitness,
    genesisCWitness,
    isDeRegKey,
    poolCWitness,
    requiresVKeyWitness,
  )
import Shelley.Spec.Ledger.EpochBoundary
  ( BlocksMade (..),
    SnapShot (..),
    SnapShots (..),
    Stake (..),
    aggregateUtxoCoinByCredential,
    emptySnapShots,
  )
import Shelley.Spec.Ledger.Hashing (hashAnnotated)
import Shelley.Spec.Ledger.Keys
  ( DSignable,
    GenDelegPair (..),
    GenDelegs (..),
    Hash,
    KeyHash (..),
    KeyPair,
    KeyRole (..),
    VKey,
    asWitness,
  )
import Shelley.Spec.Ledger.PParams
  ( PParams,
    PParams' (..),
    ProposedPPUpdates (..),
    ProtVer (..),
    Update (..),
    emptyPPPUpdates,
    emptyPParams,
  )
import Shelley.Spec.Ledger.Rewards
  ( Likelihood (..),
    NonMyopic (..),
    applyDecay,
    emptyNonMyopic,
    reward,
  )
import Shelley.Spec.Ledger.Serialization (decodeRecordNamed, mapFromCBOR, mapToCBOR)
import Shelley.Spec.Ledger.Slot
  ( EpochNo (..),
    EpochSize,
    SlotNo (..),
  )
import Shelley.Spec.Ledger.Tx
  ( Tx (..),
    WitnessSet,
    WitnessSetHKD (..),
    addrWits,
    extractKeyHashWitnessSet,
  )
import Shelley.Spec.Ledger.TxBody
  ( EraIndependentTxBody,
    Ix,
    PoolCert (..),
    PoolParams (..),
    Ptr (..),
    RewardAcnt (..),
    TxIn (..),
    TxOut (..),
    Wdrl (..),
    WitVKey (..),
    getRwdCred,
    witKeyHash,
  )
import Shelley.Spec.Ledger.UTxO
  ( UTxO (..),
    balance,
    totalDeposits,
    txinLookup,
    txins,
    txouts,
    txup,
    verifyWitVKey,
  )

-- | Representation of a list of pairs of key pairs, e.g., pay and stake keys
type KeyPairs crypto = [(KeyPair 'Payment crypto, KeyPair 'Staking crypto)]

type RewardAccounts crypto =
  Map (Credential 'Staking crypto) Coin

data FutureGenDeleg crypto = FutureGenDeleg
  { FutureGenDeleg crypto -> SlotNo
fGenDelegSlot :: !SlotNo,
    FutureGenDeleg crypto -> KeyHash 'Genesis crypto
fGenDelegGenKeyHash :: !(KeyHash 'Genesis crypto)
  }
  deriving (Int -> FutureGenDeleg crypto -> ShowS
[FutureGenDeleg crypto] -> ShowS
FutureGenDeleg crypto -> String
(Int -> FutureGenDeleg crypto -> ShowS)
-> (FutureGenDeleg crypto -> String)
-> ([FutureGenDeleg crypto] -> ShowS)
-> Show (FutureGenDeleg crypto)
forall crypto. Int -> FutureGenDeleg crypto -> ShowS
forall crypto. [FutureGenDeleg crypto] -> ShowS
forall crypto. FutureGenDeleg crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FutureGenDeleg crypto] -> ShowS
$cshowList :: forall crypto. [FutureGenDeleg crypto] -> ShowS
show :: FutureGenDeleg crypto -> String
$cshow :: forall crypto. FutureGenDeleg crypto -> String
showsPrec :: Int -> FutureGenDeleg crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> FutureGenDeleg crypto -> ShowS
Show, FutureGenDeleg crypto -> FutureGenDeleg crypto -> Bool
(FutureGenDeleg crypto -> FutureGenDeleg crypto -> Bool)
-> (FutureGenDeleg crypto -> FutureGenDeleg crypto -> Bool)
-> Eq (FutureGenDeleg crypto)
forall crypto.
FutureGenDeleg crypto -> FutureGenDeleg crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FutureGenDeleg crypto -> FutureGenDeleg crypto -> Bool
$c/= :: forall crypto.
FutureGenDeleg crypto -> FutureGenDeleg crypto -> Bool
== :: FutureGenDeleg crypto -> FutureGenDeleg crypto -> Bool
$c== :: forall crypto.
FutureGenDeleg crypto -> FutureGenDeleg crypto -> Bool
Eq, Eq (FutureGenDeleg crypto)
Eq (FutureGenDeleg crypto)
-> (FutureGenDeleg crypto -> FutureGenDeleg crypto -> Ordering)
-> (FutureGenDeleg crypto -> FutureGenDeleg crypto -> Bool)
-> (FutureGenDeleg crypto -> FutureGenDeleg crypto -> Bool)
-> (FutureGenDeleg crypto -> FutureGenDeleg crypto -> Bool)
-> (FutureGenDeleg crypto -> FutureGenDeleg crypto -> Bool)
-> (FutureGenDeleg crypto
    -> FutureGenDeleg crypto -> FutureGenDeleg crypto)
-> (FutureGenDeleg crypto
    -> FutureGenDeleg crypto -> FutureGenDeleg crypto)
-> Ord (FutureGenDeleg crypto)
FutureGenDeleg crypto -> FutureGenDeleg crypto -> Bool
FutureGenDeleg crypto -> FutureGenDeleg crypto -> Ordering
FutureGenDeleg crypto
-> FutureGenDeleg crypto -> FutureGenDeleg crypto
forall crypto. Eq (FutureGenDeleg crypto)
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall crypto.
FutureGenDeleg crypto -> FutureGenDeleg crypto -> Bool
forall crypto.
FutureGenDeleg crypto -> FutureGenDeleg crypto -> Ordering
forall crypto.
FutureGenDeleg crypto
-> FutureGenDeleg crypto -> FutureGenDeleg crypto
min :: FutureGenDeleg crypto
-> FutureGenDeleg crypto -> FutureGenDeleg crypto
$cmin :: forall crypto.
FutureGenDeleg crypto
-> FutureGenDeleg crypto -> FutureGenDeleg crypto
max :: FutureGenDeleg crypto
-> FutureGenDeleg crypto -> FutureGenDeleg crypto
$cmax :: forall crypto.
FutureGenDeleg crypto
-> FutureGenDeleg crypto -> FutureGenDeleg crypto
>= :: FutureGenDeleg crypto -> FutureGenDeleg crypto -> Bool
$c>= :: forall crypto.
FutureGenDeleg crypto -> FutureGenDeleg crypto -> Bool
> :: FutureGenDeleg crypto -> FutureGenDeleg crypto -> Bool
$c> :: forall crypto.
FutureGenDeleg crypto -> FutureGenDeleg crypto -> Bool
<= :: FutureGenDeleg crypto -> FutureGenDeleg crypto -> Bool
$c<= :: forall crypto.
FutureGenDeleg crypto -> FutureGenDeleg crypto -> Bool
< :: FutureGenDeleg crypto -> FutureGenDeleg crypto -> Bool
$c< :: forall crypto.
FutureGenDeleg crypto -> FutureGenDeleg crypto -> Bool
compare :: FutureGenDeleg crypto -> FutureGenDeleg crypto -> Ordering
$ccompare :: forall crypto.
FutureGenDeleg crypto -> FutureGenDeleg crypto -> Ordering
$cp1Ord :: forall crypto. Eq (FutureGenDeleg crypto)
Ord, (forall x. FutureGenDeleg crypto -> Rep (FutureGenDeleg crypto) x)
-> (forall x.
    Rep (FutureGenDeleg crypto) x -> FutureGenDeleg crypto)
-> Generic (FutureGenDeleg crypto)
forall x. Rep (FutureGenDeleg crypto) x -> FutureGenDeleg crypto
forall x. FutureGenDeleg crypto -> Rep (FutureGenDeleg crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x.
Rep (FutureGenDeleg crypto) x -> FutureGenDeleg crypto
forall crypto x.
FutureGenDeleg crypto -> Rep (FutureGenDeleg crypto) x
$cto :: forall crypto x.
Rep (FutureGenDeleg crypto) x -> FutureGenDeleg crypto
$cfrom :: forall crypto x.
FutureGenDeleg crypto -> Rep (FutureGenDeleg crypto) x
Generic)

instance NoThunks (FutureGenDeleg crypto)

instance NFData (FutureGenDeleg crypto)

instance CC.Crypto crypto => ToCBOR (FutureGenDeleg crypto) where
  toCBOR :: FutureGenDeleg crypto -> Encoding
toCBOR (FutureGenDeleg SlotNo
a KeyHash 'Genesis crypto
b) =
    Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SlotNo -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR SlotNo
a Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> KeyHash 'Genesis crypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR KeyHash 'Genesis crypto
b

instance CC.Crypto crypto => FromCBOR (FutureGenDeleg crypto) where
  fromCBOR :: Decoder s (FutureGenDeleg crypto)
fromCBOR = do
    Text
-> (FutureGenDeleg crypto -> Int)
-> Decoder s (FutureGenDeleg crypto)
-> Decoder s (FutureGenDeleg crypto)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"FutureGenDeleg" (Int -> FutureGenDeleg crypto -> Int
forall a b. a -> b -> a
const Int
2) (Decoder s (FutureGenDeleg crypto)
 -> Decoder s (FutureGenDeleg crypto))
-> Decoder s (FutureGenDeleg crypto)
-> Decoder s (FutureGenDeleg crypto)
forall a b. (a -> b) -> a -> b
$ do
      SlotNo
a <- Decoder s SlotNo
forall a s. FromCBOR a => Decoder s a
fromCBOR
      KeyHash 'Genesis crypto
b <- Decoder s (KeyHash 'Genesis crypto)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      FutureGenDeleg crypto -> Decoder s (FutureGenDeleg crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FutureGenDeleg crypto -> Decoder s (FutureGenDeleg crypto))
-> FutureGenDeleg crypto -> Decoder s (FutureGenDeleg crypto)
forall a b. (a -> b) -> a -> b
$ SlotNo -> KeyHash 'Genesis crypto -> FutureGenDeleg crypto
forall crypto.
SlotNo -> KeyHash 'Genesis crypto -> FutureGenDeleg crypto
FutureGenDeleg SlotNo
a KeyHash 'Genesis crypto
b

data InstantaneousRewards crypto = InstantaneousRewards
  { InstantaneousRewards crypto
-> Map (Credential 'Staking crypto) Coin
iRReserves :: !(Map (Credential 'Staking crypto) Coin),
    InstantaneousRewards crypto
-> Map (Credential 'Staking crypto) Coin
iRTreasury :: !(Map (Credential 'Staking crypto) Coin)
  }
  deriving (Int -> InstantaneousRewards crypto -> ShowS
[InstantaneousRewards crypto] -> ShowS
InstantaneousRewards crypto -> String
(Int -> InstantaneousRewards crypto -> ShowS)
-> (InstantaneousRewards crypto -> String)
-> ([InstantaneousRewards crypto] -> ShowS)
-> Show (InstantaneousRewards crypto)
forall crypto. Int -> InstantaneousRewards crypto -> ShowS
forall crypto. [InstantaneousRewards crypto] -> ShowS
forall crypto. InstantaneousRewards crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InstantaneousRewards crypto] -> ShowS
$cshowList :: forall crypto. [InstantaneousRewards crypto] -> ShowS
show :: InstantaneousRewards crypto -> String
$cshow :: forall crypto. InstantaneousRewards crypto -> String
showsPrec :: Int -> InstantaneousRewards crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> InstantaneousRewards crypto -> ShowS
Show, InstantaneousRewards crypto -> InstantaneousRewards crypto -> Bool
(InstantaneousRewards crypto
 -> InstantaneousRewards crypto -> Bool)
-> (InstantaneousRewards crypto
    -> InstantaneousRewards crypto -> Bool)
-> Eq (InstantaneousRewards crypto)
forall crypto.
InstantaneousRewards crypto -> InstantaneousRewards crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InstantaneousRewards crypto -> InstantaneousRewards crypto -> Bool
$c/= :: forall crypto.
InstantaneousRewards crypto -> InstantaneousRewards crypto -> Bool
== :: InstantaneousRewards crypto -> InstantaneousRewards crypto -> Bool
$c== :: forall crypto.
InstantaneousRewards crypto -> InstantaneousRewards crypto -> Bool
Eq, (forall x.
 InstantaneousRewards crypto -> Rep (InstantaneousRewards crypto) x)
-> (forall x.
    Rep (InstantaneousRewards crypto) x -> InstantaneousRewards crypto)
-> Generic (InstantaneousRewards crypto)
forall x.
Rep (InstantaneousRewards crypto) x -> InstantaneousRewards crypto
forall x.
InstantaneousRewards crypto -> Rep (InstantaneousRewards crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x.
Rep (InstantaneousRewards crypto) x -> InstantaneousRewards crypto
forall crypto x.
InstantaneousRewards crypto -> Rep (InstantaneousRewards crypto) x
$cto :: forall crypto x.
Rep (InstantaneousRewards crypto) x -> InstantaneousRewards crypto
$cfrom :: forall crypto x.
InstantaneousRewards crypto -> Rep (InstantaneousRewards crypto) x
Generic)

totalInstantaneousReservesRewards :: InstantaneousRewards crypto -> Coin
totalInstantaneousReservesRewards :: InstantaneousRewards crypto -> Coin
totalInstantaneousReservesRewards (InstantaneousRewards Map (Credential 'Staking crypto) Coin
irR Map (Credential 'Staking crypto) Coin
_) = Map (Credential 'Staking crypto) Coin -> Coin
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Map (Credential 'Staking crypto) Coin
irR

instance NoThunks (InstantaneousRewards crypto)

instance NFData (InstantaneousRewards crypto)

instance
  CC.Crypto crypto =>
  ToCBOR (InstantaneousRewards crypto)
  where
  toCBOR :: InstantaneousRewards crypto -> Encoding
toCBOR (InstantaneousRewards Map (Credential 'Staking crypto) Coin
irR Map (Credential 'Staking crypto) Coin
irT) =
    Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map (Credential 'Staking crypto) Coin -> Encoding
forall a b. (ToCBOR a, ToCBOR b) => Map a b -> Encoding
mapToCBOR Map (Credential 'Staking crypto) Coin
irR Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map (Credential 'Staking crypto) Coin -> Encoding
forall a b. (ToCBOR a, ToCBOR b) => Map a b -> Encoding
mapToCBOR Map (Credential 'Staking crypto) Coin
irT

instance
  CC.Crypto crypto =>
  FromCBOR (InstantaneousRewards crypto)
  where
  fromCBOR :: Decoder s (InstantaneousRewards crypto)
fromCBOR = do
    Text
-> (InstantaneousRewards crypto -> Int)
-> Decoder s (InstantaneousRewards crypto)
-> Decoder s (InstantaneousRewards crypto)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"InstantaneousRewards" (Int -> InstantaneousRewards crypto -> Int
forall a b. a -> b -> a
const Int
2) (Decoder s (InstantaneousRewards crypto)
 -> Decoder s (InstantaneousRewards crypto))
-> Decoder s (InstantaneousRewards crypto)
-> Decoder s (InstantaneousRewards crypto)
forall a b. (a -> b) -> a -> b
$ do
      Map (Credential 'Staking crypto) Coin
irR <- Decoder s (Map (Credential 'Staking crypto) Coin)
forall a b s.
(Ord a, FromCBOR a, FromCBOR b) =>
Decoder s (Map a b)
mapFromCBOR
      Map (Credential 'Staking crypto) Coin
irT <- Decoder s (Map (Credential 'Staking crypto) Coin)
forall a b s.
(Ord a, FromCBOR a, FromCBOR b) =>
Decoder s (Map a b)
mapFromCBOR
      InstantaneousRewards crypto
-> Decoder s (InstantaneousRewards crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InstantaneousRewards crypto
 -> Decoder s (InstantaneousRewards crypto))
-> InstantaneousRewards crypto
-> Decoder s (InstantaneousRewards crypto)
forall a b. (a -> b) -> a -> b
$ Map (Credential 'Staking crypto) Coin
-> Map (Credential 'Staking crypto) Coin
-> InstantaneousRewards crypto
forall crypto.
Map (Credential 'Staking crypto) Coin
-> Map (Credential 'Staking crypto) Coin
-> InstantaneousRewards crypto
InstantaneousRewards Map (Credential 'Staking crypto) Coin
irR Map (Credential 'Staking crypto) Coin
irT

-- | State of staking pool delegations and rewards
data DState crypto = DState
  { -- | The active reward accounts.
    DState crypto -> RewardAccounts crypto
_rewards :: !(RewardAccounts crypto),
    -- | The current delegations.
    DState crypto
-> Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
_delegations :: !(Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto)),
    -- | The pointed to hash keys.
    DState crypto -> Bimap Ptr (Credential 'Staking crypto)
_ptrs :: !(Bimap Ptr (Credential 'Staking crypto)),
    -- | future genesis key delegations
    DState crypto -> Map (FutureGenDeleg crypto) (GenDelegPair crypto)
_fGenDelegs :: !(Map (FutureGenDeleg crypto) (GenDelegPair crypto)),
    -- | Genesis key delegations
    DState crypto -> GenDelegs crypto
_genDelegs :: !(GenDelegs crypto),
    -- | Instantaneous Rewards
    DState crypto -> InstantaneousRewards crypto
_irwd :: !(InstantaneousRewards crypto)
  }
  deriving (Int -> DState crypto -> ShowS
[DState crypto] -> ShowS
DState crypto -> String
(Int -> DState crypto -> ShowS)
-> (DState crypto -> String)
-> ([DState crypto] -> ShowS)
-> Show (DState crypto)
forall crypto. Int -> DState crypto -> ShowS
forall crypto. [DState crypto] -> ShowS
forall crypto. DState crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DState crypto] -> ShowS
$cshowList :: forall crypto. [DState crypto] -> ShowS
show :: DState crypto -> String
$cshow :: forall crypto. DState crypto -> String
showsPrec :: Int -> DState crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> DState crypto -> ShowS
Show, DState crypto -> DState crypto -> Bool
(DState crypto -> DState crypto -> Bool)
-> (DState crypto -> DState crypto -> Bool) -> Eq (DState crypto)
forall crypto. DState crypto -> DState crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DState crypto -> DState crypto -> Bool
$c/= :: forall crypto. DState crypto -> DState crypto -> Bool
== :: DState crypto -> DState crypto -> Bool
$c== :: forall crypto. DState crypto -> DState crypto -> Bool
Eq, (forall x. DState crypto -> Rep (DState crypto) x)
-> (forall x. Rep (DState crypto) x -> DState crypto)
-> Generic (DState crypto)
forall x. Rep (DState crypto) x -> DState crypto
forall x. DState crypto -> Rep (DState crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x. Rep (DState crypto) x -> DState crypto
forall crypto x. DState crypto -> Rep (DState crypto) x
$cto :: forall crypto x. Rep (DState crypto) x -> DState crypto
$cfrom :: forall crypto x. DState crypto -> Rep (DState crypto) x
Generic)

instance NoThunks (DState crypto)

instance NFData (DState crypto)

instance
  CC.Crypto crypto =>
  ToCBOR (DState crypto)
  where
  toCBOR :: DState crypto -> Encoding
toCBOR (DState RewardAccounts crypto
rw Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
dlg Bimap Ptr (Credential 'Staking crypto)
p Map (FutureGenDeleg crypto) (GenDelegPair crypto)
fgs GenDelegs crypto
gs InstantaneousRewards crypto
ir) =
    Word -> Encoding
encodeListLen Word
6
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> RewardAccounts crypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR RewardAccounts crypto
rw
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
-> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
dlg
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Bimap Ptr (Credential 'Staking crypto) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Bimap Ptr (Credential 'Staking crypto)
p
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map (FutureGenDeleg crypto) (GenDelegPair crypto) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Map (FutureGenDeleg crypto) (GenDelegPair crypto)
fgs
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> GenDelegs crypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR GenDelegs crypto
gs
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> InstantaneousRewards crypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR InstantaneousRewards crypto
ir

instance
  CC.Crypto crypto =>
  FromCBOR (DState crypto)
  where
  fromCBOR :: Decoder s (DState crypto)
fromCBOR = do
    Text
-> (DState crypto -> Int)
-> Decoder s (DState crypto)
-> Decoder s (DState crypto)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"DState" (Int -> DState crypto -> Int
forall a b. a -> b -> a
const Int
6) (Decoder s (DState crypto) -> Decoder s (DState crypto))
-> Decoder s (DState crypto) -> Decoder s (DState crypto)
forall a b. (a -> b) -> a -> b
$ do
      RewardAccounts crypto
rw <- Decoder s (RewardAccounts crypto)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
dlg <- Decoder
  s (Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto))
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Bimap Ptr (Credential 'Staking crypto)
p <- Decoder s (Bimap Ptr (Credential 'Staking crypto))
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Map (FutureGenDeleg crypto) (GenDelegPair crypto)
fgs <- Decoder s (Map (FutureGenDeleg crypto) (GenDelegPair crypto))
forall a s. FromCBOR a => Decoder s a
fromCBOR
      GenDelegs crypto
gs <- Decoder s (GenDelegs crypto)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      InstantaneousRewards crypto
ir <- Decoder s (InstantaneousRewards crypto)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      DState crypto -> Decoder s (DState crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DState crypto -> Decoder s (DState crypto))
-> DState crypto -> Decoder s (DState crypto)
forall a b. (a -> b) -> a -> b
$ RewardAccounts crypto
-> Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
-> Bimap Ptr (Credential 'Staking crypto)
-> Map (FutureGenDeleg crypto) (GenDelegPair crypto)
-> GenDelegs crypto
-> InstantaneousRewards crypto
-> DState crypto
forall crypto.
RewardAccounts crypto
-> Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
-> Bimap Ptr (Credential 'Staking crypto)
-> Map (FutureGenDeleg crypto) (GenDelegPair crypto)
-> GenDelegs crypto
-> InstantaneousRewards crypto
-> DState crypto
DState RewardAccounts crypto
rw Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
dlg Bimap Ptr (Credential 'Staking crypto)
p Map (FutureGenDeleg crypto) (GenDelegPair crypto)
fgs GenDelegs crypto
gs InstantaneousRewards crypto
ir

-- | Current state of staking pools and their certificate counters.
data PState crypto = PState
  { -- | The pool parameters.
    PState crypto
-> Map (KeyHash 'StakePool crypto) (PoolParams crypto)
_pParams :: !(Map (KeyHash 'StakePool crypto) (PoolParams crypto)),
    -- | The future pool parameters.
    PState crypto
-> Map (KeyHash 'StakePool crypto) (PoolParams crypto)
_fPParams :: !(Map (KeyHash 'StakePool crypto) (PoolParams crypto)),
    -- | A map of retiring stake pools to the epoch when they retire.
    PState crypto -> Map (KeyHash 'StakePool crypto) EpochNo
_retiring :: !(Map (KeyHash 'StakePool crypto) EpochNo)
  }
  deriving (Int -> PState crypto -> ShowS
[PState crypto] -> ShowS
PState crypto -> String
(Int -> PState crypto -> ShowS)
-> (PState crypto -> String)
-> ([PState crypto] -> ShowS)
-> Show (PState crypto)
forall crypto. Int -> PState crypto -> ShowS
forall crypto. [PState crypto] -> ShowS
forall crypto. PState crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PState crypto] -> ShowS
$cshowList :: forall crypto. [PState crypto] -> ShowS
show :: PState crypto -> String
$cshow :: forall crypto. PState crypto -> String
showsPrec :: Int -> PState crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> PState crypto -> ShowS
Show, PState crypto -> PState crypto -> Bool
(PState crypto -> PState crypto -> Bool)
-> (PState crypto -> PState crypto -> Bool) -> Eq (PState crypto)
forall crypto. PState crypto -> PState crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PState crypto -> PState crypto -> Bool
$c/= :: forall crypto. PState crypto -> PState crypto -> Bool
== :: PState crypto -> PState crypto -> Bool
$c== :: forall crypto. PState crypto -> PState crypto -> Bool
Eq, (forall x. PState crypto -> Rep (PState crypto) x)
-> (forall x. Rep (PState crypto) x -> PState crypto)
-> Generic (PState crypto)
forall x. Rep (PState crypto) x -> PState crypto
forall x. PState crypto -> Rep (PState crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x. Rep (PState crypto) x -> PState crypto
forall crypto x. PState crypto -> Rep (PState crypto) x
$cto :: forall crypto x. Rep (PState crypto) x -> PState crypto
$cfrom :: forall crypto x. PState crypto -> Rep (PState crypto) x
Generic)

instance NoThunks (PState crypto)

instance NFData (PState crypto)

instance CC.Crypto crypto => ToCBOR (PState crypto) where
  toCBOR :: PState crypto -> Encoding
toCBOR (PState Map (KeyHash 'StakePool crypto) (PoolParams crypto)
a Map (KeyHash 'StakePool crypto) (PoolParams crypto)
b Map (KeyHash 'StakePool crypto) EpochNo
c) =
    Word -> Encoding
encodeListLen Word
3 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map (KeyHash 'StakePool crypto) (PoolParams crypto) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Map (KeyHash 'StakePool crypto) (PoolParams crypto)
a Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map (KeyHash 'StakePool crypto) (PoolParams crypto) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Map (KeyHash 'StakePool crypto) (PoolParams crypto)
b Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map (KeyHash 'StakePool crypto) EpochNo -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Map (KeyHash 'StakePool crypto) EpochNo
c

instance CC.Crypto crypto => FromCBOR (PState crypto) where
  fromCBOR :: Decoder s (PState crypto)
fromCBOR = do
    Text
-> (PState crypto -> Int)
-> Decoder s (PState crypto)
-> Decoder s (PState crypto)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"PState" (Int -> PState crypto -> Int
forall a b. a -> b -> a
const Int
3) (Decoder s (PState crypto) -> Decoder s (PState crypto))
-> Decoder s (PState crypto) -> Decoder s (PState crypto)
forall a b. (a -> b) -> a -> b
$ do
      Map (KeyHash 'StakePool crypto) (PoolParams crypto)
a <- Decoder s (Map (KeyHash 'StakePool crypto) (PoolParams crypto))
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Map (KeyHash 'StakePool crypto) (PoolParams crypto)
b <- Decoder s (Map (KeyHash 'StakePool crypto) (PoolParams crypto))
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Map (KeyHash 'StakePool crypto) EpochNo
c <- Decoder s (Map (KeyHash 'StakePool crypto) EpochNo)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      PState crypto -> Decoder s (PState crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PState crypto -> Decoder s (PState crypto))
-> PState crypto -> Decoder s (PState crypto)
forall a b. (a -> b) -> a -> b
$ Map (KeyHash 'StakePool crypto) (PoolParams crypto)
-> Map (KeyHash 'StakePool crypto) (PoolParams crypto)
-> Map (KeyHash 'StakePool crypto) EpochNo
-> PState crypto
forall crypto.
Map (KeyHash 'StakePool crypto) (PoolParams crypto)
-> Map (KeyHash 'StakePool crypto) (PoolParams crypto)
-> Map (KeyHash 'StakePool crypto) EpochNo
-> PState crypto
PState Map (KeyHash 'StakePool crypto) (PoolParams crypto)
a Map (KeyHash 'StakePool crypto) (PoolParams crypto)
b Map (KeyHash 'StakePool crypto) EpochNo
c

-- | The state associated with the current stake delegation.
data DPState crypto = DPState
  { DPState crypto -> DState crypto
_dstate :: !(DState crypto),
    DPState crypto -> PState crypto
_pstate :: !(PState crypto)
  }
  deriving (Int -> DPState crypto -> ShowS
[DPState crypto] -> ShowS
DPState crypto -> String
(Int -> DPState crypto -> ShowS)
-> (DPState crypto -> String)
-> ([DPState crypto] -> ShowS)
-> Show (DPState crypto)
forall crypto. Int -> DPState crypto -> ShowS
forall crypto. [DPState crypto] -> ShowS
forall crypto. DPState crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DPState crypto] -> ShowS
$cshowList :: forall crypto. [DPState crypto] -> ShowS
show :: DPState crypto -> String
$cshow :: forall crypto. DPState crypto -> String
showsPrec :: Int -> DPState crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> DPState crypto -> ShowS
Show, DPState crypto -> DPState crypto -> Bool
(DPState crypto -> DPState crypto -> Bool)
-> (DPState crypto -> DPState crypto -> Bool)
-> Eq (DPState crypto)
forall crypto. DPState crypto -> DPState crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DPState crypto -> DPState crypto -> Bool
$c/= :: forall crypto. DPState crypto -> DPState crypto -> Bool
== :: DPState crypto -> DPState crypto -> Bool
$c== :: forall crypto. DPState crypto -> DPState crypto -> Bool
Eq, (forall x. DPState crypto -> Rep (DPState crypto) x)
-> (forall x. Rep (DPState crypto) x -> DPState crypto)
-> Generic (DPState crypto)
forall x. Rep (DPState crypto) x -> DPState crypto
forall x. DPState crypto -> Rep (DPState crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x. Rep (DPState crypto) x -> DPState crypto
forall crypto x. DPState crypto -> Rep (DPState crypto) x
$cto :: forall crypto x. Rep (DPState crypto) x -> DPState crypto
$cfrom :: forall crypto x. DPState crypto -> Rep (DPState crypto) x
Generic)

instance NoThunks (DPState crypto)

instance NFData (DPState crypto)

instance
  CC.Crypto crypto =>
  ToCBOR (DPState crypto)
  where
  toCBOR :: DPState crypto -> Encoding
toCBOR (DPState DState crypto
ds PState crypto
ps) =
    Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> DState crypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR DState crypto
ds Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> PState crypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR PState crypto
ps

instance
  CC.Crypto crypto =>
  FromCBOR (DPState crypto)
  where
  fromCBOR :: Decoder s (DPState crypto)
fromCBOR = do
    Text
-> (DPState crypto -> Int)
-> Decoder s (DPState crypto)
-> Decoder s (DPState crypto)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"DPState" (Int -> DPState crypto -> Int
forall a b. a -> b -> a
const Int
2) (Decoder s (DPState crypto) -> Decoder s (DPState crypto))
-> Decoder s (DPState crypto) -> Decoder s (DPState crypto)
forall a b. (a -> b) -> a -> b
$ do
      DState crypto
ds <- Decoder s (DState crypto)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      PState crypto
ps <- Decoder s (PState crypto)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      DPState crypto -> Decoder s (DPState crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DPState crypto -> Decoder s (DPState crypto))
-> DPState crypto -> Decoder s (DPState crypto)
forall a b. (a -> b) -> a -> b
$ DState crypto -> PState crypto -> DPState crypto
forall crypto. DState crypto -> PState crypto -> DPState crypto
DPState DState crypto
ds PState crypto
ps

data RewardUpdate crypto = RewardUpdate
  { RewardUpdate crypto -> DeltaCoin
deltaT :: !DeltaCoin,
    RewardUpdate crypto -> DeltaCoin
deltaR :: !DeltaCoin,
    RewardUpdate crypto -> Map (Credential 'Staking crypto) Coin
rs :: !(Map (Credential 'Staking crypto) Coin),
    RewardUpdate crypto -> DeltaCoin
deltaF :: !DeltaCoin,
    RewardUpdate crypto -> NonMyopic crypto
nonMyopic :: !(NonMyopic crypto)
  }
  deriving (Int -> RewardUpdate crypto -> ShowS
[RewardUpdate crypto] -> ShowS
RewardUpdate crypto -> String
(Int -> RewardUpdate crypto -> ShowS)
-> (RewardUpdate crypto -> String)
-> ([RewardUpdate crypto] -> ShowS)
-> Show (RewardUpdate crypto)
forall crypto. Int -> RewardUpdate crypto -> ShowS
forall crypto. [RewardUpdate crypto] -> ShowS
forall crypto. RewardUpdate crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RewardUpdate crypto] -> ShowS
$cshowList :: forall crypto. [RewardUpdate crypto] -> ShowS
show :: RewardUpdate crypto -> String
$cshow :: forall crypto. RewardUpdate crypto -> String
showsPrec :: Int -> RewardUpdate crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> RewardUpdate crypto -> ShowS
Show, RewardUpdate crypto -> RewardUpdate crypto -> Bool
(RewardUpdate crypto -> RewardUpdate crypto -> Bool)
-> (RewardUpdate crypto -> RewardUpdate crypto -> Bool)
-> Eq (RewardUpdate crypto)
forall crypto. RewardUpdate crypto -> RewardUpdate crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RewardUpdate crypto -> RewardUpdate crypto -> Bool
$c/= :: forall crypto. RewardUpdate crypto -> RewardUpdate crypto -> Bool
== :: RewardUpdate crypto -> RewardUpdate crypto -> Bool
$c== :: forall crypto. RewardUpdate crypto -> RewardUpdate crypto -> Bool
Eq, (forall x. RewardUpdate crypto -> Rep (RewardUpdate crypto) x)
-> (forall x. Rep (RewardUpdate crypto) x -> RewardUpdate crypto)
-> Generic (RewardUpdate crypto)
forall x. Rep (RewardUpdate crypto) x -> RewardUpdate crypto
forall x. RewardUpdate crypto -> Rep (RewardUpdate crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x. Rep (RewardUpdate crypto) x -> RewardUpdate crypto
forall crypto x. RewardUpdate crypto -> Rep (RewardUpdate crypto) x
$cto :: forall crypto x. Rep (RewardUpdate crypto) x -> RewardUpdate crypto
$cfrom :: forall crypto x. RewardUpdate crypto -> Rep (RewardUpdate crypto) x
Generic)

instance NoThunks (RewardUpdate crypto)

instance NFData (RewardUpdate crypto)

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

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

emptyRewardUpdate :: RewardUpdate crypto
emptyRewardUpdate :: RewardUpdate crypto
emptyRewardUpdate = DeltaCoin
-> DeltaCoin
-> Map (Credential 'Staking crypto) Coin
-> DeltaCoin
-> NonMyopic crypto
-> RewardUpdate crypto
forall crypto.
DeltaCoin
-> DeltaCoin
-> Map (Credential 'Staking crypto) Coin
-> DeltaCoin
-> NonMyopic crypto
-> RewardUpdate crypto
RewardUpdate (Integer -> DeltaCoin
DeltaCoin Integer
0) (Integer -> DeltaCoin
DeltaCoin Integer
0) Map (Credential 'Staking crypto) Coin
forall k a. Map k a
Map.empty (Integer -> DeltaCoin
DeltaCoin Integer
0) NonMyopic crypto
forall crypto. NonMyopic crypto
emptyNonMyopic

data AccountState = AccountState
  { AccountState -> Coin
_treasury :: !Coin,
    AccountState -> Coin
_reserves :: !Coin
  }
  deriving (Int -> AccountState -> ShowS
[AccountState] -> ShowS
AccountState -> String
(Int -> AccountState -> ShowS)
-> (AccountState -> String)
-> ([AccountState] -> ShowS)
-> Show AccountState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccountState] -> ShowS
$cshowList :: [AccountState] -> ShowS
show :: AccountState -> String
$cshow :: AccountState -> String
showsPrec :: Int -> AccountState -> ShowS
$cshowsPrec :: Int -> AccountState -> ShowS
Show, AccountState -> AccountState -> Bool
(AccountState -> AccountState -> Bool)
-> (AccountState -> AccountState -> Bool) -> Eq AccountState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccountState -> AccountState -> Bool
$c/= :: AccountState -> AccountState -> Bool
== :: AccountState -> AccountState -> Bool
$c== :: AccountState -> AccountState -> Bool
Eq, (forall x. AccountState -> Rep AccountState x)
-> (forall x. Rep AccountState x -> AccountState)
-> Generic AccountState
forall x. Rep AccountState x -> AccountState
forall x. AccountState -> Rep AccountState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AccountState x -> AccountState
$cfrom :: forall x. AccountState -> Rep AccountState x
Generic)

instance ToCBOR AccountState where
  toCBOR :: AccountState -> Encoding
toCBOR (AccountState Coin
t Coin
r) =
    Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Coin -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Coin
t Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Coin -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Coin
r

instance FromCBOR AccountState where
  fromCBOR :: Decoder s AccountState
fromCBOR = do
    Text
-> (AccountState -> Int)
-> Decoder s AccountState
-> Decoder s AccountState
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"AccountState" (Int -> AccountState -> Int
forall a b. a -> b -> a
const Int
2) (Decoder s AccountState -> Decoder s AccountState)
-> Decoder s AccountState -> Decoder s AccountState
forall a b. (a -> b) -> a -> b
$ do
      Coin
t <- Decoder s Coin
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Coin
r <- Decoder s Coin
forall a s. FromCBOR a => Decoder s a
fromCBOR
      AccountState -> Decoder s AccountState
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AccountState -> Decoder s AccountState)
-> AccountState -> Decoder s AccountState
forall a b. (a -> b) -> a -> b
$ Coin -> Coin -> AccountState
AccountState Coin
t Coin
r

instance NoThunks AccountState

instance NFData AccountState

data EpochState era = EpochState
  { EpochState era -> AccountState
esAccountState :: !AccountState,
    EpochState era -> SnapShots (Crypto era)
esSnapshots :: !(SnapShots (Crypto era)),
    EpochState era -> LedgerState era
esLState :: !(LedgerState era),
    EpochState era -> PParams era
esPrevPp :: !(PParams era),
    EpochState era -> PParams era
esPp :: !(PParams era),
    -- | This field, esNonMyopic, does not appear in the formal spec
    -- and is not a part of the protocol. It is only used for providing
    -- data to the stake pool ranking calculation @getNonMyopicMemberRewards@.
    -- See https://hydra.iohk.io/job/Cardano/cardano-ledger-specs/specs.pool-ranking/latest/download-by-type/doc-pdf/pool-ranking
    EpochState era -> NonMyopic (Crypto era)
esNonMyopic :: !(NonMyopic (Crypto era))
  }
  deriving ((forall x. EpochState era -> Rep (EpochState era) x)
-> (forall x. Rep (EpochState era) x -> EpochState era)
-> Generic (EpochState era)
forall x. Rep (EpochState era) x -> EpochState era
forall x. EpochState era -> Rep (EpochState era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (EpochState era) x -> EpochState era
forall era x. EpochState era -> Rep (EpochState era) x
$cto :: forall era x. Rep (EpochState era) x -> EpochState era
$cfrom :: forall era x. EpochState era -> Rep (EpochState era) x
Generic)

deriving stock instance
  ShelleyBased era =>
  Show (EpochState era)

deriving stock instance
  ShelleyBased era =>
  Eq (EpochState era)

instance NoThunks (EpochState era)

instance (Era era) => NFData (EpochState era)

instance
  ShelleyBased era =>
  ToCBOR (EpochState era)
  where
  toCBOR :: EpochState era -> Encoding
toCBOR (EpochState AccountState
a SnapShots (Crypto era)
s LedgerState era
l PParams era
r PParams era
p NonMyopic (Crypto era)
n) =
    Word -> Encoding
encodeListLen Word
6 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> AccountState -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR AccountState
a Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SnapShots (Crypto era) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR SnapShots (Crypto era)
s Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> LedgerState era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR LedgerState era
l Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> PParams era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR PParams era
r Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> PParams era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR PParams era
p Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> NonMyopic (Crypto era) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR NonMyopic (Crypto era)
n

instance
  ShelleyBased era =>
  FromCBOR (EpochState era)
  where
  fromCBOR :: Decoder s (EpochState era)
fromCBOR = do
    Text
-> (EpochState era -> Int)
-> Decoder s (EpochState era)
-> Decoder s (EpochState era)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"EpochState" (Int -> EpochState era -> Int
forall a b. a -> b -> a
const Int
6) (Decoder s (EpochState era) -> Decoder s (EpochState era))
-> Decoder s (EpochState era) -> Decoder s (EpochState era)
forall a b. (a -> b) -> a -> b
$ do
      AccountState
a <- Decoder s AccountState
forall a s. FromCBOR a => Decoder s a
fromCBOR
      SnapShots (Crypto era)
s <- Decoder s (SnapShots (Crypto era))
forall a s. FromCBOR a => Decoder s a
fromCBOR
      LedgerState era
l <- Decoder s (LedgerState era)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      PParams era
r <- Decoder s (PParams era)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      PParams era
p <- Decoder s (PParams era)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      NonMyopic (Crypto era)
n <- Decoder s (NonMyopic (Crypto era))
forall a s. FromCBOR a => Decoder s a
fromCBOR
      EpochState era -> Decoder s (EpochState era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EpochState era -> Decoder s (EpochState era))
-> EpochState era -> Decoder s (EpochState era)
forall a b. (a -> b) -> a -> b
$ AccountState
-> SnapShots (Crypto era)
-> LedgerState era
-> PParams era
-> PParams era
-> NonMyopic (Crypto era)
-> EpochState era
forall era.
AccountState
-> SnapShots (Crypto era)
-> LedgerState era
-> PParams era
-> PParams era
-> NonMyopic (Crypto era)
-> EpochState era
EpochState AccountState
a SnapShots (Crypto era)
s LedgerState era
l PParams era
r PParams era
p NonMyopic (Crypto era)
n

emptyPPUPState :: PPUPState era
emptyPPUPState :: PPUPState era
emptyPPUPState = ProposedPPUpdates era -> ProposedPPUpdates era -> PPUPState era
forall era.
ProposedPPUpdates era -> ProposedPPUpdates era -> PPUPState era
PPUPState ProposedPPUpdates era
forall era. ProposedPPUpdates era
emptyPPPUpdates ProposedPPUpdates era
forall era. ProposedPPUpdates era
emptyPPPUpdates

emptyUTxOState :: UTxOState era
emptyUTxOState :: UTxOState era
emptyUTxOState = UTxO era -> Coin -> Coin -> PPUPState era -> UTxOState era
forall era.
UTxO era -> Coin -> Coin -> PPUPState era -> UTxOState era
UTxOState (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)
forall k a. Map k a
Map.empty) (Integer -> Coin
Coin Integer
0) (Integer -> Coin
Coin Integer
0) PPUPState era
forall era. PPUPState era
emptyPPUPState

emptyEpochState :: EpochState era
emptyEpochState :: EpochState era
emptyEpochState =
  AccountState
-> SnapShots (Crypto era)
-> LedgerState era
-> PParams era
-> PParams era
-> NonMyopic (Crypto era)
-> EpochState era
forall era.
AccountState
-> SnapShots (Crypto era)
-> LedgerState era
-> PParams era
-> PParams era
-> NonMyopic (Crypto era)
-> EpochState era
EpochState AccountState
emptyAccount SnapShots (Crypto era)
forall crypto. SnapShots crypto
emptySnapShots LedgerState era
forall era. LedgerState era
emptyLedgerState PParams era
forall era. PParams era
emptyPParams PParams era
forall era. PParams era
emptyPParams NonMyopic (Crypto era)
forall crypto. NonMyopic crypto
emptyNonMyopic

emptyLedgerState :: LedgerState era
emptyLedgerState :: LedgerState era
emptyLedgerState =
  UTxOState era -> DPState (Crypto era) -> LedgerState era
forall era.
UTxOState era -> DPState (Crypto era) -> LedgerState era
LedgerState
    UTxOState era
forall era. UTxOState era
emptyUTxOState
    DPState (Crypto era)
forall crypto. DPState crypto
emptyDelegation

emptyAccount :: AccountState
emptyAccount :: AccountState
emptyAccount = Coin -> Coin -> AccountState
AccountState (Integer -> Coin
Coin Integer
0) (Integer -> Coin
Coin Integer
0)

emptyDelegation :: DPState crypto
emptyDelegation :: DPState crypto
emptyDelegation =
  DState crypto -> PState crypto -> DPState crypto
forall crypto. DState crypto -> PState crypto -> DPState crypto
DPState DState crypto
forall crypto. DState crypto
emptyDState PState crypto
forall crypto. PState crypto
emptyPState

emptyInstantaneousRewards :: InstantaneousRewards crypto
emptyInstantaneousRewards :: InstantaneousRewards crypto
emptyInstantaneousRewards = Map (Credential 'Staking crypto) Coin
-> Map (Credential 'Staking crypto) Coin
-> InstantaneousRewards crypto
forall crypto.
Map (Credential 'Staking crypto) Coin
-> Map (Credential 'Staking crypto) Coin
-> InstantaneousRewards crypto
InstantaneousRewards Map (Credential 'Staking crypto) Coin
forall k a. Map k a
Map.empty Map (Credential 'Staking crypto) Coin
forall k a. Map k a
Map.empty

emptyDState :: DState crypto
emptyDState :: DState crypto
emptyDState =
  RewardAccounts crypto
-> Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
-> Bimap Ptr (Credential 'Staking crypto)
-> Map (FutureGenDeleg crypto) (GenDelegPair crypto)
-> GenDelegs crypto
-> InstantaneousRewards crypto
-> DState crypto
forall crypto.
RewardAccounts crypto
-> Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
-> Bimap Ptr (Credential 'Staking crypto)
-> Map (FutureGenDeleg crypto) (GenDelegPair crypto)
-> GenDelegs crypto
-> InstantaneousRewards crypto
-> DState crypto
DState
    RewardAccounts crypto
forall k a. Map k a
Map.empty
    Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
forall k a. Map k a
Map.empty
    Bimap Ptr (Credential 'Staking crypto)
forall v k. BiMap v k v
biMapEmpty
    Map (FutureGenDeleg crypto) (GenDelegPair crypto)
forall k a. Map k a
Map.empty
    (Map (KeyHash 'Genesis crypto) (GenDelegPair crypto)
-> GenDelegs crypto
forall crypto.
Map (KeyHash 'Genesis crypto) (GenDelegPair crypto)
-> GenDelegs crypto
GenDelegs Map (KeyHash 'Genesis crypto) (GenDelegPair crypto)
forall k a. Map k a
Map.empty)
    InstantaneousRewards crypto
forall crypto. InstantaneousRewards crypto
emptyInstantaneousRewards

emptyPState :: PState crypto
emptyPState :: PState crypto
emptyPState =
  Map (KeyHash 'StakePool crypto) (PoolParams crypto)
-> Map (KeyHash 'StakePool crypto) (PoolParams crypto)
-> Map (KeyHash 'StakePool crypto) EpochNo
-> PState crypto
forall crypto.
Map (KeyHash 'StakePool crypto) (PoolParams crypto)
-> Map (KeyHash 'StakePool crypto) (PoolParams crypto)
-> Map (KeyHash 'StakePool crypto) EpochNo
-> PState crypto
PState Map (KeyHash 'StakePool crypto) (PoolParams crypto)
forall k a. Map k a
Map.empty Map (KeyHash 'StakePool crypto) (PoolParams crypto)
forall k a. Map k a
Map.empty Map (KeyHash 'StakePool crypto) EpochNo
forall k a. Map k a
Map.empty

emptyDPState :: DPState crypto
emptyDPState :: DPState crypto
emptyDPState = DState crypto -> PState crypto -> DPState crypto
forall crypto. DState crypto -> PState crypto -> DPState crypto
DPState DState crypto
forall crypto. DState crypto
emptyDState PState crypto
forall crypto. PState crypto
emptyPState

data PPUPState era = PPUPState
  { PPUPState era -> ProposedPPUpdates era
proposals :: !(ProposedPPUpdates era),
    PPUPState era -> ProposedPPUpdates era
futureProposals :: !(ProposedPPUpdates era)
  }
  deriving (Int -> PPUPState era -> ShowS
[PPUPState era] -> ShowS
PPUPState era -> String
(Int -> PPUPState era -> ShowS)
-> (PPUPState era -> String)
-> ([PPUPState era] -> ShowS)
-> Show (PPUPState era)
forall era. Int -> PPUPState era -> ShowS
forall era. [PPUPState era] -> ShowS
forall era. PPUPState era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PPUPState era] -> ShowS
$cshowList :: forall era. [PPUPState era] -> ShowS
show :: PPUPState era -> String
$cshow :: forall era. PPUPState era -> String
showsPrec :: Int -> PPUPState era -> ShowS
$cshowsPrec :: forall era. Int -> PPUPState era -> ShowS
Show, PPUPState era -> PPUPState era -> Bool
(PPUPState era -> PPUPState era -> Bool)
-> (PPUPState era -> PPUPState era -> Bool) -> Eq (PPUPState era)
forall era. PPUPState era -> PPUPState era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PPUPState era -> PPUPState era -> Bool
$c/= :: forall era. PPUPState era -> PPUPState era -> Bool
== :: PPUPState era -> PPUPState era -> Bool
$c== :: forall era. PPUPState era -> PPUPState era -> Bool
Eq, (forall x. PPUPState era -> Rep (PPUPState era) x)
-> (forall x. Rep (PPUPState era) x -> PPUPState era)
-> Generic (PPUPState era)
forall x. Rep (PPUPState era) x -> PPUPState era
forall x. PPUPState era -> Rep (PPUPState era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (PPUPState era) x -> PPUPState era
forall era x. PPUPState era -> Rep (PPUPState era) x
$cto :: forall era x. Rep (PPUPState era) x -> PPUPState era
$cfrom :: forall era x. PPUPState era -> Rep (PPUPState era) x
Generic, PPUPState era -> ()
(PPUPState era -> ()) -> NFData (PPUPState era)
forall era. PPUPState era -> ()
forall a. (a -> ()) -> NFData a
rnf :: PPUPState era -> ()
$crnf :: forall era. PPUPState era -> ()
NFData, Context -> PPUPState era -> IO (Maybe ThunkInfo)
Proxy (PPUPState era) -> String
(Context -> PPUPState era -> IO (Maybe ThunkInfo))
-> (Context -> PPUPState era -> IO (Maybe ThunkInfo))
-> (Proxy (PPUPState era) -> String)
-> NoThunks (PPUPState era)
forall era. Context -> PPUPState era -> IO (Maybe ThunkInfo)
forall era. Proxy (PPUPState era) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (PPUPState era) -> String
$cshowTypeOf :: forall era. Proxy (PPUPState era) -> String
wNoThunks :: Context -> PPUPState era -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall era. Context -> PPUPState era -> IO (Maybe ThunkInfo)
noThunks :: Context -> PPUPState era -> IO (Maybe ThunkInfo)
$cnoThunks :: forall era. Context -> PPUPState era -> IO (Maybe ThunkInfo)
NoThunks)

instance Era era => ToCBOR (PPUPState era) where
  toCBOR :: PPUPState era -> Encoding
toCBOR (PPUPState ProposedPPUpdates era
ppup ProposedPPUpdates era
fppup) =
    Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ProposedPPUpdates era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR ProposedPPUpdates era
ppup Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ProposedPPUpdates era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR ProposedPPUpdates era
fppup

instance Era era => FromCBOR (PPUPState era) where
  fromCBOR :: Decoder s (PPUPState era)
fromCBOR = do
    Text
-> (PPUPState era -> Int)
-> Decoder s (PPUPState era)
-> Decoder s (PPUPState era)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"PPUPState" (Int -> PPUPState era -> Int
forall a b. a -> b -> a
const Int
2) (Decoder s (PPUPState era) -> Decoder s (PPUPState era))
-> Decoder s (PPUPState era) -> Decoder s (PPUPState era)
forall a b. (a -> b) -> a -> b
$ do
      ProposedPPUpdates era
ppup <- Decoder s (ProposedPPUpdates era)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      ProposedPPUpdates era
fppup <- Decoder s (ProposedPPUpdates era)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      PPUPState era -> Decoder s (PPUPState era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PPUPState era -> Decoder s (PPUPState era))
-> PPUPState era -> Decoder s (PPUPState era)
forall a b. (a -> b) -> a -> b
$ ProposedPPUpdates era -> ProposedPPUpdates era -> PPUPState era
forall era.
ProposedPPUpdates era -> ProposedPPUpdates era -> PPUPState era
PPUPState ProposedPPUpdates era
ppup ProposedPPUpdates era
fppup

pvCanFollow :: ProtVer -> StrictMaybe ProtVer -> Bool
pvCanFollow :: ProtVer -> StrictMaybe ProtVer -> Bool
pvCanFollow ProtVer
_ StrictMaybe ProtVer
SNothing = Bool
True
pvCanFollow (ProtVer Natural
m Natural
n) (SJust (ProtVer Natural
m' Natural
n')) =
  (Natural
m Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
1, Natural
0) (Natural, Natural) -> (Natural, Natural) -> Bool
forall a. Eq a => a -> a -> Bool
== (Natural
m', Natural
n') Bool -> Bool -> Bool
|| (Natural
m, Natural
n Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
1) (Natural, Natural) -> (Natural, Natural) -> Bool
forall a. Eq a => a -> a -> Bool
== (Natural
m', Natural
n')

-- | Update the protocol parameter updates by clearing out the proposals
-- and making the future proposals become the new proposals,
-- provided the new proposals can follow (otherwise reset them).
updatePpup :: UTxOState era -> PParams era -> UTxOState era
updatePpup :: UTxOState era -> PParams era -> UTxOState era
updatePpup UTxOState era
utxoSt PParams era
pp = UTxOState era
utxoSt {_ppups :: PPUPState era
_ppups = ProposedPPUpdates era -> ProposedPPUpdates era -> PPUPState era
forall era.
ProposedPPUpdates era -> ProposedPPUpdates era -> PPUPState era
PPUPState ProposedPPUpdates era
ps ProposedPPUpdates era
forall era. ProposedPPUpdates era
emptyPPPUpdates}
  where
    (ProposedPPUpdates Map (KeyHash 'Genesis (Crypto era)) (PParamsUpdate era)
newProposals) = PPUPState era -> ProposedPPUpdates era
forall era. PPUPState era -> ProposedPPUpdates era
futureProposals (PPUPState era -> ProposedPPUpdates era)
-> (UTxOState era -> PPUPState era)
-> UTxOState era
-> ProposedPPUpdates era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxOState era -> PPUPState era
forall era. UTxOState era -> PPUPState era
_ppups (UTxOState era -> ProposedPPUpdates era)
-> UTxOState era -> ProposedPPUpdates era
forall a b. (a -> b) -> a -> b
$ UTxOState era
utxoSt
    goodPV :: PParamsUpdate era -> Bool
goodPV = ProtVer -> StrictMaybe ProtVer -> Bool
pvCanFollow (PParams era -> HKD Identity ProtVer
forall (f :: * -> *) era. PParams' f era -> HKD f ProtVer
_protocolVersion PParams era
pp) (StrictMaybe ProtVer -> Bool)
-> (PParamsUpdate era -> StrictMaybe ProtVer)
-> PParamsUpdate era
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PParamsUpdate era -> StrictMaybe ProtVer
forall (f :: * -> *) era. PParams' f era -> HKD f ProtVer
_protocolVersion
    ps :: ProposedPPUpdates era
ps = if (PParamsUpdate era -> Bool)
-> Map (KeyHash 'Genesis (Crypto era)) (PParamsUpdate era) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all PParamsUpdate era -> Bool
goodPV Map (KeyHash 'Genesis (Crypto era)) (PParamsUpdate era)
newProposals then Map (KeyHash 'Genesis (Crypto era)) (PParamsUpdate era)
-> ProposedPPUpdates era
forall era.
Map (KeyHash 'Genesis (Crypto era)) (PParamsUpdate era)
-> ProposedPPUpdates era
ProposedPPUpdates Map (KeyHash 'Genesis (Crypto era)) (PParamsUpdate era)
newProposals else ProposedPPUpdates era
forall era. ProposedPPUpdates era
emptyPPPUpdates

data UTxOState era = UTxOState
  { UTxOState era -> UTxO era
_utxo :: !(UTxO era),
    UTxOState era -> Coin
_deposited :: !Coin,
    UTxOState era -> Coin
_fees :: !Coin,
    UTxOState era -> PPUPState era
_ppups :: !(PPUPState era)
  }
  deriving ((forall x. UTxOState era -> Rep (UTxOState era) x)
-> (forall x. Rep (UTxOState era) x -> UTxOState era)
-> Generic (UTxOState era)
forall x. Rep (UTxOState era) x -> UTxOState era
forall x. UTxOState era -> Rep (UTxOState era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (UTxOState era) x -> UTxOState era
forall era x. UTxOState era -> Rep (UTxOState era) x
$cto :: forall era x. Rep (UTxOState era) x -> UTxOState era
$cfrom :: forall era x. UTxOState era -> Rep (UTxOState era) x
Generic, UTxOState era -> ()
(UTxOState era -> ()) -> NFData (UTxOState era)
forall era. Era era => UTxOState era -> ()
forall a. (a -> ()) -> NFData a
rnf :: UTxOState era -> ()
$crnf :: forall era. Era era => UTxOState era -> ()
NFData)

deriving stock instance
  ShelleyBased era =>
  Show (UTxOState era)

deriving stock instance
  ShelleyBased era =>
  Eq (UTxOState era)

instance NoThunks (UTxOState era)

instance
  ShelleyBased era =>
  ToCBOR (UTxOState era)
  where
  toCBOR :: UTxOState era -> Encoding
toCBOR (UTxOState UTxO era
ut Coin
dp Coin
fs PPUPState era
us) =
    Word -> Encoding
encodeListLen Word
4 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> UTxO era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR UTxO era
ut Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Coin -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Coin
dp Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Coin -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Coin
fs Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> PPUPState era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR PPUPState era
us

instance
  ShelleyBased era =>
  FromCBOR (UTxOState era)
  where
  fromCBOR :: Decoder s (UTxOState era)
fromCBOR = do
    Text
-> (UTxOState era -> Int)
-> Decoder s (UTxOState era)
-> Decoder s (UTxOState era)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"UTxOState" (Int -> UTxOState era -> Int
forall a b. a -> b -> a
const Int
4) (Decoder s (UTxOState era) -> Decoder s (UTxOState era))
-> Decoder s (UTxOState era) -> Decoder s (UTxOState era)
forall a b. (a -> b) -> a -> b
$ do
      UTxO era
ut <- Decoder s (UTxO era)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Coin
dp <- Decoder s Coin
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Coin
fs <- Decoder s Coin
forall a s. FromCBOR a => Decoder s a
fromCBOR
      PPUPState era
us <- Decoder s (PPUPState era)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      UTxOState era -> Decoder s (UTxOState era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UTxOState era -> Decoder s (UTxOState era))
-> UTxOState era -> Decoder s (UTxOState era)
forall a b. (a -> b) -> a -> b
$ UTxO era -> Coin -> Coin -> PPUPState era -> UTxOState era
forall era.
UTxO era -> Coin -> Coin -> PPUPState era -> UTxOState era
UTxOState UTxO era
ut Coin
dp Coin
fs PPUPState era
us

-- | New Epoch state and environment
data NewEpochState era = NewEpochState
  { -- | Last epoch
    NewEpochState era -> EpochNo
nesEL :: !EpochNo,
    -- | Blocks made before current epoch
    NewEpochState era -> BlocksMade (Crypto era)
nesBprev :: !(BlocksMade (Crypto era)),
    -- | Blocks made in current epoch
    NewEpochState era -> BlocksMade (Crypto era)
nesBcur :: !(BlocksMade (Crypto era)),
    -- | Epoch state before current
    NewEpochState era -> EpochState era
nesEs :: !(EpochState era),
    -- | Possible reward update
    NewEpochState era -> StrictMaybe (RewardUpdate (Crypto era))
nesRu :: !(StrictMaybe (RewardUpdate (Crypto era))),
    -- | Stake distribution within the stake pool
    NewEpochState era -> PoolDistr (Crypto era)
nesPd :: !(PoolDistr (Crypto era))
  }
  deriving ((forall x. NewEpochState era -> Rep (NewEpochState era) x)
-> (forall x. Rep (NewEpochState era) x -> NewEpochState era)
-> Generic (NewEpochState era)
forall x. Rep (NewEpochState era) x -> NewEpochState era
forall x. NewEpochState era -> Rep (NewEpochState era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (NewEpochState era) x -> NewEpochState era
forall era x. NewEpochState era -> Rep (NewEpochState era) x
$cto :: forall era x. Rep (NewEpochState era) x -> NewEpochState era
$cfrom :: forall era x. NewEpochState era -> Rep (NewEpochState era) x
Generic)

deriving stock instance
  ShelleyBased era =>
  Show (NewEpochState era)

deriving stock instance
  ShelleyBased era =>
  Eq (NewEpochState era)

instance (Era era) => NFData (NewEpochState era)

instance NoThunks (NewEpochState era)

instance ShelleyBased era => ToCBOR (NewEpochState era) where
  toCBOR :: NewEpochState era -> Encoding
toCBOR (NewEpochState EpochNo
e BlocksMade (Crypto era)
bp BlocksMade (Crypto era)
bc EpochState era
es StrictMaybe (RewardUpdate (Crypto era))
ru PoolDistr (Crypto era)
pd) =
    Word -> Encoding
encodeListLen Word
6 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> EpochNo -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR EpochNo
e Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> BlocksMade (Crypto era) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR BlocksMade (Crypto era)
bp Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> BlocksMade (Crypto era) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR BlocksMade (Crypto era)
bc Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> EpochState era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR EpochState era
es
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> StrictMaybe (RewardUpdate (Crypto era)) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR StrictMaybe (RewardUpdate (Crypto era))
ru
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> PoolDistr (Crypto era) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR PoolDistr (Crypto era)
pd

instance
  ShelleyBased era =>
  FromCBOR (NewEpochState era)
  where
  fromCBOR :: Decoder s (NewEpochState era)
fromCBOR = do
    Text
-> (NewEpochState era -> Int)
-> Decoder s (NewEpochState era)
-> Decoder s (NewEpochState era)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"NewEpochState" (Int -> NewEpochState era -> Int
forall a b. a -> b -> a
const Int
6) (Decoder s (NewEpochState era) -> Decoder s (NewEpochState era))
-> Decoder s (NewEpochState era) -> Decoder s (NewEpochState era)
forall a b. (a -> b) -> a -> b
$ do
      EpochNo
e <- Decoder s EpochNo
forall a s. FromCBOR a => Decoder s a
fromCBOR
      BlocksMade (Crypto era)
bp <- Decoder s (BlocksMade (Crypto era))
forall a s. FromCBOR a => Decoder s a
fromCBOR
      BlocksMade (Crypto era)
bc <- Decoder s (BlocksMade (Crypto era))
forall a s. FromCBOR a => Decoder s a
fromCBOR
      EpochState era
es <- Decoder s (EpochState era)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      StrictMaybe (RewardUpdate (Crypto era))
ru <- Decoder s (StrictMaybe (RewardUpdate (Crypto era)))
forall a s. FromCBOR a => Decoder s a
fromCBOR
      PoolDistr (Crypto era)
pd <- Decoder s (PoolDistr (Crypto era))
forall a s. FromCBOR a => Decoder s a
fromCBOR
      NewEpochState era -> Decoder s (NewEpochState era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NewEpochState era -> Decoder s (NewEpochState era))
-> NewEpochState era -> Decoder s (NewEpochState era)
forall a b. (a -> b) -> a -> b
$ EpochNo
-> BlocksMade (Crypto era)
-> BlocksMade (Crypto era)
-> EpochState era
-> StrictMaybe (RewardUpdate (Crypto era))
-> PoolDistr (Crypto era)
-> NewEpochState era
forall era.
EpochNo
-> BlocksMade (Crypto era)
-> BlocksMade (Crypto era)
-> EpochState era
-> StrictMaybe (RewardUpdate (Crypto era))
-> PoolDistr (Crypto era)
-> NewEpochState era
NewEpochState EpochNo
e BlocksMade (Crypto era)
bp BlocksMade (Crypto era)
bc EpochState era
es StrictMaybe (RewardUpdate (Crypto era))
ru PoolDistr (Crypto era)
pd

getGKeys ::
  NewEpochState era ->
  Set (KeyHash 'Genesis (Crypto era))
getGKeys :: NewEpochState era -> Set (KeyHash 'Genesis (Crypto era))
getGKeys NewEpochState era
nes = Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
-> Set (KeyHash 'Genesis (Crypto era))
forall k a. Map k a -> Set k
Map.keysSet Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
genDelegs
  where
    NewEpochState EpochNo
_ BlocksMade (Crypto era)
_ BlocksMade (Crypto era)
_ EpochState era
es StrictMaybe (RewardUpdate (Crypto era))
_ PoolDistr (Crypto era)
_ = NewEpochState era
nes
    EpochState AccountState
_ SnapShots (Crypto era)
_ LedgerState era
ls PParams era
_ PParams era
_ NonMyopic (Crypto era)
_ = EpochState era
es
    LedgerState UTxOState era
_ (DPState (DState RewardAccounts (Crypto era)
_ Map
  (Credential 'Staking (Crypto era))
  (KeyHash 'StakePool (Crypto era))
_ Bimap Ptr (Credential 'Staking (Crypto era))
_ Map (FutureGenDeleg (Crypto era)) (GenDelegPair (Crypto era))
_ (GenDelegs Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
genDelegs) InstantaneousRewards (Crypto era)
_) PState (Crypto era)
_) = LedgerState era
ls

-- | The state associated with a 'Ledger'.
data LedgerState era = LedgerState
  { -- | The current unspent transaction outputs.
    LedgerState era -> UTxOState era
_utxoState :: !(UTxOState era),
    -- | The current delegation state
    LedgerState era -> DPState (Crypto era)
_delegationState :: !(DPState (Crypto era))
  }
  deriving ((forall x. LedgerState era -> Rep (LedgerState era) x)
-> (forall x. Rep (LedgerState era) x -> LedgerState era)
-> Generic (LedgerState era)
forall x. Rep (LedgerState era) x -> LedgerState era
forall x. LedgerState era -> Rep (LedgerState era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (LedgerState era) x -> LedgerState era
forall era x. LedgerState era -> Rep (LedgerState era) x
$cto :: forall era x. Rep (LedgerState era) x -> LedgerState era
$cfrom :: forall era x. LedgerState era -> Rep (LedgerState era) x
Generic)

deriving stock instance
  ShelleyBased era =>
  Show (LedgerState era)

deriving stock instance
  ShelleyBased era =>
  Eq (LedgerState era)

instance NoThunks (LedgerState era)

instance (Era era) => NFData (LedgerState era)

instance
  ShelleyBased era =>
  ToCBOR (LedgerState era)
  where
  toCBOR :: LedgerState era -> Encoding
toCBOR (LedgerState UTxOState era
u DPState (Crypto era)
dp) =
    Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> UTxOState era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR UTxOState era
u Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> DPState (Crypto era) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR DPState (Crypto era)
dp

instance
  ShelleyBased era =>
  FromCBOR (LedgerState era)
  where
  fromCBOR :: Decoder s (LedgerState era)
fromCBOR = do
    Text
-> (LedgerState era -> Int)
-> Decoder s (LedgerState era)
-> Decoder s (LedgerState era)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"LedgerState" (Int -> LedgerState era -> Int
forall a b. a -> b -> a
const Int
2) (Decoder s (LedgerState era) -> Decoder s (LedgerState era))
-> Decoder s (LedgerState era) -> Decoder s (LedgerState era)
forall a b. (a -> b) -> a -> b
$ do
      UTxOState era
u <- Decoder s (UTxOState era)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      DPState (Crypto era)
dp <- Decoder s (DPState (Crypto era))
forall a s. FromCBOR a => Decoder s a
fromCBOR
      LedgerState era -> Decoder s (LedgerState era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LedgerState era -> Decoder s (LedgerState era))
-> LedgerState era -> Decoder s (LedgerState era)
forall a b. (a -> b) -> a -> b
$ UTxOState era -> DPState (Crypto era) -> LedgerState era
forall era.
UTxOState era -> DPState (Crypto era) -> LedgerState era
LedgerState UTxOState era
u DPState (Crypto era)
dp

-- | Creates the ledger state for an empty ledger which
--  contains the specified transaction outputs.
genesisState ::
  Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era)) ->
  UTxO era ->
  LedgerState era
genesisState :: Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
-> UTxO era -> LedgerState era
genesisState Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
genDelegs0 UTxO era
utxo0 =
  UTxOState era -> DPState (Crypto era) -> LedgerState era
forall era.
UTxOState era -> DPState (Crypto era) -> LedgerState era
LedgerState
    ( UTxO era -> Coin -> Coin -> PPUPState era -> UTxOState era
forall era.
UTxO era -> Coin -> Coin -> PPUPState era -> UTxOState era
UTxOState
        UTxO era
utxo0
        (Integer -> Coin
Coin Integer
0)
        (Integer -> Coin
Coin Integer
0)
        PPUPState era
forall era. PPUPState era
emptyPPUPState
    )
    (DState (Crypto era) -> PState (Crypto era) -> DPState (Crypto era)
forall crypto. DState crypto -> PState crypto -> DPState crypto
DPState DState (Crypto era)
dState PState (Crypto era)
forall crypto. PState crypto
emptyPState)
  where
    dState :: DState (Crypto era)
dState = DState (Crypto era)
forall crypto. DState crypto
emptyDState {_genDelegs :: GenDelegs (Crypto era)
_genDelegs = Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
-> GenDelegs (Crypto era)
forall crypto.
Map (KeyHash 'Genesis crypto) (GenDelegPair crypto)
-> GenDelegs crypto
GenDelegs Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
genDelegs0}

-- | Implementation of abstract transaction size
txsize :: Tx era -> Integer
txsize :: Tx era -> Integer
txsize = Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Integer) -> (Tx era -> Int64) -> Tx era -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BSL.length (ByteString -> Int64) -> (Tx era -> ByteString) -> Tx era -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx era -> ByteString
forall era. Tx era -> ByteString
txFullBytes

-- | Convenience Function to bound the txsize function.
-- | It can be helpful for coin selection.
txsizeBound ::
  forall era.
  ( ShelleyBased era,
    HasField "outputs" (Core.TxBody era) (StrictSeq (TxOut era)),
    HasField "inputs" (Core.TxBody era) (Set (TxIn (Crypto era)))
  ) =>
  Tx era ->
  Integer
txsizeBound :: Tx era -> Integer
txsizeBound Tx era
tx = Integer
numInputs Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
inputSize Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
numOutputs Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
outputSize Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
rest
  where
    uint :: Integer
uint = Integer
5
    smallArray :: Integer
smallArray = Integer
1
    hashLen :: Integer
hashLen = Integer
32
    hashObj :: Integer
hashObj = Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
hashLen
    addrHashLen :: Integer
addrHashLen = Integer
28
    addrHeader :: Integer
addrHeader = Integer
1
    address :: Integer
address = Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
addrHeader Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
addrHashLen
    txbody :: TxBody era
txbody = Tx era
-> (TxBodyConstraints era, ToCBOR (AuxiliaryData era)) =>
   TxBody era
forall era.
Tx era
-> (TxBodyConstraints era, ToCBOR (AuxiliaryData era)) =>
   TxBody era
_body Tx era
tx
    numInputs :: Integer
numInputs = Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (TxBody era -> Int) -> TxBody era -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (TxIn (Crypto era)) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Set (TxIn (Crypto era)) -> Int)
-> (TxBody era -> Set (TxIn (Crypto era))) -> TxBody era -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (x :: k) r a. HasField x r a => r -> a
forall r a. HasField "inputs" r a => r -> a
getField @"inputs" (TxBody era -> Integer) -> TxBody era -> Integer
forall a b. (a -> b) -> a -> b
$ TxBody era
txbody
    inputSize :: Integer
inputSize = Integer
smallArray Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
uint Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
hashObj
    numOutputs :: Integer
numOutputs = Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (TxBody era -> Int) -> TxBody era -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictSeq (TxOut era) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (StrictSeq (TxOut era) -> Int)
-> (TxBody era -> StrictSeq (TxOut era)) -> TxBody era -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (x :: k) r a. HasField x r a => r -> a
forall r a. HasField "outputs" r a => r -> a
getField @"outputs" (TxBody era -> Integer) -> TxBody era -> Integer
forall a b. (a -> b) -> a -> b
$ TxBody era
txbody
    outputSize :: Integer
outputSize = Integer
smallArray Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
uint Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
address
    rest :: Integer
rest = Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Integer) -> Int64 -> Integer
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BSL.length (Tx era -> ByteString
forall era. Tx era -> ByteString
txFullBytes Tx era
tx)

-- | Minimum fee calculation
minfee :: PParams era -> Tx era -> Coin
minfee :: PParams era -> Tx era -> Coin
minfee PParams era
pp Tx era
tx =
  Integer -> Coin
Coin (Integer -> Coin) -> Integer -> Coin
forall a b. (a -> b) -> a -> b
$
    Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PParams era -> HKD Identity Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_minfeeA PParams era
pp)
      Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Tx era -> Integer
forall era. Tx era -> Integer
txsize Tx era
tx Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PParams era -> HKD Identity Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_minfeeB PParams era
pp)

-- | Minimum fee bound using txsizeBound
minfeeBound ::
  forall era.
  ( ShelleyBased era,
    HasField "outputs" (Core.TxBody era) (StrictSeq (TxOut era)),
    HasField "inputs" (Core.TxBody era) (Set (TxIn (Crypto era)))
  ) =>
  PParams era ->
  Tx era ->
  Coin
minfeeBound :: PParams era -> Tx era -> Coin
minfeeBound PParams era
pp Tx era
tx =
  Integer -> Coin
Coin (Integer -> Coin) -> Integer -> Coin
forall a b. (a -> b) -> a -> b
$
    Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PParams era -> HKD Identity Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_minfeeA PParams era
pp)
      Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Tx era -> Integer
forall era.
(ShelleyBased era,
 HasField "outputs" (TxBody era) (StrictSeq (TxOut era)),
 HasField "inputs" (TxBody era) (Set (TxIn (Crypto era)))) =>
Tx era -> Integer
txsizeBound Tx era
tx Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PParams era -> HKD Identity Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_minfeeB PParams era
pp)

-- | Compute the lovelace which are created by the transaction
produced ::
  ( ShelleyBased era,
    HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era))),
    HasField "outputs" (Core.TxBody era) (StrictSeq (TxOut era)),
    HasField "txfee" (Core.TxBody era) Coin
  ) =>
  PParams era ->
  Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era)) ->
  Core.TxBody era ->
  Core.Value era
produced :: PParams era
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
-> TxBody era
-> Value era
produced PParams era
pp Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
stakePools TxBody era
tx =
  UTxO era -> Value era
forall era. ShelleyBased era => UTxO era -> Value era
balance (TxBody era -> UTxO era
forall era.
(ShelleyBased era,
 HasField "outputs" (TxBody era) (StrictSeq (TxOut era))) =>
TxBody era -> UTxO era
txouts TxBody era
tx)
    Value era -> Value era -> Value era
forall a. Semigroup a => a -> a -> a
<> ( Coin -> Value era
forall t. Val t => Coin -> t
Val.inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$
           TxBody era -> Coin
forall k (x :: k) r a. HasField x r a => r -> a
getField @"txfee" TxBody era
tx
             Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> PParams era
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
-> [DCert (Crypto era)]
-> Coin
forall era.
PParams era
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
-> [DCert (Crypto era)]
-> Coin
totalDeposits PParams era
pp Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
stakePools (StrictSeq (DCert (Crypto era)) -> [DCert (Crypto era)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (StrictSeq (DCert (Crypto era)) -> [DCert (Crypto era)])
-> StrictSeq (DCert (Crypto era)) -> [DCert (Crypto era)]
forall a b. (a -> b) -> a -> b
$ TxBody era -> StrictSeq (DCert (Crypto era))
forall k (x :: k) r a. HasField x r a => r -> a
getField @"certs" TxBody era
tx)
       )

-- | Compute the key deregistration refunds in a transaction
keyRefunds ::
  ( HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era)))
  ) =>
  PParams era ->
  Core.TxBody era ->
  Coin
keyRefunds :: PParams era -> TxBody era -> Coin
keyRefunds PParams era
pp TxBody era
tx = ([DCert (Crypto era)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DCert (Crypto era)]
deregistrations) Int -> Coin -> Coin
forall t i. (Val t, Integral i) => i -> t -> t
<×> (PParams era -> HKD Identity Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_keyDeposit PParams era
pp)
  where
    deregistrations :: [DCert (Crypto era)]
deregistrations = (DCert (Crypto era) -> Bool)
-> [DCert (Crypto era)] -> [DCert (Crypto era)]
forall a. (a -> Bool) -> [a] -> [a]
filter DCert (Crypto era) -> Bool
forall crypto. DCert crypto -> Bool
isDeRegKey (StrictSeq (DCert (Crypto era)) -> [DCert (Crypto era)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (StrictSeq (DCert (Crypto era)) -> [DCert (Crypto era)])
-> StrictSeq (DCert (Crypto era)) -> [DCert (Crypto era)]
forall a b. (a -> b) -> a -> b
$ TxBody era -> StrictSeq (DCert (Crypto era))
forall k (x :: k) r a. HasField x r a => r -> a
getField @"certs" TxBody era
tx)

-- | Compute the lovelace which are destroyed by the transaction
consumed ::
  forall era.
  ( ShelleyBased era,
    HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era))),
    HasField "inputs" (Core.TxBody era) (Set (TxIn (Crypto era))),
    HasField "wdrls" (Core.TxBody era) (Wdrl (Crypto era))
  ) =>
  PParams era ->
  UTxO era ->
  Core.TxBody era ->
  Core.Value era
consumed :: PParams era -> UTxO era -> TxBody era -> Value era
consumed PParams era
pp UTxO era
u TxBody era
tx =
  UTxO era -> Value era
forall era. ShelleyBased era => UTxO era -> Value era
balance (Exp (Map (TxIn (Crypto era)) (TxOut era)) -> UTxO era
forall s t. Embed s t => Exp t -> s
eval (TxBody era -> Set (TxIn (Crypto era))
forall era.
HasField "inputs" (TxBody era) (Set (TxIn (Crypto era))) =>
TxBody era -> Set (TxIn (Crypto era))
txins @era TxBody era
tx Set (TxIn (Crypto era))
-> UTxO era -> Exp (Map (TxIn (Crypto era)) (TxOut era))
forall k s1 s2 (f :: * -> * -> *) v.
(Ord k, HasExp s1 (Sett k ()), HasExp s2 (f k v)) =>
s1 -> s2 -> Exp (f k v)
 UTxO era
u)) Value era -> Value era -> Value era
forall a. Semigroup a => a -> a -> a
<> (Coin -> Value era
forall t. Val t => Coin -> t
Val.inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Coin
refunds Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> Coin
withdrawals)
  where
    -- balance (UTxO (Map.restrictKeys v (txins tx))) + refunds + withdrawals
    refunds :: Coin
refunds = PParams era -> TxBody era -> Coin
forall era.
HasField "certs" (TxBody era) (StrictSeq (DCert (Crypto era))) =>
PParams era -> TxBody era -> Coin
keyRefunds PParams era
pp TxBody era
tx
    withdrawals :: Coin
withdrawals = Map (RewardAcnt (Crypto era)) Coin -> Coin
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Map (RewardAcnt (Crypto era)) Coin -> Coin)
-> (Wdrl (Crypto era) -> Map (RewardAcnt (Crypto era)) Coin)
-> Wdrl (Crypto era)
-> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wdrl (Crypto era) -> Map (RewardAcnt (Crypto era)) Coin
forall crypto. Wdrl crypto -> Map (RewardAcnt crypto) Coin
unWdrl (Wdrl (Crypto era) -> Coin) -> Wdrl (Crypto era) -> Coin
forall a b. (a -> b) -> a -> b
$ TxBody era -> Wdrl (Crypto era)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"wdrls" TxBody era
tx

newtype WitHashes crypto = WitHashes
  {WitHashes crypto -> Set (KeyHash 'Witness crypto)
unWitHashes :: Set (KeyHash 'Witness crypto)}
  deriving (WitHashes crypto -> WitHashes crypto -> Bool
(WitHashes crypto -> WitHashes crypto -> Bool)
-> (WitHashes crypto -> WitHashes crypto -> Bool)
-> Eq (WitHashes crypto)
forall crypto. WitHashes crypto -> WitHashes crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WitHashes crypto -> WitHashes crypto -> Bool
$c/= :: forall crypto. WitHashes crypto -> WitHashes crypto -> Bool
== :: WitHashes crypto -> WitHashes crypto -> Bool
$c== :: forall crypto. WitHashes crypto -> WitHashes crypto -> Bool
Eq, (forall x. WitHashes crypto -> Rep (WitHashes crypto) x)
-> (forall x. Rep (WitHashes crypto) x -> WitHashes crypto)
-> Generic (WitHashes crypto)
forall x. Rep (WitHashes crypto) x -> WitHashes crypto
forall x. WitHashes crypto -> Rep (WitHashes crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x. Rep (WitHashes crypto) x -> WitHashes crypto
forall crypto x. WitHashes crypto -> Rep (WitHashes crypto) x
$cto :: forall crypto x. Rep (WitHashes crypto) x -> WitHashes crypto
$cfrom :: forall crypto x. WitHashes crypto -> Rep (WitHashes crypto) x
Generic)
  deriving (Int -> WitHashes crypto -> ShowS
[WitHashes crypto] -> ShowS
WitHashes crypto -> String
(Int -> WitHashes crypto -> ShowS)
-> (WitHashes crypto -> String)
-> ([WitHashes crypto] -> ShowS)
-> Show (WitHashes crypto)
forall crypto. Int -> WitHashes crypto -> ShowS
forall crypto. [WitHashes crypto] -> ShowS
forall crypto. WitHashes crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WitHashes crypto] -> ShowS
$cshowList :: forall crypto. [WitHashes crypto] -> ShowS
show :: WitHashes crypto -> String
$cshow :: forall crypto. WitHashes crypto -> String
showsPrec :: Int -> WitHashes crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> WitHashes crypto -> ShowS
Show) via Quiet (WitHashes crypto)

instance NoThunks (WitHashes crypto)

-- | Check if a set of witness hashes is empty.
nullWitHashes :: WitHashes crypto -> Bool
nullWitHashes :: WitHashes crypto -> Bool
nullWitHashes (WitHashes Set (KeyHash 'Witness crypto)
a) = Set (KeyHash 'Witness crypto) -> Bool
forall a. Set a -> Bool
Set.null Set (KeyHash 'Witness crypto)
a

-- | Extract the difference between two sets of witness hashes.
diffWitHashes :: WitHashes crypto -> WitHashes crypto -> WitHashes crypto
diffWitHashes :: WitHashes crypto -> WitHashes crypto -> WitHashes crypto
diffWitHashes (WitHashes Set (KeyHash 'Witness crypto)
x) (WitHashes Set (KeyHash 'Witness crypto)
x') =
  Set (KeyHash 'Witness crypto) -> WitHashes crypto
forall crypto. Set (KeyHash 'Witness crypto) -> WitHashes crypto
WitHashes (Set (KeyHash 'Witness crypto)
x Set (KeyHash 'Witness crypto)
-> Set (KeyHash 'Witness crypto) -> Set (KeyHash 'Witness crypto)
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set (KeyHash 'Witness crypto)
x')

-- | Extract the witness hashes from the Witness set.
witsFromWitnessSet ::
  (Era era, Core.AnnotatedData (Core.Script era)) =>
  WitnessSet era ->
  WitHashes (Crypto era)
witsFromWitnessSet :: WitnessSet era -> WitHashes (Crypto era)
witsFromWitnessSet (WitnessSet Set (WitVKey 'Witness (Crypto era))
aWits Map (ScriptHash (Crypto era)) (Script era)
_ Set (BootstrapWitness (Crypto era))
bsWits) =
  Set (KeyHash 'Witness (Crypto era)) -> WitHashes (Crypto era)
forall crypto. Set (KeyHash 'Witness crypto) -> WitHashes crypto
WitHashes (Set (KeyHash 'Witness (Crypto era)) -> WitHashes (Crypto era))
-> Set (KeyHash 'Witness (Crypto era)) -> WitHashes (Crypto era)
forall a b. (a -> b) -> a -> b
$
    (WitVKey 'Witness (Crypto era) -> KeyHash 'Witness (Crypto era))
-> Set (WitVKey 'Witness (Crypto era))
-> Set (KeyHash 'Witness (Crypto era))
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map WitVKey 'Witness (Crypto era) -> KeyHash 'Witness (Crypto era)
forall (kr :: KeyRole) crypto.
WitVKey kr crypto -> KeyHash 'Witness crypto
witKeyHash Set (WitVKey 'Witness (Crypto era))
aWits
      Set (KeyHash 'Witness (Crypto era))
-> Set (KeyHash 'Witness (Crypto era))
-> Set (KeyHash 'Witness (Crypto era))
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` (BootstrapWitness (Crypto era) -> KeyHash 'Witness (Crypto era))
-> Set (BootstrapWitness (Crypto era))
-> Set (KeyHash 'Witness (Crypto era))
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map BootstrapWitness (Crypto era) -> KeyHash 'Witness (Crypto era)
forall crypto.
Crypto crypto =>
BootstrapWitness crypto -> KeyHash 'Witness crypto
bootstrapWitKeyHash Set (BootstrapWitness (Crypto era))
bsWits

-- | Collect the set of hashes of keys that needs to sign a
--  given transaction. This set consists of the txin owners,
--  certificate authors, and withdrawal reward accounts.
witsVKeyNeeded ::
  forall era.
  ( ShelleyBased era,
    HasField "wdrls" (Core.TxBody era) (Wdrl (Crypto era)),
    HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era))),
    HasField "inputs" (Core.TxBody era) (Set (TxIn (Crypto era))),
    HasField "update" (Core.TxBody era) (StrictMaybe (Update era))
  ) =>
  UTxO era ->
  Tx era ->
  GenDelegs (Crypto era) ->
  WitHashes (Crypto era)
witsVKeyNeeded :: UTxO era
-> Tx era -> GenDelegs (Crypto era) -> WitHashes (Crypto era)
witsVKeyNeeded UTxO era
utxo' tx :: Tx era
tx@(Tx TxBody era
txbody WitnessSet era
_ StrictMaybe (AuxiliaryData era)
_) GenDelegs (Crypto era)
genDelegs =
  Set (KeyHash 'Witness (Crypto era)) -> WitHashes (Crypto era)
forall crypto. Set (KeyHash 'Witness crypto) -> WitHashes crypto
WitHashes (Set (KeyHash 'Witness (Crypto era)) -> WitHashes (Crypto era))
-> Set (KeyHash 'Witness (Crypto era)) -> WitHashes (Crypto era)
forall a b. (a -> b) -> a -> b
$
    Set (KeyHash 'Witness (Crypto era))
certAuthors
      Set (KeyHash 'Witness (Crypto era))
-> Set (KeyHash 'Witness (Crypto era))
-> Set (KeyHash 'Witness (Crypto era))
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set (KeyHash 'Witness (Crypto era))
inputAuthors
      Set (KeyHash 'Witness (Crypto era))
-> Set (KeyHash 'Witness (Crypto era))
-> Set (KeyHash 'Witness (Crypto era))
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set (KeyHash 'Witness (Crypto era))
owners
      Set (KeyHash 'Witness (Crypto era))
-> Set (KeyHash 'Witness (Crypto era))
-> Set (KeyHash 'Witness (Crypto era))
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set (KeyHash 'Witness (Crypto era))
wdrlAuthors
      Set (KeyHash 'Witness (Crypto era))
-> Set (KeyHash 'Witness (Crypto era))
-> Set (KeyHash 'Witness (Crypto era))
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set (KeyHash 'Witness (Crypto era))
updateKeys
  where
    inputAuthors :: Set (KeyHash 'Witness (Crypto era))
    inputAuthors :: Set (KeyHash 'Witness (Crypto era))
inputAuthors = (TxIn (Crypto era)
 -> Set (KeyHash 'Witness (Crypto era))
 -> Set (KeyHash 'Witness (Crypto era)))
-> Set (KeyHash 'Witness (Crypto era))
-> Set (TxIn (Crypto era))
-> Set (KeyHash 'Witness (Crypto era))
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr TxIn (Crypto era)
-> Set (KeyHash 'Witness (Crypto era))
-> Set (KeyHash 'Witness (Crypto era))
accum Set (KeyHash 'Witness (Crypto era))
forall a. Set a
Set.empty (TxBody era -> Set (TxIn (Crypto era))
forall k (x :: k) r a. HasField x r a => r -> a
getField @"inputs" TxBody era
txbody)
      where
        accum :: TxIn (Crypto era)
-> Set (KeyHash 'Witness (Crypto era))
-> Set (KeyHash 'Witness (Crypto era))
accum TxIn (Crypto era)
txin Set (KeyHash 'Witness (Crypto era))
ans =
          case TxIn (Crypto era) -> UTxO era -> Maybe (TxOut era)
forall era. TxIn (Crypto era) -> UTxO era -> Maybe (TxOut era)
txinLookup TxIn (Crypto era)
txin UTxO era
utxo' of
            Just (TxOut (Addr Network
_ (KeyHashObj KeyHash 'Payment (Crypto era)
pay) StakeReference (Crypto era)
_) Value era
_) ->
              KeyHash 'Witness (Crypto era)
-> Set (KeyHash 'Witness (Crypto era))
-> Set (KeyHash 'Witness (Crypto era))
forall a. Ord a => a -> Set a -> Set a
Set.insert (KeyHash 'Payment (Crypto era) -> KeyHash 'Witness (Crypto era)
forall (a :: KeyRole -> * -> *) (r :: KeyRole) crypto.
HasKeyRole a =>
a r crypto -> a 'Witness crypto
asWitness KeyHash 'Payment (Crypto era)
pay) Set (KeyHash 'Witness (Crypto era))
ans
            Just (TxOut (AddrBootstrap BootstrapAddress (Crypto era)
bootAddr) Value era
_) ->
              KeyHash 'Witness (Crypto era)
-> Set (KeyHash 'Witness (Crypto era))
-> Set (KeyHash 'Witness (Crypto era))
forall a. Ord a => a -> Set a -> Set a
Set.insert (KeyHash 'Payment (Crypto era) -> KeyHash 'Witness (Crypto era)
forall (a :: KeyRole -> * -> *) (r :: KeyRole) crypto.
HasKeyRole a =>
a r crypto -> a 'Witness crypto
asWitness (BootstrapAddress (Crypto era) -> KeyHash 'Payment (Crypto era)
forall crypto.
Crypto crypto =>
BootstrapAddress crypto -> KeyHash 'Payment crypto
bootstrapKeyHash BootstrapAddress (Crypto era)
bootAddr)) Set (KeyHash 'Witness (Crypto era))
ans
            Maybe (TxOut era)
_other -> Set (KeyHash 'Witness (Crypto era))
ans
    wdrlAuthors :: Set (KeyHash 'Witness (Crypto era))
    wdrlAuthors :: Set (KeyHash 'Witness (Crypto era))
wdrlAuthors = (RewardAcnt (Crypto era)
 -> Coin
 -> Set (KeyHash 'Witness (Crypto era))
 -> Set (KeyHash 'Witness (Crypto era)))
-> Set (KeyHash 'Witness (Crypto era))
-> Map (RewardAcnt (Crypto era)) Coin
-> Set (KeyHash 'Witness (Crypto era))
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey RewardAcnt (Crypto era)
-> Coin
-> Set (KeyHash 'Witness (Crypto era))
-> Set (KeyHash 'Witness (Crypto era))
forall crypto p.
RewardAcnt crypto
-> p
-> Set (KeyHash 'Witness crypto)
-> Set (KeyHash 'Witness crypto)
accum Set (KeyHash 'Witness (Crypto era))
forall a. Set a
Set.empty (Wdrl (Crypto era) -> Map (RewardAcnt (Crypto era)) Coin
forall crypto. Wdrl crypto -> Map (RewardAcnt crypto) Coin
unWdrl (TxBody era -> Wdrl (Crypto era)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"wdrls" TxBody era
txbody))
      where
        accum :: RewardAcnt crypto
-> p
-> Set (KeyHash 'Witness crypto)
-> Set (KeyHash 'Witness crypto)
accum RewardAcnt crypto
key p
_ Set (KeyHash 'Witness crypto)
ans = Set (KeyHash 'Witness crypto)
-> Set (KeyHash 'Witness crypto) -> Set (KeyHash 'Witness crypto)
forall a. Ord a => Set a -> Set a -> Set a
Set.union ([Credential 'Staking crypto] -> Set (KeyHash 'Witness crypto)
forall (r :: KeyRole) crypto.
[Credential r crypto] -> Set (KeyHash 'Witness crypto)
extractKeyHashWitnessSet [RewardAcnt crypto -> Credential 'Staking crypto
forall crypto. RewardAcnt crypto -> Credential 'Staking crypto
getRwdCred RewardAcnt crypto
key]) Set (KeyHash 'Witness crypto)
ans
    owners :: Set (KeyHash 'Witness (Crypto era))
    owners :: Set (KeyHash 'Witness (Crypto era))
owners = (DCert (Crypto era)
 -> Set (KeyHash 'Witness (Crypto era))
 -> Set (KeyHash 'Witness (Crypto era)))
-> Set (KeyHash 'Witness (Crypto era))
-> StrictSeq (DCert (Crypto era))
-> Set (KeyHash 'Witness (Crypto era))
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr DCert (Crypto era)
-> Set (KeyHash 'Witness (Crypto era))
-> Set (KeyHash 'Witness (Crypto era))
forall crypto.
DCert crypto
-> Set (KeyHash 'Witness crypto) -> Set (KeyHash 'Witness crypto)
accum Set (KeyHash 'Witness (Crypto era))
forall a. Set a
Set.empty (TxBody era -> StrictSeq (DCert (Crypto era))
forall k (x :: k) r a. HasField x r a => r -> a
getField @"certs" TxBody era
txbody)
      where
        accum :: DCert crypto
-> Set (KeyHash 'Witness crypto) -> Set (KeyHash 'Witness crypto)
accum (DCertPool (RegPool PoolParams crypto
pool)) Set (KeyHash 'Witness crypto)
ans =
          Set (KeyHash 'Witness crypto)
-> Set (KeyHash 'Witness crypto) -> Set (KeyHash 'Witness crypto)
forall a. Ord a => Set a -> Set a -> Set a
Set.union
            ((KeyHash 'Staking crypto -> KeyHash 'Witness crypto)
-> Set (KeyHash 'Staking crypto) -> Set (KeyHash 'Witness crypto)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map KeyHash 'Staking crypto -> KeyHash 'Witness crypto
forall (a :: KeyRole -> * -> *) (r :: KeyRole) crypto.
HasKeyRole a =>
a r crypto -> a 'Witness crypto
asWitness (PoolParams crypto -> Set (KeyHash 'Staking crypto)
forall crypto. PoolParams crypto -> Set (KeyHash 'Staking crypto)
_poolOwners PoolParams crypto
pool))
            Set (KeyHash 'Witness crypto)
ans
        accum DCert crypto
_cert Set (KeyHash 'Witness crypto)
ans = Set (KeyHash 'Witness crypto)
ans
    cwitness :: DCert crypto -> Set (KeyHash 'Witness crypto)
cwitness (DCertDeleg DelegCert crypto
dc) = [Credential 'Staking crypto] -> Set (KeyHash 'Witness crypto)
forall (r :: KeyRole) crypto.
[Credential r crypto] -> Set (KeyHash 'Witness crypto)
extractKeyHashWitnessSet [DelegCert crypto -> Credential 'Staking crypto
forall crypto. DelegCert crypto -> Credential 'Staking crypto
delegCWitness DelegCert crypto
dc]
    cwitness (DCertPool PoolCert crypto
pc) = [Credential 'StakePool crypto] -> Set (KeyHash 'Witness crypto)
forall (r :: KeyRole) crypto.
[Credential r crypto] -> Set (KeyHash 'Witness crypto)
extractKeyHashWitnessSet [PoolCert crypto -> Credential 'StakePool crypto
forall crypto. PoolCert crypto -> Credential 'StakePool crypto
poolCWitness PoolCert crypto
pc]
    cwitness (DCertGenesis GenesisDelegCert crypto
gc) = KeyHash 'Witness crypto -> Set (KeyHash 'Witness crypto)
forall a. a -> Set a
Set.singleton (KeyHash 'Genesis crypto -> KeyHash 'Witness crypto
forall (a :: KeyRole -> * -> *) (r :: KeyRole) crypto.
HasKeyRole a =>
a r crypto -> a 'Witness crypto
asWitness (KeyHash 'Genesis crypto -> KeyHash 'Witness crypto)
-> KeyHash 'Genesis crypto -> KeyHash 'Witness crypto
forall a b. (a -> b) -> a -> b
$ GenesisDelegCert crypto -> KeyHash 'Genesis crypto
forall crypto. GenesisDelegCert crypto -> KeyHash 'Genesis crypto
genesisCWitness GenesisDelegCert crypto
gc)
    cwitness DCert crypto
c = String -> Set (KeyHash 'Witness crypto)
forall a. HasCallStack => String -> a
error (String -> Set (KeyHash 'Witness crypto))
-> String -> Set (KeyHash 'Witness crypto)
forall a b. (a -> b) -> a -> b
$ DCert crypto -> String
forall a. Show a => a -> String
show DCert crypto
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" does not have a witness"
    -- key reg requires no witness but this is already filtered outby requiresVKeyWitness
    -- before the call to `cwitness`, so this error should never be reached.

    certAuthors :: Set (KeyHash 'Witness (Crypto era))
    certAuthors :: Set (KeyHash 'Witness (Crypto era))
certAuthors = (DCert (Crypto era)
 -> Set (KeyHash 'Witness (Crypto era))
 -> Set (KeyHash 'Witness (Crypto era)))
-> Set (KeyHash 'Witness (Crypto era))
-> StrictSeq (DCert (Crypto era))
-> Set (KeyHash 'Witness (Crypto era))
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr DCert (Crypto era)
-> Set (KeyHash 'Witness (Crypto era))
-> Set (KeyHash 'Witness (Crypto era))
forall crypto.
DCert crypto
-> Set (KeyHash 'Witness crypto) -> Set (KeyHash 'Witness crypto)
accum Set (KeyHash 'Witness (Crypto era))
forall a. Set a
Set.empty (TxBody era -> StrictSeq (DCert (Crypto era))
forall k (x :: k) r a. HasField x r a => r -> a
getField @"certs" TxBody era
txbody)
      where
        accum :: DCert crypto
-> Set (KeyHash 'Witness crypto) -> Set (KeyHash 'Witness crypto)
accum DCert crypto
cert Set (KeyHash 'Witness crypto)
ans | DCert crypto -> Bool
forall crypto. DCert crypto -> Bool
requiresVKeyWitness DCert crypto
cert = Set (KeyHash 'Witness crypto)
-> Set (KeyHash 'Witness crypto) -> Set (KeyHash 'Witness crypto)
forall a. Ord a => Set a -> Set a -> Set a
Set.union (DCert crypto -> Set (KeyHash 'Witness crypto)
forall crypto. DCert crypto -> Set (KeyHash 'Witness crypto)
cwitness DCert crypto
cert) Set (KeyHash 'Witness crypto)
ans
        accum DCert crypto
_cert Set (KeyHash 'Witness crypto)
ans = Set (KeyHash 'Witness crypto)
ans
    updateKeys :: Set (KeyHash 'Witness (Crypto era))
    updateKeys :: Set (KeyHash 'Witness (Crypto era))
updateKeys = KeyHash 'Witness (Crypto era) -> KeyHash 'Witness (Crypto era)
forall (a :: KeyRole -> * -> *) (r :: KeyRole) crypto.
HasKeyRole a =>
a r crypto -> a 'Witness crypto
asWitness (KeyHash 'Witness (Crypto era) -> KeyHash 'Witness (Crypto era))
-> Set (KeyHash 'Witness (Crypto era))
-> Set (KeyHash 'Witness (Crypto era))
forall b a. Ord b => (a -> b) -> Set a -> Set b
`Set.map` Maybe (Update era)
-> GenDelegs (Crypto era) -> Set (KeyHash 'Witness (Crypto era))
forall era.
Maybe (Update era)
-> GenDelegs (Crypto era) -> Set (KeyHash 'Witness (Crypto era))
propWits (Tx era -> Maybe (Update era)
forall era.
(ShelleyBased era,
 HasField "update" (TxBody era) (StrictMaybe (Update era))) =>
Tx era -> Maybe (Update era)
txup Tx era
tx) GenDelegs (Crypto era)
genDelegs

-- | Given a ledger state, determine if the UTxO witnesses in a given
--  transaction are correct.
verifiedWits ::
  ( TxBodyConstraints era,
    Core.AnnotatedData (Core.Script era),
    ToCBOR (Core.AuxiliaryData era),
    DSignable (Crypto era) (Hash (Crypto era) EraIndependentTxBody)
  ) =>
  Tx era ->
  Either [VKey 'Witness (Crypto era)] ()
verifiedWits :: Tx era -> Either [VKey 'Witness (Crypto era)] ()
verifiedWits (Tx TxBody era
txbody WitnessSet era
wits StrictMaybe (AuxiliaryData era)
_) =
  case ([VKey 'Witness (Crypto era)]
failed [VKey 'Witness (Crypto era)]
-> [VKey 'Witness (Crypto era)] -> [VKey 'Witness (Crypto era)]
forall a. Semigroup a => a -> a -> a
<> [VKey 'Witness (Crypto era)]
failedBootstrap) of
    [] -> () -> Either [VKey 'Witness (Crypto era)] ()
forall a b. b -> Either a b
Right ()
    [VKey 'Witness (Crypto era)]
nonEmpty -> [VKey 'Witness (Crypto era)]
-> Either [VKey 'Witness (Crypto era)] ()
forall a b. a -> Either a b
Left [VKey 'Witness (Crypto era)]
nonEmpty
  where
    wvkKey :: WitVKey kr crypto -> VKey kr crypto
wvkKey (WitVKey VKey kr crypto
k SignedDSIGN crypto (Hash crypto EraIndependentTxBody)
_) = VKey kr crypto
k
    failed :: [VKey 'Witness (Crypto era)]
failed =
      WitVKey 'Witness (Crypto era) -> VKey 'Witness (Crypto era)
forall crypto (kr :: KeyRole).
(Crypto crypto, Typeable kr) =>
WitVKey kr crypto -> VKey kr crypto
wvkKey
        (WitVKey 'Witness (Crypto era) -> VKey 'Witness (Crypto era))
-> [WitVKey 'Witness (Crypto era)] -> [VKey 'Witness (Crypto era)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WitVKey 'Witness (Crypto era) -> Bool)
-> [WitVKey 'Witness (Crypto era)]
-> [WitVKey 'Witness (Crypto era)]
forall a. (a -> Bool) -> [a] -> [a]
filter
          (Bool -> Bool
not (Bool -> Bool)
-> (WitVKey 'Witness (Crypto era) -> Bool)
-> WitVKey 'Witness (Crypto era)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash (Crypto era) EraIndependentTxBody
-> WitVKey 'Witness (Crypto era) -> Bool
forall (kr :: KeyRole) crypto.
(Typeable kr, Crypto crypto,
 DSignable crypto (Hash crypto EraIndependentTxBody)) =>
Hash crypto EraIndependentTxBody -> WitVKey kr crypto -> Bool
verifyWitVKey (Hash (HASH (Crypto era)) (HashIndex (TxBody era))
-> Hash (Crypto era) EraIndependentTxBody
coerce (Hash (HASH (Crypto era)) (HashIndex (TxBody era))
 -> Hash (Crypto era) EraIndependentTxBody)
-> (TxBody era
    -> Hash (HASH (Crypto era)) (HashIndex (TxBody era)))
-> TxBody era
-> Hash (Crypto era) EraIndependentTxBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody era -> Hash (HASH (Crypto era)) (HashIndex (TxBody era))
forall a e.
HashAnnotated a e =>
a -> Hash (HASH (Crypto e)) (HashIndex a)
hashAnnotated (TxBody era -> Hash (Crypto era) EraIndependentTxBody)
-> TxBody era -> Hash (Crypto era) EraIndependentTxBody
forall a b. (a -> b) -> a -> b
$ TxBody era
txbody))
          (Set (WitVKey 'Witness (Crypto era))
-> [WitVKey 'Witness (Crypto era)]
forall a. Set a -> [a]
Set.toList (Set (WitVKey 'Witness (Crypto era))
 -> [WitVKey 'Witness (Crypto era)])
-> Set (WitVKey 'Witness (Crypto era))
-> [WitVKey 'Witness (Crypto era)]
forall a b. (a -> b) -> a -> b
$ 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 WitnessSet era
wits)
    failedBootstrap :: [VKey 'Witness (Crypto era)]
failedBootstrap =
      BootstrapWitness (Crypto era) -> VKey 'Witness (Crypto era)
forall crypto.
BootstrapWitness crypto -> Crypto crypto => VKey 'Witness crypto
bwKey
        (BootstrapWitness (Crypto era) -> VKey 'Witness (Crypto era))
-> [BootstrapWitness (Crypto era)] -> [VKey 'Witness (Crypto era)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BootstrapWitness (Crypto era) -> Bool)
-> [BootstrapWitness (Crypto era)]
-> [BootstrapWitness (Crypto era)]
forall a. (a -> Bool) -> [a] -> [a]
filter
          (Bool -> Bool
not (Bool -> Bool)
-> (BootstrapWitness (Crypto era) -> Bool)
-> BootstrapWitness (Crypto era)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash (Crypto era) EraIndependentTxBody
-> BootstrapWitness (Crypto era) -> Bool
forall crypto.
(Crypto crypto,
 Signable (DSIGN crypto) (Hash crypto EraIndependentTxBody)) =>
Hash crypto EraIndependentTxBody -> BootstrapWitness crypto -> Bool
verifyBootstrapWit (Hash (HASH (Crypto era)) (HashIndex (TxBody era))
-> Hash (Crypto era) EraIndependentTxBody
coerce (Hash (HASH (Crypto era)) (HashIndex (TxBody era))
 -> Hash (Crypto era) EraIndependentTxBody)
-> (TxBody era
    -> Hash (HASH (Crypto era)) (HashIndex (TxBody era)))
-> TxBody era
-> Hash (Crypto era) EraIndependentTxBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody era -> Hash (HASH (Crypto era)) (HashIndex (TxBody era))
forall a e.
HashAnnotated a e =>
a -> Hash (HASH (Crypto e)) (HashIndex a)
hashAnnotated (TxBody era -> Hash (Crypto era) EraIndependentTxBody)
-> TxBody era -> Hash (Crypto era) EraIndependentTxBody
forall a b. (a -> b) -> a -> b
$ TxBody era
txbody))
          (Set (BootstrapWitness (Crypto era))
-> [BootstrapWitness (Crypto era)]
forall a. Set a -> [a]
Set.toList (Set (BootstrapWitness (Crypto era))
 -> [BootstrapWitness (Crypto era)])
-> Set (BootstrapWitness (Crypto era))
-> [BootstrapWitness (Crypto era)]
forall a b. (a -> b) -> a -> b
$ WitnessSet era
-> (Era era, AnnotatedData (Script era)) =>
   Set (BootstrapWitness (Crypto era))
forall era.
WitnessSet era
-> (Era era, AnnotatedData (Script era)) =>
   Set (BootstrapWitness (Crypto era))
bootWits WitnessSet era
wits)

-- | Calculate the set of hash keys of the required witnesses for update
-- proposals.
propWits ::
  Maybe (Update era) ->
  GenDelegs (Crypto era) ->
  Set (KeyHash 'Witness (Crypto era))
propWits :: Maybe (Update era)
-> GenDelegs (Crypto era) -> Set (KeyHash 'Witness (Crypto era))
propWits Maybe (Update era)
Nothing GenDelegs (Crypto era)
_ = Set (KeyHash 'Witness (Crypto era))
forall a. Set a
Set.empty
propWits (Just (Update (ProposedPPUpdates Map (KeyHash 'Genesis (Crypto era)) (PParamsUpdate era)
pup) EpochNo
_)) (GenDelegs Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
genDelegs) =
  (KeyHash 'GenesisDelegate (Crypto era)
 -> KeyHash 'Witness (Crypto era))
-> Set (KeyHash 'GenesisDelegate (Crypto era))
-> Set (KeyHash 'Witness (Crypto era))
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map KeyHash 'GenesisDelegate (Crypto era)
-> KeyHash 'Witness (Crypto era)
forall (a :: KeyRole -> * -> *) (r :: KeyRole) crypto.
HasKeyRole a =>
a r crypto -> a 'Witness crypto
asWitness (Set (KeyHash 'GenesisDelegate (Crypto era))
 -> Set (KeyHash 'Witness (Crypto era)))
-> ([KeyHash 'GenesisDelegate (Crypto era)]
    -> Set (KeyHash 'GenesisDelegate (Crypto era)))
-> [KeyHash 'GenesisDelegate (Crypto era)]
-> Set (KeyHash 'Witness (Crypto era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [KeyHash 'GenesisDelegate (Crypto era)]
-> Set (KeyHash 'GenesisDelegate (Crypto era))
forall a. Ord a => [a] -> Set a
Set.fromList ([KeyHash 'GenesisDelegate (Crypto era)]
 -> Set (KeyHash 'Witness (Crypto era)))
-> [KeyHash 'GenesisDelegate (Crypto era)]
-> Set (KeyHash 'Witness (Crypto era))
forall a b. (a -> b) -> a -> b
$ Map
  (KeyHash 'Genesis (Crypto era))
  (KeyHash 'GenesisDelegate (Crypto era))
-> [KeyHash 'GenesisDelegate (Crypto era)]
forall k a. Map k a -> [a]
Map.elems Map
  (KeyHash 'Genesis (Crypto era))
  (KeyHash 'GenesisDelegate (Crypto era))
updateKeys
  where
    updateKeys' :: Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
updateKeys' = Exp
  (Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era)))
-> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
forall s t. Embed s t => Exp t -> s
eval (Map (KeyHash 'Genesis (Crypto era)) (PParamsUpdate era)
-> Set (KeyHash 'Genesis (Crypto era))
forall k a. Map k a -> Set k
Map.keysSet Map (KeyHash 'Genesis (Crypto era)) (PParamsUpdate era)
pup Set (KeyHash 'Genesis (Crypto era))
-> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
-> Exp
     (Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era)))
forall k s1 s2 (f :: * -> * -> *) v.
(Ord k, HasExp s1 (Sett k ()), HasExp s2 (f k v)) =>
s1 -> s2 -> Exp (f k v)
 Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
genDelegs)
    updateKeys :: Map
  (KeyHash 'Genesis (Crypto era))
  (KeyHash 'GenesisDelegate (Crypto era))
updateKeys = (GenDelegPair (Crypto era)
 -> KeyHash 'GenesisDelegate (Crypto era))
-> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
-> Map
     (KeyHash 'Genesis (Crypto era))
     (KeyHash 'GenesisDelegate (Crypto era))
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map GenDelegPair (Crypto era) -> KeyHash 'GenesisDelegate (Crypto era)
forall crypto.
GenDelegPair crypto -> KeyHash 'GenesisDelegate crypto
genDelegKeyHash Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
updateKeys'

-- Functions for stake delegation model

-- | Calculate the change to the deposit pool for a given transaction.
depositPoolChange ::
  ( HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era)))
  ) =>
  LedgerState era ->
  PParams era ->
  Core.TxBody era ->
  Coin
depositPoolChange :: LedgerState era -> PParams era -> TxBody era -> Coin
depositPoolChange LedgerState era
ls PParams era
pp TxBody era
tx = (Coin
currentPool Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Coin
txDeposits) Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Coin
txRefunds
  where
    -- Note that while (currentPool + txDeposits) >= txRefunds,
    -- it could be that txDeposits < txRefunds. We keep the parenthesis above
    -- to emphasize this point.

    currentPool :: Coin
currentPool = (UTxOState era -> Coin
forall era. UTxOState era -> Coin
_deposited (UTxOState era -> Coin)
-> (LedgerState era -> UTxOState era) -> LedgerState era -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState era -> UTxOState era
forall era. LedgerState era -> UTxOState era
_utxoState) LedgerState era
ls
    txDeposits :: Coin
txDeposits =
      PParams era
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
-> [DCert (Crypto era)]
-> Coin
forall era.
PParams era
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
-> [DCert (Crypto era)]
-> Coin
totalDeposits PParams era
pp ((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)))
-> (LedgerState era -> PState (Crypto era))
-> LedgerState 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
_pstate (DPState (Crypto era) -> PState (Crypto era))
-> (LedgerState era -> DPState (Crypto era))
-> LedgerState 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)
_delegationState) LedgerState era
ls) (StrictSeq (DCert (Crypto era)) -> [DCert (Crypto era)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (StrictSeq (DCert (Crypto era)) -> [DCert (Crypto era)])
-> StrictSeq (DCert (Crypto era)) -> [DCert (Crypto era)]
forall a b. (a -> b) -> a -> b
$ TxBody era -> StrictSeq (DCert (Crypto era))
forall k (x :: k) r a. HasField x r a => r -> a
getField @"certs" TxBody era
tx)
    txRefunds :: Coin
txRefunds = PParams era -> TxBody era -> Coin
forall era.
HasField "certs" (TxBody era) (StrictSeq (DCert (Crypto era))) =>
PParams era -> TxBody era -> Coin
keyRefunds PParams era
pp TxBody era
tx

reapRewards ::
  RewardAccounts crypto ->
  RewardAccounts crypto ->
  RewardAccounts crypto
reapRewards :: RewardAccounts crypto
-> RewardAccounts crypto -> RewardAccounts crypto
reapRewards RewardAccounts crypto
dStateRewards RewardAccounts crypto
withdrawals =
  (Credential 'Staking crypto -> Coin -> Coin)
-> RewardAccounts crypto -> RewardAccounts crypto
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey Credential 'Staking crypto -> Coin -> Coin
removeRewards RewardAccounts crypto
dStateRewards
  where
    removeRewards :: Credential 'Staking crypto -> Coin -> Coin
removeRewards Credential 'Staking crypto
k Coin
v = if Credential 'Staking crypto
k Credential 'Staking crypto -> RewardAccounts crypto -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` RewardAccounts crypto
withdrawals then Integer -> Coin
Coin Integer
0 else Coin
v

---------------------------------
-- epoch boundary calculations --
---------------------------------

stakeDistr ::
  forall era.
  ShelleyBased era =>
  UTxO era ->
  DState (Crypto era) ->
  PState (Crypto era) ->
  SnapShot (Crypto era)
stakeDistr :: UTxO era
-> DState (Crypto era)
-> PState (Crypto era)
-> SnapShot (Crypto era)
stakeDistr UTxO era
u DState (Crypto era)
ds PState (Crypto era)
ps =
  Stake (Crypto era)
-> Map
     (Credential 'Staking (Crypto era))
     (KeyHash 'StakePool (Crypto era))
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
-> SnapShot (Crypto era)
forall crypto.
Stake crypto
-> Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
-> Map (KeyHash 'StakePool crypto) (PoolParams crypto)
-> SnapShot crypto
SnapShot
    (Map (Credential 'Staking (Crypto era)) Coin -> Stake (Crypto era)
forall crypto.
Map (Credential 'Staking crypto) Coin -> Stake crypto
Stake (Map (Credential 'Staking (Crypto era)) Coin -> Stake (Crypto era))
-> Map (Credential 'Staking (Crypto era)) Coin
-> Stake (Crypto era)
forall a b. (a -> b) -> a -> b
$ Exp (Map (Credential 'Staking (Crypto era)) Coin)
-> Map (Credential 'Staking (Crypto era)) Coin
forall s t. Embed s t => Exp t -> s
eval (Map
  (Credential 'Staking (Crypto era))
  (KeyHash 'StakePool (Crypto era))
-> Exp (Sett (Credential 'Staking (Crypto era)) ())
forall k s (f :: * -> * -> *) v.
(Ord k, HasExp s (f k v)) =>
s -> Exp (Sett k ())
dom Map
  (Credential 'Staking (Crypto era))
  (KeyHash 'StakePool (Crypto era))
activeDelegs Exp (Sett (Credential 'Staking (Crypto era)) ())
-> Map (Credential 'Staking (Crypto era)) Coin
-> Exp (Map (Credential 'Staking (Crypto era)) Coin)
forall k s1 s2 (f :: * -> * -> *) v.
(Ord k, HasExp s1 (Sett k ()), HasExp s2 (f k v)) =>
s1 -> s2 -> Exp (f k v)
 Map (Credential 'Staking (Crypto era)) Coin
stakeRelation))
    Map
  (Credential 'Staking (Crypto era))
  (KeyHash 'StakePool (Crypto era))
delegs
    Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
poolParams
  where
    DState Map (Credential 'Staking (Crypto era)) Coin
rewards' Map
  (Credential 'Staking (Crypto era))
  (KeyHash 'StakePool (Crypto era))
delegs Bimap Ptr (Credential 'Staking (Crypto era))
ptrs' Map (FutureGenDeleg (Crypto era)) (GenDelegPair (Crypto era))
_ GenDelegs (Crypto era)
_ InstantaneousRewards (Crypto era)
_ = DState (Crypto era)
ds
    PState Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
poolParams Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
_ Map (KeyHash 'StakePool (Crypto era)) EpochNo
_ = PState (Crypto era)
ps
    stakeRelation :: Map (Credential 'Staking (Crypto era)) Coin
    stakeRelation :: Map (Credential 'Staking (Crypto era)) Coin
stakeRelation = Map Ptr (Credential 'Staking (Crypto era))
-> UTxO era
-> Map (Credential 'Staking (Crypto era)) Coin
-> Map (Credential 'Staking (Crypto era)) Coin
forall era.
ShelleyBased era =>
Map Ptr (Credential 'Staking (Crypto era))
-> UTxO era
-> Map (Credential 'Staking (Crypto era)) Coin
-> Map (Credential 'Staking (Crypto era)) Coin
aggregateUtxoCoinByCredential (Bimap Ptr (Credential 'Staking (Crypto era))
-> Map Ptr (Credential 'Staking (Crypto era))
forall v k. BiMap v k v -> Map k v
forwards Bimap Ptr (Credential 'Staking (Crypto era))
ptrs') UTxO era
u Map (Credential 'Staking (Crypto era)) Coin
rewards'
    activeDelegs :: Map (Credential 'Staking (Crypto era)) (KeyHash 'StakePool (Crypto era))
    activeDelegs :: Map
  (Credential 'Staking (Crypto era))
  (KeyHash 'StakePool (Crypto era))
activeDelegs = Exp
  (Map
     (Credential 'Staking (Crypto era))
     (KeyHash 'StakePool (Crypto era)))
-> Map
     (Credential 'Staking (Crypto era))
     (KeyHash 'StakePool (Crypto era))
forall s t. Embed s t => Exp t -> s
eval ((Map (Credential 'Staking (Crypto era)) Coin
-> Exp (Sett (Credential 'Staking (Crypto era)) ())
forall k s (f :: * -> * -> *) v.
(Ord k, HasExp s (f k v)) =>
s -> Exp (Sett k ())
dom Map (Credential 'Staking (Crypto era)) Coin
rewards' Exp (Sett (Credential 'Staking (Crypto era)) ())
-> Map
     (Credential 'Staking (Crypto era))
     (KeyHash 'StakePool (Crypto era))
-> Exp
     (Map
        (Credential 'Staking (Crypto era))
        (KeyHash 'StakePool (Crypto era)))
forall k s1 s2 (f :: * -> * -> *) v.
(Ord k, HasExp s1 (Sett k ()), HasExp s2 (f k v)) =>
s1 -> s2 -> Exp (f k v)
 Map
  (Credential 'Staking (Crypto era))
  (KeyHash 'StakePool (Crypto era))
delegs) Exp
  (Map
     (Credential 'Staking (Crypto era))
     (KeyHash 'StakePool (Crypto era)))
-> Exp (Sett (KeyHash 'StakePool (Crypto era)) ())
-> Exp
     (Map
        (Credential 'Staking (Crypto era))
        (KeyHash 'StakePool (Crypto era)))
forall k (g :: * -> * -> *) v s1 (f :: * -> * -> *) s2.
(Ord k, Iter g, Ord v, HasExp s1 (f k v), HasExp s2 (g v ())) =>
s1 -> s2 -> Exp (f k v)
 Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
-> Exp (Sett (KeyHash 'StakePool (Crypto era)) ())
forall k s (f :: * -> * -> *) v.
(Ord k, HasExp s (f k v)) =>
s -> Exp (Sett k ())
dom Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
poolParams)

-- | Apply a reward update
applyRUpd ::
  RewardUpdate (Crypto era) ->
  EpochState era ->
  EpochState era
applyRUpd :: RewardUpdate (Crypto era) -> EpochState era -> EpochState era
applyRUpd RewardUpdate (Crypto era)
ru (EpochState AccountState
as SnapShots (Crypto era)
ss LedgerState era
ls PParams era
pr PParams era
pp NonMyopic (Crypto era)
_nm) = AccountState
-> SnapShots (Crypto era)
-> LedgerState era
-> PParams era
-> PParams era
-> NonMyopic (Crypto era)
-> EpochState era
forall era.
AccountState
-> SnapShots (Crypto era)
-> LedgerState era
-> PParams era
-> PParams era
-> NonMyopic (Crypto era)
-> EpochState era
EpochState AccountState
as' SnapShots (Crypto era)
ss LedgerState era
ls' PParams era
pr PParams era
pp NonMyopic (Crypto era)
nm'
  where
    utxoState_ :: UTxOState era
utxoState_ = LedgerState era -> UTxOState era
forall era. LedgerState era -> UTxOState era
_utxoState LedgerState era
ls
    delegState :: DPState (Crypto era)
delegState = LedgerState era -> DPState (Crypto era)
forall era. LedgerState era -> DPState (Crypto era)
_delegationState LedgerState era
ls
    dState :: DState (Crypto era)
dState = DPState (Crypto era) -> DState (Crypto era)
forall crypto. DPState crypto -> DState crypto
_dstate DPState (Crypto era)
delegState
    (Map (Credential 'Staking (Crypto era)) Coin
regRU, Map (Credential 'Staking (Crypto era)) Coin
unregRU) =
      (Credential 'Staking (Crypto era) -> Coin -> Bool)
-> Map (Credential 'Staking (Crypto era)) Coin
-> (Map (Credential 'Staking (Crypto era)) Coin,
    Map (Credential 'Staking (Crypto era)) Coin)
forall k a. (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
Map.partitionWithKey
        (\Credential 'Staking (Crypto era)
k Coin
_ -> Exp Bool -> Bool
forall s t. Embed s t => Exp t -> s
eval (Credential 'Staking (Crypto era)
k Credential 'Staking (Crypto era)
-> Exp (Sett (Credential 'Staking (Crypto era)) ()) -> Exp Bool
forall k (g :: * -> * -> *) s.
(Show k, Ord k, Iter g, HasExp s (g k ())) =>
k -> s -> Exp Bool
 Map (Credential 'Staking (Crypto era)) Coin
-> Exp (Sett (Credential 'Staking (Crypto era)) ())
forall k s (f :: * -> * -> *) v.
(Ord k, HasExp s (f k v)) =>
s -> Exp (Sett k ())
dom (DState (Crypto era) -> Map (Credential 'Staking (Crypto era)) Coin
forall crypto. DState crypto -> RewardAccounts crypto
_rewards DState (Crypto era)
dState)))
        (RewardUpdate (Crypto era)
-> Map (Credential 'Staking (Crypto era)) Coin
forall crypto.
RewardUpdate crypto -> Map (Credential 'Staking crypto) Coin
rs RewardUpdate (Crypto era)
ru)
    as' :: AccountState
as' =
      AccountState
as
        { _treasury :: Coin
_treasury = (Coin -> DeltaCoin -> Coin
addDeltaCoin (AccountState -> Coin
_treasury AccountState
as) (RewardUpdate (Crypto era) -> DeltaCoin
forall crypto. RewardUpdate crypto -> DeltaCoin
deltaT RewardUpdate (Crypto era)
ru)) Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> Set Coin -> Coin
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Map (Credential 'Staking (Crypto era)) Coin -> Set Coin
forall (f :: * -> * -> *) v k. (Basic f, Ord v) => f k v -> Set v
range Map (Credential 'Staking (Crypto era)) Coin
unregRU),
          _reserves :: Coin
_reserves = Coin -> DeltaCoin -> Coin
addDeltaCoin (AccountState -> Coin
_reserves AccountState
as) (RewardUpdate (Crypto era) -> DeltaCoin
forall crypto. RewardUpdate crypto -> DeltaCoin
deltaR RewardUpdate (Crypto era)
ru)
        }
    ls' :: LedgerState era
ls' =
      LedgerState era
ls
        { _utxoState :: UTxOState era
_utxoState =
            UTxOState era
utxoState_ {_fees :: Coin
_fees = UTxOState era -> Coin
forall era. UTxOState era -> Coin
_fees UTxOState era
utxoState_ Coin -> DeltaCoin -> Coin
`addDeltaCoin` RewardUpdate (Crypto era) -> DeltaCoin
forall crypto. RewardUpdate crypto -> DeltaCoin
deltaF RewardUpdate (Crypto era)
ru},
          _delegationState :: DPState (Crypto era)
_delegationState =
            DPState (Crypto era)
delegState
              { _dstate :: DState (Crypto era)
_dstate =
                  DState (Crypto era)
dState
                    { _rewards :: Map (Credential 'Staking (Crypto era)) Coin
_rewards = Exp (Map (Credential 'Staking (Crypto era)) Coin)
-> Map (Credential 'Staking (Crypto era)) Coin
forall s t. Embed s t => Exp t -> s
eval (DState (Crypto era) -> Map (Credential 'Staking (Crypto era)) Coin
forall crypto. DState crypto -> RewardAccounts crypto
_rewards DState (Crypto era)
dState Map (Credential 'Staking (Crypto era)) Coin
-> Map (Credential 'Staking (Crypto era)) Coin
-> Exp (Map (Credential 'Staking (Crypto era)) Coin)
forall k n s1 (f :: * -> * -> *) s2.
(Ord k, Monoid n, HasExp s1 (f k n), HasExp s2 (f k n)) =>
s1 -> s2 -> Exp (f k n)
∪+ Map (Credential 'Staking (Crypto era)) Coin
regRU)
                    }
              }
        }
    nm' :: NonMyopic (Crypto era)
nm' = RewardUpdate (Crypto era) -> NonMyopic (Crypto era)
forall crypto. RewardUpdate crypto -> NonMyopic crypto
nonMyopic RewardUpdate (Crypto era)
ru

decayFactor :: Float
decayFactor :: Float
decayFactor = Float
0.9

updateNonMypopic ::
  NonMyopic crypto ->
  Coin ->
  Map (KeyHash 'StakePool crypto) Likelihood ->
  NonMyopic crypto
updateNonMypopic :: NonMyopic crypto
-> Coin
-> Map (KeyHash 'StakePool crypto) Likelihood
-> NonMyopic crypto
updateNonMypopic NonMyopic crypto
nm Coin
rPot Map (KeyHash 'StakePool crypto) Likelihood
newLikelihoods =
  NonMyopic crypto
nm
    { likelihoodsNM :: Map (KeyHash 'StakePool crypto) Likelihood
likelihoodsNM = Map (KeyHash 'StakePool crypto) Likelihood
updatedLikelihoods,
      rewardPotNM :: Coin
rewardPotNM = Coin
rPot
    }
  where
    history :: Map (KeyHash 'StakePool crypto) Likelihood
history = NonMyopic crypto -> Map (KeyHash 'StakePool crypto) Likelihood
forall crypto.
NonMyopic crypto -> Map (KeyHash 'StakePool crypto) Likelihood
likelihoodsNM NonMyopic crypto
nm
    performance :: KeyHash 'StakePool crypto -> Likelihood -> Likelihood
performance KeyHash 'StakePool crypto
kh Likelihood
newPerf =
      Likelihood -> Maybe Likelihood -> Likelihood
forall a. a -> Maybe a -> a
fromMaybe
        Likelihood
forall a. Monoid a => a
mempty
        (Float -> Likelihood -> Likelihood
applyDecay Float
decayFactor (Likelihood -> Likelihood) -> Maybe Likelihood -> Maybe Likelihood
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyHash 'StakePool crypto
-> Map (KeyHash 'StakePool crypto) Likelihood -> Maybe Likelihood
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash 'StakePool crypto
kh Map (KeyHash 'StakePool crypto) Likelihood
history)
        Likelihood -> Likelihood -> Likelihood
forall a. Semigroup a => a -> a -> a
<> Likelihood
newPerf
    updatedLikelihoods :: Map (KeyHash 'StakePool crypto) Likelihood
updatedLikelihoods = (KeyHash 'StakePool crypto -> Likelihood -> Likelihood)
-> Map (KeyHash 'StakePool crypto) Likelihood
-> Map (KeyHash 'StakePool crypto) Likelihood
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey KeyHash 'StakePool crypto -> Likelihood -> Likelihood
performance Map (KeyHash 'StakePool crypto) Likelihood
newLikelihoods

-- | Create a reward update
createRUpd ::
  EpochSize ->
  BlocksMade (Crypto era) ->
  EpochState era ->
  Coin ->
  ShelleyBase (RewardUpdate (Crypto era))
createRUpd :: EpochSize
-> BlocksMade (Crypto era)
-> EpochState era
-> Coin
-> ShelleyBase (RewardUpdate (Crypto era))
createRUpd EpochSize
slotsPerEpoch b :: BlocksMade (Crypto era)
b@(BlocksMade Map (KeyHash 'StakePool (Crypto era)) Natural
b') es :: EpochState era
es@(EpochState AccountState
acnt SnapShots (Crypto era)
ss LedgerState era
ls PParams era
pr PParams era
_ NonMyopic (Crypto era)
nm) Coin
maxSupply = do
  ActiveSlotCoeff
asc <- (Globals -> ActiveSlotCoeff)
-> ReaderT Globals Identity ActiveSlotCoeff
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Globals -> ActiveSlotCoeff
activeSlotCoeff
  let SnapShot Stake (Crypto era)
stake' Map
  (Credential 'Staking (Crypto era))
  (KeyHash 'StakePool (Crypto era))
delegs' Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
poolParams = SnapShots (Crypto era) -> SnapShot (Crypto era)
forall crypto. SnapShots crypto -> SnapShot crypto
_pstakeGo SnapShots (Crypto era)
ss
      Coin Integer
reserves = AccountState -> Coin
_reserves AccountState
acnt
      ds :: DState (Crypto era)
ds = DPState (Crypto era) -> DState (Crypto era)
forall crypto. DPState crypto -> DState crypto
_dstate (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)
_delegationState LedgerState era
ls
      -- reserves and rewards change
      deltaR1 :: Coin
deltaR1 =
        ( Rational -> Coin
rationalToCoinViaFloor (Rational -> Coin) -> Rational -> Coin
forall a b. (a -> b) -> a -> b
$
            Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
min Rational
1 Rational
eta
              Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* UnitInterval -> Rational
unitIntervalToRational (PParams era -> HKD Identity UnitInterval
forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
_rho PParams era
pr)
              Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Integer -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
reserves
        )
      d :: Rational
d = UnitInterval -> Rational
unitIntervalToRational (PParams era -> HKD Identity UnitInterval
forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
_d PParams era
pr)
      expectedBlocks :: Integer
expectedBlocks =
        Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational -> Integer) -> Rational -> Integer
forall a b. (a -> b) -> a -> b
$
          (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
d) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* UnitInterval -> Rational
unitIntervalToRational (ActiveSlotCoeff -> UnitInterval
activeSlotVal ActiveSlotCoeff
asc) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* EpochSize -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral EpochSize
slotsPerEpoch
      -- TODO asc is a global constant, and slotsPerEpoch should not change often at all,
      -- it would be nice to not have to compute expectedBlocks every epoch
      eta :: Rational
eta
        | UnitInterval -> Ratio Word64
intervalValue (PParams era -> HKD Identity UnitInterval
forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
_d PParams era
pr) Ratio Word64 -> Ratio Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ratio Word64
0.8 = Rational
1
        | Bool
otherwise = Integer
blocksMade Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
expectedBlocks
      Coin Integer
rPot = SnapShots (Crypto era) -> Coin
forall crypto. SnapShots crypto -> Coin
_feeSS SnapShots (Crypto era)
ss Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> Coin
deltaR1
      deltaT1 :: Integer
deltaT1 = Ratio Word64 -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (Ratio Word64 -> Integer) -> Ratio Word64 -> Integer
forall a b. (a -> b) -> a -> b
$ UnitInterval -> Ratio Word64
intervalValue (PParams era -> HKD Identity UnitInterval
forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
_tau PParams era
pr) Ratio Word64 -> Ratio Word64 -> Ratio Word64
forall a. Num a => a -> a -> a
* Integer -> Ratio Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
rPot
      _R :: Coin
_R = Integer -> Coin
Coin (Integer -> Coin) -> Integer -> Coin
forall a b. (a -> b) -> a -> b
$ Integer
rPot Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
deltaT1
      totalStake :: Coin
totalStake = EpochState era -> Coin -> Coin
forall era. EpochState era -> Coin -> Coin
circulation EpochState era
es Coin
maxSupply
      (Map (Credential 'Staking (Crypto era)) Coin
rs_, Map (KeyHash 'StakePool (Crypto era)) Likelihood
newLikelihoods) =
        PParams era
-> BlocksMade (Crypto era)
-> Coin
-> Set (Credential 'Staking (Crypto era))
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
-> Stake (Crypto era)
-> Map
     (Credential 'Staking (Crypto era))
     (KeyHash 'StakePool (Crypto era))
-> Coin
-> ActiveSlotCoeff
-> EpochSize
-> (Map (Credential 'Staking (Crypto era)) Coin,
    Map (KeyHash 'StakePool (Crypto era)) Likelihood)
forall era.
PParams era
-> BlocksMade (Crypto era)
-> Coin
-> Set (Credential 'Staking (Crypto era))
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
-> Stake (Crypto era)
-> Map
     (Credential 'Staking (Crypto era))
     (KeyHash 'StakePool (Crypto era))
-> Coin
-> ActiveSlotCoeff
-> EpochSize
-> (Map (Credential 'Staking (Crypto era)) Coin,
    Map (KeyHash 'StakePool (Crypto era)) Likelihood)
reward
          PParams era
pr
          BlocksMade (Crypto era)
b
          Coin
_R
          (Map (Credential 'Staking (Crypto era)) Coin
-> Set (Credential 'Staking (Crypto era))
forall k a. Map k a -> Set k
Map.keysSet (Map (Credential 'Staking (Crypto era)) Coin
 -> Set (Credential 'Staking (Crypto era)))
-> Map (Credential 'Staking (Crypto era)) Coin
-> Set (Credential 'Staking (Crypto era))
forall a b. (a -> b) -> a -> b
$ DState (Crypto era) -> Map (Credential 'Staking (Crypto era)) Coin
forall crypto. DState crypto -> RewardAccounts crypto
_rewards DState (Crypto era)
ds)
          Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
poolParams
          Stake (Crypto era)
stake'
          Map
  (Credential 'Staking (Crypto era))
  (KeyHash 'StakePool (Crypto era))
delegs'
          Coin
totalStake
          ActiveSlotCoeff
asc
          EpochSize
slotsPerEpoch
      deltaR2 :: Coin
deltaR2 = Coin
_R Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> ((Coin -> Coin -> Coin)
-> Coin -> Map (Credential 'Staking (Crypto era)) Coin -> Coin
forall a b k. (a -> b -> b) -> b -> Map k a -> b
Map.foldr Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
(<+>) Coin
forall a. Monoid a => a
mempty Map (Credential 'Staking (Crypto era)) Coin
rs_)
      blocksMade :: Integer
blocksMade = Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Integer) -> Natural -> Integer
forall a b. (a -> b) -> a -> b
$ (Natural -> Natural -> Natural)
-> Natural
-> Map (KeyHash 'StakePool (Crypto era)) Natural
-> Natural
forall a b k. (a -> b -> b) -> b -> Map k a -> b
Map.foldr Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
(+) Natural
0 Map (KeyHash 'StakePool (Crypto era)) Natural
b' :: Integer
  RewardUpdate (Crypto era)
-> ShelleyBase (RewardUpdate (Crypto era))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RewardUpdate (Crypto era)
 -> ShelleyBase (RewardUpdate (Crypto era)))
-> RewardUpdate (Crypto era)
-> ShelleyBase (RewardUpdate (Crypto era))
forall a b. (a -> b) -> a -> b
$
    RewardUpdate :: forall crypto.
DeltaCoin
-> DeltaCoin
-> Map (Credential 'Staking crypto) Coin
-> DeltaCoin
-> NonMyopic crypto
-> RewardUpdate crypto
RewardUpdate
      { deltaT :: DeltaCoin
deltaT = (Integer -> DeltaCoin
DeltaCoin Integer
deltaT1),
        deltaR :: DeltaCoin
deltaR = ((DeltaCoin -> DeltaCoin
forall m. Group m => m -> m
invert (DeltaCoin -> DeltaCoin) -> DeltaCoin -> DeltaCoin
forall a b. (a -> b) -> a -> b
$ Coin -> DeltaCoin
toDeltaCoin Coin
deltaR1) DeltaCoin -> DeltaCoin -> DeltaCoin
forall a. Semigroup a => a -> a -> a
<> Coin -> DeltaCoin
toDeltaCoin Coin
deltaR2),
        rs :: Map (Credential 'Staking (Crypto era)) Coin
rs = Map (Credential 'Staking (Crypto era)) Coin
rs_,
        deltaF :: DeltaCoin
deltaF = (DeltaCoin -> DeltaCoin
forall m. Group m => m -> m
invert (Coin -> DeltaCoin
toDeltaCoin (Coin -> DeltaCoin) -> Coin -> DeltaCoin
forall a b. (a -> b) -> a -> b
$ SnapShots (Crypto era) -> Coin
forall crypto. SnapShots crypto -> Coin
_feeSS SnapShots (Crypto era)
ss)),
        nonMyopic :: NonMyopic (Crypto era)
nonMyopic = (NonMyopic (Crypto era)
-> Coin
-> Map (KeyHash 'StakePool (Crypto era)) Likelihood
-> NonMyopic (Crypto era)
forall crypto.
NonMyopic crypto
-> Coin
-> Map (KeyHash 'StakePool crypto) Likelihood
-> NonMyopic crypto
updateNonMypopic NonMyopic (Crypto era)
nm Coin
_R Map (KeyHash 'StakePool (Crypto era)) Likelihood
newLikelihoods)
      }

-- | Calculate the current circulation
--
-- This is used in the rewards calculation, and for API endpoints for pool ranking.
circulation :: EpochState era -> Coin -> Coin
circulation :: EpochState era -> Coin -> Coin
circulation (EpochState AccountState
acnt SnapShots (Crypto era)
_ LedgerState era
_ PParams era
_ PParams era
_ NonMyopic (Crypto era)
_) Coin
supply =
  Coin
supply Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> (AccountState -> Coin
_reserves AccountState
acnt)

-- | Update new epoch state
updateNES ::
  NewEpochState era ->
  BlocksMade (Crypto era) ->
  LedgerState era ->
  NewEpochState era
updateNES :: NewEpochState era
-> BlocksMade (Crypto era) -> LedgerState era -> NewEpochState era
updateNES
  ( NewEpochState
      EpochNo
eL
      BlocksMade (Crypto era)
bprev
      BlocksMade (Crypto era)
_
      (EpochState AccountState
acnt SnapShots (Crypto era)
ss LedgerState era
_ PParams era
pr PParams era
pp NonMyopic (Crypto era)
nm)
      StrictMaybe (RewardUpdate (Crypto era))
ru
      PoolDistr (Crypto era)
pd
    )
  BlocksMade (Crypto era)
bcur
  LedgerState era
ls =
    EpochNo
-> BlocksMade (Crypto era)
-> BlocksMade (Crypto era)
-> EpochState era
-> StrictMaybe (RewardUpdate (Crypto era))
-> PoolDistr (Crypto era)
-> NewEpochState era
forall era.
EpochNo
-> BlocksMade (Crypto era)
-> BlocksMade (Crypto era)
-> EpochState era
-> StrictMaybe (RewardUpdate (Crypto era))
-> PoolDistr (Crypto era)
-> NewEpochState era
NewEpochState EpochNo
eL BlocksMade (Crypto era)
bprev BlocksMade (Crypto era)
bcur (AccountState
-> SnapShots (Crypto era)
-> LedgerState era
-> PParams era
-> PParams era
-> NonMyopic (Crypto era)
-> EpochState era
forall era.
AccountState
-> SnapShots (Crypto era)
-> LedgerState era
-> PParams era
-> PParams era
-> NonMyopic (Crypto era)
-> EpochState era
EpochState AccountState
acnt SnapShots (Crypto era)
ss LedgerState era
ls PParams era
pr PParams era
pp NonMyopic (Crypto era)
nm) StrictMaybe (RewardUpdate (Crypto era))
ru PoolDistr (Crypto era)
pd

returnRedeemAddrsToReserves ::
  ShelleyBased era =>
  EpochState era ->
  EpochState era
returnRedeemAddrsToReserves :: EpochState era -> EpochState era
returnRedeemAddrsToReserves EpochState era
es = EpochState era
es {esAccountState :: AccountState
esAccountState = AccountState
acnt', esLState :: LedgerState era
esLState = LedgerState era
ls'}
  where
    ls :: LedgerState era
ls = EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState EpochState era
es
    us :: UTxOState era
us = LedgerState era -> UTxOState era
forall era. LedgerState era -> UTxOState era
_utxoState LedgerState era
ls
    UTxO Map (TxIn (Crypto era)) (TxOut era)
utxo = UTxOState era -> UTxO era
forall era. UTxOState era -> UTxO era
_utxo UTxOState era
us
    (Map (TxIn (Crypto era)) (TxOut era)
redeemers, Map (TxIn (Crypto era)) (TxOut era)
nonredeemers) = (TxOut era -> Bool)
-> Map (TxIn (Crypto era)) (TxOut era)
-> (Map (TxIn (Crypto era)) (TxOut era),
    Map (TxIn (Crypto era)) (TxOut era))
forall a k. (a -> Bool) -> Map k a -> (Map k a, Map k a)
Map.partition (\(TxOut Addr (Crypto era)
a Value era
_) -> Addr (Crypto era) -> Bool
forall crypto. Addr crypto -> Bool
isBootstrapRedeemer Addr (Crypto era)
a) Map (TxIn (Crypto era)) (TxOut era)
utxo
    acnt :: AccountState
acnt = EpochState era -> AccountState
forall era. EpochState era -> AccountState
esAccountState EpochState era
es
    acnt' :: AccountState
acnt' = AccountState
acnt {_reserves :: Coin
_reserves = (AccountState -> Coin
_reserves AccountState
acnt) Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> (Value era -> Coin
forall t. Val t => t -> Coin
Val.coin (Value era -> Coin) -> (UTxO era -> Value era) -> UTxO era -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO era -> Value era
forall era. ShelleyBased era => UTxO era -> Value era
balance (UTxO era -> Coin) -> UTxO era -> Coin
forall a b. (a -> b) -> a -> b
$ 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)
redeemers)}
    us' :: UTxOState era
us' = UTxOState era
us {_utxo :: UTxO era
_utxo = 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)
nonredeemers}
    ls' :: LedgerState era
ls' = LedgerState era
ls {_utxoState :: UTxOState era
_utxoState = UTxOState era
us'}