{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-}

-- | 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.Credential (Credential (..))
import Cardano.Ledger.EpochBoundary (SnapShots, emptySnapShots)
import Cardano.Ledger.Keys (
  GenDelegs (..),
  KeyHash (..),
  KeyRole (..),
 )
import Cardano.Ledger.PoolDistr (IndividualPoolStake (..), PoolDistr (..))
import Cardano.Ledger.PoolParams (PoolParams (..))
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.LedgerState (
  AccountState (..),
  CertState (..),
  DState (..),
  EpochState (..),
  IncrementalStake (..),
  InstantaneousRewards (..),
  LedgerState (..),
  NewEpochState (..),
  PState (..),
  StashedAVVMAddresses,
  UTxOState (..),
  VState (..),
  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.TxIn (TxId (..), TxIn (..))
import qualified Cardano.Ledger.UMap as UM
import Cardano.Ledger.UTxO (UTxO (..))
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,
  pcAccountState,
  pcCoin,
  pcCredential,
  pcIndividualPoolStake,
  pcKeyHash,
  pcPoolParams,
  pcTxId,
  pcTxIn,
  pcTxOut,
  ppEpochNo,
  ppInt,
  ppMap,
  ppNatural,
  ppRecord,
  ppString,
 )
import Test.Cardano.Ledger.Generic.Proof (
  BabbageEra,
  Proof (..),
  Reflect (..),
  StandardCrypto,
 )
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 (EraCrypto era)) (TxOut era)

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

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

