{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}

module Cardano.Ledger.State.CertState (
  EraCertState (..),
  CommitteeAuthorization (..),
  DState (..),
  PState (..),
  InstantaneousRewards (..),
  FutureGenDeleg (..),
  Anchor (..),
  DRepState (..),
  DRep (..),
  CommitteeState (..),
  authorizedHotCommitteeCredentials,
  AnchorData,
  lookupDepositDState,
  lookupRewardDState,
  Obligations (..),
  sumObligation,
  unDelegReDelegStakePool,
  -- Lenses
  iRReservesL,
  dsIRewardsL,
  dsGenDelegsL,
  iRTreasuryL,
  iRDeltaReservesL,
  iRDeltaTreasuryL,
  dsFutureGenDelegsL,
  psStakePoolsL,
  psFutureStakePoolParamsL,
  psRetiringL,
  psVRFKeyHashesL,
) where

import Cardano.Ledger.BaseTypes (
  Anchor (..),
  AnchorData,
  KeyValuePairs (..),
  NonZero,
  StrictMaybe,
  ToKeyValuePairs (..),
 )
import Cardano.Ledger.Binary (
  DecCBOR (..),
  DecShareCBOR (..),
  EncCBOR (..),
  Interns,
  ToCBOR (..),
  decNoShareCBOR,
  decSharePlusCBOR,
  decSharePlusLensCBOR,
  decodeRecordNamed,
  decodeRecordNamedT,
  encodeListLen,
  internsFromSet,
  toMemptyLens,
 )
import Cardano.Ledger.Binary.Coders (Decode (..), Encode (..), decode, encode, (!>), (<!))
import Cardano.Ledger.Coin (Coin (..), DeltaCoin (..))
import Cardano.Ledger.Compactible (Compactible (..), fromCompact)
import Cardano.Ledger.Core
import Cardano.Ledger.Credential (Credential (..))
import Cardano.Ledger.DRep (DRep (..), DRepState (..))
import Cardano.Ledger.Hashes (GenDelegPair (..), GenDelegs (..))
import Cardano.Ledger.Slot (EpochNo (..), SlotNo (..))
import Cardano.Ledger.State.Account
import Cardano.Ledger.State.StakePool (StakePoolParams, StakePoolState (..), spsDelegatorsL)
import Control.DeepSeq (NFData (..))
import Control.Monad.Trans
import Data.Aeson (ToJSON (..), object, (.=))
import Data.Default (Default (def))
import qualified Data.Foldable as F
import Data.Kind (Type)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe)
import qualified Data.Set as Set
import Data.Word (Word64)
import GHC.Generics (Generic)
import Lens.Micro
import NoThunks.Class (NoThunks (..))

data FutureGenDeleg = FutureGenDeleg
  { FutureGenDeleg -> SlotNo
fGenDelegSlot :: !SlotNo
  , FutureGenDeleg -> KeyHash GenesisRole
fGenDelegGenKeyHash :: !(KeyHash GenesisRole)
  }
  deriving (Int -> FutureGenDeleg -> ShowS
[FutureGenDeleg] -> ShowS
FutureGenDeleg -> String
(Int -> FutureGenDeleg -> ShowS)
-> (FutureGenDeleg -> String)
-> ([FutureGenDeleg] -> ShowS)
-> Show FutureGenDeleg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FutureGenDeleg -> ShowS
showsPrec :: Int -> FutureGenDeleg -> ShowS
$cshow :: FutureGenDeleg -> String
show :: FutureGenDeleg -> String
$cshowList :: [FutureGenDeleg] -> ShowS
showList :: [FutureGenDeleg] -> ShowS
Show, FutureGenDeleg -> FutureGenDeleg -> Bool
(FutureGenDeleg -> FutureGenDeleg -> Bool)
-> (FutureGenDeleg -> FutureGenDeleg -> Bool) -> Eq FutureGenDeleg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FutureGenDeleg -> FutureGenDeleg -> Bool
== :: FutureGenDeleg -> FutureGenDeleg -> Bool
$c/= :: FutureGenDeleg -> FutureGenDeleg -> Bool
/= :: FutureGenDeleg -> FutureGenDeleg -> Bool
Eq, Eq FutureGenDeleg
Eq FutureGenDeleg =>
(FutureGenDeleg -> FutureGenDeleg -> Ordering)
-> (FutureGenDeleg -> FutureGenDeleg -> Bool)
-> (FutureGenDeleg -> FutureGenDeleg -> Bool)
-> (FutureGenDeleg -> FutureGenDeleg -> Bool)
-> (FutureGenDeleg -> FutureGenDeleg -> Bool)
-> (FutureGenDeleg -> FutureGenDeleg -> FutureGenDeleg)
-> (FutureGenDeleg -> FutureGenDeleg -> FutureGenDeleg)
-> Ord FutureGenDeleg
FutureGenDeleg -> FutureGenDeleg -> Bool
FutureGenDeleg -> FutureGenDeleg -> Ordering
FutureGenDeleg -> FutureGenDeleg -> FutureGenDeleg
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
$ccompare :: FutureGenDeleg -> FutureGenDeleg -> Ordering
compare :: FutureGenDeleg -> FutureGenDeleg -> Ordering
$c< :: FutureGenDeleg -> FutureGenDeleg -> Bool
< :: FutureGenDeleg -> FutureGenDeleg -> Bool
$c<= :: FutureGenDeleg -> FutureGenDeleg -> Bool
<= :: FutureGenDeleg -> FutureGenDeleg -> Bool
$c> :: FutureGenDeleg -> FutureGenDeleg -> Bool
> :: FutureGenDeleg -> FutureGenDeleg -> Bool
$c>= :: FutureGenDeleg -> FutureGenDeleg -> Bool
>= :: FutureGenDeleg -> FutureGenDeleg -> Bool
$cmax :: FutureGenDeleg -> FutureGenDeleg -> FutureGenDeleg
max :: FutureGenDeleg -> FutureGenDeleg -> FutureGenDeleg
$cmin :: FutureGenDeleg -> FutureGenDeleg -> FutureGenDeleg
min :: FutureGenDeleg -> FutureGenDeleg -> FutureGenDeleg
Ord, (forall x. FutureGenDeleg -> Rep FutureGenDeleg x)
-> (forall x. Rep FutureGenDeleg x -> FutureGenDeleg)
-> Generic FutureGenDeleg
forall x. Rep FutureGenDeleg x -> FutureGenDeleg
forall x. FutureGenDeleg -> Rep FutureGenDeleg x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FutureGenDeleg -> Rep FutureGenDeleg x
from :: forall x. FutureGenDeleg -> Rep FutureGenDeleg x
$cto :: forall x. Rep FutureGenDeleg x -> FutureGenDeleg
to :: forall x. Rep FutureGenDeleg x -> FutureGenDeleg
Generic)

instance NoThunks FutureGenDeleg

instance NFData FutureGenDeleg

instance EncCBOR FutureGenDeleg where
  encCBOR :: FutureGenDeleg -> Encoding
encCBOR (FutureGenDeleg SlotNo
a KeyHash GenesisRole
b) =
    Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SlotNo -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR SlotNo
a Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> KeyHash GenesisRole -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR KeyHash GenesisRole
b

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

instance ToJSON FutureGenDeleg where
  toJSON :: FutureGenDeleg -> Value
toJSON FutureGenDeleg
fGenDeleg =
    [Pair] -> Value
object
      [ Key
"fGenDelegSlot" Key -> SlotNo -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= FutureGenDeleg -> SlotNo
fGenDelegSlot FutureGenDeleg
fGenDeleg
      , Key
"fGenDelegGenKeyHash" Key -> KeyHash GenesisRole -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= FutureGenDeleg -> KeyHash GenesisRole
fGenDelegGenKeyHash FutureGenDeleg
fGenDeleg
      ]

