{-# 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))
| DelegFailure (PredicateFailure (EraRule "DELEG" era))
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