{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Conway.Transition (
  ConwayEraTransition (..),
  TransitionConfig (..),
  registerDRepsThenDelegs,
  conwayRegisterInitialAccounts,
  conwayRegisterInitialFundsThenStaking,
  injectStakeCredentials,
  injectDRepsThenDelegs,
) where

import Cardano.Ledger.Babbage
import Cardano.Ledger.Babbage.Transition (
  TransitionConfig (BabbageTransitionConfig),
  alonzoInjectCostModels,
 )
import Cardano.Ledger.BaseTypes (Network (..))
import Cardano.Ledger.Coin (compactCoinOrError)
import Cardano.Ledger.Conway.Era
import Cardano.Ledger.Conway.Genesis (ConwayExtraConfig (..), ConwayGenesis (..))
import Cardano.Ledger.Conway.Rules.Deleg (processDelegation)
import Cardano.Ledger.Conway.State
import Cardano.Ledger.Conway.Translation ()
import Cardano.Ledger.Conway.TxCert (Delegatee (..))
import Cardano.Ledger.Core
import Cardano.Ledger.Credential (Credential (..))
import Cardano.Ledger.Shelley.Genesis (
  InjectionData,
  InjectionError (..),
  ShelleyGenesisStaking (..),
  foldInjectionData,
 )
import Cardano.Ledger.Shelley.LedgerState (
  NewEpochState,
  curPParamsEpochStateL,
  esLStateL,
  lsCertStateL,
  nesEsL,
 )
import Cardano.Ledger.Shelley.Transition hiding (injectStakeCredentials)
import Control.Monad (when)
import Control.Monad.Class.MonadST (MonadST)
import Control.Monad.Class.MonadThrow (MonadThrow (throwIO))
import Data.ListMap (ListMap)
import qualified Data.ListMap as ListMap
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import GHC.Generics
import GHC.Stack
import Lens.Micro
import NoThunks.Class (NoThunks (..))
import System.FS.API (HasFS)

class (EraTransition era, ConwayEraCertState era) => ConwayEraTransition era where
  tcConwayGenesisL :: Lens' (TransitionConfig era) ConwayGenesis
  default tcConwayGenesisL ::
    ConwayEraTransition (PreviousEra era) =>
    Lens' (TransitionConfig era) ConwayGenesis
  tcConwayGenesisL = (TransitionConfig (PreviousEra era)
 -> f (TransitionConfig (PreviousEra era)))
-> TransitionConfig era -> f (TransitionConfig era)
forall era.
(EraTransition era, EraTransition (PreviousEra era)) =>
Lens' (TransitionConfig era) (TransitionConfig (PreviousEra era))
Lens' (TransitionConfig era) (TransitionConfig (PreviousEra era))
tcPreviousEraConfigL ((TransitionConfig (PreviousEra era)
  -> f (TransitionConfig (PreviousEra era)))
 -> TransitionConfig era -> f (TransitionConfig era))
-> ((ConwayGenesis -> f ConwayGenesis)
    -> TransitionConfig (PreviousEra era)
    -> f (TransitionConfig (PreviousEra era)))
-> (ConwayGenesis -> f ConwayGenesis)
-> TransitionConfig era
-> f (TransitionConfig era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConwayGenesis -> f ConwayGenesis)
-> TransitionConfig (PreviousEra era)
-> f (TransitionConfig (PreviousEra era))
forall era.
ConwayEraTransition era =>
Lens' (TransitionConfig era) ConwayGenesis
Lens' (TransitionConfig (PreviousEra era)) ConwayGenesis
tcConwayGenesisL

registerDRepsThenDelegs ::
  forall era.
  ConwayEraTransition era =>
  TransitionConfig era ->
  NewEpochState era ->
  NewEpochState era
registerDRepsThenDelegs :: forall era.
ConwayEraTransition era =>
TransitionConfig era -> NewEpochState era -> NewEpochState era
registerDRepsThenDelegs TransitionConfig era
cfg =
  -- NOTE: The order of registration does not matter.
  NewEpochState era -> NewEpochState era
registerDelegs (NewEpochState era -> NewEpochState era)
-> (NewEpochState era -> NewEpochState era)
-> NewEpochState era
-> NewEpochState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> NewEpochState era
registerInitialDReps
  where
    registerInitialDReps :: NewEpochState era -> NewEpochState era
    registerInitialDReps :: NewEpochState era -> NewEpochState era
registerInitialDReps =
      (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 DRepRole) DRepState
     -> Identity (Map (Credential DRepRole) DRepState))
    -> EpochState era -> Identity (EpochState era))
-> (Map (Credential DRepRole) DRepState
    -> Identity (Map (Credential DRepRole) DRepState))
-> 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 DRepRole) DRepState
     -> Identity (Map (Credential DRepRole) DRepState))
    -> LedgerState era -> Identity (LedgerState era))
-> (Map (Credential DRepRole) DRepState
    -> Identity (Map (Credential DRepRole) DRepState))
-> 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 DRepRole) DRepState
     -> Identity (Map (Credential DRepRole) DRepState))
    -> CertState era -> Identity (CertState era))
-> (Map (Credential DRepRole) DRepState
    -> Identity (Map (Credential DRepRole) DRepState))
-> LedgerState era
-> Identity (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VState era -> Identity (VState era))
-> CertState era -> Identity (CertState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL ((VState era -> Identity (VState era))
 -> CertState era -> Identity (CertState era))
-> ((Map (Credential DRepRole) DRepState
     -> Identity (Map (Credential DRepRole) DRepState))
    -> VState era -> Identity (VState era))
-> (Map (Credential DRepRole) DRepState
    -> Identity (Map (Credential DRepRole) DRepState))
-> CertState era
-> Identity (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Credential DRepRole) DRepState
 -> Identity (Map (Credential DRepRole) DRepState))
-> VState era -> Identity (VState era)
forall era (f :: * -> *).
Functor f =>
(Map (Credential DRepRole) DRepState
 -> f (Map (Credential DRepRole) DRepState))
-> VState era -> f (VState era)
vsDRepsL ((Map (Credential DRepRole) DRepState
  -> Identity (Map (Credential DRepRole) DRepState))
 -> NewEpochState era -> Identity (NewEpochState era))
-> Map (Credential DRepRole) DRepState
-> NewEpochState era
-> NewEpochState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map (Credential DRepRole) DRepState
drepsMap
      where
        drepsMap :: Map (Credential DRepRole) DRepState
drepsMap = ListMap (Credential DRepRole) DRepState
-> Map (Credential DRepRole) DRepState
forall k v. Ord k => ListMap k v -> Map k v
ListMap.toMap (ListMap (Credential DRepRole) DRepState
 -> Map (Credential DRepRole) DRepState)
-> ListMap (Credential DRepRole) DRepState
-> Map (Credential DRepRole) DRepState
forall a b. (a -> b) -> a -> b
$ TransitionConfig era
cfg TransitionConfig era
-> Getting
     (ListMap (Credential DRepRole) DRepState)
     (TransitionConfig era)
     (ListMap (Credential DRepRole) DRepState)
