{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Alonzo.Transition (
  AlonzoEraTransition (..),
  TransitionConfig (..),
  alonzoInjectCostModels,
) where

import Cardano.Ledger.Alonzo.Core (AlonzoEraPParams, PreviousEra, ppCostModelsL)
import Cardano.Ledger.Alonzo.Era
import Cardano.Ledger.Alonzo.Genesis
import Cardano.Ledger.Alonzo.Translation ()
import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Mary
import Cardano.Ledger.Mary.Transition (TransitionConfig (MaryTransitionConfig))
import Cardano.Ledger.Plutus.CostModels (CostModels, CostModelsUpdate (..), updateCostModels)
import Cardano.Ledger.Shelley.LedgerState
import Cardano.Ledger.Shelley.Transition
import GHC.Generics
import Lens.Micro
import NoThunks.Class (NoThunks (..))

class (EraTransition era, AlonzoEraPParams era) => AlonzoEraTransition era where
  -- | Lens for the `AlonzoGenesis` from the `TransitionConfig`. Default implementation
  -- looks in the previous era's config
  tcAlonzoGenesisL :: Lens' (TransitionConfig era) AlonzoGenesis
  default tcAlonzoGenesisL ::
    AlonzoEraTransition (PreviousEra era) =>
    Lens' (TransitionConfig era) AlonzoGenesis
  tcAlonzoGenesisL = (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))
-> ((AlonzoGenesis -> f AlonzoGenesis)
    -> TransitionConfig (PreviousEra era)
    -> f (TransitionConfig (PreviousEra era)))
-> (AlonzoGenesis -> f AlonzoGenesis)
-> TransitionConfig era
-> f (TransitionConfig era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AlonzoGenesis -> f AlonzoGenesis)
-> TransitionConfig (PreviousEra era)
-> f (TransitionConfig (PreviousEra era))
forall era.
AlonzoEraTransition era =>
Lens' (TransitionConfig era) AlonzoGenesis
Lens' (TransitionConfig (PreviousEra era)) AlonzoGenesis
tcAlonzoGenesisL

instance EraTransition AlonzoEra where
  data TransitionConfig AlonzoEra = AlonzoTransitionConfig
    { TransitionConfig AlonzoEra -> AlonzoGenesis
atcAlonzoGenesis :: !AlonzoGenesis
    , TransitionConfig AlonzoEra -> TransitionConfig MaryEra
atcMaryTransitionConfig :: !(TransitionConfig MaryEra)
    }
    deriving (Int -> TransitionConfig AlonzoEra -> ShowS
[TransitionConfig AlonzoEra] -> ShowS
TransitionConfig AlonzoEra -> String
(Int -> TransitionConfig AlonzoEra -> ShowS)
-> (TransitionConfig AlonzoEra -> String)
-> ([TransitionConfig AlonzoEra] -> ShowS)
-> Show (TransitionConfig AlonzoEra)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TransitionConfig AlonzoEra -> ShowS
showsPrec :: Int -> TransitionConfig AlonzoEra -> ShowS
$cshow :: TransitionConfig AlonzoEra -> String
show :: TransitionConfig AlonzoEra -> String
$cshowList :: [TransitionConfig AlonzoEra] -> ShowS
showList :: [TransitionConfig AlonzoEra] -> ShowS
Show, TransitionConfig AlonzoEra -> TransitionConfig AlonzoEra -> Bool
(TransitionConfig AlonzoEra -> TransitionConfig AlonzoEra -> Bool)
-> (TransitionConfig AlonzoEra
    -> TransitionConfig AlonzoEra -> Bool)
-> Eq (TransitionConfig AlonzoEra)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TransitionConfig AlonzoEra -> TransitionConfig AlonzoEra -> Bool
== :: TransitionConfig AlonzoEra -> TransitionConfig AlonzoEra -> Bool
$c/= :: TransitionConfig AlonzoEra -> TransitionConfig AlonzoEra -> Bool
/= :: TransitionConfig AlonzoEra -> TransitionConfig AlonzoEra -> Bool
Eq, (forall x.
 TransitionConfig AlonzoEra -> Rep (TransitionConfig AlonzoEra) x)
-> (forall x.
    Rep (TransitionConfig AlonzoEra) x -> TransitionConfig AlonzoEra)
-> Generic (TransitionConfig AlonzoEra)
forall x.
Rep (TransitionConfig AlonzoEra) x -> TransitionConfig AlonzoEra
forall x.
TransitionConfig AlonzoEra -> Rep (TransitionConfig AlonzoEra) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
TransitionConfig AlonzoEra -> Rep (TransitionConfig AlonzoEra) x
from :: forall x.
TransitionConfig AlonzoEra -> Rep (TransitionConfig AlonzoEra) x
$cto :: forall x.
Rep (TransitionConfig AlonzoEra) x -> TransitionConfig AlonzoEra
to :: forall x.
Rep (TransitionConfig AlonzoEra) x -> TransitionConfig AlonzoEra
Generic)

  mkTransitionConfig :: TranslationContext AlonzoEra
