diff --git a/eras/conway/impl/cardano-ledger-conway.cabal b/eras/conway/impl/cardano-ledger-conway.cabal index fe49f99882e..e89b2938d38 100644 --- a/eras/conway/impl/cardano-ledger-conway.cabal +++ b/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 diff --git a/eras/conway/impl/cddl-files/extra.cddl b/eras/conway/impl/cddl-files/extra.cddl index f4fa6e31ad7..b2619c2fac2 100644 --- a/eras/conway/impl/cddl-files/extra.cddl +++ b/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 = #6.258([* a]) / [* a] +; Just like `set`, but must contain at least one element. nonempty_set = #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 = #6.258([+ a]) / [+ a] positive_int = 1 .. 18446744073709551615 diff --git a/hie.yaml b/hie.yaml index 1790f9156a6..19f3d97d222 100644 --- a/hie.yaml +++ b/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" diff --git a/libs/cardano-ledger-core/CHANGELOG.md b/libs/cardano-ledger-core/CHANGELOG.md index fdf92b6c513..b2f6108b2c4 100644 --- a/libs/cardano-ledger-core/CHANGELOG.md +++ b/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 diff --git a/libs/plutus-preprocessor/src/Debug.hs b/libs/cardano-ledger-core/app/PlutusDebug.hs similarity index 68% rename from libs/plutus-preprocessor/src/Debug.hs rename to libs/cardano-ledger-core/app/PlutusDebug.hs index 7c0d412ed84..d597e413b04 100644 --- a/libs/plutus-preprocessor/src/Debug.hs +++ b/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 diff --git a/libs/cardano-ledger-core/cardano-ledger-core.cabal b/libs/cardano-ledger-core/cardano-ledger-core.cabal index cb21397552c..bb33f7badc3 100644 --- a/libs/cardano-ledger-core/cardano-ledger-core.cabal +++ b/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 diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/Evaluate.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/Evaluate.hs index 33d478923b7..b24df9eef3d 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/Evaluate.hs +++ b/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 diff --git a/libs/plutus-preprocessor/plutus-preprocessor.cabal b/libs/plutus-preprocessor/plutus-preprocessor.cabal index 0bd3475ebd2..1ff6234322d 100644 --- a/libs/plutus-preprocessor/plutus-preprocessor.cabal +++ b/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