PLT-272: Give a better error when builtins aren't available (#4736)

* PLT-272: Give a better error when builtins aren't available

Make the predicate an error-producing function so we can give an error
with more context.

* Remove redundant constraints

* Remove more redundant constraints

plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Instance/Flat.hs

@@ -12,7 +12,6 @@ module UntypedPlutusCore.Core.Instance.Flat where
 import UntypedPlutusCore.Core.Type
 
 import PlutusCore.Flat
-import PlutusCore.Pretty
 
 import Data.Word (Word8)
 import Flat
@@ -97,7 +96,6 @@ encodeTerm
     :: forall name uni fun ann
     . ( Closed uni
     , uni `Everywhere` Flat
-    , PrettyPlc (Term name uni fun ann)
     , Flat fun
     , Flat ann
     , Flat name
@@ -119,13 +117,12 @@ decodeTerm
     :: forall name uni fun ann
     . ( Closed uni
     , uni `Everywhere` Flat
-    , PrettyPlc (Term name uni fun ann)
     , Flat fun
     , Flat ann
     , Flat name
     , Flat (Binder name)
     )
-    => (fun -> Bool)
+    => (fun -> Maybe String)
     -> Get (Term name uni fun ann)
 decodeTerm builtinPred = go
     where
@@ -142,16 +139,15 @@ decodeTerm builtinPred = go
             fun <- decode
             let t :: Term name uni fun ann
                 t = Builtin ann fun
-            if builtinPred fun
-            then pure t
-            else fail $ "Forbidden builtin function: " ++ show (prettyPlcDef t)
+            case builtinPred fun of
+                Nothing -> pure t
+                Just e  -> fail e
         handleTerm t = fail $ "Unknown term constructor tag: " ++ show t
 
 sizeTerm
     :: forall name uni fun ann
     . ( Closed uni
     , uni `Everywhere` Flat
-    , PrettyPlc (Term name uni fun ann)
     , Flat fun
     , Flat ann
     , Flat name
@@ -174,13 +170,12 @@ decodeProgram
     :: forall name uni fun ann
     . ( Closed uni
     , uni `Everywhere` Flat
-    , PrettyPlc (Term name uni fun ann)
     , Flat fun
     , Flat ann
     , Flat name
     , Flat (Binder name)
     )
-    => (fun -> Bool)
+    => (fun -> Maybe String)
     -> Get (Program name uni fun ann)
 decodeProgram builtinPred = Program <$> decode <*> decode <*> decodeTerm builtinPred
 
@@ -195,20 +190,18 @@ the expected behaviour.
 
 instance ( Closed uni
          , uni `Everywhere` Flat
-         , PrettyPlc (Term name uni fun ann)
          , Flat fun
          , Flat ann
          , Flat name
          , Flat (Binder name)
          ) => Flat (Term name uni fun ann) where
     encode = encodeTerm
-    decode = decodeTerm (const True)
+    decode = decodeTerm (const Nothing)
     size = sizeTerm
 
 -- This instance could probably be derived, but better to write it explicitly ourselves so we have control!
 instance ( Closed uni
          , uni `Everywhere` Flat
-         , PrettyPlc (Term name uni fun ann)
          , Flat fun
          , Flat ann
          , Flat name

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

@@ -17,6 +17,7 @@ import Data.ByteString.Short
 import Data.Coerce
 import Data.Either
 import Data.Set as Set
+import Prettyprinter
 
 {- Note [Size checking of constants in PLC programs]
 We impose a 64-byte *on-the-wire* limit on the constants inside PLC programs. This prevents people from inserting
@@ -43,8 +44,10 @@ scriptCBORDecoder :: LedgerPlutusVersion -> ProtocolVersion -> CBOR.Decoder s Sc
 scriptCBORDecoder lv pv =
     -- See Note [New builtins and protocol versions]
     let availableBuiltins = builtinsAvailableIn lv pv
+        flatDecoder = UPLC.decodeProgram checkBuiltin
         -- TODO: optimize this by using a better datastructure e.g. 'IntSet'
-        flatDecoder = UPLC.decodeProgram (\f -> f `Set.member` availableBuiltins)
+        checkBuiltin f | f `Set.member` availableBuiltins = Nothing
+        checkBuiltin f = Just $ "Builtin function " ++ show f ++ " is not available in language " ++ show (pretty lv) ++ " at and protocol version " ++ show (pretty pv)
     in do
         -- Deserialise using 'FakeNamedDeBruijn' to get the fake names added
         (p :: UPLC.Program UPLC.FakeNamedDeBruijn DefaultUni DefaultFun ()) <- decodeViaFlat flatDecoder

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

@@ -12,6 +12,7 @@ import PlutusLedgerApi.Common.ProtocolVersions
 import Data.Foldable
 import Data.Map qualified as Map
 import Data.Set qualified as Set
+import Prettyprinter
 
 {- Note [New builtins and protocol versions]
 When we add a new builtin to the language, that is a *backwards-compatible* change.
@@ -41,6 +42,9 @@ data LedgerPlutusVersion =
     | PlutusV3
    deriving stock (Eq, Ord, Show)
 
+instance Pretty LedgerPlutusVersion where
+    pretty = viaShow
+
 {-| A map indicating which builtin functions were introduced in which 'ProtocolVersion'. Each builtin function should appear at most once.
 
 This *must* be updated when new builtins are added.

plutus-tx-plugin/test/Lib.hs

@@ -29,7 +29,7 @@ import PlutusCore.Pretty
 import UntypedPlutusCore qualified as UPLC
 import UntypedPlutusCore.Evaluation.Machine.Cek
 
-instance (PLC.Closed uni, uni `PLC.Everywhere` Flat, uni `PLC.Everywhere` PrettyConst, Pretty (PLC.SomeTypeIn uni), Pretty fun, Flat fun) =>
+instance (PLC.Closed uni, uni `PLC.Everywhere` Flat, Flat fun) =>
             ToUPlc (CompiledCodeIn uni fun a) uni fun where
     toUPlc v = do
         v' <- catchAll $ getPlc v

plutus-tx/src/PlutusTx/Code.hs

@@ -18,7 +18,6 @@ import PlutusTx.Lift.Instances ()
 import PlutusIR qualified as PIR
 
 import PlutusCore qualified as PLC
-import PlutusCore.Pretty qualified as PLC
 import UntypedPlutusCore qualified as UPLC
 
 import Control.Exception
@@ -57,15 +56,15 @@ type CompiledCode = CompiledCodeIn PLC.DefaultUni PLC.DefaultFun
 
 -- | Apply a compiled function to a compiled argument.
 applyCode
-    :: (PLC.Closed uni, uni `PLC.Everywhere` Flat, Flat fun, uni `PLC.Everywhere` PLC.PrettyConst, PLC.Pretty (PLC.SomeTypeIn uni), PLC.Pretty fun)
+    :: (PLC.Closed uni, uni `PLC.Everywhere` Flat, Flat fun)
     => CompiledCodeIn uni fun (a -> b) -> CompiledCodeIn uni fun a -> CompiledCodeIn uni fun b
 applyCode fun arg = DeserializedCode (UPLC.applyProgram (getPlc fun) (getPlc arg)) (PIR.applyProgram <$> getPir fun <*> getPir arg) (getCovIdx fun <> getCovIdx arg)
 
 -- | The size of a 'CompiledCodeIn', in AST nodes.
-sizePlc :: (PLC.Closed uni, uni `PLC.Everywhere` Flat, Flat fun, uni `PLC.Everywhere` PLC.PrettyConst, PLC.Pretty (PLC.SomeTypeIn uni), PLC.Pretty fun) => CompiledCodeIn uni fun a -> Integer
+sizePlc :: (PLC.Closed uni, uni `PLC.Everywhere` Flat, Flat fun) => CompiledCodeIn uni fun a -> Integer
 sizePlc = UPLC.programSize . getPlc
 
-instance (PLC.Closed uni, uni `PLC.Everywhere` Flat, Flat fun, uni `PLC.Everywhere` PLC.PrettyConst, PLC.Pretty (PLC.SomeTypeIn uni), PLC.Pretty fun)
+instance (PLC.Closed uni, uni `PLC.Everywhere` Flat, Flat fun)
     => Flat (CompiledCodeIn uni fun a) where
     encode c = encode (getPlc c)
 
@@ -90,7 +89,7 @@ instance HasErrorCode ImpossibleDeserialisationFailure where
 
 -- | Get the actual Plutus Core program out of a 'CompiledCodeIn'.
 getPlc
-    :: (PLC.Closed uni, uni `PLC.Everywhere` Flat, Flat fun, uni `PLC.Everywhere` PLC.PrettyConst, PLC.Pretty (PLC.SomeTypeIn uni), PLC.Pretty fun)
+    :: (PLC.Closed uni, uni `PLC.Everywhere` Flat, Flat fun)
     => CompiledCodeIn uni fun a -> UPLC.Program UPLC.NamedDeBruijn uni fun ()
 getPlc wrapper = case wrapper of
     SerializedCode plc _ _ -> case unflat (BSL.fromStrict plc) of

plutus-tx/testlib/PlutusTx/Test.hs

@@ -143,7 +143,7 @@ goldenEvalCekLog name values = nestedGoldenVsDocM name $ pretty . view _1 <$> (r
 
 -- Helpers
 
-instance (PLC.Closed uni, uni `PLC.Everywhere` Flat, uni `PLC.Everywhere` PrettyConst, Pretty (PLC.SomeTypeIn uni), Pretty fun, Flat fun) =>
+instance (PLC.Closed uni, uni `PLC.Everywhere` Flat, Flat fun) =>
             ToUPlc (CompiledCodeIn uni fun a) uni fun where
     toUPlc v = do
         v' <- catchAll $ getPlc v