fix: return full redeemer report instead of single entry

testgen-hs/Evaluation.hs

@@ -1,6 +1,5 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
@@ -15,10 +14,9 @@ where
 import CLI (GenSize (..), NumCases (..), Seed (..))
 import Cardano.Api.Internal.Orphans ()
 import Cardano.Ledger.Alonzo.Plutus.Evaluate (evalTxExUnits)
-import Cardano.Ledger.Alonzo.Scripts (AsIx (..), ExUnits (..))
 import Cardano.Ledger.Api (ConwayEra, PParams, TransactionScriptFailure)
 import qualified Cardano.Ledger.Api as Ledger
-import Cardano.Ledger.Api.Tx (PlutusPurpose, RedeemerReport, Tx)
+import Cardano.Ledger.Api.Tx (RedeemerReport, Tx)
 import Cardano.Ledger.Api.UTxO (UTxO (..))
 import Cardano.Slotting.EpochInfo (EpochInfo)
 import Cardano.Slotting.Slot ()
@@ -27,7 +25,6 @@ import Data.Aeson (ToJSON)
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Encoding as AesonEncoding
 import qualified Data.ByteString.Lazy.Char8 as BL8
-import Data.List (sortOn)
 import qualified Data.Map as Map
 import Data.Proxy (Proxy)
 import Data.Text (Text)
@@ -89,61 +86,9 @@ eval'Conway ::
   SystemStart ->
   J.Value
 eval'Conway pparams tx utxo epochInfo systemStart =
-  case J.decode (AesonEncoding.encodingToLazyByteString (ogmiosSuccess redeemerReport)) of
+  case J.decode (AesonEncoding.encodingToLazyByteString (ogmiosSuccess report)) of
     Just v -> v
     Nothing -> error "ogmiosSuccess produced invalid JSON"
   where
-    redeemerReport :: RedeemerReport ConwayEra
-    redeemerReport = selectSingleReport fullReport
-
-    fullReport :: RedeemerReport ConwayEra
-    fullReport = evalTxExUnits pparams tx utxo epochInfo systemStart
-
-    -- Collapse the full report down to a single entry, preferring failures.
-    selectSingleReport :: RedeemerReport ConwayEra -> RedeemerReport ConwayEra
-    selectSingleReport report =
-      case Map.toList failures of
-        (purpose, errors) : _ ->
-          Map.singleton purpose (Left (pickScriptFailure errors))
-        [] ->
-          case Map.toList successes of
-            (purpose, exUnits) : _ ->
-              Map.singleton purpose (Right exUnits)
-            [] ->
-              Map.empty
-      where
-        (failures, successes) = Map.foldrWithKey groupReports (Map.empty, Map.empty) report
-
-    groupReports ::
-      (Ord (PlutusPurpose AsIx era)) =>
-      PlutusPurpose AsIx era ->
-      Either (Ledger.TransactionScriptFailure era) ExUnits ->
-      (Map.Map (PlutusPurpose AsIx era) [Ledger.TransactionScriptFailure era], Map.Map (PlutusPurpose AsIx era) ExUnits) ->
-      (Map.Map (PlutusPurpose AsIx era) [Ledger.TransactionScriptFailure era], Map.Map (PlutusPurpose AsIx era) ExUnits)
-    groupReports purpose result (failures, successes) =
-      case result of
-        Left scriptFail -> (Map.unionWith (++) (Map.singleton purpose [scriptFail]) failures, successes)
-        Right exUnits -> (failures, Map.singleton purpose exUnits <> successes)
-
--- | Return the most relevant script failure from a list of errors.
-pickScriptFailure ::
-  [Ledger.TransactionScriptFailure era] ->
-  Ledger.TransactionScriptFailure era
-pickScriptFailure xs =
-  case sortOn scriptFailurePriority xs of
-    [] -> error "Empty list of script failures from the ledger!?"
-    x : _ -> x
-  where
-    scriptFailurePriority ::
-      Ledger.TransactionScriptFailure era ->
-      Word
-    scriptFailurePriority = \case
-      Ledger.UnknownTxIn {} -> 0
-      Ledger.MissingScript {} -> 0
-      Ledger.RedeemerPointsToUnknownScriptHash {} -> 1
-      Ledger.NoCostModelInLedgerState {} -> 1
-      Ledger.InvalidTxIn {} -> 2
-      Ledger.MissingDatum {} -> 3
-      Ledger.ContextError {} -> 4
-      Ledger.ValidationFailure {} -> 5
-      Ledger.IncompatibleBudget {} -> 999
+    report :: RedeemerReport ConwayEra
+    report = evalTxExUnits pparams tx utxo epochInfo systemStart