-- | InstantaneousRewards captures the pending changes to the ledger
-- state caused by MIR certificates. It consists of two mappings,
-- the rewards which will be paid out from the reserves and the rewards
-- which will be paid out from the treasury. It also consists of
-- two coin values which represent the transfer of coins from
-- one pot to the other pot.
-- NOTE that the following property should always hold:
--   deltaReserves + deltaTreasury = 0
data InstantaneousRewards = InstantaneousRewards
  { InstantaneousRewards -> Map (Credential Staking) Coin
iRReserves :: !(Map (Credential Staking) Coin)
  , InstantaneousRewards -> Map (Credential Staking) Coin
iRTreasury :: !(Map (Credential Staking) Coin)
  , InstantaneousRewards -> DeltaCoin
deltaReserves :: !DeltaCoin
  , InstantaneousRewards -> DeltaCoin
deltaTreasury :: !DeltaCoin
  }
  deriving (Int -> InstantaneousRewards -> ShowS
[InstantaneousRewards] -> ShowS
InstantaneousRewards -> String
(Int -> InstantaneousRewards -> ShowS)
-> (InstantaneousRewards -> String)
-> ([InstantaneousRewards] -> ShowS)
-> Show InstantaneousRewards
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InstantaneousRewards -> ShowS
showsPrec :: Int -> InstantaneousRewards -> ShowS
$cshow :: InstantaneousRewards -> String
show :: InstantaneousRewards -> String
$cshowList :: [InstantaneousRewards] -> ShowS
showList :: [InstantaneousRewards] -> ShowS
Show, InstantaneousRewards -> InstantaneousRewards -> Bool
(InstantaneousRewards -> InstantaneousRewards -> Bool)
-> (InstantaneousRewards -> InstantaneousRewards -> Bool)
-> Eq InstantaneousRewards
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InstantaneousRewards -> InstantaneousRewards -> Bool
== :: InstantaneousRewards -> InstantaneousRewards -> Bool
$c/= :: InstantaneousRewards -> InstantaneousRewards -> Bool
/= :: InstantaneousRewards -> InstantaneousRewards -> Bool
Eq, (forall x. InstantaneousRewards -> Rep InstantaneousRewards x)
-> (forall x. Rep InstantaneousRewards x -> InstantaneousRewards)
-> Generic InstantaneousRewards
forall x. Rep InstantaneousRewards x -> InstantaneousRewards
forall x. InstantaneousRewards -> Rep InstantaneousRewards x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InstantaneousRewards -> Rep InstantaneousRewards x
from :: forall x. InstantaneousRewards -> Rep InstantaneousRewards x
$cto :: forall x. Rep InstantaneousRewards x -> InstantaneousRewards
to :: forall x. Rep InstantaneousRewards x -> InstantaneousRewards
Generic)
  deriving ([InstantaneousRewards] -> Value
[InstantaneousRewards] -> Encoding
InstantaneousRewards -> Bool
InstantaneousRewards -> Value
InstantaneousRewards -> Encoding
(InstantaneousRewards -> Value)
-> (InstantaneousRewards -> Encoding)
-> ([InstantaneousRewards] -> Value)
-> ([InstantaneousRewards] -> Encoding)
-> (InstantaneousRewards -> Bool)
-> ToJSON InstantaneousRewards
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: InstantaneousRewards -> Value
toJSON :: InstantaneousRewards -> Value
$ctoEncoding :: InstantaneousRewards -> Encoding
toEncoding :: InstantaneousRewards -> Encoding
$ctoJSONList :: [InstantaneousRewards] -> Value
toJSONList :: [InstantaneousRewards] -> Value
$ctoEncodingList :: [InstantaneousRewards] -> Encoding
toEncodingList :: [InstantaneousRewards] -> Encoding
$comitField :: InstantaneousRewards -> Bool
omitField :: InstantaneousRewards -> Bool
ToJSON) via KeyValuePairs InstantaneousRewards

instance NoThunks InstantaneousRewards

instance NFData InstantaneousRewards

instance ToKeyValuePairs InstantaneousRewards where
  toKeyValuePairs :: forall e kv. KeyValue e kv => InstantaneousRewards -> [kv]
toKeyValuePairs InstantaneousRewards {Map (Credential Staking) Coin
DeltaCoin
iRReserves :: InstantaneousRewards -> Map (Credential Staking) Coin
iRTreasury :: InstantaneousRewards -> Map (Credential Staking) Coin
deltaReserves :: InstantaneousRewards -> DeltaCoin
deltaTreasury :: InstantaneousRewards -> DeltaCoin
iRReserves :: Map (Credential Staking) Coin
iRTreasury :: Map (Credential Staking) Coin
deltaReserves :: DeltaCoin
deltaTreasury :: DeltaCoin
..} =
    [ Key
"iRReserves" Key -> Map (Credential Staking) Coin -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map (Credential Staking) Coin
iRReserves
    , Key
"iRTreasury" Key -> Map (Credential Staking) Coin -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map (Credential Staking) Coin
iRTreasury
    , Key
"deltaReserves" Key -> DeltaCoin -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DeltaCoin
deltaReserves
    , Key
"deltaTreasury" Key -> DeltaCoin -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DeltaCoin
deltaTreasury
    ]

