Improvements to plutus debug

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

@@ -1,6 +1,6 @@
 cabal-version:      3.0
 name:               cardano-ledger-conway
-version:            1.16.0.1
+version:            1.16.1.0
 license:            Apache-2.0
 maintainer:         operations@iohk.io
 author:             IOHK

eras/conway/impl/cddl-files/extra.cddl

@@ -2,10 +2,13 @@
 ; second era after Conway. We recommend all the tooling to account for this future breaking
 ; change sooner rather than later, in order to provide a smooth transition for their users.
 
+; This is an unordered set. Duplicate elements are not allowed and the order of elements is implementation specific.
 set<a> = #6.258([* a]) / [* a]
 
+; Just like `set`, but must contain at least one element.
 nonempty_set<a> = #6.258([+ a]) / [+ a]
 
+; This is a non-empty ordered set. Duplicate elements are not allowed and the order of elements will be preserved.
 nonempty_oset<a> = #6.258([+ a]) / [+ a]
 
 positive_int = 1 .. 18446744073709551615

hie.yaml

@@ -192,6 +192,9 @@ cradle:
     - path: "libs/cardano-ledger-core/testlib"
       component: "cardano-ledger-core:lib:testlib"
 
+    - path: "libs/cardano-ledger-core/app/PlutusDebug.hs"
+      component: "cardano-ledger-core:exe:plutus-debug"
+
     - path: "libs/cardano-ledger-core/test"
       component: "cardano-ledger-core:test:tests"
 
@@ -285,9 +288,6 @@ cradle:
     - path: "libs/plutus-preprocessor/app/Main.hs"
       component: "plutus-preprocessor:exe:plutus-preprocessor"
 
-    - path: "libs/plutus-preprocessor/src/Debug.hs"
-      component: "plutus-preprocessor:exe:plutus-debug"
-
     - path: "libs/set-algebra/src"
       component: "lib:set-algebra"
 

libs/cardano-ledger-core/CHANGELOG.md

@@ -9,6 +9,9 @@
 ## 1.14.0.0
 
 * Add `mkTermToEvaluate` to `PlutusLanguage` class.
+* Add a field to `DebugFailure`
+* Convert `debugPlutus` to an `IO` action
+* Add `plutus-debug` executable
 
 ## 1.13.2.0
 

libs/plutus-preprocessor/src/Debug.hs → libs/cardano-ledger-core/app/PlutusDebug.hs

@@ -4,7 +4,8 @@ module Main where
 
 import Cardano.Ledger.Crypto (StandardCrypto)
 import Cardano.Ledger.Plutus.Evaluate (debugPlutus)
+import Control.Monad ((<=<))
 import System.Environment (getArgs)
 
 main :: IO ()
-main = mapM_ (print . debugPlutus @StandardCrypto) =<< getArgs
+main = mapM_ (print <=< debugPlutus @StandardCrypto) =<< getArgs

libs/cardano-ledger-core/cardano-ledger-core.cabal

@@ -208,6 +208,19 @@ library testlib
     if !impl(ghc >=9.2)
         ghc-options: -Wno-name-shadowing
 
+executable plutus-debug
+    main-is:          PlutusDebug.hs
+    hs-source-dirs:   app
+    default-language: Haskell2010
+    ghc-options:
+        -Wall -Wcompat -Wincomplete-record-updates
+        -Wincomplete-uni-patterns -Wredundant-constraints -Wpartial-fields
+        -Wunused-packages -threaded -rtsopts -with-rtsopts=-N
+
+    build-depends:
+        base >=4.14 && <5,
+        cardano-ledger-core
+
 test-suite tests
     type:             exitcode-stdio-1.0
     main-is:          Main.hs

libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/Evaluate.hs

@@ -5,6 +5,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE RankNTypes #-}
@@ -61,8 +62,9 @@ import Cardano.Ledger.Plutus.Language (
   withSamePlutusLanguage,
  )
 import Cardano.Ledger.Plutus.TxInfo
-import Control.DeepSeq (NFData (..))
-import Control.Monad (unless)
+import Control.DeepSeq (NFData (..), force)
+import Control.Exception (evaluate)
+import Control.Monad (join, unless)
 import qualified Data.ByteString.Base64 as B64
 import qualified Data.ByteString.UTF8 as BSU
 import Data.List.NonEmpty (NonEmpty (..))
