{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Cardano.Ledger.Conway.Transition (
ConwayEraTransition (..),
TransitionConfig (..),
toConwayTransitionConfigPairs,
registerDRepsThenDelegs,
) where
import Cardano.Ledger.Alonzo.Transition (toAlonzoTransitionConfigPairs)
import Cardano.Ledger.Babbage
import Cardano.Ledger.Babbage.Transition (TransitionConfig (BabbageTransitionConfig))
import Cardano.Ledger.BaseTypes (toKeyValuePairs)
import Cardano.Ledger.Conway.Era
import Cardano.Ledger.Conway.Genesis (ConwayGenesis (..))
import Cardano.Ledger.Conway.Rules.Deleg (processDelegation)
import Cardano.Ledger.Conway.State (ConwayEraCertState (..), DRepState, vsDRepsL)
import Cardano.Ledger.Conway.Translation ()
import Cardano.Ledger.Conway.TxCert (Delegatee)
import Cardano.Ledger.Core
import Cardano.Ledger.Credential (Credential)
import Cardano.Ledger.Shelley.LedgerState (
NewEpochState,
esLStateL,
lsCertStateL,
nesEsL,
)
import Cardano.Ledger.Shelley.Transition
import Data.Aeson (
FromJSON (..),
KeyValue (..),
ToJSON (..),
Value (..),
object,
pairs,
withObject,
(.:),
)
import Data.ListMap (ListMap)
import qualified Data.ListMap as ListMap
import GHC.Generics
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 =
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
cfg =
TransitionConfig ConwayEra
-> NewEpochState ConwayEra -> NewEpochState ConwayEra
forall era.
ConwayEraTransition era =>
TransitionConfig era -> NewEpochState era -> NewEpochState era
registerDRepsThenDelegs TransitionConfig ConwayEra
cfg
(NewEpochState ConwayEra -> NewEpochState ConwayEra)
-> (NewEpochState ConwayEra -> NewEpochState ConwayEra)
-> NewEpochState ConwayEra
-> NewEpochState ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransitionConfig ConwayEra
-> NewEpochState ConwayEra -> NewEpochState ConwayEra
forall era.
EraTransition era =>
TransitionConfig era -> NewEpochState era -> NewEpochState era
registerInitialFundsThenStaking TransitionConfig ConwayEra
cfg
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)
instance ToJSON (TransitionConfig ConwayEra) where
toJSON :: TransitionConfig ConwayEra -> Value
toJSON = [Pair] -> Value
object ([Pair] -> Value)
-> (TransitionConfig ConwayEra -> [Pair])
-> TransitionConfig ConwayEra
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransitionConfig ConwayEra -> [Pair]
forall e a. KeyValue e a => TransitionConfig ConwayEra -> [a]
toConwayTransitionConfigPairs
toEncoding :: TransitionConfig ConwayEra -> Encoding
toEncoding = Series -> Encoding
pairs (Series -> Encoding)
-> (TransitionConfig ConwayEra -> Series)
-> TransitionConfig ConwayEra
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series)
-> (TransitionConfig ConwayEra -> [Series])
-> TransitionConfig ConwayEra
-> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransitionConfig ConwayEra -> [Series]
forall e a. KeyValue e a => TransitionConfig ConwayEra -> [a]
toConwayTransitionConfigPairs
toConwayTransitionConfigPairs :: KeyValue e a => TransitionConfig ConwayEra -> [a]
toConwayTransitionConfigPairs :: forall e a. KeyValue e a => TransitionConfig ConwayEra -> [a]
toConwayTransitionConfigPairs TransitionConfig ConwayEra
conwayConfig =
TransitionConfig AlonzoEra -> [a]
forall e a. KeyValue e a => TransitionConfig AlonzoEra -> [a]
toAlonzoTransitionConfigPairs TransitionConfig AlonzoEra
alonzoConfig
[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [Key
"conway" Key -> Value -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object (ConwayGenesis -> [Pair]
forall a e kv. (ToKeyValuePairs a, KeyValue e kv) => a -> [kv]
forall e kv. KeyValue e kv => ConwayGenesis -> [kv]
toKeyValuePairs (TransitionConfig ConwayEra
conwayConfig TransitionConfig ConwayEra
-> Getting ConwayGenesis (TransitionConfig ConwayEra) ConwayGenesis
-> ConwayGenesis
forall s a. s -> Getting a s a -> a
^. (TranslationContext ConwayEra
-> Const ConwayGenesis (TranslationContext ConwayEra))
-> TransitionConfig ConwayEra
-> Const ConwayGenesis (TransitionConfig ConwayEra)
Getting ConwayGenesis (TransitionConfig ConwayEra) ConwayGenesis
forall era.
EraTransition era =>
Lens' (TransitionConfig era) (TranslationContext era)
Lens' (TransitionConfig ConwayEra) (TranslationContext ConwayEra)
tcTranslationContextL))]
where
babbageConfig :: TransitionConfig BabbageEra
babbageConfig = TransitionConfig ConwayEra
conwayConfig TransitionConfig ConwayEra
-> Getting
(TransitionConfig BabbageEra)
(TransitionConfig ConwayEra)
(TransitionConfig BabbageEra)
-> TransitionConfig BabbageEra
forall s a. s -> Getting a s a -> a
^. (TransitionConfig (PreviousEra ConwayEra)
-> Const
(TransitionConfig BabbageEra)
(TransitionConfig (PreviousEra ConwayEra)))
-> TransitionConfig ConwayEra
-> Const (TransitionConfig BabbageEra) (TransitionConfig ConwayEra)
Getting
(TransitionConfig BabbageEra)
(TransitionConfig ConwayEra)
(TransitionConfig BabbageEra)
forall era.
(EraTransition era, EraTransition (PreviousEra era)) =>
Lens' (TransitionConfig era) (TransitionConfig (PreviousEra era))
Lens'
(TransitionConfig ConwayEra)
(TransitionConfig (PreviousEra ConwayEra))
tcPreviousEraConfigL
alonzoConfig :: TransitionConfig AlonzoEra
alonzoConfig = TransitionConfig BabbageEra
babbageConfig TransitionConfig BabbageEra
-> Getting
(TransitionConfig AlonzoEra)
(TransitionConfig BabbageEra)
(TransitionConfig AlonzoEra)
-> TransitionConfig AlonzoEra
forall s a. s -> Getting a s a -> a
^. (TransitionConfig (PreviousEra BabbageEra)
-> Const
(TransitionConfig AlonzoEra)
(TransitionConfig (PreviousEra BabbageEra)))
-> TransitionConfig BabbageEra
-> Const (TransitionConfig AlonzoEra) (TransitionConfig BabbageEra)
Getting
(TransitionConfig AlonzoEra)
(TransitionConfig BabbageEra)
(TransitionConfig AlonzoEra)
forall era.
(EraTransition era, EraTransition (PreviousEra era)) =>
Lens' (TransitionConfig era) (TransitionConfig (PreviousEra era))
Lens'
(TransitionConfig BabbageEra)
(TransitionConfig (PreviousEra BabbageEra))
tcPreviousEraConfigL
instance FromJSON (TransitionConfig ConwayEra) where
parseJSON :: Value -> Parser (TransitionConfig ConwayEra)
parseJSON = String
-> (Object -> Parser (TransitionConfig ConwayEra))
-> Value
-> Parser (TransitionConfig ConwayEra)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ConwayTransitionConfig" ((Object -> Parser (TransitionConfig ConwayEra))
-> Value -> Parser (TransitionConfig ConwayEra))
-> (Object -> Parser (TransitionConfig ConwayEra))
-> Value
-> Parser (TransitionConfig ConwayEra)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
ConwayGenesis
pc <- Value -> Parser ConwayGenesis
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
TransitionConfig BabbageEra
ag <- Object
o Object -> Key -> Parser (TransitionConfig BabbageEra)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"conway"
TransitionConfig ConwayEra -> Parser (TransitionConfig ConwayEra)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TransitionConfig ConwayEra -> Parser (TransitionConfig ConwayEra))
-> TransitionConfig ConwayEra
-> Parser (TransitionConfig ConwayEra)
forall a b. (a -> b) -> a -> b
$ TranslationContext ConwayEra
-> TransitionConfig (PreviousEra ConwayEra)
-> TransitionConfig ConwayEra
forall era.
EraTransition era =>
TranslationContext era
-> TransitionConfig (PreviousEra era) -> TransitionConfig era
mkTransitionConfig TranslationContext ConwayEra
ConwayGenesis
pc TransitionConfig (PreviousEra ConwayEra)
TransitionConfig BabbageEra
ag
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)