-> TransitionConfig (PreviousEra AlonzoEra)
-> TransitionConfig AlonzoEra
mkTransitionConfig = TranslationContext AlonzoEra
-> TransitionConfig (PreviousEra AlonzoEra)
-> TransitionConfig AlonzoEra
AlonzoGenesis
-> TransitionConfig MaryEra -> TransitionConfig AlonzoEra
AlonzoTransitionConfig

  injectIntoTestState :: forall (m :: * -> *) h.
(HasCallStack, MonadST m, MonadThrow m) =>
HasFS m h
-> TransitionConfig AlonzoEra
-> NewEpochState AlonzoEra
-> m (NewEpochState AlonzoEra)
injectIntoTestState HasFS m h
hasFS TransitionConfig AlonzoEra
cfg NewEpochState AlonzoEra
newEpochState =
    HasFS m h
-> TransitionConfig AlonzoEra
-> NewEpochState AlonzoEra
-> m (NewEpochState AlonzoEra)
forall era (m :: * -> *) h.
(EraTransition era, ShelleyEraAccounts era, HasCallStack,
 MonadST m, MonadThrow m) =>
HasFS m h
-> TransitionConfig era
-> NewEpochState era
-> m (NewEpochState era)
shelleyRegisterInitialFundsThenStaking HasFS m h
hasFS TransitionConfig AlonzoEra
cfg (TransitionConfig AlonzoEra
-> NewEpochState AlonzoEra -> NewEpochState AlonzoEra
forall era.
AlonzoEraTransition era =>
TransitionConfig era -> NewEpochState era -> NewEpochState era
alonzoInjectCostModels TransitionConfig AlonzoEra
cfg NewEpochState AlonzoEra
newEpochState)

  tcPreviousEraConfigL :: EraTransition (PreviousEra AlonzoEra) =>
Lens'
  (TransitionConfig AlonzoEra)
  (TransitionConfig (PreviousEra AlonzoEra))
tcPreviousEraConfigL =
    (TransitionConfig AlonzoEra -> TransitionConfig MaryEra)
-> (TransitionConfig AlonzoEra
    -> TransitionConfig MaryEra -> TransitionConfig AlonzoEra)
-> Lens
     (TransitionConfig AlonzoEra)
     (TransitionConfig AlonzoEra)
     (TransitionConfig MaryEra)
     (TransitionConfig MaryEra)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TransitionConfig AlonzoEra -> TransitionConfig MaryEra
atcMaryTransitionConfig (\TransitionConfig AlonzoEra
atc TransitionConfig MaryEra
pc -> TransitionConfig AlonzoEra
atc {atcMaryTransitionConfig = pc})

  tcTranslationContextL :: Lens' (TransitionConfig AlonzoEra) (TranslationContext AlonzoEra)
tcTranslationContextL =
    (TransitionConfig AlonzoEra -> AlonzoGenesis)
-> (TransitionConfig AlonzoEra
    -> AlonzoGenesis -> TransitionConfig AlonzoEra)
-> Lens
     (TransitionConfig AlonzoEra)
     (TransitionConfig AlonzoEra)
     AlonzoGenesis
     AlonzoGenesis
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TransitionConfig AlonzoEra -> AlonzoGenesis
atcAlonzoGenesis (\TransitionConfig AlonzoEra
atc AlonzoGenesis
ag -> TransitionConfig AlonzoEra
atc {atcAlonzoGenesis = ag})

instance AlonzoEraTransition AlonzoEra where
  tcAlonzoGenesisL :: Lens
  (TransitionConfig AlonzoEra)
  (TransitionConfig AlonzoEra)
  AlonzoGenesis
  AlonzoGenesis
