SCP-2417: Add builtin serialiseData

cost-model stubs for serialiseData added plugin golden tests
IntersectMBO · Mar 4, 2022 · 6f9a294 · 6f9a294
1 parent 024573e
commit 6f9a294
Show file tree

Hide file tree

Showing 20 changed files with 99 additions and 5 deletions.
diff --git a/doc/reference/builtin-parameters.csv b/doc/reference/builtin-parameters.csv
@@ -35,7 +35,7 @@ decodeUtf8,decodeUtf8-memory-arguments-slope,Linear model coefficient for the me
 divideInteger,divideInteger-cpu-arguments-constant,Constant CPU cost (argument sizes above diagonal)
 divideInteger,divideInteger-cpu-arguments-model-arguments-intercept,Linear model intercept for the CPU calculation (argument sizes on or below diagonal)
 divideInteger,divideInteger-cpu-arguments-model-arguments-slope,Linear model coefficient for the CPU calculation (argument sizes on or below diagonal)
-divideInteger,divideInteger-memory-arguments-intercept,Linear model intercept for the memory calculation (argument sizes on or below diagonal) 
+divideInteger,divideInteger-memory-arguments-intercept,Linear model intercept for the memory calculation (argument sizes on or below diagonal)
 divideInteger,divideInteger-memory-arguments-minimum,Constant memory cost (argument sizes above diagonal)
 divideInteger,divideInteger-memory-arguments-slope,Linear model coefficient for the memory calculation (argument sizes on or below diagonal)
 encodeUtf8,encodeUtf8-cpu-arguments-intercept,Linear model intercept for the CPU calculation below diagonal
@@ -98,7 +98,7 @@ modInteger,modInteger-cpu-arguments-model-arguments-slope,Linear model coefficie
 modInteger,modInteger-memory-arguments-intercept,Linear model intercept for the memory calculation
 modInteger,modInteger-memory-arguments-minimum,Constant memory cost (argument sizes above diagonal)
 modInteger,modInteger-memory-arguments-slope,Linear model coefficient for the memory calculation (argument sizes on or below diagonal)
-multiplyInteger,multiplyInteger-cpu-arguments-intercept,Linear model intercept for the CPU calculation 
+multiplyInteger,multiplyInteger-cpu-arguments-intercept,Linear model intercept for the CPU calculation
 multiplyInteger,multiplyInteger-cpu-arguments-slope,Linear model coefficient for the CPU calculation
 multiplyInteger,multiplyInteger-memory-arguments-intercept,Linear model intercept for the memory calculation
 multiplyInteger,multiplyInteger-memory-arguments-slope,Linear model coefficient for the memory calculation
@@ -116,6 +116,10 @@ remainderInteger,remainderInteger-cpu-arguments-model-arguments-slope,Linear mod
 remainderInteger,remainderInteger-memory-arguments-intercept,Linear model intercept for the memory calculation (argument sizes on or below diagonal)
 remainderInteger,remainderInteger-memory-arguments-minimum,Constant memory cost (argument sizes above diagonal)
 remainderInteger,remainderInteger-memory-arguments-slope,Linear model coefficient for the memory calculation (argument sizes on or below diagonal)
+serialiseData,serialiseData-cpu-arguments-intercept,TODO
+serialiseData,serialiseData-cpu-arguments-slope,TODO
+serialiseData,serialiseData-memory-arguments-intercept,TODO
+serialiseData,serialiseData-memory-arguments-slope,TODO
 sha2_256,sha2_256-cpu-arguments-intercept,Linear model intercept for the CPU calculation
 sha2_256,sha2_256-cpu-arguments-slope,Linear model coefficient for the CPU calculation
 sha2_256,sha2_256-memory-arguments,Constant memory cost

diff --git a/plutus-core/cost-model/budgeting-bench/Benchmarks/Data.hs b/plutus-core/cost-model/budgeting-bench/Benchmarks/Data.hs
@@ -126,6 +126,10 @@ benchEqualsData =
         where args1 = dataSampleForEq -- 400 elements: should take about 35 minutes to benchmark
               args2 = fmap copyData args1
 
