{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Shelley.Rules.Epoch (
  ShelleyEPOCH,
  ShelleyEpochPredFailure (..),
  ShelleyEpochEvent (..),
  PredicateFailure,
  UpecPredFailure,
) where

import Cardano.Ledger.BaseTypes (ShelleyBase)
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.Era (ShelleyEPOCH)
import Cardano.Ledger.Shelley.LedgerState (
  EpochState,
  LedgerState,
  UTxOState (utxosDeposited, utxosGovState),
  curPParamsEpochStateL,
  esChainAccountState,
  esLState,
  esLStateL,
  esNonMyopic,
  esSnapshots,
  lsCertState,
  lsCertStateL,
  lsUTxOState,
  lsUTxOStateL,
  totalObligation,
  utxosGovStateL,
  pattern EpochState,
 )
import Cardano.Ledger.Shelley.LedgerState.Types (prevPParamsEpochStateL)
import Cardano.Ledger.Shelley.Rewards ()
import Cardano.Ledger.Shelley.Rules.PoolReap (
  ShelleyPOOLREAP,
  ShelleyPoolreapEvent,
  ShelleyPoolreapPredFailure,
  ShelleyPoolreapState (..),
 )
import Cardano.Ledger.Shelley.Rules.Snap (
  ShelleySNAP,
  ShelleySnapPredFailure,
  SnapEnv (..),
  SnapEvent,
 )
import Cardano.Ledger.Shelley.Rules.Upec (ShelleyUPEC, ShelleyUpecPredFailure, UpecState (..))
import Cardano.Ledger.Slot (EpochNo)
import Cardano.Ledger.State
import Control.DeepSeq (NFData)
import Control.SetAlgebra (eval, (⨃))
import Control.State.Transition (
  Embed (..),
  STS (..),
  TRC (..),
  TransitionRule,
  judgmentContext,
  trans,
 )
import Data.Default (Default)
import qualified Data.Map.Strict as Map
import Data.Void (Void)
import GHC.Generics (Generic)
import Lens.Micro
import NoThunks.Class (NoThunks (..))

type UpecPredFailure era = UpecPredFailurePV (ProtVerLow era) era

type family UpecPredFailurePV pv era where
  UpecPredFailurePV 2 era = ShelleyUpecPredFailure era
  UpecPredFailurePV 3 era = ShelleyUpecPredFailure era
  UpecPredFailurePV 4 era = ShelleyUpecPredFailure era
  UpecPredFailurePV 5 era = ShelleyUpecPredFailure era
  UpecPredFailurePV 6 era = ShelleyUpecPredFailure era
  UpecPredFailurePV 7 era = ShelleyUpecPredFailure era
  UpecPredFailurePV 8 era = ShelleyUpecPredFailure era
  UpecPredFailurePV _ era = Void

data ShelleyEpochPredFailure era
  = PoolReapFailure (PredicateFailure (EraRule "POOLREAP" era)) -- Subtransition Failures
  | SnapFailure (PredicateFailure (EraRule "SNAP" era)) -- Subtransition Failures
  | UpecFailure (UpecPredFailure era) -- Subtransition Failures
  deriving ((forall x.
 ShelleyEpochPredFailure era -> Rep (ShelleyEpochPredFailure era) x)
-> (forall x.
    Rep (ShelleyEpochPredFailure era) x -> ShelleyEpochPredFailure era)
-> Generic (ShelleyEpochPredFailure era)
forall x.
Rep (ShelleyEpochPredFailure era) x -> ShelleyEpochPredFailure era
forall x.
ShelleyEpochPredFailure era -> Rep (ShelleyEpochPredFailure era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ShelleyEpochPredFailure era) x -> ShelleyEpochPredFailure era
forall era x.
ShelleyEpochPredFailure era -> Rep (ShelleyEpochPredFailure era) x
$cfrom :: forall era x.
ShelleyEpochPredFailure era -> Rep (ShelleyEpochPredFailure era) x
from :: forall x.
ShelleyEpochPredFailure era -> Rep (ShelleyEpochPredFailure era) x
$cto :: forall era x.
Rep (ShelleyEpochPredFailure era) x -> ShelleyEpochPredFailure era
to :: forall x.
Rep (ShelleyEpochPredFailure era) x -> ShelleyEpochPredFailure era
Generic)

deriving stock instance
  ( Eq (PredicateFailure (EraRule "POOLREAP" era))
  , Eq (PredicateFailure (EraRule "SNAP" era))
  , Eq (UpecPredFailure era)
  ) =>
  Eq (ShelleyEpochPredFailure era)

deriving stock instance
  ( Show (PredicateFailure (EraRule "POOLREAP" era))
  , Show (PredicateFailure (EraRule "SNAP" era))
  , Show (UpecPredFailure era)
  ) =>
  Show (ShelleyEpochPredFailure era)

instance
  ( NFData (PredicateFailure (EraRule "POOLREAP" era))
  , NFData (PredicateFailure (EraRule "SNAP" era))
  , NFData (UpecPredFailure era)
  ) =>
  NFData (ShelleyEpochPredFailure era)

data ShelleyEpochEvent era
  = PoolReapEvent (Event (EraRule "POOLREAP" era))
  | SnapEvent (Event (EraRule "SNAP" era))
  | UpecEvent (Event (EraRule "UPEC" era))
  deriving ((forall x. ShelleyEpochEvent era -> Rep (ShelleyEpochEvent era) x)
-> (forall x.
    Rep (ShelleyEpochEvent era) x -> ShelleyEpochEvent era)
-> Generic (ShelleyEpochEvent era)
forall x. Rep (ShelleyEpochEvent era) x -> ShelleyEpochEvent era
forall x. ShelleyEpochEvent era -> Rep (ShelleyEpochEvent era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ShelleyEpochEvent era) x -> ShelleyEpochEvent era
forall era x.
ShelleyEpochEvent era -> Rep (ShelleyEpochEvent era) x
$cfrom :: forall era x.
ShelleyEpochEvent era -> Rep (ShelleyEpochEvent era) x
from :: forall x. ShelleyEpochEvent era -> Rep (ShelleyEpochEvent era) x
$cto :: forall era x.
Rep (ShelleyEpochEvent era) x -> ShelleyEpochEvent era
to :: forall x. Rep (ShelleyEpochEvent era) x -> ShelleyEpochEvent era
Generic)

deriving instance
  ( Eq (Event (EraRule "POOLREAP" era))
  , Eq (Event (EraRule "SNAP" era))
  , Eq (Event (EraRule "UPEC" era))
  ) =>
  Eq (ShelleyEpochEvent era)

instance
  ( NFData (Event (EraRule "POOLREAP" era))
  , NFData (Event (EraRule "SNAP" era))
  , NFData (Event (EraRule "UPEC" era))
  ) =>
  NFData (ShelleyEpochEvent era)

instance
  ( EraTxOut era
  , EraGov era
  , EraStake era
  , EraCertState era
  , GovState era ~ ShelleyGovState era
  , Embed (EraRule "SNAP" era) (ShelleyEPOCH era)
  , Environment (EraRule "SNAP" era) ~ SnapEnv era
  , State (EraRule "SNAP" era) ~ SnapShots
  , Signal (EraRule "SNAP" era) ~ ()
  , Embed (EraRule "POOLREAP" era) (ShelleyEPOCH era)
  , Environment (EraRule "POOLREAP" era) ~ ()
  , State (EraRule "POOLREAP" era) ~ ShelleyPoolreapState era
  , Signal (EraRule "POOLREAP" era) ~ EpochNo
  , Embed (EraRule "UPEC" era) (ShelleyEPOCH era)
  , Environment (EraRule "UPEC" era) ~ LedgerState era
  , State (EraRule "UPEC" era) ~ UpecState era
  , Signal (EraRule "UPEC" era) ~ ()
  , Default (PParams era)
  , Eq (UpecPredFailure era)
  , Show (UpecPredFailure era)
  ) =>
  STS (ShelleyEPOCH era)
  where
  type State (ShelleyEPOCH era) = EpochState era
  type Signal (ShelleyEPOCH era) = EpochNo
  type Environment (ShelleyEPOCH era) = ()
  type BaseM (ShelleyEPOCH era) = ShelleyBase
  type PredicateFailure (ShelleyEPOCH era) = ShelleyEpochPredFailure era
  type Event (ShelleyEPOCH era) = ShelleyEpochEvent era
  transitionRules :: [TransitionRule (ShelleyEPOCH era)]
transitionRules = [TransitionRule (ShelleyEPOCH era)
forall era.
(Embed (EraRule "SNAP" era) (ShelleyEPOCH era),
 Environment (EraRule "SNAP" era) ~ SnapEnv era,
 State (EraRule "SNAP" era) ~ SnapShots,
 Signal (EraRule "SNAP" era) ~ (),
 Embed (EraRule "POOLREAP" era) (ShelleyEPOCH era),
 Environment (EraRule "POOLREAP" era) ~ (),
 State (EraRule "POOLREAP" era) ~ ShelleyPoolreapState era,
 Signal (EraRule "POOLREAP" era) ~ EpochNo,
 Embed (EraRule "UPEC" era) (ShelleyEPOCH era),
 Environment (EraRule "UPEC" era) ~ LedgerState era,
 State (EraRule "UPEC" era) ~ UpecState era,
 Signal (EraRule "UPEC" era) ~ (),
 GovState era ~ ShelleyGovState era, EraGov era,
 EraCertState era) =>
TransitionRule (ShelleyEPOCH era)
epochTransition]

instance
  ( NoThunks (PredicateFailure (EraRule "POOLREAP" era))
  , NoThunks (PredicateFailure (EraRule "SNAP" era))
  , NoThunks (UpecPredFailure era)
  ) =>
  NoThunks (ShelleyEpochPredFailure era)

epochTransition ::
  forall era.
  ( Embed (EraRule "SNAP" era) (ShelleyEPOCH era)
  , Environment (EraRule "SNAP" era) ~ SnapEnv era
  , State (EraRule "SNAP" era) ~ SnapShots
  , Signal (EraRule "SNAP" era) ~ ()
  , Embed (EraRule "POOLREAP" era) (ShelleyEPOCH era)
  , Environment (EraRule "POOLREAP" era) ~ ()
  , State (EraRule "POOLREAP" era) ~ ShelleyPoolreapState era
  , Signal (EraRule "POOLREAP" era) ~ EpochNo
  , Embed (EraRule "UPEC" era) (ShelleyEPOCH era)
  , Environment (EraRule "UPEC" era) ~ LedgerState era
  , State (EraRule "UPEC" era) ~ UpecState era
  , Signal (EraRule "UPEC" era) ~ ()
  , GovState era ~ ShelleyGovState era
  , EraGov era
  , EraCertState era
  ) =>
  TransitionRule (ShelleyEPOCH era)
epochTransition :: forall era.
(Embed (EraRule "SNAP" era) (ShelleyEPOCH era),
 Environment (EraRule "SNAP" era) ~ SnapEnv era,
 State (EraRule "SNAP" era) ~ SnapShots,
 Signal (EraRule "SNAP" era) ~ (),
 Embed (EraRule "POOLREAP" era) (ShelleyEPOCH era),
 Environment (EraRule "POOLREAP" era) ~ (),
 State (EraRule "POOLREAP" era) ~ ShelleyPoolreapState era,
 Signal (EraRule "POOLREAP" era) ~ EpochNo,
 Embed (EraRule "UPEC" era) (ShelleyEPOCH era),
 Environment (EraRule "UPEC" era) ~ LedgerState era,
 State (EraRule "UPEC" era) ~ UpecState era,
 Signal (EraRule "UPEC" era) ~ (),
 GovState era ~ ShelleyGovState era, EraGov era,
 EraCertState era) =>
TransitionRule (ShelleyEPOCH era)
epochTransition = do
  TRC
    ( Environment (ShelleyEPOCH era)
_
      , es :: State (ShelleyEPOCH era)
es@EpochState
          { esChainAccountState :: forall era. EpochState era -> ChainAccountState
esChainAccountState = ChainAccountState
chainAccountState
          , esSnapshots :: forall era. EpochState era -> SnapShots
esSnapshots = SnapShots
ss
          , esLState :: forall era. EpochState era -> LedgerState era
esLState = LedgerState era
ls
          , esNonMyopic :: forall era. EpochState era -> NonMyopic
esNonMyopic = NonMyopic
nm
          }
      , Signal (ShelleyEPOCH era)
e
      ) <-
    Rule
  (ShelleyEPOCH era)
  'Transition
  (RuleContext 'Transition (ShelleyEPOCH era))
F (Clause (ShelleyEPOCH era) 'Transition) (TRC (ShelleyEPOCH era))
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
  let pp :: PParams era
pp = State (ShelleyEPOCH era)
EpochState era
es EpochState era
-> Getting (PParams era) (EpochState era) (PParams era)
-> PParams era
forall s a. s -> Getting a s a -> a
^. Getting (PParams era) (EpochState era) (PParams era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL
      utxoSt :: UTxOState era
utxoSt = LedgerState era -> UTxOState era
forall era. LedgerState era -> UTxOState era
lsUTxOState LedgerState era
ls
      certState :: CertState era
certState = LedgerState era
ls 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
      pstate :: PState era
pstate = CertState era
certState 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
  SnapShots
ss' <-
    forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @(EraRule "SNAP" era) (RuleContext 'Transition (EraRule "SNAP" era)
 -> Rule
      (ShelleyEPOCH era) 'Transition (State (EraRule "SNAP" era)))
-> RuleContext 'Transition (EraRule "SNAP" era)
-> Rule (ShelleyEPOCH era) 'Transition (State (EraRule "SNAP" era))
forall a b. (a -> b) -> a -> b
$ (Environment (EraRule "SNAP" era), State (EraRule "SNAP" era),
 Signal (EraRule "SNAP" era))
-> TRC (EraRule "SNAP" era)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (LedgerState era -> PParams era -> SnapEnv era
forall era. LedgerState era -> PParams era -> SnapEnv era
SnapEnv LedgerState era
ls PParams era
pp, SnapShots
State (EraRule "SNAP" era)
ss, ())

  let PState Map (KeyHash 'StakePool) PoolParams
pParams Map (KeyHash 'StakePool) PoolParams
fPParams Map (KeyHash 'StakePool) EpochNo
_ Map (KeyHash 'StakePool) (CompactForm Coin)
_ = PState era
pstate
      ppp :: Map (KeyHash 'StakePool) PoolParams
ppp = Exp (Map (KeyHash 'StakePool) PoolParams)
-> Map (KeyHash 'StakePool) PoolParams
forall s t. Embed s t => Exp t -> s
eval (Map (KeyHash 'StakePool) PoolParams
pParams Map (KeyHash 'StakePool) PoolParams
-> Map (KeyHash 'StakePool) PoolParams
-> Exp (Map (KeyHash 'StakePool) PoolParams)
forall k s1 (f :: * -> * -> *) v s2 (g :: * -> * -> *).
(Ord k, HasExp s1 (f k v), HasExp s2 (g k v)) =>
s1 -> s2 -> Exp (f k v)
⨃ Map (KeyHash 'StakePool) PoolParams
fPParams)
      pstate' :: PState era
pstate' =
        PState era
pstate
          { psStakePoolParams = ppp
          , psFutureStakePoolParams = Map.empty
          }
  PoolreapState UTxOState era
utxoSt' ChainAccountState
chainAccountState' CertState era
adjustedCertState <-
    forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @(EraRule "POOLREAP" era) (RuleContext 'Transition (EraRule "POOLREAP" era)
 -> Rule
      (ShelleyEPOCH era) 'Transition (State (EraRule "POOLREAP" era)))
-> RuleContext 'Transition (EraRule "POOLREAP" era)
-> Rule
     (ShelleyEPOCH era) 'Transition (State (EraRule "POOLREAP" era))
forall a b. (a -> b) -> a -> b
$
      (Environment (EraRule "POOLREAP" era),
 State (EraRule "POOLREAP" era), Signal (EraRule "POOLREAP" era))
-> TRC (EraRule "POOLREAP" era)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC ((), UTxOState era
-> ChainAccountState -> CertState era -> ShelleyPoolreapState era
forall era.
UTxOState era
-> ChainAccountState -> CertState era -> ShelleyPoolreapState era
PoolreapState UTxOState era
utxoSt ChainAccountState
chainAccountState (CertState era
certState CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (PState era -> Identity (PState era))
-> CertState era -> Identity (CertState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
certPStateL ((PState era -> Identity (PState era))
 -> CertState era -> Identity (CertState era))
-> PState era -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PState era
pstate'), Signal (EraRule "POOLREAP" era)
Signal (ShelleyEPOCH era)
e)

  let ls' :: LedgerState era
ls' = LedgerState era
ls {lsUTxOState = utxoSt', lsCertState = adjustedCertState}

  UpecState PParams era
pp' ShelleyGovState era
ppupSt' <-
    forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @(EraRule "UPEC" era) (RuleContext 'Transition (EraRule "UPEC" era)
 -> Rule
      (ShelleyEPOCH era) 'Transition (State (EraRule "UPEC" era)))
-> RuleContext 'Transition (EraRule "UPEC" era)
-> Rule (ShelleyEPOCH era) 'Transition (State (EraRule "UPEC" era))
forall a b. (a -> b) -> a -> b
$
      (Environment (EraRule "UPEC" era), State (EraRule "UPEC" era),
 Signal (EraRule "UPEC" era))
-> TRC (EraRule "UPEC" era)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (Environment (EraRule "UPEC" era)
LedgerState era
ls', PParams era -> ShelleyGovState era -> UpecState era
forall era. PParams era -> ShelleyGovState era -> UpecState era
UpecState PParams era
pp (UTxOState era -> GovState era
forall era. UTxOState era -> GovState era
utxosGovState UTxOState era
utxoSt'), ())
  let utxoSt'' :: UTxOState era
utxoSt'' = UTxOState era
utxoSt' {utxosGovState = ppupSt'}

  let
    -- At the epoch boundary refunds are made, so we need to change what
    -- the utxosDeposited field is. The other two places where deposits are
    -- kept (dsUnified of DState and psDeposits of PState) are adjusted by
    -- the rules, So we can recompute the utxosDeposited field using adjustedCertState
    -- since we have the invariant that: obligationCertState dpstate == utxosDeposited utxostate
    oblgNew :: Coin
oblgNew = CertState era -> GovState era -> Coin
forall era.
(EraGov era, EraCertState era) =>
CertState era -> GovState era -> Coin
totalObligation CertState era
adjustedCertState (UTxOState era
utxoSt'' UTxOState era
-> Getting
     (ShelleyGovState era) (UTxOState era) (ShelleyGovState era)
-> ShelleyGovState era
forall s a. s -> Getting a s a -> a
^. (GovState era -> Const (ShelleyGovState era) (GovState era))
-> UTxOState era -> Const (ShelleyGovState era) (UTxOState era)
Getting (ShelleyGovState era) (UTxOState era) (ShelleyGovState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> UTxOState era -> f (UTxOState era)
utxosGovStateL)
    utxoSt''' :: UTxOState era
utxoSt''' = UTxOState era
utxoSt'' {utxosDeposited = oblgNew}
  EpochState era
-> F (Clause (ShelleyEPOCH era) 'Transition) (EpochState era)
forall a. a -> F (Clause (ShelleyEPOCH era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EpochState era
 -> F (Clause (ShelleyEPOCH era) 'Transition) (EpochState era))
-> EpochState era
-> F (Clause (ShelleyEPOCH era) 'Transition) (EpochState era)
forall a b. (a -> b) -> a -> b
$
    ChainAccountState
-> LedgerState era -> SnapShots -> NonMyopic -> EpochState era
forall era.
ChainAccountState
-> LedgerState era -> SnapShots -> NonMyopic -> EpochState era
EpochState ChainAccountState
chainAccountState' LedgerState era
ls' SnapShots
ss' NonMyopic
nm
      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))
-> ((UTxOState era -> Identity (UTxOState era))
    -> LedgerState era -> Identity (LedgerState era))
-> (UTxOState era -> Identity (UTxOState era))
-> EpochState era
-> Identity (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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))
 -> EpochState era -> Identity (EpochState era))
-> UTxOState era -> EpochState era -> EpochState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ UTxOState era
utxoSt'''
      EpochState era
-> (EpochState era -> EpochState era) -> EpochState era
forall a b. a -> (a -> b) -> b
& (PParams era -> Identity (PParams era))
-> EpochState era -> Identity (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
prevPParamsEpochStateL ((PParams era -> Identity (PParams era))
 -> EpochState era -> Identity (EpochState era))
-> PParams era -> EpochState era -> EpochState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams era
pp
      EpochState era
-> (EpochState era -> EpochState era) -> EpochState era
forall a b. a -> (a -> b) -> b
& (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))
-> PParams era -> EpochState era -> EpochState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams era
pp'

instance
  ( EraTxOut era
  , EraStake era
  , PredicateFailure (EraRule "SNAP" era) ~ ShelleySnapPredFailure era
  , Event (EraRule "SNAP" era) ~ SnapEvent era
  , EraCertState era
  ) =>
  Embed (ShelleySNAP era) (ShelleyEPOCH era)
  where
  wrapFailed :: PredicateFailure (ShelleySNAP era)
-> PredicateFailure (ShelleyEPOCH era)
wrapFailed = PredicateFailure (EraRule "SNAP" era)
-> ShelleyEpochPredFailure era
PredicateFailure (ShelleySNAP era)
-> PredicateFailure (ShelleyEPOCH era)
forall era.
PredicateFailure (EraRule "SNAP" era)
-> ShelleyEpochPredFailure era
SnapFailure
  wrapEvent :: Event (ShelleySNAP era) -> Event (ShelleyEPOCH era)
wrapEvent = Event (EraRule "SNAP" era) -> ShelleyEpochEvent era
Event (ShelleySNAP era) -> Event (ShelleyEPOCH era)
forall era. Event (EraRule "SNAP" era) -> ShelleyEpochEvent era
SnapEvent

instance
  ( Era era
  , STS (ShelleyPOOLREAP era)
  , PredicateFailure (EraRule "POOLREAP" era) ~ ShelleyPoolreapPredFailure era
  , Event (EraRule "POOLREAP" era) ~ ShelleyPoolreapEvent era
  ) =>
  Embed (ShelleyPOOLREAP era) (ShelleyEPOCH era)
  where
  wrapFailed :: PredicateFailure (ShelleyPOOLREAP era)
-> PredicateFailure (ShelleyEPOCH era)
wrapFailed = PredicateFailure (EraRule "POOLREAP" era)
-> ShelleyEpochPredFailure era
PredicateFailure (ShelleyPOOLREAP era)
-> PredicateFailure (ShelleyEPOCH era)
forall era.
PredicateFailure (EraRule "POOLREAP" era)
-> ShelleyEpochPredFailure era
PoolReapFailure
  wrapEvent :: Event (ShelleyPOOLREAP era) -> Event (ShelleyEPOCH era)
wrapEvent = Event (EraRule "POOLREAP" era) -> ShelleyEpochEvent era
Event (ShelleyPOOLREAP era) -> Event (ShelleyEPOCH era)
forall era. Event (EraRule "POOLREAP" era) -> ShelleyEpochEvent era
PoolReapEvent

instance
  ( Era era
  , STS (ShelleyUPEC era)
  , UpecPredFailure era ~ ShelleyUpecPredFailure era
  , Event (EraRule "UPEC" era) ~ Void
  ) =>
  Embed (ShelleyUPEC era) (ShelleyEPOCH era)
  where
  wrapFailed :: PredicateFailure (ShelleyUPEC era)
-> PredicateFailure (ShelleyEPOCH era)
wrapFailed = PredicateFailure (ShelleyUPEC era)
-> PredicateFailure (ShelleyEPOCH era)
UpecPredFailure era -> ShelleyEpochPredFailure era
forall era. UpecPredFailure era -> ShelleyEpochPredFailure era
UpecFailure
  wrapEvent :: Event (ShelleyUPEC era) -> Event (ShelleyEPOCH era)
wrapEvent = Event (EraRule "UPEC" era) -> ShelleyEpochEvent era
Event (ShelleyUPEC era) -> Event (ShelleyEPOCH era)
forall era. Event (EraRule "UPEC" era) -> ShelleyEpochEvent era
UpecEvent