tcAlonzoGenesisL = (TranslationContext AlonzoEra -> f (TranslationContext AlonzoEra))
-> TransitionConfig AlonzoEra -> f (TransitionConfig AlonzoEra)
(AlonzoGenesis -> f AlonzoGenesis)
-> TransitionConfig AlonzoEra -> f (TransitionConfig AlonzoEra)
forall era.
EraTransition era =>
Lens' (TransitionConfig era) (TranslationContext era)
Lens' (TransitionConfig AlonzoEra) (TranslationContext AlonzoEra)
tcTranslationContextL

instance NoThunks (TransitionConfig AlonzoEra)

alonzoInjectCostModels ::
  AlonzoEraTransition era =>
  TransitionConfig era -> NewEpochState era -> NewEpochState era
alonzoInjectCostModels :: forall era.
AlonzoEraTransition era =>
TransitionConfig era -> NewEpochState era -> NewEpochState era
alonzoInjectCostModels TransitionConfig era
cfg =
  case AlonzoGenesis -> StrictMaybe AlonzoExtraConfig
agExtraConfig (AlonzoGenesis -> StrictMaybe AlonzoExtraConfig)
-> AlonzoGenesis -> StrictMaybe AlonzoExtraConfig
forall a b. (a -> b) -> a -> b
$ TransitionConfig era
cfg TransitionConfig era
-> Getting AlonzoGenesis (TransitionConfig era) AlonzoGenesis
-> AlonzoGenesis
forall s a. s -> Getting a s a -> a
^. Getting AlonzoGenesis (TransitionConfig era) AlonzoGenesis
forall era.
AlonzoEraTransition era =>
Lens' (TransitionConfig era) AlonzoGenesis
Lens' (TransitionConfig era) AlonzoGenesis
tcAlonzoGenesisL of
    StrictMaybe AlonzoExtraConfig
SNothing -> NewEpochState era -> NewEpochState era
forall a. a -> a
id
    SJust AlonzoExtraConfig
aec -> Maybe CostModels -> NewEpochState era -> NewEpochState era
forall era.
(EraTransition era, AlonzoEraPParams era) =>
Maybe CostModels -> NewEpochState era -> NewEpochState era
overrideCostModels (AlonzoExtraConfig -> Maybe CostModels
aecCostModels AlonzoExtraConfig
aec)

overrideCostModels ::
  (EraTransition era, AlonzoEraPParams era) =>
  Maybe CostModels ->
  NewEpochState era ->
  NewEpochState era
overrideCostModels :: forall era.
(EraTransition era, AlonzoEraPParams era) =>
Maybe CostModels -> NewEpochState era -> NewEpochState era
overrideCostModels = \case
  Maybe CostModels
Nothing -> NewEpochState era -> NewEpochState era
forall a. a -> a
id
  -- Injected cost models override the era-translated ones (the fixed-length
  -- PlutusV1/PlutusV3 genesis fields), so a testnet can carry full cost models
  -- without an on-chain parameter update.
  Just CostModels
cms ->
    (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))
-> ((CostModels -> Identity CostModels)
    -> EpochState era -> Identity (EpochState era))
-> (CostModels -> Identity CostModels)
-> NewEpochState era
-> Identity (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Identity (PParams era))
-> EpochState era -> Identity (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Identity (PParams era))
 -> EpochState era -> Identity (EpochState era))
-> ((CostModels -> Identity CostModels)
    -> PParams era -> Identity (PParams era))
-> (CostModels -> Identity CostModels)
-> EpochState era
-> Identity (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CostModels -> Identity CostModels)
-> PParams era -> Identity (PParams era)
forall era. AlonzoEraPParams era => Lens' (PParams era) CostModels
Lens' (PParams era) CostModels
ppCostModelsL ((CostModels -> Identity CostModels)
 -> NewEpochState era -> Identity (NewEpochState era))
-> (CostModels -> CostModels)
-> NewEpochState era
-> NewEpochState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (CostModels -> CostModelsUpdate -> CostModels)
-> CostModelsUpdate -> CostModels -> CostModels
forall a b c. (a -> b -> c) -> b -> a -> c
flip CostModels -> CostModelsUpdate -> CostModels
updateCostModels (CostModels -> CostModelsUpdate
CostModelsUpdate CostModels
cms)