-- | The state used by the DELEG rule, which roughly tracks stake
-- delegation and some governance features.
data DState era = DState
  { forall era. DState era -> Accounts era
dsAccounts :: !(Accounts era)
  -- ^ Keep track of the account state (eg. balance, deposit, stake-pool delegation, etc.) for all registered stake credentials.
  , forall era. DState era -> Map FutureGenDeleg GenDelegPair
dsFutureGenDelegs :: !(Map FutureGenDeleg GenDelegPair)
  -- ^ Future genesis key delegations
  , forall era. DState era -> GenDelegs
dsGenDelegs :: !GenDelegs
  -- ^ Genesis key delegations
  , forall era. DState era -> InstantaneousRewards
dsIRewards :: !InstantaneousRewards
  -- ^ Instantaneous Rewards
  }
  deriving ((forall x. DState era -> Rep (DState era) x)
-> (forall x. Rep (DState era) x -> DState era)
-> Generic (DState era)
forall x. Rep (DState era) x -> DState era
forall x. DState era -> Rep (DState era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (DState era) x -> DState era
forall era x. DState era -> Rep (DState era) x
$cfrom :: forall era x. DState era -> Rep (DState era) x
from :: forall x. DState era -> Rep (DState era) x
$cto :: forall era x. Rep (DState era) x -> DState era
to :: forall x. Rep (DState era) x -> DState era
Generic)

instance CanGetAccounts DState

instance CanSetAccounts DState where
  accountsL :: forall era. Lens' (DState era) (Accounts era)
accountsL =
    (DState era -> Accounts era)
-> (DState era -> Accounts era -> DState era)
-> Lens (DState era) (DState era) (Accounts era) (Accounts era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens DState era -> Accounts era
forall era. DState era -> Accounts era
dsAccounts (\DState era
dState Accounts era
accounts -> DState era
dState {dsAccounts = accounts})
  {-# INLINE accountsL #-}

deriving instance Eq (Accounts era) => Eq (DState era)

deriving instance Show (Accounts era) => Show (DState era)

deriving via
  KeyValuePairs (DState era)
  instance
    ToJSON (Accounts era) => ToJSON (DState era)

instance NoThunks (Accounts era) => NoThunks (DState era)

instance NFData (Accounts era) => NFData (DState era)

instance (Era era, EncCBOR (Accounts era)) => EncCBOR (DState era) where
  encCBOR :: DState era -> Encoding
encCBOR dState :: DState era
dState@(DState Accounts era
_ Map FutureGenDeleg GenDelegPair
_ GenDelegs
_ InstantaneousRewards
_) =
    let DState {Map FutureGenDeleg GenDelegPair
GenDelegs
Accounts era
InstantaneousRewards
dsAccounts :: forall era. DState era -> Accounts era
dsFutureGenDelegs :: forall era. DState era -> Map FutureGenDeleg GenDelegPair
dsGenDelegs :: forall era. DState era -> GenDelegs
dsIRewards :: forall era. DState era -> InstantaneousRewards
dsAccounts :: Accounts era
dsFutureGenDelegs :: Map FutureGenDeleg GenDelegPair
dsGenDelegs :: GenDelegs
dsIRewards :: InstantaneousRewards
..} = DState era
dState
     in Word -> Encoding
encodeListLen Word
4
          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Accounts era -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Accounts era
dsAccounts
          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map FutureGenDeleg GenDelegPair -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Map FutureGenDeleg GenDelegPair
dsFutureGenDelegs
          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> GenDelegs -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR GenDelegs
dsGenDelegs
          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> InstantaneousRewards -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR InstantaneousRewards
dsIRewards

instance EraAccounts era => DecShareCBOR (DState era) where
  type
    Share (DState era) =
      (Interns (Credential Staking), Interns (KeyHash StakePool), Interns (Credential DRepRole))
  decSharePlusCBOR :: forall s. StateT (Share (DState era)) (Decoder s) (DState era)
decSharePlusCBOR =
    Text
-> (DState era -> Int)
-> StateT (Share (DState era)) (Decoder s) (DState era)
-> StateT (Share (DState era)) (Decoder s) (DState era)
forall (m :: (* -> *) -> * -> *) s a.
(MonadTrans m, Monad (m (Decoder s))) =>
Text -> (a -> Int) -> m (Decoder s) a -> m (Decoder s) a
decodeRecordNamedT Text
"DState" (Int -> DState era -> Int
forall a b. a -> b -> a
const Int
4) (StateT (Share (DState era)) (Decoder s) (DState era)
 -> StateT (Share (DState era)) (Decoder s) (DState era))
-> StateT (Share (DState era)) (Decoder s) (DState era)
-> StateT (Share (DState era)) (Decoder s) (DState era)
forall a b. (a -> b) -> a -> b
$ do
      dsAccounts <- StateT
  (Interns (Credential Staking), Interns (KeyHash StakePool),
   Interns (Credential DRepRole))
  (Decoder s)
  (Accounts era)
StateT (Share (Accounts era)) (Decoder s) (Accounts era)
forall s. StateT (Share (Accounts era)) (Decoder s) (Accounts era)
forall a s. DecShareCBOR a => StateT (Share a) (Decoder s) a
decSharePlusCBOR
      dsFutureGenDelegs <- lift decCBOR
      dsGenDelegs <- lift decCBOR
      dsIRewards <- decSharePlusLensCBOR _1
      pure DState {..}

instance ToJSON (Accounts era) => ToKeyValuePairs (DState era) where
  toKeyValuePairs :: forall e kv. KeyValue e kv => DState era -> [kv]
toKeyValuePairs dState :: DState era
dState@(DState Accounts era
_ Map FutureGenDeleg GenDelegPair
_ GenDelegs
_ InstantaneousRewards
_) =
    let DState {Map FutureGenDeleg GenDelegPair
GenDelegs
Accounts era
InstantaneousRewards
dsAccounts :: forall era. DState era -> Accounts era
dsFutureGenDelegs :: forall era. DState era -> Map FutureGenDeleg GenDelegPair
dsGenDelegs :: forall era. DState era -> GenDelegs
dsIRewards :: forall era. DState era -> InstantaneousRewards
dsAccounts :: Accounts era
dsFutureGenDelegs :: Map FutureGenDeleg GenDelegPair
dsGenDelegs :: GenDelegs
dsIRewards :: InstantaneousRewards
..} = DState era
dState
     in [ Key
"accounts" Key -> Accounts era -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Accounts era
dsAccounts
        , Key
"fGenDelegs" Key -> [(FutureGenDeleg, GenDelegPair)] -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map FutureGenDeleg GenDelegPair -> [(FutureGenDeleg, GenDelegPair)]
forall k a. Map k a -> [(k, a)]
Map.toList Map FutureGenDeleg GenDelegPair
dsFutureGenDelegs
        , Key
"genDelegs" Key -> GenDelegs -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= GenDelegs
dsGenDelegs
        , Key
"irwd" Key -> InstantaneousRewards -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= InstantaneousRewards
dsIRewards
        ]

-- | Function that looks up the deposit for currently delegated staking credential
lookupDepositDState :: EraAccounts era => DState era -> (Credential Staking -> Maybe Coin)
lookupDepositDState :: forall era.
EraAccounts era =>
DState era -> Credential Staking -> Maybe Coin
lookupDepositDState DState {Accounts era
dsAccounts :: forall era. DState era -> Accounts era
dsAccounts :: Accounts era
dsAccounts} Credential Staking
cred = do
  accountState <- Credential Staking
-> Map (Credential Staking) (AccountState era)
-> Maybe (AccountState era)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential Staking
cred (Accounts era
dsAccounts Accounts era
-> Getting
     (Map (Credential Staking) (AccountState era))
     (Accounts era)
     (Map (Credential Staking) (AccountState era))
-> Map (Credential Staking) (AccountState era)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map (Credential Staking) (AccountState era))
  (Accounts era)
  (Map (Credential Staking) (AccountState era))
forall era.
EraAccounts era =>
Lens' (Accounts era) (Map (Credential Staking) (AccountState era))
Lens' (Accounts era) (Map (Credential Staking) (AccountState era))
accountsMapL)
  Just $! fromCompact (accountState ^. depositAccountStateL)

-- | Function that looks up curret reward for the delegated staking credential.
lookupRewardDState :: EraAccounts era => DState era -> (Credential Staking -> Maybe Coin)
lookupRewardDState :: forall era.
EraAccounts era =>
DState era -> Credential Staking -> Maybe Coin
lookupRewardDState DState {Accounts era
dsAccounts :: forall era. DState era -> Accounts era
dsAccounts :: Accounts era
dsAccounts} Credential Staking
cred = do
  accountState <- Credential Staking
-> Map (Credential Staking) (AccountState era)
-> Maybe (AccountState era)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential Staking
cred (Accounts era
dsAccounts Accounts era
-> Getting
     (Map (Credential Staking) (AccountState era))
     (Accounts era)
     (Map (Credential Staking) (AccountState era))
-> Map (Credential Staking) (AccountState era)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map (Credential Staking) (AccountState era))
  (Accounts era)
  (Map (Credential Staking) (AccountState era))
forall era.
EraAccounts era =>
Lens' (Accounts era) (Map (Credential Staking) (AccountState era))
Lens' (Accounts era) (Map (Credential Staking) (AccountState era))
accountsMapL)
  Just $! fromCompact (accountState ^. balanceAccountStateL)

-- | The state used by the POOL rule, which tracks stake pool information.
data PState era = PState
  { forall era.
PState era -> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
psVRFKeyHashes :: !(Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64))
  -- ^ VRF key hashes that have been registered via PoolParams
  , forall era. PState era -> Map (KeyHash StakePool) StakePoolState
psStakePools :: !(Map (KeyHash StakePool) StakePoolState)
  -- ^ The state of current stake pools.
  , forall era. PState era -> Map (KeyHash StakePool) StakePoolParams
psFutureStakePoolParams :: !(Map (KeyHash StakePool) StakePoolParams)
  -- ^ Future pool params
  -- Changes to existing stake pool parameters are staged in order
  -- to give delegators time to react to changes.
  -- See section 11.2, "Example Illustration of the Reward Cycle",
  -- of the Shelley Ledger Specification for a sequence diagram.
  , forall era. PState era -> Map (KeyHash StakePool) EpochNo
psRetiring :: !(Map (KeyHash StakePool) EpochNo)
  -- ^ A map of retiring stake pools to the epoch when they retire.
  }
  deriving (Int -> PState era -> ShowS
[PState era] -> ShowS
PState era -> String
(Int -> PState era -> ShowS)
-> (PState era -> String)
-> ([PState era] -> ShowS)
-> Show (PState era)
forall era. Int -> PState era -> ShowS
forall era. [PState era] -> ShowS
forall era. PState era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era. Int -> PState era -> ShowS
showsPrec :: Int -> PState era -> ShowS
$cshow :: forall era. PState era -> String
show :: PState era -> String
$cshowList :: forall era. [PState era] -> ShowS
showList :: [PState era] -> ShowS
Show, PState era -> PState era -> Bool
(PState era -> PState era -> Bool)
-> (PState era -> PState era -> Bool) -> Eq (PState era)
forall era. PState era -> PState era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall era. PState era -> PState era -> Bool
== :: PState era -> PState era -> Bool
$c/= :: forall era. PState era -> PState era -> Bool
/= :: PState era -> PState era -> Bool
Eq, (forall x. PState era -> Rep (PState era) x)
-> (forall x. Rep (PState era) x -> PState era)
-> Generic (PState era)
forall x. Rep (PState era) x -> PState era
forall x. PState era -> Rep (PState era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (PState era) x -> PState era
forall era x. PState era -> Rep (PState era) x
$cfrom :: forall era x. PState era -> Rep (PState era) x
from :: forall x. PState era -> Rep (PState era) x
$cto :: forall era x. Rep (PState era) x -> PState era
to :: forall x. Rep (PState era) x -> PState era
Generic)
  deriving ([PState era] -> Value
[PState era] -> Encoding
PState era -> Bool
PState era -> Value
PState era -> Encoding
(PState era -> Value)
-> (PState era -> Encoding)
-> ([PState era] -> Value)
-> ([PState era] -> Encoding)
-> (PState era -> Bool)
-> ToJSON (PState era)
forall era. [PState era] -> Value
forall era. [PState era] -> Encoding
forall era. PState era -> Bool
forall era. PState era -> Value
forall era. PState era -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: forall era. PState era -> Value
toJSON :: PState era -> Value
$ctoEncoding :: forall era. PState era -> Encoding
toEncoding :: PState era -> Encoding
$ctoJSONList :: forall era. [PState era] -> Value
toJSONList :: [PState era] -> Value
$ctoEncodingList :: forall era. [PState era] -> Encoding
toEncodingList :: [PState era] -> Encoding
$comitField :: forall era. PState era -> Bool
omitField :: PState era -> Bool
ToJSON) via KeyValuePairs (PState era)

instance NoThunks (PState era)

instance NFData (PState era)

instance Era era => EncCBOR (PState era) where
  encCBOR :: PState era -> Encoding
encCBOR (PState Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
a Map (KeyHash StakePool) StakePoolState
b Map (KeyHash StakePool) StakePoolParams
c Map (KeyHash StakePool) EpochNo
d) =
    Word -> Encoding
encodeListLen Word
4 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64) -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
a Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map (KeyHash StakePool) StakePoolState -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Map (KeyHash StakePool) StakePoolState
b Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map (KeyHash StakePool) StakePoolParams -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Map (KeyHash StakePool) StakePoolParams
c Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map (KeyHash StakePool) EpochNo -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Map (KeyHash StakePool) EpochNo
d

instance DecShareCBOR (PState era) where
  type Share (PState era) = (Interns (VRFVerKeyHash StakePoolVRF), Interns (KeyHash StakePool))

  decSharePlusCBOR :: forall s. StateT (Share (PState era)) (Decoder s) (PState era)
decSharePlusCBOR = Text
-> (PState era -> Int)
-> StateT (Share (PState era)) (Decoder s) (PState era)
-> StateT (Share (PState era)) (Decoder s) (PState era)
forall (m :: (* -> *) -> * -> *) s a.
(MonadTrans m, Monad (m (Decoder s))) =>
Text -> (a -> Int) -> m (Decoder s) a -> m (Decoder s) a
decodeRecordNamedT Text
"PState" (Int -> PState era -> Int
forall a b. a -> b -> a
const Int
4) (StateT (Share (PState era)) (Decoder s) (PState era)
 -> StateT (Share (PState era)) (Decoder s) (PState era))
-> StateT (Share (PState era)) (Decoder s) (PState era)
-> StateT (Share (PState era)) (Decoder s) (PState era)
forall a b. (a -> b) -> a -> b
$ do
    psVRFKeyHashes <- Lens'
  (Interns (VRFVerKeyHash StakePoolVRF), Interns (KeyHash StakePool))
  (Share (Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)))
-> StateT
     (Interns (VRFVerKeyHash StakePoolVRF), Interns (KeyHash StakePool))
     (Decoder s)
     (Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64))
