{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

-- | The data types in this file constitute a Model of the NewEpochState
--   sufficient for generating transactions that can run in the
--   MockChain STS instance. This is a model so we drop some details of the
--   real NewEpochState, and add some additional details specific to Tx generation.
--   Dropped details include
--   1) Efficiency concerns
--      a) Pulsing Reward updates
--      b) Inverse of the Rewards Map
--      c) esNonMyopic field
--      d) _stakeDistro, Incremental Stake distribution
--   2) Transaction features that make changes to the Protocol Parameters
--   3) Using Hashes of the TxBody as the Ix, instead we maintain an index of
--      an arbitrary Hash to the sequence (Count) in which the TxBody was generated.
--   Additional details
--   1) Utxo entries to pay fees. It is incredibly hard to generate Txs with the
--      correct fees. So we keep a small set of UtxoEntrys, where it is allowed to
--      mutate the value field of the TxOut. We have to be sure these entries are carefully
--      managed, as they do not follow the rules of the real world.
--   Additional comments
--   1) We include data in the Model for Epoch boundary computations, but we do not
--      do anything with them at this time.
module Test.Cardano.Ledger.Generic.ModelState where

import Cardano.Ledger.BaseTypes (BlocksMade (..))
import Cardano.Ledger.Coin (Coin (..), CompactForm (CompactCoin))
import Cardano.Ledger.Conway.State (ConwayEraCertState (..), VState (..))
import Cardano.Ledger.Credential (Credential (..))
import Cardano.Ledger.Hashes (GenDelegs (..))
import Cardano.Ledger.PoolParams (PoolParams (..))
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.LedgerState (
  ChainAccountState (..),
  DState (..),
  EpochState (..),
  InstantaneousRewards (..),
  LedgerState (..),
  NewEpochState (..),
  PState (..),
  StashedAVVMAddresses,
  UTxOState (..),
  completeRupd,
  curPParamsEpochStateL,
  prevPParamsEpochStateL,
  smartUTxOState,
 )
import Cardano.Ledger.Shelley.PoolRank (NonMyopic (..))
import Cardano.Ledger.Shelley.RewardUpdate (PulsingRewUpdate (..), RewardUpdate (..))
import Cardano.Ledger.Slot (EpochNo (..))
import Cardano.Ledger.State (
  ChainAccountState (..),
  EraCertState (..),
  IndividualPoolStake (..),
  PoolDistr (..),
  SnapShots,
  UTxO (..),
  emptySnapShots,
 )
import Cardano.Ledger.TxIn (TxId (..), TxIn (..))
import qualified Cardano.Ledger.UMap as UM
import Control.Monad.Trans ()
import Data.Default (Default (def))
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import qualified Data.Maybe as Maybe
import Data.Maybe.Strict (StrictMaybe (..))
import Data.Text (Text)
import GHC.Natural (Natural)
import Lens.Micro ((&), (.~), (^.))
import Lens.Micro.Extras (view)
import Test.Cardano.Ledger.Generic.PrettyCore (
  PDoc,
  PrettyA (..),
  credSummary,
  keyHashSummary,
  pcChainAccountState,
  pcCoin,
  pcCredential,
  pcIndividualPoolStake,
  pcKeyHash,
  pcPoolParams,
  pcTxId,
  pcTxIn,
  pcTxOut,
  ppEpochNo,
  ppInt,
  ppMap,
  ppNatural,
  ppRecord,
  ppString,
 )
import Test.Cardano.Ledger.Generic.Proof (
  BabbageEra,
  CertStateWit (..),
  Proof (..),
  Reflect (..),
  whichCertState,
 )
import Test.Cardano.Ledger.Shelley.Utils (runShelleyBase)

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

-- | MUtxo = Model UTxO. In the Model we represent the
--   UTxO as a Map (not a newtype around a Map)
type MUtxo era = Map TxIn (TxOut era)

pcMUtxo :: Reflect era => Proof era -> MUtxo era -> PDoc
pcMUtxo :: forall era. Reflect era => Proof era -> MUtxo era -> PDoc
pcMUtxo Proof era
proof = (TxIn -> PDoc)
-> (TxOut era -> PDoc) -> Map TxIn (TxOut era) -> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap TxIn -> PDoc
pcTxIn (Proof era -> TxOut era -> PDoc
forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut Proof era
proof)

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

