diff --git a/CHANGELOG.md b/CHANGELOG.md index f2b71ecd885..c03c39d103a 100644 --- a/CHANGELOG.md +++ b/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. diff --git a/hydra-node/hydra-node.cabal b/hydra-node/hydra-node.cabal index 30e014f13b7..d9bb0ae0fda 100644 --- a/hydra-node/hydra-node.cabal +++ b/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 diff --git a/hydra-node/src/Hydra/Ledger/Cardano.hs b/hydra-node/src/Hydra/Ledger/Cardano.hs index 5b03ee33921..f9456ba5f74 100644 --- a/hydra-node/src/Hydra/Ledger/Cardano.hs +++ b/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}