@@ -71,6 +73,7 @@ import Data.Text (Text, pack)
 import GHC.Generics (Generic)
 import PlutusLedgerApi.Common as P (EvaluationError (CodecError), ExBudget, VerboseMode (..))
 import Prettyprinter (Pretty (..))
+import System.Timeout (timeout)
 
 -- | This type contains all that is necessary from Ledger to evaluate a plutus script.
 data PlutusWithContext c where
@@ -196,27 +199,51 @@ instance Crypto c => FromCBOR (PlutusWithContext c) where
 data PlutusDebugInfo c
   = DebugBadHex String
   | DebugCannotDecode String
-  | DebugSuccess [Text] P.ExBudget
-  | DebugFailure [Text] P.EvaluationError (PlutusWithContext c)
+  | DebugSuccess
+      -- | Execution logs from the plutus interpreter
+      [Text]
+      -- | Execution budget that was consumed. It will always be less or equal to what was
+      -- supplied during execution.
+      P.ExBudget
+  | DebugFailure
+      -- | Execution logs from the plutus interpreter
+      [Text]
+      -- | Evaluation error from Plutus interpreter
+      P.EvaluationError
+      -- | Everything that is needed in order to run the script
+      (PlutusWithContext c)
+      -- | Expected execution budget. This value is Nothing when the supplied script can't
+      -- be executed within 5 second limit or there is a problem with decoding plutus script
+      -- itself.
+      (Maybe P.ExBudget)
   deriving (Show)
 
-debugPlutus :: Crypto c => String -> PlutusDebugInfo c
+debugPlutus :: Crypto c => String -> IO (PlutusDebugInfo c)
 debugPlutus db =
   case B64.decode (BSU.fromString db) of
-    Left e -> DebugBadHex (show e)
+    Left e -> pure $ DebugBadHex (show e)
     Right bs ->
       case Plain.decodeFull' bs of
-        Left e -> DebugCannotDecode $ show e
+        Left e -> pure $ DebugCannotDecode $ show e
         Right pwc@(PlutusWithContext {..}) ->
           let cm = getEvaluationContext pwcCostModel
               eu = transExUnits pwcExUnits
-              onDecoderError err = DebugFailure [] err pwc
-              toDebugInfo = \case
-                (logs, Left err) -> DebugFailure logs err pwc
-                (logs, Right ex) -> DebugSuccess logs ex
+              onDecoderError err = pure $ DebugFailure [] err pwc Nothing
            in withRunnablePlutusWithContext pwc onDecoderError $ \plutusRunnable args ->
-                toDebugInfo $
-                  evaluatePlutusRunnable pwcProtocolVersion P.Verbose cm eu plutusRunnable args
+                let toDebugInfo = \case
+                      (logs, Left err@(P.CodecError {})) -> pure $ DebugFailure logs err pwc Nothing
+                      (logs, Left err) -> do
+                        mExpectedExUnits <-
+                          timeout 5_000_000 $ do
+                            let res =
+                                  evaluatePlutusRunnableBudget pwcProtocolVersion P.Verbose cm plutusRunnable args
+                            case snd res of
+                              Left {} -> pure Nothing
+                              Right exUnits -> Just <$> evaluate (force exUnits)
+                        pure $ DebugFailure logs err pwc (join mExpectedExUnits)
+                      (logs, Right ex) -> pure $ DebugSuccess logs ex
+                 in toDebugInfo $
+                      evaluatePlutusRunnable pwcProtocolVersion P.Verbose cm eu plutusRunnable args
 
 runPlutusScript :: PlutusWithContext c -> ScriptResult c
 runPlutusScript = snd . runPlutusScriptWithLogs

libs/plutus-preprocessor/plutus-preprocessor.cabal

@@ -62,16 +62,3 @@ executable plutus-preprocessor
 
     if (impl(ghc <9.6) || impl(ghc >=9.7))
         buildable: False
-
-executable plutus-debug
-    main-is:          Debug.hs
-    hs-source-dirs:   src
-    default-language: Haskell2010
-    ghc-options:
-        -Wall -Wcompat -Wincomplete-record-updates
-        -Wincomplete-uni-patterns -Wredundant-constraints -Wpartial-fields
-        -Wunused-packages -threaded -rtsopts -with-rtsopts=-N
-
-    build-depends:
-        base >=4.14 && <5,
-        cardano-ledger-core >=1.0