{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-deprecations #-}

module Cardano.Ledger.Shelley.LedgerState.Types where

import Cardano.Ledger.BaseTypes (
  BlocksMade (..),
  EpochNo,
  StrictMaybe (..),
 )
import Cardano.Ledger.Binary (
  DecCBOR (decCBOR),
  DecShareCBOR (Share, decShareCBOR, decSharePlusCBOR),
  EncCBOR (encCBOR),
  FromCBOR (..),
  Interns,
  ToCBOR (..),
  decShareLensCBOR,
  decSharePlusLensCBOR,
  decodeRecordNamed,
  decodeRecordNamedT,
  encodeListLen,
  encodeMap,
  encodeMemPack,
 )
import Cardano.Ledger.Binary.Coders (Decode (From, RecD), Encode (..), decode, encode, (!>), (<!))
import Cardano.Ledger.Coin (Coin (..), CompactForm)
import Cardano.Ledger.Credential (Credential (..))
import Cardano.Ledger.PoolParams
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.Era (ShelleyEra)
import Cardano.Ledger.Shelley.PoolRank (NonMyopic (..))
import Cardano.Ledger.Shelley.RewardUpdate (PulsingRewUpdate (..))
import Cardano.Ledger.State
import Cardano.Ledger.UMap (UMap (..))
import Control.DeepSeq (NFData)
import Control.Monad.State.Strict (evalStateT)
import Control.Monad.Trans (MonadTrans (lift))
import Data.Aeson (KeyValue, ToJSON (..), object, pairs, (.=))
import Data.Default (Default, def)
import Data.Map.Strict (Map)
import Data.VMap (VB, VMap, VP)
import GHC.Generics (Generic)
import Lens.Micro
import NoThunks.Class (NoThunks (..))
import Numeric.Natural (Natural)

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

type RewardAccounts =
  Map (Credential 'Staking) Coin

{-# DEPRECATED RewardAccounts "In favor of `Map` (`Credential` `Staking`) `Coin`" #-}

data EpochState era = EpochState
  { forall era. EpochState era -> ChainAccountState
esChainAccountState :: !ChainAccountState
  , forall era. EpochState era -> LedgerState era
esLState :: !(LedgerState era)
  , forall era. EpochState era -> SnapShots
esSnapshots :: !SnapShots
  , forall era. EpochState era -> NonMyopic
esNonMyopic :: !NonMyopic
  -- ^ This field, esNonMyopic, does not appear in the formal spec
  -- and is not a part of the protocol. It is only used for providing
  -- data to the stake pool ranking calculation @getNonMyopicMemberRewards@.
  -- See https://github.com/intersectmbo/cardano-ledger/releases/latest/download/pool-ranking.pdf
  }
  deriving ((forall x. EpochState era -> Rep (EpochState era) x)
-> (forall x. Rep (EpochState era) x -> EpochState era)
-> Generic (EpochState era)
forall x. Rep (EpochState era) x -> EpochState era
forall x. EpochState era -> Rep (EpochState era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (EpochState era) x -> EpochState era
forall era x. EpochState era -> Rep (EpochState era) x
$cfrom :: forall era x. EpochState era -> Rep (EpochState era) x
from :: forall x. EpochState era -> Rep (EpochState era) x
$cto :: forall era x. Rep (EpochState era) x -> EpochState era
to :: forall x. Rep (EpochState era) x -> EpochState era
Generic)

instance CanGetUTxO EpochState

instance CanSetUTxO EpochState where
  utxoL :: forall era. Lens' (EpochState era) (UTxO era)
utxoL = (EpochState era -> LedgerState era)
-> (EpochState era -> LedgerState era -> EpochState era)
-> Lens
     (EpochState era)
     (EpochState era)
     (LedgerState era)
     (LedgerState era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState (\EpochState era
es LedgerState era
ls -> EpochState era
es {esLState = ls}) ((LedgerState era -> f (LedgerState era))
 -> EpochState era -> f (EpochState era))
-> ((UTxO era -> f (UTxO era))
    -> LedgerState era -> f (LedgerState era))
-> (UTxO era -> f (UTxO era))
-> EpochState era
-> f (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTxO era -> f (UTxO era))
-> LedgerState era -> f (LedgerState era)
forall era. Lens' (LedgerState era) (UTxO era)
forall (t :: * -> *) era. CanSetUTxO t => Lens' (t era) (UTxO era)
utxoL
  {-# INLINE utxoL #-}

instance CanGetInstantStake EpochState

instance CanSetInstantStake EpochState where
  instantStakeL :: forall era. Lens' (EpochState era) (InstantStake era)
instantStakeL = (EpochState era -> LedgerState era)
-> (EpochState era -> LedgerState era -> EpochState era)
-> Lens
     (EpochState era)
     (EpochState era)
     (LedgerState era)
     (LedgerState era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState (\EpochState era
es LedgerState era
ls -> EpochState era
es {esLState = ls}) ((LedgerState era -> f (LedgerState era))
 -> EpochState era -> f (EpochState era))
-> ((InstantStake era -> f (InstantStake era))
    -> LedgerState era -> f (LedgerState era))
-> (InstantStake era -> f (InstantStake era))
-> EpochState era
-> f (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InstantStake era -> f (InstantStake era))
-> LedgerState era -> f (LedgerState era)
forall era. Lens' (LedgerState era) (InstantStake era)
forall (t :: * -> *) era.
CanSetInstantStake t =>
Lens' (t era) (InstantStake era)
instantStakeL
  {-# INLINE instantStakeL #-}

instance CanGetChainAccountState EpochState

instance CanSetChainAccountState EpochState where
  chainAccountStateL :: forall era. Lens' (EpochState era) ChainAccountState
chainAccountStateL = (EpochState era -> ChainAccountState)
-> (EpochState era -> ChainAccountState -> EpochState era)
-> forall {f :: * -> *}.
   Functor f =>
   (ChainAccountState -> f ChainAccountState)
   -> EpochState era -> f (EpochState era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens EpochState era -> ChainAccountState
forall era. EpochState era -> ChainAccountState
esChainAccountState ((EpochState era -> ChainAccountState -> EpochState era)
 -> forall {f :: * -> *}.
    Functor f =>
    (ChainAccountState -> f ChainAccountState)
    -> EpochState era -> f (EpochState era))
-> (EpochState era -> ChainAccountState -> EpochState era)
-> forall {f :: * -> *}.
   Functor f =>
   (ChainAccountState -> f ChainAccountState)
   -> EpochState era -> f (EpochState era)
forall a b. (a -> b) -> a -> b
$ \EpochState era
es ChainAccountState
cas -> EpochState era
es {esChainAccountState = cas}
  {-# INLINE chainAccountStateL #-}

deriving stock instance
  ( EraTxOut era
  , Show (GovState era)
  , Show (CertState era)
  , Show (InstantStake era)
  ) =>
  Show (EpochState era)

deriving stock instance
  ( EraTxOut era
  , Eq (GovState era)
  , Eq (CertState era)
  , Eq (InstantStake era)
  ) =>
  Eq (EpochState era)

instance
  ( EraTxOut era
  , NoThunks (GovState era)
  , NoThunks (CertState era)
  , NoThunks (InstantStake era)
  ) =>
  NoThunks (EpochState era)

instance
  ( EraTxOut era
  , NFData (GovState era)
  , NFData (CertState era)
  , NFData (InstantStake era)
  ) =>
  NFData (EpochState era)

instance
  ( EraTxOut era
  , EraStake era
  , EncCBOR (GovState era)
  , EncCBOR (CertState era)
  ) =>
  EncCBOR (EpochState era)
  where
  encCBOR :: EpochState era -> Encoding
encCBOR EpochState {ChainAccountState
esChainAccountState :: forall era. EpochState era -> ChainAccountState
esChainAccountState :: ChainAccountState
esChainAccountState, LedgerState era
esLState :: forall era. EpochState era -> LedgerState era
esLState :: LedgerState era
esLState, SnapShots
esSnapshots :: forall era. EpochState era -> SnapShots
esSnapshots :: SnapShots
esSnapshots, NonMyopic
esNonMyopic :: forall era. EpochState era -> NonMyopic
esNonMyopic :: NonMyopic
esNonMyopic} =
    Encode ('Closed 'Dense) (EpochState era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) (EpochState era) -> Encoding)
-> Encode ('Closed 'Dense) (EpochState era) -> Encoding
forall a b. (a -> b) -> a -> b
$
      (ChainAccountState
 -> LedgerState era -> SnapShots -> NonMyopic -> EpochState era)
-> Encode
     ('Closed 'Dense)
     (ChainAccountState
      -> LedgerState era -> SnapShots -> NonMyopic -> EpochState era)
forall t. t -> Encode ('Closed 'Dense) t
Rec ChainAccountState
-> LedgerState era -> SnapShots -> NonMyopic -> EpochState era
forall era.
ChainAccountState
-> LedgerState era -> SnapShots -> NonMyopic -> EpochState era
EpochState
        Encode
  ('Closed 'Dense)
  (ChainAccountState
   -> LedgerState era -> SnapShots -> NonMyopic -> EpochState era)
-> Encode ('Closed 'Dense) ChainAccountState
-> Encode
     ('Closed 'Dense)
     (LedgerState era -> SnapShots -> NonMyopic -> EpochState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> ChainAccountState -> Encode ('Closed 'Dense) ChainAccountState
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To ChainAccountState
esChainAccountState
        Encode
  ('Closed 'Dense)
  (LedgerState era -> SnapShots -> NonMyopic -> EpochState era)
-> Encode ('Closed 'Dense) (LedgerState era)
-> Encode
     ('Closed 'Dense) (SnapShots -> NonMyopic -> EpochState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> LedgerState era -> Encode ('Closed 'Dense) (LedgerState era)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To LedgerState era
esLState -- We get better sharing when encoding ledger state before snaphots
        Encode ('Closed 'Dense) (SnapShots -> NonMyopic -> EpochState era)
-> Encode ('Closed 'Dense) SnapShots
-> Encode ('Closed 'Dense) (NonMyopic -> EpochState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> SnapShots -> Encode ('Closed 'Dense) SnapShots
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To SnapShots
esSnapshots
        Encode ('Closed 'Dense) (NonMyopic -> EpochState era)
-> Encode ('Closed 'Dense) NonMyopic
-> Encode ('Closed 'Dense) (EpochState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> NonMyopic -> Encode ('Closed 'Dense) NonMyopic
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To NonMyopic
esNonMyopic

instance
  ( EraTxOut era
  , EraGov era
  , EraStake era
  , EraCertState era
  ) =>
  DecCBOR (EpochState era)
  where
  decCBOR :: forall s. Decoder s (EpochState era)
decCBOR =
    Text
-> (EpochState era -> Int)
-> Decoder s (EpochState era)
-> Decoder s (EpochState era)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"EpochState" (Int -> EpochState era -> Int
forall a b. a -> b -> a
const Int
4) (Decoder s (EpochState era) -> Decoder s (EpochState era))
-> Decoder s (EpochState era) -> Decoder s (EpochState era)
forall a b. (a -> b) -> a -> b
$
      (StateT
   (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
    Interns (Credential 'DRepRole),
    Interns (Credential 'HotCommitteeRole))
   (Decoder s)
   (EpochState era)
 -> (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
     Interns (Credential 'DRepRole),
     Interns (Credential 'HotCommitteeRole))
 -> Decoder s (EpochState era))
-> (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
    Interns (Credential 'DRepRole),
    Interns (Credential 'HotCommitteeRole))
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     (Decoder s)
     (EpochState era)
-> Decoder s (EpochState era)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT
  (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
   Interns (Credential 'DRepRole),
   Interns (Credential 'HotCommitteeRole))
  (Decoder s)
  (EpochState era)
-> (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
    Interns (Credential 'DRepRole),
    Interns (Credential 'HotCommitteeRole))
-> Decoder s (EpochState era)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
 Interns (Credential 'DRepRole),
 Interns (Credential 'HotCommitteeRole))
forall a. Monoid a => a
mempty (StateT
   (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
    Interns (Credential 'DRepRole),
    Interns (Credential 'HotCommitteeRole))
   (Decoder s)
   (EpochState era)
 -> Decoder s (EpochState era))
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     (Decoder s)
     (EpochState era)
-> Decoder s (EpochState era)
forall a b. (a -> b) -> a -> b
$ do
        ChainAccountState
esChainAccountState <- Decoder s ChainAccountState
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     (Decoder s)
     ChainAccountState
forall (m :: * -> *) a.
Monad m =>
m a
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Decoder s ChainAccountState
forall s. Decoder s ChainAccountState
forall a s. DecCBOR a => Decoder s a
decCBOR
        LedgerState era
esLState <- StateT
  (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
   Interns (Credential 'DRepRole),
   Interns (Credential 'HotCommitteeRole))
  (Decoder s)
  (LedgerState era)
StateT (Share (LedgerState era)) (Decoder s) (LedgerState era)
forall s.
StateT (Share (LedgerState era)) (Decoder s) (LedgerState era)
forall a s. DecShareCBOR a => StateT (Share a) (Decoder s) a
decSharePlusCBOR
        SnapShots
esSnapshots <-
          Lens'
  (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
   Interns (Credential 'DRepRole),
   Interns (Credential 'HotCommitteeRole))
  (Share SnapShots)
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     (Decoder s)
     SnapShots
forall b bs s.
DecShareCBOR b =>
Lens' bs (Share b) -> StateT bs (Decoder s) b
decSharePlusLensCBOR (Lens'
   (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
    Interns (Credential 'DRepRole),
    Interns (Credential 'HotCommitteeRole))
   (Share SnapShots)
 -> StateT
      (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
       Interns (Credential 'DRepRole),
       Interns (Credential 'HotCommitteeRole))
      (Decoder s)
      SnapShots)
-> Lens'
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     (Share SnapShots)
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     (Decoder s)
     SnapShots
forall a b. (a -> b) -> a -> b
$
            ((Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
  Interns (Credential 'DRepRole),
  Interns (Credential 'HotCommitteeRole))
 -> (Interns (Credential 'Staking), Interns (KeyHash 'StakePool)))
-> ((Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
     Interns (Credential 'DRepRole),
     Interns (Credential 'HotCommitteeRole))
    -> (Interns (Credential 'Staking), Interns (KeyHash 'StakePool))
    -> (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
        Interns (Credential 'DRepRole),
        Interns (Credential 'HotCommitteeRole)))
-> Lens
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool))
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(Interns (Credential 'Staking)
cs, Interns (KeyHash 'StakePool)
ks, Interns (Credential 'DRepRole)
_, Interns (Credential 'HotCommitteeRole)
_) -> (Interns (Credential 'Staking)
cs, Interns (KeyHash 'StakePool)
ks)) (\(Interns (Credential 'Staking)
_, Interns (KeyHash 'StakePool)
_, Interns (Credential 'DRepRole)
cd, Interns (Credential 'HotCommitteeRole)
ch) (Interns (Credential 'Staking)
cs, Interns (KeyHash 'StakePool)
ks) -> (Interns (Credential 'Staking)
cs, Interns (KeyHash 'StakePool)
ks, Interns (Credential 'DRepRole)
cd, Interns (Credential 'HotCommitteeRole)
ch))
        NonMyopic
esNonMyopic <- SimpleGetter
  (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
   Interns (Credential 'DRepRole),
   Interns (Credential 'HotCommitteeRole))
  (Share NonMyopic)
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     (Decoder s)
     NonMyopic
forall b bs s.
DecShareCBOR b =>
SimpleGetter bs (Share b) -> StateT bs (Decoder s) b
decShareLensCBOR (Share NonMyopic -> Const r (Share NonMyopic))
-> (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
    Interns (Credential 'DRepRole),
    Interns (Credential 'HotCommitteeRole))
-> Const
     r
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
(Interns (KeyHash 'StakePool)
 -> Const r (Interns (KeyHash 'StakePool)))
-> (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
    Interns (Credential 'DRepRole),
    Interns (Credential 'HotCommitteeRole))
-> Const
     r
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
SimpleGetter
  (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
   Interns (Credential 'DRepRole),
   Interns (Credential 'HotCommitteeRole))
  (Share NonMyopic)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
   Interns (Credential 'DRepRole),
   Interns (Credential 'HotCommitteeRole))
  (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
   Interns (Credential 'DRepRole),
   Interns (Credential 'HotCommitteeRole))
  (Interns (KeyHash 'StakePool))
  (Interns (KeyHash 'StakePool))
_2
        EpochState era
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     (Decoder s)
     (EpochState era)
forall a.
a
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     (Decoder s)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EpochState {ChainAccountState
esChainAccountState :: ChainAccountState
esChainAccountState :: ChainAccountState
esChainAccountState, SnapShots
esSnapshots :: SnapShots
esSnapshots :: SnapShots
esSnapshots, LedgerState era
esLState :: LedgerState era
esLState :: LedgerState era
esLState, NonMyopic
esNonMyopic :: NonMyopic
esNonMyopic :: NonMyopic
esNonMyopic}

instance (EraTxOut era, EraGov era, EraStake era, EraCertState era) => ToCBOR (EpochState era) where
  toCBOR :: EpochState era -> Encoding
toCBOR = forall era t. (Era era, EncCBOR t) => t -> Encoding
toEraCBOR @era

instance (EraTxOut era, EraGov era, EraStake era, EraCertState era) => FromCBOR (EpochState era) where
  fromCBOR :: forall s. Decoder s (EpochState era)
fromCBOR = forall era t s. (Era era, DecCBOR t) => Decoder s t
fromEraCBOR @era

instance (EraTxOut era, EraGov era, EraStake era, EraCertState era) => ToJSON (EpochState era) where
  toJSON :: EpochState era -> Value
toJSON = [Pair] -> Value
object ([Pair] -> Value)
-> (EpochState era -> [Pair]) -> EpochState era -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochState era -> [Pair]
forall era e a.
(EraTxOut era, EraGov era, EraStake era, KeyValue e a,
 EraCertState era) =>
EpochState era -> [a]
toEpochStatePairs
  toEncoding :: EpochState era -> Encoding
toEncoding = Series -> Encoding
pairs (Series -> Encoding)
-> (EpochState era -> Series) -> EpochState era -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series)
-> (EpochState era -> [Series]) -> EpochState era -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochState era -> [Series]
forall era e a.
(EraTxOut era, EraGov era, EraStake era, KeyValue e a,
 EraCertState era) =>
EpochState era -> [a]
toEpochStatePairs

toEpochStatePairs ::
  ( EraTxOut era
  , EraGov era
  , EraStake era
  , KeyValue e a
  , EraCertState era
  ) =>
  EpochState era ->
  [a]
toEpochStatePairs :: forall era e a.
(EraTxOut era, EraGov era, EraStake era, KeyValue e a,
 EraCertState era) =>
EpochState era -> [a]
toEpochStatePairs es :: EpochState era
es@(EpochState ChainAccountState
_ LedgerState era
_ SnapShots
_ NonMyopic
_) =
  let EpochState {ChainAccountState
SnapShots
NonMyopic
LedgerState era
esChainAccountState :: forall era. EpochState era -> ChainAccountState
esLState :: forall era. EpochState era -> LedgerState era
esSnapshots :: forall era. EpochState era -> SnapShots
esNonMyopic :: forall era. EpochState era -> NonMyopic
esChainAccountState :: ChainAccountState
esLState :: LedgerState era
esSnapshots :: SnapShots
esNonMyopic :: NonMyopic
..} = EpochState era
es
   in [ Key
"esChainAccountState" Key -> ChainAccountState -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ChainAccountState
esChainAccountState
      , Key
"esSnapshots" Key -> SnapShots -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SnapShots
esSnapshots
      , Key
"esLState" Key -> LedgerState era -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= LedgerState era
esLState
      , Key
"esNonMyopic" Key -> NonMyopic -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NonMyopic
esNonMyopic
      ]

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

-- | There is a serious invariant that we must maintain in the UTxOState.
--   Given (UTxOState utxo _ _ _ istake) it must be the case that
--   Of course computing the RHS of the above equality can be very expensive, so we only
--   use this route in the testing function smartUTxO. But we are very careful, wherever
--   we update the UTxO, we carefully make INCREMENTAL changes to istake to maintain
--   this invariant. This happens in the UTxO rule.
data UTxOState era = UTxOState
  { forall era. UTxOState era -> UTxO era
utxosUtxo :: !(UTxO era)
  , forall era. UTxOState era -> Coin
utxosDeposited :: !Coin
  , forall era. UTxOState era -> Coin
utxosFees :: !Coin
  , forall era. UTxOState era -> GovState era
utxosGovState :: !(GovState era)
  , forall era. UTxOState era -> InstantStake era
utxosInstantStake :: !(InstantStake era)
  , forall era. UTxOState era -> Coin
utxosDonation :: !Coin
  }
  deriving ((forall x. UTxOState era -> Rep (UTxOState era) x)
-> (forall x. Rep (UTxOState era) x -> UTxOState era)
-> Generic (UTxOState era)
forall x. Rep (UTxOState era) x -> UTxOState era
forall x. UTxOState era -> Rep (UTxOState era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (UTxOState era) x -> UTxOState era
forall era x. UTxOState era -> Rep (UTxOState era) x
$cfrom :: forall era x. UTxOState era -> Rep (UTxOState era) x
from :: forall x. UTxOState era -> Rep (UTxOState era) x
$cto :: forall era x. Rep (UTxOState era) x -> UTxOState era
to :: forall x. Rep (UTxOState era) x -> UTxOState era
Generic)

instance CanGetUTxO UTxOState

instance CanSetUTxO UTxOState where
  utxoL :: forall era. Lens' (UTxOState era) (UTxO era)
utxoL = (UTxOState era -> UTxO era)
-> (UTxOState era -> UTxO era -> UTxOState era)
-> forall {f :: * -> *}.
   Functor f =>
   (UTxO era -> f (UTxO era)) -> UTxOState era -> f (UTxOState era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens UTxOState era -> UTxO era
forall era. UTxOState era -> UTxO era
utxosUtxo ((UTxOState era -> UTxO era -> UTxOState era)
 -> forall {f :: * -> *}.
    Functor f =>
    (UTxO era -> f (UTxO era)) -> UTxOState era -> f (UTxOState era))
-> (UTxOState era -> UTxO era -> UTxOState era)
-> forall {f :: * -> *}.
   Functor f =>
   (UTxO era -> f (UTxO era)) -> UTxOState era -> f (UTxOState era)
forall a b. (a -> b) -> a -> b
$ \UTxOState era
s UTxO era
u -> UTxOState era
s {utxosUtxo = u}
  {-# INLINE utxoL #-}

instance CanGetInstantStake UTxOState

instance CanSetInstantStake UTxOState where
  instantStakeL :: forall era. Lens' (UTxOState era) (InstantStake era)
instantStakeL = (UTxOState era -> InstantStake era)
-> (UTxOState era -> InstantStake era -> UTxOState era)
-> forall {f :: * -> *}.
   Functor f =>
   (InstantStake era -> f (InstantStake era))
   -> UTxOState era -> f (UTxOState era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens UTxOState era -> InstantStake era
forall era. UTxOState era -> InstantStake era
utxosInstantStake ((UTxOState era -> InstantStake era -> UTxOState era)
 -> forall {f :: * -> *}.
    Functor f =>
    (InstantStake era -> f (InstantStake era))
    -> UTxOState era -> f (UTxOState era))
-> (UTxOState era -> InstantStake era -> UTxOState era)
-> forall {f :: * -> *}.
   Functor f =>
   (InstantStake era -> f (InstantStake era))
   -> UTxOState era -> f (UTxOState era)
forall a b. (a -> b) -> a -> b
$ \UTxOState era
s InstantStake era
is -> UTxOState era
s {utxosInstantStake = is}
  {-# INLINE instantStakeL #-}

instance
  ( EraTxOut era
  , NFData (GovState era)
  , NFData (InstantStake era)
  ) =>
  NFData (UTxOState era)

deriving stock instance
  ( EraTxOut era
  , Show (GovState era)
  , Show (InstantStake era)
  ) =>
  Show (UTxOState era)

deriving stock instance
  ( EraTxOut era
  , Eq (GovState era)
  , Eq (InstantStake era)
  ) =>
  Eq (UTxOState era)

instance
  ( NoThunks (UTxO era)
  , NoThunks (GovState era)
  , NoThunks (InstantStake era)
  ) =>
  NoThunks (UTxOState era)

instance
  ( EraTxOut era
  , EraStake era
  , EncCBOR (GovState era)
  ) =>
  EncCBOR (UTxOState era)
  where
  encCBOR :: UTxOState era -> Encoding
encCBOR utxos :: UTxOState era
utxos@(UTxOState UTxO era
_ Coin
_ Coin
_ GovState era
_ InstantStake era
_ Coin
_) =
    let UTxOState {Coin
UTxO era
InstantStake era
GovState era
utxosUtxo :: forall era. UTxOState era -> UTxO era
utxosDeposited :: forall era. UTxOState era -> Coin
utxosFees :: forall era. UTxOState era -> Coin
utxosGovState :: forall era. UTxOState era -> GovState era
utxosInstantStake :: forall era. UTxOState era -> InstantStake era
utxosDonation :: forall era. UTxOState era -> Coin
utxosUtxo :: UTxO era
utxosDeposited :: Coin
utxosFees :: Coin
utxosGovState :: GovState era
utxosInstantStake :: InstantStake era
utxosDonation :: Coin
..} = UTxOState era
utxos
     in Encode ('Closed 'Dense) (UTxOState era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) (UTxOState era) -> Encoding)
-> Encode ('Closed 'Dense) (UTxOState era) -> Encoding
forall a b. (a -> b) -> a -> b
$
          (UTxO era
 -> Coin
 -> Coin
 -> GovState era
 -> InstantStake era
 -> Coin
 -> UTxOState era)
-> Encode
     ('Closed 'Dense)
     (UTxO era
      -> Coin
      -> Coin
      -> GovState era
      -> InstantStake era
      -> Coin
      -> UTxOState era)
forall t. t -> Encode ('Closed 'Dense) t
Rec UTxO era
-> Coin
-> Coin
-> GovState era
-> InstantStake era
-> Coin
-> UTxOState era
forall era.
UTxO era
-> Coin
-> Coin
-> GovState era
-> InstantStake era
-> Coin
-> UTxOState era
UTxOState
            -- We need to define encoder with MemPack manually here instead of changing the `EncCBOR`
            -- instance for `UTxO` in order to not affect some of the ledger state queries.
            Encode
  ('Closed 'Dense)
  (UTxO era
   -> Coin
   -> Coin
   -> GovState era
   -> InstantStake era
   -> Coin
   -> UTxOState era)
-> Encode ('Closed 'Dense) (UTxO era)
-> Encode
     ('Closed 'Dense)
     (Coin
      -> Coin
      -> GovState era
      -> InstantStake era
      -> Coin
      -> UTxOState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (UTxO era -> Encoding)
-> UTxO era -> Encode ('Closed 'Dense) (UTxO era)
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E ((TxIn -> Encoding)
-> (TxOut era -> Encoding) -> Map TxIn (TxOut era) -> Encoding
forall k v.
(k -> Encoding) -> (v -> Encoding) -> Map k v -> Encoding
encodeMap TxIn -> Encoding
forall a. MemPack a => a -> Encoding
encodeMemPack TxOut era -> Encoding
forall a. MemPack a => a -> Encoding
encodeMemPack (Map TxIn (TxOut era) -> Encoding)
-> (UTxO era -> Map TxIn (TxOut era)) -> UTxO era -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO era -> Map TxIn (TxOut era)
forall era. UTxO era -> Map TxIn (TxOut era)
unUTxO) UTxO era
utxosUtxo
            Encode
  ('Closed 'Dense)
  (Coin
   -> Coin
   -> GovState era
   -> InstantStake era
   -> Coin
   -> UTxOState era)
-> Encode ('Closed 'Dense) Coin
-> Encode
     ('Closed 'Dense)
     (Coin -> GovState era -> InstantStake era -> Coin -> UTxOState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Coin -> Encode ('Closed 'Dense) Coin
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
utxosDeposited
            Encode
  ('Closed 'Dense)
  (Coin -> GovState era -> InstantStake era -> Coin -> UTxOState era)
-> Encode ('Closed 'Dense) Coin
-> Encode
     ('Closed 'Dense)
     (GovState era -> InstantStake era -> Coin -> UTxOState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Coin -> Encode ('Closed 'Dense) Coin
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
utxosFees
            Encode
  ('Closed 'Dense)
  (GovState era -> InstantStake era -> Coin -> UTxOState era)
-> Encode ('Closed 'Dense) (GovState era)
-> Encode
     ('Closed 'Dense) (InstantStake era -> Coin -> UTxOState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> GovState era -> Encode ('Closed 'Dense) (GovState era)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To GovState era
utxosGovState
            Encode ('Closed 'Dense) (InstantStake era -> Coin -> UTxOState era)
-> Encode ('Closed 'Dense) (InstantStake era)
-> Encode ('Closed 'Dense) (Coin -> UTxOState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> InstantStake era -> Encode ('Closed 'Dense) (InstantStake era)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To InstantStake era
utxosInstantStake
            Encode ('Closed 'Dense) (Coin -> UTxOState era)
-> Encode ('Closed 'Dense) Coin
-> Encode ('Closed 'Dense) (UTxOState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Coin -> Encode ('Closed 'Dense) Coin
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
utxosDonation

instance (EraTxOut era, EraGov era, EraStake era) => DecShareCBOR (UTxOState era) where
  type
    Share (UTxOState era) =
      ( Interns (Credential 'Staking)
      , Interns (KeyHash 'StakePool)
      , Interns (Credential 'DRepRole)
      , Interns (Credential 'HotCommitteeRole)
      )
  decShareCBOR :: forall s. Share (UTxOState era) -> Decoder s (UTxOState era)
decShareCBOR is :: Share (UTxOState era)
is@(Interns (Credential 'Staking)
cs, Interns (KeyHash 'StakePool)
_, Interns (Credential 'DRepRole)
_, Interns (Credential 'HotCommitteeRole)
_) =
    Text
-> (UTxOState era -> Int)
-> Decoder s (UTxOState era)
-> Decoder s (UTxOState era)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"UTxOState" (Int -> UTxOState era -> Int
forall a b. a -> b -> a
const Int
6) (Decoder s (UTxOState era) -> Decoder s (UTxOState era))
-> Decoder s (UTxOState era) -> Decoder s (UTxOState era)
forall a b. (a -> b) -> a -> b
$ do
      UTxO era
utxosUtxo <- Share (UTxO era) -> Decoder s (UTxO era)
forall a s. DecShareCBOR a => Share a -> Decoder s a
forall s. Share (UTxO era) -> Decoder s (UTxO era)
decShareCBOR Share (UTxO era)
Interns (Credential 'Staking)
cs
      Coin
utxosDeposited <- Decoder s Coin
forall s. Decoder s Coin
forall a s. DecCBOR a => Decoder s a
decCBOR
      Coin
utxosFees <- Decoder s Coin
forall s. Decoder s Coin
forall a s. DecCBOR a => Decoder s a
decCBOR
      GovState era
utxosGovState <- Share (GovState era) -> Decoder s (GovState era)
forall a s. DecShareCBOR a => Share a -> Decoder s a
forall s. Share (GovState era) -> Decoder s (GovState era)
decShareCBOR Share (GovState era)
Share (UTxOState era)
is
      InstantStake era
utxosInstantStake <- Share (InstantStake era) -> Decoder s (InstantStake era)
forall a s. DecShareCBOR a => Share a -> Decoder s a
forall s. Share (InstantStake era) -> Decoder s (InstantStake era)
decShareCBOR Share (InstantStake era)
Interns (Credential 'Staking)
cs
      Coin
utxosDonation <- Decoder s Coin
forall s. Decoder s Coin
forall a s. DecCBOR a => Decoder s a
decCBOR
      UTxOState era -> Decoder s (UTxOState era)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UTxOState {Coin
UTxO era
InstantStake era
GovState era
utxosUtxo :: UTxO era
utxosDeposited :: Coin
utxosFees :: Coin
utxosGovState :: GovState era
utxosInstantStake :: InstantStake era
utxosDonation :: Coin
utxosUtxo :: UTxO era
utxosDeposited :: Coin
utxosFees :: Coin
utxosGovState :: GovState era
utxosInstantStake :: InstantStake era
utxosDonation :: Coin
..}

instance (EraTxOut era, EraGov era, EraStake era) => ToCBOR (UTxOState era) where
  toCBOR :: UTxOState era -> Encoding
toCBOR = forall era t. (Era era, EncCBOR t) => t -> Encoding
toEraCBOR @era

instance (EraTxOut era, EraGov era, EraStake era) => FromCBOR (UTxOState era) where
  fromCBOR :: forall s. Decoder s (UTxOState era)
fromCBOR = forall era t s. (Era era, DecShareCBOR t) => Decoder s t
fromEraShareCBOR @era

instance (EraTxOut era, EraGov era, EraStake era) => ToJSON (UTxOState era) where
  toJSON :: UTxOState era -> Value
toJSON = [Pair] -> Value
object ([Pair] -> Value)
-> (UTxOState era -> [Pair]) -> UTxOState era -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxOState era -> [Pair]
forall era e a.
(EraTxOut era, EraGov era, EraStake era, KeyValue e a) =>
UTxOState era -> [a]
toUTxOStatePairs
  toEncoding :: UTxOState era -> Encoding
toEncoding = Series -> Encoding
pairs (Series -> Encoding)
-> (UTxOState era -> Series) -> UTxOState era -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series)
-> (UTxOState era -> [Series]) -> UTxOState era -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxOState era -> [Series]
forall era e a.
(EraTxOut era, EraGov era, EraStake era, KeyValue e a) =>
UTxOState era -> [a]
toUTxOStatePairs

toUTxOStatePairs ::
  (EraTxOut era, EraGov era, EraStake era, KeyValue e a) => UTxOState era -> [a]
toUTxOStatePairs :: forall era e a.
(EraTxOut era, EraGov era, EraStake era, KeyValue e a) =>
UTxOState era -> [a]
toUTxOStatePairs utxoState :: UTxOState era
utxoState@(UTxOState UTxO era
_ Coin
_ Coin
_ GovState era
_ InstantStake era
_ Coin
_) =
  let UTxOState {Coin
UTxO era
InstantStake era
GovState era
utxosUtxo :: forall era. UTxOState era -> UTxO era
utxosDeposited :: forall era. UTxOState era -> Coin
utxosFees :: forall era. UTxOState era -> Coin
utxosGovState :: forall era. UTxOState era -> GovState era
utxosInstantStake :: forall era. UTxOState era -> InstantStake era
utxosDonation :: forall era. UTxOState era -> Coin
utxosUtxo :: UTxO era
utxosDeposited :: Coin
utxosFees :: Coin
utxosGovState :: GovState era
utxosInstantStake :: InstantStake era
utxosDonation :: Coin
..} = UTxOState era
utxoState
   in [ Key
"utxo" Key -> UTxO era -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UTxO era
utxosUtxo
      , Key
"deposited" Key -> Coin -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin
utxosDeposited
      , Key
"fees" Key -> Coin -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin
utxosFees
      , Key
"ppups" Key -> GovState era -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= GovState era
utxosGovState
      , Key
"stake" Key -> InstantStake era -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= InstantStake era
utxosInstantStake
      ]

-- | New Epoch state and environment
data NewEpochState era = NewEpochState
  { forall era. NewEpochState era -> EpochNo
nesEL :: !EpochNo
  -- ^ Number of the epoch when this NewEpochState was modified last. With respect to
  -- block and transactions validation this will always be the current epoch
  -- number. However, when it comes to the TICK rule, it will be the epoch number of the
  -- previous epoch whenever we are crossing the epoch boundary.
  , forall era. NewEpochState era -> BlocksMade
nesBprev :: !BlocksMade
  -- ^ Blocks made before current epoch
  , forall era. NewEpochState era -> BlocksMade
nesBcur :: !BlocksMade
  -- ^ Blocks made in current epoch
  , forall era. NewEpochState era -> EpochState era
nesEs :: !(EpochState era)
  -- ^ Epoch state
  , forall era. NewEpochState era -> StrictMaybe PulsingRewUpdate
nesRu :: !(StrictMaybe PulsingRewUpdate)
  -- ^ Possible reward update
  , forall era. NewEpochState era -> PoolDistr
nesPd :: !PoolDistr
  -- ^ Stake distribution within the stake pool
  , forall era. NewEpochState era -> StashedAVVMAddresses era
stashedAVVMAddresses :: !(StashedAVVMAddresses era)
  -- ^ AVVM addresses to be removed at the end of the Shelley era. Note that
  -- the existence of this field is a hack, related to the transition of UTxO
  -- to disk. We remove AVVM addresses from the UTxO on the Shelley/Allegra
  -- boundary. However, by this point the UTxO will be moved to disk, and
  -- hence doing a scan of the UTxO for AVVM addresses will be expensive. Our
  -- solution to this is to do a scan of the UTxO on the Byron/Shelley
  -- boundary (since Byron UTxO are still on disk), stash the results here,
  -- and then remove them at the Shelley/Allegra boundary.
  --
  -- This is very much an awkward implementation hack, and hence we hide it
  -- from as many places as possible.
  }
  deriving ((forall x. NewEpochState era -> Rep (NewEpochState era) x)
-> (forall x. Rep (NewEpochState era) x -> NewEpochState era)
-> Generic (NewEpochState era)
forall x. Rep (NewEpochState era) x -> NewEpochState era
forall x. NewEpochState era -> Rep (NewEpochState era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (NewEpochState era) x -> NewEpochState era
forall era x. NewEpochState era -> Rep (NewEpochState era) x
$cfrom :: forall era x. NewEpochState era -> Rep (NewEpochState era) x
from :: forall x. NewEpochState era -> Rep (NewEpochState era) x
$cto :: forall era x. Rep (NewEpochState era) x -> NewEpochState era
to :: forall x. Rep (NewEpochState era) x -> NewEpochState era
Generic)

instance CanGetUTxO NewEpochState

instance CanSetUTxO NewEpochState where
  utxoL :: forall era. Lens' (NewEpochState era) (UTxO era)
utxoL = (NewEpochState era -> EpochState era)
-> (NewEpochState era -> EpochState era -> NewEpochState era)
-> Lens
     (NewEpochState era)
     (NewEpochState era)
     (EpochState era)
     (EpochState era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs (\NewEpochState era
s EpochState era
es -> NewEpochState era
s {nesEs = es}) ((EpochState era -> f (EpochState era))
 -> NewEpochState era -> f (NewEpochState era))
-> ((UTxO era -> f (UTxO era))
    -> EpochState era -> f (EpochState era))
-> (UTxO era -> f (UTxO era))
-> NewEpochState era
-> f (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTxO era -> f (UTxO era)) -> EpochState era -> f (EpochState era)
forall era. Lens' (EpochState era) (UTxO era)
forall (t :: * -> *) era. CanSetUTxO t => Lens' (t era) (UTxO era)
utxoL
  {-# INLINE utxoL #-}

instance CanGetInstantStake NewEpochState

instance CanSetInstantStake NewEpochState where
  instantStakeL :: forall era. Lens' (NewEpochState era) (InstantStake era)
instantStakeL = (NewEpochState era -> EpochState era)
-> (NewEpochState era -> EpochState era -> NewEpochState era)
-> Lens
     (NewEpochState era)
     (NewEpochState era)
     (EpochState era)
     (EpochState era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs (\NewEpochState era
s EpochState era
es -> NewEpochState era
s {nesEs = es}) ((EpochState era -> f (EpochState era))
 -> NewEpochState era -> f (NewEpochState era))
-> ((InstantStake era -> f (InstantStake era))
    -> EpochState era -> f (EpochState era))
-> (InstantStake era -> f (InstantStake era))
-> NewEpochState era
-> f (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InstantStake era -> f (InstantStake era))
-> EpochState era -> f (EpochState era)
forall era. Lens' (EpochState era) (InstantStake era)
forall (t :: * -> *) era.
CanSetInstantStake t =>
Lens' (t era) (InstantStake era)
instantStakeL
  {-# INLINE instantStakeL #-}

instance CanGetChainAccountState NewEpochState

instance CanSetChainAccountState NewEpochState where
  chainAccountStateL :: forall era. Lens' (NewEpochState era) ChainAccountState
chainAccountStateL = (NewEpochState era -> EpochState era)
-> (NewEpochState era -> EpochState era -> NewEpochState era)
-> Lens
     (NewEpochState era)
     (NewEpochState era)
     (EpochState era)
     (EpochState era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs (\NewEpochState era
s EpochState era
es -> NewEpochState era
s {nesEs = es}) ((EpochState era -> f (EpochState era))
 -> NewEpochState era -> f (NewEpochState era))
-> ((ChainAccountState -> f ChainAccountState)
    -> EpochState era -> f (EpochState era))
-> (ChainAccountState -> f ChainAccountState)
-> NewEpochState era
-> f (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChainAccountState -> f ChainAccountState)
-> EpochState era -> f (EpochState era)
forall era. Lens' (EpochState era) ChainAccountState
forall (t :: * -> *) era.
CanSetChainAccountState t =>
Lens' (t era) ChainAccountState
chainAccountStateL
  {-# INLINE chainAccountStateL #-}

type family StashedAVVMAddresses era where
  StashedAVVMAddresses ShelleyEra = UTxO ShelleyEra
  StashedAVVMAddresses _ = ()

deriving stock instance
  ( EraTxOut era
  , Show (StashedAVVMAddresses era)
  , Show (GovState era)
  , Show (CertState era)
  , Show (InstantStake era)
  ) =>
  Show (NewEpochState era)

deriving stock instance
  ( EraTxOut era
  , Eq (StashedAVVMAddresses era)
  , Eq (GovState era)
  , Eq (CertState era)
  , Eq (InstantStake era)
  ) =>
  Eq (NewEpochState era)

instance
  ( EraTxOut era
  , NFData (StashedAVVMAddresses era)
  , NFData (GovState era)
  , NFData (CertState era)
  , NFData (InstantStake era)
  ) =>
  NFData (NewEpochState era)

instance
  ( EraTxOut era
  , EraStake era
  , EncCBOR (StashedAVVMAddresses era)
  , EncCBOR (GovState era)
  , EncCBOR (CertState era)
  ) =>
  EncCBOR (NewEpochState era)
  where
  encCBOR :: NewEpochState era -> Encoding
encCBOR (NewEpochState EpochNo
e BlocksMade
bp BlocksMade
bc EpochState era
es StrictMaybe PulsingRewUpdate
ru PoolDistr
pd StashedAVVMAddresses era
av) =
    Word -> Encoding
encodeListLen Word
7
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> EpochNo -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR EpochNo
e
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> BlocksMade -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR BlocksMade
bp
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> BlocksMade -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR BlocksMade
bc
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> EpochState era -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR EpochState era
es
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> StrictMaybe PulsingRewUpdate -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR StrictMaybe PulsingRewUpdate
ru
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> PoolDistr -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR PoolDistr
pd
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> StashedAVVMAddresses era -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR StashedAVVMAddresses era
av

instance
  ( EraTxOut era
  , EraGov era
  , EraStake era
  , DecCBOR (StashedAVVMAddresses era)
  , EraCertState era
  ) =>
  DecCBOR (NewEpochState era)
  where
  decCBOR :: forall s. Decoder s (NewEpochState era)
decCBOR = do
    Decode ('Closed 'Dense) (NewEpochState era)
-> Decoder s (NewEpochState era)
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) (NewEpochState era)
 -> Decoder s (NewEpochState era))
-> Decode ('Closed 'Dense) (NewEpochState era)
-> Decoder s (NewEpochState era)
forall a b. (a -> b) -> a -> b
$
      (EpochNo
 -> BlocksMade
 -> BlocksMade
 -> EpochState era
 -> StrictMaybe PulsingRewUpdate
 -> PoolDistr
 -> StashedAVVMAddresses era
 -> NewEpochState era)
-> Decode
     ('Closed 'Dense)
     (EpochNo
      -> BlocksMade
      -> BlocksMade
      -> EpochState era
      -> StrictMaybe PulsingRewUpdate
      -> PoolDistr
      -> StashedAVVMAddresses era
      -> NewEpochState era)
forall t. t -> Decode ('Closed 'Dense) t
RecD 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
        Decode
  ('Closed 'Dense)
  (EpochNo
   -> BlocksMade
   -> BlocksMade
   -> EpochState era
   -> StrictMaybe PulsingRewUpdate
   -> PoolDistr
   -> StashedAVVMAddresses era
   -> NewEpochState era)
-> Decode ('Closed Any) EpochNo
-> Decode
     ('Closed 'Dense)
     (BlocksMade
      -> BlocksMade
      -> EpochState era
      -> StrictMaybe PulsingRewUpdate
      -> PoolDistr
      -> StashedAVVMAddresses era
      -> NewEpochState era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) EpochNo
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (BlocksMade
   -> BlocksMade
   -> EpochState era
   -> StrictMaybe PulsingRewUpdate
   -> PoolDistr
   -> StashedAVVMAddresses era
   -> NewEpochState era)
-> Decode ('Closed Any) BlocksMade
-> Decode
     ('Closed 'Dense)
     (BlocksMade
      -> EpochState era
      -> StrictMaybe PulsingRewUpdate
      -> PoolDistr
      -> StashedAVVMAddresses era
      -> NewEpochState era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) BlocksMade
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (BlocksMade
   -> EpochState era
   -> StrictMaybe PulsingRewUpdate
   -> PoolDistr
   -> StashedAVVMAddresses era
   -> NewEpochState era)
-> Decode ('Closed Any) BlocksMade
-> Decode
     ('Closed 'Dense)
     (EpochState era
      -> StrictMaybe PulsingRewUpdate
      -> PoolDistr
      -> StashedAVVMAddresses era
      -> NewEpochState era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) BlocksMade
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (EpochState era
   -> StrictMaybe PulsingRewUpdate
   -> PoolDistr
   -> StashedAVVMAddresses era
   -> NewEpochState era)
-> Decode ('Closed Any) (EpochState era)
-> Decode
     ('Closed 'Dense)
     (StrictMaybe PulsingRewUpdate
      -> PoolDistr -> StashedAVVMAddresses era -> NewEpochState era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (EpochState era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (StrictMaybe PulsingRewUpdate
   -> PoolDistr -> StashedAVVMAddresses era -> NewEpochState era)
-> Decode ('Closed Any) (StrictMaybe PulsingRewUpdate)
-> Decode
     ('Closed 'Dense)
     (PoolDistr -> StashedAVVMAddresses era -> NewEpochState era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (StrictMaybe PulsingRewUpdate)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (PoolDistr -> StashedAVVMAddresses era -> NewEpochState era)
-> Decode ('Closed Any) PoolDistr
-> Decode
     ('Closed 'Dense) (StashedAVVMAddresses era -> NewEpochState era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) PoolDistr
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense) (StashedAVVMAddresses era -> NewEpochState era)
-> Decode ('Closed Any) (StashedAVVMAddresses era)
-> Decode ('Closed 'Dense) (NewEpochState era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (StashedAVVMAddresses era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From

instance
  (EraTxOut era, EraGov era, EraStake era, EraCertState era, EncCBOR (StashedAVVMAddresses era)) =>
  ToCBOR (NewEpochState era)
  where
  toCBOR :: NewEpochState era -> Encoding
toCBOR = forall era t. (Era era, EncCBOR t) => t -> Encoding
toEraCBOR @era

instance
  (EraTxOut era, EraGov era, EraStake era, EraCertState era, DecCBOR (StashedAVVMAddresses era)) =>
  FromCBOR (NewEpochState era)
  where
  fromCBOR :: forall s. Decoder s (NewEpochState era)
fromCBOR = forall era t s. (Era era, DecCBOR t) => Decoder s t
fromEraCBOR @era

instance
  ( Era era
  , NoThunks (EpochState era)
  , NoThunks (StashedAVVMAddresses era)
  ) =>
  NoThunks (NewEpochState era)

-- | The state associated with a 'Ledger'.
data LedgerState era = LedgerState
  { forall era. LedgerState era -> UTxOState era
lsUTxOState :: !(UTxOState era)
  -- ^ The current unspent transaction outputs.
  , forall era. LedgerState era -> CertState era
lsCertState :: !(CertState era)
  }
  deriving ((forall x. LedgerState era -> Rep (LedgerState era) x)
-> (forall x. Rep (LedgerState era) x -> LedgerState era)
-> Generic (LedgerState era)
forall x. Rep (LedgerState era) x -> LedgerState era
forall x. LedgerState era -> Rep (LedgerState era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (LedgerState era) x -> LedgerState era
forall era x. LedgerState era -> Rep (LedgerState era) x
$cfrom :: forall era x. LedgerState era -> Rep (LedgerState era) x
from :: forall x. LedgerState era -> Rep (LedgerState era) x
$cto :: forall era x. Rep (LedgerState era) x -> LedgerState era
to :: forall x. Rep (LedgerState era) x -> LedgerState era
Generic)

instance CanGetUTxO LedgerState

instance CanSetUTxO LedgerState where
  utxoL :: forall era. Lens' (LedgerState era) (UTxO era)
utxoL = (LedgerState era -> UTxOState era)
-> (LedgerState era -> UTxOState era -> LedgerState era)
-> Lens
     (LedgerState era) (LedgerState era) (UTxOState era) (UTxOState era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens LedgerState era -> UTxOState era
forall era. LedgerState era -> UTxOState era
lsUTxOState (\LedgerState era
s UTxOState era
us -> LedgerState era
s {lsUTxOState = us}) ((UTxOState era -> f (UTxOState era))
 -> LedgerState era -> f (LedgerState era))
-> ((UTxO era -> f (UTxO era))
    -> UTxOState era -> f (UTxOState era))
-> (UTxO era -> f (UTxO era))
-> LedgerState era
-> f (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTxO era -> f (UTxO era)) -> UTxOState era -> f (UTxOState era)
forall era. Lens' (UTxOState era) (UTxO era)
forall (t :: * -> *) era. CanSetUTxO t => Lens' (t era) (UTxO era)
utxoL
  {-# INLINE utxoL #-}

instance CanGetInstantStake LedgerState

instance CanSetInstantStake LedgerState where
  instantStakeL :: forall era. Lens' (LedgerState era) (InstantStake era)
instantStakeL = (LedgerState era -> UTxOState era)
-> (LedgerState era -> UTxOState era -> LedgerState era)
-> Lens
     (LedgerState era) (LedgerState era) (UTxOState era) (UTxOState era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens LedgerState era -> UTxOState era
forall era. LedgerState era -> UTxOState era
lsUTxOState (\LedgerState era
s UTxOState era
us -> LedgerState era
s {lsUTxOState = us}) ((UTxOState era -> f (UTxOState era))
 -> LedgerState era -> f (LedgerState era))
-> ((InstantStake era -> f (InstantStake era))
    -> UTxOState era -> f (UTxOState era))
-> (InstantStake era -> f (InstantStake era))
-> LedgerState era
-> f (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InstantStake era -> f (InstantStake era))
-> UTxOState era -> f (UTxOState era)
forall era. Lens' (UTxOState era) (InstantStake era)
forall (t :: * -> *) era.
CanSetInstantStake t =>
Lens' (t era) (InstantStake era)
instantStakeL
  {-# INLINE instantStakeL #-}

deriving stock instance
  ( EraTxOut era
  , Show (GovState era)
  , Show (CertState era)
  , Show (InstantStake era)
  ) =>
  Show (LedgerState era)

deriving stock instance
  ( EraTxOut era
  , Eq (GovState era)
  , Eq (CertState era)
  , Eq (InstantStake era)
  ) =>
  Eq (LedgerState era)

instance
  ( EraTxOut era
  , NoThunks (GovState era)
  , NoThunks (CertState era)
  , NoThunks (InstantStake era)
  ) =>
  NoThunks (LedgerState era)

instance
  ( EraTxOut era
  , NFData (GovState era)
  , NFData (CertState era)
  , NFData (InstantStake era)
  ) =>
  NFData (LedgerState era)

instance
  ( EraTxOut era
  , EraStake era
  , EncCBOR (GovState era)
  , EncCBOR (CertState era)
  ) =>
  EncCBOR (LedgerState era)
  where
  encCBOR :: LedgerState era -> Encoding
encCBOR LedgerState {UTxOState era
lsUTxOState :: forall era. LedgerState era -> UTxOState era
lsUTxOState :: UTxOState era
lsUTxOState, CertState era
lsCertState :: forall era. LedgerState era -> CertState era
lsCertState :: CertState era
lsCertState} =
    Word -> Encoding
encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CertState era -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR CertState era
lsCertState -- encode delegation state first to improve sharing
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> UTxOState era -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR UTxOState era
lsUTxOState

instance
  ( EraTxOut era
  , EraGov era
  , EraStake era
  , EraCertState era
  ) =>
  DecShareCBOR (LedgerState era)
  where
  type
    Share (LedgerState era) =
      ( Interns (Credential 'Staking)
      , Interns (KeyHash 'StakePool)
      , Interns (Credential 'DRepRole)
      , Interns (Credential 'HotCommitteeRole)
      )
  decSharePlusCBOR :: forall s.
StateT (Share (LedgerState era)) (Decoder s) (LedgerState era)
decSharePlusCBOR =
    Text
-> (LedgerState era -> Int)
-> StateT (Share (LedgerState era)) (Decoder s) (LedgerState era)
-> StateT (Share (LedgerState era)) (Decoder s) (LedgerState era)
forall (m :: (* -> *) -> * -> *) s a.
(MonadTrans m, Monad (m (Decoder s))) =>
Text -> (a -> Int) -> m (Decoder s) a -> m (Decoder s) a
decodeRecordNamedT Text
"LedgerState" (Int -> LedgerState era -> Int
forall a b. a -> b -> a
const Int
2) (StateT (Share (LedgerState era)) (Decoder s) (LedgerState era)
 -> StateT (Share (LedgerState era)) (Decoder s) (LedgerState era))
-> StateT (Share (LedgerState era)) (Decoder s) (LedgerState era)
-> StateT (Share (LedgerState era)) (Decoder s) (LedgerState era)
forall a b. (a -> b) -> a -> b
$ do
      CertState era
lsCertState <- StateT
  (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
   Interns (Credential 'DRepRole),
   Interns (Credential 'HotCommitteeRole))
  (Decoder s)
  (CertState era)
StateT (Share (CertState era)) (Decoder s) (CertState era)
forall s.
StateT (Share (CertState era)) (Decoder s) (CertState era)
forall a s. DecShareCBOR a => StateT (Share a) (Decoder s) a
decSharePlusCBOR
      UTxOState era
lsUTxOState <- StateT
  (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
   Interns (Credential 'DRepRole),
   Interns (Credential 'HotCommitteeRole))
  (Decoder s)
  (UTxOState era)
StateT (Share (UTxOState era)) (Decoder s) (UTxOState era)
forall s.
StateT (Share (UTxOState era)) (Decoder s) (UTxOState era)
forall a s. DecShareCBOR a => StateT (Share a) (Decoder s) a
decSharePlusCBOR
      LedgerState era
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     (Decoder s)
     (LedgerState era)
forall a.
a
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     (Decoder s)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LedgerState {UTxOState era
lsUTxOState :: UTxOState era
lsUTxOState :: UTxOState era
lsUTxOState, CertState era
lsCertState :: CertState era
lsCertState :: CertState era
lsCertState}

instance (EraTxOut era, EraGov era, EraStake era, EraCertState era) => ToCBOR (LedgerState era) where
  toCBOR :: LedgerState era -> Encoding
toCBOR = forall era t. (Era era, EncCBOR t) => t -> Encoding
toEraCBOR @era

instance (EraTxOut era, EraGov era, EraStake era, EraCertState era) => FromCBOR (LedgerState era) where
  fromCBOR :: forall s. Decoder s (LedgerState era)
fromCBOR = forall era t s. (Era era, DecShareCBOR t) => Decoder s t
fromEraShareCBOR @era

instance (EraTxOut era, EraGov era, EraStake era, EraCertState era) => ToJSON (LedgerState era) where
  toJSON :: LedgerState era -> Value
toJSON = [Pair] -> Value
object ([Pair] -> Value)
-> (LedgerState era -> [Pair]) -> LedgerState era -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState era -> [Pair]
forall era e a.
(EraTxOut era, EraGov era, KeyValue e a, EraStake era,
 EraCertState era) =>
LedgerState era -> [a]
toLedgerStatePairs
  toEncoding :: LedgerState era -> Encoding
toEncoding = Series -> Encoding
pairs (Series -> Encoding)
-> (LedgerState era -> Series) -> LedgerState era -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series)
-> (LedgerState era -> [Series]) -> LedgerState era -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState era -> [Series]
forall era e a.
(EraTxOut era, EraGov era, KeyValue e a, EraStake era,
 EraCertState era) =>
LedgerState era -> [a]
toLedgerStatePairs

toLedgerStatePairs ::
  (EraTxOut era, EraGov era, KeyValue e a, EraStake era, EraCertState era) => LedgerState era -> [a]
toLedgerStatePairs :: forall era e a.
(EraTxOut era, EraGov era, KeyValue e a, EraStake era,
 EraCertState era) =>
LedgerState era -> [a]
toLedgerStatePairs ls :: LedgerState era
ls@(LedgerState UTxOState era
_ CertState era
_) =
  let LedgerState {CertState era
UTxOState era
lsUTxOState :: forall era. LedgerState era -> UTxOState era
lsCertState :: forall era. LedgerState era -> CertState era
lsUTxOState :: UTxOState era
lsCertState :: CertState era
..} = LedgerState era
ls
   in [ Key
"utxoState" Key -> UTxOState era -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UTxOState era
lsUTxOState
      , Key
"delegationState" Key -> CertState era -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CertState era
lsCertState
      ]

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

--------------------------------------------------------------------------------
-- Default instances
--------------------------------------------------------------------------------

instance (EraGov era, EraStake era) => Default (UTxOState era) where
  def :: UTxOState era
def = UTxO era
-> Coin
-> Coin
-> GovState era
-> InstantStake era
-> Coin
-> UTxOState era
forall era.
UTxO era
-> Coin
-> Coin
-> GovState era
-> InstantStake era
-> Coin
-> UTxOState era
UTxOState UTxO era
forall a. Monoid a => a
mempty Coin
forall a. Monoid a => a
mempty Coin
forall a. Monoid a => a
mempty GovState era
forall a. Default a => a
def InstantStake era
forall a. Monoid a => a
mempty Coin
forall a. Monoid a => a
mempty

instance
  Default (LedgerState era) =>
  Default (EpochState era)
  where
  def :: EpochState era
def = ChainAccountState
-> LedgerState era -> SnapShots -> NonMyopic -> EpochState era
forall era.
ChainAccountState
-> LedgerState era -> SnapShots -> NonMyopic -> EpochState era
EpochState ChainAccountState
forall a. Default a => a
def LedgerState era
forall a. Default a => a
def SnapShots
forall a. Default a => a
def NonMyopic
forall a. Default a => a
def

instance (Default (UTxOState era), Default (CertState era)) => Default (LedgerState era) where
  def :: LedgerState era
def = UTxOState era -> CertState era -> LedgerState era
forall era. UTxOState era -> CertState era -> LedgerState era
LedgerState UTxOState era
forall a. Default a => a
def CertState era
forall a. Default a => a
def

-- =============================================================
-- Lenses for types found inside NewEpochState and its fields

-- ==========================================
-- NewEpochState

nesPdL :: Lens' (NewEpochState era) PoolDistr
nesPdL :: forall era (f :: * -> *).
Functor f =>
(PoolDistr -> f PoolDistr)
-> NewEpochState era -> f (NewEpochState era)
nesPdL = (NewEpochState era -> PoolDistr)
-> (NewEpochState era -> PoolDistr -> NewEpochState era)
-> Lens (NewEpochState era) (NewEpochState era) PoolDistr PoolDistr
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens NewEpochState era -> PoolDistr
forall era. NewEpochState era -> PoolDistr
nesPd (\NewEpochState era
ds PoolDistr
u -> NewEpochState era
ds {nesPd = u})

{- Called nesEpochStateL elsewhere -}
nesEsL :: Lens' (NewEpochState era) (EpochState era)
nesEsL :: forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL = (NewEpochState era -> EpochState era)
-> (NewEpochState era -> EpochState era -> NewEpochState era)
-> Lens
     (NewEpochState era)
     (NewEpochState era)
     (EpochState era)
     (EpochState era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs (\NewEpochState era
ds EpochState era
u -> NewEpochState era
ds {nesEs = u})

unifiedL :: EraCertState era => Lens' (NewEpochState era) UMap
unifiedL :: forall era. EraCertState era => Lens' (NewEpochState era) UMap
unifiedL = (EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> f (EpochState era))
 -> NewEpochState era -> f (NewEpochState era))
-> ((UMap -> f UMap) -> EpochState era -> f (EpochState era))
-> (UMap -> f UMap)
-> NewEpochState era
-> f (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> f (LedgerState era))
 -> EpochState era -> f (EpochState era))
-> ((UMap -> f UMap) -> LedgerState era -> f (LedgerState era))
-> (UMap -> f UMap)
-> EpochState era
-> f (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era -> f (CertState era))
 -> LedgerState era -> f (LedgerState era))
-> ((UMap -> f UMap) -> CertState era -> f (CertState era))
-> (UMap -> f UMap)
-> LedgerState era
-> f (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DState era -> f (DState era))
-> CertState era -> f (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL ((DState era -> f (DState era))
 -> CertState era -> f (CertState era))
-> ((UMap -> f UMap) -> DState era -> f (DState era))
-> (UMap -> f UMap)
-> CertState era
-> f (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UMap -> f UMap) -> DState era -> f (DState era)
forall era (f :: * -> *).
Functor f =>
(UMap -> f UMap) -> DState era -> f (DState era)
dsUnifiedL

nesELL :: Lens' (NewEpochState era) EpochNo
nesELL :: forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo)
-> NewEpochState era -> f (NewEpochState era)
nesELL = (NewEpochState era -> EpochNo)
-> (NewEpochState era -> EpochNo -> NewEpochState era)
-> Lens (NewEpochState era) (NewEpochState era) EpochNo EpochNo
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens NewEpochState era -> EpochNo
forall era. NewEpochState era -> EpochNo
nesEL (\NewEpochState era
ds EpochNo
u -> NewEpochState era
ds {nesEL = u})

nesBprevL :: Lens' (NewEpochState era) (Map (KeyHash 'StakePool) Natural)
nesBprevL :: forall era (f :: * -> *).
Functor f =>
(Map (KeyHash 'StakePool) Natural
 -> f (Map (KeyHash 'StakePool) Natural))
-> NewEpochState era -> f (NewEpochState era)
nesBprevL = (NewEpochState era -> Map (KeyHash 'StakePool) Natural)
-> (NewEpochState era
    -> Map (KeyHash 'StakePool) Natural -> NewEpochState era)
-> Lens
     (NewEpochState era)
     (NewEpochState era)
     (Map (KeyHash 'StakePool) Natural)
     (Map (KeyHash 'StakePool) Natural)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (BlocksMade -> Map (KeyHash 'StakePool) Natural
unBlocksMade (BlocksMade -> Map (KeyHash 'StakePool) Natural)
-> (NewEpochState era -> BlocksMade)
-> NewEpochState era
-> Map (KeyHash 'StakePool) Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> BlocksMade
forall era. NewEpochState era -> BlocksMade
nesBprev) (\NewEpochState era
ds Map (KeyHash 'StakePool) Natural
u -> NewEpochState era
ds {nesBprev = BlocksMade u})

nesBcurL :: Lens' (NewEpochState era) (Map (KeyHash 'StakePool) Natural)
nesBcurL :: forall era (f :: * -> *).
Functor f =>
(Map (KeyHash 'StakePool) Natural
 -> f (Map (KeyHash 'StakePool) Natural))
-> NewEpochState era -> f (NewEpochState era)
nesBcurL = (NewEpochState era -> Map (KeyHash 'StakePool) Natural)
-> (NewEpochState era
    -> Map (KeyHash 'StakePool) Natural -> NewEpochState era)
-> Lens
     (NewEpochState era)
     (NewEpochState era)
     (Map (KeyHash 'StakePool) Natural)
     (Map (KeyHash 'StakePool) Natural)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (BlocksMade -> Map (KeyHash 'StakePool) Natural
unBlocksMade (BlocksMade -> Map (KeyHash 'StakePool) Natural)
-> (NewEpochState era -> BlocksMade)
-> NewEpochState era
-> Map (KeyHash 'StakePool) Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> BlocksMade
forall era. NewEpochState era -> BlocksMade
nesBcur) (\NewEpochState era
ds Map (KeyHash 'StakePool) Natural
u -> NewEpochState era
ds {nesBcur = BlocksMade u})

nesRuL :: Lens' (NewEpochState era) (StrictMaybe PulsingRewUpdate)
nesRuL :: forall era (f :: * -> *).
Functor f =>
(StrictMaybe PulsingRewUpdate -> f (StrictMaybe PulsingRewUpdate))
-> NewEpochState era -> f (NewEpochState era)
nesRuL = (NewEpochState era -> StrictMaybe PulsingRewUpdate)
-> (NewEpochState era
    -> StrictMaybe PulsingRewUpdate -> NewEpochState era)
-> Lens
     (NewEpochState era)
     (NewEpochState era)
     (StrictMaybe PulsingRewUpdate)
     (StrictMaybe PulsingRewUpdate)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens NewEpochState era -> StrictMaybe PulsingRewUpdate
forall era. NewEpochState era -> StrictMaybe PulsingRewUpdate
nesRu (\NewEpochState era
ds StrictMaybe PulsingRewUpdate
u -> NewEpochState era
ds {nesRu = u})

nesStashedAVVMAddressesL :: Lens' (NewEpochState era) (StashedAVVMAddresses era)
nesStashedAVVMAddressesL :: forall era (f :: * -> *).
Functor f =>
(StashedAVVMAddresses era -> f (StashedAVVMAddresses era))
-> NewEpochState era -> f (NewEpochState era)
nesStashedAVVMAddressesL = (NewEpochState era -> StashedAVVMAddresses era)
-> (NewEpochState era
    -> StashedAVVMAddresses era -> NewEpochState era)
-> Lens
     (NewEpochState era)
     (NewEpochState era)
     (StashedAVVMAddresses era)
     (StashedAVVMAddresses era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens NewEpochState era -> StashedAVVMAddresses era
forall era. NewEpochState era -> StashedAVVMAddresses era
stashedAVVMAddresses (\NewEpochState era
ds StashedAVVMAddresses era
u -> NewEpochState era
ds {stashedAVVMAddresses = u})

-- For backward compatibility
nesEpochStateL :: Lens' (NewEpochState era) (EpochState era)
nesEpochStateL :: forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEpochStateL = (NewEpochState era -> EpochState era)
-> (NewEpochState era -> EpochState era -> NewEpochState era)
-> forall {f :: * -> *}.
   Functor f =>
   (EpochState era -> f (EpochState era))
   -> NewEpochState era -> f (NewEpochState era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs ((NewEpochState era -> EpochState era -> NewEpochState era)
 -> forall {f :: * -> *}.
    Functor f =>
    (EpochState era -> f (EpochState era))
    -> NewEpochState era -> f (NewEpochState era))
-> (NewEpochState era -> EpochState era -> NewEpochState era)
-> forall {f :: * -> *}.
   Functor f =>
   (EpochState era -> f (EpochState era))
   -> NewEpochState era -> f (NewEpochState era)
forall a b. (a -> b) -> a -> b
$ \NewEpochState era
x EpochState era
y -> NewEpochState era
x {nesEs = y}

-- ===================================================
-- EpochState

esAccountStateL :: Lens' (EpochState era) ChainAccountState
esAccountStateL :: forall era. Lens' (EpochState era) ChainAccountState
esAccountStateL = (EpochState era -> ChainAccountState)
-> (EpochState era -> ChainAccountState -> EpochState era)
-> Lens
     (EpochState era)
     (EpochState era)
     ChainAccountState
     ChainAccountState
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens EpochState era -> ChainAccountState
forall era. EpochState era -> ChainAccountState
esChainAccountState (\EpochState era
x ChainAccountState
y -> EpochState era
x {esChainAccountState = y})
{-# DEPRECATED esAccountStateL "In favor of `chainAccountStateL`" #-}

esSnapshotsL :: Lens' (EpochState era) SnapShots
esSnapshotsL :: forall era (f :: * -> *).
Functor f =>
(SnapShots -> f SnapShots) -> EpochState era -> f (EpochState era)
esSnapshotsL = (EpochState era -> SnapShots)
-> (EpochState era -> SnapShots -> EpochState era)
-> Lens (EpochState era) (EpochState era) SnapShots SnapShots
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens EpochState era -> SnapShots
forall era. EpochState era -> SnapShots
esSnapshots (\EpochState era
x SnapShots
y -> EpochState era
x {esSnapshots = y})

esLStateL :: Lens' (EpochState era) (LedgerState era)
esLStateL :: forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL = (EpochState era -> LedgerState era)
-> (EpochState era -> LedgerState era -> EpochState era)
-> Lens
     (EpochState era)
     (EpochState era)
     (LedgerState era)
     (LedgerState era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState (\EpochState era
x LedgerState era
y -> EpochState era
x {esLState = y})

esNonMyopicL :: Lens' (EpochState era) NonMyopic
esNonMyopicL :: forall era (f :: * -> *).
Functor f =>
(NonMyopic -> f NonMyopic) -> EpochState era -> f (EpochState era)
esNonMyopicL = (EpochState era -> NonMyopic)
-> (EpochState era -> NonMyopic -> EpochState era)
-> Lens (EpochState era) (EpochState era) NonMyopic NonMyopic
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens EpochState era -> NonMyopic
forall era. EpochState era -> NonMyopic
esNonMyopic (\EpochState era
x NonMyopic
y -> EpochState era
x {esNonMyopic = y})

curPParamsEpochStateL :: EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL :: forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL = (GovState era -> f (GovState era))
-> EpochState era -> f (EpochState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> EpochState era -> f (EpochState era)
epochStateGovStateL ((GovState era -> f (GovState era))
 -> EpochState era -> f (EpochState era))
-> ((PParams era -> f (PParams era))
    -> GovState era -> f (GovState era))
-> (PParams era -> f (PParams era))
-> EpochState era
-> f (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> f (PParams era))
-> GovState era -> f (GovState era)
forall era. EraGov era => Lens' (GovState era) (PParams era)
Lens' (GovState era) (PParams era)
curPParamsGovStateL

prevPParamsEpochStateL :: EraGov era => Lens' (EpochState era) (PParams era)
prevPParamsEpochStateL :: forall era. EraGov era => Lens' (EpochState era) (PParams era)
prevPParamsEpochStateL = (GovState era -> f (GovState era))
-> EpochState era -> f (EpochState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> EpochState era -> f (EpochState era)
epochStateGovStateL ((GovState era -> f (GovState era))
 -> EpochState era -> f (EpochState era))
-> ((PParams era -> f (PParams era))
    -> GovState era -> f (GovState era))
-> (PParams era -> f (PParams era))
-> EpochState era
-> f (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> f (PParams era))
-> GovState era -> f (GovState era)
forall era. EraGov era => Lens' (GovState era) (PParams era)
Lens' (GovState era) (PParams era)
prevPParamsGovStateL

futurePParamsEpochStateL :: EraGov era => Lens' (EpochState era) (FuturePParams era)
futurePParamsEpochStateL :: forall era.
EraGov era =>
Lens' (EpochState era) (FuturePParams era)
futurePParamsEpochStateL = (GovState era -> f (GovState era))
-> EpochState era -> f (EpochState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> EpochState era -> f (EpochState era)
epochStateGovStateL ((GovState era -> f (GovState era))
 -> EpochState era -> f (EpochState era))
-> ((FuturePParams era -> f (FuturePParams era))
    -> GovState era -> f (GovState era))
-> (FuturePParams era -> f (FuturePParams era))
-> EpochState era
-> f (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FuturePParams era -> f (FuturePParams era))
-> GovState era -> f (GovState era)
forall era. EraGov era => Lens' (GovState era) (FuturePParams era)
Lens' (GovState era) (FuturePParams era)
futurePParamsGovStateL

-- ==========================================
-- ChainAccountState

asTreasuryL :: Lens' ChainAccountState Coin
asTreasuryL :: Lens' ChainAccountState Coin
asTreasuryL = (ChainAccountState -> Coin)
-> (ChainAccountState -> Coin -> ChainAccountState)
-> Lens' ChainAccountState Coin
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ChainAccountState -> Coin
casTreasury (\ChainAccountState
ds Coin
u -> ChainAccountState
ds {casTreasury = u})
{-# DEPRECATED asTreasuryL "In favor of `casTreasuryL`" #-}

asReservesL :: Lens' ChainAccountState Coin
asReservesL :: Lens' ChainAccountState Coin
asReservesL = (ChainAccountState -> Coin)
-> (ChainAccountState -> Coin -> ChainAccountState)
-> Lens' ChainAccountState Coin
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ChainAccountState -> Coin
casReserves (\ChainAccountState
ds Coin
u -> ChainAccountState
ds {casReserves = u})
{-# DEPRECATED asReservesL "In favor of `casReservesL`" #-}

-- ====================================================
-- LedgerState

lsUTxOStateL :: Lens' (LedgerState era) (UTxOState era)
lsUTxOStateL :: forall era (f :: * -> *).
Functor f =>
(UTxOState era -> f (UTxOState era))
-> LedgerState era -> f (LedgerState era)
lsUTxOStateL = (LedgerState era -> UTxOState era)
-> (LedgerState era -> UTxOState era -> LedgerState era)
-> Lens
     (LedgerState era) (LedgerState era) (UTxOState era) (UTxOState era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens LedgerState era -> UTxOState era
forall era. LedgerState era -> UTxOState era
lsUTxOState (\LedgerState era
x UTxOState era
y -> LedgerState era
x {lsUTxOState = y})

lsCertStateL :: Lens' (LedgerState era) (CertState era)
lsCertStateL :: forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL = (LedgerState era -> CertState era)
-> (LedgerState era -> CertState era -> LedgerState era)
-> Lens
     (LedgerState era) (LedgerState era) (CertState era) (CertState era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens LedgerState era -> CertState era
forall era. LedgerState era -> CertState era
lsCertState (\LedgerState era
x CertState era
y -> LedgerState era
x {lsCertState = y})

-- ================ UTxOState ===========================

utxosUtxoL :: Lens' (UTxOState era) (UTxO era)
utxosUtxoL :: forall era. Lens' (UTxOState era) (UTxO era)
utxosUtxoL = (UTxOState era -> UTxO era)
-> (UTxOState era -> UTxO era -> UTxOState era)
-> Lens (UTxOState era) (UTxOState era) (UTxO era) (UTxO era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens UTxOState era -> UTxO era
forall era. UTxOState era -> UTxO era
utxosUtxo (\UTxOState era
x UTxO era
y -> UTxOState era
x {utxosUtxo = y})
{-# DEPRECATED utxosUtxoL "In favor of `utxoL`" #-}

utxosDepositedL :: Lens' (UTxOState era) Coin
utxosDepositedL :: forall era (f :: * -> *).
Functor f =>
(Coin -> f Coin) -> UTxOState era -> f (UTxOState era)
utxosDepositedL = (UTxOState era -> Coin)
-> (UTxOState era -> Coin -> UTxOState era)
-> Lens (UTxOState era) (UTxOState era) Coin Coin
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens UTxOState era -> Coin
forall era. UTxOState era -> Coin
utxosDeposited (\UTxOState era
x Coin
y -> UTxOState era
x {utxosDeposited = y})

utxosFeesL :: Lens' (UTxOState era) Coin
utxosFeesL :: forall era (f :: * -> *).
Functor f =>
(Coin -> f Coin) -> UTxOState era -> f (UTxOState era)
utxosFeesL = (UTxOState era -> Coin)
-> (UTxOState era -> Coin -> UTxOState era)
-> Lens (UTxOState era) (UTxOState era) Coin Coin
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens UTxOState era -> Coin
forall era. UTxOState era -> Coin
utxosFees (\UTxOState era
x Coin
y -> UTxOState era
x {utxosFees = y})

utxosGovStateL :: Lens' (UTxOState era) (GovState era)
utxosGovStateL :: forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> UTxOState era -> f (UTxOState era)
utxosGovStateL = (UTxOState era -> GovState era)
-> (UTxOState era -> GovState era -> UTxOState era)
-> Lens
     (UTxOState era) (UTxOState era) (GovState era) (GovState era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens UTxOState era -> GovState era
forall era. UTxOState era -> GovState era
utxosGovState (\UTxOState era
x GovState era
y -> UTxOState era
x {utxosGovState = y})

utxosDonationL :: Lens' (UTxOState era) Coin
utxosDonationL :: forall era (f :: * -> *).
Functor f =>
(Coin -> f Coin) -> UTxOState era -> f (UTxOState era)
utxosDonationL = (UTxOState era -> Coin)
-> (UTxOState era -> Coin -> UTxOState era)
-> Lens (UTxOState era) (UTxOState era) Coin Coin
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens UTxOState era -> Coin
forall era. UTxOState era -> Coin
utxosDonation (\UTxOState era
x Coin
y -> UTxOState era
x {utxosDonation = y})

-- ====================  Compound Lenses =======================

newEpochStateGovStateL :: Lens' (NewEpochState era) (GovState era)
newEpochStateGovStateL :: forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> NewEpochState era -> f (NewEpochState era)
newEpochStateGovStateL = (EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> f (EpochState era))
 -> NewEpochState era -> f (NewEpochState era))
-> ((GovState era -> f (GovState era))
    -> EpochState era -> f (EpochState era))
-> (GovState era -> f (GovState era))
-> NewEpochState era
-> f (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GovState era -> f (GovState era))
-> EpochState era -> f (EpochState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> EpochState era -> f (EpochState era)
epochStateGovStateL

epochStateGovStateL :: Lens' (EpochState era) (GovState era)
epochStateGovStateL :: forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> EpochState era -> f (EpochState era)
epochStateGovStateL = (LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> f (LedgerState era))
 -> EpochState era -> f (EpochState era))
-> ((GovState era -> f (GovState era))
    -> LedgerState era -> f (LedgerState era))
-> (GovState era -> f (GovState era))
-> EpochState era
-> f (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTxOState era -> f (UTxOState era))
-> LedgerState era -> f (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(UTxOState era -> f (UTxOState era))
-> LedgerState era -> f (LedgerState era)
lsUTxOStateL ((UTxOState era -> f (UTxOState era))
 -> LedgerState era -> f (LedgerState era))
-> ((GovState era -> f (GovState era))
    -> UTxOState era -> f (UTxOState era))
-> (GovState era -> f (GovState era))
-> LedgerState era
-> f (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GovState era -> f (GovState era))
-> UTxOState era -> f (UTxOState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> UTxOState era -> f (UTxOState era)
utxosGovStateL

epochStateDonationL :: Lens' (EpochState era) Coin
epochStateDonationL :: forall era (f :: * -> *).
Functor f =>
(Coin -> f Coin) -> EpochState era -> f (EpochState era)
epochStateDonationL = (LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> f (LedgerState era))
 -> EpochState era -> f (EpochState era))
-> ((Coin -> f Coin) -> LedgerState era -> f (LedgerState era))
-> (Coin -> f Coin)
-> EpochState era
-> f (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTxOState era -> f (UTxOState era))
-> LedgerState era -> f (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(UTxOState era -> f (UTxOState era))
-> LedgerState era -> f (LedgerState era)
lsUTxOStateL ((UTxOState era -> f (UTxOState era))
 -> LedgerState era -> f (LedgerState era))
-> ((Coin -> f Coin) -> UTxOState era -> f (UTxOState era))
-> (Coin -> f Coin)
-> LedgerState era
-> f (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> f Coin) -> UTxOState era -> f (UTxOState era)
forall era (f :: * -> *).
Functor f =>
(Coin -> f Coin) -> UTxOState era -> f (UTxOState era)
utxosDonationL

epochStateTreasuryL :: Lens' (EpochState era) Coin
epochStateTreasuryL :: forall era (f :: * -> *).
Functor f =>
(Coin -> f Coin) -> EpochState era -> f (EpochState era)
epochStateTreasuryL = (Coin -> f Coin) -> EpochState era -> f (EpochState era)
Lens' (EpochState era) Coin
forall (t :: * -> *) era.
CanSetChainAccountState t =>
Lens' (t era) Coin
treasuryL
{-# DEPRECATED epochStateTreasuryL "In favor of `treasuryL`" #-}

epochStatePoolParamsL ::
  EraCertState era => Lens' (EpochState era) (Map (KeyHash 'StakePool) PoolParams)
epochStatePoolParamsL :: forall era.
EraCertState era =>
Lens' (EpochState era) (Map (KeyHash 'StakePool) PoolParams)
epochStatePoolParamsL = (LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> f (LedgerState era))
 -> EpochState era -> f (EpochState era))
-> ((Map (KeyHash 'StakePool) PoolParams
     -> f (Map (KeyHash 'StakePool) PoolParams))
    -> LedgerState era -> f (LedgerState era))
-> (Map (KeyHash 'StakePool) PoolParams
    -> f (Map (KeyHash 'StakePool) PoolParams))
-> EpochState era
-> f (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era -> f (CertState era))
 -> LedgerState era -> f (LedgerState era))
-> ((Map (KeyHash 'StakePool) PoolParams
     -> f (Map (KeyHash 'StakePool) PoolParams))
    -> CertState era -> f (CertState era))
-> (Map (KeyHash 'StakePool) PoolParams
    -> f (Map (KeyHash 'StakePool) PoolParams))
-> LedgerState era
-> f (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PState era -> f (PState era))
-> CertState era -> f (CertState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
certPStateL ((PState era -> f (PState era))
 -> CertState era -> f (CertState era))
-> ((Map (KeyHash 'StakePool) PoolParams
     -> f (Map (KeyHash 'StakePool) PoolParams))
    -> PState era -> f (PState era))
-> (Map (KeyHash 'StakePool) PoolParams
    -> f (Map (KeyHash 'StakePool) PoolParams))
-> CertState era
-> f (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (KeyHash 'StakePool) PoolParams
 -> f (Map (KeyHash 'StakePool) PoolParams))
-> PState era -> f (PState era)
forall era (f :: * -> *).
Functor f =>
(Map (KeyHash 'StakePool) PoolParams
 -> f (Map (KeyHash 'StakePool) PoolParams))
-> PState era -> f (PState era)
psStakePoolParamsL

epochStateUMapL :: EraCertState era => Lens' (EpochState era) UMap
epochStateUMapL :: forall era. EraCertState era => Lens' (EpochState era) UMap
epochStateUMapL = (LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> f (LedgerState era))
 -> EpochState era -> f (EpochState era))
-> ((UMap -> f UMap) -> LedgerState era -> f (LedgerState era))
-> (UMap -> f UMap)
-> EpochState era
-> f (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era -> f (CertState era))
 -> LedgerState era -> f (LedgerState era))
-> ((UMap -> f UMap) -> CertState era -> f (CertState era))
-> (UMap -> f UMap)
-> LedgerState era
-> f (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DState era -> f (DState era))
-> CertState era -> f (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL ((DState era -> f (DState era))
 -> CertState era -> f (CertState era))
-> ((UMap -> f UMap) -> DState era -> f (DState era))
-> (UMap -> f UMap)
-> CertState era
-> f (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UMap -> f UMap) -> DState era -> f (DState era)
forall era (f :: * -> *).
Functor f =>
(UMap -> f UMap) -> DState era -> f (DState era)
dsUnifiedL

epochStateStakeDistrL ::
  Lens' (EpochState era) (VMap VB VP (Credential 'Staking) (CompactForm Coin))
epochStateStakeDistrL :: forall era (f :: * -> *).
Functor f =>
(VMap VB VP (Credential 'Staking) (CompactForm Coin)
 -> f (VMap VB VP (Credential 'Staking) (CompactForm Coin)))
-> EpochState era -> f (EpochState era)
epochStateStakeDistrL = (SnapShots -> f SnapShots) -> EpochState era -> f (EpochState era)
forall era (f :: * -> *).
Functor f =>
(SnapShots -> f SnapShots) -> EpochState era -> f (EpochState era)
esSnapshotsL ((SnapShots -> f SnapShots)
 -> EpochState era -> f (EpochState era))
-> ((VMap VB VP (Credential 'Staking) (CompactForm Coin)
     -> f (VMap VB VP (Credential 'Staking) (CompactForm Coin)))
    -> SnapShots -> f SnapShots)
-> (VMap VB VP (Credential 'Staking) (CompactForm Coin)
    -> f (VMap VB VP (Credential 'Staking) (CompactForm Coin)))
-> EpochState era
-> f (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SnapShot -> f SnapShot) -> SnapShots -> f SnapShots
Lens' SnapShots SnapShot
ssStakeMarkL ((SnapShot -> f SnapShot) -> SnapShots -> f SnapShots)
-> ((VMap VB VP (Credential 'Staking) (CompactForm Coin)
     -> f (VMap VB VP (Credential 'Staking) (CompactForm Coin)))
    -> SnapShot -> f SnapShot)
-> (VMap VB VP (Credential 'Staking) (CompactForm Coin)
    -> f (VMap VB VP (Credential 'Staking) (CompactForm Coin)))
-> SnapShots
-> f SnapShots
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VMap VB VP (Credential 'Staking) (CompactForm Coin)
 -> f (VMap VB VP (Credential 'Staking) (CompactForm Coin)))
-> SnapShot -> f SnapShot
Lens'
  SnapShot (VMap VB VP (Credential 'Staking) (CompactForm Coin))
ssStakeDistrL

potEqualsObligation ::
  (EraGov era, EraCertState era) =>
  CertState era ->
  UTxOState era ->
  Bool
potEqualsObligation :: forall era.
(EraGov era, EraCertState era) =>
CertState era -> UTxOState era -> Bool
potEqualsObligation CertState era
certState UTxOState era
utxoSt = Coin
obligations Coin -> Coin -> Bool
forall a. Eq a => a -> a -> Bool
== Coin
pot
  where
    obligations :: Coin
obligations = CertState era -> GovState era -> Coin
forall era.
(EraGov era, EraCertState era) =>
CertState era -> GovState era -> Coin
totalObligation CertState era
certState (UTxOState era
utxoSt UTxOState era
-> Getting (GovState era) (UTxOState era) (GovState era)
-> GovState era
forall s a. s -> Getting a s a -> a
^. Getting (GovState era) (UTxOState era) (GovState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> UTxOState era -> f (UTxOState era)
utxosGovStateL)
    pot :: Coin
pot = UTxOState era
utxoSt UTxOState era -> Getting Coin (UTxOState era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (UTxOState era) Coin
forall era (f :: * -> *).
Functor f =>
(Coin -> f Coin) -> UTxOState era -> f (UTxOState era)
utxosDepositedL

allObligations :: (EraGov era, EraCertState era) => CertState era -> GovState era -> Obligations
allObligations :: forall era.
(EraGov era, EraCertState era) =>
CertState era -> GovState era -> Obligations
allObligations CertState era
certState GovState era
govState =
  CertState era -> Obligations
forall era. EraCertState era => CertState era -> Obligations
obligationCertState CertState era
certState Obligations -> Obligations -> Obligations
forall a. Semigroup a => a -> a -> a
<> GovState era -> Obligations
forall era. EraGov era => GovState era -> Obligations
obligationGovState GovState era
govState

totalObligation :: (EraGov era, EraCertState era) => CertState era -> GovState era -> Coin
totalObligation :: forall era.
(EraGov era, EraCertState era) =>
CertState era -> GovState era -> Coin
totalObligation CertState era
certState GovState era
govState = Obligations -> Coin
sumObligation (CertState era -> GovState era -> Obligations
forall era.
(EraGov era, EraCertState era) =>
CertState era -> GovState era -> Obligations
allObligations CertState era
certState GovState era
govState)