-> ListMap (Credential DRepRole) DRepState
forall s a. s -> Getting a s a -> a
^. Getting
  (ListMap (Credential DRepRole) DRepState)
  (TransitionConfig era)
  (ListMap (Credential DRepRole) DRepState)
forall era.
ConwayEraTransition era =>
Lens'
  (TransitionConfig era) (ListMap (Credential DRepRole) DRepState)
Lens'
  (TransitionConfig era) (ListMap (Credential DRepRole) DRepState)
tcInitialDRepsL
    registerDelegs :: NewEpochState era -> NewEpochState era
    registerDelegs :: NewEpochState era -> NewEpochState era
registerDelegs =
      (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))
-> ((CertState era -> Identity (CertState era))
    -> EpochState era -> Identity (EpochState era))
-> (CertState era -> Identity (CertState 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))
-> ((CertState era -> Identity (CertState era))
    -> LedgerState era -> Identity (LedgerState era))
-> (CertState era -> Identity (CertState 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))
 -> NewEpochState era -> Identity (NewEpochState era))
-> (CertState era -> CertState era)
-> NewEpochState era
-> NewEpochState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \CertState era
certState -> ((Credential Staking, Delegatee) -> CertState era -> CertState era)
-> CertState era
-> ListMap (Credential Staking) Delegatee
-> CertState era
forall k a b. ((k, a) -> b -> b) -> b -> ListMap k a -> b
ListMap.foldrWithKey ((Credential Staking -> Delegatee -> CertState era -> CertState era)
-> (Credential Staking, Delegatee)
-> CertState era
-> CertState era
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Credential Staking -> Delegatee -> CertState era -> CertState era
forall era.
ConwayEraCertState era =>
Credential Staking -> Delegatee -> CertState era -> CertState era
processDelegation) CertState era
certState (TransitionConfig era
cfg TransitionConfig era
-> Getting
     (ListMap (Credential Staking) Delegatee)
     (TransitionConfig era)
     (ListMap (Credential Staking) Delegatee)
-> ListMap (Credential Staking) Delegatee
forall s a. s -> Getting a s a -> a
^. Getting
  (ListMap (Credential Staking) Delegatee)
  (TransitionConfig era)
  (ListMap (Credential Staking) Delegatee)
forall era.
ConwayEraTransition era =>
Lens'
  (TransitionConfig era) (ListMap (Credential Staking) Delegatee)
Lens'
  (TransitionConfig era) (ListMap (Credential Staking) Delegatee)
tcDelegsL)
{-# DEPRECATED registerDRepsThenDelegs "Use `injectDRepsThenDelegs` instead" #-}

injectDRepsThenDelegs ::
  (ConwayEraCertState era, MonadST m, MonadThrow m) =>
  Network ->
  HasFS m h ->
  InjectionData (Credential DRepRole) DRepState ->
  InjectionData (Credential Staking) Delegatee ->
  NewEpochState era ->
  m (NewEpochState era)
injectDRepsThenDelegs :: forall era (m :: * -> *) h.
(ConwayEraCertState era, MonadST m, MonadThrow m) =>
Network
-> HasFS m h
-> InjectionData (Credential DRepRole) DRepState
-> InjectionData (Credential Staking) Delegatee
-> NewEpochState era
-> m (NewEpochState era)
injectDRepsThenDelegs Network
network HasFS m h
fs InjectionData (Credential DRepRole) DRepState
drepsSource InjectionData (Credential Staking) Delegatee
delegsSource NewEpochState era
newEpochState = do
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Network
network Network -> Network -> Bool
forall a. Eq a => a -> a -> Bool
== Network
Mainnet) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ InjectionError -> m ()
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO InjectionError
InjectionNotAllowedOnMainnet
  -- NOTE: The order of registration does not matter.
  drepsMap <-
    HasFS m h
-> InjectionData (Credential DRepRole) DRepState
-> (Map (Credential DRepRole) DRepState
    -> (Credential DRepRole, DRepState)
    -> Map (Credential DRepRole) DRepState)
-> Map (Credential DRepRole) DRepState
-> m (Map (Credential DRepRole) DRepState)
forall k v (m :: * -> *) h acc.
(MonadST m, MonadThrow m, FromJSON v, FromJSONKey k) =>
HasFS m h
-> InjectionData k v -> (acc -> (k, v) -> acc) -> acc -> m acc
foldInjectionData
      HasFS m h
fs
      InjectionData (Credential DRepRole) DRepState
drepsSource
      (\ !Map (Credential DRepRole) DRepState
acc (Credential DRepRole
cred, DRepState
drepState) -> Credential DRepRole
-> DRepState
-> Map (Credential DRepRole) DRepState
-> Map (Credential DRepRole) DRepState
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Credential DRepRole
cred DRepState
drepState Map (Credential DRepRole) DRepState
acc)
      Map (Credential DRepRole) DRepState
forall k a. Map k a
Map.empty
  let newEpochState' = NewEpochState era
newEpochState 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 DRepRole) DRepState
     -> Identity (Map (Credential DRepRole) DRepState))
    -> EpochState era -> Identity (EpochState era))
-> (Map (Credential DRepRole) DRepState
    -> Identity (Map (Credential DRepRole) DRepState))
-> 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 DRepRole) DRepState
     -> Identity (Map (Credential DRepRole) DRepState))
    -> LedgerState era -> Identity (LedgerState era))
-> (Map (Credential DRepRole) DRepState
    -> Identity (Map (Credential DRepRole) DRepState))
-> 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 DRepRole) DRepState
     -> Identity (Map (Credential DRepRole) DRepState))
    -> CertState era -> Identity (CertState era))
-> (Map (Credential DRepRole) DRepState
    -> Identity (Map (Credential DRepRole) DRepState))
-> LedgerState era
-> Identity (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VState era -> Identity (VState era))
-> CertState era -> Identity (CertState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL ((VState era -> Identity (VState era))
 -> CertState era -> Identity (CertState era))
-> ((Map (Credential DRepRole) DRepState
     -> Identity (Map (Credential DRepRole) DRepState))
    -> VState era -> Identity (VState era))
-> (Map (Credential DRepRole) DRepState
    -> Identity (Map (Credential DRepRole) DRepState))
-> CertState era
-> Identity (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Credential DRepRole) DRepState
 -> Identity (Map (Credential DRepRole) DRepState))
-> VState era -> Identity (VState era)
forall era (f :: * -> *).
Functor f =>
(Map (Credential DRepRole) DRepState
 -> f (Map (Credential DRepRole) DRepState))
-> VState era -> f (VState era)
vsDRepsL ((Map (Credential DRepRole) DRepState
  -> Identity (Map (Credential DRepRole) DRepState))
 -> NewEpochState era -> Identity (NewEpochState era))
