Allow predicate failures from applyTx

This is a temporary measure until the embedded transactions are fixed
for Conway. With this change it's possible to run the benchmarks but
they're measuring failing transactions which isn't representative of
real traffic.

Author: neilmayhew

libs/ledger-state/bench/Performance.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeApplications #-}
@@ -11,6 +12,10 @@ import Cardano.Ledger.Api.Era
 import Cardano.Ledger.Api.State.Query (queryStakePoolDelegsAndRewards)
 import Cardano.Ledger.BaseTypes
 import Cardano.Ledger.Binary
+import Cardano.Ledger.Conway.Rules (
+  ConwayLedgerPredFailure (ConwayUtxowFailure),
+  ConwayUtxowPredFailure (InvalidWitnessesUTXOW),
+ )
 import Cardano.Ledger.Core
 import Cardano.Ledger.Shelley.API.Mempool
 import Cardano.Ledger.Shelley.API.Wallet (getFilteredUTxO, getUTxO)
@@ -30,10 +35,11 @@ import Control.DeepSeq
 import Control.Monad (when)
 import Criterion.Main
 import Data.Aeson
-import Data.Bifunctor (first)
+import Data.Bifunctor (bimap, first)
 import Data.ByteString.Base16.Lazy as BSL16
 import Data.ByteString.Lazy (ByteString)
 import Data.Foldable as F
+import Data.List.NonEmpty (NonEmpty ((:|)))
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import Data.MapExtras (extractKeys, extractKeysSmallSet)
@@ -75,8 +81,12 @@ main = do
       toMempoolState NewEpochState {nesEs = EpochState {esLState}} = esLState
       !globals = mkGlobals genesis
       !slotNo = SlotNo 55733343
+      restrictError = \case
+        ApplyTxError (ConwayUtxowFailure (InvalidWitnessesUTXOW [_]) :| []) -> ()
+        otherErr -> error . show $ otherErr
       applyTx' mempoolEnv mempoolState =
-        either (error . show) seqTuple
+        -- TODO: revert this to `either (error . show) seqTuple` after tx's are fixed
+        bimap restrictError seqTuple
           . applyTx globals mempoolEnv mempoolState
       reapplyTx' mempoolEnv mempoolState =
         either (error . show) id
@@ -112,7 +122,9 @@ main = do
               bench "Tx3" . whnf (applyTx' mempoolEnv mempoolState)
           , env
               (pure [validatedTx1, validatedTx2, validatedTx3])
-              $ bench "Tx1+Tx2+Tx3" . whnf (F.foldl' (\ms -> fst . applyTx' mempoolEnv ms . extractTx) mempoolState)
+              $ bench "Tx1+Tx2+Tx3"
+                -- TODO: revert this to `foldl'` without `fmap` after tx's are fixed
+                . whnf (F.foldlM (\ms -> fmap fst . applyTx' mempoolEnv ms . extractTx) mempoolState)
           ]
     , env (pure utxo) $ \utxo' ->
         bgroup

libs/ledger-state/ledger-state.cabal

@@ -125,6 +125,7 @@ benchmark performance
     cardano-data,
     cardano-ledger-api:{cardano-ledger-api, testlib},
     cardano-ledger-binary,
+    cardano-ledger-conway,
     cardano-ledger-core:{cardano-ledger-core, testlib},
     cardano-ledger-shelley,
     cardano-slotting,