Merge pull request #4890 from IntersectMBO/lehins/invert-mempool

Invert mempool

Author: lehins

eras/allegra/impl/src/Cardano/Ledger/Allegra.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
@@ -19,7 +20,7 @@ import Cardano.Ledger.Allegra.Translation ()
 import Cardano.Ledger.Allegra.Tx ()
 import Cardano.Ledger.Allegra.TxSeq ()
 import Cardano.Ledger.Allegra.UTxO ()
-import Cardano.Ledger.Shelley.API (ApplyBlock, ApplyTx)
+import Cardano.Ledger.Shelley.API
 
 type Allegra = AllegraEra
 
@@ -29,6 +30,7 @@ type Allegra = AllegraEra
 -- Mempool instances
 --------------------------------------------------------------------------------
 
-instance ApplyTx AllegraEra
+instance ApplyTx AllegraEra where
+  applyTxValidation = ruleApplyTxValidation @"LEDGER"
 
 instance ApplyBlock AllegraEra

eras/alonzo/impl/CHANGELOG.md

@@ -2,6 +2,7 @@
 
 ## 1.13.0.0
 
+* Remove `reapplyAlonzoTx` as no longer needed.
 * Add `TxInfoResult` data family, `mkTxInfoResult` and `lookupTxInfoResult` to `EraPlutusContext`
 * Add `lookupTxInfoResultImpossible` helper
 * Add `TxInfoResult era` parameter to `toPlutusWithContext` and `mkPlutusWithContext`

eras/alonzo/impl/cardano-ledger-alonzo.cabal

@@ -91,7 +91,6 @@ library
     deepseq,
     mempack,
     microlens,
-    mtl,
     nothunks,
     plutus-ledger-api >=1.37,
     set-algebra >=1.0,

eras/alonzo/impl/src/Cardano/Ledger/Alonzo.hs

@@ -14,7 +14,6 @@ module Cardano.Ledger.Alonzo (
   AlonzoTxBody,
   AlonzoScript,
   AlonzoTxAuxData,
-  reapplyAlonzoTx,
 )
 where
 
@@ -30,39 +29,17 @@ import Cardano.Ledger.Alonzo.TxAuxData (AlonzoTxAuxData)
 import Cardano.Ledger.Alonzo.TxBody (AlonzoTxBody, AlonzoTxOut)
 import Cardano.Ledger.Alonzo.TxWits ()
 import Cardano.Ledger.Alonzo.UTxO ()
-import Cardano.Ledger.Core
 import Cardano.Ledger.Mary.Value (MaryValue)
 import Cardano.Ledger.Plutus.Data ()
-import Cardano.Ledger.Rules.ValidationMode (applySTSNonStatic)
 import Cardano.Ledger.Shelley.API
-import Control.Arrow (left)
-import Control.Monad.Except (MonadError, liftEither)
-import Control.Monad.Reader (runReader)
-import Control.State.Transition.Extended (TRC (TRC))
 
 type Alonzo = AlonzoEra
 
 {-# DEPRECATED Alonzo "In favor of `AlonzoEra`" #-}
 
 -- =====================================================
 
-reapplyAlonzoTx ::
-  forall era m.
-  (ApplyTx era, MonadError (ApplyTxError era) m) =>
-  Globals ->
-  MempoolEnv era ->
-  MempoolState era ->
-  Validated (Tx era) ->
-  m (MempoolState era)
-reapplyAlonzoTx globals env state vtx =
-  let res =
-        flip runReader globals
-          . applySTSNonStatic
-            @(EraRule "LEDGER" era)
-          $ TRC (env, state, extractTx vtx)
-   in liftEither . left ApplyTxError $ res
-
 instance ApplyTx AlonzoEra where
-  reapplyTx = reapplyAlonzoTx
+  applyTxValidation = ruleApplyTxValidation @"LEDGER"
 
 instance ApplyBlock AlonzoEra

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Ledger.hs

@@ -127,7 +127,7 @@ ledgerTransition ::
   ) =>
   TransitionRule (someLEDGER era)
 ledgerTransition = do
-  TRC (LedgerEnv slot mbCurEpochNo txIx pp account _, LedgerState utxoSt certState, tx) <-
+  TRC (LedgerEnv slot mbCurEpochNo txIx pp account, LedgerState utxoSt certState, tx) <-
     judgmentContext
   let txBody = tx ^. bodyTxL
 

eras/alonzo/test-suite/src/Test/Cardano/Ledger/Alonzo/Trace.hs

@@ -71,7 +71,6 @@ instance
     LedgerEnv (SlotNo 0) Nothing minBound
       <$> genEraPParams @era geConstants
       <*> genAccountState geConstants
-      <*> pure False
 
   sigGen genenv env state = genTx genenv env state
 

eras/babbage/impl/src/Cardano/Ledger/Babbage.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
@@ -14,7 +15,6 @@ module Cardano.Ledger.Babbage (
 )
 where
 
-import Cardano.Ledger.Alonzo (reapplyAlonzoTx)
 import Cardano.Ledger.Alonzo.Scripts (AlonzoScript (..))
 import Cardano.Ledger.Alonzo.TxAuxData (AlonzoTxAuxData (..))
 import Cardano.Ledger.Babbage.Era (BabbageEra)
@@ -33,6 +33,6 @@ type Babbage = BabbageEra
 -- =====================================================
 
 instance ApplyTx BabbageEra where
-  reapplyTx = reapplyAlonzoTx
+  applyTxValidation = ruleApplyTxValidation @"LEDGER"
 
 instance ApplyBlock BabbageEra

eras/conway/impl/CHANGELOG.md

@@ -2,6 +2,9 @@
 
 ## 1.19.0.0
 
+* Remove `ConwayMempoolPredFailure` and `ConwayMempoolEvent`
+* Switch to `MEMPOOL` rule to be the entry point for `ApplyTx` instead of `LEDGER` and invert their
+  ivocation.
 * Added `ToCBOR` and `FromCBOR` instances for `DefaultVote`.
 * Made the fields of predicate failures and environments lazy
 * Add `MemPack` instance for `PlutusScript ConwayEra`

eras/conway/impl/cardano-ledger-conway.cabal

@@ -180,6 +180,7 @@ library testlib
     plutus-ledger-api,
     prettyprinter,
     small-steps >=1.1,
+    text,
 
 executable huddle-cddl
   main-is: Main.hs

eras/conway/impl/src/Cardano/Ledger/Conway.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
@@ -10,7 +11,6 @@ module Cardano.Ledger.Conway (
 )
 where
 
-import Cardano.Ledger.Alonzo (reapplyAlonzoTx)
 import Cardano.Ledger.Babbage.TxBody ()
 import Cardano.Ledger.Conway.Era (ConwayEra)
 import Cardano.Ledger.Conway.Governance (RunConwayRatify (..))
@@ -30,7 +30,7 @@ type Conway = ConwayEra
 -- =====================================================
 
 instance ApplyTx ConwayEra where
-  reapplyTx = reapplyAlonzoTx
+  applyTxValidation = ruleApplyTxValidation @"MEMPOOL"
 
 instance ApplyBlock ConwayEra