-> Map (Credential DRepRole) DRepState
-> NewEpochState era
-> NewEpochState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map (Credential DRepRole) DRepState
drepsMap
  updatedCertState <-
    foldInjectionData
      fs
      delegsSource
      (\ !CertState era
certState (Credential Staking
cred, Delegatee
delegatee) -> Credential Staking -> Delegatee -> CertState era -> CertState era
forall era.
ConwayEraCertState era =>
Credential Staking -> Delegatee -> CertState era -> CertState era
processDelegation Credential Staking
cred Delegatee
delegatee CertState era
certState)
      (newEpochState' ^. nesEsL . esLStateL . lsCertStateL)
  pure $ newEpochState' & nesEsL . esLStateL . lsCertStateL .~ updatedCertState

instance EraTransition ConwayEra where
  data TransitionConfig ConwayEra = ConwayTransitionConfig
    { TransitionConfig ConwayEra -> ConwayGenesis
ctcConwayGenesis :: !ConwayGenesis
    , TransitionConfig ConwayEra -> TransitionConfig BabbageEra
ctcBabbageTransitionConfig :: !(TransitionConfig BabbageEra)
    }
    deriving (Int -> TransitionConfig ConwayEra -> ShowS
[TransitionConfig ConwayEra] -> ShowS
TransitionConfig ConwayEra -> String
(Int -> TransitionConfig ConwayEra -> ShowS)
-> (TransitionConfig ConwayEra -> String)
-> ([TransitionConfig ConwayEra] -> ShowS)
-> Show (TransitionConfig ConwayEra)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TransitionConfig ConwayEra -> ShowS
showsPrec :: Int -> TransitionConfig ConwayEra -> ShowS
$cshow :: TransitionConfig ConwayEra -> String
show :: TransitionConfig ConwayEra -> String
$cshowList :: [TransitionConfig ConwayEra] -> ShowS
showList :: [TransitionConfig ConwayEra] -> ShowS
Show, TransitionConfig ConwayEra -> TransitionConfig ConwayEra -> Bool
(TransitionConfig ConwayEra -> TransitionConfig ConwayEra -> Bool)
-> (TransitionConfig ConwayEra
    -> TransitionConfig ConwayEra -> Bool)
-> Eq (TransitionConfig ConwayEra)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TransitionConfig ConwayEra -> TransitionConfig ConwayEra -> Bool
== :: TransitionConfig ConwayEra -> TransitionConfig ConwayEra -> Bool
$c/= :: TransitionConfig ConwayEra -> TransitionConfig ConwayEra -> Bool
/= :: TransitionConfig ConwayEra -> TransitionConfig ConwayEra -> Bool
Eq, (forall x.
 TransitionConfig ConwayEra -> Rep (TransitionConfig ConwayEra) x)
-> (forall x.
    Rep (TransitionConfig ConwayEra) x -> TransitionConfig ConwayEra)
-> Generic (TransitionConfig ConwayEra)
forall x.
Rep (TransitionConfig ConwayEra) x -> TransitionConfig ConwayEra
forall x.
TransitionConfig ConwayEra -> Rep (TransitionConfig ConwayEra) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
TransitionConfig ConwayEra -> Rep (TransitionConfig ConwayEra) x
from :: forall x.
TransitionConfig ConwayEra -> Rep (TransitionConfig ConwayEra) x
$cto :: forall x.
Rep (TransitionConfig ConwayEra) x -> TransitionConfig ConwayEra
to :: forall x.
Rep (TransitionConfig ConwayEra) x -> TransitionConfig ConwayEra
Generic)

  mkTransitionConfig :: TranslationContext ConwayEra
-> TransitionConfig (PreviousEra ConwayEra)
-> TransitionConfig ConwayEra
mkTransitionConfig = TranslationContext ConwayEra
-> TransitionConfig (PreviousEra ConwayEra)
-> TransitionConfig ConwayEra
ConwayGenesis
-> TransitionConfig BabbageEra -> TransitionConfig ConwayEra
ConwayTransitionConfig

  injectIntoTestState :: forall (m :: * -> *) h.
(HasCallStack, MonadST m, MonadThrow m) =>
HasFS m h
-> TransitionConfig ConwayEra
-> NewEpochState ConwayEra
-> m (NewEpochState ConwayEra)
injectIntoTestState HasFS m h
hasFS TransitionConfig ConwayEra
cfg NewEpochState ConwayEra
newEpochState =
    HasFS m h
-> TransitionConfig ConwayEra
-> NewEpochState ConwayEra
-> m (NewEpochState ConwayEra)
forall era (m :: * -> *) h.
(ConwayEraTransition era, HasCallStack, MonadST m, MonadThrow m) =>
HasFS m h
-> TransitionConfig era
-> NewEpochState era
-> m (NewEpochState era)
conwayRegisterInitialFundsThenStaking HasFS m h
hasFS TransitionConfig ConwayEra
cfg (NewEpochState ConwayEra -> m (NewEpochState ConwayEra))
-> NewEpochState ConwayEra -> m (NewEpochState ConwayEra)
forall a b. (a -> b) -> a -> b
$
      TransitionConfig AlonzoEra
-> NewEpochState ConwayEra -> NewEpochState ConwayEra
forall era.
(EraTransition era, AlonzoEraPParams era) =>
TransitionConfig AlonzoEra
-> NewEpochState era -> NewEpochState era
alonzoInjectCostModels (TransitionConfig ConwayEra
cfg TransitionConfig ConwayEra
-> Getting
     (TransitionConfig AlonzoEra)
     (TransitionConfig ConwayEra)
     (TransitionConfig AlonzoEra)
-> TransitionConfig AlonzoEra
forall s a. s -> Getting a s a -> a
^. (TransitionConfig (PreviousEra ConwayEra)
 -> Const
      (TransitionConfig AlonzoEra)
      (TransitionConfig (PreviousEra ConwayEra)))
-> TransitionConfig ConwayEra
-> Const (TransitionConfig AlonzoEra) (TransitionConfig ConwayEra)
(TransitionConfig BabbageEra
 -> Const
      (TransitionConfig AlonzoEra) (TransitionConfig BabbageEra))
-> TransitionConfig ConwayEra
-> Const (TransitionConfig AlonzoEra) (TransitionConfig ConwayEra)
forall era.
(EraTransition era, EraTransition (PreviousEra era)) =>
Lens' (TransitionConfig era) (TransitionConfig (PreviousEra era))
Lens'
  (TransitionConfig ConwayEra)
  (TransitionConfig (PreviousEra ConwayEra))
tcPreviousEraConfigL ((TransitionConfig BabbageEra
  -> Const
       (TransitionConfig AlonzoEra) (TransitionConfig BabbageEra))
 -> TransitionConfig ConwayEra
 -> Const (TransitionConfig AlonzoEra) (TransitionConfig ConwayEra))
-> ((TransitionConfig AlonzoEra
     -> Const (TransitionConfig AlonzoEra) (TransitionConfig AlonzoEra))
    -> TransitionConfig BabbageEra
    -> Const
         (TransitionConfig AlonzoEra) (TransitionConfig BabbageEra))
-> Getting
     (TransitionConfig AlonzoEra)
     (TransitionConfig ConwayEra)
     (TransitionConfig AlonzoEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TransitionConfig (PreviousEra BabbageEra)
 -> Const
      (TransitionConfig AlonzoEra)
      (TransitionConfig (PreviousEra BabbageEra)))
-> TransitionConfig BabbageEra
-> Const (TransitionConfig AlonzoEra) (TransitionConfig BabbageEra)
(TransitionConfig AlonzoEra
 -> Const (TransitionConfig AlonzoEra) (TransitionConfig AlonzoEra))
-> TransitionConfig BabbageEra
-> Const (TransitionConfig AlonzoEra) (TransitionConfig BabbageEra)
forall era.
(EraTransition era, EraTransition (PreviousEra era)) =>
Lens' (TransitionConfig era) (TransitionConfig (PreviousEra era))
Lens'
  (TransitionConfig BabbageEra)
  (TransitionConfig (PreviousEra BabbageEra))
tcPreviousEraConfigL) NewEpochState ConwayEra
newEpochState

  tcPreviousEraConfigL :: EraTransition (PreviousEra ConwayEra) =>
Lens'
  (TransitionConfig ConwayEra)
  (TransitionConfig (PreviousEra ConwayEra))
tcPreviousEraConfigL =
    (TransitionConfig ConwayEra -> TransitionConfig BabbageEra)
-> (TransitionConfig ConwayEra
    -> TransitionConfig BabbageEra -> TransitionConfig ConwayEra)
-> Lens
     (TransitionConfig ConwayEra)
     (TransitionConfig ConwayEra)
     (TransitionConfig BabbageEra)
     (TransitionConfig BabbageEra)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TransitionConfig ConwayEra -> TransitionConfig BabbageEra
ctcBabbageTransitionConfig (\TransitionConfig ConwayEra
ctc TransitionConfig BabbageEra
pc -> TransitionConfig ConwayEra
ctc {ctcBabbageTransitionConfig = pc})

  tcTranslationContextL :: Lens' (TransitionConfig ConwayEra) (TranslationContext ConwayEra)
tcTranslationContextL =
    (TransitionConfig ConwayEra -> ConwayGenesis)
-> (TransitionConfig ConwayEra
    -> ConwayGenesis -> TransitionConfig ConwayEra)
-> Lens
     (TransitionConfig ConwayEra)
     (TransitionConfig ConwayEra)
     ConwayGenesis
     ConwayGenesis
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TransitionConfig ConwayEra -> ConwayGenesis
ctcConwayGenesis (\TransitionConfig ConwayEra
ctc ConwayGenesis
ag -> TransitionConfig ConwayEra
ctc {ctcConwayGenesis = ag})

instance ConwayEraTransition ConwayEra where
  tcConwayGenesisL :: Lens
  (TransitionConfig ConwayEra)
  (TransitionConfig ConwayEra)
  ConwayGenesis
  ConwayGenesis
tcConwayGenesisL = (TransitionConfig ConwayEra -> ConwayGenesis)
-> (TransitionConfig ConwayEra
    -> ConwayGenesis -> TransitionConfig ConwayEra)
-> Lens
     (TransitionConfig ConwayEra)
     (TransitionConfig ConwayEra)
     ConwayGenesis
     ConwayGenesis
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TransitionConfig ConwayEra -> ConwayGenesis
ctcConwayGenesis (\TransitionConfig ConwayEra
g ConwayGenesis
x -> TransitionConfig ConwayEra
g {ctcConwayGenesis = x})

tcDelegsL ::
  ConwayEraTransition era => Lens' (TransitionConfig era) (ListMap (Credential Staking) Delegatee)
tcDelegsL :: forall era.
ConwayEraTransition era =>
Lens'
  (TransitionConfig era) (ListMap (Credential Staking) Delegatee)
tcDelegsL =
  String
-> (ListMap (Credential Staking) Delegatee -> Bool)
-> Lens'
     (TransitionConfig era) (ListMap (Credential Staking) Delegatee)
-> Lens'
     (TransitionConfig era) (ListMap (Credential Staking) Delegatee)
forall era a.
(HasCallStack, EraTransition era) =>
String
-> (a -> Bool)
-> Lens' (TransitionConfig era) a
-> Lens' (TransitionConfig era) a
protectMainnetLens String
"ConwayDelegs" ListMap (Credential Staking) Delegatee -> Bool
forall a. ListMap (Credential Staking) a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Lens'
   (TransitionConfig era) (ListMap (Credential Staking) Delegatee)
 -> Lens'
      (TransitionConfig era) (ListMap (Credential Staking) Delegatee))
