{-# LANGUAGE DataKinds #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Dijkstra.Rules.Epoch () where

import Cardano.Ledger.BaseTypes (ProtVer, ShelleyBase)
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.Governance (
  ConwayEraGov (..),
  ConwayGovState,
  EnactState (..),
  RatifyEnv (..),
  RatifySignal (..),
  RatifyState (..),
  RunConwayRatify,
  cgsCommitteeL,
  cgsConstitutionL,
  cgsCurPParamsL,
  cgsFuturePParamsL,
  cgsPrevPParamsL,
  cgsProposalsL,
  epochStateDRepPulsingStateL,
  extractDRepPulsingState,
  proposalsApplyEnactment,
  proposalsGovStateL,
  setFreshDRepPulsingState,
 )
import Cardano.Ledger.Conway.Rules (
  ConwayEpochEvent (..),
  ConwayHardForkEvent,
  ConwayNewEpochEvent (EpochEvent),
  HARDFORK,
  NEWEPOCH,
  RATIFY,
  applyEnactedWithdrawals,
  returnProposalDeposits,
  updateCommitteeState,
  updateNumDormantEpochs,
 )
import Cardano.Ledger.Conway.State
import Cardano.Ledger.Dijkstra.Era (EPOCH)
import Cardano.Ledger.Shelley.LedgerState (
  EpochState (..),
  LedgerState (..),
  UTxOState (..),
  curPParamsEpochStateL,
  esLStateL,
  esSnapshotsL,
  lsCertStateL,
  lsUTxOStateL,
  prevPParamsEpochStateL,
  totalObligation,
  utxosDepositedL,
  utxosDonationL,
  utxosGovStateL,
 )
import Cardano.Ledger.Shelley.Rewards ()
import qualified Cardano.Ledger.Shelley.Rules as Shelley
import Cardano.Ledger.Slot (EpochNo)
import Cardano.Ledger.Val (zero)
import Control.State.Transition (
  Embed (..),
  STS (..),
  TRC (..),
  TransitionRule,
  judgmentContext,
  liftSTS,
  tellEvent,
  trans,
 )
import Data.Foldable (fold)
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import Data.Void (Void, absurd)
import Lens.Micro ((%~), (&), (.~), (<>~), (^.))

instance
  ( EraTxOut era
  , RunConwayRatify era
  , ConwayEraCertState era
  , ConwayEraGov era
  , EraStake era
  , EraCertState era
  , Embed (EraRule "SNAP" era) (EPOCH era)
  , Environment (EraRule "SNAP" era) ~ Shelley.SnapEnv era
  , State (EraRule "SNAP" era) ~ SnapShots era
  , Signal (EraRule "SNAP" era) ~ ()
  , Embed (EraRule "POOLREAP" era) (EPOCH era)
  , Environment (EraRule "POOLREAP" era) ~ ()
  , State (EraRule "POOLREAP" era) ~ Shelley.ShelleyPoolreapState era
  , Signal (EraRule "POOLREAP" era) ~ EpochNo
  , Embed (EraRule "RATIFY" era) (EPOCH era)
  , Environment (EraRule "RATIFY" era) ~ RatifyEnv era
  , GovState era ~ ConwayGovState era
  , State (EraRule "RATIFY" era) ~ RatifyState era
  , Signal (EraRule "RATIFY" era) ~ RatifySignal era
  , Embed (EraRule "HARDFORK" era) (EPOCH era)
  , Environment (EraRule "HARDFORK" era) ~ ()
  , State (EraRule "HARDFORK" era) ~ EpochState era
  , Signal (EraRule "HARDFORK" era) ~ ProtVer
  ) =>
  STS (EPOCH era)
  where
  type State (EPOCH era) = EpochState era
  type Signal (EPOCH era) = EpochNo
  type Environment (EPOCH era) = ()
  type BaseM (EPOCH era) = ShelleyBase
  type PredicateFailure (EPOCH era) = Void
  type Event (EPOCH era) = ConwayEpochEvent era
  transitionRules :: [TransitionRule (EPOCH era)]
transitionRules = [TransitionRule (EPOCH era)
forall era.
(RunConwayRatify era, ConwayEraCertState era, EraTxOut era,
 Environment (EraRule "SNAP" era) ~ SnapEnv era,
 State (EraRule "SNAP" era) ~ SnapShots era,
 Signal (EraRule "SNAP" era) ~ (),
 Embed (EraRule "SNAP" era) (EPOCH era),
 Embed (EraRule "POOLREAP" era) (EPOCH era),
 Environment (EraRule "POOLREAP" era) ~ (),
 State (EraRule "POOLREAP" era) ~ ShelleyPoolreapState era,
 Signal (EraRule "POOLREAP" era) ~ EpochNo,
 Embed (EraRule "RATIFY" era) (EPOCH era),
 Environment (EraRule "RATIFY" era) ~ RatifyEnv era,
 State (EraRule "RATIFY" era) ~ RatifyState era,
 GovState era ~ ConwayGovState era,
 Signal (EraRule "RATIFY" era) ~ RatifySignal era, ConwayEraGov era,
 Embed (EraRule "HARDFORK" era) (EPOCH era),
 Environment (EraRule "HARDFORK" era) ~ (),
 State (EraRule "HARDFORK" era) ~ EpochState era,
 Signal (EraRule "HARDFORK" era) ~ ProtVer) =>
TransitionRule (EPOCH era)
epochTransition]

epochTransition ::
  forall era.
  ( RunConwayRatify era
  , ConwayEraCertState era
  , EraTxOut era
  , Environment (EraRule "SNAP" era) ~ Shelley.SnapEnv era
  , State (EraRule "SNAP" era) ~ SnapShots era
  , Signal (EraRule "SNAP" era) ~ ()
  , Embed (EraRule "SNAP" era) (EPOCH era)
  , Embed (EraRule "POOLREAP" era) (EPOCH era)
  , Environment (EraRule "POOLREAP" era) ~ ()
  , State (EraRule "POOLREAP" era) ~ Shelley.ShelleyPoolreapState era
  , Signal (EraRule "POOLREAP" era) ~ EpochNo
  , Embed (EraRule "RATIFY" era) (EPOCH era)
  , Environment (EraRule "RATIFY" era) ~ RatifyEnv era
  , State (EraRule "RATIFY" era) ~ RatifyState era
  , GovState era ~ ConwayGovState era
  , Signal (EraRule "RATIFY" era) ~ RatifySignal era
  , ConwayEraGov era
  , Embed (EraRule "HARDFORK" era) (EPOCH era)
  , Environment (EraRule "HARDFORK" era) ~ ()
  , State (EraRule "HARDFORK" era) ~ EpochState era
  , Signal (EraRule "HARDFORK" era) ~ ProtVer
  ) =>
  TransitionRule (EPOCH era)
epochTransition :: forall era.
(RunConwayRatify era, ConwayEraCertState era, EraTxOut era,
 Environment (EraRule "SNAP" era) ~ SnapEnv era,
 State (EraRule "SNAP" era) ~ SnapShots era,
 Signal (EraRule "SNAP" era) ~ (),
 Embed (EraRule "SNAP" era) (EPOCH era),
 Embed (EraRule "POOLREAP" era) (EPOCH era),
 Environment (EraRule "POOLREAP" era) ~ (),
 State (EraRule "POOLREAP" era) ~ ShelleyPoolreapState era,
 Signal (EraRule "POOLREAP" era) ~ EpochNo,
 Embed (EraRule "RATIFY" era) (EPOCH era),
 Environment (EraRule "RATIFY" era) ~ RatifyEnv era,
 State (EraRule "RATIFY" era) ~ RatifyState era,
 GovState era ~ ConwayGovState era,
 Signal (EraRule "RATIFY" era) ~ RatifySignal era, ConwayEraGov era,
 Embed (EraRule "HARDFORK" era) (EPOCH era),
 Environment (EraRule "HARDFORK" era) ~ (),
 State (EraRule "HARDFORK" era) ~ EpochState era,
 Signal (EraRule "HARDFORK" era) ~ ProtVer) =>
TransitionRule (EPOCH era)
epochTransition = do
  TRC
    ( ()
      , epochState0@EpochState
          { esSnapshots = snapshots0
          , esLState = ledgerState0
          }
      , eNo
      ) <-
    Rule (EPOCH era) 'Transition (RuleContext 'Transition (EPOCH era))
