{-# 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 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,
  rewards,
  delegations,
  ptrsMap,
  payPoolDeposit,
  refundPoolDeposit,
  Obligations (..),
  sumObligation,
  -- Lenses
  dsUnifiedL,
  dsGenDelegsL,
  dsIRewardsL,
  dsFutureGenDelegsL,
  psStakePoolParamsL,
  psFutureStakePoolParamsL,
  psRetiringL,
  psDepositsL,
) where

import Cardano.Ledger.BaseTypes (Anchor (..), AnchorData, StrictMaybe)
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 (fromCompact)
import Cardano.Ledger.Core
import Cardano.Ledger.Credential (Credential (..), Ptr, StakeCredential)
import Cardano.Ledger.DRep (DRep (..), DRepState (..))
import Cardano.Ledger.Hashes (GenDelegPair (..), GenDelegs (..))
import Cardano.Ledger.PoolParams (PoolParams)
import Cardano.Ledger.Slot (EpochNo (..), SlotNo (..))
import Cardano.Ledger.UMap (RDPair (..), UMap (UMap), UView (RewDepUView, SPoolUView))
import qualified Cardano.Ledger.UMap as UM
import Control.DeepSeq (NFData (..))
import Control.Monad.Trans
import Data.Aeson (KeyValue, ToJSON (..), object, pairs, (.=))
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 qualified Data.Set as Set
import GHC.Generics (Generic)
import Lens.Micro (Lens', lens, (^.), _1)
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)

instance NoThunks InstantaneousRewards

instance NFData InstantaneousRewards

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