-> Lens'
     (TransitionConfig era) (ListMap (Credential Staking) Delegatee)
-> Lens'
     (TransitionConfig era) (ListMap (Credential Staking) Delegatee)
forall a b. (a -> b) -> a -> b
$
    (ConwayGenesis -> f ConwayGenesis)
-> TransitionConfig era -> f (TransitionConfig era)
forall era.
ConwayEraTransition era =>
Lens' (TransitionConfig era) ConwayGenesis
Lens' (TransitionConfig era) ConwayGenesis
tcConwayGenesisL ((ConwayGenesis -> f ConwayGenesis)
 -> TransitionConfig era -> f (TransitionConfig era))
-> ((ListMap (Credential Staking) Delegatee
     -> f (ListMap (Credential Staking) Delegatee))
    -> ConwayGenesis -> f ConwayGenesis)
-> (ListMap (Credential Staking) Delegatee
    -> f (ListMap (Credential Staking) Delegatee))
-> TransitionConfig era
-> f (TransitionConfig era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConwayGenesis -> ListMap (Credential Staking) Delegatee)
-> (ConwayGenesis
    -> ListMap (Credential Staking) Delegatee -> ConwayGenesis)
-> Lens
     ConwayGenesis
     ConwayGenesis
     (ListMap (Credential Staking) Delegatee)
     (ListMap (Credential Staking) Delegatee)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ConwayGenesis -> ListMap (Credential Staking) Delegatee
cgDelegs (\ConwayGenesis
g ListMap (Credential Staking) Delegatee
x -> ConwayGenesis
g {cgDelegs = x})

tcInitialDRepsL ::
  ConwayEraTransition era => Lens' (TransitionConfig era) (ListMap (Credential DRepRole) DRepState)
tcInitialDRepsL :: forall era.
ConwayEraTransition era =>
Lens'
  (TransitionConfig era) (ListMap (Credential DRepRole) DRepState)
tcInitialDRepsL =
  String
-> (ListMap (Credential DRepRole) DRepState -> Bool)
-> Lens'
     (TransitionConfig era) (ListMap (Credential DRepRole) DRepState)
-> Lens'
     (TransitionConfig era) (ListMap (Credential DRepRole) DRepState)
forall era a.
(HasCallStack, EraTransition era) =>
String
-> (a -> Bool)
-> Lens' (TransitionConfig era) a
-> Lens' (TransitionConfig era) a
protectMainnetLens String
"InitialDReps" ListMap (Credential DRepRole) DRepState -> Bool
forall a. ListMap (Credential DRepRole) a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Lens'
   (TransitionConfig era) (ListMap (Credential DRepRole) DRepState)
 -> Lens'
      (TransitionConfig era) (ListMap (Credential DRepRole) DRepState))