F (Clause (EPOCH era) 'Transition) (TRC (EPOCH era))
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
  let chainAccountState0 = State (EPOCH era)
EpochState era
epochState0 EpochState era
-> Getting ChainAccountState (EpochState era) ChainAccountState
-> ChainAccountState
forall s a. s -> Getting a s a -> a
^. Getting ChainAccountState (EpochState era) ChainAccountState
forall era. Lens' (EpochState era) ChainAccountState
forall (t :: * -> *) era.
CanSetChainAccountState t =>
Lens' (t era) ChainAccountState
chainAccountStateL
      govState0 = UTxOState era -> GovState era
forall era. UTxOState era -> GovState era
utxosGovState UTxOState era
utxoState0
      curPParams = GovState era
ConwayGovState era
govState0 ConwayGovState era
-> Getting (PParams era) (ConwayGovState era) (PParams era)
-> PParams era
forall s a. s -> Getting a s a -> a
^. (PParams era -> Const (PParams era) (PParams era))
-> GovState era -> Const (PParams era) (GovState era)
Getting (PParams era) (ConwayGovState era) (PParams era)
forall era. EraGov era => Lens' (GovState era) (PParams era)
Lens' (GovState era) (PParams era)
curPParamsGovStateL
      utxoState0 = LedgerState era -> UTxOState era
forall era. LedgerState era -> UTxOState era
lsUTxOState LedgerState era
ledgerState0
      certState0 = LedgerState era
ledgerState0 LedgerState era
-> Getting (CertState era) (LedgerState era) (CertState era)
-> CertState era
forall s a. s -> Getting a s a -> a
^. Getting (CertState era) (LedgerState era) (CertState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL
      vState = CertState era
certState0 CertState era
-> Getting (VState era) (CertState era) (VState era) -> VState era
forall s a. s -> Getting a s a -> a
^. Getting (VState era) (CertState era) (VState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL
  Shelley.PoolreapState utxoState1 chainAccountState1 certState1 <-
    trans @(EraRule "POOLREAP" era) $
      TRC ((), Shelley.PoolreapState utxoState0 chainAccountState0 certState0, eNo)

  let
    pulsingState = State (EPOCH era)
EpochState era
epochState0 EpochState era
-> Getting
     (DRepPulsingState era) (EpochState era) (DRepPulsingState era)
-> DRepPulsingState era
forall s a. s -> Getting a s a -> a
^. Getting
  (DRepPulsingState era) (EpochState era) (DRepPulsingState era)
forall era.
ConwayEraGov era =>
Lens' (EpochState era) (DRepPulsingState era)
Lens' (EpochState era) (DRepPulsingState era)
epochStateDRepPulsingStateL

    ratifyState@RatifyState {rsEnactState, rsEnacted, rsExpired} =
      extractDRepPulsingState pulsingState

    (chainAccountState2, dState2, EnactState {..}) =
      applyEnactedWithdrawals chainAccountState1 (certState1 ^. certDStateL) rsEnactState

    (newProposals, enactedActions, removedDueToEnactment, expiredActions) =
      proposalsApplyEnactment rsEnacted rsExpired (govState0 ^. proposalsGovStateL)

    govState1 =
      GovState era
ConwayGovState era
govState0
        ConwayGovState era
-> (ConwayGovState era -> ConwayGovState era) -> ConwayGovState era
forall a b. a -> (a -> b) -> b
& (Proposals era -> Identity (Proposals era))
-> ConwayGovState era -> Identity (ConwayGovState era)
forall era (f :: * -> *).
Functor f =>
(Proposals era -> f (Proposals era))
-> ConwayGovState era -> f (ConwayGovState era)
cgsProposalsL ((Proposals era -> Identity (Proposals era))
 -> ConwayGovState era -> Identity (ConwayGovState era))
-> Proposals era -> ConwayGovState era -> ConwayGovState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proposals era
newProposals
        ConwayGovState era
-> (ConwayGovState era -> ConwayGovState era) -> ConwayGovState era
forall a b. a -> (a -> b) -> b
& (StrictMaybe (Committee era)
 -> Identity (StrictMaybe (Committee era)))
-> ConwayGovState era -> Identity (ConwayGovState era)
forall era (f :: * -> *).
Functor f =>
(StrictMaybe (Committee era) -> f (StrictMaybe (Committee era)))
-> ConwayGovState era -> f (ConwayGovState era)
cgsCommitteeL ((StrictMaybe (Committee era)
  -> Identity (StrictMaybe (Committee era)))
 -> ConwayGovState era -> Identity (ConwayGovState era))
-> StrictMaybe (Committee era)
-> ConwayGovState era
-> ConwayGovState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (Committee era)
ensCommittee
        ConwayGovState era
-> (ConwayGovState era -> ConwayGovState era) -> ConwayGovState era
forall a b. a -> (a -> b) -> b
& (Constitution era -> Identity (Constitution era))
-> ConwayGovState era -> Identity (ConwayGovState era)
forall era (f :: * -> *).
Functor f =>
(Constitution era -> f (Constitution era))
-> ConwayGovState era -> f (ConwayGovState era)
cgsConstitutionL ((Constitution era -> Identity (Constitution era))
 -> ConwayGovState era -> Identity (ConwayGovState era))
-> Constitution era -> ConwayGovState era -> ConwayGovState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Constitution era
ensConstitution
        ConwayGovState era
-> (ConwayGovState era -> ConwayGovState era) -> ConwayGovState era
forall a b. a -> (a -> b) -> b
& (PParams era -> Identity (PParams era))
-> ConwayGovState era -> Identity (ConwayGovState era)
forall era (f :: * -> *).
Functor f =>
(PParams era -> f (PParams era))
-> ConwayGovState era -> f (ConwayGovState era)
cgsCurPParamsL ((PParams era -> Identity (PParams era))
 -> ConwayGovState era -> Identity (ConwayGovState era))
-> PParams era -> ConwayGovState era -> ConwayGovState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ GovState era -> PParams era
forall era. EraGov era => GovState era -> PParams era
nextEpochPParams GovState era
govState0
        ConwayGovState era
-> (ConwayGovState era -> ConwayGovState era) -> ConwayGovState era
forall a b. a -> (a -> b) -> b
& (PParams era -> Identity (PParams era))
-> ConwayGovState era -> Identity (ConwayGovState era)
forall era (f :: * -> *).
Functor f =>
(PParams era -> f (PParams era))
-> ConwayGovState era -> f (ConwayGovState era)
cgsPrevPParamsL ((PParams era -> Identity (PParams era))
 -> ConwayGovState era -> Identity (ConwayGovState era))
-> PParams era -> ConwayGovState era -> ConwayGovState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams era
curPParams
        ConwayGovState era
-> (ConwayGovState era -> ConwayGovState era) -> ConwayGovState era
forall a b. a -> (a -> b) -> b
& (FuturePParams era -> Identity (FuturePParams era))
-> ConwayGovState era -> Identity (ConwayGovState era)
forall era (f :: * -> *).
Functor f =>
(FuturePParams era -> f (FuturePParams era))
-> ConwayGovState era -> f (ConwayGovState era)
cgsFuturePParamsL ((FuturePParams era -> Identity (FuturePParams era))
 -> ConwayGovState era -> Identity (ConwayGovState era))
-> FuturePParams era -> ConwayGovState era -> ConwayGovState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe (PParams era) -> FuturePParams era
forall era. Maybe (PParams era) -> FuturePParams era
PotentialPParamsUpdate Maybe (PParams era)
forall a. Maybe a
Nothing

    allRemovedGovActions = [Map GovActionId (GovActionState era)]
-> Map GovActionId (GovActionState era)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions [Map GovActionId (GovActionState era)
expiredActions, Map GovActionId (GovActionState era)
enactedActions, Map GovActionId (GovActionState era)
removedDueToEnactment]
    (newAccounts, unclaimed) =
      returnProposalDeposits allRemovedGovActions $ dState2 ^. accountsL
  tellEvent $
    GovInfoEvent
      (Set.fromList $ Map.elems enactedActions)
      (Set.fromList $ Map.elems removedDueToEnactment)
      (Set.fromList $ Map.elems expiredActions)
      unclaimed

  let
    certState2 =
      VState era -> PState era -> DState era -> CertState era
forall era.
ConwayEraCertState era =>
VState era -> PState era -> DState era -> CertState era
mkConwayCertState
        ( EpochNo -> Proposals era -> VState era -> VState era
forall era. EpochNo -> Proposals era -> VState era -> VState era
updateNumDormantEpochs EpochNo
Signal (EPOCH era)
eNo Proposals era
newProposals VState era
vState
            VState era -> (VState era -> VState era) -> VState era
forall a b. a -> (a -> b) -> b
& (CommitteeState era -> Identity (CommitteeState era))
-> VState era -> Identity (VState era)
forall era (f :: * -> *).
Functor f =>
(CommitteeState era -> f (CommitteeState era))
-> VState era -> f (VState era)
vsCommitteeStateL ((CommitteeState era -> Identity (CommitteeState era))
 -> VState era -> Identity (VState era))
-> (CommitteeState era -> CommitteeState era)
-> VState era
-> VState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ StrictMaybe (Committee era)
-> CommitteeState era -> CommitteeState era
forall era.
StrictMaybe (Committee era)
-> CommitteeState era -> CommitteeState era
updateCommitteeState (ConwayGovState era
govState1 ConwayGovState era
-> Getting
     (StrictMaybe (Committee era))
     (ConwayGovState era)
     (StrictMaybe (Committee era))
-> StrictMaybe (Committee era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe (Committee era))
  (ConwayGovState era)
  (StrictMaybe (Committee era))
forall era (f :: * -> *).
Functor f =>
(StrictMaybe (Committee era) -> f (StrictMaybe (Committee era)))
-> ConwayGovState era -> f (ConwayGovState era)
cgsCommitteeL)
        )
        (CertState era
certState1 CertState era
-> Getting (PState era) (CertState era) (PState era) -> PState era
forall s a. s -> Getting a s a -> a
^. Getting (PState era) (CertState era) (PState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
certPStateL)
        (DState era
dState2 DState era -> (DState era -> DState era) -> DState era
forall a b. a -> (a -> b) -> b
& (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))
 -> DState era -> Identity (DState era))
-> Accounts era -> DState era -> DState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Accounts era
newAccounts)
    chainAccountState3 =
      ChainAccountState
chainAccountState2
        ChainAccountState
-> (ChainAccountState -> ChainAccountState) -> ChainAccountState
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> ChainAccountState -> Identity ChainAccountState
Lens' ChainAccountState Coin
casTreasuryL ((Coin -> Identity Coin)
 -> ChainAccountState -> Identity ChainAccountState)
-> Coin -> ChainAccountState -> ChainAccountState
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ (UTxOState era
utxoState0 UTxOState era -> Getting Coin (UTxOState era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (UTxOState era) Coin
forall era (f :: * -> *).
Functor f =>
(Coin -> f Coin) -> UTxOState era -> f (UTxOState era)
utxosDonationL Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> Map GovActionId Coin -> Coin
forall m. Monoid m => Map GovActionId m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Map GovActionId Coin
unclaimed)
    utxoState2 =
      UTxOState era
utxoState1
        UTxOState era -> (UTxOState era -> UTxOState era) -> UTxOState era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> UTxOState era -> Identity (UTxOState era)
forall era (f :: * -> *).
Functor f =>
(Coin -> f Coin) -> UTxOState era -> f (UTxOState era)
utxosDepositedL ((Coin -> Identity Coin)
 -> UTxOState era -> Identity (UTxOState era))
-> Coin -> UTxOState era -> UTxOState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CertState era -> GovState era -> Coin
forall era.
(EraGov era, EraCertState era) =>
CertState era -> GovState era -> Coin
totalObligation CertState era
certState2 GovState era
ConwayGovState era
govState1
        UTxOState era -> (UTxOState era -> UTxOState era) -> UTxOState era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> UTxOState era -> Identity (UTxOState era)
forall era (f :: * -> *).
Functor f =>
(Coin -> f Coin) -> UTxOState era -> f (UTxOState era)
utxosDonationL ((Coin -> Identity Coin)
 -> UTxOState era -> Identity (UTxOState era))
-> Coin -> UTxOState era -> UTxOState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
forall t. Val t => t
zero
        UTxOState era -> (UTxOState era -> UTxOState era) -> UTxOState era
forall a b. a -> (a -> b) -> b
& (GovState era -> Identity (GovState era))
-> UTxOState era -> Identity (UTxOState era)
(ConwayGovState era -> Identity (ConwayGovState era))
-> UTxOState era -> Identity (UTxOState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> UTxOState era -> f (UTxOState era)
utxosGovStateL ((ConwayGovState era -> Identity (ConwayGovState era))
 -> UTxOState era -> Identity (UTxOState era))
-> ConwayGovState era -> UTxOState era -> UTxOState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ConwayGovState era
govState1
    ledgerState1 =
      LedgerState era
ledgerState0
        LedgerState era
-> (LedgerState era -> LedgerState era) -> LedgerState era
forall a b. a -> (a -> b) -> b
& (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))
-> CertState era -> LedgerState era -> LedgerState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CertState era
certState2
        LedgerState era
-> (LedgerState era -> LedgerState era) -> LedgerState era
forall a b. a -> (a -> b) -> b
& (UTxOState era -> Identity (UTxOState era))
-> LedgerState era -> Identity (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(UTxOState era -> f (UTxOState era))
-> LedgerState era -> f (LedgerState era)
lsUTxOStateL ((UTxOState era -> Identity (UTxOState era))
 -> LedgerState era -> Identity (LedgerState era))
-> UTxOState era -> LedgerState era -> LedgerState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ UTxOState era
utxoState2
    epochState1 =
      State (EPOCH era)
EpochState era
epochState0
        EpochState era
-> (EpochState era -> EpochState era) -> EpochState era
forall a b. a -> (a -> b) -> b
& (ChainAccountState -> Identity ChainAccountState)
-> EpochState era -> Identity (EpochState era)
forall era. Lens' (EpochState era) ChainAccountState
forall (t :: * -> *) era.
CanSetChainAccountState t =>
Lens' (t era) ChainAccountState
chainAccountStateL ((ChainAccountState -> Identity ChainAccountState)
 -> EpochState era -> Identity (EpochState era))
-> ChainAccountState -> EpochState era -> EpochState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ChainAccountState
chainAccountState3
        EpochState era
-> (EpochState era -> EpochState era) -> EpochState era
forall a b. a -> (a -> b) -> b
& (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))
-> LedgerState era -> EpochState era -> EpochState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ LedgerState era
ledgerState1
  tellEvent $ EpochBoundaryRatifyState ratifyState
  epochState2 <- do
    let curPv = EpochState era
epochState1 EpochState era
-> Getting ProtVer (EpochState era) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. (PParams era -> Const ProtVer (PParams era))
-> EpochState era -> Const ProtVer (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const ProtVer (PParams era))
 -> EpochState era -> Const ProtVer (EpochState era))
-> ((ProtVer -> Const ProtVer ProtVer)
    -> PParams era -> Const ProtVer (PParams era))
-> Getting ProtVer (EpochState era) ProtVer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtVer -> Const ProtVer ProtVer)
-> PParams era -> Const ProtVer (PParams era)
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams era) ProtVer
ppProtocolVersionL
    if curPv /= epochState1 ^. prevPParamsEpochStateL . ppProtocolVersionL
      then trans @(EraRule "HARDFORK" era) $ TRC ((), epochState1, curPv)
      else pure epochState1
  snapshots1 <-
    trans @(EraRule "SNAP" era) $
      TRC
        ( Shelley.SnapEnv (epochState2 ^. esLStateL) (epochState2 ^. curPParamsEpochStateL)
        , snapshots0
        , ()
        )
  let
    stakePoolDistr = SnapShots era -> PoolDistr
