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

module Cardano.Ledger.Conway.Transition (
  ConwayEraTransition (..),
  TransitionConfig (..),
  toConwayTransitionConfigPairs,
  registerDRepsThenDelegs,
  conwayRegisterInitialFundsThenStaking,
) where

import Cardano.Ledger.Babbage
import Cardano.Ledger.Babbage.Transition (TransitionConfig (BabbageTransitionConfig))
import Cardano.Ledger.BaseTypes (toKeyValuePairs)
import Cardano.Ledger.Coin (compactCoinOrError)
import Cardano.Ledger.Conway.Era
import Cardano.Ledger.Conway.Genesis (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 (ShelleyGenesisStaking (..))
import Cardano.Ledger.Shelley.LedgerState (
  NewEpochState,
  curPParamsEpochStateL,
  esLStateL,
  lsCertStateL,
  nesEsL,
 )
import Cardano.Ledger.Shelley.Transition
import Data.Aeson (KeyValue (..))
import Data.ListMap (ListMap)
import qualified Data.ListMap as ListMap
import qualified Data.Map.Strict as Map
import GHC.Generics
import GHC.Stack
import Lens.Micro
import NoThunks.Class (NoThunks (..))

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 ::
  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.
  TransitionConfig era -> NewEpochState era -> NewEpochState era
forall era.
ConwayEraTransition era =>
TransitionConfig era -> NewEpochState era -> NewEpochState era
registerDelegs TransitionConfig era
cfg (NewEpochState era -> NewEpochState era)
-> (NewEpochState era -> NewEpochState era)
-> NewEpochState era
-> NewEpochState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransitionConfig era -> NewEpochState era -> NewEpochState era
forall era.
ConwayEraTransition era =>
TransitionConfig era -> NewEpochState era -> NewEpochState era
registerInitialDReps TransitionConfig era
cfg

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 :: TransitionConfig ConwayEra
-> NewEpochState ConwayEra -> NewEpochState ConwayEra
injectIntoTestState = TransitionConfig ConwayEra
-> NewEpochState ConwayEra -> NewEpochState ConwayEra
forall era.
ConwayEraTransition era =>
TransitionConfig era -> NewEpochState era -> NewEpochState era
conwayRegisterInitialFundsThenStaking

  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)
