Don't evaluate away builtins where the result might be unserializable

plutus-core/changelog.d/20231204_155446_michael.peyton-jones_non_representable_constants.md

@@ -0,0 +1,3 @@
+### Fixed
+
+- The `EvaluateBuiltins` pass will no longer produce constants that can't be serialized.

plutus-core/plutus-ir/src/PlutusIR/Analysis/Builtins.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs             #-}
 {-# LANGUAGE KindSignatures    #-}
+{-# LANGUAGE LambdaCase        #-}
 {-# LANGUAGE PatternSynonyms   #-}
 {-# LANGUAGE RankNTypes        #-}
 {-# LANGUAGE TemplateHaskell   #-}
@@ -13,9 +14,13 @@ module PlutusIR.Analysis.Builtins
     , BuiltinsInfo (..)
     , biSemanticsVariant
     , biMatcherLike
+    , biUnserializableConstants
     , builtinArityInfo
+    , constantIsSerializable
+    , termIsSerializable
     , asBuiltinDatatypeMatch
     , builtinDatatypeMatchBranchArities
+    , defaultUniUnserializableConstants
     ) where
 
 import Control.Lens hiding (parts)
@@ -29,6 +34,8 @@ import PlutusCore.Builtin qualified as PLC
 import PlutusCore.Default
 import PlutusCore.MkPlc (mkIterTyAppNoAnn)
 import PlutusIR.Contexts
+import PlutusIR.Core (Term)
+import PlutusIR.Core.Plated (_Constant, termSubtermsDeep)
 import PlutusPrelude (Default (..))
 
 -- | The information we need to work with a builtin that is like a datatype matcher.
@@ -41,15 +48,18 @@ makeLenses ''BuiltinMatcherLike
 
 -- | All non-static information about builtins that the compiler might want.
 data BuiltinsInfo (uni :: Type -> Type) fun = BuiltinsInfo
-  { _biSemanticsVariant :: PLC.BuiltinSemanticsVariant fun
-  , _biMatcherLike      :: Map.Map fun (BuiltinMatcherLike uni fun)
+  { _biSemanticsVariant        :: PLC.BuiltinSemanticsVariant fun
+  , _biMatcherLike             :: Map.Map fun (BuiltinMatcherLike uni fun)
+  -- See Note [Unserializable constants]
+  , _biUnserializableConstants :: Some (ValueOf uni) -> Bool
   }
 makeLenses ''BuiltinsInfo
 
 instance Default (BuiltinsInfo DefaultUni DefaultFun) where
   def = BuiltinsInfo
         { _biSemanticsVariant = def
         , _biMatcherLike = defaultUniMatcherLike
+        , _biUnserializableConstants = defaultUniUnserializableConstants
         }
 
 -- | Get the arity of a builtin function from the 'PLC.BuiltinInfo'.
@@ -61,6 +71,19 @@ builtinArityInfo
     -> Arity
 builtinArityInfo binfo = builtinArity (Proxy @uni) (binfo ^. biSemanticsVariant)
 
+constantIsSerializable
+  :: forall uni fun
+  . BuiltinsInfo uni fun
+  -> Some (ValueOf uni)
+  -> Bool
+constantIsSerializable bi v = not $ _biUnserializableConstants bi v
+
+termIsSerializable :: BuiltinsInfo uni fun -> Term tyname name uni fun a -> Bool
+termIsSerializable binfo =
+  allOf
+    (termSubtermsDeep . _Constant)
+    (constantIsSerializable binfo . snd)
+
 -- | Split a builtin 'match'.
 asBuiltinDatatypeMatch ::
   Ord fun
@@ -162,3 +185,45 @@ defaultUniMatcherLike = Map.fromList
       vars <> TypeAppContext resTy resTyAnn (TermAppContext scrut scrutAnn branches)
     -- both branches have no args
     chooseListBranchArities = [[], []]
+
+-- See Note [Unserializable constants]
+defaultUniUnserializableConstants :: Some (ValueOf DefaultUni) -> Bool
+defaultUniUnserializableConstants = \case
+  Some (ValueOf DefaultUniBLS12_381_G1_Element _) -> True
+  Some (ValueOf DefaultUniBLS12_381_G2_Element _) -> True
+  Some (ValueOf DefaultUniBLS12_381_MlResult _) -> True
+  _ -> False
+
+{- Note [Unserializable constants]
+Generally we require that programs are (de-)serializable, which requires that all constants
+in the program are (de-)serializable. This is enforced by the type system, we have to
+have instances for all builtin types in the universe.
+
+However, in practice we have to limit this somewhat. In particular, some builtin types
+have no _cheap_ (de-)serialization method. This notably applies to the BLS constants, where
+both BLS "deserialization" and "uncompression" do some sanity checks that take a non-trivial
+amount of time.
+
+This is a problem: in our time budgeting for validating transactions we generally assume
+that deserialization is proportional to input size with low constant factors. But for a
+malicious program made up of only BLS points, this would not be true!
+
+So pragmatically we disallow (de-)serialization of constants of such types (the instances
+still exist, but they will fail at runtime). The problem then is that we need to make
+sure that we don't accidentally create any such constants. It's one thing if the _user_
+does it - then we can just tell them not to (there are usually workarounds). But the
+compiler should also not do it! Notably, the EvaluateBuiltins pass can produce _new_
+constants.
+
+To deal with this problem we pass around a predicate that tells us which constants are
+bad, so we can just refuse to perform a transformation if it would produce unrepresentable
+constants.
+
+An alternative approach would be to instead add a pass to rewrite the problematic
+constants into a non-problematic form (e.g. conversion from a bytestring instead of a constant).
+This would be better for optimization, since we wouldn't be blocking EvaluateBuiltins
+from working, even if it was good, but it has two problems:
+1. It would fight with EvaluateBuiltins, which each undoing the other.
+2. It can't work generically, since we don't always have a way to do the transformation. In
+particular, there isn't a way to do this for the ML-result BLS type.
+-}

plutus-core/plutus-ir/src/PlutusIR/Core/Plated.hs

@@ -28,6 +28,7 @@ module PlutusIR.Core.Plated
     , termUniquesDeep
     , varDeclSubtypes
     , underBinders
+    , _Constant
     ) where
 
 import PlutusCore qualified as PLC
@@ -49,6 +50,10 @@ infixr 6 <^>
 (<^>) :: Fold s a -> Fold s a -> Fold s a
 (f1 <^> f2) g s = f1 g s *> f2 g s
 
+-- | View a term as a constant.
+_Constant :: Prism' (Term tyname name uni fun a) (a, PLC.Some (PLC.ValueOf uni))
+_Constant = prism' (uncurry Constant) (\case { Constant a v -> Just (a, v); _ -> Nothing })
+
 {-# INLINE bindingSubterms #-}
 -- | Get all the direct child 'Term's of the given 'Binding'.
 bindingSubterms :: Traversal' (Binding tyname name uni fun a) (Term tyname name uni fun a)

plutus-core/plutus-ir/src/PlutusIR/Transform/EvaluateBuiltins.hs

@@ -68,6 +68,7 @@ evaluateBuiltins conservative binfo costModel = transformOf termSubterms process
            -- suboptimal, e.g. in `ifThenElse True x y`, we will get back `x`, but
            -- with the annotation that was on the `ifThenElse` node. But we can't
            -- easily do better.
-           Just t' -> x <$ t'
-           Nothing -> t
+           -- See Note [Unserializable constants]
+           Just t' | termIsSerializable binfo t' -> x <$ t'
+           _                                     -> t
     processTerm t = t

plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/Tests.hs

@@ -15,15 +15,27 @@ import Test.QuickCheck.Property (Property, withMaxSuccess)
 test_evaluateBuiltins :: TestTree
 test_evaluateBuiltins = runTestNestedIn ["plutus-ir", "test", "PlutusIR", "Transform"] $
     testNested "EvaluateBuiltins" $
+      conservative ++ nonConservative
+    where
+      conservative =
         map
             (goldenPir (evaluateBuiltins True def def) pTerm)
             [ "addInteger"
             , "ifThenElse"
-            , "trace"
+            , "traceConservative"
             , "failingBuiltin"
             , "nonConstantArg"
             , "overApplication"
             , "underApplication"
+            , "uncompressBlsConservative"
+            ]
+      nonConservative =
+        map
+            (goldenPir (evaluateBuiltins False def def) pTerm)
+            -- We want to test the case where this would reduce, i.e.
+            [ "traceNonConservative"
+            , "uncompressBlsNonConservative"
+            , "uncompressAndEqualBlsNonConservative"
             ]
 
 -- | Check that a term typechecks after a `PlutusIR.Transform.EvaluateBuiltins`

plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/traceNonConservative

@@ -0,0 +1,2 @@
+-- In non-conservative mode should be removed
+[{(builtin trace) (con integer) } (con string "hello") (con integer 1)]

plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/traceNonConservative.golden

@@ -0,0 +1 @@
+(con integer 1)

plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/uncompressAndEqualBlsNonConservative

@@ -0,0 +1,7 @@
+-- This would evaluate all the way to a boolean constant (which is serializable!) but we block the intermediate states
+-- (which have unserializable constants), so we can't get there.
+[
+  (builtin bls12_381_G1_equal)
+  [(builtin bls12_381_G1_uncompress) (con bytestring #97f1d3a73197d7942695638c4fa9ac0fc3688c4f9774b905a14e3a3f171bac586c55e83ff97a1aeffb3af00adb22c6bb)]
+  [(builtin bls12_381_G1_uncompress) (con bytestring #97f1d3a73197d7942695638c4fa9ac0fc3688c4f9774b905a14e3a3f171bac586c55e83ff97a1aeffb3af00adb22c6bb)]
+]

plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/uncompressAndEqualBlsNonConservative.golden

@@ -0,0 +1,19 @@
+[
+  [
+    (builtin bls12_381_G1_equal)
+    [
+      (builtin bls12_381_G1_uncompress)
+      (con
+        bytestring
+        #97f1d3a73197d7942695638c4fa9ac0fc3688c4f9774b905a14e3a3f171bac586c55e83ff97a1aeffb3af00adb22c6bb
+      )
+    ]
+  ]
+  [
+    (builtin bls12_381_G1_uncompress)
+    (con
+      bytestring
+      #97f1d3a73197d7942695638c4fa9ac0fc3688c4f9774b905a14e3a3f171bac586c55e83ff97a1aeffb3af00adb22c6bb
+    )
+  ]
+]

plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/uncompressBlsConservative

@@ -0,0 +1,8 @@
+-- In conservative mode should be left
+[
+  (builtin bls12_381_G2_uncompress)
+  (con
+    bytestring
+    #c00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
+  )
+]

plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/uncompressBlsConservative.golden

@@ -0,0 +1,7 @@
+[
+  (builtin bls12_381_G2_uncompress)
+  (con
+    bytestring
+    #c00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
+  )
+]

plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/uncompressBlsNonConservative

@@ -0,0 +1,8 @@
+-- Should also be left in non-conservative mode because the result is unrepresentable
+[
+  (builtin bls12_381_G2_uncompress)
+  (con
+    bytestring
+    #c00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
+  )
+]

plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/uncompressBlsNonConservative.golden

@@ -0,0 +1,7 @@
+[
+  (builtin bls12_381_G2_uncompress)
+  (con
+    bytestring
+    #c00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
+  )
+]