{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Cardano.Ledger.Shelley.Rules.Ledgers (
ShelleyLEDGERS,
ShelleyLedgersEnv (..),
ShelleyLedgersPredFailure (..),
ShelleyLedgersEvent (..),
PredicateFailure,
) where
import Cardano.Ledger.BaseTypes (EpochNo, ShelleyBase)
import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..))
import Cardano.Ledger.Binary.Coders (Encode (..), encode, (!>))
import Cardano.Ledger.Core
import Cardano.Ledger.Shelley.Era (ShelleyEra, ShelleyLEDGERS)
import Cardano.Ledger.Shelley.LedgerState (ChainAccountState, LedgerState)
import Cardano.Ledger.Shelley.Rules.Deleg (ShelleyDelegPredFailure)
import Cardano.Ledger.Shelley.Rules.Delegs (ShelleyDelegsPredFailure)
import Cardano.Ledger.Shelley.Rules.Delpl (ShelleyDelplPredFailure)
import Cardano.Ledger.Shelley.Rules.Ledger (
LedgerEnv (..),
ShelleyLEDGER,
ShelleyLedgerEvent,
ShelleyLedgerPredFailure,
)
import Cardano.Ledger.Shelley.Rules.Pool (ShelleyPoolPredFailure)
import Cardano.Ledger.Shelley.Rules.Ppup (ShelleyPpupPredFailure)
import Cardano.Ledger.Shelley.Rules.Utxo (ShelleyUtxoPredFailure)
import Cardano.Ledger.Shelley.Rules.Utxow (ShelleyUtxowPredFailure)
import Cardano.Ledger.Slot (SlotNo)
import Control.DeepSeq (NFData)
import Control.Monad (foldM)
import Control.State.Transition (
Embed (..),
STS (..),
TRC (..),
TransitionRule,
judgmentContext,
trans,
)
import Data.Default (Default)
import Data.Foldable (toList)
import Data.Functor.Identity (Identity)
import Data.Sequence (Seq)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks (..))
data ShelleyLedgersEnv era = LedgersEnv
{ :: SlotNo
, forall era. ShelleyLedgersEnv era -> EpochNo
ledgersEpochNo :: EpochNo
, forall era. ShelleyLedgersEnv era -> PParams era
ledgersPp :: PParams era
, forall era. ShelleyLedgersEnv era -> ChainAccountState
ledgersAccount :: ChainAccountState
}
deriving ((forall x. ShelleyLedgersEnv era -> Rep (ShelleyLedgersEnv era) x)
-> (forall x.
Rep (ShelleyLedgersEnv era) x -> ShelleyLedgersEnv era)
-> Generic (ShelleyLedgersEnv era)
forall x. Rep (ShelleyLedgersEnv era) x -> ShelleyLedgersEnv era
forall x. ShelleyLedgersEnv era -> Rep (ShelleyLedgersEnv era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ShelleyLedgersEnv era) x -> ShelleyLedgersEnv era
forall era x.
ShelleyLedgersEnv era -> Rep (ShelleyLedgersEnv era) x
$cfrom :: forall era x.
ShelleyLedgersEnv era -> Rep (ShelleyLedgersEnv era) x
from :: forall x. ShelleyLedgersEnv era -> Rep (ShelleyLedgersEnv era) x
$cto :: forall era x.
Rep (ShelleyLedgersEnv era) x -> ShelleyLedgersEnv era
to :: forall x. Rep (ShelleyLedgersEnv era) x -> ShelleyLedgersEnv era
Generic)
deriving instance Eq (PParamsHKD Identity era) => Eq (ShelleyLedgersEnv era)
deriving instance Show (PParamsHKD Identity era) => Show (ShelleyLedgersEnv era)
instance NFData (PParamsHKD Identity era) => NFData (ShelleyLedgersEnv era)
instance EraPParams era => EncCBOR (ShelleyLedgersEnv era) where
encCBOR :: ShelleyLedgersEnv era -> Encoding
encCBOR x :: ShelleyLedgersEnv era
x@(LedgersEnv SlotNo
_ EpochNo
_ PParams era
_ ChainAccountState
_) =
let LedgersEnv {EpochNo
SlotNo
PParams era
ChainAccountState
ledgersSlotNo :: forall era. ShelleyLedgersEnv era -> SlotNo
ledgersEpochNo :: forall era. ShelleyLedgersEnv era -> EpochNo
ledgersPp :: forall era. ShelleyLedgersEnv era -> PParams era
ledgersAccount :: forall era. ShelleyLedgersEnv era -> ChainAccountState
ledgersSlotNo :: SlotNo
ledgersEpochNo :: EpochNo
ledgersPp :: PParams era
ledgersAccount :: ChainAccountState
..} = ShelleyLedgersEnv era
x
in Encode ('Closed 'Dense) (ShelleyLedgersEnv era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) (ShelleyLedgersEnv era) -> Encoding)
-> Encode ('Closed 'Dense) (ShelleyLedgersEnv era) -> Encoding
forall a b. (a -> b) -> a -> b
$
(SlotNo
-> EpochNo
-> PParams era
-> ChainAccountState
-> ShelleyLedgersEnv era)
-> Encode
('Closed 'Dense)
(SlotNo
-> EpochNo
-> PParams era
-> ChainAccountState
-> ShelleyLedgersEnv era)
forall t. t -> Encode ('Closed 'Dense) t
Rec SlotNo
-> EpochNo
-> PParams era
-> ChainAccountState
-> ShelleyLedgersEnv era
forall era.
SlotNo
-> EpochNo
-> PParams era
-> ChainAccountState
-> ShelleyLedgersEnv era
LedgersEnv
Encode
('Closed 'Dense)
(SlotNo
-> EpochNo
-> PParams era
-> ChainAccountState
-> ShelleyLedgersEnv era)
-> Encode ('Closed 'Dense) SlotNo
-> Encode
('Closed 'Dense)
(EpochNo
-> PParams era -> ChainAccountState -> ShelleyLedgersEnv era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> SlotNo -> Encode ('Closed 'Dense) SlotNo
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To SlotNo
ledgersSlotNo
Encode
('Closed 'Dense)
(EpochNo
-> PParams era -> ChainAccountState -> ShelleyLedgersEnv era)
-> Encode ('Closed 'Dense) EpochNo
-> Encode
('Closed 'Dense)
(PParams era -> ChainAccountState -> ShelleyLedgersEnv era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> EpochNo -> Encode ('Closed 'Dense) EpochNo
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To EpochNo
ledgersEpochNo
Encode
('Closed 'Dense)
(PParams era -> ChainAccountState -> ShelleyLedgersEnv era)
-> Encode ('Closed 'Dense) (PParams era)
-> Encode
('Closed 'Dense) (ChainAccountState -> ShelleyLedgersEnv era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> PParams era -> Encode ('Closed 'Dense) (PParams era)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To PParams era
ledgersPp
Encode
('Closed 'Dense) (ChainAccountState -> ShelleyLedgersEnv era)
-> Encode ('Closed 'Dense) ChainAccountState
-> Encode ('Closed 'Dense) (ShelleyLedgersEnv era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> ChainAccountState -> Encode ('Closed 'Dense) ChainAccountState
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To ChainAccountState
ledgersAccount
newtype ShelleyLedgersPredFailure era
= LedgerFailure (PredicateFailure (EraRule "LEDGER" era))
deriving ((forall x.
ShelleyLedgersPredFailure era
-> Rep (ShelleyLedgersPredFailure era) x)
-> (forall x.
Rep (ShelleyLedgersPredFailure era) x
-> ShelleyLedgersPredFailure era)
-> Generic (ShelleyLedgersPredFailure era)
forall x.
Rep (ShelleyLedgersPredFailure era) x
-> ShelleyLedgersPredFailure era
forall x.
ShelleyLedgersPredFailure era
-> Rep (ShelleyLedgersPredFailure era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ShelleyLedgersPredFailure era) x
-> ShelleyLedgersPredFailure era
forall era x.
ShelleyLedgersPredFailure era
-> Rep (ShelleyLedgersPredFailure era) x
$cfrom :: forall era x.
ShelleyLedgersPredFailure era
-> Rep (ShelleyLedgersPredFailure era) x
from :: forall x.
ShelleyLedgersPredFailure era
-> Rep (ShelleyLedgersPredFailure era) x
$cto :: forall era x.
Rep (ShelleyLedgersPredFailure era) x
-> ShelleyLedgersPredFailure era
to :: forall x.
Rep (ShelleyLedgersPredFailure era) x
-> ShelleyLedgersPredFailure era
Generic)
instance
NFData (PredicateFailure (EraRule "LEDGER" era)) =>
NFData (ShelleyLedgersPredFailure era)
type instance EraRuleFailure "LEDGERS" ShelleyEra = ShelleyLedgersPredFailure ShelleyEra
type instance EraRuleEvent "LEDGERS" ShelleyEra = ShelleyLedgersEvent ShelleyEra
instance InjectRuleFailure "LEDGERS" ShelleyLedgersPredFailure ShelleyEra
instance InjectRuleFailure "LEDGERS" ShelleyLedgerPredFailure ShelleyEra where
injectFailure :: ShelleyLedgerPredFailure ShelleyEra
-> EraRuleFailure "LEDGERS" ShelleyEra
injectFailure = PredicateFailure (EraRule "LEDGER" ShelleyEra)
-> ShelleyLedgersPredFailure ShelleyEra
ShelleyLedgerPredFailure ShelleyEra
-> EraRuleFailure "LEDGERS" ShelleyEra
forall era.
PredicateFailure (EraRule "LEDGER" era)
-> ShelleyLedgersPredFailure era
LedgerFailure
instance InjectRuleFailure "LEDGERS" ShelleyUtxowPredFailure ShelleyEra where
injectFailure :: ShelleyUtxowPredFailure ShelleyEra
-> EraRuleFailure "LEDGERS" ShelleyEra
injectFailure = PredicateFailure (EraRule "LEDGER" ShelleyEra)
-> ShelleyLedgersPredFailure ShelleyEra
ShelleyLedgerPredFailure ShelleyEra
-> ShelleyLedgersPredFailure ShelleyEra
forall era.
PredicateFailure (EraRule "LEDGER" era)
-> ShelleyLedgersPredFailure era
LedgerFailure (ShelleyLedgerPredFailure ShelleyEra
-> ShelleyLedgersPredFailure ShelleyEra)
-> (ShelleyUtxowPredFailure ShelleyEra
-> ShelleyLedgerPredFailure ShelleyEra)
-> ShelleyUtxowPredFailure ShelleyEra
-> ShelleyLedgersPredFailure ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyUtxowPredFailure ShelleyEra
-> EraRuleFailure "LEDGER" ShelleyEra
ShelleyUtxowPredFailure ShelleyEra
-> ShelleyLedgerPredFailure ShelleyEra
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
instance InjectRuleFailure "LEDGERS" ShelleyUtxoPredFailure ShelleyEra where
injectFailure :: ShelleyUtxoPredFailure ShelleyEra
-> EraRuleFailure "LEDGERS" ShelleyEra
injectFailure = PredicateFailure (EraRule "LEDGER" ShelleyEra)
-> ShelleyLedgersPredFailure ShelleyEra
ShelleyLedgerPredFailure ShelleyEra
-> ShelleyLedgersPredFailure ShelleyEra
forall era.
PredicateFailure (EraRule "LEDGER" era)
-> ShelleyLedgersPredFailure era
LedgerFailure (ShelleyLedgerPredFailure ShelleyEra
-> ShelleyLedgersPredFailure ShelleyEra)
-> (ShelleyUtxoPredFailure ShelleyEra
-> ShelleyLedgerPredFailure ShelleyEra)
-> ShelleyUtxoPredFailure ShelleyEra
-> ShelleyLedgersPredFailure ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyUtxoPredFailure ShelleyEra
-> EraRuleFailure "LEDGER" ShelleyEra
ShelleyUtxoPredFailure ShelleyEra
-> ShelleyLedgerPredFailure ShelleyEra
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
instance InjectRuleFailure "LEDGERS" ShelleyPpupPredFailure ShelleyEra where
injectFailure :: ShelleyPpupPredFailure ShelleyEra
-> EraRuleFailure "LEDGERS" ShelleyEra
injectFailure = PredicateFailure (EraRule "LEDGER" ShelleyEra)
-> ShelleyLedgersPredFailure ShelleyEra
ShelleyLedgerPredFailure ShelleyEra
-> ShelleyLedgersPredFailure ShelleyEra
forall era.
PredicateFailure (EraRule "LEDGER" era)
-> ShelleyLedgersPredFailure era
LedgerFailure (ShelleyLedgerPredFailure ShelleyEra
-> ShelleyLedgersPredFailure ShelleyEra)
-> (ShelleyPpupPredFailure ShelleyEra
-> ShelleyLedgerPredFailure ShelleyEra)
-> ShelleyPpupPredFailure ShelleyEra
-> ShelleyLedgersPredFailure ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyPpupPredFailure ShelleyEra
-> EraRuleFailure "LEDGER" ShelleyEra
ShelleyPpupPredFailure ShelleyEra
-> ShelleyLedgerPredFailure ShelleyEra
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
instance InjectRuleFailure "LEDGERS" ShelleyDelegsPredFailure ShelleyEra where
injectFailure :: ShelleyDelegsPredFailure ShelleyEra
-> EraRuleFailure "LEDGERS" ShelleyEra
injectFailure = PredicateFailure (EraRule "LEDGER" ShelleyEra)
-> ShelleyLedgersPredFailure ShelleyEra
ShelleyLedgerPredFailure ShelleyEra
-> ShelleyLedgersPredFailure ShelleyEra
forall era.
PredicateFailure (EraRule "LEDGER" era)
-> ShelleyLedgersPredFailure era
LedgerFailure (ShelleyLedgerPredFailure ShelleyEra
-> ShelleyLedgersPredFailure ShelleyEra)
-> (ShelleyDelegsPredFailure ShelleyEra
-> ShelleyLedgerPredFailure ShelleyEra)
-> ShelleyDelegsPredFailure ShelleyEra
-> ShelleyLedgersPredFailure ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyDelegsPredFailure ShelleyEra
-> EraRuleFailure "LEDGER" ShelleyEra
ShelleyDelegsPredFailure ShelleyEra
-> ShelleyLedgerPredFailure ShelleyEra
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
instance InjectRuleFailure "LEDGERS" ShelleyDelplPredFailure ShelleyEra where
injectFailure :: ShelleyDelplPredFailure ShelleyEra
-> EraRuleFailure "LEDGERS" ShelleyEra
injectFailure = PredicateFailure (EraRule "LEDGER" ShelleyEra)
-> ShelleyLedgersPredFailure ShelleyEra
ShelleyLedgerPredFailure ShelleyEra
-> ShelleyLedgersPredFailure ShelleyEra
forall era.
PredicateFailure (EraRule "LEDGER" era)
-> ShelleyLedgersPredFailure era
LedgerFailure (ShelleyLedgerPredFailure ShelleyEra
-> ShelleyLedgersPredFailure ShelleyEra)
-> (ShelleyDelplPredFailure ShelleyEra
-> ShelleyLedgerPredFailure ShelleyEra)
-> ShelleyDelplPredFailure ShelleyEra
-> ShelleyLedgersPredFailure ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyDelplPredFailure ShelleyEra
-> EraRuleFailure "LEDGER" ShelleyEra
ShelleyDelplPredFailure ShelleyEra
-> ShelleyLedgerPredFailure ShelleyEra
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
instance InjectRuleFailure "LEDGERS" ShelleyPoolPredFailure ShelleyEra where
injectFailure :: ShelleyPoolPredFailure ShelleyEra
-> EraRuleFailure "LEDGERS" ShelleyEra
injectFailure = PredicateFailure (EraRule "LEDGER" ShelleyEra)
-> ShelleyLedgersPredFailure ShelleyEra
ShelleyLedgerPredFailure ShelleyEra
-> ShelleyLedgersPredFailure ShelleyEra
forall era.
PredicateFailure (EraRule "LEDGER" era)
-> ShelleyLedgersPredFailure era
LedgerFailure (ShelleyLedgerPredFailure ShelleyEra
-> ShelleyLedgersPredFailure ShelleyEra)
-> (ShelleyPoolPredFailure ShelleyEra
-> ShelleyLedgerPredFailure ShelleyEra)
-> ShelleyPoolPredFailure ShelleyEra
-> ShelleyLedgersPredFailure ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyPoolPredFailure ShelleyEra
-> EraRuleFailure "LEDGER" ShelleyEra
ShelleyPoolPredFailure ShelleyEra
-> ShelleyLedgerPredFailure ShelleyEra
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
instance InjectRuleFailure "LEDGERS" ShelleyDelegPredFailure ShelleyEra where
injectFailure :: ShelleyDelegPredFailure ShelleyEra
-> EraRuleFailure "LEDGERS" ShelleyEra
injectFailure = PredicateFailure (EraRule "LEDGER" ShelleyEra)
-> ShelleyLedgersPredFailure ShelleyEra
ShelleyLedgerPredFailure ShelleyEra
-> ShelleyLedgersPredFailure ShelleyEra
forall era.
PredicateFailure (EraRule "LEDGER" era)
-> ShelleyLedgersPredFailure era
LedgerFailure (ShelleyLedgerPredFailure ShelleyEra
-> ShelleyLedgersPredFailure ShelleyEra)
-> (ShelleyDelegPredFailure ShelleyEra
-> ShelleyLedgerPredFailure ShelleyEra)
-> ShelleyDelegPredFailure ShelleyEra
-> ShelleyLedgersPredFailure ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyDelegPredFailure ShelleyEra
-> EraRuleFailure "LEDGER" ShelleyEra
ShelleyDelegPredFailure ShelleyEra
-> ShelleyLedgerPredFailure ShelleyEra
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
newtype ShelleyLedgersEvent era
= LedgerEvent (Event (EraRule "LEDGER" era))
deriving stock instance
( Era era
, Show (PredicateFailure (EraRule "LEDGER" era))
) =>
Show (ShelleyLedgersPredFailure era)
deriving stock instance
( Era era
, Eq (PredicateFailure (EraRule "LEDGER" era))
) =>
Eq (ShelleyLedgersPredFailure era)
instance
( Era era
, NoThunks (PredicateFailure (EraRule "LEDGER" era))
) =>
NoThunks (ShelleyLedgersPredFailure era)
instance
( Era era
, EncCBOR (PredicateFailure (EraRule "LEDGER" era))
) =>
EncCBOR (ShelleyLedgersPredFailure era)
where
encCBOR :: ShelleyLedgersPredFailure era -> Encoding
encCBOR (LedgerFailure PredicateFailure (EraRule "LEDGER" era)
e) = PredicateFailure (EraRule "LEDGER" era) -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR PredicateFailure (EraRule "LEDGER" era)
e
instance
( Era era
, DecCBOR (PredicateFailure (EraRule "LEDGER" era))
) =>
DecCBOR (ShelleyLedgersPredFailure era)
where
decCBOR :: forall s. Decoder s (ShelleyLedgersPredFailure era)
decCBOR = PredicateFailure (EraRule "LEDGER" era)
-> ShelleyLedgersPredFailure era
forall era.
PredicateFailure (EraRule "LEDGER" era)
-> ShelleyLedgersPredFailure era
LedgerFailure (PredicateFailure (EraRule "LEDGER" era)
-> ShelleyLedgersPredFailure era)
-> Decoder s (PredicateFailure (EraRule "LEDGER" era))
-> Decoder s (ShelleyLedgersPredFailure era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (PredicateFailure (EraRule "LEDGER" era))
forall s. Decoder s (PredicateFailure (EraRule "LEDGER" era))
forall a s. DecCBOR a => Decoder s a
decCBOR
instance
( Era era
, Embed (EraRule "LEDGER" era) (ShelleyLEDGERS era)
, Environment (EraRule "LEDGER" era) ~ LedgerEnv era
, State (EraRule "LEDGER" era) ~ LedgerState era
, Signal (EraRule "LEDGER" era) ~ Tx era
, Default (LedgerState era)
) =>
STS (ShelleyLEDGERS era)
where
type State (ShelleyLEDGERS era) = LedgerState era
type Signal (ShelleyLEDGERS era) = Seq (Tx era)
type Environment (ShelleyLEDGERS era) = ShelleyLedgersEnv era
type BaseM (ShelleyLEDGERS era) = ShelleyBase
type PredicateFailure (ShelleyLEDGERS era) = ShelleyLedgersPredFailure era
type Event (ShelleyLEDGERS era) = ShelleyLedgersEvent era
transitionRules :: [TransitionRule (ShelleyLEDGERS era)]
transitionRules = [TransitionRule (ShelleyLEDGERS era)
forall era.
(Embed (EraRule "LEDGER" era) (ShelleyLEDGERS era),
Environment (EraRule "LEDGER" era) ~ LedgerEnv era,
State (EraRule "LEDGER" era) ~ LedgerState era,
Signal (EraRule "LEDGER" era) ~ Tx era) =>
TransitionRule (ShelleyLEDGERS era)
ledgersTransition]
ledgersTransition ::
forall era.
( Embed (EraRule "LEDGER" era) (ShelleyLEDGERS era)
, Environment (EraRule "LEDGER" era) ~ LedgerEnv era
, State (EraRule "LEDGER" era) ~ LedgerState era
, Signal (EraRule "LEDGER" era) ~ Tx era
) =>
TransitionRule (ShelleyLEDGERS era)
ledgersTransition :: forall era.
(Embed (EraRule "LEDGER" era) (ShelleyLEDGERS era),
Environment (EraRule "LEDGER" era) ~ LedgerEnv era,
State (EraRule "LEDGER" era) ~ LedgerState era,
Signal (EraRule "LEDGER" era) ~ Tx era) =>
TransitionRule (ShelleyLEDGERS era)
ledgersTransition = do
TRC (LedgersEnv SlotNo
slot EpochNo
epochNo PParams era
pp ChainAccountState
account, State (ShelleyLEDGERS era)
ls, Signal (ShelleyLEDGERS era)
txwits) <- Rule
(ShelleyLEDGERS era)
'Transition
(RuleContext 'Transition (ShelleyLEDGERS era))
F (Clause (ShelleyLEDGERS era) 'Transition)
(TRC (ShelleyLEDGERS era))
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
(LedgerState era
-> (TxIx, Tx era)
-> F (Clause (ShelleyLEDGERS era) 'Transition) (LedgerState era))
-> LedgerState era
-> [(TxIx, Tx era)]
-> F (Clause (ShelleyLEDGERS era) 'Transition) (LedgerState era)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM
( \ !LedgerState era
ls' (TxIx
ix, Tx era
tx) ->
forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @(EraRule "LEDGER" era) (RuleContext 'Transition (EraRule "LEDGER" era)
-> Rule
(ShelleyLEDGERS era) 'Transition (State (EraRule "LEDGER" era)))
-> RuleContext 'Transition (EraRule "LEDGER" era)
-> Rule
(ShelleyLEDGERS era) 'Transition (State (EraRule "LEDGER" era))
forall a b. (a -> b) -> a -> b
$
(Environment (EraRule "LEDGER" era), State (EraRule "LEDGER" era),
Signal (EraRule "LEDGER" era))
-> TRC (EraRule "LEDGER" era)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (SlotNo
-> Maybe EpochNo
-> TxIx
-> PParams era
-> ChainAccountState
-> LedgerEnv era
forall era.
SlotNo
-> Maybe EpochNo
-> TxIx
-> PParams era
-> ChainAccountState
-> LedgerEnv era
LedgerEnv SlotNo
slot (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
epochNo) TxIx
ix PParams era
pp ChainAccountState
account, State (EraRule "LEDGER" era)
LedgerState era
ls', Tx era
Signal (EraRule "LEDGER" era)
tx)
)
State (ShelleyLEDGERS era)
LedgerState era
ls
([(TxIx, Tx era)]
-> F (Clause (ShelleyLEDGERS era) 'Transition) (LedgerState era))
-> [(TxIx, Tx era)]
-> F (Clause (ShelleyLEDGERS era) 'Transition) (LedgerState era)
forall a b. (a -> b) -> a -> b
$ [TxIx] -> [Tx era] -> [(TxIx, Tx era)]
forall a b. [a] -> [b] -> [(a, b)]
zip [TxIx
forall a. Bounded a => a
minBound ..]
([Tx era] -> [(TxIx, Tx era)]) -> [Tx era] -> [(TxIx, Tx era)]
forall a b. (a -> b) -> a -> b
$ Seq (Tx era) -> [Tx era]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Tx era)
Signal (ShelleyLEDGERS era)
txwits
instance
( Era era
, STS (ShelleyLEDGER era)
, PredicateFailure (EraRule "LEDGER" era) ~ ShelleyLedgerPredFailure era
, Event (EraRule "LEDGER" era) ~ ShelleyLedgerEvent era
) =>
Embed (ShelleyLEDGER era) (ShelleyLEDGERS era)
where
wrapFailed :: PredicateFailure (ShelleyLEDGER era)
-> PredicateFailure (ShelleyLEDGERS era)
wrapFailed = PredicateFailure (EraRule "LEDGER" era)
-> ShelleyLedgersPredFailure era
PredicateFailure (ShelleyLEDGER era)
-> PredicateFailure (ShelleyLEDGERS era)
forall era.
PredicateFailure (EraRule "LEDGER" era)
-> ShelleyLedgersPredFailure era
LedgerFailure
wrapEvent :: Event (ShelleyLEDGER era) -> Event (ShelleyLEDGERS era)
wrapEvent = Event (EraRule "LEDGER" era) -> ShelleyLedgersEvent era
Event (ShelleyLEDGER era) -> Event (ShelleyLEDGERS era)
forall era. Event (EraRule "LEDGER" era) -> ShelleyLedgersEvent era
LedgerEvent