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

module Cardano.Ledger.Shelley.Rules.Delpl (
  ShelleyDELPL,
  DelplEnv (..),
  ShelleyDelplPredFailure (..),
  ShelleyDelplEvent,
  PredicateFailure,
) where

import Cardano.Ledger.BaseTypes (EpochNo, ShelleyBase, invalidKey)
import Cardano.Ledger.Binary (
  DecCBOR (..),
  EncCBOR (..),
  decodeRecordSum,
  encodeListLen,
 )
import Cardano.Ledger.Credential (Ptr)
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.Era (ShelleyDELPL, ShelleyEra)
import Cardano.Ledger.Shelley.LedgerState (
  ChainAccountState,
  DState,
  PState,
 )
import Cardano.Ledger.Shelley.Rules.Deleg (
  DelegEnv (..),
  ShelleyDELEG,
  ShelleyDelegEvent,
  ShelleyDelegPredFailure,
 )
import Cardano.Ledger.Shelley.Rules.Pool (PoolEnv (..), ShelleyPOOL, ShelleyPoolPredFailure)
import qualified Cardano.Ledger.Shelley.Rules.Pool as Pool
import Cardano.Ledger.Shelley.TxCert (GenesisDelegCert (..), ShelleyTxCert (..))
import Cardano.Ledger.Slot (SlotNo)
import Cardano.Ledger.State (EraCertState (..))
import Control.DeepSeq
import Control.State.Transition
import Data.Typeable (Typeable)
import Data.Word (Word8)
import GHC.Generics (Generic)
import Lens.Micro ((&), (.~), (^.))
import NoThunks.Class (NoThunks (..))

data DelplEnv era = DelplEnv
  { forall era. DelplEnv era -> SlotNo
delplSlotNo :: SlotNo
  , forall era. DelplEnv era -> EpochNo
delplEpochNo :: EpochNo
  , forall era. DelplEnv era -> Ptr
delPlPtr :: Ptr
  , forall era. DelplEnv era -> PParams era
delPlPp :: PParams era
  , forall era. DelplEnv era -> ChainAccountState
delPlAccount :: ChainAccountState
  }

data ShelleyDelplPredFailure era
  = PoolFailure (PredicateFailure (EraRule "POOL" era)) -- Subtransition Failures
  | DelegFailure (PredicateFailure (EraRule "DELEG" era)) -- Subtransition Failures
  deriving ((forall x.
 ShelleyDelplPredFailure era -> Rep (ShelleyDelplPredFailure era) x)
-> (forall x.
    Rep (ShelleyDelplPredFailure era) x -> ShelleyDelplPredFailure era)
-> Generic (ShelleyDelplPredFailure era)
forall x.
Rep (ShelleyDelplPredFailure era) x -> ShelleyDelplPredFailure era
forall x.
ShelleyDelplPredFailure era -> Rep (ShelleyDelplPredFailure era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ShelleyDelplPredFailure era) x -> ShelleyDelplPredFailure era
forall era x.
ShelleyDelplPredFailure era -> Rep (ShelleyDelplPredFailure era) x
$cfrom :: forall era x.
ShelleyDelplPredFailure era -> Rep (ShelleyDelplPredFailure era) x
from :: forall x.
ShelleyDelplPredFailure era -> Rep (ShelleyDelplPredFailure era) x
$cto :: forall era x.
Rep (ShelleyDelplPredFailure era) x -> ShelleyDelplPredFailure era
to :: forall x.
Rep (ShelleyDelplPredFailure era) x -> ShelleyDelplPredFailure era
Generic)

type instance EraRuleFailure "DELPL" ShelleyEra = ShelleyDelplPredFailure ShelleyEra

instance InjectRuleFailure "DELPL" ShelleyDelplPredFailure ShelleyEra

instance InjectRuleFailure "DELPL" ShelleyPoolPredFailure ShelleyEra where
  injectFailure :: ShelleyPoolPredFailure ShelleyEra