-> Lens'
     (TransitionConfig era) (ListMap (Credential DRepRole) DRepState)
-> Lens'
     (TransitionConfig era) (ListMap (Credential DRepRole) DRepState)
forall a b. (a -> b) -> a -> b
$
    (ConwayGenesis -> f ConwayGenesis)
-> TransitionConfig era -> f (TransitionConfig era)
forall era.
ConwayEraTransition era =>
Lens' (TransitionConfig era) ConwayGenesis
Lens' (TransitionConfig era) ConwayGenesis
tcConwayGenesisL ((ConwayGenesis -> f ConwayGenesis)
 -> TransitionConfig era -> f (TransitionConfig era))
-> ((ListMap (Credential DRepRole) DRepState
     -> f (ListMap (Credential DRepRole) DRepState))
    -> ConwayGenesis -> f ConwayGenesis)
-> (ListMap (Credential DRepRole) DRepState
    -> f (ListMap (Credential DRepRole) DRepState))
-> TransitionConfig era
-> f (TransitionConfig era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConwayGenesis -> ListMap (Credential DRepRole) DRepState)
-> (ConwayGenesis
    -> ListMap (Credential DRepRole) DRepState -> ConwayGenesis)
-> Lens
     ConwayGenesis
     ConwayGenesis
     (ListMap (Credential DRepRole) DRepState)
     (ListMap (Credential DRepRole) DRepState)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ConwayGenesis -> ListMap (Credential DRepRole) DRepState
cgInitialDReps (\ConwayGenesis
g ListMap (Credential DRepRole) DRepState
x -> ConwayGenesis
g {cgInitialDReps = x})

instance NoThunks (TransitionConfig ConwayEra)

conwayRegisterInitialFundsThenStaking ::
  (ConwayEraTransition era, HasCallStack, MonadST m, MonadThrow m) =>
  HasFS m h ->
  TransitionConfig era ->
  NewEpochState era ->
  m (NewEpochState era)
conwayRegisterInitialFundsThenStaking :: forall era (m :: * -> *) h.
(ConwayEraTransition era, HasCallStack, MonadST m, MonadThrow m) =>
HasFS m h
-> TransitionConfig era
-> NewEpochState era
-> m (NewEpochState era)
conwayRegisterInitialFundsThenStaking HasFS m h
hasFS TransitionConfig era
cfg NewEpochState era
newEpochState = do
  let cg :: ConwayGenesis
cg = TransitionConfig era
cfg TransitionConfig era
-> Getting ConwayGenesis (TransitionConfig era) ConwayGenesis
-> ConwayGenesis
forall s a. s -> Getting a s a -> a
^. Getting ConwayGenesis (TransitionConfig era) ConwayGenesis
forall era.
ConwayEraTransition era =>
Lens' (TransitionConfig era) ConwayGenesis
Lens' (TransitionConfig era) ConwayGenesis
tcConwayGenesisL
      network :: Network
network = TransitionConfig era
cfg TransitionConfig era
-> Getting Network (TransitionConfig era) Network -> Network
forall s a. s -> Getting a s a -> a
^. Getting Network (TransitionConfig era) Network
forall era.
EraTransition era =>
SimpleGetter (TransitionConfig era) Network
SimpleGetter (TransitionConfig era) Network
tcNetworkIDG
  drepsSource <-
    String
-> StrictMaybe ConwayExtraConfig
-> (ConwayExtraConfig
    -> InjectionData (Credential DRepRole) DRepState)
-> ListMap (Credential DRepRole) DRepState
-> m (InjectionData (Credential DRepRole) DRepState)
forall (m :: * -> *) extraConfig k v.
MonadThrow m =>
String
-> StrictMaybe extraConfig
-> (extraConfig -> InjectionData k v)
-> ListMap k v
-> m (InjectionData k v)
resolveInjectionSource String
"initialDReps" (ConwayGenesis -> StrictMaybe ConwayExtraConfig
cgExtraConfig ConwayGenesis
cg) ConwayExtraConfig -> InjectionData (Credential DRepRole) DRepState
cecInitialDReps (ConwayGenesis -> ListMap (Credential DRepRole) DRepState
cgInitialDReps ConwayGenesis
cg)
  delegsSource <- resolveInjectionSource "delegs" (cgExtraConfig cg) cecDelegs (cgDelegs cg)
  fmap resetStakeDistribution $
    injectInitialFundsAndStaking hasFS injectStakeCredentials cfg newEpochState
      >>= injectDRepsThenDelegs network hasFS drepsSource delegsSource

-- | Register all staking credentials and apply delegations. Make sure StakePools that are being
-- delegated to are already registered, which can be done with `registerInitialStakePools`.
conwayRegisterInitialAccounts ::
  forall era.
  (HasCallStack, EraTransition era, ConwayEraAccounts era) =>
  ShelleyGenesisStaking ->
  NewEpochState era ->
  NewEpochState era
conwayRegisterInitialAccounts :: forall era.
(HasCallStack, EraTransition era, ConwayEraAccounts era) =>
ShelleyGenesisStaking -> NewEpochState era -> NewEpochState era
conwayRegisterInitialAccounts ShelleyGenesisStaking {ListMap (KeyHash Staking) (KeyHash StakePool)
sgsStake :: ListMap (KeyHash Staking) (KeyHash StakePool)
sgsStake :: ShelleyGenesisStaking
-> ListMap (KeyHash Staking) (KeyHash StakePool)
sgsStake} NewEpochState era
nes =
  NewEpochState era
nes
    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
updatedAccounts
    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) StakePoolState
     -> Identity (Map (KeyHash StakePool) StakePoolState))
    -> EpochState era -> Identity (EpochState era))
-> (Map (KeyHash StakePool) StakePoolState
    -> Identity (Map (KeyHash StakePool) StakePoolState))
-> 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) StakePoolState
     -> Identity (Map (KeyHash StakePool) StakePoolState))
    -> LedgerState era -> Identity (LedgerState era))
-> (Map (KeyHash StakePool) StakePoolState
    -> Identity (Map (KeyHash StakePool) StakePoolState))
-> 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) StakePoolState
     -> Identity (Map (KeyHash StakePool) StakePoolState))
    -> CertState era -> Identity (CertState era))
-> (Map (KeyHash StakePool) StakePoolState
    -> Identity (Map (KeyHash StakePool) StakePoolState))
-> 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) StakePoolState
     -> Identity (Map (KeyHash StakePool) StakePoolState))
    -> PState era -> Identity (PState era))
-> (Map (KeyHash StakePool) StakePoolState
    -> Identity (Map (KeyHash StakePool) StakePoolState))
-> CertState era
-> Identity (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (KeyHash StakePool) StakePoolState
 -> Identity (Map (KeyHash StakePool) StakePoolState))
-> PState era -> Identity (PState era)
forall era (f :: * -> *).
Functor f =>
(Map (KeyHash StakePool) StakePoolState
 -> f (Map (KeyHash StakePool) StakePoolState))
-> PState era -> f (PState era)
psStakePoolsL ((Map (KeyHash StakePool) StakePoolState
  -> Identity (Map (KeyHash StakePool) StakePoolState))
 -> NewEpochState era -> Identity (NewEpochState era))
