{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

-- |
-- Module      : Test.Cardano.Ledger.Shelley.Examples.Combinators
-- Description : Chain State Combinators
--
-- A collection of combinators for manipulating Chain State.
-- The idea is to provide a clear way of describing the
-- changes to the chain state when a block is processed.
module Test.Cardano.Ledger.Shelley.Examples.Combinators (
  evolveNonceFrozen,
  evolveNonceUnfrozen,
  newLab,
  feesAndKeyRefund,
  feesAndDeposits,
  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 (..))
import Cardano.Ledger.Credential (
  Credential (..),
  Ptr,
 )
import Cardano.Ledger.EpochBoundary (SnapShot, SnapShots (..), calculatePoolDistr)
import Cardano.Ledger.Keys (
  GenDelegPair,
  GenDelegs (..),
  KeyHash,
  KeyRole (..),
 )
import Cardano.Ledger.PoolDistr (PoolDistr (..))
import Cardano.Ledger.PoolParams (PoolParams (..))
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.LedgerState (
  AccountState (..),
  CertState (..),
  DState (..),
  EpochState (..),
  FutureGenDeleg (..),
  InstantaneousRewards (..),
  LedgerState (..),
  NewEpochState (..),
  PState (..),
  PulsingRewUpdate (..),
  RewardUpdate (..),
  UTxOState (..),
  applyRUpd,
  curPParamsEpochStateL,
  delegations,
  futurePParamsEpochStateL,
  prevPParamsEpochStateL,
  rewards,
  updateStakeDistribution,
 )
import Cardano.Ledger.Shelley.PParams (ProposedPPUpdates)
import Cardano.Ledger.Shelley.Rules (emptyInstantaneousRewards, votedFuturePParams)
import Cardano.Ledger.UMap (
  RDPair (..),
  UView (PtrUView, RewDepUView, SPoolUView),
  fromCompact,
  unUView,
 )
import qualified Cardano.Ledger.UMap as UM
import Cardano.Ledger.UTxO (UTxO (..), txins, txouts)
import Cardano.Ledger.Val ((<+>), (<->), (<×>))
import Cardano.Protocol.TPraos.BHeader (
  BHBody (..),
  BHeader,
  LastAppliedBlock (..),
  bhHash,
  bhbody,
  lastAppliedHash,
  prevHashToNonce,
 )
import Cardano.Slotting.Slot (EpochNo, WithOrigin (..))
import Data.Default (Default (..))
import Data.Foldable as F (fold, foldl')
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import Data.Word (Word64)
import Lens.Micro ((%~), (&), (.~), (^.))
import Lens.Micro.Extras (view)
import Test.Cardano.Ledger.Shelley.Rules.Chain (ChainState (..))
import Test.Cardano.Ledger.Shelley.Utils (epochFromSlotNo, getBlockNonce, testGlobals)

-- ======================================================

-- | = Evolve Nonces - Frozen
--
-- Evolve the appropriate nonces under the assumption
-- that the candidate nonce is now frozen.
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 :: Nonce
chainEvolvingNonce = forall era. ChainState era -> Nonce
chainEvolvingNonce ChainState era
cs Nonce -> Nonce -> Nonce
⭒ Nonce
n}

-- | = Evolve Nonces - Unfrozen
--
-- Evolve the appropriate nonces under the assumption
-- that the candidate nonce is not frozen.
-- Note: do not use this function when crossing the epoch boundary,
-- instead use 'newEpoch'.
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 :: Nonce
chainCandidateNonce = forall era. ChainState era -> Nonce
chainCandidateNonce ChainState era
cs Nonce -> Nonce -> Nonce
⭒ Nonce
n
    , chainEvolvingNonce :: Nonce
chainEvolvingNonce = forall era. ChainState era -> Nonce
chainEvolvingNonce ChainState era
cs Nonce -> Nonce -> Nonce
⭒ Nonce
n
    }

-- | = New 'LastAppliedBlock' (*NOT* on epoch boundaries)
--
-- Update the chain state with the details of 'LastAppliedBlock'
-- that occur when a new block is processed.
-- Note: do not use this function when crossing the epoch boundary,
-- instead use 'newEpoch'.
newLab ::
  forall era.
  Era era =>
  Block (BHeader (EraCrypto era)) era ->
  ChainState era ->
  ChainState era
newLab :: forall era.
Era era =>
Block (BHeader (EraCrypto era)) era
-> ChainState era -> ChainState era
newLab Block (BHeader (EraCrypto era)) era
b ChainState era
cs =
  ChainState era
cs {chainLastAppliedBlock :: WithOrigin (LastAppliedBlock (EraCrypto era))
chainLastAppliedBlock = forall t. t -> WithOrigin t
At forall a b. (a -> b) -> a -> b
$ forall c. BlockNo -> SlotNo -> HashHeader c -> LastAppliedBlock c
LastAppliedBlock BlockNo
bn SlotNo
sn (forall c. Crypto c => BHeader c -> HashHeader c
bhHash BHeader (EraCrypto era)
bh)}
  where
    bh :: BHeader (EraCrypto era)
bh = forall h era. Block h era -> h
bheader Block (BHeader (EraCrypto era)) era
b
    bn :: BlockNo
bn = forall c. BHBody c -> BlockNo
bheaderBlockNo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Crypto c => BHeader c -> BHBody c
bhbody forall a b. (a -> b) -> a -> b
$ BHeader (EraCrypto era)
bh
    sn :: SlotNo
sn = forall c. BHBody c -> SlotNo
bheaderSlotNo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Crypto c => BHeader c -> BHBody c
bhbody forall a b. (a -> b) -> a -> b
$ BHeader (EraCrypto era)
bh