-> EraRuleFailure "DELPL" ShelleyEra
injectFailure = PredicateFailure (EraRule "POOL" ShelleyEra)
-> ShelleyDelplPredFailure ShelleyEra
ShelleyPoolPredFailure ShelleyEra
-> EraRuleFailure "DELPL" ShelleyEra
forall era.
PredicateFailure (EraRule "POOL" era)
-> ShelleyDelplPredFailure era
PoolFailure

instance InjectRuleFailure "DELPL" ShelleyDelegPredFailure ShelleyEra where
  injectFailure :: ShelleyDelegPredFailure ShelleyEra
-> EraRuleFailure "DELPL" ShelleyEra
injectFailure = PredicateFailure (EraRule "DELEG" ShelleyEra)
-> ShelleyDelplPredFailure ShelleyEra
ShelleyDelegPredFailure ShelleyEra
-> EraRuleFailure "DELPL" ShelleyEra
forall era.
PredicateFailure (EraRule "DELEG" era)
-> ShelleyDelplPredFailure era
DelegFailure

data ShelleyDelplEvent era
  = PoolEvent (Event (EraRule "POOL" era))
  | DelegEvent (Event (EraRule "DELEG" era))
  deriving ((forall x. ShelleyDelplEvent era -> Rep (ShelleyDelplEvent era) x)
-> (forall x.
    Rep (ShelleyDelplEvent era) x -> ShelleyDelplEvent era)
-> Generic (ShelleyDelplEvent era)
forall x. Rep (ShelleyDelplEvent era) x -> ShelleyDelplEvent era
forall x. ShelleyDelplEvent era -> Rep (ShelleyDelplEvent era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ShelleyDelplEvent era) x -> ShelleyDelplEvent era
forall era x.
ShelleyDelplEvent era -> Rep (ShelleyDelplEvent era) x
$cfrom :: forall era x.
ShelleyDelplEvent era -> Rep (ShelleyDelplEvent era) x
from :: forall x. ShelleyDelplEvent era -> Rep (ShelleyDelplEvent era) x
$cto :: forall era x.
Rep (ShelleyDelplEvent era) x -> ShelleyDelplEvent era
to :: forall x. Rep (ShelleyDelplEvent era) x -> ShelleyDelplEvent era
Generic)

instance
  ( NFData (Event (EraRule "DELEG" era))
  , NFData (Event (EraRule "POOL" era))
  ) =>
  NFData (ShelleyDelplEvent era)

deriving instance
  ( Eq (Event (EraRule "DELEG" era))
  , Eq (Event (EraRule "POOL" era))
  ) =>
  Eq (ShelleyDelplEvent era)

deriving stock instance
  ( Eq (PredicateFailure (EraRule "DELEG" era))
  , Eq (PredicateFailure (EraRule "POOL" era))
  ) =>
  Eq (ShelleyDelplPredFailure era)

deriving stock instance
  ( Show (PredicateFailure (EraRule "DELEG" era))
  , Show (PredicateFailure (EraRule "POOL" era))
  ) =>
  Show (ShelleyDelplPredFailure era)

instance
  ( NoThunks (PredicateFailure (EraRule "DELEG" era))
  , NoThunks (PredicateFailure (EraRule "POOL" era))
  ) =>
  NoThunks (ShelleyDelplPredFailure era)

instance
  ( NFData (PredicateFailure (EraRule "DELEG" era))
  , NFData (PredicateFailure (EraRule "POOL" era))
  ) =>
  NFData (ShelleyDelplPredFailure era)

instance
  ( Era era
  , EraCertState era
  , Embed (EraRule "DELEG" era) (ShelleyDELPL era)
  , Environment (EraRule "DELEG" era) ~ DelegEnv era
  , State (EraRule "DELEG" era) ~ DState era
  , Embed (EraRule "POOL" era) (ShelleyDELPL era)
  , Environment (EraRule "POOL" era) ~ PoolEnv era
  , State (EraRule "POOL" era) ~ PState era
  , Signal (EraRule "DELEG" era) ~ TxCert era
  , Embed (EraRule "POOL" era) (ShelleyDELPL era)
  , Environment (EraRule "POOL" era) ~ PoolEnv era
  , Signal (EraRule "POOL" era) ~ PoolCert
  , TxCert era ~ ShelleyTxCert era
  ) =>
  STS (ShelleyDELPL era)
  where
  type State (ShelleyDELPL era) = CertState era
  type Signal (ShelleyDELPL era) = TxCert era
  type Environment (ShelleyDELPL era) = DelplEnv era
  type BaseM (ShelleyDELPL era) = ShelleyBase
  type PredicateFailure (ShelleyDELPL era) = ShelleyDelplPredFailure era
  type Event (ShelleyDELPL era) = ShelleyDelplEvent era

  transitionRules :: [TransitionRule (ShelleyDELPL era)]