-> Map (KeyHash StakePool) StakePoolState
-> NewEpochState era
-> NewEpochState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map (KeyHash StakePool) StakePoolState
updatedStakePoolStates
  where
    stakePools :: Map (KeyHash StakePool) StakePoolState
stakePools = NewEpochState era
nes NewEpochState era
-> Getting
     (Map (KeyHash StakePool) StakePoolState)
     (NewEpochState era)
     (Map (KeyHash StakePool) StakePoolState)
-> Map (KeyHash StakePool) StakePoolState
forall s a. s -> Getting a s a -> a
^. (EpochState era
 -> Const (Map (KeyHash StakePool) StakePoolState) (EpochState era))
-> NewEpochState era
-> Const
     (Map (KeyHash StakePool) StakePoolState) (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era
  -> Const (Map (KeyHash StakePool) StakePoolState) (EpochState era))
 -> NewEpochState era
 -> Const
      (Map (KeyHash StakePool) StakePoolState) (NewEpochState era))
-> ((Map (KeyHash StakePool) StakePoolState
     -> Const
          (Map (KeyHash StakePool) StakePoolState)
          (Map (KeyHash StakePool) StakePoolState))
    -> EpochState era
    -> Const (Map (KeyHash StakePool) StakePoolState) (EpochState era))
-> Getting
     (Map (KeyHash StakePool) StakePoolState)
     (NewEpochState era)
     (Map (KeyHash StakePool) StakePoolState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era
 -> Const
      (Map (KeyHash StakePool) StakePoolState) (LedgerState era))
-> EpochState era
-> Const (Map (KeyHash StakePool) StakePoolState) (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era
  -> Const
       (Map (KeyHash StakePool) StakePoolState) (LedgerState era))
 -> EpochState era
 -> Const (Map (KeyHash StakePool) StakePoolState) (EpochState era))
-> ((Map (KeyHash StakePool) StakePoolState
     -> Const
          (Map (KeyHash StakePool) StakePoolState)
          (Map (KeyHash StakePool) StakePoolState))
    -> LedgerState era
    -> Const
         (Map (KeyHash StakePool) StakePoolState) (LedgerState era))
-> (Map (KeyHash StakePool) StakePoolState
    -> Const
         (Map (KeyHash StakePool) StakePoolState)
         (Map (KeyHash StakePool) StakePoolState))
-> EpochState era
-> Const (Map (KeyHash StakePool) StakePoolState) (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era
 -> Const (Map (KeyHash StakePool) StakePoolState) (CertState era))
-> LedgerState era
-> Const (Map (KeyHash StakePool) StakePoolState) (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era
  -> Const (Map (KeyHash StakePool) StakePoolState) (CertState era))
 -> LedgerState era
 -> Const
      (Map (KeyHash StakePool) StakePoolState) (LedgerState era))
-> ((Map (KeyHash StakePool) StakePoolState
     -> Const
          (Map (KeyHash StakePool) StakePoolState)
          (Map (KeyHash StakePool) StakePoolState))
    -> CertState era
    -> Const (Map (KeyHash StakePool) StakePoolState) (CertState era))
-> (Map (KeyHash StakePool) StakePoolState
    -> Const
         (Map (KeyHash StakePool) StakePoolState)
         (Map (KeyHash StakePool) StakePoolState))
-> LedgerState era
-> Const (Map (KeyHash StakePool) StakePoolState) (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PState era
 -> Const (Map (KeyHash StakePool) StakePoolState) (PState era))
-> CertState era
-> Const (Map (KeyHash StakePool) StakePoolState) (CertState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
certPStateL ((PState era
  -> Const (Map (KeyHash StakePool) StakePoolState) (PState era))
 -> CertState era
 -> Const (Map (KeyHash StakePool) StakePoolState) (CertState era))
-> ((Map (KeyHash StakePool) StakePoolState
     -> Const
          (Map (KeyHash StakePool) StakePoolState)
          (Map (KeyHash StakePool) StakePoolState))
    -> PState era
    -> Const (Map (KeyHash StakePool) StakePoolState) (PState era))
-> (Map (KeyHash StakePool) StakePoolState
    -> Const
         (Map (KeyHash StakePool) StakePoolState)
         (Map (KeyHash StakePool) StakePoolState))
-> CertState era
-> Const (Map (KeyHash StakePool) StakePoolState) (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (KeyHash StakePool) StakePoolState
 -> Const
      (Map (KeyHash StakePool) StakePoolState)
      (Map (KeyHash StakePool) StakePoolState))
-> PState era
-> Const (Map (KeyHash StakePool) StakePoolState) (PState era)
forall era (f :: * -> *).
Functor f =>
(Map (KeyHash StakePool) StakePoolState
 -> f (Map (KeyHash StakePool) StakePoolState))
-> PState era -> f (PState era)
psStakePoolsL
    initialAccounts :: Accounts era
initialAccounts = NewEpochState era
nes 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
    deposit :: CompactForm Coin
deposit = HasCallStack => Coin -> CompactForm Coin
Coin -> CompactForm Coin
compactCoinOrError (Coin -> CompactForm Coin) -> Coin -> CompactForm Coin
forall a b. (a -> b) -> a -> b
$ NewEpochState era
nes 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, HasCallStack) =>
Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL

    !(!Accounts era
updatedAccounts, !Map (KeyHash StakePool) StakePoolState
updatedStakePoolStates) =
      ((KeyHash Staking, KeyHash StakePool)
 -> (Accounts era, Map (KeyHash StakePool) StakePoolState)
 -> (Accounts era, Map (KeyHash StakePool) StakePoolState))
-> (Accounts era, Map (KeyHash StakePool) StakePoolState)
-> [(KeyHash Staking, KeyHash StakePool)]
-> (Accounts era, Map (KeyHash StakePool) StakePoolState)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (KeyHash Staking, KeyHash StakePool)
-> (Accounts era, Map (KeyHash StakePool) StakePoolState)
-> (Accounts era, Map (KeyHash StakePool) StakePoolState)
registerAndDelegate (Accounts era
initialAccounts, Map (KeyHash StakePool) StakePoolState
stakePools) (ListMap (KeyHash Staking) (KeyHash StakePool)
-> [(KeyHash Staking, KeyHash StakePool)]
forall k v. ListMap k v -> [(k, v)]
ListMap.toList ListMap (KeyHash Staking) (KeyHash StakePool)
sgsStake)
    registerAndDelegate :: (KeyHash Staking, KeyHash StakePool)
-> (Accounts era, Map (KeyHash StakePool) StakePoolState)
-> (Accounts era, Map (KeyHash StakePool) StakePoolState)
registerAndDelegate (KeyHash Staking
stakeKeyHash, KeyHash StakePool
stakePool) (!Accounts era
accounts, !Map (KeyHash StakePool) StakePoolState
stakePoolMap)
      | KeyHash StakePool
