{-# 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,
  -- Lenses
  dsGenDelegsL,
  dsIRewardsL,
  dsFutureGenDelegsL,
  psStakePoolsL,
  psFutureStakePoolsL,
  psRetiringL,
  psVRFKeyHashesL,
) where

import Cardano.Ledger.BaseTypes (
  Anchor (..),
  AnchorData,
  KeyValuePairs (..),
  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 (..), StakeCredential)
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 (StakePoolState (..))
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.Set (Set)
import qualified Data.Set as Set
import GHC.Generics (Generic)
import Lens.Micro
import NoThunks.Class (NoThunks (..))

data FutureGenDeleg = FutureGenDeleg
  { FutureGenDeleg -> SlotNo
fGenDelegSlot :: !SlotNo
  , FutureGenDeleg -> KeyHash 'Genesis
fGenDelegGenKeyHash :: !(KeyHash 'Genesis)
  }
  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 'Genesis
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 'Genesis -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR KeyHash 'Genesis
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 'Genesis -> FutureGenDeleg
FutureGenDeleg (SlotNo -> KeyHash 'Genesis -> FutureGenDeleg)
-> Decoder s SlotNo
-> Decoder s (KeyHash 'Genesis -> 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 'Genesis -> FutureGenDeleg)
-> Decoder s (KeyHash 'Genesis) -> 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 'Genesis)
forall s. Decoder s (KeyHash 'Genesis)
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 'Genesis -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= FutureGenDeleg -> KeyHash 'Genesis
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 Accounts era
unified Map FutureGenDeleg GenDelegPair
fgs GenDelegs
gs InstantaneousRewards
ir) =
    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
unified
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map FutureGenDeleg GenDelegPair -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Map FutureGenDeleg GenDelegPair
fgs
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> GenDelegs -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR GenDelegs
gs
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> InstantaneousRewards -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR InstantaneousRewards
ir

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
      Accounts era
unified <- 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
      Map FutureGenDeleg GenDelegPair
fgs <- Decoder s (Map FutureGenDeleg GenDelegPair)
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole))
     (Decoder s)
     (Map FutureGenDeleg GenDelegPair)
forall (m :: * -> *) a.
Monad m =>
m a
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole))
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Decoder s (Map FutureGenDeleg GenDelegPair)
forall s. Decoder s (Map FutureGenDeleg GenDelegPair)
forall a s. DecCBOR a => Decoder s a
decCBOR
      GenDelegs
gs <- Decoder s GenDelegs
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole))
     (Decoder s)
     GenDelegs
forall (m :: * -> *) a.
Monad m =>
m a
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole))
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Decoder s GenDelegs
forall s. Decoder s GenDelegs
forall a s. DecCBOR a => Decoder s a
decCBOR
      InstantaneousRewards
ir <- Lens'
  (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
   Interns (Credential 'DRepRole))
  (Share InstantaneousRewards)
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole))
     (Decoder s)
     InstantaneousRewards