transitionRules = [TransitionRule (ShelleyDELPL era)
forall era.
(Embed (EraRule "DELEG" era) (ShelleyDELPL era),
 Environment (EraRule "DELEG" era) ~ DelegEnv era,
 State (EraRule "DELEG" era) ~ DState era,
 State (EraRule "POOL" era) ~ PState era,
 Signal (EraRule "DELEG" era) ~ TxCert era,
 Embed (EraRule "POOL" era) (ShelleyDELPL era),
 Environment (EraRule "POOL" era) ~ PoolEnv era,
 Signal (EraRule "POOL" era) ~ PoolCert,
 TxCert era ~ ShelleyTxCert era, EraCertState era) =>
TransitionRule (ShelleyDELPL era)
delplTransition]

instance
  ( Era era
  , EncCBOR (PredicateFailure (EraRule "POOL" era))
  , EncCBOR (PredicateFailure (EraRule "DELEG" era))
  , Typeable (Script era)
  ) =>
  EncCBOR (ShelleyDelplPredFailure era)
  where
  encCBOR :: ShelleyDelplPredFailure era -> Encoding
encCBOR = \case
    (PoolFailure PredicateFailure (EraRule "POOL" era)
a) ->
      Word -> Encoding
encodeListLen Word
2
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
0 :: Word8)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> PredicateFailure (EraRule "POOL" era) -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR PredicateFailure (EraRule "POOL" era)
a
    (DelegFailure PredicateFailure (EraRule "DELEG" era)
a) ->
      Word -> Encoding
encodeListLen Word
2
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
1 :: Word8)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> PredicateFailure (EraRule "DELEG" era) -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR PredicateFailure (EraRule "DELEG" era)
a

instance
  ( Era era
  , DecCBOR (PredicateFailure (EraRule "POOL" era))
  , DecCBOR (PredicateFailure (EraRule "DELEG" era))
  , Typeable (Script era)
  ) =>
  DecCBOR (ShelleyDelplPredFailure era)
  where
  decCBOR :: forall s. Decoder s (ShelleyDelplPredFailure era)
decCBOR =
    Text
-> (Word -> Decoder s (Int, ShelleyDelplPredFailure era))
-> Decoder s (ShelleyDelplPredFailure era)
forall s a. Text -> (Word -> Decoder s (Int, a)) -> Decoder s a
decodeRecordSum
      Text
"PredicateFailure (DELPL era)"
      ( \case
          Word
0 -> do
            PredicateFailure (EraRule "POOL" era)
a <- Decoder s (PredicateFailure (EraRule "POOL" era))
forall s. Decoder s (PredicateFailure (EraRule "POOL" era))
forall a s. DecCBOR a => Decoder s a
decCBOR
            (Int, ShelleyDelplPredFailure era)
-> Decoder s (Int, ShelleyDelplPredFailure era)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
2, PredicateFailure (EraRule "POOL" era)
-> ShelleyDelplPredFailure era
forall era.
PredicateFailure (EraRule "POOL" era)
-> ShelleyDelplPredFailure era
PoolFailure PredicateFailure (EraRule "POOL" era)
a)
          Word
1 -> do
            PredicateFailure (EraRule "DELEG" era)
a <- Decoder s (PredicateFailure (EraRule "DELEG" era))
forall s. Decoder s (PredicateFailure (EraRule "DELEG" era))
forall a s. DecCBOR a => Decoder s a
decCBOR
            (Int, ShelleyDelplPredFailure era)