stakePool KeyHash StakePool -> Map (KeyHash StakePool) StakePoolState -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map (KeyHash StakePool) StakePoolState
stakePools =
          ( (Credential Staking
-> CompactForm Coin
-> Maybe Delegatee
-> Accounts era
-> Accounts era
forall era.
ConwayEraAccounts era =>
Credential Staking
-> CompactForm Coin
-> Maybe Delegatee
-> Accounts era
-> Accounts era
registerConwayAccount (KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash Staking
stakeKeyHash) CompactForm Coin
deposit (Delegatee -> Maybe Delegatee
forall a. a -> Maybe a
Just (KeyHash StakePool -> Delegatee
DelegStake KeyHash StakePool
stakePool)) Accounts era
accounts)
          , (StakePoolState -> StakePoolState)
-> KeyHash StakePool
-> Map (KeyHash StakePool) StakePoolState
-> Map (KeyHash StakePool) StakePoolState
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust ((Set (Credential Staking) -> Identity (Set (Credential Staking)))
-> StakePoolState -> Identity StakePoolState
Lens' StakePoolState (Set (Credential Staking))
spsDelegatorsL ((Set (Credential Staking) -> Identity (Set (Credential Staking)))
 -> StakePoolState -> Identity StakePoolState)
-> (Set (Credential Staking) -> Set (Credential Staking))
-> StakePoolState
-> StakePoolState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Credential Staking
-> Set (Credential Staking) -> Set (Credential Staking)
forall a. Ord a => a -> Set a -> Set a
Set.insert (KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash Staking
stakeKeyHash)) KeyHash StakePool
stakePool Map (KeyHash StakePool) StakePoolState
stakePoolMap
          )
      | Bool
otherwise = String -> (Accounts era, Map (KeyHash StakePool) StakePoolState)
forall a. HasCallStack => String -> a
error (String -> (Accounts era, Map (KeyHash StakePool) StakePoolState))
-> String -> (Accounts era, Map (KeyHash StakePool) StakePoolState)
forall a b. (a -> b) -> a -> b
$ KeyHash Staking -> KeyHash StakePool -> String
forall a b. (Show a, Show b) => a -> b -> String
delegationInvariantMsg KeyHash Staking
stakeKeyHash KeyHash StakePool
stakePool
{-# DEPRECATED conwayRegisterInitialAccounts "Use `injectStakeCredentials` instead" #-}

injectStakeCredentials ::
  (ConwayEraAccounts era, EraCertState era, EraGov era, MonadST m, MonadThrow m) =>
  Network ->
  HasFS m h ->
  InjectionData (KeyHash Staking) (KeyHash StakePool) ->
  NewEpochState era ->
  m (NewEpochState era)
injectStakeCredentials :: forall era (m :: * -> *) h.
(ConwayEraAccounts era, EraCertState era, EraGov era, MonadST m,
 MonadThrow m) =>
Network
-> HasFS m h
-> InjectionData (KeyHash Staking) (KeyHash StakePool)
-> NewEpochState era
-> m (NewEpochState era)
injectStakeCredentials Network
network HasFS m h
fs InjectionData (KeyHash Staking) (KeyHash StakePool)
source NewEpochState era
newEpochState = do
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Network
network Network -> Network -> Bool
forall a. Eq a => a -> a -> Bool
== Network
Mainnet) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ InjectionError -> m ()
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO InjectionError
InjectionNotAllowedOnMainnet
  let stakePools :: Map (KeyHash StakePool) StakePoolState
stakePools = NewEpochState era
newEpochState NewEpochState era
-> Getting
     (Map (KeyHash StakePool) StakePoolState)
     (NewEpochState era)
     (Map (KeyHash StakePool) StakePoolState)
-> Map (KeyHash StakePool) StakePoolState
forall s a. s -> Getting a s a -> a
^. (EpochState era
 -> Const (Map (KeyHash StakePool) StakePoolState) (EpochState era))
-> NewEpochState era
-> Const
     (Map (KeyHash StakePool) StakePoolState) (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era
  -> Const (Map (KeyHash StakePool) StakePoolState) (EpochState era))
 -> NewEpochState era
 -> Const
      (Map (KeyHash StakePool) StakePoolState) (NewEpochState era))
-> ((Map (KeyHash StakePool) StakePoolState
     -> Const
          (Map (KeyHash StakePool) StakePoolState)
          (Map (KeyHash StakePool) StakePoolState))
    -> EpochState era
    -> Const (Map (KeyHash StakePool) StakePoolState) (EpochState era))
-> Getting
     (Map (KeyHash StakePool) StakePoolState)
     (NewEpochState era)
     (Map (KeyHash StakePool) StakePoolState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era
 -> Const
      (Map (KeyHash StakePool) StakePoolState) (LedgerState era))
-> EpochState era
-> Const (Map (KeyHash StakePool) StakePoolState) (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era
  -> Const
       (Map (KeyHash StakePool) StakePoolState) (LedgerState era))
 -> EpochState era
 -> Const (Map (KeyHash StakePool) StakePoolState) (EpochState era))
-> ((Map (KeyHash StakePool) StakePoolState
     -> Const
          (Map (KeyHash StakePool) StakePoolState)
          (Map (KeyHash StakePool) StakePoolState))
    -> LedgerState era
    -> Const
         (Map (KeyHash StakePool) StakePoolState) (LedgerState era))
-> (Map (KeyHash StakePool) StakePoolState
    -> Const
         (Map (KeyHash StakePool) StakePoolState)
         (Map (KeyHash StakePool) StakePoolState))
-> EpochState era
-> Const (Map (KeyHash StakePool) StakePoolState) (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era
 -> Const (Map (KeyHash StakePool) StakePoolState) (CertState era))
-> LedgerState era
-> Const (Map (KeyHash StakePool) StakePoolState) (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era
  -> Const (Map (KeyHash StakePool) StakePoolState) (CertState era))
 -> LedgerState era
 -> Const
      (Map (KeyHash StakePool) StakePoolState) (LedgerState era))
-> ((Map (KeyHash StakePool) StakePoolState
     -> Const
          (Map (KeyHash StakePool) StakePoolState)
          (Map (KeyHash StakePool) StakePoolState))
    -> CertState era
    -> Const (Map (KeyHash StakePool) StakePoolState) (CertState era))
-> (Map (KeyHash StakePool) StakePoolState
    -> Const
         (Map (KeyHash StakePool) StakePoolState)
         (Map (KeyHash StakePool) StakePoolState))
-> LedgerState era
-> Const (Map (KeyHash StakePool) StakePoolState) (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PState era
 -> Const (Map (KeyHash StakePool) StakePoolState) (PState era))
