{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# 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, dropCBOR),
  DecShareCBOR (Share, decShareCBOR, decSharePlusCBOR),
  EncCBOR (encCBOR),
  FromCBOR (..),
  Interns,
  ToCBOR (..),
  decNoShareCBOR,
  decShareLensCBOR,
  decodeRecordNamed,
  decodeRecordNamedT,
  encodeListLen,
  enforceDecoderVersion,
  ifDecoderVersionAtLeast,
  natVersion,
 )
import Cardano.Ledger.Binary.Coders (Decode (From, RecD), Encode (..), decode, encode, (!>), (<!))
import Cardano.Ledger.CertState (
  CertState,
  DRepState,
  Obligations (..),
  certDStateL,
  certPStateL,
  certVStateL,
  dsUnifiedL,
  obligationCertState,
  psStakePoolParamsL,
  sumObligation,
  vsDRepsL,
 )
import Cardano.Ledger.Coin (Coin (..), CompactForm)
import Cardano.Ledger.Credential (Credential (..), Ptr (..))
import Cardano.Ledger.Crypto (Crypto)
import Cardano.Ledger.EpochBoundary (SnapShots (..), ssStakeDistrL, ssStakeMarkL)
import Cardano.Ledger.Keys (KeyHash (..), KeyRole (..))
import Cardano.Ledger.PoolDistr (PoolDistr (..))
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.UMap (UMap (..))
import Cardano.Ledger.UTxO (UTxO (..))
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.Group (Group, invert)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Proxy
import Data.VMap (VB, VMap, VP)
import GHC.Generics (Generic)
import Lens.Micro
import NoThunks.Class (AllowThunksIn (..), NoThunks (..))
import Numeric.Natural (Natural)

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

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

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

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

instance DecCBOR AccountState where
  decCBOR :: forall s. Decoder s AccountState
decCBOR =
    forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"AccountState" (forall a b. a -> b -> a
const Int
2) forall a b. (a -> b) -> a -> b
$ Coin -> Coin -> AccountState
AccountState forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR

instance ToJSON AccountState where
  toJSON :: AccountState -> Value
toJSON = [Pair] -> Value
object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. KeyValue e a => AccountState -> [a]
toAccountStatePairs
  toEncoding :: AccountState -> Encoding
toEncoding = Series -> Encoding
pairs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. KeyValue e a => AccountState -> [a]
toAccountStatePairs

toAccountStatePairs :: KeyValue e a => AccountState -> [a]
toAccountStatePairs :: forall e a. KeyValue e a => AccountState -> [a]
toAccountStatePairs as :: AccountState
as@(AccountState Coin
_ Coin
_) =
  let AccountState {Coin
asTreasury :: Coin
asTreasury :: AccountState -> Coin
asTreasury, Coin
asReserves :: Coin
asReserves :: AccountState -> Coin
asReserves} = AccountState
as
   in [ Key
"treasury" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin
asTreasury
      , Key
"reserves" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin
asReserves
      ]

instance NoThunks AccountState

instance NFData AccountState

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

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

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

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

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

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

instance
  ( EraTxOut era
  , EraGov era
  ) =>
  DecCBOR (EpochState era)
  where
  decCBOR :: forall s. Decoder s (EpochState era)
decCBOR =
    forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"EpochState" (forall a b. a -> b -> a
const Int
4) forall a b. (a -> b) -> a -> b
$
      forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ do
        AccountState
esAccountState <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a s. DecCBOR a => Decoder s a
decCBOR
        LedgerState era
esLState <- forall a s. DecShareCBOR a => StateT (Share a) (Decoder s) a
decSharePlusCBOR
        SnapShots (EraCrypto era)
esSnapshots <- forall a s. DecShareCBOR a => StateT (Share a) (Decoder s) a
decSharePlusCBOR
        NonMyopic (EraCrypto era)