-> Decoder s (Int, ShelleyDelplPredFailure era)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
2, PredicateFailure (EraRule "DELEG" era)
-> ShelleyDelplPredFailure era
forall era.
PredicateFailure (EraRule "DELEG" era)
-> ShelleyDelplPredFailure era
DelegFailure PredicateFailure (EraRule "DELEG" era)
a)
          Word
k -> Word -> Decoder s (Int, ShelleyDelplPredFailure era)
forall a (m :: * -> *). (Typeable a, MonadFail m) => Word -> m a
invalidKey Word
k
      )

delplTransition ::
  forall era.
  ( Embed (EraRule "DELEG" era) (ShelleyDELPL era)
  , Environment (EraRule "DELEG" era) ~ DelegEnv era
  , State (EraRule "DELEG" era) ~ DState era
  , State (EraRule "POOL" era) ~ PState era
  , Signal (EraRule "DELEG" era) ~ TxCert era
  , Embed (EraRule "POOL" era) (ShelleyDELPL era)
  , Environment (EraRule "POOL" era) ~ PoolEnv era
  , Signal (EraRule "POOL" era) ~ PoolCert
  , TxCert era ~ ShelleyTxCert era
  , EraCertState era
  ) =>
  TransitionRule (ShelleyDELPL era)
delplTransition :: forall era.
(Embed (EraRule "DELEG" era) (ShelleyDELPL era),
 Environment (EraRule "DELEG" era) ~ DelegEnv era,
 State (EraRule "DELEG" era) ~ DState era,
 State (EraRule "POOL" era) ~ PState era,
 Signal (EraRule "DELEG" era) ~ TxCert era,
 Embed (EraRule "POOL" era) (ShelleyDELPL era),
 Environment (EraRule "POOL" era) ~ PoolEnv era,
 Signal (EraRule "POOL" era) ~ PoolCert,
 TxCert era ~ ShelleyTxCert era, EraCertState era) =>