forall era. SnapShots era -> PoolDistr
ssStakeMarkPoolDistr SnapShots era
snapshots1
    epochState3 = EpochState era
epochState2 EpochState era
-> (EpochState era -> EpochState era) -> EpochState era
forall a b. a -> (a -> b) -> b
& (SnapShots era -> Identity (SnapShots era))
-> EpochState era -> Identity (EpochState era)
forall era (f :: * -> *).
Functor f =>
(SnapShots era -> f (SnapShots era))
-> EpochState era -> f (EpochState era)
esSnapshotsL ((SnapShots era -> Identity (SnapShots era))
 -> EpochState era -> Identity (EpochState era))
-> SnapShots era -> EpochState era -> EpochState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ SnapShots era
snapshots1
  liftSTS $ setFreshDRepPulsingState eNo stakePoolDistr epochState3

instance
  ( Era era
  , STS (Shelley.POOLREAP era)
  , Event (EraRule "POOLREAP" era) ~ Shelley.ShelleyPoolreapEvent era
  ) =>
  Embed (Shelley.POOLREAP era) (EPOCH era)
  where
  wrapFailed :: PredicateFailure (POOLREAP era) -> PredicateFailure (EPOCH era)
wrapFailed = \case {}
  wrapEvent :: Event (POOLREAP era) -> Event (EPOCH era)