esNonMyopic <- forall b bs s.
DecShareCBOR b =>
SimpleGetter bs (Share b) -> StateT bs (Decoder s) b
decShareLensCBOR forall s t a b. Field2 s t a b => Lens s t a b
_2
        forall (f :: * -> *) a. Applicative f => a -> f a
pure EpochState {AccountState
esAccountState :: AccountState
esAccountState :: AccountState
esAccountState, SnapShots (EraCrypto era)
esSnapshots :: SnapShots (EraCrypto era)
esSnapshots :: SnapShots (EraCrypto era)
esSnapshots, LedgerState era
esLState :: LedgerState era
esLState :: LedgerState era
esLState, NonMyopic (EraCrypto era)
esNonMyopic :: NonMyopic (EraCrypto era)
esNonMyopic :: NonMyopic (EraCrypto era)
esNonMyopic}

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

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

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

-- | Incremental Stake, Stake along with possible missed coins from danging Ptrs.
--   Transactions can use Ptrs to refer to a stake credential in a TxOut. The Ptr
--   does not have to point to anything until the epoch boundary, when we compute
--   rewards and aggregate staking information for ranking. This is unusual but legal.
--   In a non incremental system, we use whatever 'legal' Ptrs exist at the epoch
--   boundary. Here we are computing things incrementally, so we need to remember Ptrs
--   that might point to something by the time the epoch boundary is reached. When
--   the epoch boundary is reached we 'resolve' these pointers, to see if any have
--   become non-dangling since the time they were first used in the incremental computation.
data IncrementalStake c = IStake
  { forall c.
IncrementalStake c
-> Map (Credential 'Staking c) (CompactForm Coin)
credMap :: !(Map (Credential 'Staking c) (CompactForm Coin))
  , forall c. IncrementalStake c -> Map Ptr (CompactForm Coin)
ptrMap :: !(Map Ptr (CompactForm Coin))
  }
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (IncrementalStake c) x -> IncrementalStake c
forall c x. IncrementalStake c -> Rep (IncrementalStake c) x
$cto :: forall c x. Rep (IncrementalStake c) x -> IncrementalStake c
$cfrom :: forall c x. IncrementalStake c -> Rep (IncrementalStake c) x
Generic, Int -> IncrementalStake c -> ShowS
forall c. Int -> IncrementalStake c -> ShowS
forall c. [IncrementalStake c] -> ShowS
forall c. IncrementalStake c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IncrementalStake c] -> ShowS
$cshowList :: forall c. [IncrementalStake c] -> ShowS
show :: IncrementalStake c -> String
$cshow :: forall c. IncrementalStake c -> String
showsPrec :: Int -> IncrementalStake c -> ShowS
$cshowsPrec :: forall c. Int -> IncrementalStake c -> ShowS
Show, IncrementalStake c -> IncrementalStake c -> Bool
forall c. IncrementalStake c -> IncrementalStake c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IncrementalStake c -> IncrementalStake c -> Bool
$c/= :: forall c. IncrementalStake c -> IncrementalStake c -> Bool
== :: IncrementalStake c -> IncrementalStake c -> Bool
$c== :: forall c. IncrementalStake c -> IncrementalStake c -> Bool
Eq, IncrementalStake c -> IncrementalStake c -> Bool
IncrementalStake c -> IncrementalStake c -> Ordering
forall c. Eq (IncrementalStake c)
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall c. IncrementalStake c -> IncrementalStake c -> Bool
forall c. IncrementalStake c -> IncrementalStake c -> Ordering
forall c.
IncrementalStake c -> IncrementalStake c -> IncrementalStake c
min :: IncrementalStake c -> IncrementalStake c -> IncrementalStake c
$cmin :: forall c.
IncrementalStake c -> IncrementalStake c -> IncrementalStake c
max :: IncrementalStake c -> IncrementalStake c -> IncrementalStake c
$cmax :: forall c.
IncrementalStake c -> IncrementalStake c -> IncrementalStake c
>= :: IncrementalStake c -> IncrementalStake c -> Bool
$c>= :: forall c. IncrementalStake c -> IncrementalStake c -> Bool
> :: IncrementalStake c -> IncrementalStake c -> Bool
$c> :: forall c. IncrementalStake c -> IncrementalStake c -> Bool
<= :: IncrementalStake c -> IncrementalStake c -> Bool
$c<= :: forall c. IncrementalStake c -> IncrementalStake c -> Bool
< :: IncrementalStake c -> IncrementalStake c -> Bool
$c< :: forall c. IncrementalStake c -> IncrementalStake c -> Bool
compare :: IncrementalStake c -> IncrementalStake c -> Ordering
$ccompare :: forall c. IncrementalStake c -> IncrementalStake c -> Ordering
Ord, forall c. Context -> IncrementalStake c -> IO (Maybe ThunkInfo)
forall c. Proxy (IncrementalStake c) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (IncrementalStake c) -> String
$cshowTypeOf :: forall c. Proxy (IncrementalStake c) -> String
wNoThunks :: Context -> IncrementalStake c -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall c. Context -> IncrementalStake c -> IO (Maybe ThunkInfo)
noThunks :: Context -> IncrementalStake c -> IO (Maybe ThunkInfo)
$cnoThunks :: forall c. Context -> IncrementalStake c -> IO (Maybe ThunkInfo)
NoThunks, forall c. IncrementalStake c -> ()
forall a. (a -> ()) -> NFData a
rnf :: IncrementalStake c -> ()
$crnf :: forall c. IncrementalStake c -> ()
NFData)

instance Crypto c => EncCBOR (IncrementalStake c) where
  encCBOR :: IncrementalStake c -> Encoding
encCBOR (IStake Map (Credential 'Staking c) (CompactForm Coin)
st Map Ptr (CompactForm Coin)
dangle) =
    Word -> Encoding
encodeListLen Word
2 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Map (Credential 'Staking c) (CompactForm Coin)
st forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Map Ptr (CompactForm Coin)
dangle

instance Crypto c => DecShareCBOR (IncrementalStake c) where
  type Share (IncrementalStake c) = Interns (Credential 'Staking c)
  decShareCBOR :: forall s.
Share (IncrementalStake c) -> Decoder s (IncrementalStake c)
decShareCBOR Share (IncrementalStake c)
credInterns =
    forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"Stake" (forall a b. a -> b -> a
const Int
2) forall a b. (a -> b) -> a -> b
$ do
      Map (Credential 'Staking c) (CompactForm Coin)
stake <- forall a s. DecShareCBOR a => Share a -> Decoder s a
decShareCBOR (Share (IncrementalStake c)
credInterns, forall a. Monoid a => a
mempty)
      let dropPtrs :: Decoder s (Map Ptr (CompactForm Coin))
dropPtrs =
            forall a. Monoid a => a
mempty
              forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s a. Version -> Decoder s a -> Decoder s a
enforceDecoderVersion (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @8) (forall a s. DecCBOR a => Proxy a -> Decoder s ()
dropCBOR (forall {k} (t :: k). Proxy t
Proxy @(Map Ptr (CompactForm Coin))))
      Map Ptr (CompactForm Coin)
ptrs <- forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @9) forall {s}. Decoder s (Map Ptr (CompactForm Coin))
dropPtrs forall a s. DecCBOR a => Decoder s a
decCBOR
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall c.
Map (Credential 'Staking c) (CompactForm Coin)
-> Map Ptr (CompactForm Coin) -> IncrementalStake c
IStake Map (Credential 'Staking c) (CompactForm Coin)
stake Map Ptr (CompactForm Coin)
ptrs

instance Semigroup (IncrementalStake c) where
  (IStake Map (Credential 'Staking c) (CompactForm Coin)
a Map Ptr (CompactForm Coin)
b) <> :: IncrementalStake c -> IncrementalStake c -> IncrementalStake c
<> (IStake Map (Credential 'Staking c) (CompactForm Coin)
c Map Ptr (CompactForm Coin)
d) = forall c.
Map (Credential 'Staking c) (CompactForm Coin)
-> Map Ptr (CompactForm Coin) -> IncrementalStake c
IStake (forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith forall a. Semigroup a => a -> a -> a
(<>) Map (Credential 'Staking c) (CompactForm Coin)
a Map (Credential 'Staking c) (CompactForm Coin)
c) (forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith forall a. Semigroup a => a -> a -> a
(<>) Map Ptr (CompactForm Coin)
b Map Ptr (CompactForm Coin)
d)

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

instance Data.Group.Group (IncrementalStake c) where
  invert :: IncrementalStake c -> IncrementalStake c
invert (IStake Map (Credential 'Staking c) (CompactForm Coin)
m1 Map Ptr (CompactForm Coin)
m2) = forall c.
Map (Credential 'Staking c) (CompactForm Coin)
-> Map Ptr (CompactForm Coin) -> IncrementalStake c
IStake (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map forall m. Group m => m -> m
invert Map (Credential 'Staking c) (CompactForm Coin)
m1) (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map forall m. Group m => m -> m
invert Map Ptr (CompactForm Coin)
m2)

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

instance Crypto c => ToJSON (IncrementalStake c) where
  toJSON :: IncrementalStake c -> Value
toJSON = [Pair] -> Value
object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a c. (KeyValue e a, Crypto c) => IncrementalStake c -> [a]
toIncrementalStakePairs
  toEncoding :: IncrementalStake c -> Encoding
toEncoding = Series -> Encoding
pairs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a c. (KeyValue e a, Crypto c) => IncrementalStake c -> [a]
toIncrementalStakePairs

toIncrementalStakePairs ::
  (KeyValue e a, Crypto c) => IncrementalStake c -> [a]
toIncrementalStakePairs :: forall e a c. (KeyValue e a, Crypto c) => IncrementalStake c -> [a]
toIncrementalStakePairs iStake :: IncrementalStake c
iStake@(IStake Map (Credential 'Staking c) (CompactForm Coin)
_ Map Ptr (CompactForm Coin)
_) =
  let IStake {Map (Credential 'Staking c) (CompactForm Coin)
Map Ptr (CompactForm Coin)
ptrMap :: Map Ptr (CompactForm Coin)
credMap :: Map (Credential 'Staking c) (CompactForm Coin)
ptrMap :: forall c. IncrementalStake c -> Map Ptr (CompactForm Coin)
credMap :: forall c.
IncrementalStake c
-> Map (Credential 'Staking c) (CompactForm Coin)
..} = IncrementalStake c
iStake -- guard against addition or removal of fields
   in [ Key
"credentials" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map (Credential 'Staking c) (CompactForm Coin)
credMap
      , Key
"pointers" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map Ptr (CompactForm Coin)
ptrMap
      ]

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

-- | There is a serious invariant that we must maintain in the UTxOState.
--   Given (UTxOState utxo _ _ _ istake) it must be the case that
--   istake == (updateStakeDistribution (UTxO Map.empty) (UTxO Map.empty) utxo)
--   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
  -- ^ This field is left lazy, because we only use it for assertions
  , forall era. UTxOState era -> Coin
utxosFees :: !Coin
  , forall era. UTxOState era -> GovState era
utxosGovState :: !(GovState era)
  , forall era. UTxOState era -> IncrementalStake (EraCrypto era)
utxosStakeDistr :: !(IncrementalStake (EraCrypto era))
  , forall era. UTxOState era -> Coin
utxosDonation :: !Coin
  }
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (UTxOState era) x -> UTxOState era
forall era x. UTxOState era -> Rep (UTxOState era) x
$cto :: forall era x. Rep (UTxOState era) x -> UTxOState era
$cfrom :: forall era x. UTxOState era -> Rep (UTxOState era) x
Generic)

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

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

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

deriving via
  AllowThunksIn
    '["utxosDeposited"]
    (UTxOState era)
  instance
    ( NoThunks (UTxO era)
    , NoThunks (GovState era)
    , Era era
    ) =>
    NoThunks (UTxOState era)

instance
  ( EraTxOut era
  , EncCBOR (GovState era)
  ) =>
  EncCBOR (UTxOState era)
  where
  encCBOR :: UTxOState era -> Encoding
encCBOR (UTxOState UTxO era
ut Coin
dp Coin
fs GovState era
us IncrementalStake (EraCrypto era)
sd Coin
don) =
    forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall a b. (a -> b) -> a -> b
$
      forall t. t -> Encode ('Closed 'Dense) t
Rec forall era.
UTxO era
-> Coin
-> Coin
-> GovState era
-> IncrementalStake (EraCrypto era)
-> Coin
-> UTxOState era
UTxOState
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To UTxO era
ut
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
dp
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
fs
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To GovState era
us
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To IncrementalStake (EraCrypto era)
sd
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
don

instance
  ( EraTxOut era
  , EraGov era
  ) =>
  DecShareCBOR (UTxOState era)
  where
  type
    Share (UTxOState era) =
      Interns (Credential 'Staking (EraCrypto era))
  decShareCBOR :: forall s. Share (UTxOState era) -> Decoder s (UTxOState era)
decShareCBOR Share (UTxOState era)
credInterns =
    forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"UTxOState" (forall a b. a -> b -> a
const Int
6) forall a b. (a -> b) -> a -> b
$ do
      UTxO era
utxosUtxo <- forall a s. DecShareCBOR a => Share a -> Decoder s a
decShareCBOR Share (UTxOState era)
credInterns
      Coin
utxosDeposited <- forall a s. DecCBOR a => Decoder s a
decCBOR
      Coin
utxosFees <- forall a s. DecCBOR a => Decoder s a
decCBOR
      -- TODO: implement proper sharing: https://github.com/intersectmbo/cardano-ledger/issues/3486
      GovState era
utxosGovState <- forall a s. DecShareCBOR a => Decoder s a
decNoShareCBOR
      IncrementalStake (EraCrypto era)
utxosStakeDistr <- forall a s. DecShareCBOR a => Share a -> Decoder s a
decShareCBOR Share (UTxOState era)
credInterns
      Coin
utxosDonation <- forall a s. DecCBOR a => Decoder s a
decCBOR
      forall (f :: * -> *) a. Applicative f => a -> f a
pure UTxOState {UTxO era
Coin
GovState era
IncrementalStake (EraCrypto era)
utxosDonation :: Coin
utxosStakeDistr :: IncrementalStake (EraCrypto era)
utxosGovState :: GovState era
utxosFees :: Coin
utxosDeposited :: Coin
utxosUtxo :: UTxO era
utxosDonation :: Coin
utxosStakeDistr :: IncrementalStake (EraCrypto era)
utxosGovState :: GovState era
utxosFees :: Coin
utxosDeposited :: Coin
utxosUtxo :: UTxO era
..}

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

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

-- | 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 (EraCrypto era)
nesBprev :: !(BlocksMade (EraCrypto era))
  -- ^ Blocks made before current epoch
  , forall era. NewEpochState era -> BlocksMade (EraCrypto era)
nesBcur :: !(BlocksMade (EraCrypto era))
  -- ^ Blocks made in current epoch
  , forall era. NewEpochState era -> EpochState era
nesEs :: !(EpochState era)
  -- ^ Epoch state
  , forall era.
NewEpochState era -> StrictMaybe (PulsingRewUpdate (EraCrypto era))
nesRu :: !(StrictMaybe (PulsingRewUpdate (EraCrypto era)))
  -- ^ Possible reward update
  , forall era. NewEpochState era -> PoolDistr (EraCrypto era)
nesPd :: !(PoolDistr (EraCrypto era))
  -- ^ 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 a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (NewEpochState era) x -> NewEpochState era
forall era x. NewEpochState era -> Rep (NewEpochState era) x
$cto :: forall era x. Rep (NewEpochState era) x -> NewEpochState era
$cfrom :: forall era x. NewEpochState era -> Rep (NewEpochState era) x
Generic)

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

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

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

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

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

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

instance
  (EraTxOut era, EraGov 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, 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 (BlocksMade (EraCrypto era))
  , NoThunks (EpochState era)
  , NoThunks (PulsingRewUpdate (EraCrypto 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 a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (LedgerState era) x -> LedgerState era
forall era x. LedgerState era -> Rep (LedgerState era) x
$cto :: forall era x. Rep (LedgerState era) x -> LedgerState era
$cfrom :: forall era x. LedgerState era -> Rep (LedgerState era) x
Generic)

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

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

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

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

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

instance
  ( EraTxOut era
  , EraGov era
  ) =>
  DecShareCBOR (LedgerState era)
  where
  type
    Share (LedgerState era) =
      ( Interns (Credential 'Staking (EraCrypto era))
      , Interns (KeyHash 'StakePool (EraCrypto era))
      )
  decSharePlusCBOR :: forall s.
StateT (Share (LedgerState era)) (Decoder s) (LedgerState era)
decSharePlusCBOR =
    forall (m :: (* -> *) -> * -> *) s a.
(MonadTrans m, Monad (m (Decoder s))) =>
Text -> (a -> Int) -> m (Decoder s) a -> m (Decoder s) a
decodeRecordNamedT Text
"LedgerState" (forall a b. a -> b -> a
const Int
2) forall a b. (a -> b) -> a -> b
$ do
      CertState era
lsCertState <- forall a s. DecShareCBOR a => StateT (Share a) (Decoder s) a
decSharePlusCBOR
      UTxOState era
lsUTxOState <- forall b bs s.
DecShareCBOR b =>
SimpleGetter bs (Share b) -> StateT bs (Decoder s) b
decShareLensCBOR forall s t a b. Field1 s t a b => Lens s t a b
_1
      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) => 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) => 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) => ToJSON (LedgerState era) where
  toJSON :: LedgerState era -> Value
toJSON = [Pair] -> Value
object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era e a.
(EraTxOut era, EraGov era, KeyValue e a) =>
LedgerState era -> [a]
toLedgerStatePairs
  toEncoding :: LedgerState era -> Encoding
toEncoding = Series -> Encoding
pairs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era e a.
(EraTxOut era, EraGov era, KeyValue e a) =>
LedgerState era -> [a]
toLedgerStatePairs

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

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

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

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

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

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

instance Default AccountState where
  def :: AccountState
def = Coin -> Coin -> AccountState
AccountState (Integer -> Coin
Coin Integer
0) (Integer -> Coin
Coin Integer
0)

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

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

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

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

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

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

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

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

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

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

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

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

esAccountStateL :: Lens' (EpochState era) AccountState
esAccountStateL :: forall era. Lens' (EpochState era) AccountState
esAccountStateL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era. EpochState era -> AccountState
esAccountState (\EpochState era
x AccountState
y -> EpochState era
x {esAccountState :: AccountState
esAccountState = AccountState
y})

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

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

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

curPParamsEpochStateL :: EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL :: forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL = forall era. Lens' (EpochState era) (GovState era)
epochStateGovStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov 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 = forall era. Lens' (EpochState era) (GovState era)
epochStateGovStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov 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 = forall era. Lens' (EpochState era) (GovState era)
epochStateGovStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (GovState era) (FuturePParams era)
futurePParamsGovStateL

-- ==========================================
-- AccountState

asTreasuryL :: Lens' AccountState Coin
asTreasuryL :: Lens' AccountState Coin
asTreasuryL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens AccountState -> Coin
asTreasury (\AccountState
ds Coin
u -> AccountState
ds {asTreasury :: Coin
asTreasury = Coin
u})

asReservesL :: Lens' AccountState Coin
asReservesL :: Lens' AccountState Coin
asReservesL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens AccountState -> Coin
asReserves (\AccountState
ds Coin
u -> AccountState
ds {asReserves :: Coin
asReserves = Coin
u})

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

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

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

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

utxosUtxoL :: Lens' (UTxOState era) (UTxO era)
utxosUtxoL :: forall era. Lens' (UTxOState era) (UTxO era)
utxosUtxoL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era. UTxOState era -> UTxO era
utxosUtxo (\UTxOState era
x UTxO era
y -> UTxOState era
x {utxosUtxo :: UTxO era
utxosUtxo = UTxO era
y})

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

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

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

utxosStakeDistrL :: Lens' (UTxOState era) (IncrementalStake (EraCrypto era))
utxosStakeDistrL :: forall era.
Lens' (UTxOState era) (IncrementalStake (EraCrypto era))
utxosStakeDistrL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era. UTxOState era -> IncrementalStake (EraCrypto era)
utxosStakeDistr (\UTxOState era
x IncrementalStake (EraCrypto era)
y -> UTxOState era
x {utxosStakeDistr :: IncrementalStake (EraCrypto era)
utxosStakeDistr = IncrementalStake (EraCrypto era)
y})

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

-- ================ IncremetalStake ===========================

credMapL :: Lens' (IncrementalStake c) (Map (Credential 'Staking c) (CompactForm Coin))
credMapL :: forall c.
Lens'
  (IncrementalStake c)
  (Map (Credential 'Staking c) (CompactForm Coin))
credMapL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall c.
IncrementalStake c
-> Map (Credential 'Staking c) (CompactForm Coin)
credMap (\IncrementalStake c
x Map (Credential 'Staking c) (CompactForm Coin)
y -> IncrementalStake c
x {credMap :: Map (Credential 'Staking c) (CompactForm Coin)
credMap = Map (Credential 'Staking c) (CompactForm Coin)
y})

ptrMapL :: Lens' (IncrementalStake c) (Map Ptr (CompactForm Coin))
ptrMapL :: forall c. Lens' (IncrementalStake c) (Map Ptr (CompactForm Coin))
ptrMapL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall c. IncrementalStake c -> Map Ptr (CompactForm Coin)
ptrMap (\IncrementalStake c
x Map Ptr (CompactForm Coin)
y -> IncrementalStake c
x {ptrMap :: Map Ptr (CompactForm Coin)
ptrMap = Map Ptr (CompactForm Coin)
y})

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

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

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

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

epochStateTreasuryL :: Lens' (EpochState era) Coin
epochStateTreasuryL :: forall era. Lens' (EpochState era) Coin
epochStateTreasuryL = forall era. Lens' (EpochState era) AccountState
esAccountStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' AccountState Coin
asTreasuryL

epochStateIncrStakeDistrL ::
  Lens'
    (EpochState era)
    (Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin))
epochStateIncrStakeDistrL :: forall era.
Lens'
  (EpochState era)
  (Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin))
epochStateIncrStakeDistrL = forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (UTxOState era)
lsUTxOStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Lens' (UTxOState era) (IncrementalStake (EraCrypto era))
utxosStakeDistrL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c.
Lens'
  (IncrementalStake c)
  (Map (Credential 'Staking c) (CompactForm Coin))
credMapL

epochStateRegDrepL ::
  Lens'
    (EpochState era)
    (Map (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era)))
epochStateRegDrepL :: forall era.
Lens'
  (EpochState era)
  (Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era)))
epochStateRegDrepL = forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (CertState era)
lsCertStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (CertState era) (VState era)
certVStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Lens'
  (VState era)
  (Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era)))
vsDRepsL

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

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

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

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

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

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