{-# 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, 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.Core (EraGov)
import Cardano.Ledger.Shelley.Era (ShelleyEra, ShelleyLEDGERS)
import Cardano.Ledger.Shelley.LedgerState (ChainAccountState, LedgerState (..), UTxOState (..))
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 Cardano.Ledger.State (CertState, EraStake)
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)

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) (ShelleyLEDGERS era)
  , Environment (EraRule "LEDGER" era) ~ LedgerEnv era
  , State (EraRule "LEDGER" era) ~ LedgerState era
  , Signal (EraRule "LEDGER" era) ~ StAnnTx TopTx era
  , Default (LedgerState era)
  ) =>
  STS (ShelleyLEDGERS era)
  where
  type State (ShelleyLEDGERS era) = LedgerState era
  type Signal (ShelleyLEDGERS era) = Seq (Tx TopTx 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.
(ApplyTx era, EraGov era, EraStake era, Default (CertState era),
 Embed (EraRule "LEDGER" era) (ShelleyLEDGERS era),
 Environment (EraRule "LEDGER" era) ~ LedgerEnv era,
 State (EraRule "LEDGER" era) ~ LedgerState era,
 Signal (EraRule "LEDGER" era) ~ StAnnTx TopTx era) =>
TransitionRule (ShelleyLEDGERS era)
ledgersTransition]

ledgersTransition ::
  forall era.
  ( ApplyTx era
  , EraGov era
  , EraStake era
  , Default (CertState era)
  , Embed (EraRule "LEDGER" era) (ShelleyLEDGERS era)
  , Environment (EraRule "LEDGER" era) ~ LedgerEnv era
  , State (EraRule "LEDGER" era) ~ LedgerState era
  , Signal (EraRule "LEDGER" era) ~ StAnnTx TopTx era
  ) =>
  TransitionRule (ShelleyLEDGERS era)
ledgersTransition :: forall era.
(ApplyTx era, EraGov era, EraStake era, Default (CertState era),
 Embed (EraRule "LEDGER" era) (ShelleyLEDGERS era),
 Environment (EraRule "LEDGER" era) ~ LedgerEnv era,
 State (EraRule "LEDGER" era) ~ LedgerState era,
 Signal (EraRule "LEDGER" era) ~ StAnnTx TopTx era) =>
TransitionRule (ShelleyLEDGERS era)
ledgersTransition = do
  TRC (LedgersEnv slot epochNo pp account, ls, txs) <- 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
  ei <- liftSTS $ asks epochInfo
  sysStart <- liftSTS $ asks systemStart
  foldM
    ( \ !LedgerState era
ls' (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 = UTxOState era -> UTxO era
forall era. UTxOState era -> UTxO era
utxosUtxo (LedgerState era -> UTxOState era
forall era. LedgerState era -> UTxOState era
lsUTxOState LedgerState era
ls')
            stAnnTx :: StAnnTx TopTx era
stAnnTx = EpochInfo (Either Text)
-> SystemStart
-> PParams era
-> UTxO era
-> Tx TopTx era
-> StAnnTx TopTx era
forall era.
ApplyTx era =>
EpochInfo (Either Text)
-> SystemStart
-> PParams era
-> UTxO era
-> Tx TopTx era
-> StAnnTx TopTx era
mkStAnnTx EpochInfo (Either Text)
ei SystemStart
sysStart PParams era
pp UTxO era
utxo 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
      (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', StAnnTx TopTx era
Signal (EraRule "LEDGER" era)
stAnnTx)
    )
    ls
    $ zip [minBound ..]
    $ toList txs

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