{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Test.Cardano.Ledger.Shelley.Examples.Combinators (
evolveNonceFrozen,
evolveNonceUnfrozen,
newLab,
addFees,
addPoolDeposits,
newUTxO,
newStakeCred,
deregStakeCred,
delegation,
newPool,
reregPool,
updatePoolParams,
stageRetirement,
reapPool,
mir,
applyMIR,
rewardUpdate,
pulserUpdate,
applyRewardUpdate,
setPoolDistr,
setOCertCounter,
newSnapshot,
incrBlockCount,
newEpoch,
setCurrentProposals,
setFutureProposals,
solidifyProposals,
setPParams,
setPrevPParams,
setFutureGenDeleg,
adoptFutureGenDeleg,
) where
import Cardano.Ledger.Address (RewardAccount (..))
import Cardano.Ledger.BaseTypes (
BlocksMade (..),
Nonce (..),
StrictMaybe (..),
quorum,
(⭒),
)
import Cardano.Ledger.Block (Block (..), bheader)
import Cardano.Ledger.Coin (
Coin (..),
compactCoinOrError,
)
import Cardano.Ledger.Compactible (fromCompact)
import Cardano.Ledger.Credential (Credential (..), Ptr)
import Cardano.Ledger.Hashes (GenDelegPair, GenDelegs (..))
import Cardano.Ledger.PoolParams (PoolParams (..))
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.LedgerState (
EpochState (..),
LedgerState (..),
NewEpochState (..),
PulsingRewUpdate (..),
RewardUpdate (..),
UTxOState (..),
applyRUpd,
curPParamsEpochStateL,
esLStateL,
futurePParamsEpochStateL,
lsCertStateL,
lsUTxOStateL,
nesEsL,
prevPParamsEpochStateL,
utxosDepositedL,
utxosFeesL,
)
import Cardano.Ledger.Shelley.PParams (ProposedPPUpdates)
import Cardano.Ledger.Shelley.Rules (emptyInstantaneousRewards, votedFuturePParams)
import Cardano.Ledger.Shelley.State
import Cardano.Ledger.Val ((<+>), (<->), (<×>))
import Cardano.Protocol.TPraos.BHeader (
BHBody (..),
BHeader,
LastAppliedBlock (..),
bhHash,
bhbody,
lastAppliedHash,
prevHashToNonce,
)
import Cardano.Slotting.Slot (EpochNo, WithOrigin (..))
import Data.Foldable (fold)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.MapExtras (fromElems)
import Data.Maybe (fromJust)
import qualified Data.Set as Set
import Data.Word (Word64)
import GHC.Stack (HasCallStack)
import Lens.Micro
import Lens.Micro.Extras (view)
import Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes (MockCrypto)
import Test.Cardano.Ledger.Shelley.Rules.Chain (ChainState (..))
import Test.Cardano.Ledger.Shelley.Utils (epochFromSlotNo, getBlockNonce, testGlobals)
evolveNonceFrozen :: forall era. Nonce -> ChainState era -> ChainState era
evolveNonceFrozen :: forall era. Nonce -> ChainState era -> ChainState era
evolveNonceFrozen Nonce
n ChainState era
cs = ChainState era
cs {chainEvolvingNonce = chainEvolvingNonce cs ⭒ n}
evolveNonceUnfrozen :: forall era. Nonce -> ChainState era -> ChainState era
evolveNonceUnfrozen :: forall era. Nonce -> ChainState era -> ChainState era
evolveNonceUnfrozen Nonce
n ChainState era
cs =
ChainState era
cs
{ chainCandidateNonce = chainCandidateNonce cs ⭒ n
, chainEvolvingNonce = chainEvolvingNonce cs ⭒ n
}
newLab ::
forall era.
Block (BHeader MockCrypto) era ->
ChainState era ->
ChainState era
newLab :: forall era.
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
newLab Block (BHeader MockCrypto) era
b ChainState era
cs =
ChainState era
cs {chainLastAppliedBlock = At $ LastAppliedBlock bn sn (bhHash bh)}
where
bh :: BHeader MockCrypto
bh = Block (BHeader MockCrypto) era -> BHeader MockCrypto
forall h era. Block h era -> h
bheader Block (BHeader MockCrypto) era
b
bn :: BlockNo
bn = BHBody MockCrypto -> BlockNo
forall c. BHBody c -> BlockNo
bheaderBlockNo (BHBody MockCrypto -> BlockNo) -> BHBody MockCrypto -> BlockNo
forall a b. (a -> b) -> a -> b
$ BHeader MockCrypto -> BHBody MockCrypto
forall c. Crypto c => BHeader c -> BHBody c
bhbody BHeader MockCrypto
bh
sn :: SlotNo
sn = BHBody MockCrypto -> SlotNo
forall c. BHBody c -> SlotNo
bheaderSlotNo (BHBody MockCrypto -> SlotNo) -> BHBody MockCrypto -> SlotNo
forall a b. (a -> b) -> a -> b
$ BHeader MockCrypto -> BHBody MockCrypto
forall c. Crypto c => BHeader c -> BHBody c
bhbody BHeader MockCrypto
bh
addPoolDeposits ::
forall era.
(EraPParams era, EraCertState era) =>
PParams era ->
[PoolParams] ->
ChainState era ->
ChainState era
addPoolDeposits :: forall era.
(EraPParams era, EraCertState era) =>
PParams era -> [PoolParams] -> ChainState era -> ChainState era
addPoolDeposits PParams era
ppEx [PoolParams]
pools ChainState era
cs = ChainState era
cs {chainNes = nes}
where
curDeposits :: Map (KeyHash 'StakePool) Coin
curDeposits =
ChainState era -> NewEpochState era
forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs NewEpochState era
-> Getting
(Map (KeyHash 'StakePool) Coin)
(NewEpochState era)
(Map (KeyHash 'StakePool) Coin)
-> Map (KeyHash 'StakePool) Coin
forall s a. s -> Getting a s a -> a
^. (EpochState era
-> Const (Map (KeyHash 'StakePool) Coin) (EpochState era))
-> NewEpochState era
-> Const (Map (KeyHash 'StakePool) Coin) (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era
-> Const (Map (KeyHash 'StakePool) Coin) (EpochState era))
-> NewEpochState era
-> Const (Map (KeyHash 'StakePool) Coin) (NewEpochState era))
-> ((Map (KeyHash 'StakePool) Coin
-> Const
(Map (KeyHash 'StakePool) Coin) (Map (KeyHash 'StakePool) Coin))
-> EpochState era
-> Const (Map (KeyHash 'StakePool) Coin) (EpochState era))
-> Getting
(Map (KeyHash 'StakePool) Coin)
(NewEpochState era)
(Map (KeyHash 'StakePool) Coin)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era
-> Const (Map (KeyHash 'StakePool) Coin) (LedgerState era))
-> EpochState era
-> Const (Map (KeyHash 'StakePool) Coin) (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era
-> Const (Map (KeyHash 'StakePool) Coin) (LedgerState era))
-> EpochState era
-> Const (Map (KeyHash 'StakePool) Coin) (EpochState era))
-> ((Map (KeyHash 'StakePool) Coin
-> Const
(Map (KeyHash 'StakePool) Coin) (Map (KeyHash 'StakePool) Coin))
-> LedgerState era
-> Const (Map (KeyHash 'StakePool) Coin) (LedgerState era))
-> (Map (KeyHash 'StakePool) Coin
-> Const
(Map (KeyHash 'StakePool) Coin) (Map (KeyHash 'StakePool) Coin))
-> EpochState era
-> Const (Map (KeyHash 'StakePool) Coin) (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era
-> Const (Map (KeyHash 'StakePool) Coin) (CertState era))
-> LedgerState era
-> Const (Map (KeyHash 'StakePool) Coin) (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era
-> Const (Map (KeyHash 'StakePool) Coin) (CertState era))
-> LedgerState era
-> Const (Map (KeyHash 'StakePool) Coin) (LedgerState era))
-> ((Map (KeyHash 'StakePool) Coin
-> Const
(Map (KeyHash 'StakePool) Coin) (Map (KeyHash 'StakePool) Coin))
-> CertState era
-> Const (Map (KeyHash 'StakePool) Coin) (CertState era))
-> (Map (KeyHash 'StakePool) Coin
-> Const
(Map (KeyHash 'StakePool) Coin) (Map (KeyHash 'StakePool) Coin))
-> LedgerState era
-> Const (Map (KeyHash 'StakePool) Coin) (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PState era -> Const (Map (KeyHash 'StakePool) Coin) (PState era))
-> CertState era
-> Const (Map (KeyHash 'StakePool) Coin) (CertState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
certPStateL ((PState era -> Const (Map (KeyHash 'StakePool) Coin) (PState era))
-> CertState era
-> Const (Map (KeyHash 'StakePool) Coin) (CertState era))
-> ((Map (KeyHash 'StakePool) Coin
-> Const
(Map (KeyHash 'StakePool) Coin) (Map (KeyHash 'StakePool) Coin))
-> PState era
-> Const (Map (KeyHash 'StakePool) Coin) (PState era))
-> (Map (KeyHash 'StakePool) Coin
-> Const
(Map (KeyHash 'StakePool) Coin) (Map (KeyHash 'StakePool) Coin))
-> CertState era
-> Const (Map (KeyHash 'StakePool) Coin) (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (KeyHash 'StakePool) Coin
-> Const
(Map (KeyHash 'StakePool) Coin) (Map (KeyHash 'StakePool) Coin))
-> PState era -> Const (Map (KeyHash 'StakePool) Coin) (PState era)
forall era (f :: * -> *).
Functor f =>
(Map (KeyHash 'StakePool) Coin
-> f (Map (KeyHash 'StakePool) Coin))
-> PState era -> f (PState era)
psDepositsL
nes :: NewEpochState era
nes =
ChainState era -> NewEpochState era
forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
NewEpochState era
-> (NewEpochState era -> NewEpochState era) -> NewEpochState era
forall a b. a -> (a -> b) -> b
& (EpochState era -> Identity (EpochState era))
-> NewEpochState era -> Identity (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Identity (EpochState era))
-> NewEpochState era -> Identity (NewEpochState era))
-> ((Map (KeyHash 'StakePool) Coin
-> Identity (Map (KeyHash 'StakePool) Coin))
-> EpochState era -> Identity (EpochState era))
-> (Map (KeyHash 'StakePool) Coin
-> Identity (Map (KeyHash 'StakePool) Coin))
-> NewEpochState era
-> Identity (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era -> Identity (LedgerState era))
-> EpochState era -> Identity (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> Identity (LedgerState era))
-> EpochState era -> Identity (EpochState era))
-> ((Map (KeyHash 'StakePool) Coin
-> Identity (Map (KeyHash 'StakePool) Coin))
-> LedgerState era -> Identity (LedgerState era))
-> (Map (KeyHash 'StakePool) Coin
-> Identity (Map (KeyHash 'StakePool) Coin))
-> EpochState era
-> Identity (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era -> Identity (CertState era))
-> LedgerState era -> Identity (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era -> Identity (CertState era))
-> LedgerState era -> Identity (LedgerState era))
-> ((Map (KeyHash 'StakePool) Coin
-> Identity (Map (KeyHash 'StakePool) Coin))
-> CertState era -> Identity (CertState era))
-> (Map (KeyHash 'StakePool) Coin
-> Identity (Map (KeyHash 'StakePool) Coin))
-> LedgerState era
-> Identity (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PState era -> Identity (PState era))
-> CertState era -> Identity (CertState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
certPStateL ((PState era -> Identity (PState era))
-> CertState era -> Identity (CertState era))
-> ((Map (KeyHash 'StakePool) Coin
-> Identity (Map (KeyHash 'StakePool) Coin))
-> PState era -> Identity (PState era))
-> (Map (KeyHash 'StakePool) Coin
-> Identity (Map (KeyHash 'StakePool) Coin))
-> CertState era
-> Identity (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (KeyHash 'StakePool) Coin
-> Identity (Map (KeyHash 'StakePool) Coin))
-> PState era -> Identity (PState era)
forall era (f :: * -> *).
Functor f =>
(Map (KeyHash 'StakePool) Coin
-> f (Map (KeyHash 'StakePool) Coin))
-> PState era -> f (PState era)
psDepositsL ((Map (KeyHash 'StakePool) Coin
-> Identity (Map (KeyHash 'StakePool) Coin))
-> NewEpochState era -> Identity (NewEpochState era))
-> (Map (KeyHash 'StakePool) Coin -> Map (KeyHash 'StakePool) Coin)
-> NewEpochState era
-> NewEpochState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Map (KeyHash 'StakePool) Coin
-> Map (KeyHash 'StakePool) Coin -> Map (KeyHash 'StakePool) Coin
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map (KeyHash 'StakePool) Coin
newPools
NewEpochState era
-> (NewEpochState era -> NewEpochState era) -> NewEpochState era
forall a b. a -> (a -> b) -> b
& (EpochState era -> Identity (EpochState era))
-> NewEpochState era -> Identity (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Identity (EpochState era))
-> NewEpochState era -> Identity (NewEpochState era))
-> ((Coin -> Identity Coin)
-> EpochState era -> Identity (EpochState era))
-> (Coin -> Identity Coin)
-> NewEpochState era
-> Identity (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era -> Identity (LedgerState era))
-> EpochState era -> Identity (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> Identity (LedgerState era))
-> EpochState era -> Identity (EpochState era))
-> ((Coin -> Identity Coin)
-> LedgerState era -> Identity (LedgerState era))
-> (Coin -> Identity Coin)
-> EpochState era
-> Identity (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTxOState era -> Identity (UTxOState era))
-> LedgerState era -> Identity (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(UTxOState era -> f (UTxOState era))
-> LedgerState era -> f (LedgerState era)
lsUTxOStateL ((UTxOState era -> Identity (UTxOState era))
-> LedgerState era -> Identity (LedgerState era))
-> ((Coin -> Identity Coin)
-> UTxOState era -> Identity (UTxOState era))
-> (Coin -> Identity Coin)
-> LedgerState era
-> Identity (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Identity Coin)
-> UTxOState era -> Identity (UTxOState era)
forall era (f :: * -> *).
Functor f =>
(Coin -> f Coin) -> UTxOState era -> f (UTxOState era)
utxosDepositedL ((Coin -> Identity Coin)
-> NewEpochState era -> Identity (NewEpochState era))
-> Coin -> NewEpochState era -> NewEpochState era
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ (Int
newPoolCount Int -> Coin -> Coin
forall i. Integral i => i -> Coin -> Coin
forall t i. (Val t, Integral i) => i -> t -> t
<×> PParams era
ppEx 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, HasCallStack) =>
Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppPoolDepositL)
newPools :: Map (KeyHash 'StakePool) Coin
newPools = PParams era
ppEx 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, HasCallStack) =>
Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppPoolDepositL Coin
-> Map (KeyHash 'StakePool) PoolParams
-> Map (KeyHash 'StakePool) Coin
forall a b.
a -> Map (KeyHash 'StakePool) b -> Map (KeyHash 'StakePool) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ((PoolParams -> KeyHash 'StakePool)
-> [PoolParams] -> Map (KeyHash 'StakePool) PoolParams
forall (f :: * -> *) k v.
(Foldable f, Ord k) =>
(v -> k) -> f v -> Map k v
fromElems PoolParams -> KeyHash 'StakePool
ppId [PoolParams]
pools Map (KeyHash 'StakePool) PoolParams
-> Map (KeyHash 'StakePool) Coin
-> Map (KeyHash 'StakePool) PoolParams
forall k a b. Ord k => Map k a -> Map k b -> Map k a
`Map.difference` Map (KeyHash 'StakePool) Coin
curDeposits)
newPoolCount :: Int
newPoolCount = Map (KeyHash 'StakePool) Coin -> Int
forall k a. Map k a -> Int
Map.size Map (KeyHash 'StakePool) Coin
newPools
addFees ::
Coin ->
ChainState era ->
ChainState era
addFees :: forall era. Coin -> ChainState era -> ChainState era
addFees Coin
newFees ChainState era
cs = ChainState era
cs {chainNes = nes}
where
nes :: NewEpochState era
nes =
ChainState era -> NewEpochState era
forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs NewEpochState era
-> (NewEpochState era -> NewEpochState era) -> NewEpochState era
forall a b. a -> (a -> b) -> b
& (EpochState era -> Identity (EpochState era))
-> NewEpochState era -> Identity (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Identity (EpochState era))
-> NewEpochState era -> Identity (NewEpochState era))
-> ((Coin -> Identity Coin)
-> EpochState era -> Identity (EpochState era))
-> (Coin -> Identity Coin)
-> NewEpochState era
-> Identity (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era -> Identity (LedgerState era))
-> EpochState era -> Identity (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> Identity (LedgerState era))
-> EpochState era -> Identity (EpochState era))
-> ((Coin -> Identity Coin)
-> LedgerState era -> Identity (LedgerState era))
-> (Coin -> Identity Coin)
-> EpochState era
-> Identity (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTxOState era -> Identity (UTxOState era))
-> LedgerState era -> Identity (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(UTxOState era -> f (UTxOState era))
-> LedgerState era -> f (LedgerState era)
lsUTxOStateL ((UTxOState era -> Identity (UTxOState era))
-> LedgerState era -> Identity (LedgerState era))
-> ((Coin -> Identity Coin)
-> UTxOState era -> Identity (UTxOState era))
-> (Coin -> Identity Coin)
-> LedgerState era
-> Identity (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Identity Coin)
-> UTxOState era -> Identity (UTxOState era)
forall era (f :: * -> *).
Functor f =>
(Coin -> f Coin) -> UTxOState era -> f (UTxOState era)
utxosFeesL ((Coin -> Identity Coin)
-> NewEpochState era -> Identity (NewEpochState era))
-> Coin -> NewEpochState era -> NewEpochState era
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ Coin
newFees
newUTxO ::
forall era.
(EraTx era, EraStake era) =>
TxBody era ->
ChainState era ->
ChainState era
newUTxO :: forall era.
(EraTx era, EraStake era) =>
TxBody era -> ChainState era -> ChainState era
newUTxO TxBody era
txb ChainState era
cs = ChainState era
cs {chainNes = nes'}
where
nes :: NewEpochState era
nes = ChainState era -> NewEpochState era
forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
es :: EpochState era
es = NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes
ls :: LedgerState era
ls = EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState EpochState era
es
utxoSt :: UTxOState era
utxoSt = LedgerState era -> UTxOState era
forall era. LedgerState era -> UTxOState era
lsUTxOState LedgerState era
ls
utxo :: Map TxIn (TxOut era)
utxo = UTxO era -> Map TxIn (TxOut era)
forall era. UTxO era -> Map TxIn (TxOut era)
unUTxO (UTxO era -> Map TxIn (TxOut era))
-> UTxO era -> Map TxIn (TxOut era)
forall a b. (a -> b) -> a -> b
$ UTxOState era -> UTxO era
forall era. UTxOState era -> UTxO era
utxosUtxo UTxOState era
utxoSt
utxoAdd :: UTxO era
utxoAdd = forall era. EraTxBody era => TxBody era -> UTxO era
txouts @era TxBody era
txb
utxoToDel :: Map TxIn (TxOut era)
utxoToDel = Map TxIn (TxOut era) -> Set TxIn -> Map TxIn (TxOut era)
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map TxIn (TxOut era)
utxo (forall era. EraTxBody era => TxBody era -> Set TxIn
txins @era TxBody era
txb)
utxoWithout :: Map TxIn (TxOut era)
utxoWithout = Map TxIn (TxOut era) -> Set TxIn -> Map TxIn (TxOut era)
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.withoutKeys Map TxIn (TxOut era)
utxo (forall era. EraTxBody era => TxBody era -> Set TxIn
txins @era TxBody era
txb)
utxoDel :: UTxO era
utxoDel = Map TxIn (TxOut era) -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO Map TxIn (TxOut era)
utxoToDel
utxo' :: UTxO era
utxo' = Map TxIn (TxOut era) -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO (Map TxIn (TxOut era)
utxoWithout Map TxIn (TxOut era)
-> Map TxIn (TxOut era) -> Map TxIn (TxOut era)
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` UTxO era -> Map TxIn (TxOut era)
forall era. UTxO era -> Map TxIn (TxOut era)
unUTxO UTxO era
utxoAdd)
is' :: InstantStake era
is' = UTxO era -> InstantStake era -> InstantStake era
forall era.
EraStake era =>
UTxO era -> InstantStake era -> InstantStake era
deleteInstantStake UTxO era
utxoDel (UTxO era -> InstantStake era -> InstantStake era
forall era.
EraStake era =>
UTxO era -> InstantStake era -> InstantStake era
addInstantStake UTxO era
utxoAdd (UTxOState era
utxoSt UTxOState era
-> Getting (InstantStake era) (UTxOState era) (InstantStake era)
-> InstantStake era
forall s a. s -> Getting a s a -> a
^. Getting (InstantStake era) (UTxOState era) (InstantStake era)
forall era. Lens' (UTxOState era) (InstantStake era)
forall (t :: * -> *) era.
CanSetInstantStake t =>
Lens' (t era) (InstantStake era)
instantStakeL))
utxoSt' :: UTxOState era
utxoSt' = UTxOState era
utxoSt {utxosUtxo = utxo', utxosInstantStake = is'}
ls' :: LedgerState era
ls' = LedgerState era
ls {lsUTxOState = utxoSt'}
es' :: EpochState era
es' = EpochState era
es {esLState = ls'}
nes' :: NewEpochState era
nes' = NewEpochState era
nes {nesEs = es'}
newStakeCred ::
(EraCertState era, EraGov era, ShelleyEraAccounts era) =>
Credential 'Staking ->
Ptr ->
ChainState era ->
ChainState era
newStakeCred :: forall era.
(EraCertState era, EraGov era, ShelleyEraAccounts era) =>
Credential 'Staking -> Ptr -> ChainState era -> ChainState era
newStakeCred Credential 'Staking
cred Ptr
ptr ChainState era
cs = ChainState era
cs {chainNes = nes}
where
deposit :: Coin
deposit = ChainState era -> NewEpochState era
forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs NewEpochState era -> Getting Coin (NewEpochState era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. (EpochState era -> Const Coin (EpochState era))
-> NewEpochState era -> Const Coin (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const Coin (EpochState era))
-> NewEpochState era -> Const Coin (NewEpochState era))
-> ((Coin -> Const Coin Coin)
-> EpochState era -> Const Coin (EpochState era))
-> Getting Coin (NewEpochState era) Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const Coin (PParams era))
-> EpochState era -> Const Coin (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const Coin (PParams era))
-> EpochState era -> Const Coin (EpochState era))
-> ((Coin -> Const Coin Coin)
-> PParams era -> Const Coin (PParams era))
-> (Coin -> Const Coin Coin)
-> EpochState era
-> Const Coin (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const Coin Coin)
-> PParams era -> Const Coin (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL
nes :: NewEpochState era
nes =
ChainState era -> NewEpochState era
forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
NewEpochState era
-> (NewEpochState era -> NewEpochState era) -> NewEpochState era
forall a b. a -> (a -> b) -> b
& (EpochState era -> Identity (EpochState era))
-> NewEpochState era -> Identity (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Identity (EpochState era))
-> NewEpochState era -> Identity (NewEpochState era))
-> ((Accounts era -> Identity (Accounts era))
-> EpochState era -> Identity (EpochState era))
-> (Accounts era -> Identity (Accounts era))
-> NewEpochState era
-> Identity (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era -> Identity (LedgerState era))
-> EpochState era -> Identity (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> Identity (LedgerState era))
-> EpochState era -> Identity (EpochState era))
-> ((Accounts era -> Identity (Accounts era))
-> LedgerState era -> Identity (LedgerState era))
-> (Accounts era -> Identity (Accounts era))
-> EpochState era
-> Identity (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era -> Identity (CertState era))
-> LedgerState era -> Identity (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era -> Identity (CertState era))
-> LedgerState era -> Identity (LedgerState era))
-> ((Accounts era -> Identity (Accounts era))
-> CertState era -> Identity (CertState era))
-> (Accounts era -> Identity (Accounts era))
-> LedgerState era
-> Identity (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DState era -> Identity (DState era))
-> CertState era -> Identity (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL ((DState era -> Identity (DState era))
-> CertState era -> Identity (CertState era))
-> ((Accounts era -> Identity (Accounts era))
-> DState era -> Identity (DState era))
-> (Accounts era -> Identity (Accounts era))
-> CertState era
-> Identity (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Accounts era -> Identity (Accounts era))
-> DState era -> Identity (DState era)
forall era. Lens' (DState era) (Accounts era)
forall (t :: * -> *) era.
CanSetAccounts t =>
Lens' (t era) (Accounts era)
accountsL
((Accounts era -> Identity (Accounts era))
-> NewEpochState era -> Identity (NewEpochState era))
-> (Accounts era -> Accounts era)
-> NewEpochState era
-> NewEpochState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Credential 'Staking
-> Ptr
-> CompactForm Coin
-> Maybe (KeyHash 'StakePool)
-> Accounts era
-> Accounts era
forall era.
ShelleyEraAccounts era =>
Credential 'Staking
-> Ptr
-> CompactForm Coin
-> Maybe (KeyHash 'StakePool)
-> Accounts era
-> Accounts era
registerShelleyAccount Credential 'Staking
cred Ptr
ptr (HasCallStack => Coin -> CompactForm Coin
Coin -> CompactForm Coin
compactCoinOrError Coin
deposit) Maybe (KeyHash 'StakePool)
forall a. Maybe a
Nothing
NewEpochState era
-> (NewEpochState era -> NewEpochState era) -> NewEpochState era
forall a b. a -> (a -> b) -> b
& (EpochState era -> Identity (EpochState era))
-> NewEpochState era -> Identity (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Identity (EpochState era))
-> NewEpochState era -> Identity (NewEpochState era))
-> ((Coin -> Identity Coin)
-> EpochState era -> Identity (EpochState era))
-> (Coin -> Identity Coin)
-> NewEpochState era
-> Identity (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era -> Identity (LedgerState era))
-> EpochState era -> Identity (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> Identity (LedgerState era))
-> EpochState era -> Identity (EpochState era))
-> ((Coin -> Identity Coin)
-> LedgerState era -> Identity (LedgerState era))
-> (Coin -> Identity Coin)
-> EpochState era
-> Identity (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTxOState era -> Identity (UTxOState era))
-> LedgerState era -> Identity (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(UTxOState era -> f (UTxOState era))
-> LedgerState era -> f (LedgerState era)
lsUTxOStateL ((UTxOState era -> Identity (UTxOState era))
-> LedgerState era -> Identity (LedgerState era))
-> ((Coin -> Identity Coin)
-> UTxOState era -> Identity (UTxOState era))
-> (Coin -> Identity Coin)
-> LedgerState era
-> Identity (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Identity Coin)
-> UTxOState era -> Identity (UTxOState era)
forall era (f :: * -> *).
Functor f =>
(Coin -> f Coin) -> UTxOState era -> f (UTxOState era)
utxosDepositedL ((Coin -> Identity Coin)
-> NewEpochState era -> Identity (NewEpochState era))
-> Coin -> NewEpochState era -> NewEpochState era
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ Coin
deposit
deregStakeCred ::
(HasCallStack, EraCertState era, ShelleyEraAccounts era) =>
Credential 'Staking ->
ChainState era ->
ChainState era
deregStakeCred :: forall era.
(HasCallStack, EraCertState era, ShelleyEraAccounts era) =>
Credential 'Staking -> ChainState era -> ChainState era
deregStakeCred Credential 'Staking
cred ChainState era
cs = ChainState era
cs {chainNes = nes}
where
nes :: NewEpochState era
nes =
ChainState era -> NewEpochState era
forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
NewEpochState era
-> (NewEpochState era -> NewEpochState era) -> NewEpochState era
forall a b. a -> (a -> b) -> b
& (EpochState era -> Identity (EpochState era))
-> NewEpochState era -> Identity (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Identity (EpochState era))
-> NewEpochState era -> Identity (NewEpochState era))
-> ((Accounts era -> Identity (Accounts era))
-> EpochState era -> Identity (EpochState era))
-> (Accounts era -> Identity (Accounts era))
-> NewEpochState era
-> Identity (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era -> Identity (LedgerState era))
-> EpochState era -> Identity (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> Identity (LedgerState era))
-> EpochState era -> Identity (EpochState era))
-> ((Accounts era -> Identity (Accounts era))
-> LedgerState era -> Identity (LedgerState era))
-> (Accounts era -> Identity (Accounts era))
-> EpochState era
-> Identity (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era -> Identity (CertState era))
-> LedgerState era -> Identity (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era -> Identity (CertState era))
-> LedgerState era -> Identity (LedgerState era))
-> ((Accounts era -> Identity (Accounts era))
-> CertState era -> Identity (CertState era))
-> (Accounts era -> Identity (Accounts era))
-> LedgerState era
-> Identity (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DState era -> Identity (DState era))
-> CertState era -> Identity (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL ((DState era -> Identity (DState era))
-> CertState era -> Identity (CertState era))
-> ((Accounts era -> Identity (Accounts era))
-> DState era -> Identity (DState era))
-> (Accounts era -> Identity (Accounts era))
-> CertState era
-> Identity (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Accounts era -> Identity (Accounts era))
-> DState era -> Identity (DState era)
forall era. Lens' (DState era) (Accounts era)
forall (t :: * -> *) era.
CanSetAccounts t =>
Lens' (t era) (Accounts era)
accountsL ((Accounts era -> Identity (Accounts era))
-> NewEpochState era -> Identity (NewEpochState era))
-> Accounts era -> NewEpochState era -> NewEpochState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Accounts era
accounts'
NewEpochState era
-> (NewEpochState era -> NewEpochState era) -> NewEpochState era
forall a b. a -> (a -> b) -> b
& (EpochState era -> Identity (EpochState era))
-> NewEpochState era -> Identity (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Identity (EpochState era))
-> NewEpochState era -> Identity (NewEpochState era))
-> ((Coin -> Identity Coin)
-> EpochState era -> Identity (EpochState era))
-> (Coin -> Identity Coin)
-> NewEpochState era
-> Identity (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era -> Identity (LedgerState era))
-> EpochState era -> Identity (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> Identity (LedgerState era))
-> EpochState era -> Identity (EpochState era))
-> ((Coin -> Identity Coin)
-> LedgerState era -> Identity (LedgerState era))
-> (Coin -> Identity Coin)
-> EpochState era
-> Identity (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTxOState era -> Identity (UTxOState era))
-> LedgerState era -> Identity (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(UTxOState era -> f (UTxOState era))
-> LedgerState era -> f (LedgerState era)
lsUTxOStateL ((UTxOState era -> Identity (UTxOState era))
-> LedgerState era -> Identity (LedgerState era))
-> ((Coin -> Identity Coin)
-> UTxOState era -> Identity (UTxOState era))
-> (Coin -> Identity Coin)
-> LedgerState era
-> Identity (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Identity Coin)
-> UTxOState era -> Identity (UTxOState era)
forall era (f :: * -> *).
Functor f =>
(Coin -> f Coin) -> UTxOState era -> f (UTxOState era)
utxosDepositedL ((Coin -> Identity Coin)
-> NewEpochState era -> Identity (NewEpochState era))
-> (Coin -> Coin) -> NewEpochState era -> NewEpochState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Coin
refund)
accounts :: Accounts era
accounts =
ChainState era -> NewEpochState era
forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
NewEpochState era
-> Getting (Accounts era) (NewEpochState era) (Accounts era)
-> Accounts era
forall s a. s -> Getting a s a -> a
^. (EpochState era -> Const (Accounts era) (EpochState era))
-> NewEpochState era -> Const (Accounts era) (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const (Accounts era) (EpochState era))
-> NewEpochState era -> Const (Accounts era) (NewEpochState era))
-> ((Accounts era -> Const (Accounts era) (Accounts era))
-> EpochState era -> Const (Accounts era) (EpochState era))
-> Getting (Accounts era) (NewEpochState era) (Accounts era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era -> Const (Accounts era) (LedgerState era))
-> EpochState era -> Const (Accounts era) (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> Const (Accounts era) (LedgerState era))
-> EpochState era -> Const (Accounts era) (EpochState era))
-> ((Accounts era -> Const (Accounts era) (Accounts era))
-> LedgerState era -> Const (Accounts era) (LedgerState era))
-> (Accounts era -> Const (Accounts era) (Accounts era))
-> EpochState era
-> Const (Accounts era) (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era -> Const (Accounts era) (CertState era))
-> LedgerState era -> Const (Accounts era) (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era -> Const (Accounts era) (CertState era))
-> LedgerState era -> Const (Accounts era) (LedgerState era))
-> ((Accounts era -> Const (Accounts era) (Accounts era))
-> CertState era -> Const (Accounts era) (CertState era))
-> (Accounts era -> Const (Accounts era) (Accounts era))
-> LedgerState era
-> Const (Accounts era) (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DState era -> Const (Accounts era) (DState era))
-> CertState era -> Const (Accounts era) (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL ((DState era -> Const (Accounts era) (DState era))
-> CertState era -> Const (Accounts era) (CertState era))
-> ((Accounts era -> Const (Accounts era) (Accounts era))
-> DState era -> Const (Accounts era) (DState era))
-> (Accounts era -> Const (Accounts era) (Accounts era))
-> CertState era
-> Const (Accounts era) (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Accounts era -> Const (Accounts era) (Accounts era))
-> DState era -> Const (Accounts era) (DState era)
forall era. Lens' (DState era) (Accounts era)
forall (t :: * -> *) era.
CanSetAccounts t =>
Lens' (t era) (Accounts era)
accountsL
(Maybe (AccountState era)
mAccountState, Accounts era
accounts') =
Credential 'Staking
-> Accounts era -> (Maybe (AccountState era), Accounts era)
forall era.
ShelleyEraAccounts era =>
Credential 'Staking
-> Accounts era -> (Maybe (AccountState era), Accounts era)
unregisterShelleyAccount Credential 'Staking
cred Accounts era
accounts
refund :: Coin
refund = CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact (Maybe (AccountState era) -> AccountState era
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (AccountState era)
mAccountState 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)
delegation ::
EraCertState era =>
Credential 'Staking ->
KeyHash 'StakePool ->
ChainState era ->
ChainState era
delegation :: forall era.
EraCertState era =>
Credential 'Staking
-> KeyHash 'StakePool -> ChainState era -> ChainState era
delegation Credential 'Staking
cred KeyHash 'StakePool
poolId ChainState era
cs = ChainState era
cs {chainNes = nes}
where
nes :: NewEpochState era
nes =
ChainState era -> NewEpochState era
forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
NewEpochState era
-> (NewEpochState era -> NewEpochState era) -> NewEpochState era
forall a b. a -> (a -> b) -> b
& (EpochState era -> Identity (EpochState era))
-> NewEpochState era -> Identity (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Identity (EpochState era))
-> NewEpochState era -> Identity (NewEpochState era))
-> ((Map (Credential 'Staking) (AccountState era)
-> Identity (Map (Credential 'Staking) (AccountState era)))
-> EpochState era -> Identity (EpochState era))
-> (Map (Credential 'Staking) (AccountState era)
-> Identity (Map (Credential 'Staking) (AccountState era)))
-> NewEpochState era
-> Identity (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era -> Identity (LedgerState era))
-> EpochState era -> Identity (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> Identity (LedgerState era))
-> EpochState era -> Identity (EpochState era))
-> ((Map (Credential 'Staking) (AccountState era)
-> Identity (Map (Credential 'Staking) (AccountState era)))
-> LedgerState era -> Identity (LedgerState era))
-> (Map (Credential 'Staking) (AccountState era)
-> Identity (Map (Credential 'Staking) (AccountState era)))
-> EpochState era
-> Identity (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era -> Identity (CertState era))
-> LedgerState era -> Identity (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era -> Identity (CertState era))
-> LedgerState era -> Identity (LedgerState era))
-> ((Map (Credential 'Staking) (AccountState era)
-> Identity (Map (Credential 'Staking) (AccountState era)))
-> CertState era -> Identity (CertState era))
-> (Map (Credential 'Staking) (AccountState era)
-> Identity (Map (Credential 'Staking) (AccountState era)))
-> LedgerState era
-> Identity (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DState era -> Identity (DState era))
-> CertState era -> Identity (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL ((DState era -> Identity (DState era))
-> CertState era -> Identity (CertState era))
-> ((Map (Credential 'Staking) (AccountState era)
-> Identity (Map (Credential 'Staking) (AccountState era)))
-> DState era -> Identity (DState era))
-> (Map (Credential 'Staking) (AccountState era)
-> Identity (Map (Credential 'Staking) (AccountState era)))
-> CertState era
-> Identity (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Accounts era -> Identity (Accounts era))
-> DState era -> Identity (DState era)
forall era. Lens' (DState era) (Accounts era)
forall (t :: * -> *) era.
CanSetAccounts t =>
Lens' (t era) (Accounts era)
accountsL ((Accounts era -> Identity (Accounts era))
-> DState era -> Identity (DState era))
-> ((Map (Credential 'Staking) (AccountState era)
-> Identity (Map (Credential 'Staking) (AccountState era)))
-> Accounts era -> Identity (Accounts era))
-> (Map (Credential 'Staking) (AccountState era)
-> Identity (Map (Credential 'Staking) (AccountState era)))
-> DState era
-> Identity (DState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Credential 'Staking) (AccountState era)
-> Identity (Map (Credential 'Staking) (AccountState era)))
-> Accounts era -> Identity (Accounts era)
forall era.
EraAccounts era =>
Lens' (Accounts era) (Map (Credential 'Staking) (AccountState era))
Lens' (Accounts era) (Map (Credential 'Staking) (AccountState era))
accountsMapL
((Map (Credential 'Staking) (AccountState era)
-> Identity (Map (Credential 'Staking) (AccountState era)))
-> NewEpochState era -> Identity (NewEpochState era))
-> (Map (Credential 'Staking) (AccountState era)
-> Map (Credential 'Staking) (AccountState era))
-> NewEpochState era
-> NewEpochState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (AccountState era -> AccountState era)
-> Credential 'Staking
-> Map (Credential 'Staking) (AccountState era)
-> Map (Credential 'Staking) (AccountState era)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust ((Maybe (KeyHash 'StakePool)
-> Identity (Maybe (KeyHash 'StakePool)))
-> AccountState era -> Identity (AccountState era)
forall era.
EraAccounts era =>
Lens' (AccountState era) (Maybe (KeyHash 'StakePool))
Lens' (AccountState era) (Maybe (KeyHash 'StakePool))
stakePoolDelegationAccountStateL ((Maybe (KeyHash 'StakePool)
-> Identity (Maybe (KeyHash 'StakePool)))
-> AccountState era -> Identity (AccountState era))
-> Maybe (KeyHash 'StakePool)
-> AccountState era
-> AccountState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ KeyHash 'StakePool -> Maybe (KeyHash 'StakePool)
forall a. a -> Maybe a
Just KeyHash 'StakePool
poolId) Credential 'Staking
cred
newPool ::
forall era.
EraCertState era =>
PoolParams ->
ChainState era ->
ChainState era
newPool :: forall era.
EraCertState era =>
PoolParams -> ChainState era -> ChainState era
newPool PoolParams
pool ChainState era
cs = ChainState era
cs {chainNes = nes'}
where
nes :: NewEpochState era
nes = ChainState era -> NewEpochState era
forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
es :: EpochState era
es = NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes
ls :: LedgerState era
ls = EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState EpochState era
es
dps :: CertState era
dps = LedgerState era -> CertState era
forall era. LedgerState era -> CertState era
lsCertState LedgerState era
ls
ps :: PState era
ps = CertState era
dps CertState era
-> Getting (PState era) (CertState era) (PState era) -> PState era
forall s a. s -> Getting a s a -> a
^. Getting (PState era) (CertState era) (PState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
certPStateL
ps' :: PState era
ps' =
PState era
ps
{ psStakePoolParams = Map.insert (ppId pool) pool (psStakePoolParams ps)
}
dps' :: CertState era
dps' = CertState era
dps CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (PState era -> Identity (PState era))
-> CertState era -> Identity (CertState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
certPStateL ((PState era -> Identity (PState era))
-> CertState era -> Identity (CertState era))
-> PState era -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PState era
ps'
ls' :: LedgerState era
ls' = LedgerState era
ls {lsCertState = dps'}
es' :: EpochState era
es' = EpochState era
es {esLState = ls'}
nes' :: NewEpochState era
nes' = NewEpochState era
nes {nesEs = es'}
reregPool ::
forall era.
EraCertState era =>
PoolParams ->
ChainState era ->
ChainState era
reregPool :: forall era.
EraCertState era =>
PoolParams -> ChainState era -> ChainState era
reregPool PoolParams
pool ChainState era
cs = ChainState era
cs {chainNes = nes'}
where
nes :: NewEpochState era
nes = ChainState era -> NewEpochState era
forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
es :: EpochState era
es = NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes
ls :: LedgerState era
ls = EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState EpochState era
es
dps :: CertState era
dps = LedgerState era -> CertState era
forall era. LedgerState era -> CertState era
lsCertState LedgerState era
ls
ps :: PState era
ps = CertState era
dps CertState era
-> Getting (PState era) (CertState era) (PState era) -> PState era
forall s a. s -> Getting a s a -> a
^. Getting (PState era) (CertState era) (PState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
certPStateL
ps' :: PState era
ps' =
PState era
ps
{ psFutureStakePoolParams = Map.insert (ppId pool) pool (psStakePoolParams ps)
}
dps' :: CertState era
dps' = CertState era
dps CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (PState era -> Identity (PState era))
-> CertState era -> Identity (CertState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
certPStateL ((PState era -> Identity (PState era))
-> CertState era -> Identity (CertState era))
-> PState era -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PState era
ps'
ls' :: LedgerState era
ls' = LedgerState era
ls {lsCertState = dps'}
es' :: EpochState era
es' = EpochState era
es {esLState = ls'}
nes' :: NewEpochState era
nes' = NewEpochState era
nes {nesEs = es'}
updatePoolParams ::
forall era.
EraCertState era =>
PoolParams ->
ChainState era ->
ChainState era
updatePoolParams :: forall era.
EraCertState era =>
PoolParams -> ChainState era -> ChainState era
updatePoolParams PoolParams
pool ChainState era
cs = ChainState era
cs {chainNes = nes'}
where
nes :: NewEpochState era
nes = ChainState era -> NewEpochState era
forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
es :: EpochState era
es = NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes
ls :: LedgerState era
ls = EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState EpochState era
es
dps :: CertState era
dps = LedgerState era -> CertState era
forall era. LedgerState era -> CertState era
lsCertState LedgerState era
ls
ps :: PState era
ps = CertState era
dps CertState era
-> Getting (PState era) (CertState era) (PState era) -> PState era
forall s a. s -> Getting a s a -> a
^. Getting (PState era) (CertState era) (PState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
certPStateL
ps' :: PState era
ps' =
PState era
ps
{ psStakePoolParams = Map.insert (ppId pool) pool (psStakePoolParams ps)
, psFutureStakePoolParams = Map.delete (ppId pool) (psStakePoolParams ps)
}
dps' :: CertState era
dps' = CertState era
dps CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (PState era -> Identity (PState era))
-> CertState era -> Identity (CertState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
certPStateL ((PState era -> Identity (PState era))
-> CertState era -> Identity (CertState era))
-> PState era -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PState era
ps'
ls' :: LedgerState era
ls' = LedgerState era
ls {lsCertState = dps'}
es' :: EpochState era
es' = EpochState era
es {esLState = ls'}
nes' :: NewEpochState era
nes' = NewEpochState era
nes {nesEs = es'}
stageRetirement ::
forall era.
EraCertState era =>
KeyHash 'StakePool ->
EpochNo ->
ChainState era ->
ChainState era
stageRetirement :: forall era.
EraCertState era =>
KeyHash 'StakePool -> EpochNo -> ChainState era -> ChainState era
stageRetirement KeyHash 'StakePool
kh EpochNo
e ChainState era
cs = ChainState era
cs {chainNes = nes'}
where
nes :: NewEpochState era
nes = ChainState era -> NewEpochState era
forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
es :: EpochState era
es = NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes
ls :: LedgerState era
ls = EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState EpochState era
es
dps :: CertState era
dps = LedgerState era -> CertState era
forall era. LedgerState era -> CertState era
lsCertState LedgerState era
ls
ps :: PState era
ps = CertState era
dps CertState era
-> Getting (PState era) (CertState era) (PState era) -> PState era
forall s a. s -> Getting a s a -> a
^. Getting (PState era) (CertState era) (PState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
certPStateL
ps' :: PState era
ps' = PState era
ps {psRetiring = Map.insert kh e (psRetiring ps)}
dps' :: CertState era
dps' = CertState era
dps CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (PState era -> Identity (PState era))
-> CertState era -> Identity (CertState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
certPStateL ((PState era -> Identity (PState era))
-> CertState era -> Identity (CertState era))
-> PState era -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PState era
ps'
ls' :: LedgerState era
ls' = LedgerState era
ls {lsCertState = dps'}
es' :: EpochState era
es' = EpochState era
es {esLState = ls'}
nes' :: NewEpochState era
nes' = NewEpochState era
nes {nesEs = es'}
reapPool ::
forall era.
(EraGov era, EraCertState era) =>
PoolParams ->
ChainState era ->
ChainState era
reapPool :: forall era.
(EraGov era, EraCertState era) =>
PoolParams -> ChainState era -> ChainState era
reapPool PoolParams
pool ChainState era
cs = ChainState era
cs {chainNes = nes'}
where
poolId :: KeyHash 'StakePool
poolId = PoolParams -> KeyHash 'StakePool
ppId PoolParams
pool
nes :: NewEpochState era
nes = ChainState era -> NewEpochState era
forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
es :: EpochState era
es = NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes
ls :: LedgerState era
ls = EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState EpochState era
es
dps :: CertState era
dps = LedgerState era -> CertState era
forall era. LedgerState era -> CertState era
lsCertState LedgerState era
ls
ps :: PState era
ps = CertState era
dps CertState era
-> Getting (PState era) (CertState era) (PState era) -> PState era
forall s a. s -> Getting a s a -> a
^. Getting (PState era) (CertState era) (PState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
certPStateL
poolDeposit :: CompactForm Coin
poolDeposit = Maybe (CompactForm Coin) -> CompactForm Coin
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (CompactForm Coin) -> CompactForm Coin)
-> Maybe (CompactForm Coin) -> CompactForm Coin
forall a b. (a -> b) -> a -> b
$ KeyHash 'StakePool
-> Map (KeyHash 'StakePool) (CompactForm Coin)
-> Maybe (CompactForm Coin)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash 'StakePool
poolId (PState era -> Map (KeyHash 'StakePool) (CompactForm Coin)
forall era.
PState era -> Map (KeyHash 'StakePool) (CompactForm Coin)
psDeposits PState era
ps)
ps' :: PState era
ps' =
PState era
ps
{ psRetiring = Map.delete poolId (psRetiring ps)
, psStakePoolParams = Map.delete poolId (psStakePoolParams ps)
, psDeposits = Map.delete poolId (psDeposits ps)
}
pp :: PParams era
pp = EpochState era
es EpochState era
-> Getting (PParams era) (EpochState era) (PParams era)
-> PParams era
forall s a. s -> Getting a s a -> a
^. Getting (PParams era) (EpochState era) (PParams era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL
ds :: DState era
ds = CertState era
dps CertState era
-> Getting (DState era) (CertState era) (DState era) -> DState era
forall s a. s -> Getting a s a -> a
^. Getting (DState era) (CertState era) (DState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL
RewardAccount Network
_ Credential 'Staking
poolAccountCred = PoolParams -> RewardAccount
ppRewardAccount PoolParams
pool
accounts :: Accounts era
accounts = DState era
ds DState era
-> Getting (Accounts era) (DState era) (Accounts era)
-> Accounts era
forall s a. s -> Getting a s a -> a
^. Getting (Accounts era) (DState era) (Accounts era)
forall era. Lens' (DState era) (Accounts era)
forall (t :: * -> *) era.
CanSetAccounts t =>
Lens' (t era) (Accounts era)
accountsL
(Accounts era
accounts', CompactForm Coin
unclaimed) =
case Credential 'Staking -> Accounts era -> Maybe (AccountState era)
forall era.
EraAccounts era =>
Credential 'Staking -> Accounts era -> Maybe (AccountState era)
lookupAccountState Credential 'Staking
poolAccountCred Accounts era
accounts of
Maybe (AccountState era)
Nothing -> (Accounts era
accounts, CompactForm Coin
poolDeposit)
Just AccountState era
accountState ->
let accountState' :: AccountState era
accountState' = AccountState era
accountState AccountState era
-> (AccountState era -> AccountState era) -> AccountState era
forall a b. a -> (a -> b) -> b
& (CompactForm Coin -> Identity (CompactForm Coin))
-> AccountState era -> Identity (AccountState era)
forall era.
EraAccounts era =>
Lens' (AccountState era) (CompactForm Coin)
Lens' (AccountState era) (CompactForm Coin)
balanceAccountStateL ((CompactForm Coin -> Identity (CompactForm Coin))
-> AccountState era -> Identity (AccountState era))
-> CompactForm Coin -> AccountState era -> AccountState era
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ CompactForm Coin
poolDeposit
in ( Accounts era
accounts Accounts era -> (Accounts era -> Accounts era) -> Accounts era
forall a b. a -> (a -> b) -> b
& (Map (Credential 'Staking) (AccountState era)
-> Identity (Map (Credential 'Staking) (AccountState era)))
-> Accounts era -> Identity (Accounts era)
forall era.
EraAccounts era =>
Lens' (Accounts era) (Map (Credential 'Staking) (AccountState era))
Lens' (Accounts era) (Map (Credential 'Staking) (AccountState era))
accountsMapL ((Map (Credential 'Staking) (AccountState era)
-> Identity (Map (Credential 'Staking) (AccountState era)))
-> Accounts era -> Identity (Accounts era))
-> (Map (Credential 'Staking) (AccountState era)
-> Map (Credential 'Staking) (AccountState era))
-> Accounts era
-> Accounts era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Credential 'Staking
-> AccountState era
-> Map (Credential 'Staking) (AccountState era)
-> Map (Credential 'Staking) (AccountState era)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Credential 'Staking
poolAccountCred AccountState era
accountState'
, CompactForm Coin
forall a. Monoid a => a
mempty
)
ds' :: DState era
ds' = DState era
ds {dsAccounts = removeStakePoolDelegations (Set.singleton poolId) accounts'}
chainAccountState :: ChainAccountState
chainAccountState = EpochState era -> ChainAccountState
forall era. EpochState era -> ChainAccountState
esChainAccountState EpochState era
es
chainAccountState' :: ChainAccountState
chainAccountState' = ChainAccountState
chainAccountState {casTreasury = casTreasury chainAccountState <+> fromCompact unclaimed}
utxoSt :: UTxOState era
utxoSt = LedgerState era -> UTxOState era
forall era. LedgerState era -> UTxOState era
lsUTxOState LedgerState era
ls
utxoSt' :: UTxOState era
utxoSt' = UTxOState era
utxoSt {utxosDeposited = utxosDeposited utxoSt <-> (pp ^. ppPoolDepositL)}
dps' :: CertState era
dps' =
CertState era
dps
CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (PState era -> Identity (PState era))
-> CertState era -> Identity (CertState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
certPStateL ((PState era -> Identity (PState era))
-> CertState era -> Identity (CertState era))
-> PState era -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PState era
ps'
CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (DState era -> Identity (DState era))
-> CertState era -> Identity (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL ((DState era -> Identity (DState era))
-> CertState era -> Identity (CertState era))
-> DState era -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DState era
ds'
ls' :: LedgerState era
ls' = LedgerState era
ls {lsCertState = dps', lsUTxOState = utxoSt'}
es' :: EpochState era
es' = EpochState era
es {esLState = ls', esChainAccountState = chainAccountState'}
nes' :: NewEpochState era
nes' = NewEpochState era
nes {nesEs = es'}
mir ::
forall era.
EraCertState era =>
Credential 'Staking ->
MIRPot ->
Coin ->
ChainState era ->
ChainState era
mir :: forall era.
EraCertState era =>
Credential 'Staking
-> MIRPot -> Coin -> ChainState era -> ChainState era
mir Credential 'Staking
cred MIRPot
pot Coin
amnt ChainState era
cs = ChainState era
cs {chainNes = nes'}
where
nes :: NewEpochState era
nes = ChainState era -> NewEpochState era
forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
es :: EpochState era
es = NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes
ls :: LedgerState era
ls = EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState EpochState era
es
dps :: CertState era
dps = LedgerState era -> CertState era
forall era. LedgerState era -> CertState era
lsCertState LedgerState era
ls
ds :: DState era
ds = CertState era
dps CertState era
-> Getting (DState era) (CertState era) (DState era) -> DState era
forall s a. s -> Getting a s a -> a
^. Getting (DState era) (CertState era) (DState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL
InstantaneousRewards
{ iRReserves :: InstantaneousRewards -> Map (Credential 'Staking) Coin
iRReserves = Map (Credential 'Staking) Coin
ir
, iRTreasury :: InstantaneousRewards -> Map (Credential 'Staking) Coin
iRTreasury = Map (Credential 'Staking) Coin
it
, deltaReserves :: InstantaneousRewards -> DeltaCoin
deltaReserves = DeltaCoin
dr
, deltaTreasury :: InstantaneousRewards -> DeltaCoin
deltaTreasury = DeltaCoin
dt
} = DState era -> InstantaneousRewards
forall era. DState era -> InstantaneousRewards
dsIRewards DState era
ds
irwd' :: InstantaneousRewards
irwd' = case MIRPot
pot of
MIRPot
ReservesMIR -> Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards
InstantaneousRewards (Credential 'Staking
-> Coin
-> Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Credential 'Staking
cred Coin
amnt Map (Credential 'Staking) Coin
ir) Map (Credential 'Staking) Coin
it DeltaCoin
dr DeltaCoin
dt
MIRPot
TreasuryMIR -> Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards
InstantaneousRewards Map (Credential 'Staking) Coin
ir (Credential 'Staking
-> Coin
-> Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Credential 'Staking
cred Coin
amnt Map (Credential 'Staking) Coin
it) DeltaCoin
dr DeltaCoin
dt
ds' :: DState era
ds' = DState era
ds {dsIRewards = irwd'}
dps' :: CertState era
dps' = CertState era
dps CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (DState era -> Identity (DState era))
-> CertState era -> Identity (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL ((DState era -> Identity (DState era))
-> CertState era -> Identity (CertState era))
-> DState era -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DState era
ds'
ls' :: LedgerState era
ls' = LedgerState era
ls {lsCertState = dps'}
es' :: EpochState era
es' = EpochState era
es {esLState = ls'}
nes' :: NewEpochState era
nes' = NewEpochState era
nes {nesEs = es'}
applyMIR ::
forall era.
EraCertState era =>
MIRPot ->
Map (Credential 'Staking) Coin ->
ChainState era ->
ChainState era
applyMIR :: forall era.
EraCertState era =>
MIRPot
-> Map (Credential 'Staking) Coin
-> ChainState era
-> ChainState era
applyMIR MIRPot
pot Map (Credential 'Staking) Coin
addBalances ChainState era
cs = ChainState era
cs {chainNes = nes'}
where
tot :: Coin
tot = Map (Credential 'Staking) Coin -> Coin
forall m. Monoid m => Map (Credential 'Staking) m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Map (Credential 'Staking) Coin
addBalances
nes :: NewEpochState era
nes = ChainState era -> NewEpochState era
forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
es :: EpochState era
es = NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes
ls :: LedgerState era
ls = EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState EpochState era
es
dps :: CertState era
dps = LedgerState era -> CertState era
forall era. LedgerState era -> CertState era
lsCertState LedgerState era
ls
ds :: DState era
ds = CertState era
dps CertState era
-> Getting (DState era) (CertState era) (DState era) -> DState era
forall s a. s -> Getting a s a -> a
^. Getting (DState era) (CertState era) (DState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL
ds' :: DState era
ds' =
DState era
ds
{ dsIRewards = emptyInstantaneousRewards
}
DState era -> (DState era -> DState era) -> DState era
forall a b. a -> (a -> b) -> b
& (Accounts era -> Identity (Accounts era))
-> DState era -> Identity (DState era)
forall era. Lens' (DState era) (Accounts era)
forall (t :: * -> *) era.
CanSetAccounts t =>
Lens' (t era) (Accounts era)
accountsL ((Accounts era -> Identity (Accounts era))
-> DState era -> Identity (DState era))
-> (Accounts era -> Accounts era) -> DState era -> DState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Map (Credential 'Staking) (CompactForm Coin)
-> Accounts era -> Accounts era
forall era.
EraAccounts era =>
Map (Credential 'Staking) (CompactForm Coin)
-> Accounts era -> Accounts era
addToBalanceAccounts ((Coin -> CompactForm Coin)
-> Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) (CompactForm Coin)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map HasCallStack => Coin -> CompactForm Coin
Coin -> CompactForm Coin
compactCoinOrError Map (Credential 'Staking) Coin
addBalances)
dps' :: CertState era
dps' = CertState era
dps CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (DState era -> Identity (DState era))
-> CertState era -> Identity (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL ((DState era -> Identity (DState era))
-> CertState era -> Identity (CertState era))
-> DState era -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DState era
ds'
ls' :: LedgerState era
ls' = LedgerState era
ls {lsCertState = dps'}
chainAccountState :: ChainAccountState
chainAccountState = EpochState era -> ChainAccountState
forall era. EpochState era -> ChainAccountState
esChainAccountState EpochState era
es
chainAccountState' :: ChainAccountState
chainAccountState' =
if MIRPot
pot MIRPot -> MIRPot -> Bool
forall a. Eq a => a -> a -> Bool
== MIRPot
ReservesMIR
then ChainAccountState
chainAccountState {casReserves = casReserves chainAccountState <-> tot}
else ChainAccountState
chainAccountState {casTreasury = casTreasury chainAccountState <-> tot}
es' :: EpochState era
es' = EpochState era
es {esChainAccountState = chainAccountState', esLState = ls'}
nes' :: NewEpochState era
nes' = NewEpochState era
nes {nesEs = es'}
rewardUpdate ::
forall era.
RewardUpdate ->
ChainState era ->
ChainState era
rewardUpdate :: forall era. RewardUpdate -> ChainState era -> ChainState era
rewardUpdate RewardUpdate
ru ChainState era
cs = ChainState era
cs {chainNes = nes'}
where
nes' :: NewEpochState era
nes' = (ChainState era -> NewEpochState era
forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs) {nesRu = SJust (Complete ru)}
pulserUpdate ::
forall era.
PulsingRewUpdate ->
ChainState era ->
ChainState era
pulserUpdate :: forall era. PulsingRewUpdate -> ChainState era -> ChainState era
pulserUpdate PulsingRewUpdate
p ChainState era
cs = ChainState era
cs {chainNes = nes'}
where
nes' :: NewEpochState era
nes' = (ChainState era -> NewEpochState era
forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs) {nesRu = SJust p}
applyRewardUpdate ::
forall era.
(EraGov era, EraCertState era) =>
RewardUpdate ->
ChainState era ->
ChainState era
applyRewardUpdate :: forall era.
(EraGov era, EraCertState era) =>
RewardUpdate -> ChainState era -> ChainState era
applyRewardUpdate RewardUpdate
ru ChainState era
cs = ChainState era
cs {chainNes = nes'}
where
nes :: NewEpochState era
nes = ChainState era -> NewEpochState era
forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
es' :: EpochState era
es' = RewardUpdate -> EpochState era -> EpochState era
forall era.
(EraGov era, EraCertState era) =>
RewardUpdate -> EpochState era -> EpochState era
applyRUpd RewardUpdate
ru (NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes)
nes' :: NewEpochState era
nes' = (ChainState era -> NewEpochState era
forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs) {nesEs = es', nesRu = SNothing}
newSnapshot ::
forall era.
SnapShot ->
Coin ->
ChainState era ->
ChainState era
newSnapshot :: forall era. SnapShot -> Coin -> ChainState era -> ChainState era
newSnapshot SnapShot
snap Coin
fee ChainState era
cs = ChainState era
cs {chainNes = nes'}
where
nes :: NewEpochState era
nes = ChainState era -> NewEpochState era
forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
es :: EpochState era
es = NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes
SnapShots
{ $sel:ssStakeMark:SnapShots :: SnapShots -> SnapShot
ssStakeMark = SnapShot
ssMark
, $sel:ssStakeSet:SnapShots :: SnapShots -> SnapShot
ssStakeSet = SnapShot
ssSet
} = EpochState era -> SnapShots
forall era. EpochState era -> SnapShots
esSnapshots EpochState era
es
snaps :: SnapShots
snaps =
SnapShots
{ $sel:ssStakeMark:SnapShots :: SnapShot
ssStakeMark = SnapShot
snap
, $sel:ssStakeMarkPoolDistr:SnapShots :: PoolDistr
ssStakeMarkPoolDistr = SnapShot -> PoolDistr
calculatePoolDistr SnapShot
snap
, $sel:ssStakeSet:SnapShots :: SnapShot
ssStakeSet = SnapShot
ssMark
, $sel:ssStakeGo:SnapShots :: SnapShot
ssStakeGo = SnapShot
ssSet
, $sel:ssFee:SnapShots :: Coin
ssFee = Coin
fee
}
es' :: EpochState era
es' = EpochState era
es {esSnapshots = snaps}
nes' :: NewEpochState era
nes' = NewEpochState era
nes {nesEs = es'}
setPoolDistr ::
forall era.
PoolDistr ->
ChainState era ->
ChainState era
setPoolDistr :: forall era. PoolDistr -> ChainState era -> ChainState era
setPoolDistr PoolDistr
pd ChainState era
cs = ChainState era
cs {chainNes = nes'}
where
nes' :: NewEpochState era
nes' = (ChainState era -> NewEpochState era
forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs) {nesPd = pd}
setOCertCounter ::
forall era.
KeyHash 'BlockIssuer ->
Word64 ->
ChainState era ->
ChainState era
setOCertCounter :: forall era.
KeyHash 'BlockIssuer -> Word64 -> ChainState era -> ChainState era
setOCertCounter KeyHash 'BlockIssuer
kh Word64
n ChainState era
cs = ChainState era
cs {chainOCertIssue = counters}
where
counters :: Map (KeyHash 'BlockIssuer) Word64
counters = KeyHash 'BlockIssuer
-> Word64
-> Map (KeyHash 'BlockIssuer) Word64
-> Map (KeyHash 'BlockIssuer) Word64
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert KeyHash 'BlockIssuer
kh Word64
n (ChainState era -> Map (KeyHash 'BlockIssuer) Word64
forall era. ChainState era -> Map (KeyHash 'BlockIssuer) Word64
chainOCertIssue ChainState era
cs)
incrBlockCount ::
forall era.
KeyHash 'StakePool ->
ChainState era ->
ChainState era
incrBlockCount :: forall era. KeyHash 'StakePool -> ChainState era -> ChainState era
incrBlockCount KeyHash 'StakePool
kh ChainState era
cs = ChainState era
cs {chainNes = nes'}
where
nes :: NewEpochState era
nes = ChainState era -> NewEpochState era
forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
BlocksMade Map (KeyHash 'StakePool) Natural
bs = NewEpochState era -> BlocksMade
forall era. NewEpochState era -> BlocksMade
nesBcur NewEpochState era
nes
n :: Natural
n = Natural
1 Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
-> KeyHash 'StakePool
-> Map (KeyHash 'StakePool) Natural
-> Natural
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Natural
0 KeyHash 'StakePool
kh Map (KeyHash 'StakePool) Natural
bs
bs' :: BlocksMade
bs' = Map (KeyHash 'StakePool) Natural -> BlocksMade
BlocksMade (Map (KeyHash 'StakePool) Natural -> BlocksMade)
-> Map (KeyHash 'StakePool) Natural -> BlocksMade
forall a b. (a -> b) -> a -> b
$ KeyHash 'StakePool
-> Natural
-> Map (KeyHash 'StakePool) Natural
-> Map (KeyHash 'StakePool) Natural
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert KeyHash 'StakePool
kh Natural
n Map (KeyHash 'StakePool) Natural
bs
nes' :: NewEpochState era
nes' = NewEpochState era
nes {nesBcur = bs'}
newEpoch ::
forall era.
(ProtVerAtMost era 6, EraGov era) =>
Block (BHeader MockCrypto) era ->
ChainState era ->
ChainState era
newEpoch :: forall era.
(ProtVerAtMost era 6, EraGov era) =>
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
newEpoch Block (BHeader MockCrypto) era
b ChainState era
cs = ChainState era
cs'
where
ChainState
{ chainNes :: forall era. ChainState era -> NewEpochState era
chainNes = NewEpochState era
nes
, chainEvolvingNonce :: forall era. ChainState era -> Nonce
chainEvolvingNonce = Nonce
evNonce
, chainCandidateNonce :: forall era. ChainState era -> Nonce
chainCandidateNonce = Nonce
cNonce
, chainPrevEpochNonce :: forall era. ChainState era -> Nonce
chainPrevEpochNonce = Nonce
pNonce
, chainLastAppliedBlock :: forall era. ChainState era -> WithOrigin LastAppliedBlock
chainLastAppliedBlock = WithOrigin LastAppliedBlock
lab
} = ChainState era
cs
bh :: BHeader MockCrypto
bh = Block (BHeader MockCrypto) era -> BHeader MockCrypto
forall h era. Block h era -> h
bheader Block (BHeader MockCrypto) era
b
bn :: BlockNo
bn = BHBody MockCrypto -> BlockNo
forall c. BHBody c -> BlockNo
bheaderBlockNo (BHBody MockCrypto -> BlockNo)
-> (BHeader MockCrypto -> BHBody MockCrypto)
-> BHeader MockCrypto
-> BlockNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BHeader MockCrypto -> BHBody MockCrypto
forall c. Crypto c => BHeader c -> BHBody c
bhbody (BHeader MockCrypto -> BlockNo) -> BHeader MockCrypto -> BlockNo
forall a b. (a -> b) -> a -> b
$ BHeader MockCrypto
bh
sn :: SlotNo
sn = BHBody MockCrypto -> SlotNo
forall c. BHBody c -> SlotNo
bheaderSlotNo (BHBody MockCrypto -> SlotNo)
-> (BHeader MockCrypto -> BHBody MockCrypto)
-> BHeader MockCrypto
-> SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BHeader MockCrypto -> BHBody MockCrypto
forall c. Crypto c => BHeader c -> BHBody c
bhbody (BHeader MockCrypto -> SlotNo) -> BHeader MockCrypto -> SlotNo
forall a b. (a -> b) -> a -> b
$ BHeader MockCrypto
bh
pp :: PParams era
pp = Getting (PParams era) (EpochState era) (PParams era)
-> EpochState era -> PParams era
forall a s. Getting a s a -> s -> a
view Getting (PParams era) (EpochState era) (PParams era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL (EpochState era -> PParams era)
-> (NewEpochState era -> EpochState era)
-> NewEpochState era
-> PParams era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs (NewEpochState era -> PParams era)
-> NewEpochState era -> PParams era
forall a b. (a -> b) -> a -> b
$ NewEpochState era
nes
e :: EpochNo
e = SlotNo -> EpochNo
epochFromSlotNo (SlotNo -> EpochNo)
-> (Block (BHeader MockCrypto) era -> SlotNo)
-> Block (BHeader MockCrypto) era
-> EpochNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BHBody MockCrypto -> SlotNo
forall c. BHBody c -> SlotNo
bheaderSlotNo (BHBody MockCrypto -> SlotNo)
-> (Block (BHeader MockCrypto) era -> BHBody MockCrypto)
-> Block (BHeader MockCrypto) era
-> SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BHeader MockCrypto -> BHBody MockCrypto
forall c. Crypto c => BHeader c -> BHBody c
bhbody (BHeader MockCrypto -> BHBody MockCrypto)
-> (Block (BHeader MockCrypto) era -> BHeader MockCrypto)
-> Block (BHeader MockCrypto) era
-> BHBody MockCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block (BHeader MockCrypto) era -> BHeader MockCrypto
forall h era. Block h era -> h
bheader (Block (BHeader MockCrypto) era -> EpochNo)
-> Block (BHeader MockCrypto) era -> EpochNo
forall a b. (a -> b) -> a -> b
$ Block (BHeader MockCrypto) era
b
nes' :: NewEpochState era
nes' =
NewEpochState era
nes
{ nesEL = e
, nesBprev = nesBcur nes
, nesBcur = BlocksMade Map.empty
}
n :: Nonce
n = Block (BHeader MockCrypto) era -> Nonce
forall era. Block (BHeader MockCrypto) era -> Nonce
getBlockNonce Block (BHeader MockCrypto) era
b
cs' :: ChainState era
cs' =
ChainState era
cs
{ chainNes = nes'
, chainEpochNonce = cNonce ⭒ pNonce ⭒ (pp ^. ppExtraEntropyL)
, chainEvolvingNonce = evNonce ⭒ n
, chainCandidateNonce = evNonce ⭒ n
, chainPrevEpochNonce = prevHashToNonce . lastAppliedHash $ lab
, chainLastAppliedBlock = At $ LastAppliedBlock bn sn (bhHash bh)
}
setCurrentProposals ::
forall era.
(GovState era ~ ShelleyGovState era, EraPParams era) =>
ProposedPPUpdates era ->
ChainState era ->
ChainState era
setCurrentProposals :: forall era.
(GovState era ~ ShelleyGovState era, EraPParams era) =>
ProposedPPUpdates era -> ChainState era -> ChainState era
setCurrentProposals ProposedPPUpdates era
ps ChainState era
cs = ChainState era
cs {chainNes = nes'}
where
nes :: NewEpochState era
nes = ChainState era -> NewEpochState era
forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
es :: EpochState era
es = NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes
ls :: LedgerState era
ls = EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState EpochState era
es
utxoSt :: UTxOState era
utxoSt = LedgerState era -> UTxOState era
forall era. LedgerState era -> UTxOState era
lsUTxOState LedgerState era
ls
govState :: GovState era
govState = UTxOState era -> GovState era
forall era. UTxOState era -> GovState era
utxosGovState UTxOState era
utxoSt
pp :: PParams era
pp = ShelleyGovState era -> PParams era
forall era. ShelleyGovState era -> PParams era
sgsCurPParams GovState era
ShelleyGovState era
govState
govState' :: ShelleyGovState era
govState' =
GovState era
govState
{ sgsCurProposals = ps
, sgsFuturePParams =
PotentialPParamsUpdate $ votedFuturePParams ps pp (quorum testGlobals)
}
utxoSt' :: UTxOState era
utxoSt' = UTxOState era
utxoSt {utxosGovState = govState'}
ls' :: LedgerState era
ls' = LedgerState era
ls {lsUTxOState = utxoSt'}
es' :: EpochState era
es' = EpochState era
es {esLState = ls'}
nes' :: NewEpochState era
nes' = NewEpochState era
nes {nesEs = es'}
setFutureProposals ::
forall era.
GovState era ~ ShelleyGovState era =>
ProposedPPUpdates era ->
ChainState era ->
ChainState era
setFutureProposals :: forall era.
(GovState era ~ ShelleyGovState era) =>
ProposedPPUpdates era -> ChainState era -> ChainState era
setFutureProposals ProposedPPUpdates era
ps ChainState era
cs = ChainState era
cs {chainNes = nes'}
where
nes :: NewEpochState era
nes = ChainState era -> NewEpochState era
forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
es :: EpochState era
es = NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes
ls :: LedgerState era
ls = EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState EpochState era
es
utxoSt :: UTxOState era
utxoSt = LedgerState era -> UTxOState era
forall era. LedgerState era -> UTxOState era
lsUTxOState LedgerState era
ls
govState :: GovState era
govState = UTxOState era -> GovState era
forall era. UTxOState era -> GovState era
utxosGovState UTxOState era
utxoSt
govState' :: ShelleyGovState era
govState' = GovState era
govState {sgsFutureProposals = ps}
utxoSt' :: UTxOState era
utxoSt' = UTxOState era
utxoSt {utxosGovState = govState'}
ls' :: LedgerState era
ls' = LedgerState era
ls {lsUTxOState = utxoSt'}
es' :: EpochState era
es' = EpochState era
es {esLState = ls'}
nes' :: NewEpochState era
nes' = NewEpochState era
nes {nesEs = es'}
solidifyProposals ::
forall era.
EraGov era =>
ChainState era ->
ChainState era
solidifyProposals :: forall era. EraGov era => ChainState era -> ChainState era
solidifyProposals ChainState era
cs = ChainState era
cs {chainNes = nes {nesEs = es}}
where
nes :: NewEpochState era
nes = ChainState era -> NewEpochState era
forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
es :: EpochState era
es = NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes EpochState era
-> (EpochState era -> EpochState era) -> EpochState era
forall a b. a -> (a -> b) -> b
& (FuturePParams era -> Identity (FuturePParams era))
-> EpochState era -> Identity (EpochState era)
forall era.
EraGov era =>
Lens' (EpochState era) (FuturePParams era)
Lens' (EpochState era) (FuturePParams era)
futurePParamsEpochStateL ((FuturePParams era -> Identity (FuturePParams era))
-> EpochState era -> Identity (EpochState era))
-> (FuturePParams era -> FuturePParams era)
-> EpochState era
-> EpochState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ FuturePParams era -> FuturePParams era
forall era. FuturePParams era -> FuturePParams era
solidifyFuturePParams
setPParams ::
forall era.
EraGov era =>
PParams era ->
ChainState era ->
ChainState era
setPParams :: forall era.
EraGov era =>
PParams era -> ChainState era -> ChainState era
setPParams PParams era
pp ChainState era
cs = ChainState era
cs {chainNes = nes'}
where
nes :: NewEpochState era
nes = ChainState era -> NewEpochState era
forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
es :: EpochState era
es = NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes
es' :: EpochState era
es' = EpochState era
es EpochState era
-> (EpochState era -> EpochState era) -> EpochState era
forall a b. a -> (a -> b) -> b
& (PParams era -> Identity (PParams era))
-> EpochState era -> Identity (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Identity (PParams era))
-> EpochState era -> Identity (EpochState era))
-> PParams era -> EpochState era -> EpochState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams era
pp
nes' :: NewEpochState era
nes' = NewEpochState era
nes {nesEs = es'}
setPrevPParams ::
forall era.
EraGov era =>
PParams era ->
ChainState era ->
ChainState era
setPrevPParams :: forall era.
EraGov era =>
PParams era -> ChainState era -> ChainState era
setPrevPParams PParams era
pp ChainState era
cs = ChainState era
cs {chainNes = nes'}
where
nes :: NewEpochState era
nes = ChainState era -> NewEpochState era
forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
es :: EpochState era
es = NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes
es' :: EpochState era
es' = EpochState era
es EpochState era
-> (EpochState era -> EpochState era) -> EpochState era
forall a b. a -> (a -> b) -> b
& (PParams era -> Identity (PParams era))
-> EpochState era -> Identity (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
prevPParamsEpochStateL ((PParams era -> Identity (PParams era))
-> EpochState era -> Identity (EpochState era))
-> PParams era -> EpochState era -> EpochState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams era
pp
nes' :: NewEpochState era
nes' = NewEpochState era
nes {nesEs = es'}
setFutureGenDeleg ::
forall era.
EraCertState era =>
(FutureGenDeleg, GenDelegPair) ->
ChainState era ->
ChainState era
setFutureGenDeleg :: forall era.
EraCertState era =>
(FutureGenDeleg, GenDelegPair) -> ChainState era -> ChainState era
setFutureGenDeleg (FutureGenDeleg
fg, GenDelegPair
gd) ChainState era
cs = ChainState era
cs {chainNes = nes'}
where
nes :: NewEpochState era
nes = ChainState era -> NewEpochState era
forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
es :: EpochState era
es = NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes
ls :: LedgerState era
ls = EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState EpochState era
es
dps :: CertState era
dps = LedgerState era -> CertState era
forall era. LedgerState era -> CertState era
lsCertState LedgerState era
ls
ds :: DState era
ds = CertState era
dps CertState era
-> Getting (DState era) (CertState era) (DState era) -> DState era
forall s a. s -> Getting a s a -> a
^. Getting (DState era) (CertState era) (DState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL
ds' :: DState era
ds' = DState era
ds {dsFutureGenDelegs = Map.insert fg gd (dsFutureGenDelegs ds)}
dps' :: CertState era
dps' = CertState era
dps CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (DState era -> Identity (DState era))
-> CertState era -> Identity (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL ((DState era -> Identity (DState era))
-> CertState era -> Identity (CertState era))
-> DState era -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DState era
ds'
ls' :: LedgerState era
ls' = LedgerState era
ls {lsCertState = dps'}
es' :: EpochState era
es' = EpochState era
es {esLState = ls'}
nes' :: NewEpochState era
nes' = NewEpochState era
nes {nesEs = es'}
adoptFutureGenDeleg ::
forall era.
EraCertState era =>
(FutureGenDeleg, GenDelegPair) ->
ChainState era ->
ChainState era
adoptFutureGenDeleg :: forall era.
EraCertState era =>
(FutureGenDeleg, GenDelegPair) -> ChainState era -> ChainState era
adoptFutureGenDeleg (FutureGenDeleg
fg, GenDelegPair
gd) ChainState era
cs = ChainState era
cs {chainNes = nes'}
where
nes :: NewEpochState era
nes = ChainState era -> NewEpochState era
forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
es :: EpochState era
es = NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes
ls :: LedgerState era
ls = EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState EpochState era
es
dps :: CertState era
dps = LedgerState era -> CertState era
forall era. LedgerState era -> CertState era
lsCertState LedgerState era
ls
ds :: DState era
ds = CertState era
dps CertState era
-> Getting (DState era) (CertState era) (DState era) -> DState era
forall s a. s -> Getting a s a -> a
^. Getting (DState era) (CertState era) (DState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL
gds :: GenDelegs
gds = Map (KeyHash 'Genesis) GenDelegPair -> GenDelegs
GenDelegs (Map (KeyHash 'Genesis) GenDelegPair -> GenDelegs)
-> Map (KeyHash 'Genesis) GenDelegPair -> GenDelegs
forall a b. (a -> b) -> a -> b
$ KeyHash 'Genesis
-> GenDelegPair
-> Map (KeyHash 'Genesis) GenDelegPair
-> Map (KeyHash 'Genesis) GenDelegPair
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (FutureGenDeleg -> KeyHash 'Genesis
fGenDelegGenKeyHash FutureGenDeleg
fg) GenDelegPair
gd (GenDelegs -> Map (KeyHash 'Genesis) GenDelegPair
unGenDelegs (DState era -> GenDelegs
forall era. DState era -> GenDelegs
dsGenDelegs DState era
ds))
ds' :: DState era
ds' =
DState era
ds
{ dsFutureGenDelegs = Map.delete fg (dsFutureGenDelegs ds)
, dsGenDelegs = gds
}
dps' :: CertState era
dps' = CertState era
dps CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (DState era -> Identity (DState era))
-> CertState era -> Identity (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL ((DState era -> Identity (DState era))
-> CertState era -> Identity (CertState era))
-> DState era -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DState era
ds'
ls' :: LedgerState era
ls' = LedgerState era
ls {lsCertState = dps'}
es' :: EpochState era
es' = EpochState era
es {esLState = ls'}
nes' :: NewEpochState era
nes' = NewEpochState era
nes {nesEs = es'}