PLT-580: Return more useful info from the isScriptWellFormed function

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

plutus-ledger-api/src/PlutusLedgerApi/Common.hs

@@ -4,7 +4,7 @@ module PlutusLedgerApi.Common
     , evaluateScriptRestricting
     , EvaluationContext (..)
     , mkDynEvaluationContext
-    , isScriptWellFormed
+    , assertScriptWellFormed
     , assertWellFormedCostModelParams
     , toMachineParameters
     , SerialisedScript

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

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

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

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

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
     ]