-> (forall {f :: * -> *}.
    Functor f =>
    (ListMap (Credential 'Staking) Delegatee
     -> f (ListMap (Credential 'Staking) Delegatee))
    -> TransitionConfig era -> f (TransitionConfig era))
-> forall {f :: * -> *}.
   Functor f =>
   (ListMap (Credential 'Staking) Delegatee
    -> f (ListMap (Credential 'Staking) Delegatee))
   -> TransitionConfig era -> f (TransitionConfig era)
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 ((forall {f :: * -> *}.
  Functor f =>
  (ListMap (Credential 'Staking) Delegatee
   -> f (ListMap (Credential 'Staking) Delegatee))
  -> TransitionConfig era -> f (TransitionConfig era))
 -> forall {f :: * -> *}.
    Functor f =>
    (ListMap (Credential 'Staking) Delegatee
     -> f (ListMap (Credential 'Staking) Delegatee))
    -> TransitionConfig era -> f (TransitionConfig era))
-> (forall {f :: * -> *}.
    Functor f =>
    (ListMap (Credential 'Staking) Delegatee
     -> f (ListMap (Credential 'Staking) Delegatee))
    -> TransitionConfig era -> f (TransitionConfig era))
-> forall {f :: * -> *}.
   Functor f =>
   (ListMap (Credential 'Staking) Delegatee
    -> f (ListMap (Credential 'Staking) Delegatee))
   -> TransitionConfig era -> f (TransitionConfig era)
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)
-> (forall {f :: * -> *}.
    Functor f =>
    (ListMap (Credential 'DRepRole) DRepState
     -> f (ListMap (Credential 'DRepRole) DRepState))
    -> TransitionConfig era -> f (TransitionConfig era))
-> forall {f :: * -> *}.
   Functor f =>
   (ListMap (Credential 'DRepRole) DRepState
    -> f (ListMap (Credential 'DRepRole) DRepState))
   -> TransitionConfig era -> f (TransitionConfig era)
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 ((forall {f :: * -> *}.
  Functor f =>
  (ListMap (Credential 'DRepRole) DRepState
   -> f (ListMap (Credential 'DRepRole) DRepState))
  -> TransitionConfig era -> f (TransitionConfig era))
 -> forall {f :: * -> *}.
    Functor f =>
    (ListMap (Credential 'DRepRole) DRepState
     -> f (ListMap (Credential 'DRepRole) DRepState))
    -> TransitionConfig era -> f (TransitionConfig era))
-> (forall {f :: * -> *}.
    Functor f =>
    (ListMap (Credential 'DRepRole) DRepState
     -> f (ListMap (Credential 'DRepRole) DRepState))
    -> TransitionConfig era -> f (TransitionConfig era))
-> forall {f :: * -> *}.
   Functor f =>
   (ListMap (Credential 'DRepRole) DRepState
    -> f (ListMap (Credential 'DRepRole) DRepState))
   -> TransitionConfig era -> f (TransitionConfig era)
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)

toConwayTransitionConfigPairs :: KeyValue e a => TransitionConfig ConwayEra -> [a]
toConwayTransitionConfigPairs :: forall e a. KeyValue e a => TransitionConfig ConwayEra -> [a]
toConwayTransitionConfigPairs = TransitionConfig ConwayEra -> [a]
forall a e kv. (ToKeyValuePairs a, KeyValue e kv) => a -> [kv]
forall e a. KeyValue e a => TransitionConfig ConwayEra -> [a]
toKeyValuePairs
{-# DEPRECATED toConwayTransitionConfigPairs "In favor of `toKeyValuePairs`" #-}

conwayRegisterInitialFundsThenStaking ::
  ConwayEraTransition era =>
  TransitionConfig era ->
  NewEpochState era ->
  NewEpochState era
conwayRegisterInitialFundsThenStaking :: forall era.
ConwayEraTransition era =>
TransitionConfig era -> NewEpochState era -> NewEpochState era
conwayRegisterInitialFundsThenStaking TransitionConfig era
cfg =
  -- We must first register the initial funds, because the stake
  -- information depends on it.
  NewEpochState era -> NewEpochState era
forall era.
(EraCertState era, EraStake era) =>
NewEpochState era -> NewEpochState era
resetStakeDistribution
    (NewEpochState era -> NewEpochState era)
-> (NewEpochState era -> NewEpochState era)
-> NewEpochState era
-> NewEpochState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransitionConfig era -> NewEpochState era -> NewEpochState era
forall era.
ConwayEraTransition era =>
TransitionConfig era -> NewEpochState era -> NewEpochState era
registerDRepsThenDelegs TransitionConfig era
cfg
    (NewEpochState era -> NewEpochState era)
-> (NewEpochState era -> NewEpochState era)
-> NewEpochState era
-> NewEpochState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyGenesisStaking -> NewEpochState era -> NewEpochState era
forall era.
(HasCallStack, EraTransition era, ConwayEraAccounts era) =>
ShelleyGenesisStaking -> NewEpochState era -> NewEpochState era
conwayRegisterInitialAccounts (TransitionConfig era
cfg TransitionConfig era
-> Getting
     ShelleyGenesisStaking (TransitionConfig era) ShelleyGenesisStaking
-> ShelleyGenesisStaking
forall s a. s -> Getting a s a -> a
^. Getting
  ShelleyGenesisStaking (TransitionConfig era) ShelleyGenesisStaking
forall era.
(HasCallStack, EraTransition era) =>
Lens' (TransitionConfig era) ShelleyGenesisStaking
Lens' (TransitionConfig era) ShelleyGenesisStaking
tcInitialStakingL)
    (NewEpochState era -> NewEpochState era)
-> (NewEpochState era -> NewEpochState era)
-> NewEpochState era
-> NewEpochState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyGenesisStaking -> NewEpochState era -> NewEpochState era
forall era.
EraCertState era =>
ShelleyGenesisStaking -> NewEpochState era -> NewEpochState era
registerInitialStakePools (TransitionConfig era
cfg TransitionConfig era
-> Getting
     ShelleyGenesisStaking (TransitionConfig era) ShelleyGenesisStaking
-> ShelleyGenesisStaking
forall s a. s -> Getting a s a -> a
^. Getting
  ShelleyGenesisStaking (TransitionConfig era) ShelleyGenesisStaking
forall era.
(HasCallStack, EraTransition era) =>
Lens' (TransitionConfig era) ShelleyGenesisStaking
Lens' (TransitionConfig era) ShelleyGenesisStaking
tcInitialStakingL)
    (NewEpochState era -> NewEpochState era)
-> (NewEpochState era -> NewEpochState era)
-> NewEpochState era
-> NewEpochState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransitionConfig era -> NewEpochState era -> NewEpochState era
forall era.
(EraTransition era, HasCallStack) =>
TransitionConfig era -> NewEpochState era -> NewEpochState era
registerInitialFunds TransitionConfig era
cfg

-- | Register all staking credentials and apply delegations. Make sure StakePools that are bing
-- 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 -> Accounts era)
-> NewEpochState era
-> NewEpochState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \Accounts era
initAccounts ->
      ((KeyHash 'Staking, KeyHash 'StakePool)
 -> Accounts era -> Accounts era)
-> Accounts era
-> [(KeyHash 'Staking, KeyHash 'StakePool)]
-> Accounts era
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 -> Accounts era
registerAndDelegate Accounts era
initAccounts ([(KeyHash 'Staking, KeyHash 'StakePool)] -> Accounts era)
-> [(KeyHash 'Staking, KeyHash 'StakePool)] -> Accounts era
forall a b. (a -> b) -> a -> b
$ 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
  where
    stakePools :: Map (KeyHash 'StakePool) PoolParams
stakePools = NewEpochState era
nes NewEpochState era
-> Getting
     (Map (KeyHash 'StakePool) PoolParams)
     (NewEpochState era)
     (Map (KeyHash 'StakePool) PoolParams)
-> Map (KeyHash 'StakePool) PoolParams
forall s a. s -> Getting a s a -> a
^. (EpochState era
 -> Const (Map (KeyHash 'StakePool) PoolParams) (EpochState era))
-> NewEpochState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era
  -> Const (Map (KeyHash 'StakePool) PoolParams) (EpochState era))
 -> NewEpochState era
 -> Const (Map (KeyHash 'StakePool) PoolParams) (NewEpochState era))
-> ((Map (KeyHash 'StakePool) PoolParams
     -> Const
          (Map (KeyHash 'StakePool) PoolParams)
          (Map (KeyHash 'StakePool) PoolParams))
    -> EpochState era
    -> Const (Map (KeyHash 'StakePool) PoolParams) (EpochState era))
-> Getting
     (Map (KeyHash 'StakePool) PoolParams)
     (NewEpochState era)
     (Map (KeyHash 'StakePool) PoolParams)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era
 -> Const (Map (KeyHash 'StakePool) PoolParams) (LedgerState era))
-> EpochState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era
  -> Const (Map (KeyHash 'StakePool) PoolParams) (LedgerState era))
 -> EpochState era
 -> Const (Map (KeyHash 'StakePool) PoolParams) (EpochState era))
-> ((Map (KeyHash 'StakePool) PoolParams
     -> Const
          (Map (KeyHash 'StakePool) PoolParams)
          (Map (KeyHash 'StakePool) PoolParams))
    -> LedgerState era
    -> Const (Map (KeyHash 'StakePool) PoolParams) (LedgerState era))
-> (Map (KeyHash 'StakePool) PoolParams
    -> Const
         (Map (KeyHash 'StakePool) PoolParams)
         (Map (KeyHash 'StakePool) PoolParams))
-> EpochState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era
 -> Const (Map (KeyHash 'StakePool) PoolParams) (CertState era))
-> LedgerState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era
  -> Const (Map (KeyHash 'StakePool) PoolParams) (CertState era))
 -> LedgerState era
 -> Const (Map (KeyHash 'StakePool) PoolParams) (LedgerState era))
-> ((Map (KeyHash 'StakePool) PoolParams
     -> Const
          (Map (KeyHash 'StakePool) PoolParams)
          (Map (KeyHash 'StakePool) PoolParams))
    -> CertState era
    -> Const (Map (KeyHash 'StakePool) PoolParams) (CertState era))
-> (Map (KeyHash 'StakePool) PoolParams
    -> Const
         (Map (KeyHash 'StakePool) PoolParams)
         (Map (KeyHash 'StakePool) PoolParams))
-> LedgerState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PState era
 -> Const (Map (KeyHash 'StakePool) PoolParams) (PState era))
-> CertState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (CertState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
certPStateL ((PState era
  -> Const (Map (KeyHash 'StakePool) PoolParams) (PState era))
 -> CertState era
 -> Const (Map (KeyHash 'StakePool) PoolParams) (CertState era))
-> ((Map (KeyHash 'StakePool) PoolParams
     -> Const
          (Map (KeyHash 'StakePool) PoolParams)
          (Map (KeyHash 'StakePool) PoolParams))
    -> PState era
    -> Const (Map (KeyHash 'StakePool) PoolParams) (PState era))
-> (Map (KeyHash 'StakePool) PoolParams
    -> Const
         (Map (KeyHash 'StakePool) PoolParams)
         (Map (KeyHash 'StakePool) PoolParams))
-> CertState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (KeyHash 'StakePool) PoolParams
 -> Const
      (Map (KeyHash 'StakePool) PoolParams)
      (Map (KeyHash 'StakePool) PoolParams))
-> PState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (PState era)
forall era (f :: * -> *).
Functor f =>
(Map (KeyHash 'StakePool) PoolParams
 -> f (Map (KeyHash 'StakePool) PoolParams))
-> PState era -> f (PState era)
psStakePoolParamsL
    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 => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL
    registerAndDelegate :: (KeyHash 'Staking, KeyHash 'StakePool)
-> Accounts era -> Accounts era
registerAndDelegate (KeyHash 'Staking
stakeKeyHash, KeyHash 'StakePool
stakePool) !Accounts era
accounts
      | KeyHash 'StakePool
stakePool KeyHash 'StakePool -> Map (KeyHash 'StakePool) PoolParams -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map (KeyHash 'StakePool) PoolParams
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
      | Bool
otherwise =
          String -> Accounts era
forall a. HasCallStack => String -> a
error (String -> Accounts era) -> String -> Accounts era
forall a b. (a -> b) -> a -> b
$
            String
"Invariant of a delegation of "
              String -> ShowS
forall a. [a] -> [a] -> [a]
++ KeyHash 'Staking -> String
forall a. Show a => a -> String
show KeyHash 'Staking
stakeKeyHash
              String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" to an unregistered stake pool "
              String -> ShowS
forall a. [a] -> [a] -> [a]
++ KeyHash 'StakePool -> String
forall a. Show a => a -> String
show KeyHash 'StakePool
stakePool
              String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is being violated."

registerInitialDReps ::
  ConwayEraTransition era =>
  TransitionConfig era ->
  NewEpochState era ->
  NewEpochState era
registerInitialDReps :: forall era.
ConwayEraTransition era =>
TransitionConfig era -> NewEpochState era -> NewEpochState era
registerInitialDReps TransitionConfig era
cfg =
  (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 ::
  forall era.
  ConwayEraTransition era =>
  TransitionConfig era ->
  NewEpochState era ->
  NewEpochState era
registerDelegs :: forall era.
ConwayEraTransition era =>
TransitionConfig era -> NewEpochState era -> NewEpochState era
registerDelegs TransitionConfig era
cfg =
  (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)