wrapEvent = Event (EraRule "POOLREAP" era) -> ConwayEpochEvent era
Event (POOLREAP era) -> Event (EPOCH era)
forall era. Event (EraRule "POOLREAP" era) -> ConwayEpochEvent era
PoolReapEvent

instance
  ( EraTxOut era
  , EraStake era
  , EraCertState era
  , Event (EraRule "SNAP" era) ~ Shelley.SnapEvent era
  ) =>
  Embed (Shelley.SNAP era) (EPOCH era)
  where
  wrapFailed :: PredicateFailure (SNAP era) -> PredicateFailure (EPOCH era)
wrapFailed = \case {}
  wrapEvent :: Event (SNAP era) -> Event (EPOCH era)
wrapEvent = Event (EraRule "SNAP" era) -> ConwayEpochEvent era
Event (SNAP era) -> Event (EPOCH era)
forall era. Event (EraRule "SNAP" era) -> ConwayEpochEvent era
SnapEvent

instance
  ( EraGov era
  , PredicateFailure (RATIFY era) ~ Void
  , STS (RATIFY era)
  , BaseM (RATIFY era) ~ ShelleyBase
  , Event (RATIFY era) ~ Void
  ) =>
  Embed (RATIFY era) (EPOCH era)
  where
  wrapFailed :: PredicateFailure (RATIFY era) -> PredicateFailure (EPOCH era)