data ModelNewEpochState era = ModelNewEpochState
  { -- PState fields
    forall era.
ModelNewEpochState era
-> Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
mPoolParams :: !(Map (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
  , forall era.
ModelNewEpochState era
-> Map (KeyHash 'StakePool (EraCrypto era)) Coin
mPoolDeposits :: !(Map (KeyHash 'StakePool (EraCrypto era)) Coin)
  , -- DState state fields
    forall era.
ModelNewEpochState era
-> Map (Credential 'Staking (EraCrypto era)) Coin
mRewards :: !(Map (Credential 'Staking (EraCrypto era)) Coin)
  , forall era.
ModelNewEpochState era
-> Map
     (Credential 'Staking (EraCrypto era))
     (KeyHash 'StakePool (EraCrypto era))
mDelegations :: !(Map (Credential 'Staking (EraCrypto era)) (KeyHash 'StakePool (EraCrypto era)))
  , forall era.
ModelNewEpochState era
-> Map (Credential 'Staking (EraCrypto era)) Coin
mKeyDeposits :: !(Map (Credential 'Staking (EraCrypto era)) 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 (EraCrypto era)) (TxOut era)
mUTxO :: !(Map (TxIn (EraCrypto era)) (TxOut era))
  , forall era.
ModelNewEpochState era -> Map (TxIn (EraCrypto era)) (TxOut era)
mMutFee :: !(Map (TxIn (EraCrypto era)) (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 -> AccountState
mAccountState :: !AccountState
  , -- 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 (EraCrypto era))
     (IndividualPoolStake (EraCrypto era))
mPoolDistr :: !(Map (KeyHash 'StakePool (EraCrypto era)) (IndividualPoolStake (EraCrypto era)))
  , 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 (EraCrypto era))
mIndex :: !(Map Int (TxId (EraCrypto era)))
  , -- below here NO EFFECT until we model EpochBoundary
    forall era.
ModelNewEpochState era
-> Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
mFPoolParams :: !(Map (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
  , forall era.
ModelNewEpochState era
-> Map (KeyHash 'StakePool (EraCrypto era)) EpochNo
mRetiring :: !(Map (KeyHash 'StakePool (EraCrypto era)) EpochNo)
  , forall era. ModelNewEpochState era -> SnapShots (EraCrypto era)
mSnapshots :: !(SnapShots (EraCrypto era))
  , forall era. ModelNewEpochState era -> EpochNo
mEL :: !EpochNo -- The current epoch,
  , forall era.
ModelNewEpochState era
-> Map (KeyHash 'StakePool (EraCrypto era)) Natural
mBprev :: !(Map (KeyHash 'StakePool (EraCrypto era)) Natural) --  Blocks made before current epoch, NO EFFECT until we model EpochBoundar
  , forall era.
ModelNewEpochState era
-> Map (KeyHash 'StakePool (EraCrypto era)) Natural
mBcur :: !(Map (KeyHash 'StakePool (EraCrypto era)) Natural)
  , forall era.
ModelNewEpochState era
-> StrictMaybe (RewardUpdate (EraCrypto era))
mRu :: !(StrictMaybe (RewardUpdate (EraCrypto era))) -- Possible reward update
  }

type UtxoEntry era = (TxIn (EraCrypto era), 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 c
blocksMadeZero :: forall c. BlocksMade c
blocksMadeZero = forall c. Map (KeyHash 'StakePool c) Natural -> BlocksMade c
BlocksMade forall k a. Map k a
Map.empty

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

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

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

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

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

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

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

dPStateZero :: CertState era
dPStateZero :: forall era. CertState era
dPStateZero = forall era. VState era -> PState era -> DState era -> CertState era
CertState forall a. Default a => a
def forall c. PState c
pStateZero forall c. DState c
dStateZero

incrementalStakeZero :: IncrementalStake c
incrementalStakeZero :: forall c. IncrementalStake c
incrementalStakeZero = forall c.
Map (Credential 'Staking c) (CompactForm Coin)
-> Map Ptr (CompactForm Coin) -> IncrementalStake c
IStake forall k a. Map k a
Map.empty forall k a. Map k a
Map.empty

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

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

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

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

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

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

newEpochStateZero :: forall era. Reflect era => NewEpochState era
newEpochStateZero :: forall era. Reflect era => NewEpochState era
newEpochStateZero =
  forall era.
EpochNo
-> BlocksMade (EraCrypto era)
-> BlocksMade (EraCrypto era)
-> EpochState era
-> StrictMaybe (PulsingRewUpdate (EraCrypto era))
-> PoolDistr (EraCrypto era)
-> StashedAVVMAddresses era
-> NewEpochState era
NewEpochState
    (Word64 -> EpochNo
EpochNo Word64
0)
    forall c. BlocksMade c
blocksMadeZero
    forall c. BlocksMade c
blocksMadeZero
    forall era. Reflect era => EpochState era
epochStateZero
    forall a. StrictMaybe a
SNothing
    forall c. PoolDistr c
poolDistrZero
    (forall era. Proof era -> StashedAVVMAddresses era
stashedAVVMAddressesZero (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 = 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 (EraCrypto era)) (PoolParams (EraCrypto era))
mPoolParams = forall k a. Map k a
Map.empty
    , mPoolDeposits :: Map (KeyHash 'StakePool (EraCrypto era)) Coin
mPoolDeposits = forall k a. Map k a
Map.empty
    , mRewards :: Map (Credential 'Staking (EraCrypto era)) Coin
mRewards = forall k a. Map k a
Map.empty
    , mDelegations :: Map
  (Credential 'Staking (EraCrypto era))
  (KeyHash 'StakePool (EraCrypto era))
mDelegations = forall k a. Map k a
Map.empty
    , mKeyDeposits :: Map (Credential 'Staking (EraCrypto era)) Coin
mKeyDeposits = forall k a. Map k a
Map.empty
    , mUTxO :: Map (TxIn (EraCrypto era)) (TxOut era)
mUTxO = forall k a. Map k a
Map.empty
    , mMutFee :: Map (TxIn (EraCrypto era)) (TxOut era)
mMutFee = forall k a. Map k a
Map.empty
    , mAccountState :: AccountState
mAccountState = AccountState
accountStateZero
    , mPoolDistr :: Map
  (KeyHash 'StakePool (EraCrypto era))
  (IndividualPoolStake (EraCrypto era))
mPoolDistr = forall k a. Map k a
Map.empty
    , mPParams :: PParams era
mPParams = 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 (EraCrypto era))
mIndex = forall k a. Map k a
Map.empty
    , -- below here NO EFFECT until we model EpochBoundary
      mFPoolParams :: Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
mFPoolParams = forall k a. Map k a
Map.empty
    , mRetiring :: Map (KeyHash 'StakePool (EraCrypto era)) EpochNo
mRetiring = forall k a. Map k a
Map.empty
    , mSnapshots :: SnapShots (EraCrypto era)
mSnapshots = forall c. SnapShots c
emptySnapShots
    , mEL :: EpochNo
mEL = Word64 -> EpochNo
EpochNo Word64
0
    , mBprev :: Map (KeyHash 'StakePool (EraCrypto era)) Natural
mBprev = forall k a. Map k a
Map.empty
    , mBcur :: Map (KeyHash 'StakePool (EraCrypto era)) Natural
mBcur = forall k a. Map k a
Map.empty
    , mRu :: StrictMaybe (RewardUpdate (EraCrypto era))
mRu = forall a. StrictMaybe a
SNothing
    }

testNES :: NewEpochState (BabbageEra StandardCrypto)
testNES :: NewEpochState (BabbageEra StandardCrypto)
testNES = forall era. Reflect era => NewEpochState era
newEpochStateZero

testMNES :: ModelNewEpochState (BabbageEra StandardCrypto)
testMNES :: ModelNewEpochState (BabbageEra StandardCrypto)
testMNES = 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 =
    forall era.
UMap (EraCrypto era)
-> Map
     (FutureGenDeleg (EraCrypto era)) (GenDelegPair (EraCrypto era))
-> GenDelegs (EraCrypto era)
-> InstantaneousRewards (EraCrypto era)
-> DState era
DState
      (forall c.
Map (Credential 'Staking c) RDPair
-> Map Ptr (Credential 'Staking c)
-> Map (Credential 'Staking c) (KeyHash 'StakePool c)
-> Map (Credential 'Staking c) (DRep c)
-> UMap c
UM.unify (forall era.
ModelNewEpochState era
-> Map (Credential 'Staking (EraCrypto era)) RDPair
makeRewards ModelNewEpochState era
x) forall k a. Map k a
Map.empty (forall era.
ModelNewEpochState era
-> Map
     (Credential 'Staking (EraCrypto era))
     (KeyHash 'StakePool (EraCrypto era))
mDelegations ModelNewEpochState era
x) forall k a. Map k a
Map.empty)
      forall k a. Map k a
Map.empty
      forall c. GenDelegs c
genDelegsZero
      forall c. InstantaneousRewards c
instantaneousRewardsZero

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

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

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

instance Extract (CertState era) era where
  extract :: ModelNewEpochState era -> CertState era
extract ModelNewEpochState era
x = forall era. VState era -> PState era -> DState era -> CertState era
CertState (forall t era. Extract t era => ModelNewEpochState era -> t
extract ModelNewEpochState era
x) (forall t era. Extract t era => ModelNewEpochState era -> t
extract ModelNewEpochState era
x) (forall t era. Extract t era => ModelNewEpochState era -> t
extract ModelNewEpochState era
x)

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

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

instance Reflect era => Extract (EpochState era) era where
  extract :: ModelNewEpochState era -> EpochState era
extract ModelNewEpochState era
x =
    forall era.
AccountState
-> LedgerState era
-> SnapShots (EraCrypto era)
-> NonMyopic (EraCrypto era)
-> EpochState era
EpochState
      (forall era. ModelNewEpochState era -> AccountState
mAccountState ModelNewEpochState era
x)
      (forall t era. Extract t era => ModelNewEpochState era -> t
extract ModelNewEpochState era
x)
      (forall era. ModelNewEpochState era -> SnapShots (EraCrypto era)
mSnapshots ModelNewEpochState era
x)
      forall c. NonMyopic c
nonMyopicZero
      forall a b. a -> (a -> b) -> b
& forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall era. ModelNewEpochState era -> PParams era
mPParams ModelNewEpochState era
x
      forall a b. a -> (a -> b) -> b
& forall era. EraGov era => Lens' (EpochState era) (PParams era)
prevPParamsEpochStateL forall s t a b. ASetter s t a b -> b -> s -> t
.~ 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 =
    forall era.
EpochNo
-> BlocksMade (EraCrypto era)
-> BlocksMade (EraCrypto era)
-> EpochState era
-> StrictMaybe (PulsingRewUpdate (EraCrypto era))
-> PoolDistr (EraCrypto era)
-> StashedAVVMAddresses era
-> NewEpochState era
NewEpochState
      (forall era. ModelNewEpochState era -> EpochNo
mEL ModelNewEpochState era
x)
      (forall c. Map (KeyHash 'StakePool c) Natural -> BlocksMade c
BlocksMade (forall era.
ModelNewEpochState era
-> Map (KeyHash 'StakePool (EraCrypto era)) Natural
mBprev ModelNewEpochState era
x))
      (forall c. Map (KeyHash 'StakePool c) Natural -> BlocksMade c
BlocksMade (forall era.
ModelNewEpochState era
-> Map (KeyHash 'StakePool (EraCrypto era)) Natural
mBcur ModelNewEpochState era
x))
      (forall t era. Extract t era => ModelNewEpochState era -> t
extract ModelNewEpochState era
x)
      (forall c. RewardUpdate c -> PulsingRewUpdate c
Complete forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era.
ModelNewEpochState era
-> StrictMaybe (RewardUpdate (EraCrypto era))
mRu ModelNewEpochState era
x)
      (forall c.
Map (KeyHash 'StakePool c) (IndividualPoolStake c)
-> CompactForm Coin -> PoolDistr c
PoolDistr (forall era.
ModelNewEpochState era
-> Map
     (KeyHash 'StakePool (EraCrypto era))
     (IndividualPoolStake (EraCrypto era))
mPoolDistr ModelNewEpochState era
x) (Word64 -> CompactForm Coin
CompactCoin Word64
1))
      (forall era. Proof era -> StashedAVVMAddresses era
stashedAVVMAddressesZero (forall era. Reflect era => Proof era
reify :: Proof era))

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

complete :: PulsingRewUpdate c -> RewardUpdate c
complete :: forall c. PulsingRewUpdate c -> RewardUpdate c
complete (Complete RewardUpdate c
r) = RewardUpdate c
r
complete (Pulsing RewardSnapShot c
rewsnap Pulser c
pulser) = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. ShelleyBase a -> a
runShelleyBase (forall c.
PulsingRewUpdate c -> ShelleyBase (RewardUpdate c, RewardEvent c)
completeRupd (forall c. RewardSnapShot c -> Pulser c -> PulsingRewUpdate c
Pulsing RewardSnapShot c
rewsnap Pulser c
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" forall a b. (a -> b) -> a -> b
$
    [ (Text
"poolparams", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole) c. KeyHash keyrole c -> PDoc
keyHashSummary forall era. PoolParams era -> PDoc
pcPoolParams (forall era.
ModelNewEpochState era
-> Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
mPoolParams ModelNewEpochState era
x))
    , (Text
"pool deposits", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole) c. KeyHash keyrole c -> PDoc
keyHashSummary Coin -> PDoc
pcCoin (forall era.
ModelNewEpochState era
-> Map (KeyHash 'StakePool (EraCrypto era)) Coin
mPoolDeposits ModelNewEpochState era
x))
    , (Text
"rewards", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
credSummary Coin -> PDoc
pcCoin (forall era.
ModelNewEpochState era
-> Map (Credential 'Staking (EraCrypto era)) Coin
mRewards ModelNewEpochState era
x))
    , (Text
"delegations", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
pcCredential forall (keyrole :: KeyRole) c. KeyHash keyrole c -> PDoc
pcKeyHash (forall era.
ModelNewEpochState era
-> Map
     (Credential 'Staking (EraCrypto era))
     (KeyHash 'StakePool (EraCrypto era))
mDelegations ModelNewEpochState era
x))
    , (Text
"key deposits", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole) c. Credential keyrole c -> PDoc
credSummary Coin -> PDoc
pcCoin (forall era.
ModelNewEpochState era
-> Map (Credential 'Staking (EraCrypto era)) Coin
mKeyDeposits ModelNewEpochState era
x))
    , (Text
"utxo", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall c. TxIn c -> PDoc
pcTxIn (forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut Proof era
proof) (forall era.
ModelNewEpochState era -> Map (TxIn (EraCrypto era)) (TxOut era)
mUTxO ModelNewEpochState era
x))
    , (Text
"mutFees", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall c. TxIn c -> PDoc
pcTxIn (forall era. Reflect era => Proof era -> TxOut era -> PDoc
pcTxOut Proof era
proof) (forall era.
ModelNewEpochState era -> Map (TxIn (EraCrypto era)) (TxOut era)
mMutFee ModelNewEpochState era
x))
    , (Text
"account", AccountState -> PDoc
pcAccountState (forall era. ModelNewEpochState era -> AccountState
mAccountState ModelNewEpochState era
x))
    , (Text
"pool distr", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole) c. KeyHash keyrole c -> PDoc
pcKeyHash forall c. IndividualPoolStake c -> PDoc
pcIndividualPoolStake (forall era.
ModelNewEpochState era
-> Map
     (KeyHash 'StakePool (EraCrypto era))
     (IndividualPoolStake (EraCrypto era))
mPoolDistr ModelNewEpochState era
x))
    , (Text
"protocol params", forall a. [Char] -> Doc a
ppString [Char]
"PParams ...")
    , (Text
"deposited", Coin -> PDoc
pcCoin (forall era. ModelNewEpochState era -> Coin
mDeposited ModelNewEpochState era
x))
    , (Text
"fees", Coin -> PDoc
pcCoin (forall era. ModelNewEpochState era -> Coin
mFees ModelNewEpochState era
x))
    , (Text
"count", forall a. Int -> Doc a
ppInt (forall era. ModelNewEpochState era -> Int
mCount ModelNewEpochState era
x))
    , (Text
"index", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall a. Int -> Doc a
ppInt forall c. TxId c -> PDoc
pcTxId (forall era.
ModelNewEpochState era -> Map Int (TxId (EraCrypto era))
mIndex ModelNewEpochState era
x))
    -- Add additional EpochBoundary fields here
    ]
      forall a. [a] -> [a] -> [a]
++ forall a. [Maybe a] -> [a]
Maybe.catMaybes (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 forall k a. Map k a -> Bool
Map.null Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
futurepp
      then forall a. Maybe a
Nothing
      else forall a. a -> Maybe a
Just (Text
"future pparams", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole) c. KeyHash keyrole c -> PDoc
pcKeyHash forall era. PoolParams era -> PDoc
pcPoolParams Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
futurepp)
  , if forall k a. Map k a -> Bool
Map.null Map (KeyHash 'StakePool (EraCrypto era)) EpochNo
retiring then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just (Text
"retiring", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole) c. KeyHash keyrole c -> PDoc
pcKeyHash forall ann. EpochNo -> Doc ann
ppEpochNo Map (KeyHash 'StakePool (EraCrypto era)) EpochNo
retiring)
  , if EpochNo
lastepoch forall a. Eq a => a -> a -> Bool
== Word64 -> EpochNo
EpochNo Word64
0 then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just (Text
"last epoch", forall ann. EpochNo -> Doc ann
ppEpochNo EpochNo
lastepoch)
  , if forall k a. Map k a -> Bool
Map.null Map (KeyHash 'StakePool (EraCrypto era)) Natural
prevBlocks then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just (Text
"prev blocks", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole) c. KeyHash keyrole c -> PDoc
pcKeyHash forall a. Natural -> Doc a
ppNatural Map (KeyHash 'StakePool (EraCrypto era)) Natural
prevBlocks)
  , if forall k a. Map k a -> Bool
Map.null Map (KeyHash 'StakePool (EraCrypto era)) Natural
curBlocks then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just (Text
"current blocks", forall k v. (k -> PDoc) -> (v -> PDoc) -> Map k v -> PDoc
ppMap forall (keyrole :: KeyRole) c. KeyHash keyrole c -> PDoc
pcKeyHash forall a. Natural -> Doc a
ppNatural Map (KeyHash 'StakePool (EraCrypto era)) Natural
curBlocks)
  ]
  where
    futurepp :: Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
futurepp = forall era.
ModelNewEpochState era
-> Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
mFPoolParams ModelNewEpochState era
x
    retiring :: Map (KeyHash 'StakePool (EraCrypto era)) EpochNo
retiring = forall era.
ModelNewEpochState era
-> Map (KeyHash 'StakePool (EraCrypto era)) EpochNo
mRetiring ModelNewEpochState era
x
    lastepoch :: EpochNo
lastepoch = forall era. ModelNewEpochState era -> EpochNo
mEL ModelNewEpochState era
x
    prevBlocks :: Map (KeyHash 'StakePool (EraCrypto era)) Natural
prevBlocks = (forall era.
ModelNewEpochState era
-> Map (KeyHash 'StakePool (EraCrypto era)) Natural
mBprev ModelNewEpochState era
x)
    curBlocks :: Map (KeyHash 'StakePool (EraCrypto era)) Natural
curBlocks = (forall era.
ModelNewEpochState era
-> Map (KeyHash 'StakePool (EraCrypto era)) 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 = forall era.
Reflect era =>
Proof era -> ModelNewEpochState era -> PDoc
pcModelNewEpochState forall era. Reflect era => Proof era
reify

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