-- | = Update Fees and Deposits
--
-- Update the fee pot and deposit pot with the new fees and deposits
-- adjust the deposit tables in the UTxOState and the CertState.
-- Notes
--   1) do not give this function duplicates in the 'stakes' or 'pools' inputs.
--   2) do not use this function when crossing the epoch boundary,
-- instead use 'newEpoch'.
feesAndDeposits ::
  forall era.
  EraPParams era =>
  PParams era ->
  Coin ->
  [Credential 'Staking (EraCrypto era)] ->
  [PoolParams (EraCrypto era)] ->
  ChainState era ->
  ChainState era
feesAndDeposits :: forall era.
EraPParams era =>
PParams era
-> Coin
-> [Credential 'Staking (EraCrypto era)]
-> [PoolParams (EraCrypto era)]
-> ChainState era
-> ChainState era
feesAndDeposits PParams era
ppEx Coin
newFees [Credential 'Staking (EraCrypto era)]
stakes [PoolParams (EraCrypto era)]
pools ChainState era
cs = ChainState era
cs {chainNes :: NewEpochState era
chainNes = NewEpochState era
nes'}
  where
    nes :: NewEpochState era
nes = forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
    es :: EpochState era
es = forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes
    ls :: LedgerState era
ls = forall era. EpochState era -> LedgerState era
esLState EpochState era
es
    CertState VState era
vstate PState era
pstate DState era
dstate = forall era. LedgerState era -> CertState era
lsCertState LedgerState era
ls
    utxoSt :: UTxOState era
utxoSt = forall era. LedgerState era -> UTxOState era
lsUTxOState LedgerState era
ls
    utxoSt' :: UTxOState era
utxoSt' =
      UTxOState era
utxoSt
        { utxosDeposited :: Coin
utxosDeposited =
            forall era. UTxOState era -> Coin
utxosDeposited UTxOState era
utxoSt
              forall t. Val t => t -> t -> t
<+> (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Credential 'Staking (EraCrypto era)]
stakes forall t i. (Val t, Integral i) => i -> t -> t
<×> PParams era
ppEx forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Coin
ppKeyDepositL)
              forall t. Val t => t -> t -> t
<+> (Integer
newcount forall t i. (Val t, Integral i) => i -> t -> t
<×> PParams era
ppEx forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Coin
ppPoolDepositL)
        , utxosFees :: Coin
utxosFees = forall era. UTxOState era -> Coin
utxosFees UTxOState era
utxoSt forall t. Val t => t -> t -> t
<+> Coin
newFees
        }
    ls' :: LedgerState era
ls' = LedgerState era
ls {lsUTxOState :: UTxOState era
lsUTxOState = UTxOState era
utxoSt', lsCertState :: CertState era
lsCertState = CertState era
dpstate'}
    -- Count the number of new pools, because we don't take a deposit for existing pools
    -- This strategy DOES NOT WORK if there are duplicate PoolParams in one call
    newcount :: Integer
newcount = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' Integer -> PoolParams (EraCrypto era) -> Integer
accum Integer
0 [PoolParams (EraCrypto era)]
pools
    accum :: Integer -> PoolParams (EraCrypto era) -> Integer
accum Integer
n PoolParams (EraCrypto era)
x = if forall k a. Ord k => k -> Map k a -> Bool
Map.member (forall c. PoolParams c -> KeyHash 'StakePool c
ppId PoolParams (EraCrypto era)
x) (forall era.
PState era -> Map (KeyHash 'StakePool (EraCrypto era)) Coin
psDeposits PState era
pstate) then (Integer
n :: Integer) else Integer
n forall a. Num a => a -> a -> a
+ Integer
1
    newDeposits :: Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
newDeposits =
      forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (forall a b. (a -> b) -> [a] -> [b]
map (\Credential 'Staking (EraCrypto era)
cred -> (Credential 'Staking (EraCrypto era)
cred, HasCallStack => Coin -> CompactForm Coin
UM.compactCoinOrError (PParams era
ppEx forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Coin
ppKeyDepositL))) [Credential 'Staking (EraCrypto era)]
stakes)
    newPools :: Map (KeyHash 'StakePool (EraCrypto era)) Coin
newPools = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (forall a b. (a -> b) -> [a] -> [b]
map (\PoolParams (EraCrypto era)
p -> (forall c. PoolParams c -> KeyHash 'StakePool c
ppId PoolParams (EraCrypto era)
p, PParams era
ppEx forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Coin
ppPoolDepositL)) [PoolParams (EraCrypto era)]
pools)
    dpstate' :: CertState era
dpstate' =
      forall era. VState era -> PState era -> DState era -> CertState era
CertState
        VState era
vstate
        PState era
pstate {psDeposits :: Map (KeyHash 'StakePool (EraCrypto era)) Coin
psDeposits = forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith (\Coin
old Coin
_new -> Coin
old) Map (KeyHash 'StakePool (EraCrypto era)) Coin
newPools (forall era.
PState era -> Map (KeyHash 'StakePool (EraCrypto era)) Coin
psDeposits PState era
pstate)}
        DState era
dstate {dsUnified :: UMap (EraCrypto era)
dsUnified = forall c k. UView c k RDPair -> Map k (CompactForm Coin) -> UMap c
UM.unionKeyDeposits (forall c. UMap c -> UView c (Credential 'Staking c) RDPair
RewDepUView (forall era. DState era -> UMap (EraCrypto era)
dsUnified DState era
dstate)) Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
newDeposits}
    es' :: EpochState era
es' = EpochState era
es {esLState :: LedgerState era
esLState = LedgerState era
ls'}
    nes' :: NewEpochState era
nes' = NewEpochState era
nes {nesEs :: EpochState era
nesEs = EpochState era
es'}

feesAndKeyRefund ::
  forall era.
  Coin ->
  Credential 'Staking (EraCrypto era) ->
  ChainState era ->
  ChainState era
feesAndKeyRefund :: forall era.
Coin
-> Credential 'Staking (EraCrypto era)
-> ChainState era
-> ChainState era
feesAndKeyRefund Coin
newFees Credential 'Staking (EraCrypto era)
key ChainState era
cs = ChainState era
cs {chainNes :: NewEpochState era
chainNes = NewEpochState era
nes'}
  where
    nes :: NewEpochState era
nes = forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
    es :: EpochState era
es = forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes
    ls :: LedgerState era
ls = forall era. EpochState era -> LedgerState era
esLState EpochState era
es
    CertState VState era
_vstate PState era
pstate DState era
dstate = forall era. LedgerState era -> CertState era
lsCertState LedgerState era
ls
    refund :: Coin
refund = case forall k c v. k -> UView c k v -> Maybe v
UM.lookup Credential 'Staking (EraCrypto era)
key (forall c. UMap c -> UView c (Credential 'Staking c) RDPair
RewDepUView (forall era. DState era -> UMap (EraCrypto era)
dsUnified DState era
dstate)) of
      Maybe RDPair
Nothing -> Integer -> Coin
Coin Integer
0
      Just (RDPair CompactForm Coin
_ CompactForm Coin
ccoin) -> forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm Coin
ccoin
    utxoSt :: UTxOState era
utxoSt = forall era. LedgerState era -> UTxOState era
lsUTxOState LedgerState era
ls
    utxoSt' :: UTxOState era
utxoSt' =
      UTxOState era
utxoSt
        { utxosDeposited :: Coin
utxosDeposited = forall era. UTxOState era -> Coin
utxosDeposited UTxOState era
utxoSt forall t. Val t => t -> t -> t
<-> Coin
refund
        , utxosFees :: Coin
utxosFees = forall era. UTxOState era -> Coin
utxosFees UTxOState era
utxoSt forall t. Val t => t -> t -> t
<+> Coin
newFees
        }
    ls' :: LedgerState era
ls' = LedgerState era
ls {lsUTxOState :: UTxOState era
lsUTxOState = UTxOState era
utxoSt', lsCertState :: CertState era
lsCertState = CertState era
dpstate'}
    es' :: EpochState era
es' = EpochState era
es {esLState :: LedgerState era
esLState = LedgerState era
ls'}
    nes' :: NewEpochState era
nes' = NewEpochState era
nes {nesEs :: EpochState era
nesEs = EpochState era
es'}
    dpstate' :: CertState era
dpstate' = forall era. VState era -> PState era -> DState era -> CertState era
CertState forall a. Default a => a
def PState era
pstate DState era
dstate {dsUnified :: UMap (EraCrypto era)
dsUnified = forall k c. (RDPair -> RDPair) -> k -> UView c k RDPair -> UMap c
UM.adjust RDPair -> RDPair
zeroD Credential 'Staking (EraCrypto era)
key (forall c. UMap c -> UView c (Credential 'Staking c) RDPair
RewDepUView (forall era. DState era -> UMap (EraCrypto era)
dsUnified DState era
dstate))}
    zeroD :: RDPair -> RDPair
zeroD (RDPair CompactForm Coin
x CompactForm Coin
_) = CompactForm Coin -> CompactForm Coin -> RDPair
RDPair CompactForm Coin
x (Word64 -> CompactForm Coin
UM.CompactCoin Word64
0)

-- | = Update the UTxO
--
-- Update the UTxO for given transaction body.
newUTxO ::
  forall era.
  (EraTx era, EraGov era) =>
  TxBody era ->
  ChainState era ->
  ChainState era
newUTxO :: forall era.
(EraTx era, EraGov era) =>
TxBody era -> ChainState era -> ChainState era
newUTxO TxBody era
txb ChainState era
cs = ChainState era
cs {chainNes :: NewEpochState era
chainNes = NewEpochState era
nes'}
  where
    nes :: NewEpochState era
nes = forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
    es :: EpochState era
es = forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes
    ls :: LedgerState era
ls = forall era. EpochState era -> LedgerState era
esLState EpochState era
es
    utxoSt :: UTxOState era
utxoSt = forall era. LedgerState era -> UTxOState era
lsUTxOState LedgerState era
ls
    utxo :: Map (TxIn (EraCrypto era)) (TxOut era)
utxo = forall era. UTxO era -> Map (TxIn (EraCrypto era)) (TxOut era)
unUTxO forall a b. (a -> b) -> a -> b
$ 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 (EraCrypto era)) (TxOut era)
utxoToDel = forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map (TxIn (EraCrypto era)) (TxOut era)
utxo (forall era.
EraTxBody era =>
TxBody era -> Set (TxIn (EraCrypto era))
txins @era TxBody era
txb)
    utxoWithout :: Map (TxIn (EraCrypto era)) (TxOut era)
utxoWithout = forall k a. Ord k => Map k a -> Set k -> Map k a
Map.withoutKeys Map (TxIn (EraCrypto era)) (TxOut era)
utxo (forall era.
EraTxBody era =>
TxBody era -> Set (TxIn (EraCrypto era))
txins @era TxBody era
txb)
    utxoDel :: UTxO era
utxoDel = forall era. Map (TxIn (EraCrypto era)) (TxOut era) -> UTxO era
UTxO Map (TxIn (EraCrypto era)) (TxOut era)
utxoToDel
    utxo' :: UTxO era
utxo' = forall era. Map (TxIn (EraCrypto era)) (TxOut era) -> UTxO era
UTxO (Map (TxIn (EraCrypto era)) (TxOut era)
utxoWithout forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` forall era. UTxO era -> Map (TxIn (EraCrypto era)) (TxOut era)
unUTxO UTxO era
utxoAdd)
    sd' :: IncrementalStake (EraCrypto era)
sd' =
      forall era.
EraTxOut era =>
PParams era
-> IncrementalStake (EraCrypto era)
-> UTxO era
-> UTxO era
-> IncrementalStake (EraCrypto era)
updateStakeDistribution @era (EpochState era
es forall s a. s -> Getting a s a -> a
^. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL) (forall era. UTxOState era -> IncrementalStake (EraCrypto era)
utxosStakeDistr UTxOState era
utxoSt) UTxO era
utxoDel UTxO era
utxoAdd
    utxoSt' :: UTxOState era
utxoSt' = UTxOState era
utxoSt {utxosUtxo :: UTxO era
utxosUtxo = UTxO era
utxo', utxosStakeDistr :: IncrementalStake (EraCrypto era)
utxosStakeDistr = IncrementalStake (EraCrypto era)
sd'}
    ls' :: LedgerState era
ls' = LedgerState era
ls {lsUTxOState :: UTxOState era
lsUTxOState = UTxOState era
utxoSt'}
    es' :: EpochState era
es' = EpochState era
es {esLState :: LedgerState era
esLState = LedgerState era
ls'}
    nes' :: NewEpochState era
nes' = NewEpochState era
nes {nesEs :: EpochState era
nesEs = EpochState era
es'}

-- | = New Stake Credential
--
--   Add a newly registered stake credential, initialize the rdRewards component of the RDPair.
--   The rdDeposit component of the RDPair is set by 'feesAndDeposits'
newStakeCred ::
  forall era.
  Credential 'Staking (EraCrypto era) ->
  Ptr ->
  ChainState era ->
  ChainState era
newStakeCred :: forall era.
Credential 'Staking (EraCrypto era)
-> Ptr -> ChainState era -> ChainState era
newStakeCred Credential 'Staking (EraCrypto era)
cred Ptr
ptr ChainState era
cs = ChainState era
cs {chainNes :: NewEpochState era
chainNes = NewEpochState era
nes'}
  where
    nes :: NewEpochState era
nes = forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
    es :: EpochState era
es = forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes
    ls :: LedgerState era
ls = forall era. EpochState era -> LedgerState era
esLState EpochState era
es
    dps :: CertState era
dps = forall era. LedgerState era -> CertState era
lsCertState LedgerState era
ls
    ds :: DState era
ds = forall era. CertState era -> DState era
certDState CertState era
dps
    ds' :: DState era
ds' =
      DState era
ds
        { dsUnified :: UMap (EraCrypto era)
dsUnified =
            let um0 :: UMap (EraCrypto era)
um0 = forall era. DState era -> UMap (EraCrypto era)
dsUnified DState era
ds
                um1 :: UMap (EraCrypto era)
um1 = forall k v c. k -> v -> UView c k v -> UMap c
UM.insert Credential 'Staking (EraCrypto era)
cred (CompactForm Coin -> CompactForm Coin -> RDPair
UM.RDPair (Word64 -> CompactForm Coin
UM.CompactCoin Word64
0) (Word64 -> CompactForm Coin
UM.CompactCoin Word64
0)) (forall c. UMap c -> UView c (Credential 'Staking c) RDPair
RewDepUView UMap (EraCrypto era)
um0)
                um2 :: UMap (EraCrypto era)
um2 = (forall c. UMap c -> UView c Ptr (Credential 'Staking c)
PtrUView UMap (EraCrypto era)
um1 forall c k v. UView c k v -> (k, v) -> UMap c
UM.∪ (Ptr
ptr, Credential 'Staking (EraCrypto era)
cred))
             in UMap (EraCrypto era)
um2
        }
    dps' :: CertState era
dps' = CertState era
dps {certDState :: DState era
certDState = DState era
ds'}
    ls' :: LedgerState era
ls' = LedgerState era
ls {lsCertState :: CertState era
lsCertState = CertState era
dps'}
    es' :: EpochState era
es' = EpochState era
es {esLState :: LedgerState era
esLState = LedgerState era
ls'}
    nes' :: NewEpochState era
nes' = NewEpochState era
nes {nesEs :: EpochState era
nesEs = EpochState era
es'}

-- | = De-Register Stake Credential
--
-- De-register a stake credential and all associated data.
-- Be sure to run 'feesAndKeyRefund' before you run this
-- because this throws away the stored refund, which then
-- can't be used to balance the utxosDeposited field in 'feesAndKeyRefund'
deregStakeCred ::
  forall era.
  Credential 'Staking (EraCrypto era) ->
  ChainState era ->
  ChainState era
deregStakeCred :: forall era.
Credential 'Staking (EraCrypto era)
-> ChainState era -> ChainState era
deregStakeCred Credential 'Staking (EraCrypto era)
cred ChainState era
cs = ChainState era
cs {chainNes :: NewEpochState era
chainNes = NewEpochState era
nes'}
  where
    nes :: NewEpochState era
nes = forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
    es :: EpochState era
es = forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes
    ls :: LedgerState era
ls = forall era. EpochState era -> LedgerState era
esLState EpochState era
es
    dps :: CertState era
dps = forall era. LedgerState era -> CertState era
lsCertState LedgerState era
ls
    ds :: DState era
ds = forall era. CertState era -> DState era
certDState CertState era
dps
    ds' :: DState era
ds' =
      DState era
ds
        { dsUnified :: UMap (EraCrypto era)
dsUnified =
            let um0 :: UMap (EraCrypto era)
um0 = forall era. DState era -> UMap (EraCrypto era)
dsUnified DState era
ds
                um1 :: UMap (EraCrypto era)
um1 = forall k c v. k -> UView c k v -> UMap c
UM.delete Credential 'Staking (EraCrypto era)
cred (forall c. UMap c -> UView c (Credential 'Staking c) RDPair
RewDepUView UMap (EraCrypto era)
um0)
                um2 :: UMap (EraCrypto era)
um2 = forall c. UMap c -> UView c Ptr (Credential 'Staking c)
PtrUView UMap (EraCrypto era)
um1 forall c k v. UView c k v -> Set v -> UMap c
UM.⋫ forall a. a -> Set a
Set.singleton Credential 'Staking (EraCrypto era)
cred
                um3 :: UMap (EraCrypto era)
um3 = forall k c v. k -> UView c k v -> UMap c
UM.delete Credential 'Staking (EraCrypto era)
cred (forall c.
UMap c -> UView c (Credential 'Staking c) (KeyHash 'StakePool c)
SPoolUView UMap (EraCrypto era)
um2)
             in UMap (EraCrypto era)
um3
        }
    dps' :: CertState era
dps' = CertState era
dps {certDState :: DState era
certDState = DState era
ds'}
    ls' :: LedgerState era
ls' = LedgerState era
ls {lsCertState :: CertState era
lsCertState = CertState era
dps'}
    es' :: EpochState era
es' = EpochState era
es {esLState :: LedgerState era
esLState = LedgerState era
ls'}
    nes' :: NewEpochState era
nes' = NewEpochState era
nes {nesEs :: EpochState era
nesEs = EpochState era
es'}

-- | = New Delegation
--
-- Create a delegation from the given stake credential to the given
-- stake pool.
delegation ::
  forall era.
  Credential 'Staking (EraCrypto era) ->
  KeyHash 'StakePool (EraCrypto era) ->
  ChainState era ->
  ChainState era
delegation :: forall era.
Credential 'Staking (EraCrypto era)
-> KeyHash 'StakePool (EraCrypto era)
-> ChainState era
-> ChainState era
delegation Credential 'Staking (EraCrypto era)
cred KeyHash 'StakePool (EraCrypto era)
pool ChainState era
cs = ChainState era
cs {chainNes :: NewEpochState era
chainNes = NewEpochState era
nes'}
  where
    nes :: NewEpochState era
nes = forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
    es :: EpochState era
es = forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes
    ls :: LedgerState era
ls = forall era. EpochState era -> LedgerState era
esLState EpochState era
es
    dps :: CertState era
dps = forall era. LedgerState era -> CertState era
lsCertState LedgerState era
ls
    ds :: DState era
ds = forall era. CertState era -> DState era
certDState CertState era
dps
    ds' :: DState era
ds' =
      DState era
ds
        { dsUnified :: UMap (EraCrypto era)
dsUnified = forall k v c. k -> v -> UView c k v -> UMap c
UM.insert Credential 'Staking (EraCrypto era)
cred KeyHash 'StakePool (EraCrypto era)
pool (forall era.
DState era
-> UView
     (EraCrypto era)
     (Credential 'Staking (EraCrypto era))
     (KeyHash 'StakePool (EraCrypto era))
delegations DState era
ds)
        }
    dps' :: CertState era
dps' = CertState era
dps {certDState :: DState era
certDState = DState era
ds'}
    ls' :: LedgerState era
ls' = LedgerState era
ls {lsCertState :: CertState era
lsCertState = CertState era
dps'}
    es' :: EpochState era
es' = EpochState era
es {esLState :: LedgerState era
esLState = LedgerState era
ls'}
    nes' :: NewEpochState era
nes' = NewEpochState era
nes {nesEs :: EpochState era
nesEs = EpochState era
es'}

-- | = New Stake Pool
--
-- Add a newly registered stake pool
newPool ::
  forall era.
  PoolParams (EraCrypto era) ->
  ChainState era ->
  ChainState era
newPool :: forall era.
PoolParams (EraCrypto era) -> ChainState era -> ChainState era
newPool PoolParams (EraCrypto era)
pool ChainState era
cs = ChainState era
cs {chainNes :: NewEpochState era
chainNes = NewEpochState era
nes'}
  where
    nes :: NewEpochState era
nes = forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
    es :: EpochState era
es = forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes
    ls :: LedgerState era
ls = forall era. EpochState era -> LedgerState era
esLState EpochState era
es
    dps :: CertState era
dps = forall era. LedgerState era -> CertState era
lsCertState LedgerState era
ls
    ps :: PState era
ps = forall era. CertState era -> PState era
certPState CertState era
dps
    ps' :: PState era
ps' =
      PState era
ps
        { psStakePoolParams :: Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
psStakePoolParams = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (forall c. PoolParams c -> KeyHash 'StakePool c
ppId PoolParams (EraCrypto era)
pool) PoolParams (EraCrypto era)
pool (forall era.
PState era
-> Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
psStakePoolParams PState era
ps)
        }
    dps' :: CertState era
dps' = CertState era
dps {certPState :: PState era
certPState = PState era
ps'}
    ls' :: LedgerState era
ls' = LedgerState era
ls {lsCertState :: CertState era
lsCertState = CertState era
dps'}
    es' :: EpochState era
es' = EpochState era
es {esLState :: LedgerState era
esLState = LedgerState era
ls'}
    nes' :: NewEpochState era
nes' = NewEpochState era
nes {nesEs :: EpochState era
nesEs = EpochState era
es'}

-- | = Re-Register Stake Pool
reregPool ::
  forall era.
  PoolParams (EraCrypto era) ->
  ChainState era ->
  ChainState era
reregPool :: forall era.
PoolParams (EraCrypto era) -> ChainState era -> ChainState era
reregPool PoolParams (EraCrypto era)
pool ChainState era
cs = ChainState era
cs {chainNes :: NewEpochState era
chainNes = NewEpochState era
nes'}
  where
    nes :: NewEpochState era
nes = forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
    es :: EpochState era
es = forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes
    ls :: LedgerState era
ls = forall era. EpochState era -> LedgerState era
esLState EpochState era
es
    dps :: CertState era
dps = forall era. LedgerState era -> CertState era
lsCertState LedgerState era
ls
    ps :: PState era
ps = forall era. CertState era -> PState era
certPState CertState era
dps
    ps' :: PState era
ps' =
      PState era
ps
        { psFutureStakePoolParams :: Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
psFutureStakePoolParams = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (forall c. PoolParams c -> KeyHash 'StakePool c
ppId PoolParams (EraCrypto era)
pool) PoolParams (EraCrypto era)
pool (forall era.
PState era
-> Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
psStakePoolParams PState era
ps)
        }
    dps' :: CertState era
dps' = CertState era
dps {certPState :: PState era
certPState = PState era
ps'}
    ls' :: LedgerState era
ls' = LedgerState era
ls {lsCertState :: CertState era
lsCertState = CertState era
dps'}
    es' :: EpochState era
es' = EpochState era
es {esLState :: LedgerState era
esLState = LedgerState era
ls'}
    nes' :: NewEpochState era
nes' = NewEpochState era
nes {nesEs :: EpochState era
nesEs = EpochState era
es'}

-- | = Re-Register Stake Pool
updatePoolParams ::
  forall era.
  PoolParams (EraCrypto era) ->
  ChainState era ->
  ChainState era
updatePoolParams :: forall era.
PoolParams (EraCrypto era) -> ChainState era -> ChainState era
updatePoolParams PoolParams (EraCrypto era)
pool ChainState era
cs = ChainState era
cs {chainNes :: NewEpochState era
chainNes = NewEpochState era
nes'}
  where
    nes :: NewEpochState era
nes = forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
    es :: EpochState era
es = forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes
    ls :: LedgerState era
ls = forall era. EpochState era -> LedgerState era
esLState EpochState era
es
    dps :: CertState era
dps = forall era. LedgerState era -> CertState era
lsCertState LedgerState era
ls
    ps :: PState era
ps = forall era. CertState era -> PState era
certPState CertState era
dps
    ps' :: PState era
ps' =
      PState era
ps
        { psStakePoolParams :: Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
psStakePoolParams = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (forall c. PoolParams c -> KeyHash 'StakePool c
ppId PoolParams (EraCrypto era)
pool) PoolParams (EraCrypto era)
pool (forall era.
PState era
-> Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
psStakePoolParams PState era
ps)
        , psFutureStakePoolParams :: Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
psFutureStakePoolParams = forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (forall c. PoolParams c -> KeyHash 'StakePool c
ppId PoolParams (EraCrypto era)
pool) (forall era.
PState era
-> Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
psStakePoolParams PState era
ps)
        }
    dps' :: CertState era
dps' = CertState era
dps {certPState :: PState era
certPState = PState era
ps'}
    ls' :: LedgerState era
ls' = LedgerState era
ls {lsCertState :: CertState era
lsCertState = CertState era
dps'}
    es' :: EpochState era
es' = EpochState era
es {esLState :: LedgerState era
esLState = LedgerState era
ls'}
    nes' :: NewEpochState era
nes' = NewEpochState era
nes {nesEs :: EpochState era
nesEs = EpochState era
es'}

-- | = Pool Retirement
--
-- Stage a stake pool for retirement.
stageRetirement ::
  forall era.
  KeyHash 'StakePool (EraCrypto era) ->
  EpochNo ->
  ChainState era ->
  ChainState era
stageRetirement :: forall era.
KeyHash 'StakePool (EraCrypto era)
-> EpochNo -> ChainState era -> ChainState era
stageRetirement KeyHash 'StakePool (EraCrypto era)
kh EpochNo
e ChainState era
cs = ChainState era
cs {chainNes :: NewEpochState era
chainNes = NewEpochState era
nes'}
  where
    nes :: NewEpochState era
nes = forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
    es :: EpochState era
es = forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes
    ls :: LedgerState era
ls = forall era. EpochState era -> LedgerState era
esLState EpochState era
es
    dps :: CertState era
dps = forall era. LedgerState era -> CertState era
lsCertState LedgerState era
ls
    ps :: PState era
ps = forall era. CertState era -> PState era
certPState CertState era
dps
    ps' :: PState era
ps' = PState era
ps {psRetiring :: Map (KeyHash 'StakePool (EraCrypto era)) EpochNo
psRetiring = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert KeyHash 'StakePool (EraCrypto era)
kh EpochNo
e (forall era.
PState era -> Map (KeyHash 'StakePool (EraCrypto era)) EpochNo
psRetiring PState era
ps)}
    dps' :: CertState era
dps' = CertState era
dps {certPState :: PState era
certPState = PState era
ps'}
    ls' :: LedgerState era
ls' = LedgerState era
ls {lsCertState :: CertState era
lsCertState = CertState era
dps'}
    es' :: EpochState era
es' = EpochState era
es {esLState :: LedgerState era
esLState = LedgerState era
ls'}
    nes' :: NewEpochState era
nes' = NewEpochState era
nes {nesEs :: EpochState era
nesEs = EpochState era
es'}

-- | = Reap Pool
--
-- Remove a stake pool.
reapPool ::
  forall era.
  EraGov era =>
  PoolParams (EraCrypto era) ->
  ChainState era ->
  ChainState era
reapPool :: forall era.
EraGov era =>
PoolParams (EraCrypto era) -> ChainState era -> ChainState era
reapPool PoolParams (EraCrypto era)
pool ChainState era
cs = ChainState era
cs {chainNes :: NewEpochState era
chainNes = NewEpochState era
nes'}
  where
    kh :: KeyHash 'StakePool (EraCrypto era)
kh = forall c. PoolParams c -> KeyHash 'StakePool c
ppId PoolParams (EraCrypto era)
pool
    nes :: NewEpochState era
nes = forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
    es :: EpochState era
es = forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes
    ls :: LedgerState era
ls = forall era. EpochState era -> LedgerState era
esLState EpochState era
es
    dps :: CertState era
dps = forall era. LedgerState era -> CertState era
lsCertState LedgerState era
ls
    ps :: PState era
ps = forall era. CertState era -> PState era
certPState CertState era
dps
    ps' :: PState era
ps' =
      PState era
ps
        { psRetiring :: Map (KeyHash 'StakePool (EraCrypto era)) EpochNo
psRetiring = forall k a. Ord k => k -> Map k a -> Map k a
Map.delete KeyHash 'StakePool (EraCrypto era)
kh (forall era.
PState era -> Map (KeyHash 'StakePool (EraCrypto era)) EpochNo
psRetiring PState era
ps)
        , psStakePoolParams :: Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
psStakePoolParams = forall k a. Ord k => k -> Map k a -> Map k a
Map.delete KeyHash 'StakePool (EraCrypto era)
kh (forall era.
PState era
-> Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
psStakePoolParams PState era
ps)
        , psDeposits :: Map (KeyHash 'StakePool (EraCrypto era)) Coin
psDeposits = forall k a. Ord k => k -> Map k a -> Map k a
Map.delete KeyHash 'StakePool (EraCrypto era)
kh (forall era.
PState era -> Map (KeyHash 'StakePool (EraCrypto era)) Coin
psDeposits PState era
ps)
        }
    pp :: PParams era
pp = EpochState era
es forall s a. s -> Getting a s a -> a
^. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL
    ds :: DState era
ds = forall era. CertState era -> DState era
certDState CertState era
dps
    RewardAccount Network
_ Credential 'Staking (EraCrypto era)
rewardAddr = forall c. PoolParams c -> RewardAccount c
ppRewardAccount PoolParams (EraCrypto era)
pool
    (UView (EraCrypto era) (Credential 'Staking (EraCrypto era)) RDPair
rewards', Coin
unclaimed) =
      case forall k c v. k -> UView c k v -> Maybe v
UM.lookup Credential 'Staking (EraCrypto era)
rewardAddr (forall era.
DState era
-> UView
     (EraCrypto era) (Credential 'Staking (EraCrypto era)) RDPair
rewards DState era
ds) of
        Maybe RDPair
Nothing -> (forall era.
DState era
-> UView
     (EraCrypto era) (Credential 'Staking (EraCrypto era)) RDPair
rewards DState era
ds, PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Coin
ppPoolDepositL)
        Just (UM.RDPair CompactForm Coin
ccoin CompactForm Coin
dep) ->
          ( forall k v c. k -> v -> UView c k v -> UView c k v
UM.insert'
              Credential 'Staking (EraCrypto era)
rewardAddr
              (CompactForm Coin -> CompactForm Coin -> RDPair
UM.RDPair (CompactForm Coin -> CompactForm Coin -> CompactForm Coin
UM.addCompact CompactForm Coin
ccoin (HasCallStack => Coin -> CompactForm Coin
UM.compactCoinOrError (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Coin
ppPoolDepositL))) CompactForm Coin
dep)
              (forall era.
DState era
-> UView
     (EraCrypto era) (Credential 'Staking (EraCrypto era)) RDPair
rewards DState era
ds)
          , Integer -> Coin
Coin Integer
0
          )
    -- FIXME shouldn't we look up the pooldeposit here?
    umap1 :: UMap (EraCrypto era)
umap1 = forall c k v. UView c k v -> UMap c
unUView UView (EraCrypto era) (Credential 'Staking (EraCrypto era)) RDPair
rewards'
    umap2 :: UMap (EraCrypto era)
umap2 = forall c.
UMap c -> UView c (Credential 'Staking c) (KeyHash 'StakePool c)
UM.SPoolUView UMap (EraCrypto era)
umap1 forall c k v. UView c k v -> Set v -> UMap c
UM.⋫ forall a. a -> Set a
Set.singleton KeyHash 'StakePool (EraCrypto era)
kh
    ds' :: DState era
ds' = DState era
ds {dsUnified :: UMap (EraCrypto era)
dsUnified = UMap (EraCrypto era)
umap2}
    as :: AccountState
as = forall era. EpochState era -> AccountState
esAccountState EpochState era
es
    as' :: AccountState
as' = AccountState
as {asTreasury :: Coin
asTreasury = AccountState -> Coin
asTreasury AccountState
as forall t. Val t => t -> t -> t
<+> Coin
unclaimed}
    utxoSt :: UTxOState era
utxoSt = forall era. LedgerState era -> UTxOState era
lsUTxOState LedgerState era
ls
    utxoSt' :: UTxOState era
utxoSt' = UTxOState era
utxoSt {utxosDeposited :: Coin
utxosDeposited = forall era. UTxOState era -> Coin
utxosDeposited UTxOState era
utxoSt forall t. Val t => t -> t -> t
<-> (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Coin
ppPoolDepositL)}
    dps' :: CertState era
dps' = CertState era
dps {certPState :: PState era
certPState = PState era
ps', certDState :: DState era
certDState = DState era
ds'}
    ls' :: LedgerState era
ls' = LedgerState era
ls {lsCertState :: CertState era
lsCertState = CertState era
dps', lsUTxOState :: UTxOState era
lsUTxOState = UTxOState era
utxoSt'}
    es' :: EpochState era
es' = EpochState era
es {esLState :: LedgerState era
esLState = LedgerState era
ls', esAccountState :: AccountState
esAccountState = AccountState
as'}
    nes' :: NewEpochState era
nes' = NewEpochState era
nes {nesEs :: EpochState era
nesEs = EpochState era
es'}

-- | = MIR
--
-- Add a credential to the MIR mapping for the given pot (reserves or treasury)
mir ::
  forall era.
  Credential 'Staking (EraCrypto era) ->
  MIRPot ->
  Coin ->
  ChainState era ->
  ChainState era
mir :: forall era.
Credential 'Staking (EraCrypto era)
-> MIRPot -> Coin -> ChainState era -> ChainState era
mir Credential 'Staking (EraCrypto era)
cred MIRPot
pot Coin
amnt ChainState era
cs = ChainState era
cs {chainNes :: NewEpochState era
chainNes = NewEpochState era
nes'}
  where
    nes :: NewEpochState era
nes = forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
    es :: EpochState era
es = forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes
    ls :: LedgerState era
ls = forall era. EpochState era -> LedgerState era
esLState EpochState era
es
    dps :: CertState era
dps = forall era. LedgerState era -> CertState era
lsCertState LedgerState era
ls
    ds :: DState era
ds = forall era. CertState era -> DState era
certDState CertState era
dps
    InstantaneousRewards
      { iRReserves :: forall c.
InstantaneousRewards c -> Map (Credential 'Staking c) Coin
iRReserves = Map (Credential 'Staking (EraCrypto era)) Coin
ir
      , iRTreasury :: forall c.
InstantaneousRewards c -> Map (Credential 'Staking c) Coin
iRTreasury = Map (Credential 'Staking (EraCrypto era)) Coin
it
      , deltaReserves :: forall c. InstantaneousRewards c -> DeltaCoin
deltaReserves = DeltaCoin
dr
      , deltaTreasury :: forall c. InstantaneousRewards c -> DeltaCoin
deltaTreasury = DeltaCoin
dt
      } = forall era. DState era -> InstantaneousRewards (EraCrypto era)
dsIRewards DState era
ds
    irwd' :: InstantaneousRewards (EraCrypto era)
irwd' = case MIRPot
pot of
      MIRPot
ReservesMIR -> forall c.
Map (Credential 'Staking c) Coin
-> Map (Credential 'Staking c) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards c
InstantaneousRewards (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Credential 'Staking (EraCrypto era)
cred Coin
amnt Map (Credential 'Staking (EraCrypto era)) Coin
ir) Map (Credential 'Staking (EraCrypto era)) Coin
it DeltaCoin
dr DeltaCoin
dt
      MIRPot
TreasuryMIR -> forall c.
Map (Credential 'Staking c) Coin
-> Map (Credential 'Staking c) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards c
InstantaneousRewards Map (Credential 'Staking (EraCrypto era)) Coin
ir (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Credential 'Staking (EraCrypto era)
cred Coin
amnt Map (Credential 'Staking (EraCrypto era)) Coin
it) DeltaCoin
dr DeltaCoin
dt
    ds' :: DState era
ds' = DState era
ds {dsIRewards :: InstantaneousRewards (EraCrypto era)
dsIRewards = InstantaneousRewards (EraCrypto era)
irwd'}
    dps' :: CertState era
dps' = CertState era
dps {certDState :: DState era
certDState = DState era
ds'}
    ls' :: LedgerState era
ls' = LedgerState era
ls {lsCertState :: CertState era
lsCertState = CertState era
dps'}
    es' :: EpochState era
es' = EpochState era
es {esLState :: LedgerState era
esLState = LedgerState era
ls'}
    nes' :: NewEpochState era
nes' = NewEpochState era
nes {nesEs :: EpochState era
nesEs = EpochState era
es'}

-- | = Apply MIR
--
-- On the epoch boundary, reset the MIR mappings and augment the rewards.
applyMIR ::
  forall era.
  MIRPot ->
  Map (Credential 'Staking (EraCrypto era)) Coin ->
  ChainState era ->
  ChainState era
applyMIR :: forall era.
MIRPot
-> Map (Credential 'Staking (EraCrypto era)) Coin
-> ChainState era
-> ChainState era
applyMIR MIRPot
pot Map (Credential 'Staking (EraCrypto era)) Coin
newrewards ChainState era
cs = ChainState era
cs {chainNes :: NewEpochState era
chainNes = NewEpochState era
nes'}
  where
    tot :: Coin
tot = forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Map (Credential 'Staking (EraCrypto era)) Coin
newrewards
    nes :: NewEpochState era
nes = forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
    es :: EpochState era
es = forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes
    ls :: LedgerState era
ls = forall era. EpochState era -> LedgerState era
esLState EpochState era
es
    dps :: CertState era
dps = forall era. LedgerState era -> CertState era
lsCertState LedgerState era
ls
    ds :: DState era
ds = forall era. CertState era -> DState era
certDState CertState era
dps
    ds' :: DState era
ds' =
      DState era
ds
        { dsUnified :: UMap (EraCrypto era)
dsUnified = forall era.
DState era
-> UView
     (EraCrypto era) (Credential 'Staking (EraCrypto era)) RDPair
rewards DState era
ds forall c.
UView c (Credential 'Staking c) RDPair
-> Map (Credential 'Staking c) (CompactForm Coin) -> UMap c
UM.∪+ forall a b k. (a -> b) -> Map k a -> Map k b
Map.map HasCallStack => Coin -> CompactForm Coin
UM.compactCoinOrError Map (Credential 'Staking (EraCrypto era)) Coin
newrewards
        , dsIRewards :: InstantaneousRewards (EraCrypto era)
dsIRewards = forall c. InstantaneousRewards c
emptyInstantaneousRewards
        }
    dps' :: CertState era
dps' = CertState era
dps {certDState :: DState era
certDState = DState era
ds'}
    ls' :: LedgerState era
ls' = LedgerState era
ls {lsCertState :: CertState era
lsCertState = CertState era
dps'}
    as :: AccountState
as = forall era. EpochState era -> AccountState
esAccountState EpochState era
es
    as' :: AccountState
as' =
      if MIRPot
pot forall a. Eq a => a -> a -> Bool
== MIRPot
ReservesMIR
        then AccountState
as {asReserves :: Coin
asReserves = AccountState -> Coin
asReserves AccountState
as forall t. Val t => t -> t -> t
<-> Coin
tot}
        else AccountState
as {asTreasury :: Coin
asTreasury = AccountState -> Coin
asTreasury AccountState
as forall t. Val t => t -> t -> t
<-> Coin
tot}
    es' :: EpochState era
es' = EpochState era
es {esAccountState :: AccountState
esAccountState = AccountState
as', esLState :: LedgerState era
esLState = LedgerState era
ls'}
    nes' :: NewEpochState era
nes' = NewEpochState era
nes {nesEs :: EpochState era
nesEs = EpochState era
es'}

-- | = Reward Update
--
-- Update the chain state with the given reward update
rewardUpdate ::
  forall era.
  RewardUpdate (EraCrypto era) ->
  ChainState era ->
  ChainState era
rewardUpdate :: forall era.
RewardUpdate (EraCrypto era) -> ChainState era -> ChainState era
rewardUpdate RewardUpdate (EraCrypto era)
ru ChainState era
cs = ChainState era
cs {chainNes :: NewEpochState era
chainNes = NewEpochState era
nes'}
  where
    nes' :: NewEpochState era
nes' = (forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs) {nesRu :: StrictMaybe (PulsingRewUpdate (EraCrypto era))
nesRu = forall a. a -> StrictMaybe a
SJust (forall c. RewardUpdate c -> PulsingRewUpdate c
Complete RewardUpdate (EraCrypto era)
ru)}

-- | = Pulser
--
-- Update the chain state with the given reward update pulser
pulserUpdate ::
  forall era.
  PulsingRewUpdate (EraCrypto era) ->
  ChainState era ->
  ChainState era
pulserUpdate :: forall era.
PulsingRewUpdate (EraCrypto era)
-> ChainState era -> ChainState era
pulserUpdate PulsingRewUpdate (EraCrypto era)
p ChainState era
cs = ChainState era
cs {chainNes :: NewEpochState era
chainNes = NewEpochState era
nes'}
  where
    nes' :: NewEpochState era
nes' = (forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs) {nesRu :: StrictMaybe (PulsingRewUpdate (EraCrypto era))
nesRu = forall a. a -> StrictMaybe a
SJust PulsingRewUpdate (EraCrypto era)
p}

-- | = Apply a Reward Update
--
-- Apply the given reward update to the chain state
applyRewardUpdate ::
  forall era.
  EraGov era =>
  RewardUpdate (EraCrypto era) ->
  ChainState era ->
  ChainState era
applyRewardUpdate :: forall era.
EraGov era =>
RewardUpdate (EraCrypto era) -> ChainState era -> ChainState era
applyRewardUpdate RewardUpdate (EraCrypto era)
ru ChainState era
cs = ChainState era
cs {chainNes :: NewEpochState era
chainNes = NewEpochState era
nes'}
  where
    nes :: NewEpochState era
nes = forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
    es' :: EpochState era
es' = forall era.
EraGov era =>
RewardUpdate (EraCrypto era) -> EpochState era -> EpochState era
applyRUpd RewardUpdate (EraCrypto era)
ru (forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes)
    nes' :: NewEpochState era
nes' = (forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs) {nesEs :: EpochState era
nesEs = EpochState era
es', nesRu :: StrictMaybe (PulsingRewUpdate (EraCrypto era))
nesRu = forall a. StrictMaybe a
SNothing}

-- | = New Snapshot
--
-- Add a new snapshot and rotate the others
newSnapshot ::
  forall era.
  SnapShot (EraCrypto era) ->
  Coin ->
  ChainState era ->
  ChainState era
newSnapshot :: forall era.
SnapShot (EraCrypto era)
-> Coin -> ChainState era -> ChainState era
newSnapshot SnapShot (EraCrypto era)
snap Coin
fee ChainState era
cs = ChainState era
cs {chainNes :: NewEpochState era
chainNes = NewEpochState era
nes'}
  where
    nes :: NewEpochState era
nes = forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
    es :: EpochState era
es = forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes
    SnapShots
      { $sel:ssStakeMark:SnapShots :: forall c. SnapShots c -> SnapShot c
ssStakeMark = SnapShot (EraCrypto era)
ssMark
      , $sel:ssStakeSet:SnapShots :: forall c. SnapShots c -> SnapShot c
ssStakeSet = SnapShot (EraCrypto era)
ssSet
      } = forall era. EpochState era -> SnapShots (EraCrypto era)
esSnapshots EpochState era
es
    snaps :: SnapShots (EraCrypto era)
snaps =
      SnapShots
        { $sel:ssStakeMark:SnapShots :: SnapShot (EraCrypto era)
ssStakeMark = SnapShot (EraCrypto era)
snap
        , $sel:ssStakeMarkPoolDistr:SnapShots :: PoolDistr (EraCrypto era)
ssStakeMarkPoolDistr = forall c. SnapShot c -> PoolDistr c
calculatePoolDistr SnapShot (EraCrypto era)
snap
        , $sel:ssStakeSet:SnapShots :: SnapShot (EraCrypto era)
ssStakeSet = SnapShot (EraCrypto era)
ssMark
        , $sel:ssStakeGo:SnapShots :: SnapShot (EraCrypto era)
ssStakeGo = SnapShot (EraCrypto era)
ssSet
        , $sel:ssFee:SnapShots :: Coin
ssFee = Coin
fee
        }
    es' :: EpochState era
es' = EpochState era
es {esSnapshots :: SnapShots (EraCrypto era)
esSnapshots = SnapShots (EraCrypto era)
snaps}
    nes' :: NewEpochState era
nes' = NewEpochState era
nes {nesEs :: EpochState era
nesEs = EpochState era
es'}

-- | = Set Pool Distribution
--
-- Set the stake pool distribution to the given one.
setPoolDistr ::
  forall era.
  PoolDistr (EraCrypto era) ->
  ChainState era ->
  ChainState era
setPoolDistr :: forall era.
PoolDistr (EraCrypto era) -> ChainState era -> ChainState era
setPoolDistr PoolDistr (EraCrypto era)
pd ChainState era
cs = ChainState era
cs {chainNes :: NewEpochState era
chainNes = NewEpochState era
nes'}
  where
    nes' :: NewEpochState era
nes' = (forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs) {nesPd :: PoolDistr (EraCrypto era)
nesPd = PoolDistr (EraCrypto era)
pd}

-- | = Set Operation Certificate Counter
--
-- Set the operational certificates counter for a given stake pool.
setOCertCounter ::
  forall era.
  KeyHash 'BlockIssuer (EraCrypto era) ->
  Word64 ->
  ChainState era ->
  ChainState era
setOCertCounter :: forall era.
KeyHash 'BlockIssuer (EraCrypto era)
-> Word64 -> ChainState era -> ChainState era
setOCertCounter KeyHash 'BlockIssuer (EraCrypto era)
kh Word64
n ChainState era
cs = ChainState era
cs {chainOCertIssue :: Map (KeyHash 'BlockIssuer (EraCrypto era)) Word64
chainOCertIssue = Map (KeyHash 'BlockIssuer (EraCrypto era)) Word64
counters}
  where
    counters :: Map (KeyHash 'BlockIssuer (EraCrypto era)) Word64
counters = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert KeyHash 'BlockIssuer (EraCrypto era)
kh Word64
n (forall era.
ChainState era -> Map (KeyHash 'BlockIssuer (EraCrypto era)) Word64
chainOCertIssue ChainState era
cs)

-- | = Increase Block Count
--
-- Record that the given stake pool (non-core node) produced a block.
incrBlockCount ::
  forall era.
  KeyHash 'StakePool (EraCrypto era) ->
  ChainState era ->
  ChainState era
incrBlockCount :: forall era.
KeyHash 'StakePool (EraCrypto era)
-> ChainState era -> ChainState era
incrBlockCount KeyHash 'StakePool (EraCrypto era)
kh ChainState era
cs = ChainState era
cs {chainNes :: NewEpochState era
chainNes = NewEpochState era
nes'}
  where
    nes :: NewEpochState era
nes = forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
    BlocksMade Map (KeyHash 'StakePool (EraCrypto era)) Natural
bs = forall era. NewEpochState era -> BlocksMade (EraCrypto era)
nesBcur NewEpochState era
nes
    n :: Natural
n = Natural
1 forall a. Num a => a -> a -> a
+ forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Natural
0 KeyHash 'StakePool (EraCrypto era)
kh Map (KeyHash 'StakePool (EraCrypto era)) Natural
bs
    bs' :: BlocksMade (EraCrypto era)
bs' = forall c. Map (KeyHash 'StakePool c) Natural -> BlocksMade c
BlocksMade forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert KeyHash 'StakePool (EraCrypto era)
kh Natural
n Map (KeyHash 'StakePool (EraCrypto era)) Natural
bs
    nes' :: NewEpochState era
nes' = NewEpochState era
nes {nesBcur :: BlocksMade (EraCrypto era)
nesBcur = BlocksMade (EraCrypto era)
bs'}

-- | = New Epoch
--
-- Update the new epoch number, set the nonces, set the last applied block,
-- and reset blocks made.
-- Note: This function subsumes the manipulations done by
-- 'newLab', 'evolveNonceUnfrozen', and 'evolveNonceFrozen'.
newEpoch ::
  forall era.
  (ProtVerAtMost era 6, EraGov era) =>
  Block (BHeader (EraCrypto era)) era ->
  ChainState era ->
  ChainState era
newEpoch :: forall era.
(ProtVerAtMost era 6, EraGov era) =>
Block (BHeader (EraCrypto era)) era
-> ChainState era -> ChainState era
newEpoch Block (BHeader (EraCrypto era)) 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 (EraCrypto era))
chainLastAppliedBlock = WithOrigin (LastAppliedBlock (EraCrypto era))
lab
      } = ChainState era
cs
    bh :: BHeader (EraCrypto era)
bh = forall h era. Block h era -> h
bheader Block (BHeader (EraCrypto era)) era
b
    bn :: BlockNo
bn = forall c. BHBody c -> BlockNo
bheaderBlockNo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Crypto c => BHeader c -> BHBody c
bhbody forall a b. (a -> b) -> a -> b
$ BHeader (EraCrypto era)
bh
    sn :: SlotNo
sn = forall c. BHBody c -> SlotNo
bheaderSlotNo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Crypto c => BHeader c -> BHBody c
bhbody forall a b. (a -> b) -> a -> b
$ BHeader (EraCrypto era)
bh
    pp :: PParams era
pp = forall a s. Getting a s a -> s -> a
view forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. NewEpochState era -> EpochState era
nesEs forall a b. (a -> b) -> a -> b
$ NewEpochState era
nes
    e :: EpochNo
e = SlotNo -> EpochNo
epochFromSlotNo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. BHBody c -> SlotNo
bheaderSlotNo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Crypto c => BHeader c -> BHBody c
bhbody forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h era. Block h era -> h
bheader forall a b. (a -> b) -> a -> b
$ Block (BHeader (EraCrypto era)) era
b
    nes' :: NewEpochState era
nes' =
      NewEpochState era
nes
        { nesEL :: EpochNo
nesEL = EpochNo
e
        , nesBprev :: BlocksMade (EraCrypto era)
nesBprev = forall era. NewEpochState era -> BlocksMade (EraCrypto era)
nesBcur NewEpochState era
nes
        , nesBcur :: BlocksMade (EraCrypto era)
nesBcur = forall c. Map (KeyHash 'StakePool c) Natural -> BlocksMade c
BlocksMade forall k a. Map k a
Map.empty
        }
    n :: Nonce
n = forall era. Era era => Block (BHeader (EraCrypto era)) era -> Nonce
getBlockNonce Block (BHeader (EraCrypto era)) era
b
    cs' :: ChainState era
cs' =
      ChainState era
cs
        { chainNes :: NewEpochState era
chainNes = NewEpochState era
nes'
        , chainEpochNonce :: Nonce
chainEpochNonce = Nonce
cNonce Nonce -> Nonce -> Nonce
⭒ Nonce
pNonce Nonce -> Nonce -> Nonce
⭒ (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era.
(EraPParams era, ProtVerAtMost era 6) =>
Lens' (PParams era) Nonce
ppExtraEntropyL)
        , chainEvolvingNonce :: Nonce
chainEvolvingNonce = Nonce
evNonce Nonce -> Nonce -> Nonce
⭒ Nonce
n
        , chainCandidateNonce :: Nonce
chainCandidateNonce = Nonce
evNonce Nonce -> Nonce -> Nonce
⭒ Nonce
n
        , chainPrevEpochNonce :: Nonce
chainPrevEpochNonce = forall c. PrevHash c -> Nonce
prevHashToNonce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. WithOrigin (LastAppliedBlock c) -> PrevHash c
lastAppliedHash forall a b. (a -> b) -> a -> b
$ WithOrigin (LastAppliedBlock (EraCrypto era))
lab
        , chainLastAppliedBlock :: WithOrigin (LastAppliedBlock (EraCrypto era))
chainLastAppliedBlock = forall t. t -> WithOrigin t
At forall a b. (a -> b) -> a -> b
$ forall c. BlockNo -> SlotNo -> HashHeader c -> LastAppliedBlock c
LastAppliedBlock BlockNo
bn SlotNo
sn (forall c. Crypto c => BHeader c -> HashHeader c
bhHash BHeader (EraCrypto era)
bh)
        }

-- | = Set Current Proposals
--
-- Set the current protocol parameter proposals.
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 :: NewEpochState era
chainNes = NewEpochState era
nes'}
  where
    nes :: NewEpochState era
nes = forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
    es :: EpochState era
es = forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes
    ls :: LedgerState era
ls = forall era. EpochState era -> LedgerState era
esLState EpochState era
es
    utxoSt :: UTxOState era
utxoSt = forall era. LedgerState era -> UTxOState era
lsUTxOState LedgerState era
ls
    govState :: GovState era
govState = forall era. UTxOState era -> GovState era
utxosGovState UTxOState era
utxoSt
    pp :: PParams era
pp = forall era. ShelleyGovState era -> PParams era
sgsCurPParams GovState era
govState
    govState' :: ShelleyGovState era
govState' =
      GovState era
govState
        { sgsCurProposals :: ProposedPPUpdates era
sgsCurProposals = ProposedPPUpdates era
ps
        , sgsFuturePParams :: FuturePParams era
sgsFuturePParams =
            forall era. Maybe (PParams era) -> FuturePParams era
PotentialPParamsUpdate forall a b. (a -> b) -> a -> b
$ forall era.
EraPParams era =>
ProposedPPUpdates era
-> PParams era -> Word64 -> Maybe (PParams era)
votedFuturePParams ProposedPPUpdates era
ps PParams era
pp (Globals -> Word64
quorum Globals
testGlobals)
        }
    utxoSt' :: UTxOState era
utxoSt' = UTxOState era
utxoSt {utxosGovState :: GovState era
utxosGovState = ShelleyGovState era
govState'}
    ls' :: LedgerState era
ls' = LedgerState era
ls {lsUTxOState :: UTxOState era
lsUTxOState = UTxOState era
utxoSt'}
    es' :: EpochState era
es' = EpochState era
es {esLState :: LedgerState era
esLState = LedgerState era
ls'}
    nes' :: NewEpochState era
nes' = NewEpochState era
nes {nesEs :: EpochState era
nesEs = EpochState era
es'}

-- | = Set Future Proposals
--
-- Set the future protocol parameter proposals.
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 :: NewEpochState era
chainNes = NewEpochState era
nes'}
  where
    nes :: NewEpochState era
nes = forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
    es :: EpochState era
es = forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes
    ls :: LedgerState era
ls = forall era. EpochState era -> LedgerState era
esLState EpochState era
es
    utxoSt :: UTxOState era
utxoSt = forall era. LedgerState era -> UTxOState era
lsUTxOState LedgerState era
ls
    govState :: GovState era
govState = forall era. UTxOState era -> GovState era
utxosGovState UTxOState era
utxoSt
    govState' :: ShelleyGovState era
govState' = GovState era
govState {sgsFutureProposals :: ProposedPPUpdates era
sgsFutureProposals = ProposedPPUpdates era
ps}
    utxoSt' :: UTxOState era
utxoSt' = UTxOState era
utxoSt {utxosGovState :: GovState era
utxosGovState = ShelleyGovState era
govState'}
    ls' :: LedgerState era
ls' = LedgerState era
ls {lsUTxOState :: UTxOState era
lsUTxOState = UTxOState era
utxoSt'}
    es' :: EpochState era
es' = EpochState era
es {esLState :: LedgerState era
esLState = LedgerState era
ls'}
    nes' :: NewEpochState era
nes' = NewEpochState era
nes {nesEs :: EpochState era
nesEs = EpochState era
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 :: NewEpochState era
chainNes = NewEpochState era
nes {nesEs :: EpochState era
nesEs = EpochState era
es}}
  where
    nes :: NewEpochState era
nes = forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
    es :: EpochState era
es = forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes forall a b. a -> (a -> b) -> b
& forall era.
EraGov era =>
Lens' (EpochState era) (FuturePParams era)
futurePParamsEpochStateL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall era. FuturePParams era -> FuturePParams era
solidifyFuturePParams

-- | = Set the Protocol Proposals
--
-- Set the protocol parameters.
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 :: NewEpochState era
chainNes = NewEpochState era
nes'}
  where
    nes :: NewEpochState era
nes = forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
    es :: EpochState era
es = forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes
    es' :: EpochState era
es' = EpochState era
es forall a b. a -> (a -> b) -> b
& forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams era
pp
    nes' :: NewEpochState era
nes' = NewEpochState era
nes {nesEs :: EpochState era
nesEs = EpochState era
es'}

-- | = Set the Previous Protocol Proposals
--
-- Set the previous protocol parameters.
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 :: NewEpochState era
chainNes = NewEpochState era
nes'}
  where
    nes :: NewEpochState era
nes = forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
    es :: EpochState era
es = forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes
    es' :: EpochState era
es' = EpochState era
es forall a b. a -> (a -> b) -> b
& forall era. EraGov era => Lens' (EpochState era) (PParams era)
prevPParamsEpochStateL forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams era
pp
    nes' :: NewEpochState era
nes' = NewEpochState era
nes {nesEs :: EpochState era
nesEs = EpochState era
es'}

-- | = Set a future genesis delegation.
setFutureGenDeleg ::
  forall era.
  (FutureGenDeleg (EraCrypto era), GenDelegPair (EraCrypto era)) ->
  ChainState era ->
  ChainState era
setFutureGenDeleg :: forall era.
(FutureGenDeleg (EraCrypto era), GenDelegPair (EraCrypto era))
-> ChainState era -> ChainState era
setFutureGenDeleg (FutureGenDeleg (EraCrypto era)
fg, GenDelegPair (EraCrypto era)
gd) ChainState era
cs = ChainState era
cs {chainNes :: NewEpochState era
chainNes = NewEpochState era
nes'}
  where
    nes :: NewEpochState era
nes = forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
    es :: EpochState era
es = forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes
    ls :: LedgerState era
ls = forall era. EpochState era -> LedgerState era
esLState EpochState era
es
    dps :: CertState era
dps = forall era. LedgerState era -> CertState era
lsCertState LedgerState era
ls
    ds :: DState era
ds = forall era. CertState era -> DState era
certDState CertState era
dps
    ds' :: DState era
ds' = DState era
ds {dsFutureGenDelegs :: Map (FutureGenDeleg (EraCrypto era)) (GenDelegPair (EraCrypto era))
dsFutureGenDelegs = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert FutureGenDeleg (EraCrypto era)
fg GenDelegPair (EraCrypto era)
gd (forall era.
DState era
-> Map
     (FutureGenDeleg (EraCrypto era)) (GenDelegPair (EraCrypto era))
dsFutureGenDelegs DState era
ds)}
    dps' :: CertState era
dps' = CertState era
dps {certDState :: DState era
certDState = DState era
ds'}
    ls' :: LedgerState era
ls' = LedgerState era
ls {lsCertState :: CertState era
lsCertState = CertState era
dps'}
    es' :: EpochState era
es' = EpochState era
es {esLState :: LedgerState era
esLState = LedgerState era
ls'}
    nes' :: NewEpochState era
nes' = NewEpochState era
nes {nesEs :: EpochState era
nesEs = EpochState era
es'}

-- | = Set a future genesis delegation.
adoptFutureGenDeleg ::
  forall era.
  (FutureGenDeleg (EraCrypto era), GenDelegPair (EraCrypto era)) ->
  ChainState era ->
  ChainState era
adoptFutureGenDeleg :: forall era.
(FutureGenDeleg (EraCrypto era), GenDelegPair (EraCrypto era))
-> ChainState era -> ChainState era
adoptFutureGenDeleg (FutureGenDeleg (EraCrypto era)
fg, GenDelegPair (EraCrypto era)
gd) ChainState era
cs = ChainState era
cs {chainNes :: NewEpochState era
chainNes = NewEpochState era
nes'}
  where
    nes :: NewEpochState era
nes = forall era. ChainState era -> NewEpochState era
chainNes ChainState era
cs
    es :: EpochState era
es = forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes
    ls :: LedgerState era
ls = forall era. EpochState era -> LedgerState era
esLState EpochState era
es
    dps :: CertState era
dps = forall era. LedgerState era -> CertState era
lsCertState LedgerState era
ls
    ds :: DState era
ds = forall era. CertState era -> DState era
certDState CertState era
dps
    gds :: GenDelegs (EraCrypto era)
gds = forall c. Map (KeyHash 'Genesis c) (GenDelegPair c) -> GenDelegs c
GenDelegs forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (forall c. FutureGenDeleg c -> KeyHash 'Genesis c
fGenDelegGenKeyHash FutureGenDeleg (EraCrypto era)
fg) GenDelegPair (EraCrypto era)
gd (forall c. GenDelegs c -> Map (KeyHash 'Genesis c) (GenDelegPair c)
unGenDelegs (forall era. DState era -> GenDelegs (EraCrypto era)
dsGenDelegs DState era
ds))
    ds' :: DState era
ds' =
      DState era
ds
        { dsFutureGenDelegs :: Map (FutureGenDeleg (EraCrypto era)) (GenDelegPair (EraCrypto era))
dsFutureGenDelegs = forall k a. Ord k => k -> Map k a -> Map k a
Map.delete FutureGenDeleg (EraCrypto era)
fg (forall era.
DState era
-> Map
     (FutureGenDeleg (EraCrypto era)) (GenDelegPair (EraCrypto era))
dsFutureGenDelegs DState era
ds)
        , dsGenDelegs :: GenDelegs (EraCrypto era)
dsGenDelegs = GenDelegs (EraCrypto era)
gds
        }
    dps' :: CertState era
dps' = CertState era
dps {certDState :: DState era
certDState = DState era
ds'}
    ls' :: LedgerState era
ls' = LedgerState era
ls {lsCertState :: CertState era
lsCertState = CertState era
dps'}
    es' :: EpochState era
es' = EpochState era
es {esLState :: LedgerState era
esLState = LedgerState era
ls'}
    nes' :: NewEpochState era
nes' = NewEpochState era
nes {nesEs :: EpochState era
nesEs = EpochState era
es'}