data ModelNewEpochState era = ModelNewEpochState
  { -- PState fields
    forall era.
ModelNewEpochState era -> Map (KeyHash 'StakePool) PoolParams
mPoolParams :: !(Map (KeyHash 'StakePool) PoolParams)
  , forall era. ModelNewEpochState era -> Map (KeyHash 'StakePool) Coin
mPoolDeposits :: !(Map (KeyHash 'StakePool) Coin)
  , -- DState state fields
    forall era.
ModelNewEpochState era -> Map (Credential 'Staking) Coin
mRewards :: !(Map (Credential 'Staking) Coin)
  , forall era.
ModelNewEpochState era
-> Map (Credential 'Staking) (KeyHash 'StakePool)
mDelegations :: !(Map (Credential 'Staking) (KeyHash 'StakePool))
  , forall era.
ModelNewEpochState era -> Map (Credential 'Staking) Coin
mKeyDeposits :: !(Map (Credential 'Staking) Coin)
  , --  _fGenDelegs,  _genDelegs, and _irwd, are for
    --  changing the PParams and are abstracted away

    -- UTxO state fields (and extra stuff)
    forall era. ModelNewEpochState era -> Map TxIn (TxOut era)
mUTxO :: !(Map TxIn (TxOut era))
  , forall era. ModelNewEpochState era -> Map TxIn (TxOut era)
mMutFee :: !(Map TxIn (TxOut era))
  -- ^ The current UTxO
  , -- _ppups is for changing PParams, and _stakeDistro is for efficiency
    -- and are abstracted away.

    -- EpochState fields
    forall era. ModelNewEpochState era -> ChainAccountState
mChainAccountState :: !ChainAccountState
  , -- esPrevPp and esPp are for changing PParams
    -- esNonMyopic is for efficiency, and all are abstracted away

    -- Model NewEpochState fields
    forall era.
ModelNewEpochState era
-> Map (KeyHash 'StakePool) IndividualPoolStake
mPoolDistr :: !(Map (KeyHash 'StakePool) IndividualPoolStake)
  , forall era. ModelNewEpochState era -> PParams era
mPParams :: !(PParams era)
  , forall era. ModelNewEpochState era -> Coin
mDeposited :: !Coin
  , forall era. ModelNewEpochState era -> Coin
mFees :: !Coin
  , forall era. ModelNewEpochState era -> Int
mCount :: !Int
  , forall era. ModelNewEpochState era -> Map Int TxId
mIndex :: !(Map Int TxId)
  , -- below here NO EFFECT until we model EpochBoundary
    forall era.
ModelNewEpochState era -> Map (KeyHash 'StakePool) PoolParams
mFPoolParams :: !(Map (KeyHash 'StakePool) PoolParams)
  , forall era.
ModelNewEpochState era -> Map (KeyHash 'StakePool) EpochNo
mRetiring :: !(Map (KeyHash 'StakePool) EpochNo)
  , forall era. ModelNewEpochState era -> SnapShots
mSnapshots :: !SnapShots
  , forall era. ModelNewEpochState era -> EpochNo
mEL :: !EpochNo -- The current epoch,
  , forall era.
ModelNewEpochState era -> Map (KeyHash 'StakePool) Natural
mBprev :: !(Map (KeyHash 'StakePool) Natural) --  Blocks made before current epoch, NO EFFECT until we model EpochBoundar
  , forall era.
ModelNewEpochState era -> Map (KeyHash 'StakePool) Natural
mBcur :: !(Map (KeyHash 'StakePool) Natural)
  , forall era. ModelNewEpochState era -> StrictMaybe RewardUpdate
mRu :: !(StrictMaybe RewardUpdate) -- Possible reward update
  }

type UtxoEntry era = (TxIn, TxOut era)

type Model era = ModelNewEpochState era

-- ======================================================================
-- Empty or default values, these are usefull for many things, not the
-- least of, for making Model instances.

blocksMadeZero :: BlocksMade
blocksMadeZero :: BlocksMade
blocksMadeZero = Map (KeyHash 'StakePool) Natural -> BlocksMade
BlocksMade Map (KeyHash 'StakePool) Natural
forall k a. Map k a
Map.empty

poolDistrZero :: PoolDistr
poolDistrZero :: PoolDistr
poolDistrZero = Map (KeyHash 'StakePool) IndividualPoolStake
-> CompactForm Coin -> PoolDistr
PoolDistr Map (KeyHash 'StakePool) IndividualPoolStake
forall k a. Map k a
Map.empty (CompactForm Coin -> PoolDistr) -> CompactForm Coin -> PoolDistr
forall a b. (a -> b) -> a -> b
$ Word64 -> CompactForm Coin
CompactCoin Word64
1

accountStateZero :: ChainAccountState
accountStateZero :: ChainAccountState
accountStateZero = Coin -> Coin -> ChainAccountState
ChainAccountState (Integer -> Coin
Coin Integer
0) (Integer -> Coin
Coin Integer
0)

utxoZero :: UTxO era
utxoZero :: forall era. UTxO era
utxoZero = Map TxIn (TxOut era) -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO Map TxIn (TxOut era)
forall k a. Map k a
Map.empty

genDelegsZero :: GenDelegs
genDelegsZero :: GenDelegs
genDelegsZero = Map (KeyHash 'Genesis) GenDelegPair -> GenDelegs
GenDelegs Map (KeyHash 'Genesis) GenDelegPair
forall k a. Map k a
Map.empty

instantaneousRewardsZero :: InstantaneousRewards
instantaneousRewardsZero :: InstantaneousRewards
instantaneousRewardsZero = Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards
InstantaneousRewards Map (Credential 'Staking) Coin
forall k a. Map k a
Map.empty Map (Credential 'Staking) Coin
forall k a. Map k a
Map.empty DeltaCoin
forall a. Monoid a => a
mempty DeltaCoin
forall a. Monoid a => a
mempty

dStateZero :: DState c
dStateZero :: forall c. DState c
dStateZero =
  DState
    { dsUnified :: UMap
dsUnified = UMap
UM.empty
    , dsFutureGenDelegs :: Map FutureGenDeleg GenDelegPair
dsFutureGenDelegs = Map FutureGenDeleg GenDelegPair
forall k a. Map k a
Map.empty
    , dsGenDelegs :: GenDelegs
dsGenDelegs = GenDelegs
genDelegsZero
    , dsIRewards :: InstantaneousRewards
dsIRewards = InstantaneousRewards
instantaneousRewardsZero
    }

pStateZero :: PState c
pStateZero :: forall c. PState c
pStateZero =
  PState
    { psStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
psStakePoolParams = Map (KeyHash 'StakePool) PoolParams
forall k a. Map k a
Map.empty
    , psFutureStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
psFutureStakePoolParams = Map (KeyHash 'StakePool) PoolParams
forall k a. Map k a
Map.empty
    , psRetiring :: Map (KeyHash 'StakePool) EpochNo
psRetiring = Map (KeyHash 'StakePool) EpochNo
forall k a. Map k a
Map.empty
    , psDeposits :: Map (KeyHash 'StakePool) Coin
psDeposits = Map (KeyHash 'StakePool) Coin
forall k a. Map k a
Map.empty
    }

dPStateZero :: EraCertState era => CertState era
dPStateZero :: forall era. EraCertState era => CertState era
dPStateZero =
  CertState era
forall a. Default a => a
def
    CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (PState era -> Identity (PState era))
-> CertState era -> Identity (CertState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
certPStateL ((PState era -> Identity (PState era))
 -> CertState era -> Identity (CertState era))
-> PState era -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PState era
forall c. PState c
pStateZero
    CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (DState era -> Identity (DState era))
-> CertState era -> Identity (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL ((DState era -> Identity (DState era))
 -> CertState era -> Identity (CertState era))
-> DState era -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DState era
forall c. DState c
dStateZero

nonMyopicZero :: NonMyopic
nonMyopicZero :: NonMyopic
nonMyopicZero = Map (KeyHash 'StakePool) Likelihood -> Coin -> NonMyopic
NonMyopic Map (KeyHash 'StakePool) Likelihood
forall k a. Map k a
Map.empty Coin
forall a. Monoid a => a
mempty

pParamsZeroByProof :: Proof era -> PParams era
pParamsZeroByProof :: forall era. Proof era -> PParams era
pParamsZeroByProof Proof era
Conway = PParams era
forall a. Default a => a
def
pParamsZeroByProof Proof era
Babbage = PParams era
forall a. Default a => a
def
pParamsZeroByProof Proof era
Alonzo = PParams era
forall a. Default a => a
def
pParamsZeroByProof Proof era
Mary = PParams era
forall a. Default a => a
def
pParamsZeroByProof Proof era
Allegra = PParams era
forall a. Default a => a
def
pParamsZeroByProof Proof era
Shelley = PParams era
forall a. Default a => a
def

uTxOStateZero :: forall era. Reflect era => UTxOState era
uTxOStateZero :: forall era. Reflect era => UTxOState era
uTxOStateZero =
  PParams era
-> UTxO era
-> Coin
-> Coin
-> GovState era
-> Coin
-> UTxOState era
forall era.
EraStake era =>
PParams era
-> UTxO era
-> Coin
-> Coin
-> GovState era
-> Coin
-> UTxOState era
smartUTxOState
    PParams era
forall era. Reflect era => PParams era
pParamsZero
    UTxO era
forall era. UTxO era
utxoZero
    Coin
forall a. Monoid a => a
mempty
    Coin
forall a. Monoid a => a
mempty
    GovState era
forall era. EraGov era => GovState era
emptyGovState
    Coin
forall a. Monoid a => a
mempty

pParamsZero :: Reflect era => PParams era
pParamsZero :: forall era. Reflect era => PParams era
pParamsZero = (Proof era -> PParams era) -> PParams era
forall era a. Reflect era => (Proof era -> a) -> a
forall a. (Proof era -> a) -> a
lift Proof era -> PParams era
forall era. Proof era -> PParams era
pParamsZeroByProof

ledgerStateZero :: forall era. Reflect era => LedgerState era
ledgerStateZero :: forall era. Reflect era => LedgerState era
ledgerStateZero = UTxOState era -> CertState era -> LedgerState era
forall era. UTxOState era -> CertState era -> LedgerState era
LedgerState UTxOState era
forall era. Reflect era => UTxOState era
uTxOStateZero CertState era
forall era. EraCertState era => CertState era
dPStateZero

epochStateZero :: Reflect era => EpochState era
epochStateZero :: forall era. Reflect era => EpochState era
epochStateZero =
  ChainAccountState
-> LedgerState era -> SnapShots -> NonMyopic -> EpochState era
forall era.
ChainAccountState
-> LedgerState era -> SnapShots -> NonMyopic -> EpochState era
EpochState
    ChainAccountState
accountStateZero
    LedgerState era
forall era. Reflect era => LedgerState era
ledgerStateZero
    SnapShots
emptySnapShots
    NonMyopic
nonMyopicZero
    EpochState era
-> (EpochState era -> EpochState era) -> EpochState era
forall a b. a -> (a -> b) -> b
& (PParams era -> Identity (PParams era))
-> EpochState era -> Identity (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Identity (PParams era))
 -> EpochState era -> Identity (EpochState era))
-> PParams era -> EpochState era -> EpochState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams era
forall era. Reflect era => PParams era
pParamsZero
    EpochState era
-> (EpochState era -> EpochState era) -> EpochState era
forall a b. a -> (a -> b) -> b
& (PParams era -> Identity (PParams era))
-> EpochState era -> Identity (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
prevPParamsEpochStateL ((PParams era -> Identity (PParams era))
 -> EpochState era -> Identity (EpochState era))
-> PParams era -> EpochState era -> EpochState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams era
forall era. Reflect era => PParams era
pParamsZero

newEpochStateZero :: forall era. Reflect era => NewEpochState era
newEpochStateZero :: forall era. Reflect era => NewEpochState era
newEpochStateZero =
  EpochNo
-> BlocksMade
-> BlocksMade
-> EpochState era
-> StrictMaybe PulsingRewUpdate
-> PoolDistr
-> StashedAVVMAddresses era
-> NewEpochState era
forall era.
EpochNo
-> BlocksMade
-> BlocksMade
-> EpochState era
-> StrictMaybe PulsingRewUpdate
-> PoolDistr
-> StashedAVVMAddresses era
-> NewEpochState era
NewEpochState
    (Word64 -> EpochNo
EpochNo Word64
0)
    BlocksMade
blocksMadeZero
    BlocksMade
blocksMadeZero
    EpochState era
forall era. Reflect era => EpochState era
epochStateZero
    StrictMaybe PulsingRewUpdate
forall a. StrictMaybe a
SNothing
    PoolDistr
poolDistrZero
    (Proof era -> StashedAVVMAddresses era
forall era. Proof era -> StashedAVVMAddresses era
stashedAVVMAddressesZero (Proof era
forall era. Reflect era => Proof era
reify :: Proof era))

stashedAVVMAddressesZero :: Proof era -> StashedAVVMAddresses era
stashedAVVMAddressesZero :: forall era. Proof era -> StashedAVVMAddresses era
stashedAVVMAddressesZero Proof era
Shelley = UTxO ShelleyEra
StashedAVVMAddresses era
forall era. UTxO era
utxoZero
stashedAVVMAddressesZero Proof era
Conway = ()
stashedAVVMAddressesZero Proof era
Babbage = ()
stashedAVVMAddressesZero Proof era
Alonzo = ()
stashedAVVMAddressesZero Proof era
Mary = ()
stashedAVVMAddressesZero Proof era
Allegra = ()

mNewEpochStateZero :: Reflect era => ModelNewEpochState era
mNewEpochStateZero :: forall era. Reflect era => ModelNewEpochState era
mNewEpochStateZero =
  ModelNewEpochState
    { mPoolParams :: Map (KeyHash 'StakePool) PoolParams
mPoolParams = Map (KeyHash 'StakePool) PoolParams
forall k a. Map k a
Map.empty
    , mPoolDeposits :: Map (KeyHash 'StakePool) Coin
mPoolDeposits = Map (KeyHash 'StakePool) Coin
forall k a. Map k a
Map.empty
    , mRewards :: Map (Credential 'Staking) Coin
mRewards = Map (Credential 'Staking) Coin
forall k a. Map k a
Map.empty
    , mDelegations :: Map (Credential 'Staking) (KeyHash 'StakePool)
mDelegations = Map (Credential 'Staking) (KeyHash 'StakePool)
forall k a. Map k a
Map.empty
    , mKeyDeposits :: Map (Credential 'Staking) Coin
mKeyDeposits = Map (Credential 'Staking) Coin
forall k a. Map k a
Map.empty
    , mUTxO :: Map TxIn (TxOut era)
mUTxO = Map TxIn (TxOut era)
forall k a. Map k a
Map.empty
    , mMutFee :: Map TxIn (TxOut era)
mMutFee = Map TxIn (TxOut era)
forall k a. Map k a
Map.empty
    , mChainAccountState :: ChainAccountState
mChainAccountState = ChainAccountState
accountStateZero
    , mPoolDistr :: Map (KeyHash 'StakePool) IndividualPoolStake
mPoolDistr = Map (KeyHash 'StakePool) IndividualPoolStake
forall k a. Map k a
Map.empty
    , mPParams :: PParams era
mPParams = PParams era
forall era. Reflect era => PParams era
pParamsZero
    , mDeposited :: Coin
mDeposited = Integer -> Coin
Coin Integer
0
    , mFees :: Coin
mFees = Integer -> Coin
Coin Integer
0
    , mCount :: Int
mCount = Int
0
    , mIndex :: Map Int TxId
mIndex = Map Int TxId
forall k a. Map k a
Map.empty
    , -- below here NO EFFECT until we model EpochBoundary
      mFPoolParams :: Map (KeyHash 'StakePool) PoolParams
mFPoolParams = Map (KeyHash 'StakePool) PoolParams
forall k a. Map k a
Map.empty
    , mRetiring :: Map (KeyHash 'StakePool) EpochNo
mRetiring = Map (KeyHash 'StakePool) EpochNo
forall k a. Map k a
Map.empty
    , mSnapshots :: SnapShots
mSnapshots = SnapShots
emptySnapShots
    , mEL :: EpochNo
mEL = Word64 -> EpochNo
EpochNo Word64
0
    , mBprev :: Map (KeyHash 'StakePool) Natural
mBprev = Map (KeyHash 'StakePool) Natural
forall k a. Map k a
Map.empty
    , mBcur :: Map (KeyHash 'StakePool) Natural
mBcur = Map (KeyHash 'StakePool) Natural
forall k a. Map k a
Map.empty
    , mRu :: StrictMaybe RewardUpdate
mRu = StrictMaybe RewardUpdate
forall a. StrictMaybe a
SNothing
    }

testNES :: NewEpochState BabbageEra
testNES :: NewEpochState BabbageEra
testNES = NewEpochState BabbageEra
forall era. Reflect era => NewEpochState era
newEpochStateZero

testMNES :: ModelNewEpochState BabbageEra
testMNES :: ModelNewEpochState BabbageEra
testMNES = ModelNewEpochState BabbageEra
forall era. Reflect era => ModelNewEpochState era
mNewEpochStateZero

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

class Extract t era where
  extract :: ModelNewEpochState era -> t

instance Extract (DState era) era where
  extract :: ModelNewEpochState era -> DState era
extract ModelNewEpochState era
x =
    UMap
-> Map FutureGenDeleg GenDelegPair
-> GenDelegs
-> InstantaneousRewards
-> DState era
forall era.
UMap
-> Map FutureGenDeleg GenDelegPair
-> GenDelegs
-> InstantaneousRewards
-> DState era
DState
      (Map (Credential 'Staking) RDPair
-> Map Ptr (Credential 'Staking)
-> Map (Credential 'Staking) (KeyHash 'StakePool)
-> Map (Credential 'Staking) DRep
-> UMap
UM.unify (ModelNewEpochState era -> Map (Credential 'Staking) RDPair
forall era.
ModelNewEpochState era -> Map (Credential 'Staking) RDPair
makeRewards ModelNewEpochState era
x) Map Ptr (Credential 'Staking)
forall k a. Map k a
Map.empty (ModelNewEpochState era
-> Map (Credential 'Staking) (KeyHash 'StakePool)
forall era.
ModelNewEpochState era
-> Map (Credential 'Staking) (KeyHash 'StakePool)
mDelegations ModelNewEpochState era
x) Map (Credential 'Staking) DRep
forall k a. Map k a
Map.empty)
      Map FutureGenDeleg GenDelegPair
forall k a. Map k a
Map.empty
      GenDelegs
genDelegsZero
      InstantaneousRewards
instantaneousRewardsZero

makeRewards :: ModelNewEpochState era -> Map.Map (Credential 'Staking) UM.RDPair
makeRewards :: forall era.
ModelNewEpochState era -> Map (Credential 'Staking) RDPair
makeRewards ModelNewEpochState era
mnes = (Credential 'Staking -> Coin -> RDPair)
-> Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) RDPair
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey Credential 'Staking -> Coin -> RDPair
f Map (Credential 'Staking) Coin
credRewMap
  where
    credRewMap :: Map (Credential 'Staking) Coin
credRewMap = ModelNewEpochState era -> Map (Credential 'Staking) Coin
forall era.
ModelNewEpochState era -> Map (Credential 'Staking) Coin
mRewards ModelNewEpochState era
mnes
    credDepMap :: Map (Credential 'Staking) Coin
credDepMap = ModelNewEpochState era -> Map (Credential 'Staking) Coin
forall era.
ModelNewEpochState era -> Map (Credential 'Staking) Coin
mKeyDeposits ModelNewEpochState era
mnes
    f :: Credential 'Staking -> Coin -> RDPair
f Credential 'Staking
cred Coin
rew = case Credential 'Staking -> Map (Credential 'Staking) Coin -> Maybe Coin
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'Staking
cred Map (Credential 'Staking) Coin
credDepMap of
      Just Coin
dep -> CompactForm Coin -> CompactForm Coin -> RDPair
UM.RDPair (HasCallStack => Coin -> CompactForm Coin
Coin -> CompactForm Coin
UM.compactCoinOrError Coin
rew) (HasCallStack => Coin -> CompactForm Coin
Coin -> CompactForm Coin
UM.compactCoinOrError Coin
dep)
      Maybe Coin
Nothing -> [Char] -> RDPair
forall a. HasCallStack => [Char] -> a
error ([Char]
"In makeRewards the reward and deposit maps are not in synch " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Credential 'Staking -> [Char]
forall a. Show a => a -> [Char]
show Credential 'Staking
cred)

instance Extract (PState era) era where
  extract :: ModelNewEpochState era -> PState era
extract ModelNewEpochState era
x = Map (KeyHash 'StakePool) PoolParams
-> Map (KeyHash 'StakePool) PoolParams
-> Map (KeyHash 'StakePool) EpochNo
-> Map (KeyHash 'StakePool) Coin
-> PState era
forall era.
Map (KeyHash 'StakePool) PoolParams
-> Map (KeyHash 'StakePool) PoolParams
-> Map (KeyHash 'StakePool) EpochNo
-> Map (KeyHash 'StakePool) Coin
-> PState era
PState (ModelNewEpochState era -> Map (KeyHash 'StakePool) PoolParams
forall era.
ModelNewEpochState era -> Map (KeyHash 'StakePool) PoolParams
mPoolParams ModelNewEpochState era
x) (ModelNewEpochState era -> Map (KeyHash 'StakePool) PoolParams
forall era.
ModelNewEpochState era -> Map (KeyHash 'StakePool) PoolParams
mFPoolParams ModelNewEpochState era
x) (ModelNewEpochState era -> Map (KeyHash 'StakePool) EpochNo
forall era.
ModelNewEpochState era -> Map (KeyHash 'StakePool) EpochNo
mRetiring ModelNewEpochState era
x) Map (KeyHash 'StakePool) Coin
forall k a. Map k a
Map.empty

instance Extract (VState era) era where
  extract :: ModelNewEpochState era -> VState era
extract ModelNewEpochState era
_ = Map (Credential 'DRepRole) DRepState
-> CommitteeState era -> EpochNo -> VState era
forall era.
Map (Credential 'DRepRole) DRepState
-> CommitteeState era -> EpochNo -> VState era
VState Map (Credential 'DRepRole) DRepState
forall a. Default a => a
def CommitteeState era
forall a. Default a => a
def (Word64 -> EpochNo
EpochNo Word64
0)

instance Reflect era => Extract (UTxOState era) era where
  extract :: ModelNewEpochState era -> UTxOState era
extract ModelNewEpochState era
x =
    PParams era
-> UTxO era
-> Coin
-> Coin
-> GovState era
-> Coin
-> UTxOState era
forall era.
EraStake era =>
PParams era
-> UTxO era
-> Coin
-> Coin
-> GovState era
-> Coin
-> UTxOState era
smartUTxOState
      (ModelNewEpochState era -> PParams era
forall era. ModelNewEpochState era -> PParams era
mPParams ModelNewEpochState era
x)
      (Map TxIn (TxOut era) -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO (ModelNewEpochState era -> Map TxIn (TxOut era)
forall era. ModelNewEpochState era -> Map TxIn (TxOut era)
mUTxO ModelNewEpochState era
x))
      (ModelNewEpochState era -> Coin
forall era. ModelNewEpochState era -> Coin
mDeposited ModelNewEpochState era
x)
      (ModelNewEpochState era -> Coin
forall era. ModelNewEpochState era -> Coin
mFees ModelNewEpochState era
x)
      GovState era
forall era. EraGov era => GovState era
emptyGovState
      Coin
forall a. Monoid a => a
mempty

extractCertState ::
  forall era. Reflect era => ModelNewEpochState era -> CertState era
extractCertState :: forall era. Reflect era => ModelNewEpochState era -> CertState era
extractCertState ModelNewEpochState era
x = case Proof era -> CertStateWit era
forall era. Proof era -> CertStateWit era
whichCertState (forall era. Reflect era => Proof era
reify @era) of
  CertStateWit era
CertStateShelleyToBabbage ->
    CertState era
forall a. Default a => a
def
      CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& ((PState era -> Identity (PState era))
-> CertState era -> Identity (CertState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
certPStateL ((PState era -> Identity (PState era))
 -> CertState era -> Identity (CertState era))
-> PState era -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ModelNewEpochState era -> PState era
forall t era. Extract t era => ModelNewEpochState era -> t
extract ModelNewEpochState era
x)
      CertState era
-> (CertState era -> ShelleyCertState era) -> ShelleyCertState era
forall a b. a -> (a -> b) -> b
& ((DState era -> Identity (DState era))
-> CertState era -> Identity (CertState era)
(DState era -> Identity (DState era))
-> CertState era -> Identity (ShelleyCertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL ((DState era -> Identity (DState era))
 -> CertState era -> Identity (ShelleyCertState era))
-> DState era -> CertState era -> ShelleyCertState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ModelNewEpochState era -> DState era
forall t era. Extract t era => ModelNewEpochState era -> t
extract ModelNewEpochState era
x)
  CertStateWit era
CertStateConwayToConway ->
    CertState era
forall a. Default a => a
def
      CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& ((PState era -> Identity (PState era))
-> CertState era -> Identity (CertState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
certPStateL ((PState era -> Identity (PState era))
 -> CertState era -> Identity (CertState era))
-> PState era -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ModelNewEpochState era -> PState era
forall t era. Extract t era => ModelNewEpochState era -> t
extract ModelNewEpochState era
x)
      CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& ((DState era -> Identity (DState era))
-> CertState era -> Identity (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL ((DState era -> Identity (DState era))
 -> CertState era -> Identity (CertState era))
-> DState era -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ModelNewEpochState era -> DState era
forall t era. Extract t era => ModelNewEpochState era -> t
extract ModelNewEpochState era
x)
      CertState era
-> (CertState era -> ConwayCertState era) -> ConwayCertState era
forall a b. a -> (a -> b) -> b
& ((VState era -> Identity (VState era))
-> CertState era -> Identity (CertState era)
(VState era -> Identity (VState era))
-> CertState era -> Identity (ConwayCertState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL ((VState era -> Identity (VState era))
 -> CertState era -> Identity (ConwayCertState era))
-> VState era -> CertState era -> ConwayCertState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ModelNewEpochState era -> VState era
forall t era. Extract t era => ModelNewEpochState era -> t
extract ModelNewEpochState era
x)

instance Reflect era => Extract (LedgerState era) era where
  extract :: ModelNewEpochState era -> LedgerState era
extract ModelNewEpochState era
x = UTxOState era -> CertState era -> LedgerState era
forall era. UTxOState era -> CertState era -> LedgerState era
LedgerState (ModelNewEpochState era -> UTxOState era
forall t era. Extract t era => ModelNewEpochState era -> t
extract ModelNewEpochState era
x) (ModelNewEpochState era -> CertState era
forall era. Reflect era => ModelNewEpochState era -> CertState era
extractCertState ModelNewEpochState era
x)

instance Reflect era => Extract (EpochState era) era where
  extract :: ModelNewEpochState era -> EpochState era
extract ModelNewEpochState era
x =
    ChainAccountState
-> LedgerState era -> SnapShots -> NonMyopic -> EpochState era
forall era.
ChainAccountState
-> LedgerState era -> SnapShots -> NonMyopic -> EpochState era
EpochState
      (ModelNewEpochState era -> ChainAccountState
forall era. ModelNewEpochState era -> ChainAccountState
mChainAccountState ModelNewEpochState era
x)
      (ModelNewEpochState era -> LedgerState era
forall t era. Extract t era => ModelNewEpochState era -> t
extract ModelNewEpochState era
x)
      (ModelNewEpochState era -> SnapShots
forall era. ModelNewEpochState era -> SnapShots
mSnapshots ModelNewEpochState era
x)
      NonMyopic
nonMyopicZero
      EpochState era
-> (EpochState era -> EpochState era) -> EpochState era
forall a b. a -> (a -> b) -> b
& (PParams era -> Identity (PParams era))
-> EpochState era -> Identity (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Identity (PParams era))
 -> EpochState era -> Identity (EpochState era))
-> PParams era -> EpochState era -> EpochState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ModelNewEpochState era -> PParams era
forall era. ModelNewEpochState era -> PParams era
mPParams ModelNewEpochState era
x
      EpochState era
-> (EpochState era -> EpochState era) -> EpochState era
forall a b. a -> (a -> b) -> b
& (PParams era -> Identity (PParams era))
-> EpochState era -> Identity (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
prevPParamsEpochStateL ((PParams era -> Identity (PParams era))
 -> EpochState era -> Identity (EpochState era))
-> PParams era -> EpochState era -> EpochState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ModelNewEpochState era -> PParams era
forall era. ModelNewEpochState era -> PParams era
mPParams ModelNewEpochState era
x

instance forall era. Reflect era => Extract (NewEpochState era) era where
  extract :: ModelNewEpochState era -> NewEpochState era
extract ModelNewEpochState era
x =
    EpochNo
-> BlocksMade
-> BlocksMade
-> EpochState era
-> StrictMaybe PulsingRewUpdate
-> PoolDistr
-> StashedAVVMAddresses era
-> NewEpochState era
forall era.
EpochNo
-> BlocksMade
-> BlocksMade
-> EpochState era
-> StrictMaybe PulsingRewUpdate
-> PoolDistr
-> StashedAVVMAddresses era
-> NewEpochState era
NewEpochState
      (ModelNewEpochState era -> EpochNo
forall era. ModelNewEpochState era -> EpochNo
mEL ModelNewEpochState era
x)
      (Map (KeyHash 'StakePool) Natural -> BlocksMade
BlocksMade (ModelNewEpochState era -> Map (KeyHash 'StakePool) Natural
forall era.
ModelNewEpochState era -> Map (KeyHash 'StakePool) Natural
mBprev ModelNewEpochState era
x))
      (Map (KeyHash 'StakePool) Natural -> BlocksMade
BlocksMade (ModelNewEpochState era -> Map (KeyHash 'StakePool) Natural
forall era.
ModelNewEpochState era -> Map (KeyHash 'StakePool) Natural
mBcur ModelNewEpochState era
x))
      (ModelNewEpochState era -> EpochState era
forall t era. Extract t era => ModelNewEpochState era -> t
extract ModelNewEpochState era
x)
      (RewardUpdate -> PulsingRewUpdate
Complete (RewardUpdate -> PulsingRewUpdate)
-> StrictMaybe RewardUpdate -> StrictMaybe PulsingRewUpdate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ModelNewEpochState era -> StrictMaybe RewardUpdate
forall era. ModelNewEpochState era -> StrictMaybe RewardUpdate
mRu ModelNewEpochState era
x)
      (Map (KeyHash 'StakePool) IndividualPoolStake
-> CompactForm Coin -> PoolDistr
PoolDistr (ModelNewEpochState era
-> Map (KeyHash 'StakePool) IndividualPoolStake
forall era.
ModelNewEpochState era
-> Map (KeyHash 'StakePool) IndividualPoolStake
mPoolDistr ModelNewEpochState era
x) (Word64 -> CompactForm Coin
CompactCoin Word64
1))
      (Proof era -> StashedAVVMAddresses era
forall era. Proof era -> StashedAVVMAddresses era
stashedAVVMAddressesZero (Proof era
forall era. Reflect era => Proof era
reify :: Proof era))

abstract :: (EraGov era, EraCertState era) => NewEpochState era -> ModelNewEpochState era
abstract :: forall era.
(EraGov era, EraCertState era) =>
NewEpochState era -> ModelNewEpochState era
abstract NewEpochState era
x =
  ModelNewEpochState
    { mPoolParams :: Map (KeyHash 'StakePool) PoolParams
mPoolParams = (PState era -> Map (KeyHash 'StakePool) PoolParams
forall era. PState era -> Map (KeyHash 'StakePool) PoolParams
psStakePoolParams (PState era -> Map (KeyHash 'StakePool) PoolParams)
-> (NewEpochState era -> PState era)
-> NewEpochState era
-> Map (KeyHash 'StakePool) PoolParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CertState era -> PState era
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 EraCertState era) =>
CertState era -> PState era
certPState (CertState era -> PState era)
-> (NewEpochState era -> CertState era)
-> NewEpochState era
-> PState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState era -> CertState era
forall era. LedgerState era -> CertState era
lsCertState (LedgerState era -> CertState era)
-> (NewEpochState era -> LedgerState era)
-> NewEpochState era
-> CertState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState (EpochState era -> LedgerState era)
-> (NewEpochState era -> EpochState era)
-> NewEpochState era
-> LedgerState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs) NewEpochState era
x
    , mPoolDeposits :: Map (KeyHash 'StakePool) Coin
mPoolDeposits = (PState era -> Map (KeyHash 'StakePool) Coin
forall era. PState era -> Map (KeyHash 'StakePool) Coin
psDeposits (PState era -> Map (KeyHash 'StakePool) Coin)
-> (NewEpochState era -> PState era)
-> NewEpochState era
-> Map (KeyHash 'StakePool) Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CertState era -> PState era
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 EraCertState era) =>
CertState era -> PState era
certPState (CertState era -> PState era)
-> (NewEpochState era -> CertState era)
-> NewEpochState era
-> PState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState era -> CertState era
forall era. LedgerState era -> CertState era
lsCertState (LedgerState era -> CertState era)
-> (NewEpochState era -> LedgerState era)
-> NewEpochState era
-> CertState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState (EpochState era -> LedgerState era)
-> (NewEpochState era -> EpochState era)
-> NewEpochState era
-> LedgerState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs) NewEpochState era
x
    , mRewards :: Map (Credential 'Staking) Coin
mRewards = (UMap -> Map (Credential 'Staking) Coin
UM.rewardMap (UMap -> Map (Credential 'Staking) Coin)
-> (NewEpochState era -> UMap)
-> NewEpochState era
-> Map (Credential 'Staking) Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DState era -> UMap
forall era. DState era -> UMap
dsUnified (DState era -> UMap)
-> (NewEpochState era -> DState era) -> NewEpochState era -> UMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CertState era -> DState era
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 EraCertState era) =>
CertState era -> DState era
certDState (CertState era -> DState era)
-> (NewEpochState era -> CertState era)
-> NewEpochState era
-> DState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState era -> CertState era
forall era. LedgerState era -> CertState era
lsCertState (LedgerState era -> CertState era)
-> (NewEpochState era -> LedgerState era)
-> NewEpochState era
-> CertState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState (EpochState era -> LedgerState era)
-> (NewEpochState era -> EpochState era)
-> NewEpochState era
-> LedgerState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs) NewEpochState era
x
    , mDelegations :: Map (Credential 'Staking) (KeyHash 'StakePool)
mDelegations = (UMap -> Map (Credential 'Staking) (KeyHash 'StakePool)
UM.sPoolMap (UMap -> Map (Credential 'Staking) (KeyHash 'StakePool))
-> (NewEpochState era -> UMap)
-> NewEpochState era
-> Map (Credential 'Staking) (KeyHash 'StakePool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DState era -> UMap
forall era. DState era -> UMap
dsUnified (DState era -> UMap)
-> (NewEpochState era -> DState era) -> NewEpochState era -> UMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CertState era -> DState era
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 EraCertState era) =>
CertState era -> DState era
certDState (CertState era -> DState era)
-> (NewEpochState era -> CertState era)
-> NewEpochState era
-> DState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState era -> CertState era
forall era. LedgerState era -> CertState era
lsCertState (LedgerState era -> CertState era)
-> (NewEpochState era -> LedgerState era)
-> NewEpochState era
-> CertState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState (EpochState era -> LedgerState era)
-> (NewEpochState era -> EpochState era)
-> NewEpochState era
-> LedgerState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs) NewEpochState era
x
    , mKeyDeposits :: Map (Credential 'Staking) Coin
mKeyDeposits = (UMap -> Map (Credential 'Staking) Coin
UM.depositMap (UMap -> Map (Credential 'Staking) Coin)
-> (NewEpochState era -> UMap)
-> NewEpochState era
-> Map (Credential 'Staking) Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DState era -> UMap
forall era. DState era -> UMap
dsUnified (DState era -> UMap)
-> (NewEpochState era -> DState era) -> NewEpochState era -> UMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CertState era -> DState era
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 EraCertState era) =>
CertState era -> DState era
certDState (CertState era -> DState era)
-> (NewEpochState era -> CertState era)
-> NewEpochState era
-> DState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState era -> CertState era
forall era. LedgerState era -> CertState era
lsCertState (LedgerState era -> CertState era)
-> (NewEpochState era -> LedgerState era)
-> NewEpochState era
-> CertState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState (EpochState era -> LedgerState era)
-> (NewEpochState era -> EpochState era)
-> NewEpochState era
-> LedgerState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs) NewEpochState era
x
    , mUTxO :: Map TxIn (TxOut era)
mUTxO = (UTxO era -> Map TxIn (TxOut era)
forall era. UTxO era -> Map TxIn (TxOut era)
unUTxO (UTxO era -> Map TxIn (TxOut era))
-> (NewEpochState era -> UTxO era)
-> NewEpochState era
-> Map TxIn (TxOut era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxOState era -> UTxO era
forall era. UTxOState era -> UTxO era
utxosUtxo (UTxOState era -> UTxO era)
-> (NewEpochState era -> UTxOState era)
-> NewEpochState era
-> UTxO era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState era -> UTxOState era
forall era. LedgerState era -> UTxOState era
lsUTxOState (LedgerState era -> UTxOState era)
-> (NewEpochState era -> LedgerState era)
-> NewEpochState era
-> UTxOState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState (EpochState era -> LedgerState era)
-> (NewEpochState era -> EpochState era)
-> NewEpochState era
-> LedgerState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs) NewEpochState era
x
    , mMutFee :: Map TxIn (TxOut era)
mMutFee = Map TxIn (TxOut era)
forall k a. Map k a
Map.empty
    , mChainAccountState :: ChainAccountState
mChainAccountState = (EpochState era -> ChainAccountState
forall era. EpochState era -> ChainAccountState
esChainAccountState (EpochState era -> ChainAccountState)
-> (NewEpochState era -> EpochState era)
-> NewEpochState era
-> ChainAccountState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs) NewEpochState era
x
    , mPoolDistr :: Map (KeyHash 'StakePool) IndividualPoolStake
mPoolDistr = (PoolDistr -> Map (KeyHash 'StakePool) IndividualPoolStake
unPoolDistr (PoolDistr -> Map (KeyHash 'StakePool) IndividualPoolStake)
-> (NewEpochState era -> PoolDistr)
-> NewEpochState era
-> Map (KeyHash 'StakePool) IndividualPoolStake
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> PoolDistr
forall era. NewEpochState era -> PoolDistr
nesPd) NewEpochState era
x
    , mPParams :: PParams era
mPParams = (Getting (PParams era) (EpochState era) (PParams era)
-> EpochState era -> PParams era
forall a s. Getting a s a -> s -> a
view Getting (PParams era) (EpochState era) (PParams era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL (EpochState era -> PParams era)
-> (NewEpochState era -> EpochState era)
-> NewEpochState era
-> PParams era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs) NewEpochState era
x
    , mDeposited :: Coin
mDeposited = (UTxOState era -> Coin
forall era. UTxOState era -> Coin
utxosDeposited (UTxOState era -> Coin)
-> (NewEpochState era -> UTxOState era)
-> NewEpochState era
-> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState era -> UTxOState era
forall era. LedgerState era -> UTxOState era
lsUTxOState (LedgerState era -> UTxOState era)
-> (NewEpochState era -> LedgerState era)
-> NewEpochState era
-> UTxOState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState (EpochState era -> LedgerState era)
-> (NewEpochState era -> EpochState era)
-> NewEpochState era
-> LedgerState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs) NewEpochState era
x
    , mFees :: Coin
mFees = (UTxOState era -> Coin
forall era. UTxOState era -> Coin
utxosFees (UTxOState era -> Coin)
-> (NewEpochState era -> UTxOState era)
-> NewEpochState era
-> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState era -> UTxOState era
forall era. LedgerState era -> UTxOState era
lsUTxOState (LedgerState era -> UTxOState era)
-> (NewEpochState era -> LedgerState era)
-> NewEpochState era
-> UTxOState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState (EpochState era -> LedgerState era)
-> (NewEpochState era -> EpochState era)
-> NewEpochState era
-> LedgerState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs) NewEpochState era
x
    , mCount :: Int
mCount = Int
0
    , mIndex :: Map Int TxId
mIndex = Map Int TxId
forall k a. Map k a
Map.empty
    , -- below here NO EFFECT until we model EpochBoundary
      mFPoolParams :: Map (KeyHash 'StakePool) PoolParams
mFPoolParams = (PState era -> Map (KeyHash 'StakePool) PoolParams
forall era. PState era -> Map (KeyHash 'StakePool) PoolParams
psFutureStakePoolParams (PState era -> Map (KeyHash 'StakePool) PoolParams)
-> (NewEpochState era -> PState era)
-> NewEpochState era
-> Map (KeyHash 'StakePool) PoolParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CertState era -> PState era
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 EraCertState era) =>
CertState era -> PState era
certPState (CertState era -> PState era)
-> (NewEpochState era -> CertState era)
-> NewEpochState era
-> PState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState era -> CertState era
forall era. LedgerState era -> CertState era
lsCertState (LedgerState era -> CertState era)
-> (NewEpochState era -> LedgerState era)
-> NewEpochState era
-> CertState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState (EpochState era -> LedgerState era)
-> (NewEpochState era -> EpochState era)
-> NewEpochState era
-> LedgerState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs) NewEpochState era
x
    , mRetiring :: Map (KeyHash 'StakePool) EpochNo
mRetiring = (PState era -> Map (KeyHash 'StakePool) EpochNo
forall era. PState era -> Map (KeyHash 'StakePool) EpochNo
psRetiring (PState era -> Map (KeyHash 'StakePool) EpochNo)
-> (NewEpochState era -> PState era)
-> NewEpochState era
-> Map (KeyHash 'StakePool) EpochNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CertState era -> PState era
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 EraCertState era) =>
CertState era -> PState era
certPState (CertState era -> PState era)
-> (NewEpochState era -> CertState era)
-> NewEpochState era
-> PState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState era -> CertState era
forall era. LedgerState era -> CertState era
lsCertState (LedgerState era -> CertState era)
-> (NewEpochState era -> LedgerState era)
-> NewEpochState era
-> CertState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState (EpochState era -> LedgerState era)
-> (NewEpochState era -> EpochState era)
-> NewEpochState era
-> LedgerState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs) NewEpochState era
x
    , mSnapshots :: SnapShots
mSnapshots = EpochState era -> SnapShots
forall era. EpochState era -> SnapShots
esSnapshots (NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
x)
    , mEL :: EpochNo
mEL = NewEpochState era -> EpochNo
forall era. NewEpochState era -> EpochNo
nesEL NewEpochState era
x
    , mBprev :: Map (KeyHash 'StakePool) Natural
mBprev = BlocksMade -> Map (KeyHash 'StakePool) Natural
unBlocksMade (NewEpochState era -> BlocksMade
forall era. NewEpochState era -> BlocksMade
nesBprev NewEpochState era
x)
    , mBcur :: Map (KeyHash 'StakePool) Natural
mBcur = BlocksMade -> Map (KeyHash 'StakePool) Natural
unBlocksMade (NewEpochState era -> BlocksMade
forall era. NewEpochState era -> BlocksMade
nesBcur NewEpochState era
x)
    , mRu :: StrictMaybe RewardUpdate
mRu = case NewEpochState era -> StrictMaybe PulsingRewUpdate
forall era. NewEpochState era -> StrictMaybe PulsingRewUpdate
nesRu NewEpochState era
x of
        StrictMaybe PulsingRewUpdate
SNothing -> StrictMaybe RewardUpdate
forall a. StrictMaybe a
SNothing -- <- There is no way to complete (nesRu x) to get a RewardUpdate
        SJust PulsingRewUpdate
pru -> RewardUpdate -> StrictMaybe RewardUpdate
forall a. a -> StrictMaybe a
SJust (PulsingRewUpdate -> RewardUpdate
complete PulsingRewUpdate
pru)
    }
  where
    certPState :: CertState era -> PState era
certPState CertState era
certState = CertState era
certState CertState era
-> Getting (PState era) (CertState era) (PState era) -> PState era
forall s a. s -> Getting a s a -> a
^. Getting (PState era) (CertState era) (PState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
certPStateL
    certDState :: CertState era -> DState era
certDState CertState era
certState = CertState era
certState CertState era
-> Getting (DState era) (CertState era) (DState era) -> DState era
forall s a. s -> Getting a s a -> a
^. Getting (DState era) (CertState era) (DState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL

complete :: PulsingRewUpdate -> RewardUpdate
complete :: PulsingRewUpdate -> RewardUpdate
complete (Complete RewardUpdate
r) = RewardUpdate
r
complete (Pulsing RewardSnapShot
rewsnap Pulser
pulser) = (RewardUpdate, RewardEvent) -> RewardUpdate
forall a b. (a, b) -> a
fst ((RewardUpdate, RewardEvent) -> RewardUpdate)
-> (RewardUpdate, RewardEvent) -> RewardUpdate
forall a b. (a -> b) -> a -> b
$ ShelleyBase (RewardUpdate, RewardEvent)
-> (RewardUpdate, RewardEvent)
forall a. ShelleyBase a -> a
runShelleyBase (PulsingRewUpdate -> ShelleyBase (RewardUpdate, RewardEvent)
completeRupd (RewardSnapShot -> Pulser -> PulsingRewUpdate
Pulsing RewardSnapShot
rewsnap Pulser
pulser))

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

pcModelNewEpochState :: Reflect era => Proof era -> ModelNewEpochState era -> PDoc
pcModelNewEpochState :: forall era.
Reflect era =>
Proof era -> ModelNewEpochState era -> PDoc
pcModelNewEpochState Proof era
proof ModelNewEpochState era
x =
  Text -> [(Text, PDoc)] -> PDoc
ppRecord Text
"ModelNewEpochState" ([(Text, PDoc)] -> PDoc) -> [(Text, PDoc)] -> PDoc
forall a b. (a -> b) -> a -> b
$
    [ (Text
"poolparams", (KeyHash 'StakePool -> PDoc)
-> (PoolParams -> PDoc)
-> Map (KeyHash 'StakePool) PoolParams
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap KeyHash 'StakePool -> PDoc
forall (keyrole :: KeyRole). KeyHash keyrole -> PDoc
keyHashSummary PoolParams -> PDoc
pcPoolParams (ModelNewEpochState era -> Map (KeyHash 'StakePool) PoolParams
forall era.
ModelNewEpochState era -> Map (KeyHash 'StakePool) PoolParams
mPoolParams ModelNewEpochState era
x))
    , (Text
"pool deposits", (KeyHash 'StakePool -> PDoc)
-> (Coin -> PDoc) -> Map (KeyHash 'StakePool) Coin -> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap KeyHash 'StakePool -> PDoc
forall (keyrole :: KeyRole). KeyHash keyrole -> PDoc
keyHashSummary Coin -> PDoc
pcCoin (ModelNewEpochState era -> Map (KeyHash 'StakePool) Coin
forall era. ModelNewEpochState era -> Map (KeyHash 'StakePool) Coin
mPoolDeposits ModelNewEpochState era
x))
    , (Text
"rewards", (Credential 'Staking -> PDoc)
-> (Coin -> PDoc) -> Map (Credential 'Staking) Coin -> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap Credential 'Staking -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
credSummary Coin -> PDoc
pcCoin (ModelNewEpochState era -> Map (Credential 'Staking) Coin
forall era.
ModelNewEpochState era -> Map (Credential 'Staking) Coin
mRewards ModelNewEpochState era
x))
    , (Text
"delegations", (Credential 'Staking -> PDoc)
-> (KeyHash 'StakePool -> PDoc)
-> Map (Credential 'Staking) (KeyHash 'StakePool)
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap Credential 'Staking -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
pcCredential KeyHash 'StakePool -> PDoc
forall (keyrole :: KeyRole). KeyHash keyrole -> PDoc
pcKeyHash (ModelNewEpochState era
-> Map (Credential 'Staking) (KeyHash 'StakePool)
forall era.
ModelNewEpochState era
-> Map (Credential 'Staking) (KeyHash 'StakePool)
mDelegations ModelNewEpochState era
x))
    , (Text
"key deposits", (Credential 'Staking -> PDoc)
-> (Coin -> PDoc) -> Map (Credential 'Staking) Coin -> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap Credential 'Staking -> PDoc
forall (keyrole :: KeyRole). Credential keyrole -> PDoc
credSummary Coin -> PDoc
pcCoin (ModelNewEpochState era -> Map (Credential 'Staking) Coin
forall era.
ModelNewEpochState era -> Map (Credential 'Staking) Coin
mKeyDeposits ModelNewEpochState era
x))
    , (Text
"utxo", (TxIn -> PDoc)
-> (TxOut era -> PDoc) -> Map TxIn (TxOut era) -> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap TxIn -> PDoc
pcTxIn (Proof era -> TxOut era -> PDoc
forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut Proof era
proof) (ModelNewEpochState era -> Map TxIn (TxOut era)
forall era. ModelNewEpochState era -> Map TxIn (TxOut era)
mUTxO ModelNewEpochState era
x))
    , (Text
"mutFees", (TxIn -> PDoc)
-> (TxOut era -> PDoc) -> Map TxIn (TxOut era) -> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap TxIn -> PDoc
pcTxIn (Proof era -> TxOut era -> PDoc
forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut Proof era
proof) (ModelNewEpochState era -> Map TxIn (TxOut era)
forall era. ModelNewEpochState era -> Map TxIn (TxOut era)
mMutFee ModelNewEpochState era
x))
    , (Text
"account", ChainAccountState -> PDoc
pcChainAccountState (ModelNewEpochState era -> ChainAccountState
forall era. ModelNewEpochState era -> ChainAccountState
mChainAccountState ModelNewEpochState era
x))
    , (Text
"pool distr", (KeyHash 'StakePool -> PDoc)
-> (IndividualPoolStake -> PDoc)
-> Map (KeyHash 'StakePool) IndividualPoolStake
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap KeyHash 'StakePool -> PDoc
forall (keyrole :: KeyRole). KeyHash keyrole -> PDoc
pcKeyHash IndividualPoolStake -> PDoc
pcIndividualPoolStake (ModelNewEpochState era
-> Map (KeyHash 'StakePool) IndividualPoolStake
forall era.
ModelNewEpochState era
-> Map (KeyHash 'StakePool) IndividualPoolStake
mPoolDistr ModelNewEpochState era
x))
    , (Text
"protocol params", [Char] -> PDoc
forall a. [Char] -> Doc a
ppString [Char]
"PParams ...")
    , (Text
"deposited", Coin -> PDoc
pcCoin (ModelNewEpochState era -> Coin
forall era. ModelNewEpochState era -> Coin
mDeposited ModelNewEpochState era
x))
    , (Text
"fees", Coin -> PDoc
pcCoin (ModelNewEpochState era -> Coin
forall era. ModelNewEpochState era -> Coin
mFees ModelNewEpochState era
x))
    , (Text
"count", Int -> PDoc
forall a. Int -> Doc a
ppInt (ModelNewEpochState era -> Int
forall era. ModelNewEpochState era -> Int
mCount ModelNewEpochState era
x))
    , (Text
"index", (Int -> PDoc) -> (TxId -> PDoc) -> Map Int TxId -> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap Int -> PDoc
forall a. Int -> Doc a
ppInt TxId -> PDoc
pcTxId (ModelNewEpochState era -> Map Int TxId
forall era. ModelNewEpochState era -> Map Int TxId
mIndex ModelNewEpochState era
x))
    -- Add additional EpochBoundary fields here
    ]
      [(Text, PDoc)] -> [(Text, PDoc)] -> [(Text, PDoc)]
forall a. [a] -> [a] -> [a]
++ [Maybe (Text, PDoc)] -> [(Text, PDoc)]
forall a. [Maybe a] -> [a]
Maybe.catMaybes (Proof era -> ModelNewEpochState era -> [Maybe (Text, PDoc)]
forall era.
Proof era -> ModelNewEpochState era -> [Maybe (Text, PDoc)]
epochBoundaryPDoc Proof era
proof ModelNewEpochState era
x)

epochBoundaryPDoc :: Proof era -> ModelNewEpochState era -> [Maybe (Text, PDoc)]
epochBoundaryPDoc :: forall era.
Proof era -> ModelNewEpochState era -> [Maybe (Text, PDoc)]
epochBoundaryPDoc Proof era
_proof ModelNewEpochState era
x =
  [ if Map (KeyHash 'StakePool) PoolParams -> Bool
forall k a. Map k a -> Bool
Map.null Map (KeyHash 'StakePool) PoolParams
futurepp
      then Maybe (Text, PDoc)
forall a. Maybe a
Nothing
      else (Text, PDoc) -> Maybe (Text, PDoc)
forall a. a -> Maybe a
Just (Text
"future pparams", (KeyHash 'StakePool -> PDoc)
-> (PoolParams -> PDoc)
-> Map (KeyHash 'StakePool) PoolParams
-> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap KeyHash 'StakePool -> PDoc
forall (keyrole :: KeyRole). KeyHash keyrole -> PDoc
pcKeyHash PoolParams -> PDoc
pcPoolParams Map (KeyHash 'StakePool) PoolParams
futurepp)
  , if Map (KeyHash 'StakePool) EpochNo -> Bool
forall k a. Map k a -> Bool
Map.null Map (KeyHash 'StakePool) EpochNo
retiring then Maybe (Text, PDoc)
forall a. Maybe a
Nothing else (Text, PDoc) -> Maybe (Text, PDoc)
forall a. a -> Maybe a
Just (Text
"retiring", (KeyHash 'StakePool -> PDoc)
-> (EpochNo -> PDoc) -> Map (KeyHash 'StakePool) EpochNo -> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap KeyHash 'StakePool -> PDoc
forall (keyrole :: KeyRole). KeyHash keyrole -> PDoc
pcKeyHash EpochNo -> PDoc
forall ann. EpochNo -> Doc ann
ppEpochNo Map (KeyHash 'StakePool) EpochNo
retiring)
  , if EpochNo
lastepoch EpochNo -> EpochNo -> Bool
forall a. Eq a => a -> a -> Bool
== Word64 -> EpochNo
EpochNo Word64
0 then Maybe (Text, PDoc)
forall a. Maybe a
Nothing else (Text, PDoc) -> Maybe (Text, PDoc)
forall a. a -> Maybe a
Just (Text
"last epoch", EpochNo -> PDoc
forall ann. EpochNo -> Doc ann
ppEpochNo EpochNo
lastepoch)
  , if Map (KeyHash 'StakePool) Natural -> Bool
forall k a. Map k a -> Bool
Map.null Map (KeyHash 'StakePool) Natural
prevBlocks then Maybe (Text, PDoc)
forall a. Maybe a
Nothing else (Text, PDoc) -> Maybe (Text, PDoc)
forall a. a -> Maybe a
Just (Text
"prev blocks", (KeyHash 'StakePool -> PDoc)
-> (Natural -> PDoc) -> Map (KeyHash 'StakePool) Natural -> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap KeyHash 'StakePool -> PDoc
forall (keyrole :: KeyRole). KeyHash keyrole -> PDoc
pcKeyHash Natural -> PDoc
forall a. Natural -> Doc a
ppNatural Map (KeyHash 'StakePool) Natural
prevBlocks)
  , if Map (KeyHash 'StakePool) Natural -> Bool
forall k a. Map k a -> Bool
Map.null Map (KeyHash 'StakePool) Natural
curBlocks then Maybe (Text, PDoc)
forall a. Maybe a
Nothing else (Text, PDoc) -> Maybe (Text, PDoc)
forall a. a -> Maybe a
Just (Text
"current blocks", (KeyHash 'StakePool -> PDoc)
-> (Natural -> PDoc) -> Map (KeyHash 'StakePool) Natural -> PDoc
forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap KeyHash 'StakePool -> PDoc
forall (keyrole :: KeyRole). KeyHash keyrole -> PDoc
pcKeyHash Natural -> PDoc
forall a. Natural -> Doc a
ppNatural Map (KeyHash 'StakePool) Natural
curBlocks)
  ]
  where
    futurepp :: Map (KeyHash 'StakePool) PoolParams
futurepp = ModelNewEpochState era -> Map (KeyHash 'StakePool) PoolParams
forall era.
ModelNewEpochState era -> Map (KeyHash 'StakePool) PoolParams
mFPoolParams ModelNewEpochState era
x
    retiring :: Map (KeyHash 'StakePool) EpochNo
retiring = ModelNewEpochState era -> Map (KeyHash 'StakePool) EpochNo
forall era.
ModelNewEpochState era -> Map (KeyHash 'StakePool) EpochNo
mRetiring ModelNewEpochState era
x
    lastepoch :: EpochNo
lastepoch = ModelNewEpochState era -> EpochNo
forall era. ModelNewEpochState era -> EpochNo
mEL ModelNewEpochState era
x
    prevBlocks :: Map (KeyHash 'StakePool) Natural
prevBlocks = ModelNewEpochState era -> Map (KeyHash 'StakePool) Natural
forall era.
ModelNewEpochState era -> Map (KeyHash 'StakePool) Natural
mBprev ModelNewEpochState era
x
    curBlocks :: Map (KeyHash 'StakePool) Natural
curBlocks = ModelNewEpochState era -> Map (KeyHash 'StakePool) Natural
forall era.
ModelNewEpochState era -> Map (KeyHash 'StakePool) Natural
mBcur ModelNewEpochState era
x

-- SnapShots and PulsingRewUdate delberately ommitted from pretty printer

instance Reflect era => PrettyA (ModelNewEpochState era) where prettyA :: ModelNewEpochState era -> PDoc
prettyA = Proof era -> ModelNewEpochState era -> PDoc
forall era.
Reflect era =>
Proof era -> ModelNewEpochState era -> PDoc
pcModelNewEpochState Proof era
forall era. Reflect era => Proof era
reify

instance Reflect era => Show (ModelNewEpochState era) where
  show :: ModelNewEpochState era -> [Char]
show ModelNewEpochState era
x = PDoc -> [Char]
forall a. Show a => a -> [Char]
show (ModelNewEpochState era -> PDoc
forall t. PrettyA t => t -> PDoc
prettyA ModelNewEpochState era
x)