+benchSerialiseData :: Benchmark
+benchSerialiseData =
+    createOneTermBuiltinBench SerialiseData [] args
+        where args = dataSampleForEq -- FIXME: is this a good sample for serialization?
 
 makeBenchmarks :: StdGen -> [Benchmark]
 makeBenchmarks gen =
@@ -141,4 +145,5 @@ makeBenchmarks gen =
     , benchUnIData
     , benchUnBData
     , benchEqualsData
+    , benchSerialiseData
     ]
diff --git a/plutus-core/cost-model/create-cost-model/CostModelCreation.hs b/plutus-core/cost-model/create-cost-model/CostModelCreation.hs
@@ -95,6 +95,7 @@ builtinCostModelNames = BuiltinCostModelBase
   , paramMkPairData               = "mkPairDataModel"
   , paramMkNilData                = "mkNilDataModel"
   , paramMkNilPairData            = "mkNilPairDataModel"
+  , paramSerialiseData            = "serialiseDataModel"
   }
 
 
@@ -175,6 +176,7 @@ createBuiltinCostModel =
     paramUnIData                  <- getParams unIData        paramUnIData
     paramUnBData                  <- getParams unBData        paramUnBData
     paramEqualsData               <- getParams equalsData     paramEqualsData
+    paramSerialiseData            <- getParams serialiseData  paramSerialiseData
     -- Misc constructors
     paramMkPairData               <- getParams mkPairData     paramMkPairData
     paramMkNilData                <- getParams mkNilData      paramMkNilData
@@ -676,6 +678,12 @@ equalsData cpuModelR = do
      worst case it may have to examine almost all of the smaller argument before
      realising that the two arguments are different. -}
 
+serialiseData :: MonadR m => (SomeSEXP (Region m)) -> m (CostingFun ModelOneArgument)
+serialiseData cpuModelR = do
+  cpuModel <- ModelOneArgumentLinearCost <$> readModelLinearInX cpuModelR
+  let memModel = ModelOneArgumentLinearCost $ ModelLinearSize 0 0
+  pure $ CostingFun cpuModel memModel
+
 ---------------- Misc constructors ----------------
 
 mkPairData :: MonadR m => (SomeSEXP (Region m)) -> m (CostingFun ModelTwoArguments)

diff --git a/plutus-core/cost-model/data/builtinCostModel.json b/plutus-core/cost-model/data/builtinCostModel.json
@@ -389,6 +389,22 @@
             "type": "constant_cost"
         }
     },