forall b bs s.
DecShareCBOR b =>
Lens' bs (Share b) -> StateT bs (Decoder s) b
decSharePlusLensCBOR (Lens'
  (Interns (VRFVerKeyHash StakePoolVRF), Interns (NonZero Word64))
  (Interns (VRFVerKeyHash StakePoolVRF))
-> Lens'
     (Interns (VRFVerKeyHash StakePoolVRF), Interns (KeyHash StakePool))
     (Interns (VRFVerKeyHash StakePoolVRF))
-> Lens'
     (Interns (VRFVerKeyHash StakePoolVRF), Interns (KeyHash StakePool))
     (Interns (VRFVerKeyHash StakePoolVRF), Interns (NonZero Word64))
forall a b c. Monoid a => Lens' a b -> Lens' c b -> Lens' c a
toMemptyLens (Interns (VRFVerKeyHash StakePoolVRF)
 -> f (Interns (VRFVerKeyHash StakePoolVRF)))
-> (Interns (VRFVerKeyHash StakePoolVRF), Interns (NonZero Word64))
-> f (Interns (VRFVerKeyHash StakePoolVRF),
      Interns (NonZero Word64))
forall s t a b. Field1 s t a b => Lens s t a b
Lens'
  (Interns (VRFVerKeyHash StakePoolVRF), Interns (NonZero Word64))
  (Interns (VRFVerKeyHash StakePoolVRF))
_1 (Interns (VRFVerKeyHash StakePoolVRF)
 -> f (Interns (VRFVerKeyHash StakePoolVRF)))
-> (Interns (VRFVerKeyHash StakePoolVRF),
    Interns (KeyHash StakePool))
-> f (Interns (VRFVerKeyHash StakePoolVRF),
      Interns (KeyHash StakePool))
forall s t a b. Field1 s t a b => Lens s t a b
Lens'
  (Interns (VRFVerKeyHash StakePoolVRF), Interns (KeyHash StakePool))
  (Interns (VRFVerKeyHash StakePoolVRF))
_1)
    psStakePools <- decSharePlusLensCBOR (toMemptyLens _1 _2)
    psFutureStakePoolParams <- decSharePlusLensCBOR (toMemptyLens _1 _2)
    psRetiring <- decSharePlusLensCBOR (toMemptyLens _1 _2)
    pure PState {psVRFKeyHashes, psStakePools, psFutureStakePoolParams, psRetiring}

instance (Era era, DecShareCBOR (PState era)) => DecCBOR (PState era) where
  decCBOR :: forall s. Decoder s (PState era)
decCBOR = Decoder s (PState era)
forall a s. DecShareCBOR a => Decoder s a
decNoShareCBOR

instance ToKeyValuePairs (PState era) where
  toKeyValuePairs :: forall e kv. KeyValue e kv => PState era -> [kv]
toKeyValuePairs PState {Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
Map (KeyHash StakePool) EpochNo
Map (KeyHash StakePool) StakePoolParams
Map (KeyHash StakePool) StakePoolState
psVRFKeyHashes :: forall era.
PState era -> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
psStakePools :: forall era. PState era -> Map (KeyHash StakePool) StakePoolState
psFutureStakePoolParams :: forall era. PState era -> Map (KeyHash StakePool) StakePoolParams
psRetiring :: forall era. PState era -> Map (KeyHash StakePool) EpochNo
psVRFKeyHashes :: Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
psStakePools :: Map (KeyHash StakePool) StakePoolState
psFutureStakePoolParams :: Map (KeyHash StakePool) StakePoolParams
psRetiring :: Map (KeyHash StakePool) EpochNo
..} =
    [ Key
"vrfKeyHashes" Key -> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64) -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
psVRFKeyHashes
    , Key
"stakePools" Key -> Map (KeyHash StakePool) StakePoolState -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map (KeyHash StakePool) StakePoolState
psStakePools
    , Key
"futureStakePoolParams" Key -> Map (KeyHash StakePool) StakePoolParams -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map (KeyHash StakePool) StakePoolParams
psFutureStakePoolParams
    , Key
"retiring" Key -> Map (KeyHash StakePool) EpochNo -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map (KeyHash StakePool) EpochNo
psRetiring
    ]

-- | Reverses stake pool delegation.
-- To be called when a stake credential is unregistered or its delegation target changes.
-- If the new delegation matches the previous one, this is a noop.
unDelegReDelegStakePool ::
  EraAccounts era =>
  Credential Staking ->
  -- | Account that is losing its current delegation and/or acquiring a new one
  AccountState era ->
  -- | Optional new delegation target. Use 'Nothing' when the stake credential unregisters.
  Maybe (KeyHash StakePool) ->
  PState era ->
  PState era
unDelegReDelegStakePool :: forall era.
EraAccounts era =>
Credential Staking
-> AccountState era
-> Maybe (KeyHash StakePool)
-> PState era
-> PState era
unDelegReDelegStakePool Credential Staking
stakeCred AccountState era
accountState Maybe (KeyHash StakePool)
mNewStakePool =
  (PState era -> PState era)
-> Maybe (PState era -> PState era) -> PState era -> PState era
forall a. a -> Maybe a -> a
fromMaybe ((Map (KeyHash StakePool) StakePoolState
 -> Identity (Map (KeyHash StakePool) StakePoolState))
-> PState era -> Identity (PState era)
forall era (f :: * -> *).
Functor f =>
(Map (KeyHash StakePool) StakePoolState
 -> f (Map (KeyHash StakePool) StakePoolState))
-> PState era -> f (PState era)
psStakePoolsL ((Map (KeyHash StakePool) StakePoolState
  -> Identity (Map (KeyHash StakePool) StakePoolState))
 -> PState era -> Identity (PState era))
-> (Map (KeyHash StakePool) StakePoolState
    -> Map (KeyHash StakePool) StakePoolState)
-> PState era
-> PState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Map (KeyHash StakePool) StakePoolState
-> Map (KeyHash StakePool) StakePoolState
addNewDelegation) (Maybe (PState era -> PState era) -> PState era -> PState era)
-> Maybe (PState era -> PState era) -> PState era -> PState era
forall a b. (a -> b) -> a -> b
$ do
    curStakePool <- AccountState era
accountState AccountState era
-> Getting
     (Maybe (KeyHash StakePool))
     (AccountState era)
     (Maybe (KeyHash StakePool))
-> Maybe (KeyHash StakePool)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (KeyHash StakePool))
  (AccountState era)
  (Maybe (KeyHash StakePool))
forall era.
EraAccounts era =>
Lens' (AccountState era) (Maybe (KeyHash StakePool))
Lens' (AccountState era) (Maybe (KeyHash StakePool))
stakePoolDelegationAccountStateL
    pure $
      -- no need to update the set of delegations if the delegation is unchanged
      if Just curStakePool == mNewStakePool
        then id
        else
          psStakePoolsL %~ addNewDelegation . Map.adjust (spsDelegatorsL %~ Set.delete stakeCred) curStakePool
  where
    addNewDelegation :: Map (KeyHash StakePool) StakePoolState
-> Map (KeyHash StakePool) StakePoolState
addNewDelegation = (Map (KeyHash StakePool) StakePoolState
 -> Map (KeyHash StakePool) StakePoolState)
-> (KeyHash StakePool
    -> Map (KeyHash StakePool) StakePoolState
    -> Map (KeyHash StakePool) StakePoolState)
-> Maybe (KeyHash StakePool)
-> Map (KeyHash StakePool) StakePoolState
-> Map (KeyHash StakePool) StakePoolState
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map (KeyHash StakePool) StakePoolState
-> Map (KeyHash StakePool) StakePoolState
forall a. a -> a
id ((StakePoolState -> StakePoolState)
-> KeyHash StakePool
-> Map (KeyHash StakePool) StakePoolState
-> Map (KeyHash StakePool) StakePoolState
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust ((Set (Credential Staking) -> Identity (Set (Credential Staking)))
-> StakePoolState -> Identity StakePoolState
Lens' StakePoolState (Set (Credential Staking))
spsDelegatorsL ((Set (Credential Staking) -> Identity (Set (Credential Staking)))
 -> StakePoolState -> Identity StakePoolState)
-> (Set (Credential Staking) -> Set (Credential Staking))
-> StakePoolState
-> StakePoolState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Credential Staking
-> Set (Credential Staking) -> Set (Credential Staking)
forall a. Ord a => a -> Set a -> Set a
Set.insert Credential Staking
stakeCred)) Maybe (KeyHash StakePool)
mNewStakePool