toInstantaneousRewardsPair :: KeyValue e a => InstantaneousRewards -> [a]
toInstantaneousRewardsPair :: forall e a. KeyValue e a => InstantaneousRewards -> [a]
toInstantaneousRewardsPair 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 -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map (Credential 'Staking) Coin
iRReserves
  , Key
"iRTreasury" Key -> Map (Credential 'Staking) Coin -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map (Credential 'Staking) Coin
iRTreasury
  , Key
"deltaReserves" Key -> DeltaCoin -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DeltaCoin
deltaReserves
  , Key
"deltaTreasury" Key -> DeltaCoin -> a
forall v. ToJSON v => Key -> v -> a
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 -> UMap
dsUnified :: !UMap
  -- ^ Unified Reward Maps. This contains the reward map (which is the source
  -- of truth regarding the registered stake credentials, the deposit map,
  -- the delegation map, and the stake credential pointer map.
  , 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 (Int -> DState era -> ShowS
[DState era] -> ShowS
DState era -> String
(Int -> DState era -> ShowS)
-> (DState era -> String)
-> ([DState era] -> ShowS)
-> Show (DState era)
forall era. Int -> DState era -> ShowS
forall era. [DState era] -> ShowS
forall era. DState era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era. Int -> DState era -> ShowS
showsPrec :: Int -> DState era -> ShowS
$cshow :: forall era. DState era -> String
show :: DState era -> String
$cshowList :: forall era. [DState era] -> ShowS
showList :: [DState era] -> ShowS
Show, DState era -> DState era -> Bool
(DState era -> DState era -> Bool)
-> (DState era -> DState era -> Bool) -> Eq (DState era)
forall era. DState era -> DState era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall era. DState era -> DState era -> Bool
== :: DState era -> DState era -> Bool
$c/= :: forall era. DState era -> DState era -> Bool
/= :: DState era -> DState era -> Bool
Eq, (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 NoThunks (DState era)

instance NFData (DState era)

instance Era era => EncCBOR (DState era) where
  encCBOR :: DState era -> Encoding
encCBOR (DState UMap
unified Map FutureGenDeleg GenDelegPair
fgs GenDelegs
gs InstantaneousRewards
ir) =
    Word -> Encoding
encodeListLen Word
4
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> UMap -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR UMap
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 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
      UMap
unified <- StateT
  (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
   Interns (Credential 'DRepRole))
  (Decoder s)
  UMap
StateT (Share UMap) (Decoder s) UMap
forall s. StateT (Share UMap) (Decoder s) UMap
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
$ UMap
-> Map FutureGenDeleg GenDelegPair
-> GenDelegs
-> InstantaneousRewards
-> DState era
forall era.
UMap
-> Map FutureGenDeleg GenDelegPair
-> GenDelegs
-> InstantaneousRewards
-> DState era
DState UMap
unified Map FutureGenDeleg GenDelegPair
fgs GenDelegs
gs InstantaneousRewards
ir

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

toDStatePair :: KeyValue e a => DState era -> [a]
toDStatePair :: forall e a era. KeyValue e a => DState era -> [a]
toDStatePair DState {Map FutureGenDeleg GenDelegPair
GenDelegs
UMap
InstantaneousRewards
dsUnified :: forall era. DState era -> UMap
dsFutureGenDelegs :: forall era. DState era -> Map FutureGenDeleg GenDelegPair
dsGenDelegs :: forall era. DState era -> GenDelegs
dsIRewards :: forall era. DState era -> InstantaneousRewards
dsUnified :: UMap
dsFutureGenDelegs :: Map FutureGenDeleg GenDelegPair
dsGenDelegs :: GenDelegs
dsIRewards :: InstantaneousRewards
..} =
  [ Key
"unified" Key -> UMap -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UMap
dsUnified
  , Key
"fGenDelegs" Key -> [(FutureGenDeleg, GenDelegPair)] -> a
forall v. ToJSON v => Key -> v -> a
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 -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= GenDelegs
dsGenDelegs
  , Key
"irwd" Key -> InstantaneousRewards -> a
forall v. ToJSON v => Key -> v -> a
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 :: DState era -> (StakeCredential -> Maybe Coin)
lookupDepositDState :: forall era. DState era -> Credential 'Staking -> Maybe Coin
lookupDepositDState DState era
dstate =
  let currentRewardDeposits :: UView (Credential 'Staking) RDPair
currentRewardDeposits = UMap -> UView (Credential 'Staking) RDPair
RewDepUView (UMap -> UView (Credential 'Staking) RDPair)
-> UMap -> UView (Credential 'Staking) RDPair
forall a b. (a -> b) -> a -> b
$ DState era -> UMap
forall era. DState era -> UMap
dsUnified DState era
dstate
   in \Credential 'Staking
k -> do
        RDPair CompactForm Coin
_ CompactForm Coin
deposit <- Credential 'Staking
-> UView (Credential 'Staking) RDPair -> Maybe RDPair
forall k v. k -> UView k v -> Maybe v
UM.lookup Credential 'Staking
k UView (Credential 'Staking) RDPair
currentRewardDeposits
        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 CompactForm Coin
deposit

-- | Function that looks up curret reward for the delegated staking credential.
lookupRewardDState :: DState era -> (StakeCredential -> Maybe Coin)
lookupRewardDState :: forall era. DState era -> Credential 'Staking -> Maybe Coin
lookupRewardDState DState era
dstate =
  let currentRewardDeposits :: UView (Credential 'Staking) RDPair
currentRewardDeposits = UMap -> UView (Credential 'Staking) RDPair
RewDepUView (UMap -> UView (Credential 'Staking) RDPair)
-> UMap -> UView (Credential 'Staking) RDPair
forall a b. (a -> b) -> a -> b
$ DState era -> UMap
forall era. DState era -> UMap
dsUnified DState era
dstate
   in \Credential 'Staking
k -> do
        RDPair CompactForm Coin
reward CompactForm Coin
_ <- Credential 'Staking
-> UView (Credential 'Staking) RDPair -> Maybe RDPair
forall k v. k -> UView k v -> Maybe v
UM.lookup Credential 'Staking
k UView (Credential 'Staking) RDPair
currentRewardDeposits
        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 CompactForm Coin
reward

-- | The state used by the POOL rule, which tracks stake pool information.
data PState era = PState
  { forall era. PState era -> Map (KeyHash 'StakePool) PoolParams
psStakePoolParams :: !(Map (KeyHash 'StakePool) PoolParams)
  -- ^ The stake pool parameters.
  , forall era. PState era -> Map (KeyHash 'StakePool) PoolParams
psFutureStakePoolParams :: !(Map (KeyHash 'StakePool) PoolParams)
  -- ^ The future stake pool parameters.
  -- 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.
  , forall era. PState era -> Map (KeyHash 'StakePool) Coin
psDeposits :: !(Map (KeyHash 'StakePool) Coin)
  -- ^ A map of the deposits for each pool
  }
  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)

instance NoThunks (PState era)

instance NFData (PState era)

instance Era era => EncCBOR (PState era) where
  encCBOR :: PState era -> Encoding
encCBOR (PState Map (KeyHash 'StakePool) PoolParams
a Map (KeyHash 'StakePool) PoolParams
b Map (KeyHash 'StakePool) EpochNo
c Map (KeyHash 'StakePool) Coin
d) =
    Word -> Encoding
encodeListLen Word
4 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map (KeyHash 'StakePool) PoolParams -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Map (KeyHash 'StakePool) PoolParams
a Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map (KeyHash 'StakePool) PoolParams -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Map (KeyHash 'StakePool) PoolParams
b 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
c Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map (KeyHash 'StakePool) Coin -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Map (KeyHash 'StakePool) Coin
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
    Map (KeyHash 'StakePool) PoolParams
psStakePoolParams <- Lens'
  (Interns (KeyHash 'StakePool))
  (Share (Map (KeyHash 'StakePool) PoolParams))
-> StateT
     (Interns (KeyHash 'StakePool))
     (Decoder s)
     (Map (KeyHash 'StakePool) PoolParams)
forall b bs s.
DecShareCBOR b =>
Lens' bs (Share b) -> StateT bs (Decoder s) b
decSharePlusLensCBOR (Lens'
  (Interns (KeyHash 'StakePool), Interns PoolParams)
  (Interns (KeyHash 'StakePool))
-> Lens'
     (Interns (KeyHash 'StakePool)) (Interns (KeyHash 'StakePool))
-> Lens'
     (Interns (KeyHash 'StakePool))
     (Interns (KeyHash 'StakePool), Interns PoolParams)
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 PoolParams)
-> f (Interns (KeyHash 'StakePool), Interns PoolParams)
forall s t a b. Field1 s t a b => Lens s t a b
Lens'
  (Interns (KeyHash 'StakePool), Interns PoolParams)
  (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) PoolParams
psFutureStakePoolParams <- Lens'
  (Interns (KeyHash 'StakePool))
  (Share (Map (KeyHash 'StakePool) PoolParams))
-> StateT
     (Interns (KeyHash 'StakePool))
     (Decoder s)
     (Map (KeyHash 'StakePool) PoolParams)
forall b bs s.
DecShareCBOR b =>
Lens' bs (Share b) -> StateT bs (Decoder s) b
decSharePlusLensCBOR (Lens'
  (Interns (KeyHash 'StakePool), Interns PoolParams)
  (Interns (KeyHash 'StakePool))
-> Lens'
     (Interns (KeyHash 'StakePool)) (Interns (KeyHash 'StakePool))
-> Lens'
     (Interns (KeyHash 'StakePool))
     (Interns (KeyHash 'StakePool), Interns PoolParams)
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 PoolParams)
-> f (Interns (KeyHash 'StakePool), Interns PoolParams)
forall s t a b. Field1 s t a b => Lens s t a b
Lens'
  (Interns (KeyHash 'StakePool), Interns PoolParams)
  (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)
    Map (KeyHash 'StakePool) Coin
psDeposits <- Lens'
  (Interns (KeyHash 'StakePool))
  (Share (Map (KeyHash 'StakePool) Coin))
-> StateT
     (Interns (KeyHash 'StakePool))
     (Decoder s)
     (Map (KeyHash 'StakePool) Coin)
forall b bs s.
DecShareCBOR b =>
Lens' bs (Share b) -> StateT bs (Decoder s) b
decSharePlusLensCBOR (Lens'
  (Interns (KeyHash 'StakePool), Interns Coin)
  (Interns (KeyHash 'StakePool))
-> Lens'
     (Interns (KeyHash 'StakePool)) (Interns (KeyHash 'StakePool))
-> Lens'
     (Interns (KeyHash 'StakePool))
     (Interns (KeyHash 'StakePool), Interns Coin)
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 Coin)
-> f (Interns (KeyHash 'StakePool), Interns Coin)
forall s t a b. Field1 s t a b => Lens s t a b
Lens'
  (Interns (KeyHash 'StakePool), Interns Coin)
  (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 {Map (KeyHash 'StakePool) PoolParams
psStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
psStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
psStakePoolParams, Map (KeyHash 'StakePool) PoolParams
psFutureStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
psFutureStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
psFutureStakePoolParams, Map (KeyHash 'StakePool) EpochNo
psRetiring :: Map (KeyHash 'StakePool) EpochNo
psRetiring :: Map (KeyHash 'StakePool) EpochNo
psRetiring, Map (KeyHash 'StakePool) Coin
psDeposits :: Map (KeyHash 'StakePool) Coin
psDeposits :: Map (KeyHash 'StakePool) Coin
psDeposits}

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

toPStatePair :: KeyValue e a => PState era -> [a]
toPStatePair :: forall e a era. KeyValue e a => PState era -> [a]
toPStatePair PState {Map (KeyHash 'StakePool) EpochNo
Map (KeyHash 'StakePool) Coin
Map (KeyHash 'StakePool) PoolParams
psStakePoolParams :: forall era. PState era -> Map (KeyHash 'StakePool) PoolParams
psFutureStakePoolParams :: forall era. PState era -> Map (KeyHash 'StakePool) PoolParams
psRetiring :: forall era. PState era -> Map (KeyHash 'StakePool) EpochNo
psDeposits :: forall era. PState era -> Map (KeyHash 'StakePool) Coin
psStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
psFutureStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
psRetiring :: Map (KeyHash 'StakePool) EpochNo
psDeposits :: Map (KeyHash 'StakePool) Coin
..} =
  [ Key
"stakePoolParams" Key -> Map (KeyHash 'StakePool) PoolParams -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map (KeyHash 'StakePool) PoolParams
psStakePoolParams
  , Key
"futureStakePoolParams" Key -> Map (KeyHash 'StakePool) PoolParams -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map (KeyHash 'StakePool) PoolParams
psFutureStakePoolParams
  , Key
"retiring" Key -> Map (KeyHash 'StakePool) EpochNo -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map (KeyHash 'StakePool) EpochNo
psRetiring
  , Key
"deposits" Key -> Map (KeyHash 'StakePool) Coin -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map (KeyHash 'StakePool) Coin
psDeposits
  ]

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
  ( Era 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 (DState era) where
  def :: DState era
def =
    UMap
-> Map FutureGenDeleg GenDelegPair
-> GenDelegs
-> InstantaneousRewards
-> DState era
forall era.
UMap
-> Map FutureGenDeleg GenDelegPair
-> GenDelegs
-> InstantaneousRewards
-> DState era
DState
      UMap
UM.empty
      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 =
    Map (KeyHash 'StakePool) PoolParams
-> Map (KeyHash 'StakePool) PoolParams
-> Map (KeyHash 'StakePool) EpochNo
-> Map (KeyHash 'StakePool) Coin
-> PState era
forall era.
Map (KeyHash 'StakePool) PoolParams
-> Map (KeyHash 'StakePool) PoolParams
-> Map (KeyHash 'StakePool) EpochNo
-> Map (KeyHash 'StakePool) Coin
-> PState era
PState Map (KeyHash 'StakePool) PoolParams
forall k a. Map k a
Map.empty Map (KeyHash 'StakePool) PoolParams
forall k a. Map k a
Map.empty Map (KeyHash 'StakePool) EpochNo
forall k a. Map k a
Map.empty Map (KeyHash 'StakePool) Coin
forall k a. Map k a
Map.empty

rewards :: DState era -> UView (Credential 'Staking) RDPair
rewards :: forall era. DState era -> UView (Credential 'Staking) RDPair
rewards = UMap -> UView (Credential 'Staking) RDPair
RewDepUView (UMap -> UView (Credential 'Staking) RDPair)
-> (DState era -> UMap)
-> DState era
-> UView (Credential 'Staking) RDPair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DState era -> UMap
forall era. DState era -> UMap
dsUnified

delegations ::
  DState era ->
  UView (Credential 'Staking) (KeyHash 'StakePool)
delegations :: forall era.
DState era -> UView (Credential 'Staking) (KeyHash 'StakePool)
delegations = UMap -> UView (Credential 'Staking) (KeyHash 'StakePool)
SPoolUView (UMap -> UView (Credential 'Staking) (KeyHash 'StakePool))
-> (DState era -> UMap)
-> DState era
-> UView (Credential 'Staking) (KeyHash 'StakePool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DState era -> UMap
forall era. DState era -> UMap
dsUnified

-- | get the actual ptrs map, we don't need a view
ptrsMap :: DState era -> Map Ptr (Credential 'Staking)
ptrsMap :: forall era. DState era -> Map Ptr (Credential 'Staking)
ptrsMap (DState {dsUnified :: forall era. DState era -> UMap
dsUnified = UMap Map (Credential 'Staking) UMElem
_ Map Ptr (Credential 'Staking)
ptrmap}) = Map Ptr (Credential 'Staking)
ptrmap

-- ==========================================================
-- Functions that handle Deposits

-- | One only pays a deposit on the initial pool registration. So return the
--   the Deposits unchanged if the keyhash already exists. There are legal
--   situations where a pool may be registered multiple times.
payPoolDeposit ::
  EraPParams era =>
  KeyHash 'StakePool ->
  PParams era ->
  PState era ->
  PState era
payPoolDeposit :: forall era.
EraPParams era =>
KeyHash 'StakePool -> PParams era -> PState era -> PState era
payPoolDeposit KeyHash 'StakePool
keyhash PParams era
pp PState era
pstate = PState era
pstate {psDeposits = newpool}
  where
    pool :: Map (KeyHash 'StakePool) Coin
pool = PState era -> Map (KeyHash 'StakePool) Coin
forall era. PState era -> Map (KeyHash 'StakePool) Coin
psDeposits PState era
pstate
    !deposit :: Coin
deposit = PParams era
pp PParams era -> Getting Coin (PParams era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (PParams era) Coin
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppPoolDepositL
    newpool :: Map (KeyHash 'StakePool) Coin
newpool
      | KeyHash 'StakePool -> Map (KeyHash 'StakePool) Coin -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.notMember KeyHash 'StakePool
keyhash Map (KeyHash 'StakePool) Coin
pool = KeyHash 'StakePool
-> Coin
-> Map (KeyHash 'StakePool) Coin
-> Map (KeyHash 'StakePool) Coin
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert KeyHash 'StakePool
keyhash Coin
deposit Map (KeyHash 'StakePool) Coin
pool
      | Bool
otherwise = Map (KeyHash 'StakePool) Coin
pool

refundPoolDeposit :: KeyHash 'StakePool -> PState era -> (Coin, PState era)
refundPoolDeposit :: forall era. KeyHash 'StakePool -> PState era -> (Coin, PState era)
refundPoolDeposit KeyHash 'StakePool
keyhash PState era
pstate = (Coin
coin, PState era
pstate {psDeposits = newpool})
  where
    pool :: Map (KeyHash 'StakePool) Coin
pool = PState era -> Map (KeyHash 'StakePool) Coin
forall era. PState era -> Map (KeyHash 'StakePool) Coin
psDeposits PState era
pstate
    (Coin
coin, Map (KeyHash 'StakePool) Coin
newpool) = case KeyHash 'StakePool -> Map (KeyHash 'StakePool) Coin -> Maybe Coin
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash 'StakePool
keyhash Map (KeyHash 'StakePool) Coin
pool of
      Just Coin
c -> (Coin
c, KeyHash 'StakePool
-> Map (KeyHash 'StakePool) Coin -> Map (KeyHash 'StakePool) Coin
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete KeyHash 'StakePool
keyhash Map (KeyHash 'StakePool) Coin
pool)
      Maybe Coin
Nothing -> (Coin
forall a. Monoid a => a
mempty, Map (KeyHash 'StakePool) Coin
pool)

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

-- =======================================================
-- Lenses for CertState and its subsidiary types

-- ===================================
-- DState

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

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

-- ===================================
-- PState

psStakePoolParamsL :: Lens' (PState era) (Map (KeyHash 'StakePool) PoolParams)
psStakePoolParamsL :: forall era (f :: * -> *).
Functor f =>
(Map (KeyHash 'StakePool) PoolParams
 -> f (Map (KeyHash 'StakePool) PoolParams))
-> PState era -> f (PState era)
psStakePoolParamsL = (PState era -> Map (KeyHash 'StakePool) PoolParams)
-> (PState era
    -> Map (KeyHash 'StakePool) PoolParams -> PState era)
-> Lens
     (PState era)
     (PState era)
     (Map (KeyHash 'StakePool) PoolParams)
     (Map (KeyHash 'StakePool) PoolParams)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens PState era -> Map (KeyHash 'StakePool) PoolParams
forall era. PState era -> Map (KeyHash 'StakePool) PoolParams
psStakePoolParams (\PState era
ds Map (KeyHash 'StakePool) PoolParams
u -> PState era
ds {psStakePoolParams = u})

psFutureStakePoolParamsL :: Lens' (PState era) (Map (KeyHash 'StakePool) PoolParams)
psFutureStakePoolParamsL :: forall era (f :: * -> *).
Functor f =>
(Map (KeyHash 'StakePool) PoolParams
 -> f (Map (KeyHash 'StakePool) PoolParams))
-> PState era -> f (PState era)
psFutureStakePoolParamsL = (PState era -> Map (KeyHash 'StakePool) PoolParams)
-> (PState era
    -> Map (KeyHash 'StakePool) PoolParams -> PState era)
-> Lens
     (PState era)
     (PState era)
     (Map (KeyHash 'StakePool) PoolParams)
     (Map (KeyHash 'StakePool) PoolParams)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens PState era -> Map (KeyHash 'StakePool) PoolParams
forall era. PState era -> Map (KeyHash 'StakePool) PoolParams
psFutureStakePoolParams (\PState era
ds Map (KeyHash 'StakePool) PoolParams
u -> PState era
ds {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
ds Map (KeyHash 'StakePool) EpochNo
u -> PState era
ds {psRetiring = u})

psDepositsL :: Lens' (PState era) (Map (KeyHash 'StakePool) Coin)
psDepositsL :: forall era (f :: * -> *).
Functor f =>
(Map (KeyHash 'StakePool) Coin
 -> f (Map (KeyHash 'StakePool) Coin))
-> PState era -> f (PState era)
psDepositsL = (PState era -> Map (KeyHash 'StakePool) Coin)
-> (PState era -> Map (KeyHash 'StakePool) Coin -> PState era)
-> Lens
     (PState era)
     (PState era)
     (Map (KeyHash 'StakePool) Coin)
     (Map (KeyHash 'StakePool) Coin)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens PState era -> Map (KeyHash 'StakePool) Coin
forall era. PState era -> Map (KeyHash 'StakePool) Coin
psDeposits (\PState era
ds Map (KeyHash 'StakePool) Coin
u -> PState era
ds {psDeposits = u})