{-# 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.EpochBoundary (SnapShots (..), ssStakeDistrL, ssStakeMarkL)
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 =
  Map (Credential 'Staking) 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
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 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
esSnapshots :: SnapShots
esSnapshots :: forall era. EpochState era -> SnapShots
esSnapshots, NonMyopic
esNonMyopic :: NonMyopic
esNonMyopic :: forall era. EpochState era -> NonMyopic
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 -> NonMyopic -> 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
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
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
esSnapshots <- forall a s. DecShareCBOR a => StateT (Share a) (Decoder s) a
decSharePlusCBOR
        NonMyopic
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
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) => 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
_ NonMyopic
_) =
  let EpochState {SnapShots
NonMyopic
LedgerState era
AccountState
esNonMyopic :: NonMyopic
esSnapshots :: SnapShots
esLState :: LedgerState era
esAccountState :: AccountState
esNonMyopic :: forall era. EpochState era -> NonMyopic
esSnapshots :: forall era. EpochState era -> SnapShots
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
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
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 = IStake
  { IncrementalStake -> Map (Credential 'Staking) (CompactForm Coin)
credMap :: !(Map (Credential 'Staking) (CompactForm Coin))
  , IncrementalStake -> Map Ptr (CompactForm Coin)
ptrMap :: !(Map Ptr (CompactForm Coin))
  }
  deriving (forall x. Rep IncrementalStake x -> IncrementalStake
forall x. IncrementalStake -> Rep IncrementalStake x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IncrementalStake x -> IncrementalStake
$cfrom :: forall x. IncrementalStake -> Rep IncrementalStake x
Generic, Int -> IncrementalStake -> ShowS
[IncrementalStake] -> ShowS
IncrementalStake -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IncrementalStake] -> ShowS
$cshowList :: [IncrementalStake] -> ShowS
show :: IncrementalStake -> String
$cshow :: IncrementalStake -> String
showsPrec :: Int -> IncrementalStake -> ShowS
$cshowsPrec :: Int -> IncrementalStake -> ShowS
Show, IncrementalStake -> IncrementalStake -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IncrementalStake -> IncrementalStake -> Bool
$c/= :: IncrementalStake -> IncrementalStake -> Bool
== :: IncrementalStake -> IncrementalStake -> Bool
$c== :: IncrementalStake -> IncrementalStake -> Bool
Eq, Eq IncrementalStake
IncrementalStake -> IncrementalStake -> Bool
IncrementalStake -> IncrementalStake -> Ordering
IncrementalStake -> IncrementalStake -> IncrementalStake
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
min :: IncrementalStake -> IncrementalStake -> IncrementalStake
$cmin :: IncrementalStake -> IncrementalStake -> IncrementalStake
max :: IncrementalStake -> IncrementalStake -> IncrementalStake
$cmax :: IncrementalStake -> IncrementalStake -> IncrementalStake
>= :: IncrementalStake -> IncrementalStake -> Bool
$c>= :: IncrementalStake -> IncrementalStake -> Bool
> :: IncrementalStake -> IncrementalStake -> Bool
$c> :: IncrementalStake -> IncrementalStake -> Bool
<= :: IncrementalStake -> IncrementalStake -> Bool
$c<= :: IncrementalStake -> IncrementalStake -> Bool
< :: IncrementalStake -> IncrementalStake -> Bool
$c< :: IncrementalStake -> IncrementalStake -> Bool
compare :: IncrementalStake -> IncrementalStake -> Ordering
$ccompare :: IncrementalStake -> IncrementalStake -> Ordering
Ord, Context -> IncrementalStake -> IO (Maybe ThunkInfo)
Proxy IncrementalStake -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy IncrementalStake -> String
$cshowTypeOf :: Proxy IncrementalStake -> String
wNoThunks :: Context -> IncrementalStake -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> IncrementalStake -> IO (Maybe ThunkInfo)
noThunks :: Context -> IncrementalStake -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> IncrementalStake -> IO (Maybe ThunkInfo)
NoThunks, IncrementalStake -> ()
forall a. (a -> ()) -> NFData a
rnf :: IncrementalStake -> ()
$crnf :: IncrementalStake -> ()
NFData)

instance EncCBOR IncrementalStake where
  encCBOR :: IncrementalStake -> Encoding
encCBOR (IStake Map (Credential 'Staking) (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) (CompactForm Coin)
st forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Map Ptr (CompactForm Coin)
dangle

instance DecShareCBOR IncrementalStake where
  type Share IncrementalStake = Interns (Credential 'Staking)
  decShareCBOR :: forall s. Share IncrementalStake -> Decoder s IncrementalStake
decShareCBOR Share IncrementalStake
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) (CompactForm Coin)
stake <- forall a s. DecShareCBOR a => Share a -> Decoder s a
decShareCBOR (Share IncrementalStake
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
$ Map (Credential 'Staking) (CompactForm Coin)
-> Map Ptr (CompactForm Coin) -> IncrementalStake
IStake Map (Credential 'Staking) (CompactForm Coin)
stake Map Ptr (CompactForm Coin)
ptrs

instance Semigroup IncrementalStake where
  (IStake Map (Credential 'Staking) (CompactForm Coin)
a Map Ptr (CompactForm Coin)
b) <> :: IncrementalStake -> IncrementalStake -> IncrementalStake
<> (IStake Map (Credential 'Staking) (CompactForm Coin)
c Map Ptr (CompactForm Coin)
d) = Map (Credential 'Staking) (CompactForm Coin)
-> Map Ptr (CompactForm Coin) -> IncrementalStake
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) (CompactForm Coin)
a Map (Credential 'Staking) (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 where
  mempty :: IncrementalStake
mempty = Map (Credential 'Staking) (CompactForm Coin)
-> Map Ptr (CompactForm Coin) -> IncrementalStake
IStake forall k a. Map k a
Map.empty forall k a. Map k a
Map.empty

instance Data.Group.Group IncrementalStake where
  invert :: IncrementalStake -> IncrementalStake
invert (IStake Map (Credential 'Staking) (CompactForm Coin)
m1 Map Ptr (CompactForm Coin)
m2) = Map (Credential 'Staking) (CompactForm Coin)
-> Map Ptr (CompactForm Coin) -> IncrementalStake
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) (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 where
  def :: IncrementalStake
def = Map (Credential 'Staking) (CompactForm Coin)
-> Map Ptr (CompactForm Coin) -> IncrementalStake
IStake forall k a. Map k a
Map.empty forall k a. Map k a
Map.empty

instance ToJSON IncrementalStake where
  toJSON :: IncrementalStake -> Value
toJSON = [Pair] -> Value
object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. KeyValue e a => IncrementalStake -> [a]
toIncrementalStakePairs
  toEncoding :: IncrementalStake -> 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 => IncrementalStake -> [a]
toIncrementalStakePairs

toIncrementalStakePairs :: KeyValue e a => IncrementalStake -> [a]
toIncrementalStakePairs :: forall e a. KeyValue e a => IncrementalStake -> [a]
toIncrementalStakePairs iStake :: IncrementalStake
iStake@(IStake Map (Credential 'Staking) (CompactForm Coin)
_ Map Ptr (CompactForm Coin)
_) =
  let IStake {Map (Credential 'Staking) (CompactForm Coin)
Map Ptr (CompactForm Coin)
ptrMap :: Map Ptr (CompactForm Coin)
credMap :: Map (Credential 'Staking) (CompactForm Coin)
ptrMap :: IncrementalStake -> Map Ptr (CompactForm Coin)
credMap :: IncrementalStake -> Map (Credential 'Staking) (CompactForm Coin)
..} = IncrementalStake
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) (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
utxosStakeDistr :: !IncrementalStake
  , 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
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
-> 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
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)
  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
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
utxosDonation :: Coin
utxosStakeDistr :: IncrementalStake
utxosGovState :: GovState era
utxosFees :: Coin
utxosDeposited :: Coin
utxosUtxo :: UTxO era
utxosDonation :: Coin
utxosStakeDistr :: IncrementalStake
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
_ Coin
_) =
  let UTxOState {UTxO era
Coin
GovState era
IncrementalStake
utxosDonation :: Coin
utxosStakeDistr :: IncrementalStake
utxosGovState :: GovState era
utxosFees :: Coin
utxosDeposited :: Coin
utxosUtxo :: UTxO era
utxosDonation :: forall era. UTxOState era -> Coin
utxosStakeDistr :: forall era. UTxOState era -> IncrementalStake
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
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
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 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 = UTxO ShelleyEra
  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
bp BlocksMade
bc EpochState era
es StrictMaybe PulsingRewUpdate
ru PoolDistr
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
bp
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR BlocksMade
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
ru
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR PoolDistr
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
-> BlocksMade
-> EpochState era
-> StrictMaybe PulsingRewUpdate
-> PoolDistr
-> 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 (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 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), Interns (KeyHash 'StakePool))
  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
-> 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 -> NonMyopic -> 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
nesPdL :: forall era. Lens' (NewEpochState era) PoolDistr
nesPdL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era. NewEpochState era -> PoolDistr
nesPd (\NewEpochState era
ds PoolDistr
u -> NewEpochState era
ds {nesPd :: PoolDistr
nesPd = PoolDistr
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
unifiedL :: forall era. Lens' (NewEpochState era) UMap
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
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) Natural)
nesBprevL :: forall era.
Lens' (NewEpochState era) (Map (KeyHash 'StakePool) Natural)
nesBprevL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (BlocksMade -> Map (KeyHash 'StakePool) Natural
unBlocksMade forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. NewEpochState era -> BlocksMade
nesBprev) (\NewEpochState era
ds Map (KeyHash 'StakePool) Natural
u -> NewEpochState era
ds {nesBprev :: BlocksMade
nesBprev = Map (KeyHash 'StakePool) Natural -> BlocksMade
BlocksMade Map (KeyHash 'StakePool) Natural
u})

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

nesRuL :: Lens' (NewEpochState era) (StrictMaybe PulsingRewUpdate)
nesRuL :: forall era.
Lens' (NewEpochState era) (StrictMaybe PulsingRewUpdate)
nesRuL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era. NewEpochState era -> StrictMaybe PulsingRewUpdate
nesRu (\NewEpochState era
ds StrictMaybe PulsingRewUpdate
u -> NewEpochState era
ds {nesRu :: StrictMaybe PulsingRewUpdate
nesRu = StrictMaybe PulsingRewUpdate
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
esSnapshotsL :: forall era. Lens' (EpochState era) SnapShots
esSnapshotsL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era. EpochState era -> SnapShots
esSnapshots (\EpochState era
x SnapShots
y -> EpochState era
x {esSnapshots :: SnapShots
esSnapshots = SnapShots
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
esNonMyopicL :: forall era. Lens' (EpochState era) NonMyopic
esNonMyopicL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era. EpochState era -> NonMyopic
esNonMyopic (\EpochState era
x NonMyopic
y -> EpochState era
x {esNonMyopic :: NonMyopic
esNonMyopic = NonMyopic
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
utxosStakeDistrL :: forall era. Lens' (UTxOState era) IncrementalStake
utxosStakeDistrL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era. UTxOState era -> IncrementalStake
utxosStakeDistr (\UTxOState era
x IncrementalStake
y -> UTxOState era
x {utxosStakeDistr :: IncrementalStake
utxosStakeDistr = IncrementalStake
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 (Map (Credential 'Staking) (CompactForm Coin))
credMapL :: Lens'
  IncrementalStake (Map (Credential 'Staking) (CompactForm Coin))
credMapL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IncrementalStake -> Map (Credential 'Staking) (CompactForm Coin)
credMap (\IncrementalStake
x Map (Credential 'Staking) (CompactForm Coin)
y -> IncrementalStake
x {credMap :: Map (Credential 'Staking) (CompactForm Coin)
credMap = Map (Credential 'Staking) (CompactForm Coin)
y})

ptrMapL :: Lens' IncrementalStake (Map Ptr (CompactForm Coin))
ptrMapL :: Lens' IncrementalStake (Map Ptr (CompactForm Coin))
ptrMapL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IncrementalStake -> Map Ptr (CompactForm Coin)
ptrMap (\IncrementalStake
x Map Ptr (CompactForm Coin)
y -> IncrementalStake
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) (CompactForm Coin))
epochStateIncrStakeDistrL :: forall era.
Lens'
  (EpochState era) (Map (Credential 'Staking) (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
utxosStakeDistrL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens'
  IncrementalStake (Map (Credential 'Staking) (CompactForm Coin))
credMapL

epochStateRegDrepL :: Lens' (EpochState era) (Map (Credential 'DRepRole) DRepState)
epochStateRegDrepL :: forall era.
Lens' (EpochState era) (Map (Credential 'DRepRole) DRepState)
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) DRepState)
vsDRepsL

epochStatePoolParamsL :: Lens' (EpochState era) (Map (KeyHash 'StakePool) PoolParams)
epochStatePoolParamsL :: forall era.
Lens' (EpochState era) (Map (KeyHash 'StakePool) PoolParams)
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) PoolParams)
psStakePoolParamsL

epochStateUMapL :: Lens' (EpochState era) UMap
epochStateUMapL :: forall era. Lens' (EpochState era) UMap
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
dsUnifiedL

epochStateStakeDistrL ::
  Lens' (EpochState era) (VMap VB VP (Credential 'Staking) (CompactForm Coin))
epochStateStakeDistrL :: forall era.
Lens'
  (EpochState era)
  (VMap VB VP (Credential 'Staking) (CompactForm Coin))
epochStateStakeDistrL = forall era. Lens' (EpochState era) SnapShots
esSnapshotsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' SnapShots SnapShot
ssStakeMarkL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens'
  SnapShot (VMap VB VP (Credential 'Staking) (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)