From 184928042375927ec2d209cd7463112072250889 Mon Sep 17 00:00:00 2001 From: Nikolaos Bezirgiannis Date: Mon, 8 Aug 2022 16:56:57 +0200 Subject: [PATCH] PLT-580: Return more useful info from the `isScriptWellFormed` function --- plutus-ledger-api/src/Codec/CBOR/Extras.hs | 4 +++- .../src/PlutusLedgerApi/Common.hs | 2 +- .../Common/SerialisedScript.hs | 20 ++++++++++++---- plutus-ledger-api/src/PlutusLedgerApi/V1.hs | 18 ++++++++++----- plutus-ledger-api/src/PlutusLedgerApi/V2.hs | 23 ++++++++++++------- plutus-ledger-api/src/PlutusLedgerApi/V3.hs | 23 ++++++++++++------- plutus-ledger-api/test/Spec/Builtins.hs | 13 ++++++----- 7 files changed, 68 insertions(+), 35 deletions(-) diff --git a/plutus-ledger-api/src/Codec/CBOR/Extras.hs b/plutus-ledger-api/src/Codec/CBOR/Extras.hs index 9cc6706dfb8..c09823a96f4 100644 --- a/plutus-ledger-api/src/Codec/CBOR/Extras.hs +++ b/plutus-ledger-api/src/Codec/CBOR/Extras.hs @@ -17,4 +17,6 @@ instance Flat.Flat a => Serialise (SerialiseViaFlat a) where decodeViaFlat :: Flat.Get a -> CBOR.Decoder s a decodeViaFlat decoder = do bs <- decodeBytes - fromRightM (fail . show) $ Flat.unflatWith decoder bs + -- lift any flat's failures to be cborg failures (MonadFail) + fromRightM (fail . show) $ + Flat.unflatWith decoder bs diff --git a/plutus-ledger-api/src/PlutusLedgerApi/Common.hs b/plutus-ledger-api/src/PlutusLedgerApi/Common.hs index 10fe2eec39e..d38055f70f7 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/Common.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/Common.hs @@ -4,7 +4,7 @@ module PlutusLedgerApi.Common , evaluateScriptRestricting , EvaluationContext (..) , mkDynEvaluationContext - , isScriptWellFormed + , assertScriptWellFormed , assertWellFormedCostModelParams , toMachineParameters , SerialisedScript diff --git a/plutus-ledger-api/src/PlutusLedgerApi/Common/SerialisedScript.hs b/plutus-ledger-api/src/PlutusLedgerApi/Common/SerialisedScript.hs index 4c17a9905ab..40a08a22b06 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/Common/SerialisedScript.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/Common/SerialisedScript.hs @@ -3,7 +3,7 @@ module PlutusLedgerApi.Common.SerialisedScript ( SerialisedScript , scriptCBORDecoder , ScriptForExecution (..) - , isScriptWellFormed + , assertScriptWellFormed ) where import PlutusCore @@ -13,10 +13,12 @@ import UntypedPlutusCore qualified as UPLC import Codec.CBOR.Decoding qualified as CBOR import Codec.CBOR.Extras import Codec.CBOR.Read qualified as CBOR +import Control.Arrow ((>>>)) +import Control.Monad.Except +import Data.Bifunctor import Data.ByteString.Lazy (fromStrict) import Data.ByteString.Short import Data.Coerce -import Data.Either import Data.Set as Set import Prettyprinter @@ -59,6 +61,14 @@ implies that it is (almost certainly) an encoded script and the script does not Note: Parameterized over the ledger-plutus-version since the builtins allowed (during decoding) differs. -} -isScriptWellFormed :: LedgerPlutusVersion -> ProtocolVersion -> SerialisedScript -> Bool -isScriptWellFormed lv pv = isRight . CBOR.deserialiseFromBytes (scriptCBORDecoder lv pv) . fromStrict . fromShort - +assertScriptWellFormed :: MonadError CBOR.DeserialiseFailure m + => LedgerPlutusVersion + -> ProtocolVersion + -> SerialisedScript + -> m () +assertScriptWellFormed lv pv = fromShort + >>> fromStrict + >>> CBOR.deserialiseFromBytes (scriptCBORDecoder lv pv) + -- throw away the success result + >>> second (const ()) + >>> liftEither diff --git a/plutus-ledger-api/src/PlutusLedgerApi/V1.hs b/plutus-ledger-api/src/PlutusLedgerApi/V1.hs index 856f3931e8f..6c15c705bcf 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/V1.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/V1.hs @@ -6,7 +6,7 @@ module PlutusLedgerApi.V1 ( , Script , fromCompiledCode -- * Validating scripts - , isScriptWellFormed + , assertScriptWellFormed -- * Running scripts , evaluateScriptRestricting , evaluateScriptCounting @@ -106,13 +106,16 @@ module PlutusLedgerApi.V1 ( , EvaluationError (..) ) where +import Codec.CBOR.Read qualified as CBOR (DeserialiseFailure) +import Control.Monad.Except (MonadError) import Data.SatInt import PlutusCore.Data qualified as PLC import PlutusCore.Evaluation.Machine.ExBudget as PLC import PlutusCore.Evaluation.Machine.ExMemory (ExCPU (..), ExMemory (..)) -import PlutusLedgerApi.Common as Common hiding (evaluateScriptCounting, evaluateScriptRestricting, isScriptWellFormed) -import PlutusLedgerApi.Common qualified as Common (evaluateScriptCounting, evaluateScriptRestricting, - isScriptWellFormed) +import PlutusLedgerApi.Common as Common hiding (assertScriptWellFormed, evaluateScriptCounting, + evaluateScriptRestricting) +import PlutusLedgerApi.Common qualified as Common (assertScriptWellFormed, evaluateScriptCounting, + evaluateScriptRestricting) import PlutusLedgerApi.V1.Address import PlutusLedgerApi.V1.Bytes import PlutusLedgerApi.V1.Contexts @@ -147,8 +150,11 @@ anything, we're just going to create new versions. -- | Check if a 'Script' is "valid" according to a protocol version. At the moment this means "deserialises correctly", which in particular -- implies that it is (almost certainly) an encoded script and the script does not mention any builtins unavailable in the given protocol version. -isScriptWellFormed :: ProtocolVersion -> SerialisedScript -> Bool -isScriptWellFormed = Common.isScriptWellFormed PlutusV1 +assertScriptWellFormed :: MonadError CBOR.DeserialiseFailure m + => ProtocolVersion + -> SerialisedScript + -> m () +assertScriptWellFormed = Common.assertScriptWellFormed PlutusV1 -- | Evaluates a script, returning the minimum budget that the script would need -- to evaluate successfully. This will take as long as the script takes, if you need to diff --git a/plutus-ledger-api/src/PlutusLedgerApi/V2.hs b/plutus-ledger-api/src/PlutusLedgerApi/V2.hs index 9693c4a27d3..9d1786c6c3f 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/V2.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/V2.hs @@ -6,7 +6,7 @@ module PlutusLedgerApi.V2 ( , Script , fromCompiledCode -- * Validating scripts - , isScriptWellFormed + , assertScriptWellFormed -- * Running scripts , evaluateScriptRestricting , evaluateScriptCounting @@ -111,25 +111,32 @@ module PlutusLedgerApi.V2 ( , EvaluationError (..) ) where -import PlutusLedgerApi.Common as Common hiding (evaluateScriptCounting, evaluateScriptRestricting, isScriptWellFormed) -import PlutusLedgerApi.Common qualified as Common (evaluateScriptCounting, evaluateScriptRestricting, - isScriptWellFormed) +import Codec.CBOR.Read qualified as CBOR (DeserialiseFailure) +import Control.Monad.Except (MonadError) + +import PlutusLedgerApi.Common as Common hiding (assertScriptWellFormed, evaluateScriptCounting, + evaluateScriptRestricting) +import PlutusLedgerApi.Common qualified as Common (assertScriptWellFormed, evaluateScriptCounting, + evaluateScriptRestricting) import PlutusLedgerApi.V1 hiding (ParamName, ScriptContext (..), TxInInfo (..), TxInfo (..), TxOut (..), - evaluateScriptCounting, evaluateScriptRestricting, isScriptWellFormed, mkEvaluationContext) + assertScriptWellFormed, evaluateScriptCounting, evaluateScriptRestricting, + mkEvaluationContext) import PlutusLedgerApi.V1.Scripts (ScriptHash (..)) import PlutusLedgerApi.V2.Contexts import PlutusLedgerApi.V2.EvaluationContext import PlutusLedgerApi.V2.ParamName import PlutusLedgerApi.V2.Tx (OutputDatum (..)) - import PlutusCore.Data qualified as PLC import PlutusTx.AssocMap (Map, fromList) -- | Check if a 'Script' is "valid" according to a protocol version. At the moment this means "deserialises correctly", which in particular -- implies that it is (almost certainly) an encoded script and the script does not mention any builtins unavailable in the given protocol version. -isScriptWellFormed :: ProtocolVersion -> SerialisedScript -> Bool -isScriptWellFormed = Common.isScriptWellFormed PlutusV2 +assertScriptWellFormed :: MonadError CBOR.DeserialiseFailure m + => ProtocolVersion + -> SerialisedScript + -> m () +assertScriptWellFormed = Common.assertScriptWellFormed PlutusV2 -- | Evaluates a script, returning the minimum budget that the script would need -- to evaluate successfully. This will take as long as the script takes, if you need to diff --git a/plutus-ledger-api/src/PlutusLedgerApi/V3.hs b/plutus-ledger-api/src/PlutusLedgerApi/V3.hs index c3754689954..87257fb1ee3 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/V3.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/V3.hs @@ -7,7 +7,7 @@ module PlutusLedgerApi.V3 ( , Script , fromCompiledCode -- * Validating scripts - , isScriptWellFormed + , assertScriptWellFormed -- * Running scripts , evaluateScriptRestricting , evaluateScriptCounting @@ -112,25 +112,32 @@ module PlutusLedgerApi.V3 ( , EvaluationError (..) ) where -import PlutusLedgerApi.Common as Common hiding (evaluateScriptCounting, evaluateScriptRestricting, isScriptWellFormed) -import PlutusLedgerApi.Common qualified as Common (evaluateScriptCounting, evaluateScriptRestricting, - isScriptWellFormed) +import Codec.CBOR.Read qualified as CBOR (DeserialiseFailure) +import Control.Monad.Except (MonadError) + +import PlutusLedgerApi.Common as Common hiding (assertScriptWellFormed, evaluateScriptCounting, + evaluateScriptRestricting) +import PlutusLedgerApi.Common qualified as Common (assertScriptWellFormed, evaluateScriptCounting, + evaluateScriptRestricting) import PlutusLedgerApi.V1 hiding (ParamName, ScriptContext (..), TxInInfo (..), TxInfo (..), TxOut (..), - evaluateScriptCounting, evaluateScriptRestricting, isScriptWellFormed, mkEvaluationContext) + assertScriptWellFormed, evaluateScriptCounting, evaluateScriptRestricting, + mkEvaluationContext) import PlutusLedgerApi.V1.Scripts (ScriptHash (..)) import PlutusLedgerApi.V2.Contexts import PlutusLedgerApi.V2.Tx (OutputDatum (..)) import PlutusLedgerApi.V3.EvaluationContext import PlutusLedgerApi.V3.ParamName - import PlutusCore.Data qualified as PLC import PlutusTx.AssocMap (Map, fromList) -- | Check if a 'Script' is "valid" according to a protocol version. At the moment this means "deserialises correctly", which in particular -- implies that it is (almost certainly) an encoded script and the script does not mention any builtins unavailable in the given protocol version. -isScriptWellFormed :: ProtocolVersion -> SerialisedScript -> Bool -isScriptWellFormed = Common.isScriptWellFormed PlutusV3 +assertScriptWellFormed :: MonadError CBOR.DeserialiseFailure m + => ProtocolVersion + -> SerialisedScript + -> m () +assertScriptWellFormed = Common.assertScriptWellFormed PlutusV3 -- | Evaluates a script, returning the minimum budget that the script would need -- to evaluate successfully. This will take as long as the script takes, if you need to diff --git a/plutus-ledger-api/test/Spec/Builtins.hs b/plutus-ledger-api/test/Spec/Builtins.hs index b912fd660fd..3e95b99e687 100644 --- a/plutus-ledger-api/test/Spec/Builtins.hs +++ b/plutus-ledger-api/test/Spec/Builtins.hs @@ -16,6 +16,7 @@ import UntypedPlutusCore as UPLC import Codec.Serialise import Data.ByteString.Lazy as BSL import Data.ByteString.Short +import Data.Either import Data.Foldable (fold, for_) import Data.Map qualified as Map import Data.Set qualified as Set @@ -39,10 +40,10 @@ tests = in for_ allBuiltins $ \f -> assertBool (show f) (f `Set.member` allPvBuiltins) , testCase "builtins aren't available before Alonzo" $ assertBool "empty" (Set.null $ builtinsAvailableIn PlutusV1 maryPV) -- l1 valid, p4 invalid , testCase "serializeData is only available in l2,Vasil and after" $ do - assertBool "in l1,Alonzo" $ not $ V1.isScriptWellFormed alonzoPV serialiseDataExScript - assertBool "in l1,Vasil" $ not $ V1.isScriptWellFormed vasilPV serialiseDataExScript - assertBool "in l2,Alonzo" $ not $ V2.isScriptWellFormed alonzoPV serialiseDataExScript - assertBool "in l3,Alonzo" $ not $ V3.isScriptWellFormed alonzoPV serialiseDataExScript - assertBool "not in l2,Vasil" $ V2.isScriptWellFormed vasilPV serialiseDataExScript - assertBool "not in l3,Chang" $ V3.isScriptWellFormed changPV serialiseDataExScript + assertBool "in l1,Alonzo" $ isLeft $ V1.assertScriptWellFormed alonzoPV serialiseDataExScript + assertBool "in l1,Vasil" $ isLeft $ V1.assertScriptWellFormed vasilPV serialiseDataExScript + assertBool "in l2,Alonzo" $ isLeft $ V2.assertScriptWellFormed alonzoPV serialiseDataExScript + assertBool "in l3,Alonzo" $ isLeft $ V3.assertScriptWellFormed alonzoPV serialiseDataExScript + assertBool "not in l2,Vasil" $ isRight $ V2.assertScriptWellFormed vasilPV serialiseDataExScript + assertBool "not in l3,Chang" $ isRight $ V3.assertScriptWellFormed changPV serialiseDataExScript ]