{-# 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.State.Transition (
  Embed (..),
  STS (..),
  TRC (..),
  TransitionRule,
  judgmentContext,
  trans,
 )
import Data.Default (Default)
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
  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, ())

  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, 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