data CommitteeAuthorization
  = -- | Member authorized with a Hot credential acting on behalf of their Cold credential
    CommitteeHotCredential !(Credential HotCommitteeRole)
  | -- | Member resigned with a potential explanation in Anchor
    CommitteeMemberResigned !(StrictMaybe Anchor)
  deriving (CommitteeAuthorization -> CommitteeAuthorization -> Bool
(CommitteeAuthorization -> CommitteeAuthorization -> Bool)
-> (CommitteeAuthorization -> CommitteeAuthorization -> Bool)
-> Eq CommitteeAuthorization
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommitteeAuthorization -> CommitteeAuthorization -> Bool
== :: CommitteeAuthorization -> CommitteeAuthorization -> Bool
$c/= :: CommitteeAuthorization -> CommitteeAuthorization -> Bool
/= :: CommitteeAuthorization -> CommitteeAuthorization -> Bool
Eq, Eq CommitteeAuthorization
Eq CommitteeAuthorization =>
(CommitteeAuthorization -> CommitteeAuthorization -> Ordering)
-> (CommitteeAuthorization -> CommitteeAuthorization -> Bool)
-> (CommitteeAuthorization -> CommitteeAuthorization -> Bool)
-> (CommitteeAuthorization -> CommitteeAuthorization -> Bool)
-> (CommitteeAuthorization -> CommitteeAuthorization -> Bool)
-> (CommitteeAuthorization
    -> CommitteeAuthorization -> CommitteeAuthorization)
-> (CommitteeAuthorization
    -> CommitteeAuthorization -> CommitteeAuthorization)
-> Ord CommitteeAuthorization
CommitteeAuthorization -> CommitteeAuthorization -> Bool
CommitteeAuthorization -> CommitteeAuthorization -> Ordering
CommitteeAuthorization
-> CommitteeAuthorization -> CommitteeAuthorization
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
$ccompare :: CommitteeAuthorization -> CommitteeAuthorization -> Ordering
compare :: CommitteeAuthorization -> CommitteeAuthorization -> Ordering
$c< :: CommitteeAuthorization -> CommitteeAuthorization -> Bool
< :: CommitteeAuthorization -> CommitteeAuthorization -> Bool
$c<= :: CommitteeAuthorization -> CommitteeAuthorization -> Bool
<= :: CommitteeAuthorization -> CommitteeAuthorization -> Bool
$c> :: CommitteeAuthorization -> CommitteeAuthorization -> Bool
> :: CommitteeAuthorization -> CommitteeAuthorization -> Bool
$c>= :: CommitteeAuthorization -> CommitteeAuthorization -> Bool
>= :: CommitteeAuthorization -> CommitteeAuthorization -> Bool
$cmax :: CommitteeAuthorization
-> CommitteeAuthorization -> CommitteeAuthorization
max :: CommitteeAuthorization
-> CommitteeAuthorization -> CommitteeAuthorization
$cmin :: CommitteeAuthorization
-> CommitteeAuthorization -> CommitteeAuthorization
min :: CommitteeAuthorization
-> CommitteeAuthorization -> CommitteeAuthorization
Ord, Int -> CommitteeAuthorization -> ShowS
[CommitteeAuthorization] -> ShowS
CommitteeAuthorization -> String
(Int -> CommitteeAuthorization -> ShowS)
-> (CommitteeAuthorization -> String)
-> ([CommitteeAuthorization] -> ShowS)
-> Show CommitteeAuthorization
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommitteeAuthorization -> ShowS
showsPrec :: Int -> CommitteeAuthorization -> ShowS
$cshow :: CommitteeAuthorization -> String
show :: CommitteeAuthorization -> String
$cshowList :: [CommitteeAuthorization] -> ShowS
showList :: [CommitteeAuthorization] -> ShowS
Show, (forall x. CommitteeAuthorization -> Rep CommitteeAuthorization x)
-> (forall x.
    Rep CommitteeAuthorization x -> CommitteeAuthorization)
-> Generic CommitteeAuthorization
forall x. Rep CommitteeAuthorization x -> CommitteeAuthorization
forall x. CommitteeAuthorization -> Rep CommitteeAuthorization x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CommitteeAuthorization -> Rep CommitteeAuthorization x
from :: forall x. CommitteeAuthorization -> Rep CommitteeAuthorization x
$cto :: forall x. Rep CommitteeAuthorization x -> CommitteeAuthorization
to :: forall x. Rep CommitteeAuthorization x -> CommitteeAuthorization
Generic)

instance NoThunks CommitteeAuthorization

instance NFData CommitteeAuthorization

instance ToJSON CommitteeAuthorization

instance EncCBOR CommitteeAuthorization where
  encCBOR :: CommitteeAuthorization -> Encoding
encCBOR =
    Encode Open CommitteeAuthorization -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode Open CommitteeAuthorization -> Encoding)
-> (CommitteeAuthorization -> Encode Open CommitteeAuthorization)
-> CommitteeAuthorization
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      CommitteeHotCredential Credential HotCommitteeRole
cred -> (Credential HotCommitteeRole -> CommitteeAuthorization)
-> Word
-> Encode
     Open (Credential HotCommitteeRole -> CommitteeAuthorization)
forall t. t -> Word -> Encode Open t
Sum Credential HotCommitteeRole -> CommitteeAuthorization
CommitteeHotCredential Word
0 Encode Open (Credential HotCommitteeRole -> CommitteeAuthorization)
-> Encode (Closed Dense) (Credential HotCommitteeRole)
-> Encode Open CommitteeAuthorization
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Credential HotCommitteeRole
-> Encode (Closed Dense) (Credential HotCommitteeRole)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Credential HotCommitteeRole
cred
      CommitteeMemberResigned StrictMaybe Anchor
anchor -> (StrictMaybe Anchor -> CommitteeAuthorization)
-> Word
-> Encode Open (StrictMaybe Anchor -> CommitteeAuthorization)
forall t. t -> Word -> Encode Open t
Sum StrictMaybe Anchor -> CommitteeAuthorization
CommitteeMemberResigned Word
1 Encode Open (StrictMaybe Anchor -> CommitteeAuthorization)
-> Encode (Closed Dense) (StrictMaybe Anchor)
-> Encode Open CommitteeAuthorization
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> StrictMaybe Anchor -> Encode (Closed Dense) (StrictMaybe Anchor)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To StrictMaybe Anchor
anchor

instance DecCBOR CommitteeAuthorization where
  decCBOR :: forall s. Decoder s CommitteeAuthorization
decCBOR =
    Decode (Closed Dense) CommitteeAuthorization
-> Decoder s CommitteeAuthorization
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode (Closed Dense) CommitteeAuthorization
 -> Decoder s CommitteeAuthorization)
-> Decode (Closed Dense) CommitteeAuthorization
-> Decoder s CommitteeAuthorization
forall a b. (a -> b) -> a -> b
$ Text
-> (Word -> Decode Open CommitteeAuthorization)
-> Decode (Closed Dense) CommitteeAuthorization
forall t.
Text -> (Word -> Decode Open t) -> Decode (Closed Dense) t
Summands Text
"CommitteeAuthorization" ((Word -> Decode Open CommitteeAuthorization)
 -> Decode (Closed Dense) CommitteeAuthorization)
-> (Word -> Decode Open CommitteeAuthorization)
-> Decode (Closed Dense) CommitteeAuthorization
forall a b. (a -> b) -> a -> b
$ \case
      Word
0 -> (Credential HotCommitteeRole -> CommitteeAuthorization)
-> Decode
     Open (Credential HotCommitteeRole -> CommitteeAuthorization)
forall t. t -> Decode Open t
SumD Credential HotCommitteeRole -> CommitteeAuthorization
CommitteeHotCredential Decode Open (Credential HotCommitteeRole -> CommitteeAuthorization)
-> Decode (Closed (ZonkAny 0)) (Credential HotCommitteeRole)
-> Decode Open CommitteeAuthorization
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 0)) (Credential HotCommitteeRole)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      Word
1 -> (StrictMaybe Anchor -> CommitteeAuthorization)
-> Decode Open (StrictMaybe Anchor -> CommitteeAuthorization)
forall t. t -> Decode Open t
SumD StrictMaybe Anchor -> CommitteeAuthorization
CommitteeMemberResigned Decode Open (StrictMaybe Anchor -> CommitteeAuthorization)
-> Decode (Closed (ZonkAny 1)) (StrictMaybe Anchor)
-> Decode Open CommitteeAuthorization
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 1)) (StrictMaybe Anchor)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      Word
k -> Word -> Decode Open CommitteeAuthorization
forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
k