-> CertState era
-> Const (Map (KeyHash StakePool) StakePoolState) (CertState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
certPStateL ((PState era
  -> Const (Map (KeyHash StakePool) StakePoolState) (PState era))
 -> CertState era
 -> Const (Map (KeyHash StakePool) StakePoolState) (CertState era))
-> ((Map (KeyHash StakePool) StakePoolState
     -> Const
          (Map (KeyHash StakePool) StakePoolState)
          (Map (KeyHash StakePool) StakePoolState))
    -> PState era
    -> Const (Map (KeyHash StakePool) StakePoolState) (PState era))
-> (Map (KeyHash StakePool) StakePoolState
    -> Const
         (Map (KeyHash StakePool) StakePoolState)
         (Map (KeyHash StakePool) StakePoolState))
-> CertState era
-> Const (Map (KeyHash StakePool) StakePoolState) (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (KeyHash StakePool) StakePoolState
 -> Const
      (Map (KeyHash StakePool) StakePoolState)
      (Map (KeyHash StakePool) StakePoolState))
-> PState era
-> Const (Map (KeyHash StakePool) StakePoolState) (PState era)
forall era (f :: * -> *).
Functor f =>
(Map (KeyHash StakePool) StakePoolState
 -> f (Map (KeyHash StakePool) StakePoolState))
-> PState era -> f (PState era)
psStakePoolsL
      initialAccounts :: Accounts era
initialAccounts = NewEpochState era
newEpochState 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
      deposit :: CompactForm Coin
deposit = NewEpochState era
newEpochState NewEpochState era
-> Getting
     (CompactForm Coin) (NewEpochState era) (CompactForm Coin)
-> CompactForm Coin
forall s a. s -> Getting a s a -> a
^. (EpochState era -> Const (CompactForm Coin) (EpochState era))
-> NewEpochState era
-> Const (CompactForm Coin) (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const (CompactForm Coin) (EpochState era))
 -> NewEpochState era
 -> Const (CompactForm Coin) (NewEpochState era))
-> ((CompactForm Coin
     -> Const (CompactForm Coin) (CompactForm Coin))
    -> EpochState era -> Const (CompactForm Coin) (EpochState era))
-> Getting
     (CompactForm Coin) (NewEpochState era) (CompactForm Coin)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const (CompactForm Coin) (PParams era))
-> EpochState era -> Const (CompactForm Coin) (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const (CompactForm Coin) (PParams era))
 -> EpochState era -> Const (CompactForm Coin) (EpochState era))
-> ((CompactForm Coin
     -> Const (CompactForm Coin) (CompactForm Coin))
    -> PParams era -> Const (CompactForm Coin) (PParams era))
-> (CompactForm Coin
    -> Const (CompactForm Coin) (CompactForm Coin))
-> EpochState era
-> Const (CompactForm Coin) (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CompactForm Coin -> Const (CompactForm Coin) (CompactForm Coin))
-> PParams era -> Const (CompactForm Coin) (PParams era)
forall era.
EraPParams era =>
Lens' (PParams era) (CompactForm Coin)
Lens' (PParams era) (CompactForm Coin)
ppKeyDepositCompactL
      registerAndDelegate :: (Accounts era, Map (KeyHash StakePool) StakePoolState)
-> (KeyHash Staking, KeyHash StakePool)
-> (Accounts era, Map (KeyHash StakePool) StakePoolState)
registerAndDelegate (!Accounts era
accounts, !Map (KeyHash StakePool) StakePoolState
stakePoolMap) (KeyHash Staking
stakeKeyHash, KeyHash StakePool
stakePool)
        | KeyHash StakePool
stakePool KeyHash StakePool -> Map (KeyHash StakePool) StakePoolState -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map (KeyHash StakePool) StakePoolState
stakePools =
            ( Credential Staking
-> CompactForm Coin
-> Maybe Delegatee
-> Accounts era
-> Accounts era
forall era.
ConwayEraAccounts era =>
Credential Staking
-> CompactForm Coin
-> Maybe Delegatee
-> Accounts era
-> Accounts era
registerConwayAccount (KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash Staking
stakeKeyHash) CompactForm Coin
deposit (Delegatee -> Maybe Delegatee
forall a. a -> Maybe a
Just (KeyHash StakePool -> Delegatee
DelegStake KeyHash StakePool
stakePool)) Accounts era
accounts
            , (StakePoolState -> StakePoolState)
-> KeyHash StakePool
-> Map (KeyHash StakePool) StakePoolState
-> Map (KeyHash StakePool) StakePoolState
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust ((Set (Credential Staking) -> Identity (Set (Credential Staking)))
-> StakePoolState -> Identity StakePoolState
Lens' StakePoolState (Set (Credential Staking))
spsDelegatorsL ((Set (Credential Staking) -> Identity (Set (Credential Staking)))
 -> StakePoolState -> Identity StakePoolState)
-> (Set (Credential Staking) -> Set (Credential Staking))
-> StakePoolState
-> StakePoolState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Credential Staking
-> Set (Credential Staking) -> Set (Credential Staking)
forall a. Ord a => a -> Set a -> Set a
Set.insert (KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash Staking
stakeKeyHash)) KeyHash StakePool
stakePool Map (KeyHash StakePool) StakePoolState
stakePoolMap
            )
        | Bool
otherwise = String -> (Accounts era, Map (KeyHash StakePool) StakePoolState)
forall a. HasCallStack => String -> a
error (String -> (Accounts era, Map (KeyHash StakePool) StakePoolState))
-> String -> (Accounts era, Map (KeyHash StakePool) StakePoolState)
forall a b. (a -> b) -> a -> b
$ KeyHash Staking -> KeyHash StakePool -> String
forall a b. (Show a, Show b) => a -> b -> String
delegationInvariantMsg KeyHash Staking
stakeKeyHash KeyHash StakePool
stakePool
  (!updatedAccounts, !updatedPools) <-
    HasFS m h
-> InjectionData (KeyHash Staking) (KeyHash StakePool)
-> ((Accounts era, Map (KeyHash StakePool) StakePoolState)
    -> (KeyHash Staking, KeyHash StakePool)
    -> (Accounts era, Map (KeyHash StakePool) StakePoolState))
-> (Accounts era, Map (KeyHash StakePool) StakePoolState)
-> m (Accounts era, Map (KeyHash StakePool) StakePoolState)
forall k v (m :: * -> *) h acc.
(MonadST m, MonadThrow m, FromJSON v, FromJSONKey k) =>
HasFS m h
-> InjectionData k v -> (acc -> (k, v) -> acc) -> acc -> m acc
foldInjectionData HasFS m h
fs InjectionData (KeyHash Staking) (KeyHash StakePool)
source (Accounts era, Map (KeyHash StakePool) StakePoolState)
-> (KeyHash Staking, KeyHash StakePool)
-> (Accounts era, Map (KeyHash StakePool) StakePoolState)
registerAndDelegate (Accounts era
initialAccounts, Map (KeyHash StakePool) StakePoolState
stakePools)
  pure $
    newEpochState
      & nesEsL . esLStateL . lsCertStateL . certDStateL . accountsL .~ updatedAccounts
      & nesEsL . esLStateL . lsCertStateL . certPStateL . psStakePoolsL .~ updatedPools

delegationInvariantMsg :: (Show a, Show b) => a -> b -> String
delegationInvariantMsg :: forall a b. (Show a, Show b) => a -> b -> String
delegationInvariantMsg a
stakeKeyHash b
stakePool =
  String
"Delegation of "
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
stakeKeyHash
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" to an unregistered stake pool "
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. Show a => a -> String
show b
stakePool