+    "serialiseData": {
+        "memory": {
+            "arguments": {
+                "slope": 0,
+                "intercept": 0
+            },
+            "type": "linear_cost"
+        },
+        "cpu": {
+            "arguments": {
+                "slope": 0,
+                "intercept": 0
+            },
+            "type": "linear_cost"
+        }
+    },
     "addInteger": {
         "memory": {
             "arguments": {

diff --git a/plutus-core/cost-model/data/models.R b/plutus-core/cost-model/data/models.R
@@ -77,6 +77,7 @@ arity <- function(name) {
         "AppendString" = 2,
         "EqualsString" = 2,
         "EncodeUtf8" = 1,
+        "SerialiseData" = 1,
         "DecodeUtf8" = 1,
         "IfThenElse" = 3,
         "ChooseUnit" = 2,
@@ -550,6 +551,12 @@ modelFun <- function(path) {
         adjustModel(m2,fname)
     }
 
+    serialiseDataModel <- {
+        fname <- "SerialiseData"
+        #FIXME
+    }
+
+
     mkPairDataModel     <- constantModel ("MkPairData")
     mkNilDataModel      <- constantModel ("MkNilData")
     mkNilPairDataModel  <- constantModel ("MkNilPairData")
@@ -605,6 +612,7 @@ modelFun <- function(path) {
         equalsDataModel               = equalsDataModel,
         mkPairDataModel               = mkPairDataModel,
         mkNilDataModel                = mkNilDataModel,
-        mkNilPairDataModel            = mkNilPairDataModel
+        mkNilPairDataModel            = mkNilPairDataModel,
+        serialiseDataModel            = serialiseDataModel
     )
 }
diff --git a/plutus-core/cost-model/test/TestCostModels.hs b/plutus-core/cost-model/test/TestCostModels.hs
@@ -345,6 +345,7 @@ main =
                     , $(genTest 1 "unIData")
                     , $(genTest 1 "unBData")
                     , $(genTest 2 "equalsData") Everywhere
+                    , $(genTest 1 "serialiseData")
 
                     -- Misc constructors
                     , $(genTest 2 "mkPairData") Everywhere

diff --git a/plutus-core/plutus-core/src/PlutusCore/Default/Builtins.hs b/plutus-core/plutus-core/src/PlutusCore/Default/Builtins.hs
@@ -23,9 +23,11 @@ import PlutusCore.Evaluation.Machine.ExMemory
 import PlutusCore.Evaluation.Result
 import PlutusCore.Pretty
 
+import Codec.Serialise (serialise)
 import Crypto (verifySignature)
 import Data.ByteString qualified as BS
 import Data.ByteString.Hash qualified as Hash
+import Data.ByteString.Lazy qualified as BS (toStrict)
 import Data.Char
 import Data.Ix
 import Data.Text (Text)
@@ -99,6 +101,7 @@ data DefaultFun
     | UnIData
     | UnBData
     | EqualsData
+    | SerialiseData
     -- Misc constructors
     -- Constructors that we need for constructing e.g. Data. Polymorphic builtin
     -- constructors are often problematic (See note [Representable built-in
@@ -775,6 +778,10 @@ instance uni ~ DefaultUni => ToBuiltinMeaning uni DefaultFun where
         makeBuiltinMeaning
             ((==) @Data)
             (runCostingFunTwoArguments . paramEqualsData)
+    toBuiltinMeaning SerialiseData =
+        makeBuiltinMeaning
+            (BS.toStrict . serialise @Data)
+            (runCostingFunOneArgument . paramSerialiseData)
     -- Misc constructors
     toBuiltinMeaning MkPairData =
         makeBuiltinMeaning
@@ -868,6 +875,7 @@ instance Flat DefaultFun where
               MkPairData               -> 48
               MkNilData                -> 49
               MkNilPairData            -> 50
+              SerialiseData            -> 51
 
     decode = go =<< decodeBuiltin
         where go 0  = pure AddInteger
@@ -921,6 +929,7 @@ instance Flat DefaultFun where
               go 48 = pure MkPairData
               go 49 = pure MkNilData
               go 50 = pure MkNilPairData
+              go 51 = pure SerialiseData
               go t  = fail $ "Failed to decode builtin tag, got: " ++ show t
 
     size _ n = n + builtinTagWidth
diff --git a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/BuiltinCostModel.hs b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/BuiltinCostModel.hs
@@ -153,6 +153,7 @@ data BuiltinCostModelBase f =
     , paramMkPairData               :: f ModelTwoArguments
     , paramMkNilData                :: f ModelOneArgument
     , paramMkNilPairData            :: f ModelOneArgument
+    , paramSerialiseData            :: f ModelOneArgument
     }
     deriving (Generic, FunctorB, TraversableB, ConstraintsB)
 

diff --git a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExBudgetingDefaults.hs b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExBudgetingDefaults.hs
@@ -163,4 +163,5 @@ unitCostBuiltinCostModel = BuiltinCostModelBase
     , paramMkPairData               = unitCostTwoArguments
     , paramMkNilData                = unitCostOneArgument
     , paramMkNilPairData            = unitCostOneArgument
+    , paramSerialiseData            = unitCostOneArgument
     }
diff --git a/plutus-core/plutus-core/src/PlutusCore/Parser/ParserCommon.hs b/plutus-core/plutus-core/src/PlutusCore/Parser/ParserCommon.hs
@@ -202,6 +202,7 @@ builtinFnList =
     , (UnIData,"unIData")
     , (UnBData,"unBData")
     , (EqualsData,"equalsData")
+    , (SerialiseData,"serialiseData")
     , (MkPairData,"mkPairData")
     , (MkNilData,"mkNilData")
     , (MkNilPairData,"mkNilPairData")

diff --git a/plutus-core/plutus-core/test/CostModelInterface/defaultCostModelParams.json b/plutus-core/plutus-core/test/CostModelInterface/defaultCostModelParams.json
@@ -132,6 +132,10 @@
   "remainderInteger-memory-arguments-intercept": 0,
   "remainderInteger-memory-arguments-minimum": 1,
   "remainderInteger-memory-arguments-slope": 1,
+  "serialiseData-cpu-arguments-intercept": 0,
+  "serialiseData-cpu-arguments-slope": 0,
+  "serialiseData-memory-arguments-intercept": 0,
+  "serialiseData-memory-arguments-slope": 0,
   "sha2_256-cpu-arguments-intercept": 2477736,
   "sha2_256-cpu-arguments-slope": 29175,
   "sha2_256-memory-arguments": 4,

diff --git a/plutus-core/plutus-core/test/TypeSynthesis/Golden/SerialiseData.plc.golden b/plutus-core/plutus-core/test/TypeSynthesis/Golden/SerialiseData.plc.golden
@@ -0,0 +1 @@
+(fun (con data) (con bytestring))
diff --git a/plutus-core/testlib/PlutusCore/Generators/NEAT/Term.hs b/plutus-core/testlib/PlutusCore/Generators/NEAT/Term.hs
@@ -423,7 +423,7 @@ defaultFunTypes = Map.fromList [(TyFunG (TyBuiltinG TyIntegerG) (TyFunG (TyBuilt
                   ,(TyFunG (TyBuiltinG TyDataG) (TyBuiltinG TyIntegerG)
                   ,[UnIData])
                   ,(TyFunG (TyBuiltinG TyDataG) (TyBuiltinG TyByteStringG)
-                  ,[UnBData])
+                  ,[UnBData, SerialiseData])
                   ]
 
 instance Ord tyname => Check (TypeG tyname) DefaultFun where

diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Definition.hs b/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Definition.hs
@@ -477,6 +477,7 @@ test_Data = testCase "Data" $ do
     evals @[(Data, Data)] [(B "", I 3)] UnMapData [cons $ Map [(B "", I 3)]]
     evals @[Data] [] UnListData [cons $ List []]
     evals @[Data] [I 3, I 4, B ""] UnListData [cons $ List [I 3, I 4, B ""]]
+    evals @ByteString "\162\ETX@Ehello8c" SerialiseData [cons $ Map [(I 3, B ""), (B "hello", I $ -100)]]
 
     -- ChooseData
     let actualExp = mkIterApp ()
@@ -539,7 +540,6 @@ test_Crypto = testCase "Crypto" $ do
     evals @ByteString "%l\131\178\151\DC1M \ESC0\ETB\159?\SO\240\202\206\151\131b-\165\151C&\180\&6\ETB\138\238\246\DLE"
         Blake2b_256 [cons @ByteString "hello world"]
 
-
 -- Test all remaining builtins of the default universe
 test_Other :: TestTree
 test_Other = testCase "Other" $ do

diff --git a/plutus-tx-plugin/src/PlutusTx/Compiler/Builtins.hs b/plutus-tx-plugin/src/PlutusTx/Compiler/Builtins.hs
@@ -223,6 +223,7 @@ builtinNames = [
     , ''Builtins.BuiltinData
     , 'Builtins.chooseData
     , 'Builtins.equalsData
+    , 'Builtins.serialiseData
     , 'Builtins.mkConstr
     , 'Builtins.mkMap
     , 'Builtins.mkList
@@ -351,6 +352,7 @@ defineBuiltinTerms = do
     defineBuiltinTerm 'Builtins.unsafeDataAsList $ mkBuiltin PLC.UnListData
     defineBuiltinTerm 'Builtins.unsafeDataAsB $ mkBuiltin PLC.UnBData
     defineBuiltinTerm 'Builtins.unsafeDataAsI $ mkBuiltin PLC.UnIData
+    defineBuiltinTerm 'Builtins.serialiseData $ mkBuiltin PLC.SerialiseData
 
 defineBuiltinTypes
     :: CompilingDefault uni fun m

diff --git a/plutus-tx-plugin/test/Plugin/Primitives/Spec.hs b/plutus-tx-plugin/test/Plugin/Primitives/Spec.hs
@@ -59,6 +59,8 @@ primitives = testNested "Primitives" [
   , goldenPir "stringLiteral" stringLiteral
   , goldenUEval "equalsString" [ getPlc stringEquals, liftProgram ("hello" :: Builtins.BuiltinString), liftProgram ("hello" :: Builtins.BuiltinString)]
   , goldenPir "encodeUtf8" stringEncode
+  , goldenPir "serialiseData" dataEncode
+  , goldenUEval "serialiseDataApply" [ toUPlc dataEncode, toUPlc constructData1 ]
   , goldenUEval "constructData1" [ constructData1 ]
   -- It's interesting to look at one of these to make sure all the specialisation is working out nicely and for
   -- debugging when it isn't
@@ -162,6 +164,9 @@ stringEquals = plc (Proxy @"string32Equals") (\(x :: Builtins.BuiltinString) (y
 stringEncode :: CompiledCode (Builtins.BuiltinByteString)
 stringEncode = plc (Proxy @"stringEncode") (Builtins.encodeUtf8 "abc")
 
+dataEncode :: CompiledCode (Builtins.BuiltinData -> Builtins.BuiltinByteString)
+dataEncode = plc (Proxy @"dataEncode") Builtins.serialiseData
+
 constructData1 :: CompiledCode (Builtins.BuiltinData)
 constructData1 = plc (Proxy @"constructData1") (Builtins.mkI 1)
 

diff --git a/plutus-tx-plugin/test/Plugin/Primitives/serialiseData.plc.golden b/plutus-tx-plugin/test/Plugin/Primitives/serialiseData.plc.golden
@@ -0,0 +1,16 @@
+(program
+  (let
+    (nonrec)
+    (termbind
+      (strict)
+      (vardecl serialiseData (fun (con data) (con bytestring)))
+      (builtin serialiseData)
+    )
+    (termbind
+      (nonstrict)
+      (vardecl serialiseData (fun (con data) (con bytestring)))
+      serialiseData
+    )
+    serialiseData
+  )
+)
diff --git a/plutus-tx-plugin/test/Plugin/Primitives/serialiseDataApply.plc.golden b/plutus-tx-plugin/test/Plugin/Primitives/serialiseDataApply.plc.golden
@@ -0,0 +1 @@
+(con bytestring #01)
diff --git a/plutus-tx/src/PlutusTx/Builtins.hs b/plutus-tx/src/PlutusTx/Builtins.hs
@@ -43,6 +43,7 @@ module PlutusTx.Builtins (
                                 , matchData
                                 , matchData'
                                 , equalsData
+                                , serialiseData
                                 , mkConstr
                                 , mkMap
                                 , mkList
@@ -262,6 +263,11 @@ matchList l nilCase consCase = BI.chooseList l (const nilCase) (\_ -> consCase (
 chooseData :: forall a . BuiltinData -> a -> a -> a -> a -> a -> a
 chooseData = BI.chooseData
 
+{-# INLINABLE serialiseData #-}
+-- | Convert a String into a ByteString.
+serialiseData :: BuiltinData -> BuiltinByteString
+serialiseData = BI.serialiseData
+
 {-# INLINABLE mkConstr #-}
 -- | Constructs a 'BuiltinData' value with the @Constr@ constructor.
 mkConstr :: Integer -> [BuiltinData] -> BuiltinData

diff --git a/plutus-tx/src/PlutusTx/Builtins/Internal.hs b/plutus-tx/src/PlutusTx/Builtins/Internal.hs
@@ -18,6 +18,7 @@ import Crypto qualified
 import Data.ByteArray qualified as BA
 import Data.ByteString as BS
 import Data.ByteString.Hash qualified as Hash
+import Data.ByteString.Lazy as BS (toStrict)
 import Data.Coerce (coerce)
 import Data.Hashable (Hashable (..))
 import Data.Maybe (fromMaybe)
@@ -458,3 +459,7 @@ unsafeDataAsB _                       = Haskell.error "not a B"
 {-# NOINLINE equalsData #-}
 equalsData :: BuiltinData -> BuiltinData -> BuiltinBool
 equalsData (BuiltinData b1) (BuiltinData b2) = BuiltinBool $ b1 Haskell.== b2
+
+{-# NOINLINE serialiseData #-}
+serialiseData :: BuiltinData -> BuiltinByteString
+serialiseData (BuiltinData b) = BuiltinByteString $ BS.toStrict $ serialise b