wrapFailed = Void -> Void
PredicateFailure (RATIFY era) -> PredicateFailure (EPOCH era)
forall a. Void -> a
absurd
  wrapEvent :: Event (RATIFY era) -> Event (EPOCH era)
wrapEvent = Void -> ConwayEpochEvent era
Event (RATIFY era) -> Event (EPOCH era)
forall a. Void -> a
absurd

instance
  ( EraGov era
  , PredicateFailure (HARDFORK era) ~ Void
  , STS (HARDFORK era)
  , BaseM (HARDFORK era) ~ ShelleyBase
  , Event (EraRule "HARDFORK" era) ~ ConwayHardForkEvent era
  ) =>
  Embed (HARDFORK era) (EPOCH era)
  where
  wrapFailed :: PredicateFailure (HARDFORK era) -> PredicateFailure (EPOCH era)
wrapFailed = Void -> Void
PredicateFailure (HARDFORK era) -> PredicateFailure (EPOCH era)
forall a. Void -> a
absurd
  wrapEvent :: Event (HARDFORK era) -> Event (EPOCH era)
wrapEvent = Event (EraRule "HARDFORK" era) -> ConwayEpochEvent era
Event (HARDFORK era) -> Event (EPOCH era)
forall era. Event (EraRule "HARDFORK" era) -> ConwayEpochEvent era
HardForkEvent

instance
  ( STS (EPOCH era)
  , Event (EraRule "EPOCH" era) ~ ConwayEpochEvent era
  ) =>
  Embed (EPOCH era) (NEWEPOCH era)
  where
  wrapFailed :: PredicateFailure (EPOCH era) -> PredicateFailure (NEWEPOCH era)
wrapFailed = \case {}
  wrapEvent :: Event (EPOCH era) -> Event (NEWEPOCH era)
wrapEvent = Event (EraRule "EPOCH" era) -> ConwayNewEpochEvent era
Event (EPOCH era) -> Event (NEWEPOCH era)
forall era. Event (EraRule "EPOCH" era) -> ConwayNewEpochEvent era
EpochEvent