newtype CommitteeState era = CommitteeState
  { forall era.
CommitteeState era
-> Map (Credential ColdCommitteeRole) CommitteeAuthorization
csCommitteeCreds :: Map (Credential ColdCommitteeRole) CommitteeAuthorization
  }
  deriving (CommitteeState era -> CommitteeState era -> Bool
(CommitteeState era -> CommitteeState era -> Bool)
-> (CommitteeState era -> CommitteeState era -> Bool)
-> Eq (CommitteeState era)
forall era. CommitteeState era -> CommitteeState era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall era. CommitteeState era -> CommitteeState era -> Bool
== :: CommitteeState era -> CommitteeState era -> Bool
$c/= :: forall era. CommitteeState era -> CommitteeState era -> Bool
/= :: CommitteeState era -> CommitteeState era -> Bool
Eq, Eq (CommitteeState era)
Eq (CommitteeState era) =>
(CommitteeState era -> CommitteeState era -> Ordering)
-> (CommitteeState era -> CommitteeState era -> Bool)
-> (CommitteeState era -> CommitteeState era -> Bool)
-> (CommitteeState era -> CommitteeState era -> Bool)
-> (CommitteeState era -> CommitteeState era -> Bool)
-> (CommitteeState era -> CommitteeState era -> CommitteeState era)
-> (CommitteeState era -> CommitteeState era -> CommitteeState era)
-> Ord (CommitteeState era)
CommitteeState era -> CommitteeState era -> Bool
CommitteeState era -> CommitteeState era -> Ordering
CommitteeState era -> CommitteeState era -> CommitteeState era
forall era. Eq (CommitteeState era)
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 era. CommitteeState era -> CommitteeState era -> Bool
forall era. CommitteeState era -> CommitteeState era -> Ordering
forall era.
CommitteeState era -> CommitteeState era -> CommitteeState era
$ccompare :: forall era. CommitteeState era -> CommitteeState era -> Ordering
compare :: CommitteeState era -> CommitteeState era -> Ordering
$c< :: forall era. CommitteeState era -> CommitteeState era -> Bool
< :: CommitteeState era -> CommitteeState era -> Bool
$c<= :: forall era. CommitteeState era -> CommitteeState era -> Bool
<= :: CommitteeState era -> CommitteeState era -> Bool
$c> :: forall era. CommitteeState era -> CommitteeState era -> Bool
> :: CommitteeState era -> CommitteeState era -> Bool
$c>= :: forall era. CommitteeState era -> CommitteeState era -> Bool
>= :: CommitteeState era -> CommitteeState era -> Bool
$cmax :: forall era.
CommitteeState era -> CommitteeState era -> CommitteeState era
max :: CommitteeState era -> CommitteeState era -> CommitteeState era
$cmin :: forall era.
CommitteeState era -> CommitteeState era -> CommitteeState era
min :: CommitteeState era -> CommitteeState era -> CommitteeState era
Ord, Int -> CommitteeState era -> ShowS
[CommitteeState era] -> ShowS
CommitteeState era -> String
(Int -> CommitteeState era -> ShowS)
-> (CommitteeState era -> String)
-> ([CommitteeState era] -> ShowS)
-> Show (CommitteeState era)
forall era. Int -> CommitteeState era -> ShowS
forall era. [CommitteeState era] -> ShowS
forall era. CommitteeState era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era. Int -> CommitteeState era -> ShowS
showsPrec :: Int -> CommitteeState era -> ShowS
$cshow :: forall era. CommitteeState era -> String
show :: CommitteeState era -> String
$cshowList :: forall era. [CommitteeState era] -> ShowS
showList :: [CommitteeState era] -> ShowS
Show, (forall x. CommitteeState era -> Rep (CommitteeState era) x)
-> (forall x. Rep (CommitteeState era) x -> CommitteeState era)
-> Generic (CommitteeState era)
forall x. Rep (CommitteeState era) x -> CommitteeState era
forall x. CommitteeState era -> Rep (CommitteeState era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (CommitteeState era) x -> CommitteeState era
forall era x. CommitteeState era -> Rep (CommitteeState era) x
$cfrom :: forall era x. CommitteeState era -> Rep (CommitteeState era) x
from :: forall x. CommitteeState era -> Rep (CommitteeState era) x
$cto :: forall era x. Rep (CommitteeState era) x -> CommitteeState era
to :: forall x. Rep (CommitteeState era) x -> CommitteeState era
Generic, CommitteeState era -> Encoding
(CommitteeState era -> Encoding) -> EncCBOR (CommitteeState era)
forall era. CommitteeState era -> Encoding
forall a. (a -> Encoding) -> EncCBOR a
$cencCBOR :: forall era. CommitteeState era -> Encoding
encCBOR :: CommitteeState era -> Encoding
EncCBOR, CommitteeState era -> ()
(CommitteeState era -> ()) -> NFData (CommitteeState era)
forall era. CommitteeState era -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall era. CommitteeState era -> ()
rnf :: CommitteeState era -> ()
NFData, CommitteeState era
CommitteeState era -> Default (CommitteeState era)
forall era. CommitteeState era
forall a. a -> Default a
$cdef :: forall era. CommitteeState era
def :: CommitteeState era
Default, Context -> CommitteeState era -> IO (Maybe ThunkInfo)
Proxy (CommitteeState era) -> String
(Context -> CommitteeState era -> IO (Maybe ThunkInfo))
-> (Context -> CommitteeState era -> IO (Maybe ThunkInfo))
-> (Proxy (CommitteeState era) -> String)
-> NoThunks (CommitteeState era)
forall era. Context -> CommitteeState era -> IO (Maybe ThunkInfo)
forall era. Proxy (CommitteeState era) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall era. Context -> CommitteeState era -> IO (Maybe ThunkInfo)
noThunks :: Context -> CommitteeState era -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall era. Context -> CommitteeState era -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> CommitteeState era -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall era. Proxy (CommitteeState era) -> String
showTypeOf :: Proxy (CommitteeState era) -> String
NoThunks)

instance ToJSON (CommitteeState era)

-- | Extract all unique hot credential authorizations for the current committee.  Note
-- that there is no unique mapping from Hot to Cold credential, therefore we produce a
-- Set, instead of a Map.
authorizedHotCommitteeCredentials :: CommitteeState era -> Set.Set (Credential HotCommitteeRole)
authorizedHotCommitteeCredentials :: forall era. CommitteeState era -> Set (Credential HotCommitteeRole)
authorizedHotCommitteeCredentials CommitteeState {Map (Credential ColdCommitteeRole) CommitteeAuthorization
csCommitteeCreds :: forall era.
CommitteeState era
-> Map (Credential ColdCommitteeRole) CommitteeAuthorization
csCommitteeCreds :: Map (Credential ColdCommitteeRole) CommitteeAuthorization
csCommitteeCreds} =
  let toHotCredSet :: Set (Credential HotCommitteeRole)
-> CommitteeAuthorization -> Set (Credential HotCommitteeRole)
toHotCredSet Set (Credential HotCommitteeRole)
acc = \case
        CommitteeHotCredential Credential HotCommitteeRole
hotCred -> Credential HotCommitteeRole
-> Set (Credential HotCommitteeRole)
-> Set (Credential HotCommitteeRole)
forall a. Ord a => a -> Set a -> Set a
Set.insert Credential HotCommitteeRole
hotCred Set (Credential HotCommitteeRole)
acc
        CommitteeMemberResigned {} -> Set (Credential HotCommitteeRole)
acc
   in (Set (Credential HotCommitteeRole)
 -> CommitteeAuthorization -> Set (Credential HotCommitteeRole))
-> Set (Credential HotCommitteeRole)
-> Map (Credential ColdCommitteeRole) CommitteeAuthorization
-> Set (Credential HotCommitteeRole)
forall b a.
(b -> a -> b) -> b -> Map (Credential ColdCommitteeRole) a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' Set (Credential HotCommitteeRole)
-> CommitteeAuthorization -> Set (Credential HotCommitteeRole)
toHotCredSet Set (Credential HotCommitteeRole)
forall a. Set a
Set.empty Map (Credential ColdCommitteeRole) CommitteeAuthorization
csCommitteeCreds

instance Era era => DecShareCBOR (CommitteeState era) where
  type Share (CommitteeState era) = Interns (Credential HotCommitteeRole)
  getShare :: CommitteeState era -> Share (CommitteeState era)
getShare = Set (Credential HotCommitteeRole)
-> Interns (Credential HotCommitteeRole)
forall k. Ord k => Set k -> Interns k
internsFromSet (Set (Credential HotCommitteeRole)
 -> Interns (Credential HotCommitteeRole))
-> (CommitteeState era -> Set (Credential HotCommitteeRole))
-> CommitteeState era
-> Interns (Credential HotCommitteeRole)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommitteeState era -> Set (Credential HotCommitteeRole)
forall era. CommitteeState era -> Set (Credential HotCommitteeRole)
authorizedHotCommitteeCredentials
  decShareCBOR :: forall s.
Share (CommitteeState era) -> Decoder s (CommitteeState era)
decShareCBOR Share (CommitteeState era)
_ = Map (Credential ColdCommitteeRole) CommitteeAuthorization
-> CommitteeState era
forall era.
Map (Credential ColdCommitteeRole) CommitteeAuthorization
-> CommitteeState era
CommitteeState (Map (Credential ColdCommitteeRole) CommitteeAuthorization
 -> CommitteeState era)
-> Decoder
     s (Map (Credential ColdCommitteeRole) CommitteeAuthorization)
-> Decoder s (CommitteeState era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder
  s (Map (Credential ColdCommitteeRole) CommitteeAuthorization)
forall s.
Decoder
  s (Map (Credential ColdCommitteeRole) CommitteeAuthorization)
forall a s. DecCBOR a => Decoder s a
decCBOR

instance Era era => DecCBOR (CommitteeState era) where
  decCBOR :: forall s. Decoder s (CommitteeState era)
decCBOR = Decoder s (CommitteeState era)
forall a s. DecShareCBOR a => Decoder s a
decNoShareCBOR

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

-- | The state associated with the DELPL rule, which combines the DELEG rule
-- and the POOL rule.
class
  ( EraAccounts era
  , ToJSON (CertState era)
  , EncCBOR (CertState era)
  , DecShareCBOR (CertState era)
  , Share (CertState era)
      ~ ( Interns (Credential Staking)
        , Interns (KeyHash StakePool)
        , Interns (Credential DRepRole)
        , Interns (Credential HotCommitteeRole)
        )
  , Default (CertState era)
  , NoThunks (CertState era)
  , NFData (CertState era)
  , Show (CertState era)
  , Eq (CertState era)
  ) =>
  EraCertState era
  where
  type CertState era = (r :: Type) | r -> era

  certDStateL :: Lens' (CertState era) (DState era)

  certPStateL :: Lens' (CertState era) (PState era)

  -- | Calculate total possible refunds in the system that are related to certificates
  --
  -- There is an invariant that the sum of all the fields should be the same as the
  -- utxosDeposited field of the UTxOState. Note that this does not depend upon the current
  -- values of the Key and Pool deposits of the PParams.
  obligationCertState :: CertState era -> Obligations

  -- | Compute the total deposits from the Certs of a TxBody.
  --
  -- This is the contribution of a TxBody towards the deposit pot (utxosDeposit field of
  -- the UTxOState) of the system
  certsTotalDepositsTxBody :: EraTxBody era => PParams era -> CertState era -> TxBody t era -> Coin

  -- | Compute the total refunds from the Certs of a TxBody.
  --
  -- This is the contribution of a TxBody towards the total 'Obligations' of the system
  -- See `Obligations` and `obligationCertState` for more information.
  certsTotalRefundsTxBody :: EraTxBody era => PParams era -> CertState era -> TxBody t era -> Coin

instance EncCBOR InstantaneousRewards where
  encCBOR :: InstantaneousRewards -> Encoding
encCBOR (InstantaneousRewards Map (Credential Staking) Coin
irR Map (Credential Staking) Coin
irT DeltaCoin
dR DeltaCoin
dT) =
    Word -> Encoding
encodeListLen Word
4 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map (Credential Staking) Coin -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Map (Credential Staking) Coin
irR Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map (Credential Staking) Coin -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Map (Credential Staking) Coin
irT Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> DeltaCoin -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR DeltaCoin
dR Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> DeltaCoin -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR DeltaCoin
dT

instance DecShareCBOR InstantaneousRewards where
  type Share InstantaneousRewards = Interns (Credential Staking)
  decSharePlusCBOR :: forall s.
StateT
  (Share InstantaneousRewards) (Decoder s) InstantaneousRewards
decSharePlusCBOR =
    Text
-> (InstantaneousRewards -> Int)
-> StateT
     (Share InstantaneousRewards) (Decoder s) InstantaneousRewards
-> StateT
     (Share InstantaneousRewards) (Decoder s) InstantaneousRewards
forall (m :: (* -> *) -> * -> *) s a.
(MonadTrans m, Monad (m (Decoder s))) =>
Text -> (a -> Int) -> m (Decoder s) a -> m (Decoder s) a
decodeRecordNamedT Text
"InstantaneousRewards" (Int -> InstantaneousRewards -> Int
forall a b. a -> b -> a
const Int
4) (StateT
   (Share InstantaneousRewards) (Decoder s) InstantaneousRewards
 -> StateT
      (Share InstantaneousRewards) (Decoder s) InstantaneousRewards)
-> StateT
     (Share InstantaneousRewards) (Decoder s) InstantaneousRewards
-> StateT
     (Share InstantaneousRewards) (Decoder s) InstantaneousRewards
forall a b. (a -> b) -> a -> b
$ do
      irR <- Lens'
  (Interns (Credential Staking))
  (Share (Map (Credential Staking) Coin))
-> StateT
     (Interns (Credential Staking))
     (Decoder s)
     (Map (Credential Staking) Coin)
forall b bs s.
DecShareCBOR b =>
Lens' bs (Share b) -> StateT bs (Decoder s) b
decSharePlusLensCBOR (Lens'
  (Interns (Credential Staking), Interns Coin)
  (Interns (Credential Staking))
-> Lens'
     (Interns (Credential Staking)) (Interns (Credential Staking))
-> Lens'
     (Interns (Credential Staking))
     (Interns (Credential Staking), Interns Coin)
forall a b c. Monoid a => Lens' a b -> Lens' c b -> Lens' c a
toMemptyLens (Interns (Credential Staking) -> f (Interns (Credential Staking)))
-> (Interns (Credential Staking), Interns Coin)
-> f (Interns (Credential Staking), Interns Coin)
forall s t a b. Field1 s t a b => Lens s t a b
Lens'
  (Interns (Credential Staking), Interns Coin)
  (Interns (Credential Staking))
_1 (Interns (Credential Staking) -> f (Interns (Credential Staking)))
-> Interns (Credential Staking) -> f (Interns (Credential Staking))
forall a. a -> a
Lens' (Interns (Credential Staking)) (Interns (Credential Staking))
id)
      irT <- decSharePlusLensCBOR (toMemptyLens _1 id)
      dR <- lift decCBOR
      dT <- lift decCBOR
      pure $ InstantaneousRewards irR irT dR dT

instance Default InstantaneousRewards where
  def :: InstantaneousRewards
def = Map (Credential Staking) Coin
-> Map (Credential Staking) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards
InstantaneousRewards Map (Credential Staking) Coin
forall k a. Map k a
Map.empty Map (Credential Staking) Coin
forall k a. Map k a
Map.empty DeltaCoin
forall a. Monoid a => a
mempty DeltaCoin
forall a. Monoid a => a
mempty

instance Default (Accounts era) => Default (DState era) where
  def :: DState era
def = Accounts era
-> Map FutureGenDeleg GenDelegPair
-> GenDelegs
-> InstantaneousRewards
-> DState era
forall era.
Accounts era
-> Map FutureGenDeleg GenDelegPair
-> GenDelegs
-> InstantaneousRewards
-> DState era
DState Accounts era
forall a. Default a => a
def Map FutureGenDeleg GenDelegPair
forall k a. Map k a
Map.empty (Map (KeyHash GenesisRole) GenDelegPair -> GenDelegs
GenDelegs Map (KeyHash GenesisRole) GenDelegPair
forall k a. Map k a
Map.empty) InstantaneousRewards
forall a. Default a => a
def

instance Default (PState era) where
  def :: PState era
def = Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
-> Map (KeyHash StakePool) StakePoolState
-> Map (KeyHash StakePool) StakePoolParams
-> Map (KeyHash StakePool) EpochNo
-> PState era
forall era.
Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
-> Map (KeyHash StakePool) StakePoolState
-> Map (KeyHash StakePool) StakePoolParams
-> Map (KeyHash StakePool) EpochNo
-> PState era
PState Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
forall k a. Map k a
Map.empty Map (KeyHash StakePool) StakePoolState
forall k a. Map k a
Map.empty Map (KeyHash StakePool) StakePoolParams
forall k a. Map k a
Map.empty Map (KeyHash StakePool) EpochNo
forall k a. Map k a
Map.empty

-- | A composite of all the Deposits the system is obligated to eventually pay back.
data Obligations = Obligations
  { Obligations -> Coin
oblStake :: !Coin
  , Obligations -> Coin
oblPool :: !Coin
  , Obligations -> Coin
oblDRep :: !Coin
  , Obligations -> Coin
oblProposal :: !Coin
  }
  deriving (Obligations -> Obligations -> Bool
(Obligations -> Obligations -> Bool)
-> (Obligations -> Obligations -> Bool) -> Eq Obligations
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Obligations -> Obligations -> Bool
== :: Obligations -> Obligations -> Bool
$c/= :: Obligations -> Obligations -> Bool
/= :: Obligations -> Obligations -> Bool
Eq, Eq Obligations
Eq Obligations =>
(Obligations -> Obligations -> Ordering)
-> (Obligations -> Obligations -> Bool)
-> (Obligations -> Obligations -> Bool)
-> (Obligations -> Obligations -> Bool)
-> (Obligations -> Obligations -> Bool)
-> (Obligations -> Obligations -> Obligations)
-> (Obligations -> Obligations -> Obligations)
-> Ord Obligations
Obligations -> Obligations -> Bool
Obligations -> Obligations -> Ordering
Obligations -> Obligations -> Obligations
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
$ccompare :: Obligations -> Obligations -> Ordering
compare :: Obligations -> Obligations -> Ordering
$c< :: Obligations -> Obligations -> Bool
< :: Obligations -> Obligations -> Bool
$c<= :: Obligations -> Obligations -> Bool
<= :: Obligations -> Obligations -> Bool
$c> :: Obligations -> Obligations -> Bool
> :: Obligations -> Obligations -> Bool
$c>= :: Obligations -> Obligations -> Bool
>= :: Obligations -> Obligations -> Bool
$cmax :: Obligations -> Obligations -> Obligations
max :: Obligations -> Obligations -> Obligations
$cmin :: Obligations -> Obligations -> Obligations
min :: Obligations -> Obligations -> Obligations
Ord, (forall x. Obligations -> Rep Obligations x)
-> (forall x. Rep Obligations x -> Obligations)
-> Generic Obligations
forall x. Rep Obligations x -> Obligations
forall x. Obligations -> Rep Obligations x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Obligations -> Rep Obligations x
from :: forall x. Obligations -> Rep Obligations x
$cto :: forall x. Rep Obligations x -> Obligations
to :: forall x. Rep Obligations x -> Obligations
Generic)

instance NFData Obligations

sumObligation :: Obligations -> Coin
sumObligation :: Obligations -> Coin
sumObligation Obligations
x = Obligations -> Coin
oblStake Obligations
x Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> Obligations -> Coin
oblPool Obligations
x Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> Obligations -> Coin
oblDRep Obligations
x Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> Obligations -> Coin
oblProposal Obligations
x

instance Semigroup Obligations where
  Obligations
x <> :: Obligations -> Obligations -> Obligations
<> Obligations
y =
    Obligations
      { oblStake :: Coin
oblStake = Obligations -> Coin
oblStake Obligations
x Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> Obligations -> Coin
oblStake Obligations
y
      , oblPool :: Coin
oblPool = Obligations -> Coin
oblPool Obligations
x Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> Obligations -> Coin
oblPool Obligations
y
      , oblDRep :: Coin
oblDRep = Obligations -> Coin
oblDRep Obligations
x Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> Obligations -> Coin
oblDRep Obligations
y
      , oblProposal :: Coin
oblProposal = Obligations -> Coin
oblProposal Obligations
x Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> Obligations -> Coin
oblProposal Obligations
y
      }

instance Monoid Obligations where
  mempty :: Obligations
mempty = Obligations {oblStake :: Coin
oblStake = Integer -> Coin
Coin Integer
0, oblPool :: Coin
oblPool = Integer -> Coin
Coin Integer
0, oblDRep :: Coin
oblDRep = Integer -> Coin
Coin Integer
0, oblProposal :: Coin
oblProposal = Integer -> Coin
Coin Integer
0}

instance Show Obligations where
  show :: Obligations -> String
show Obligations
x =
    Context -> String
unlines
      [ String
"Total Obligations = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Coin -> String
forall a. Show a => a -> String
show (Obligations -> Coin
sumObligation Obligations
x)
      , String
"   Stake deposits = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Coin -> String
forall a. Show a => a -> String
show (Obligations -> Coin
oblStake Obligations
x)
      , String
"   Pool deposits = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Coin -> String
forall a. Show a => a -> String
show (Obligations -> Coin
oblPool Obligations
x)
      , String
"   DRep deposits = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Coin -> String
forall a. Show a => a -> String
show (Obligations -> Coin
oblDRep Obligations
x)
      , String
"   Proposal deposits = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Coin -> String
forall a. Show a => a -> String
show (Obligations -> Coin
oblProposal Obligations
x)
      ]

dsGenDelegsL :: Lens' (DState era) GenDelegs
dsGenDelegsL :: forall era (f :: * -> *).
Functor f =>
(GenDelegs -> f GenDelegs) -> DState era -> f (DState era)
dsGenDelegsL = (DState era -> GenDelegs)
-> (DState era -> GenDelegs -> DState era)
-> Lens (DState era) (DState era) GenDelegs GenDelegs
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens DState era -> GenDelegs
forall era. DState era -> GenDelegs
dsGenDelegs (\DState era
ds GenDelegs
u -> DState era
ds {dsGenDelegs = u})

dsIRewardsL :: Lens' (DState era) InstantaneousRewards
dsIRewardsL :: forall era (f :: * -> *).
Functor f =>
(InstantaneousRewards -> f InstantaneousRewards)
-> DState era -> f (DState era)
dsIRewardsL = (DState era -> InstantaneousRewards)
-> (DState era -> InstantaneousRewards -> DState era)
-> Lens
     (DState era) (DState era) InstantaneousRewards InstantaneousRewards
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens DState era -> InstantaneousRewards
forall era. DState era -> InstantaneousRewards
dsIRewards (\DState era
ds InstantaneousRewards
u -> DState era
ds {dsIRewards = u})

iRReservesL :: Lens' InstantaneousRewards (Map (Credential Staking) Coin)
iRReservesL :: Lens' InstantaneousRewards (Map (Credential Staking) Coin)
iRReservesL = (InstantaneousRewards -> Map (Credential Staking) Coin)
-> (InstantaneousRewards
    -> Map (Credential Staking) Coin -> InstantaneousRewards)
-> Lens' InstantaneousRewards (Map (Credential Staking) Coin)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens InstantaneousRewards -> Map (Credential Staking) Coin
iRReserves (\InstantaneousRewards
ir Map (Credential Staking) Coin
m -> InstantaneousRewards
ir {iRReserves = m})

iRTreasuryL :: Lens' InstantaneousRewards (Map (Credential Staking) Coin)
iRTreasuryL :: Lens' InstantaneousRewards (Map (Credential Staking) Coin)
iRTreasuryL = (InstantaneousRewards -> Map (Credential Staking) Coin)
-> (InstantaneousRewards
    -> Map (Credential Staking) Coin -> InstantaneousRewards)
-> Lens' InstantaneousRewards (Map (Credential Staking) Coin)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens InstantaneousRewards -> Map (Credential Staking) Coin
iRTreasury (\InstantaneousRewards
ir Map (Credential Staking) Coin
m -> InstantaneousRewards
ir {iRTreasury = m})

iRDeltaReservesL :: Lens' InstantaneousRewards DeltaCoin
iRDeltaReservesL :: Lens' InstantaneousRewards DeltaCoin
iRDeltaReservesL = (InstantaneousRewards -> DeltaCoin)
-> (InstantaneousRewards -> DeltaCoin -> InstantaneousRewards)
-> Lens' InstantaneousRewards DeltaCoin
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens InstantaneousRewards -> DeltaCoin
deltaReserves (\InstantaneousRewards
ir DeltaCoin
d -> InstantaneousRewards
ir {deltaReserves = d})

iRDeltaTreasuryL :: Lens' InstantaneousRewards DeltaCoin
iRDeltaTreasuryL :: Lens' InstantaneousRewards DeltaCoin
iRDeltaTreasuryL = (InstantaneousRewards -> DeltaCoin)
-> (InstantaneousRewards -> DeltaCoin -> InstantaneousRewards)
-> Lens' InstantaneousRewards DeltaCoin
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens InstantaneousRewards -> DeltaCoin
deltaTreasury (\InstantaneousRewards
ir DeltaCoin
d -> InstantaneousRewards
ir {deltaTreasury = d})

dsFutureGenDelegsL ::
  Lens' (DState era) (Map FutureGenDeleg GenDelegPair)
dsFutureGenDelegsL :: forall era (f :: * -> *).
Functor f =>
(Map FutureGenDeleg GenDelegPair
 -> f (Map FutureGenDeleg GenDelegPair))
-> DState era -> f (DState era)
dsFutureGenDelegsL = (DState era -> Map FutureGenDeleg GenDelegPair)
-> (DState era -> Map FutureGenDeleg GenDelegPair -> DState era)
-> Lens
     (DState era)
     (DState era)
     (Map FutureGenDeleg GenDelegPair)
     (Map FutureGenDeleg GenDelegPair)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens DState era -> Map FutureGenDeleg GenDelegPair
forall era. DState era -> Map FutureGenDeleg GenDelegPair
dsFutureGenDelegs (\DState era
ds Map FutureGenDeleg GenDelegPair
u -> DState era
ds {dsFutureGenDelegs = u})

psStakePoolsL :: Lens' (PState era) (Map (KeyHash StakePool) StakePoolState)
psStakePoolsL :: forall era (f :: * -> *).
Functor f =>
(Map (KeyHash StakePool) StakePoolState
 -> f (Map (KeyHash StakePool) StakePoolState))
-> PState era -> f (PState era)
psStakePoolsL = (PState era -> Map (KeyHash StakePool) StakePoolState)
-> (PState era
    -> Map (KeyHash StakePool) StakePoolState -> PState era)
-> Lens
     (PState era)
     (PState era)
     (Map (KeyHash StakePool) StakePoolState)
     (Map (KeyHash StakePool) StakePoolState)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens PState era -> Map (KeyHash StakePool) StakePoolState
forall era. PState era -> Map (KeyHash StakePool) StakePoolState
psStakePools (\PState era
ps Map (KeyHash StakePool) StakePoolState
u -> PState era
ps {psStakePools = u})

psFutureStakePoolParamsL :: Lens' (PState era) (Map (KeyHash StakePool) StakePoolParams)
psFutureStakePoolParamsL :: forall era (f :: * -> *).
Functor f =>
(Map (KeyHash StakePool) StakePoolParams
 -> f (Map (KeyHash StakePool) StakePoolParams))
-> PState era -> f (PState era)
psFutureStakePoolParamsL = (PState era -> Map (KeyHash StakePool) StakePoolParams)
-> (PState era
    -> Map (KeyHash StakePool) StakePoolParams -> PState era)
-> Lens
     (PState era)
     (PState era)
     (Map (KeyHash StakePool) StakePoolParams)
     (Map (KeyHash StakePool) StakePoolParams)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens PState era -> Map (KeyHash StakePool) StakePoolParams
forall era. PState era -> Map (KeyHash StakePool) StakePoolParams
psFutureStakePoolParams (\PState era
ps Map (KeyHash StakePool) StakePoolParams
u -> PState era
ps {psFutureStakePoolParams = u})

psRetiringL :: Lens' (PState era) (Map (KeyHash StakePool) EpochNo)
psRetiringL :: forall era (f :: * -> *).
Functor f =>
(Map (KeyHash StakePool) EpochNo
 -> f (Map (KeyHash StakePool) EpochNo))
-> PState era -> f (PState era)
psRetiringL = (PState era -> Map (KeyHash StakePool) EpochNo)
-> (PState era -> Map (KeyHash StakePool) EpochNo -> PState era)
-> Lens
     (PState era)
     (PState era)
     (Map (KeyHash StakePool) EpochNo)
     (Map (KeyHash StakePool) EpochNo)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens PState era -> Map (KeyHash StakePool) EpochNo
forall era. PState era -> Map (KeyHash StakePool) EpochNo
psRetiring (\PState era
ps Map (KeyHash StakePool) EpochNo
u -> PState era
ps {psRetiring = u})

psVRFKeyHashesL :: Lens' (PState era) (Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64))
psVRFKeyHashesL :: forall era (f :: * -> *).
Functor f =>
(Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
 -> f (Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)))
-> PState era -> f (PState era)
psVRFKeyHashesL = (PState era -> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64))
-> (PState era
    -> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64) -> PState era)
-> Lens
     (PState era)
     (PState era)
     (Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64))
     (Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens PState era -> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
forall era.
PState era -> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
psVRFKeyHashes (\PState era
ps Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
u -> PState era
ps {psVRFKeyHashes = u})