{-# 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 (
  LEDGERS,
  ShelleyLedgersEnv (..),
  ShelleyLedgersPredFailure (..),
  ShelleyLedgersEvent (..),
) where

import Cardano.Ledger.BaseTypes (EpochNo, ShelleyBase, epochInfo, systemStart)
import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..))
import Cardano.Ledger.Binary.Coders (Encode (..), encode, (!>))
import Cardano.Ledger.Core
import Cardano.Ledger.Shelley.API.Mempool (ApplyTx (..))
import Cardano.Ledger.Shelley.Era (LEDGERS, ShelleyEra)
import Cardano.Ledger.Shelley.LedgerState (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 (
  LEDGER,
  LedgerEnv (..),
  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 Cardano.Ledger.State
import Control.DeepSeq (NFData)
import Control.Monad (foldM)
import Control.Monad.Trans.Reader (asks)
import Control.State.Transition (
  Embed (..),
  STS (..),
  TRC (..),
  TransitionRule,
  judgmentContext,
  liftSTS,
  trans,
 )
import Data.Default (Default)
import Data.Foldable (toList)
import Data.Functor.Identity (Identity)
import Data.Sequence (Seq)
import GHC.Generics (Generic)
import Lens.Micro ((^.))

data ShelleyLedgersEnv era = LedgersEnv
  { forall era. ShelleyLedgersEnv era -> SlotNo
ledgersSlotNo :: 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)) -- Subtransition Failures
  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 ((forall x.
 ShelleyLedgersEvent era -> Rep (ShelleyLedgersEvent era) x)
-> (forall x.
    Rep (ShelleyLedgersEvent era) x -> ShelleyLedgersEvent era)
-> Generic (ShelleyLedgersEvent era)
forall x.
Rep (ShelleyLedgersEvent era) x -> ShelleyLedgersEvent era
forall x.
ShelleyLedgersEvent era -> Rep (ShelleyLedgersEvent era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ShelleyLedgersEvent era) x -> ShelleyLedgersEvent era
forall era x.
ShelleyLedgersEvent era -> Rep (ShelleyLedgersEvent era) x
$cfrom :: forall era x.
ShelleyLedgersEvent era -> Rep (ShelleyLedgersEvent era) x
from :: forall x.
ShelleyLedgersEvent era -> Rep (ShelleyLedgersEvent era) x
$cto :: forall era x.
Rep (ShelleyLedgersEvent era) x -> ShelleyLedgersEvent era
to :: forall x.
Rep (ShelleyLedgersEvent era) x -> ShelleyLedgersEvent era
Generic)

deriving instance
  Eq (Event (EraRule "LEDGER" era)) =>
  Eq (ShelleyLedgersEvent 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
  , 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
  ( ApplyTx era
  , EraGov era
  , EraStake era
  , Default (CertState era)
  , Embed (EraRule "LEDGER" era) (LEDGERS era)
  , Environment (EraRule "LEDGER" era) ~ LedgerEnv era
  , State (EraRule "LEDGER" era) ~ LedgerState era
  , Signal (EraRule "LEDGER" era) ~ StAnnTx TopTx era
  , Default (LedgerState era)
  ) =>
  STS (LEDGERS era)
  where
  type State (LEDGERS era) = LedgerState era
  type Signal (LEDGERS era) = Seq (Tx TopTx era)
  type Environment (LEDGERS era) = ShelleyLedgersEnv era
  type BaseM (LEDGERS era) = ShelleyBase
  type PredicateFailure (LEDGERS era) = ShelleyLedgersPredFailure era
  type Event (LEDGERS era) = ShelleyLedgersEvent era

  transitionRules :: [TransitionRule (LEDGERS era)]
transitionRules = [TransitionRule (LEDGERS era)
forall era.
(ApplyTx era, EraGov era, EraStake era, Default (CertState era),
 Embed (EraRule "LEDGER" era) (LEDGERS era),
 Environment (EraRule "LEDGER" era) ~ LedgerEnv era,
 State (EraRule "LEDGER" era) ~ LedgerState era,
 Signal (EraRule "LEDGER" era) ~ StAnnTx TopTx era) =>
TransitionRule (LEDGERS era)
ledgersTransition]

ledgersTransition ::
  forall era.
  ( ApplyTx era
  , EraGov era
  , EraStake era
  , Default (CertState era)
  , Embed (EraRule "LEDGER" era) (LEDGERS era)
  , Environment (EraRule "LEDGER" era) ~ LedgerEnv era
  , State (EraRule "LEDGER" era) ~ LedgerState era
  , Signal (EraRule "LEDGER" era) ~ StAnnTx TopTx era
  ) =>
  TransitionRule (LEDGERS era)
ledgersTransition :: forall era.
(ApplyTx era, EraGov era, EraStake era, Default (CertState era),
 Embed (EraRule "LEDGER" era) (LEDGERS era),
 Environment (EraRule "LEDGER" era) ~ LedgerEnv era,
 State (EraRule "LEDGER" era) ~ LedgerState era,
 Signal (EraRule "LEDGER" era) ~ StAnnTx TopTx era) =>
TransitionRule (LEDGERS era)
ledgersTransition = do
  TRC (LedgersEnv slot epochNo pp account, initLedgerState, txs) <- Rule
  (LEDGERS era) 'Transition (RuleContext 'Transition (LEDGERS era))
F (Clause (LEDGERS era) 'Transition) (TRC (LEDGERS era))
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
  ei <- liftSTS $ asks epochInfo
  sysStart <- liftSTS $ asks systemStart
  foldM
    ( \ !LedgerState era
curLedgerState (TxIx
ix, Tx TopTx era
tx) ->
        -- build the annotations against the same utxo snapshot that the rule will validate against
        let utxo :: UTxO era
utxo = LedgerState era
curLedgerState LedgerState era
-> Getting (UTxO era) (LedgerState era) (UTxO era) -> UTxO era
forall s a. s -> Getting a s a -> a
^. Getting (UTxO era) (LedgerState era) (UTxO era)
forall era. Lens' (LedgerState era) (UTxO era)
forall (t :: * -> *) era. CanSetUTxO t => Lens' (t era) (UTxO era)
utxoL
            stAnnTx :: StAnnTx TopTx era
stAnnTx = EpochInfo (Either Text)
-> SystemStart
-> PParams era
-> UTxO era
-> StAnnTxCache era
-> Tx TopTx era
-> StAnnTx TopTx era
forall era.
ApplyTx era =>
EpochInfo (Either Text)
-> SystemStart
-> PParams era
-> UTxO era
-> StAnnTxCache era
-> Tx TopTx era
-> StAnnTx TopTx era
mkStAnnTx EpochInfo (Either Text)
ei SystemStart
sysStart PParams era
pp UTxO era
utxo StAnnTxCache era
forall a. Monoid a => a
mempty Tx TopTx era
tx
         in 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 (LEDGERS era) 'Transition (State (EraRule "LEDGER" era)))
-> RuleContext 'Transition (EraRule "LEDGER" era)
-> Rule (LEDGERS 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
curLedgerState, StAnnTx TopTx era
Signal (EraRule "LEDGER" era)
stAnnTx)
    )
    initLedgerState
    $ zip [minBound ..]
    $ toList txs

instance
  ( Era era
  , STS (LEDGER era)
  , PredicateFailure (EraRule "LEDGER" era) ~ ShelleyLedgerPredFailure era
  , Event (EraRule "LEDGER" era) ~ ShelleyLedgerEvent era
  ) =>
  Embed (LEDGER era) (LEDGERS era)
  where
  wrapFailed :: PredicateFailure (LEDGER era) -> PredicateFailure (LEDGERS era)
wrapFailed = PredicateFailure (EraRule "LEDGER" era)
-> ShelleyLedgersPredFailure era
PredicateFailure (LEDGER era) -> PredicateFailure (LEDGERS era)
forall era.
PredicateFailure (EraRule "LEDGER" era)
-> ShelleyLedgersPredFailure era
LedgerFailure
  wrapEvent :: Event (LEDGER era) -> Event (LEDGERS era)
wrapEvent = Event (EraRule "LEDGER" era) -> ShelleyLedgersEvent era
Event (LEDGER era) -> Event (LEDGERS era)
forall era. Event (EraRule "LEDGER" era) -> ShelleyLedgersEvent era
LedgerEvent