TransitionRule (ShelleyDELPL era)
delplTransition = do
  TRC (DelplEnv SlotNo
slot EpochNo
eNo Ptr
ptr PParams era
pp ChainAccountState
chainAccountState, State (ShelleyDELPL era)
d, Signal (ShelleyDELPL era)
c) <- Rule
  (ShelleyDELPL era)
  'Transition
  (RuleContext 'Transition (ShelleyDELPL era))
F (Clause (ShelleyDELPL era) 'Transition) (TRC (ShelleyDELPL era))
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
  case Signal (ShelleyDELPL era)
c of
    ShelleyTxCertPool PoolCert
poolCert -> do
      PState era
ps <-
        forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @(EraRule "POOL" era) (RuleContext 'Transition (EraRule "POOL" era)
 -> Rule
      (ShelleyDELPL era) 'Transition (State (EraRule "POOL" era)))
-> RuleContext 'Transition (EraRule "POOL" era)
-> Rule (ShelleyDELPL era) 'Transition (State (EraRule "POOL" era))
forall a b. (a -> b) -> a -> b
$ (Environment (EraRule "POOL" era), State (EraRule "POOL" era),
 Signal (EraRule "POOL" era))
-> TRC (EraRule "POOL" era)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (EpochNo -> PParams era -> PoolEnv era
forall era. EpochNo -> PParams era -> PoolEnv era
PoolEnv EpochNo
eNo PParams era
pp, CertState era
State (ShelleyDELPL era)
d 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, PoolCert
Signal (EraRule "POOL" era)
poolCert)
      CertState era
-> F (Clause (ShelleyDELPL era) 'Transition) (CertState era)
forall a. a -> F (Clause (ShelleyDELPL era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CertState era
 -> F (Clause (ShelleyDELPL era) 'Transition) (CertState era))
-> CertState era
-> F (Clause (ShelleyDELPL era) 'Transition) (CertState era)
forall a b. (a -> b) -> a -> b
$ CertState era
State (ShelleyDELPL era)
d 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
ps
    ShelleyTxCertGenesisDeleg GenesisDelegCert {} -> do
      DState era
ds <-
        forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @(EraRule "DELEG" era) (RuleContext 'Transition (EraRule "DELEG" era)
 -> Rule
      (ShelleyDELPL era) 'Transition (State (EraRule "DELEG" era)))
-> RuleContext 'Transition (EraRule "DELEG" era)
-> Rule
     (ShelleyDELPL era) 'Transition (State (EraRule "DELEG" era))
forall a b. (a -> b) -> a -> b
$
          (Environment (EraRule "DELEG" era), State (EraRule "DELEG" era),
 Signal (EraRule "DELEG" era))
-> TRC (EraRule "DELEG" era)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (SlotNo
-> EpochNo
-> Ptr
-> ChainAccountState
-> PParams era
-> DelegEnv era
forall era.
SlotNo
-> EpochNo
-> Ptr
-> ChainAccountState
-> PParams era
-> DelegEnv era
DelegEnv SlotNo
slot EpochNo
eNo Ptr
ptr ChainAccountState
chainAccountState PParams era
pp, CertState era
State (ShelleyDELPL era)
d CertState era
-> Getting (DState era) (CertState era) (DState era) -> DState era
forall s a. s -> Getting a s a -> a
^. Getting (DState era) (CertState era) (DState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL, Signal (EraRule "DELEG" era)
Signal (ShelleyDELPL era)
c)
      CertState era
-> F (Clause (ShelleyDELPL era) 'Transition) (CertState era)
forall a. a -> F (Clause (ShelleyDELPL era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CertState era
 -> F (Clause (ShelleyDELPL era) 'Transition) (CertState era))
-> CertState era
-> F (Clause (ShelleyDELPL era) 'Transition) (CertState era)
forall a b. (a -> b) -> a -> b
$ CertState era
State (ShelleyDELPL era)
d CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (DState era -> Identity (DState era))
-> CertState era -> Identity (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL ((DState era -> Identity (DState era))
 -> CertState era -> Identity (CertState era))
-> DState era -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DState era
ds
    ShelleyTxCertDelegCert ShelleyDelegCert
_ -> do
      DState era
ds <-
        forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @(EraRule "DELEG" era) (RuleContext 'Transition (EraRule "DELEG" era)
 -> Rule
      (ShelleyDELPL era) 'Transition (State (EraRule "DELEG" era)))
-> RuleContext 'Transition (EraRule "DELEG" era)
-> Rule
     (ShelleyDELPL era) 'Transition (State (EraRule "DELEG" era))
forall a b. (a -> b) -> a -> b
$
          (Environment (EraRule "DELEG" era), State (EraRule "DELEG" era),
 Signal (EraRule "DELEG" era))
-> TRC (EraRule "DELEG" era)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (SlotNo
-> EpochNo
-> Ptr
-> ChainAccountState
-> PParams era
-> DelegEnv era
forall era.
SlotNo
-> EpochNo
-> Ptr
-> ChainAccountState
-> PParams era
-> DelegEnv era
DelegEnv SlotNo
slot EpochNo
eNo Ptr
ptr ChainAccountState
chainAccountState PParams era
pp, CertState era
State (ShelleyDELPL era)
d CertState era
-> Getting (DState era) (CertState era) (DState era) -> DState era
forall s a. s -> Getting a s a -> a
^. Getting (DState era) (CertState era) (DState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL, Signal (EraRule "DELEG" era)
Signal (ShelleyDELPL era)
c)
      CertState era
-> F (Clause (ShelleyDELPL era) 'Transition) (CertState era)
forall a. a -> F (Clause (ShelleyDELPL era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CertState era
 -> F (Clause (ShelleyDELPL era) 'Transition) (CertState era))
-> CertState era
-> F (Clause (ShelleyDELPL era) 'Transition) (CertState era)
forall a b. (a -> b) -> a -> b
$ CertState era
State (ShelleyDELPL era)
d CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (DState era -> Identity (DState era))
-> CertState era -> Identity (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL ((DState era -> Identity (DState era))
 -> CertState era -> Identity (CertState era))
-> DState era -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DState era
ds
    ShelleyTxCertMir MIRCert
_ -> do
      DState era
ds <-
        forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @(EraRule "DELEG" era) (RuleContext 'Transition (EraRule "DELEG" era)
 -> Rule
      (ShelleyDELPL era) 'Transition (State (EraRule "DELEG" era)))
-> RuleContext 'Transition (EraRule "DELEG" era)
-> Rule
     (ShelleyDELPL era) 'Transition (State (EraRule "DELEG" era))
forall a b. (a -> b) -> a -> b
$
          (Environment (EraRule "DELEG" era), State (EraRule "DELEG" era),
 Signal (EraRule "DELEG" era))
-> TRC (EraRule "DELEG" era)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (SlotNo
-> EpochNo
-> Ptr
-> ChainAccountState
-> PParams era
-> DelegEnv era
forall era.
SlotNo
-> EpochNo
-> Ptr
-> ChainAccountState
-> PParams era
-> DelegEnv era
DelegEnv SlotNo
slot EpochNo
eNo Ptr
ptr ChainAccountState
chainAccountState PParams era
pp, CertState era
State (ShelleyDELPL era)
d CertState era
-> Getting (DState era) (CertState era) (DState era) -> DState era
forall s a. s -> Getting a s a -> a
^. Getting (DState era) (CertState era) (DState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL, Signal (EraRule "DELEG" era)
Signal (ShelleyDELPL era)
c)
      CertState era
-> F (Clause (ShelleyDELPL era) 'Transition) (CertState era)
forall a. a -> F (Clause (ShelleyDELPL era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CertState era
 -> F (Clause (ShelleyDELPL era) 'Transition) (CertState era))
-> CertState era
-> F (Clause (ShelleyDELPL era) 'Transition) (CertState era)
forall a b. (a -> b) -> a -> b
$ CertState era
State (ShelleyDELPL era)
d CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (DState era -> Identity (DState era))
-> CertState era -> Identity (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL ((DState era -> Identity (DState era))
 -> CertState era -> Identity (CertState era))
-> DState era -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DState era
ds

instance
  ( Era era
  , STS (ShelleyPOOL era)
  , PredicateFailure (EraRule "POOL" era) ~ ShelleyPoolPredFailure era
  , Event (EraRule "POOL" era) ~ Pool.PoolEvent era
  ) =>
  Embed (ShelleyPOOL era) (ShelleyDELPL era)
  where
  wrapFailed :: PredicateFailure (ShelleyPOOL era)
-> PredicateFailure (ShelleyDELPL era)
wrapFailed = PredicateFailure (EraRule "POOL" era)
-> ShelleyDelplPredFailure era
PredicateFailure (ShelleyPOOL era)
-> PredicateFailure (ShelleyDELPL era)
forall era.
PredicateFailure (EraRule "POOL" era)
-> ShelleyDelplPredFailure era
PoolFailure
  wrapEvent :: Event (ShelleyPOOL era) -> Event (ShelleyDELPL era)
wrapEvent = Event (EraRule "POOL" era) -> ShelleyDelplEvent era
Event (ShelleyPOOL era) -> Event (ShelleyDELPL era)
forall era. Event (EraRule "POOL" era) -> ShelleyDelplEvent era
PoolEvent

instance
  ( ShelleyEraTxCert era
  , EraPParams era
  , ProtVerAtMost era 8
  , PredicateFailure (EraRule "DELEG" era) ~ ShelleyDelegPredFailure era
  , Event (EraRule "DELEG" era) ~ ShelleyDelegEvent era
  ) =>
  Embed (ShelleyDELEG era) (ShelleyDELPL era)
  where
  wrapFailed :: PredicateFailure (ShelleyDELEG era)
-> PredicateFailure (ShelleyDELPL era)
wrapFailed = PredicateFailure (EraRule "DELEG" era)
-> ShelleyDelplPredFailure era
PredicateFailure (ShelleyDELEG era)
-> PredicateFailure (ShelleyDELPL era)
forall era.
PredicateFailure (EraRule "DELEG" era)
-> ShelleyDelplPredFailure era
DelegFailure
  wrapEvent :: Event (ShelleyDELEG era) -> Event (ShelleyDELPL era)
wrapEvent = Event (EraRule "DELEG" era) -> ShelleyDelplEvent era
Event (ShelleyDELEG era) -> Event (ShelleyDELPL era)
forall era. Event (EraRule "DELEG" era) -> ShelleyDelplEvent era
DelegEvent