forall b bs s.
DecShareCBOR b =>
Lens' bs (Share b) -> StateT bs (Decoder s) b
decSharePlusLensCBOR (Share InstantaneousRewards -> f (Share InstantaneousRewards))
-> (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
    Interns (Credential 'DRepRole))
-> f (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole))
(Interns (Credential 'Staking)
 -> f (Interns (Credential 'Staking)))
-> (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
    Interns (Credential 'DRepRole))
-> f (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole))
forall s t a b. Field1 s t a b => Lens s t a b
Lens'
  (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
   Interns (Credential 'DRepRole))
  (Share InstantaneousRewards)
Lens
  (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
   Interns (Credential 'DRepRole))
  (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
   Interns (Credential 'DRepRole))
  (Interns (Credential 'Staking))
  (Interns (Credential 'Staking))
_1
      DState era
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole))
     (Decoder s)
     (DState era)
forall a.
a
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole))
     (Decoder s)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DState era
 -> StateT
      (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
       Interns (Credential 'DRepRole))
      (Decoder s)
      (DState era))
-> DState era
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole))
     (Decoder s)
     (DState era)
forall a b. (a -> b) -> a -> b
$ Accounts era
-> Map FutureGenDeleg GenDelegPair
-> GenDelegs
-> InstantaneousRewards
-> DState era
forall era.
Accounts era
-> Map FutureGenDeleg GenDelegPair
-> GenDelegs
-> InstantaneousRewards
-> DState era
DState Accounts era
unified Map FutureGenDeleg GenDelegPair
fgs GenDelegs
gs InstantaneousRewards
ir

instance ToJSON (Accounts era) => ToKeyValuePairs (DState era) where
  toKeyValuePairs :: forall e kv. KeyValue e kv => DState era -> [kv]
toKeyValuePairs 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
..} =
    [ 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 -> (StakeCredential -> 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 era
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)
  Coin -> Maybe Coin
forall a. a -> Maybe a
Just (Coin -> Maybe Coin) -> Coin -> Maybe Coin
forall a b. (a -> b) -> a -> b
$! CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact (AccountState era
accountState AccountState era
-> Getting (CompactForm Coin) (AccountState era) (CompactForm Coin)
-> CompactForm Coin
forall s a. s -> Getting a s a -> a
^. Getting (CompactForm Coin) (AccountState era) (CompactForm Coin)
forall era.
EraAccounts era =>
Lens' (AccountState era) (CompactForm Coin)
Lens' (AccountState era) (CompactForm Coin)
depositAccountStateL)

-- | Function that looks up curret reward for the delegated staking credential.
lookupRewardDState :: EraAccounts era => DState era -> (StakeCredential -> 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 era
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)
  Coin -> Maybe Coin
forall a. a -> Maybe a
Just (Coin -> Maybe Coin) -> Coin -> Maybe Coin
forall a b. (a -> b) -> a -> b
$! CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact (AccountState era
accountState AccountState era
-> Getting (CompactForm Coin) (AccountState era) (CompactForm Coin)
-> CompactForm Coin
forall s a. s -> Getting a s a -> a
^. Getting (CompactForm Coin) (AccountState era) (CompactForm Coin)
forall era.
EraAccounts era =>
Lens' (AccountState era) (CompactForm Coin)
Lens' (AccountState era) (CompactForm Coin)
balanceAccountStateL)

-- | The state used by the POOL rule, which tracks stake pool information.
data PState era = PState
  { forall era. PState era -> Set (VRFVerKeyHash 'StakePoolVRF)
psVRFKeyHashes :: !(Set (VRFVerKeyHash 'StakePoolVRF))
  -- ^ 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) StakePoolState
psFutureStakePools :: !(Map (KeyHash 'StakePool) StakePoolState)
  -- ^ The state of future stake pools.
  -- 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 Set (VRFVerKeyHash 'StakePoolVRF)
a Map (KeyHash 'StakePool) StakePoolState
b Map (KeyHash 'StakePool) StakePoolState
c Map (KeyHash 'StakePool) EpochNo
d) =
    Word -> Encoding
encodeListLen Word
4 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Set (VRFVerKeyHash 'StakePoolVRF) -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Set (VRFVerKeyHash 'StakePoolVRF)
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) StakePoolState -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Map (KeyHash 'StakePool) StakePoolState
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 (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
    Set (VRFVerKeyHash 'StakePoolVRF)
psVRFKeyHashes <- Decoder s (Set (VRFVerKeyHash 'StakePoolVRF))
-> StateT
     (Interns (KeyHash 'StakePool))
     (Decoder s)
     (Set (VRFVerKeyHash 'StakePoolVRF))
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Interns (KeyHash 'StakePool)) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Decoder s (Set (VRFVerKeyHash 'StakePoolVRF))
forall s. Decoder s (Set (VRFVerKeyHash 'StakePoolVRF))
forall a s. DecCBOR a => Decoder s a
decCBOR
    Map (KeyHash 'StakePool) StakePoolState
psStakePools <- Lens'
  (Interns (KeyHash 'StakePool))
  (Share (Map (KeyHash 'StakePool) StakePoolState))
-> StateT
     (Interns (KeyHash 'StakePool))
     (Decoder s)
     (Map (KeyHash 'StakePool) StakePoolState)
forall b bs s.
DecShareCBOR b =>
Lens' bs (Share b) -> StateT bs (Decoder s) b
decSharePlusLensCBOR (Lens'
  (Interns (KeyHash 'StakePool), Interns StakePoolState)
  (Interns (KeyHash 'StakePool))
-> Lens'
     (Interns (KeyHash 'StakePool)) (Interns (KeyHash 'StakePool))
-> Lens'
     (Interns (KeyHash 'StakePool))
     (Interns (KeyHash 'StakePool), Interns StakePoolState)
forall a b c. Monoid a => Lens' a b -> Lens' c b -> Lens' c a
toMemptyLens (Interns (KeyHash 'StakePool) -> f (Interns (KeyHash 'StakePool)))
-> (Interns (KeyHash 'StakePool), Interns StakePoolState)
-> f (Interns (KeyHash 'StakePool), Interns StakePoolState)
forall s t a b. Field1 s t a b => Lens s t a b
Lens'
  (Interns (KeyHash 'StakePool), Interns StakePoolState)
  (Interns (KeyHash 'StakePool))
_1 (Interns (KeyHash 'StakePool) -> f (Interns (KeyHash 'StakePool)))
-> Interns (KeyHash 'StakePool) -> f (Interns (KeyHash 'StakePool))
forall a. a -> a
Lens' (Interns (KeyHash 'StakePool)) (Interns (KeyHash 'StakePool))
id)
    Map (KeyHash 'StakePool) StakePoolState
psFutureStakePools <- Lens'
  (Interns (KeyHash 'StakePool))
  (Share (Map (KeyHash 'StakePool) StakePoolState))
-> StateT
     (Interns (KeyHash 'StakePool))
     (Decoder s)
     (Map (KeyHash 'StakePool) StakePoolState)
forall b bs s.
DecShareCBOR b =>
Lens' bs (Share b) -> StateT bs (Decoder s) b
decSharePlusLensCBOR (Lens'
  (Interns (KeyHash 'StakePool), Interns StakePoolState)
  (Interns (KeyHash 'StakePool))
-> Lens'
     (Interns (KeyHash 'StakePool)) (Interns (KeyHash 'StakePool))
-> Lens'
     (Interns (KeyHash 'StakePool))
     (Interns (KeyHash 'StakePool), Interns StakePoolState)
forall a b c. Monoid a => Lens' a b -> Lens' c b -> Lens' c a
toMemptyLens (Interns (KeyHash 'StakePool) -> f (Interns (KeyHash 'StakePool)))
-> (Interns (KeyHash 'StakePool), Interns StakePoolState)
-> f (Interns (KeyHash 'StakePool), Interns StakePoolState)
forall s t a b. Field1 s t a b => Lens s t a b
Lens'
  (Interns (KeyHash 'StakePool), Interns StakePoolState)
  (Interns (KeyHash 'StakePool))
_1 (Interns (KeyHash 'StakePool) -> f (Interns (KeyHash 'StakePool)))
-> Interns (KeyHash 'StakePool) -> f (Interns (KeyHash 'StakePool))
forall a. a -> a
Lens' (Interns (KeyHash 'StakePool)) (Interns (KeyHash 'StakePool))
id)
    Map (KeyHash 'StakePool) EpochNo
psRetiring <- Lens'
  (Interns (KeyHash 'StakePool))
  (Share (Map (KeyHash 'StakePool) EpochNo))
-> StateT
     (Interns (KeyHash 'StakePool))
     (Decoder s)
     (Map (KeyHash 'StakePool) EpochNo)
forall b bs s.
DecShareCBOR b =>
Lens' bs (Share b) -> StateT bs (Decoder s) b
decSharePlusLensCBOR (Lens'
  (Interns (KeyHash 'StakePool), Interns EpochNo)
  (Interns (KeyHash 'StakePool))
-> Lens'
     (Interns (KeyHash 'StakePool)) (Interns (KeyHash 'StakePool))
-> Lens'
     (Interns (KeyHash 'StakePool))
     (Interns (KeyHash 'StakePool), Interns EpochNo)
forall a b c. Monoid a => Lens' a b -> Lens' c b -> Lens' c a
toMemptyLens (Interns (KeyHash 'StakePool) -> f (Interns (KeyHash 'StakePool)))
-> (Interns (KeyHash 'StakePool), Interns EpochNo)
-> f (Interns (KeyHash 'StakePool), Interns EpochNo)
forall s t a b. Field1 s t a b => Lens s t a b
Lens'
  (Interns (KeyHash 'StakePool), Interns EpochNo)
  (Interns (KeyHash 'StakePool))
_1 (Interns (KeyHash 'StakePool) -> f (Interns (KeyHash 'StakePool)))
-> Interns (KeyHash 'StakePool) -> f (Interns (KeyHash 'StakePool))
forall a. a -> a
Lens' (Interns (KeyHash 'StakePool)) (Interns (KeyHash 'StakePool))
id)
    PState era
-> StateT (Interns (KeyHash 'StakePool)) (Decoder s) (PState era)
forall a. a -> StateT (Interns (KeyHash 'StakePool)) (Decoder s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PState {Set (VRFVerKeyHash 'StakePoolVRF)
psVRFKeyHashes :: Set (VRFVerKeyHash 'StakePoolVRF)
psVRFKeyHashes :: Set (VRFVerKeyHash 'StakePoolVRF)
psVRFKeyHashes, Map (KeyHash 'StakePool) StakePoolState
psStakePools :: Map (KeyHash 'StakePool) StakePoolState
psStakePools :: Map (KeyHash 'StakePool) StakePoolState
psStakePools, Map (KeyHash 'StakePool) StakePoolState
psFutureStakePools :: Map (KeyHash 'StakePool) StakePoolState
psFutureStakePools :: Map (KeyHash 'StakePool) StakePoolState
psFutureStakePools, Map (KeyHash 'StakePool) EpochNo
psRetiring :: Map (KeyHash 'StakePool) EpochNo
psRetiring :: Map (KeyHash 'StakePool) EpochNo
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 (KeyHash 'StakePool) EpochNo
Map (KeyHash 'StakePool) StakePoolState
Set (VRFVerKeyHash 'StakePoolVRF)
psVRFKeyHashes :: forall era. PState era -> Set (VRFVerKeyHash 'StakePoolVRF)
psStakePools :: forall era. PState era -> Map (KeyHash 'StakePool) StakePoolState
psFutureStakePools :: forall era. PState era -> Map (KeyHash 'StakePool) StakePoolState
psRetiring :: forall era. PState era -> Map (KeyHash 'StakePool) EpochNo
psVRFKeyHashes :: Set (VRFVerKeyHash 'StakePoolVRF)
psStakePools :: Map (KeyHash 'StakePool) StakePoolState
psFutureStakePools :: Map (KeyHash 'StakePool) StakePoolState
psRetiring :: Map (KeyHash 'StakePool) EpochNo
..} =
    [ Key
"vrfKeyHashes" Key -> Set (VRFVerKeyHash 'StakePoolVRF) -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Set (VRFVerKeyHash 'StakePoolVRF)
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
"futureStakePools" 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
psFutureStakePools
    , 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
    ]

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 Any) (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 Any) (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 Any) (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 Any) (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, Typeable (CommitteeState era)
Typeable (CommitteeState era) =>
(CommitteeState era -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy (CommitteeState era) -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy [CommitteeState era] -> Size)
-> EncCBOR (CommitteeState era)
CommitteeState era -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [CommitteeState era] -> Size
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (CommitteeState era) -> Size
forall era. Typeable era => Typeable (CommitteeState era)
forall era. Typeable era => CommitteeState era -> Encoding
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> EncCBOR a
forall era.
Typeable era =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [CommitteeState era] -> Size
forall era.
Typeable era =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (CommitteeState era) -> Size
$cencCBOR :: forall era. Typeable era => CommitteeState era -> Encoding
encCBOR :: CommitteeState era -> Encoding
$cencodedSizeExpr :: forall era.
Typeable era =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (CommitteeState era) -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (CommitteeState era) -> Size
$cencodedListSizeExpr :: forall era.
Typeable era =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [CommitteeState era] -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [CommitteeState era] -> Size
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 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 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
      Map (Credential 'Staking) Coin
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)
      Map (Credential 'Staking) Coin
irT <- 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)
      DeltaCoin
dR <- Decoder s DeltaCoin
-> StateT (Interns (Credential 'Staking)) (Decoder s) DeltaCoin
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Interns (Credential 'Staking)) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Decoder s DeltaCoin
forall s. Decoder s DeltaCoin
forall a s. DecCBOR a => Decoder s a
decCBOR
      DeltaCoin
dT <- Decoder s DeltaCoin
-> StateT (Interns (Credential 'Staking)) (Decoder s) DeltaCoin
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Interns (Credential 'Staking)) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Decoder s DeltaCoin
forall s. Decoder s DeltaCoin
forall a s. DecCBOR a => Decoder s a
decCBOR
      InstantaneousRewards
-> StateT
     (Interns (Credential 'Staking)) (Decoder s) InstantaneousRewards
forall a. a -> StateT (Interns (Credential 'Staking)) (Decoder s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InstantaneousRewards
 -> StateT
      (Interns (Credential 'Staking)) (Decoder s) InstantaneousRewards)
-> InstantaneousRewards
-> StateT
     (Interns (Credential 'Staking)) (Decoder s) InstantaneousRewards
forall a b. (a -> b) -> a -> b
$ Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards
InstantaneousRewards Map (Credential 'Staking) Coin
irR Map (Credential 'Staking) Coin
irT DeltaCoin
dR DeltaCoin
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 'Genesis) GenDelegPair -> GenDelegs
GenDelegs Map (KeyHash 'Genesis) 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 = Set (VRFVerKeyHash 'StakePoolVRF)
-> Map (KeyHash 'StakePool) StakePoolState
-> Map (KeyHash 'StakePool) StakePoolState
-> Map (KeyHash 'StakePool) EpochNo
-> PState era
forall era.
Set (VRFVerKeyHash 'StakePoolVRF)
-> Map (KeyHash 'StakePool) StakePoolState
-> Map (KeyHash 'StakePool) StakePoolState
-> Map (KeyHash 'StakePool) EpochNo
-> PState era
PState Set (VRFVerKeyHash 'StakePoolVRF)
forall a. Set a
Set.empty Map (KeyHash 'StakePool) StakePoolState
forall k a. Map k a
Map.empty Map (KeyHash 'StakePool) StakePoolState
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})

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})

psFutureStakePoolsL :: Lens' (PState era) (Map (KeyHash 'StakePool) StakePoolState)
psFutureStakePoolsL :: forall era (f :: * -> *).
Functor f =>
(Map (KeyHash 'StakePool) StakePoolState
 -> f (Map (KeyHash 'StakePool) StakePoolState))
-> PState era -> f (PState era)
psFutureStakePoolsL = (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
psFutureStakePools (\PState era
ps Map (KeyHash 'StakePool) StakePoolState
u -> PState era
ps {psFutureStakePools = 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) (Set (VRFVerKeyHash 'StakePoolVRF))
psVRFKeyHashesL :: forall era (f :: * -> *).
Functor f =>
(Set (VRFVerKeyHash 'StakePoolVRF)
 -> f (Set (VRFVerKeyHash 'StakePoolVRF)))
-> PState era -> f (PState era)
psVRFKeyHashesL = (PState era -> Set (VRFVerKeyHash 'StakePoolVRF))
-> (PState era -> Set (VRFVerKeyHash 'StakePoolVRF) -> PState era)
-> Lens
     (PState era)
     (PState era)
     (Set (VRFVerKeyHash 'StakePoolVRF))
     (Set (VRFVerKeyHash 'StakePoolVRF))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens PState era -> Set (VRFVerKeyHash 'StakePoolVRF)
forall era. PState era -> Set (VRFVerKeyHash 'StakePoolVRF)
psVRFKeyHashes (\PState era
ps Set (VRFVerKeyHash 'StakePoolVRF)
u -> PState era
ps {psVRFKeyHashes = u})