{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Dijkstra.Transition (
  TransitionConfig (..),
  seatInitialLeiosCommittee,
) where

import Cardano.Ledger.Alonzo.Transition (AlonzoEraTransition)
import Cardano.Ledger.Conway
import Cardano.Ledger.Conway.Transition (
  ConwayEraTransition,
  conwayInjectIntoTestState,
 )
import Cardano.Ledger.Dijkstra.Era
import Cardano.Ledger.Dijkstra.Genesis
import Cardano.Ledger.Dijkstra.PParams (ppLeiosCommitteeSizeL)
import Cardano.Ledger.Dijkstra.Translation ()
import Cardano.Ledger.Shelley.LedgerState (
  NewEpochState,
  curPParamsEpochStateL,
  esSnapshotsL,
  nesELL,
  nesEsL,
 )
import Cardano.Ledger.Shelley.Transition
import Cardano.Ledger.State (
  MarkSnapShot (..),
  ssStakeMarkL,
 )
import GHC.Generics
import Lens.Micro
import NoThunks.Class (NoThunks (..))

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

  mkTransitionConfig :: TranslationContext DijkstraEra
-> TransitionConfig (PreviousEra DijkstraEra)
-> TransitionConfig DijkstraEra
mkTransitionConfig = TranslationContext DijkstraEra
-> TransitionConfig (PreviousEra DijkstraEra)
-> TransitionConfig DijkstraEra
DijkstraGenesis
-> TransitionConfig ConwayEra -> TransitionConfig DijkstraEra
DijkstraTransitionConfig

  injectIntoTestState :: forall (m :: * -> *) h.
(HasCallStack, MonadST m, MonadThrow m) =>
HasFS m h
-> TransitionConfig DijkstraEra
-> NewEpochState DijkstraEra
-> m (NewEpochState DijkstraEra)
injectIntoTestState HasFS m h
hasFS TransitionConfig DijkstraEra
cfg NewEpochState DijkstraEra
nes =
    NewEpochState DijkstraEra -> NewEpochState DijkstraEra
seatInitialLeiosCommittee (NewEpochState DijkstraEra -> NewEpochState DijkstraEra)
-> m (NewEpochState DijkstraEra) -> m (NewEpochState DijkstraEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasFS m h
-> TransitionConfig DijkstraEra
-> NewEpochState DijkstraEra
-> m (NewEpochState DijkstraEra)
forall era (m :: * -> *) h.
(ConwayEraTransition era, HasCallStack, MonadST m, MonadThrow m) =>
HasFS m h
-> TransitionConfig era
-> NewEpochState era
-> m (NewEpochState era)
conwayInjectIntoTestState HasFS m h
hasFS TransitionConfig DijkstraEra
cfg NewEpochState DijkstraEra
nes

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

  tcTranslationContextL :: Lens'
  (TransitionConfig DijkstraEra) (TranslationContext DijkstraEra)
tcTranslationContextL =
    (TransitionConfig DijkstraEra -> DijkstraGenesis)
-> (TransitionConfig DijkstraEra
    -> DijkstraGenesis -> TransitionConfig DijkstraEra)
-> Lens
     (TransitionConfig DijkstraEra)
     (TransitionConfig DijkstraEra)
     DijkstraGenesis
     DijkstraGenesis
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TransitionConfig DijkstraEra -> DijkstraGenesis
dtcDijkstraGenesis (\TransitionConfig DijkstraEra
dtc DijkstraGenesis
ag -> TransitionConfig DijkstraEra
dtc {dtcDijkstraGenesis = ag})

instance AlonzoEraTransition DijkstraEra

-- | Record the Leios committee inputs (CIP-0164) on the initial mark snapshot.
--
-- Genesis never runs SNAP, and the mark it produces comes from era-generic
-- code that has no way to reach @leiosCommitteeSize@, so it carries a zero
-- size. Stamp the real epoch and committee size here; the committee itself is
-- seated when the mark rotates into the set position. Consensus fills
-- @set@\/@go@ from @mark@ for a network booting straight into Dijkstra, so
-- stamping @mark@ is enough for all three.
seatInitialLeiosCommittee :: NewEpochState DijkstraEra -> NewEpochState DijkstraEra
seatInitialLeiosCommittee :: NewEpochState DijkstraEra -> NewEpochState DijkstraEra
seatInitialLeiosCommittee NewEpochState DijkstraEra
nes =
  NewEpochState DijkstraEra
nes NewEpochState DijkstraEra
-> (NewEpochState DijkstraEra -> NewEpochState DijkstraEra)
-> NewEpochState DijkstraEra
forall a b. a -> (a -> b) -> b
& (EpochState DijkstraEra -> Identity (EpochState DijkstraEra))
-> NewEpochState DijkstraEra
-> Identity (NewEpochState DijkstraEra)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState DijkstraEra -> Identity (EpochState DijkstraEra))
 -> NewEpochState DijkstraEra
 -> Identity (NewEpochState DijkstraEra))
-> ((MarkSnapShot -> Identity MarkSnapShot)
    -> EpochState DijkstraEra -> Identity (EpochState DijkstraEra))
-> (MarkSnapShot -> Identity MarkSnapShot)
-> NewEpochState DijkstraEra
-> Identity (NewEpochState DijkstraEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SnapShots DijkstraEra -> Identity (SnapShots DijkstraEra))
-> EpochState DijkstraEra -> Identity (EpochState DijkstraEra)
forall era (f :: * -> *).
Functor f =>
(SnapShots era -> f (SnapShots era))
-> EpochState era -> f (EpochState era)
esSnapshotsL ((SnapShots DijkstraEra -> Identity (SnapShots DijkstraEra))
 -> EpochState DijkstraEra -> Identity (EpochState DijkstraEra))
-> ((MarkSnapShot -> Identity MarkSnapShot)
    -> SnapShots DijkstraEra -> Identity (SnapShots DijkstraEra))
-> (MarkSnapShot -> Identity MarkSnapShot)
-> EpochState DijkstraEra
-> Identity (EpochState DijkstraEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MarkSnapShot -> Identity MarkSnapShot)
-> SnapShots DijkstraEra -> Identity (SnapShots DijkstraEra)
forall era (f :: * -> *).
Functor f =>
(MarkSnapShot -> f MarkSnapShot)
-> SnapShots era -> f (SnapShots era)
ssStakeMarkL ((MarkSnapShot -> Identity MarkSnapShot)
 -> NewEpochState DijkstraEra
 -> Identity (NewEpochState DijkstraEra))
-> (MarkSnapShot -> MarkSnapShot)
-> NewEpochState DijkstraEra
-> NewEpochState DijkstraEra
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ MarkSnapShot -> MarkSnapShot
stampInputs
  where
    stampInputs :: MarkSnapShot -> MarkSnapShot
stampInputs MarkSnapShot
mark =
      MarkSnapShot
mark
        { msEpochNo = nes ^. nesELL
        , msLeiosCommitteeSize = nes ^. nesEsL . curPParamsEpochStateL . ppLeiosCommitteeSizeL
        }

instance ConwayEraTransition DijkstraEra

instance NoThunks (TransitionConfig DijkstraEra)