Map and debug PlutusFailure cases of ApplyTx

CHANGELOG.md

@@ -38,6 +38,8 @@ changes.
   - Overall this results in transactions still to be submitted once per client,
     but requires signifanctly less book-keeping on the client-side.
 
+- Auto-debug and provide more information on `PlutusFailure` when validating transactions on L2 ledger.
+
 - Bump docusaurus version
 
 - Add blockfrost support to `hydra-chain-observer`, to follow the chain via Blockfrost API.

hydra-node/hydra-node.cabal

@@ -109,6 +109,7 @@ library
     , cardano-ledger-api
     , cardano-ledger-babbage
     , cardano-ledger-babbage:testlib
+    , cardano-ledger-conway
     , cardano-ledger-conway:testlib
     , cardano-ledger-core
     , cardano-ledger-core:testlib

hydra-node/src/Hydra/Ledger/Cardano.hs

@@ -16,7 +16,18 @@ import Hydra.Ledger.Cardano.Builder
 
 import Cardano.Api.UTxO (fromPairs, pairs)
 import Cardano.Api.UTxO qualified as UTxO
+import Cardano.Ledger.Alonzo.Rules (
+  FailureDescription (..),
+  TagMismatchDescription (FailedUnexpectedly),
+ )
 import Cardano.Ledger.BaseTypes qualified as Ledger
+import Cardano.Ledger.Conway.Rules (
+  ConwayLedgerPredFailure (ConwayUtxowFailure),
+  ConwayUtxoPredFailure (UtxosFailure),
+  ConwayUtxosPredFailure (ValidationTagMismatch),
+  ConwayUtxowPredFailure (UtxoFailure),
+ )
+import Cardano.Ledger.Plutus (debugPlutus)
 import Cardano.Ledger.Shelley.API.Mempool qualified as Ledger
 import Cardano.Ledger.Shelley.Genesis qualified as Ledger
 import Cardano.Ledger.Shelley.LedgerState qualified as Ledger
@@ -68,7 +79,16 @@ cardanoLedger globals ledgerEnv =
       Right (Ledger.LedgerState{Ledger.lsUTxOState = us}, _validatedTx) ->
         Right . fromLedgerUTxO $ Ledger.utxosUtxo us
    where
-    toValidationError = ValidationError . show
+    -- As we use applyTx we only expect one ledger rule to run and one tx to
+    -- fail validation, hence using the heads of non empty lists is fine.
+    toValidationError (Ledger.ApplyTxError (e :| _)) = case e of
+      (ConwayUtxowFailure (UtxoFailure (UtxosFailure (ValidationTagMismatch _ (FailedUnexpectedly (PlutusFailure msg ctx :| _)))))) ->
+        ValidationError $
+          "Plutus validation failed: "
+            <> msg
+            <> "Debug info: "
+            <> show (debugPlutus @StandardCrypto (decodeUtf8 ctx))
+      _ -> ValidationError $ show e
 
     env' = ledgerEnv{Ledger.ledgerSlotNo = fromIntegral slot}