Alpha: cost of deserialization

src/proto_alpha/lib_protocol/src/alpha_context.mli

@@ -286,8 +286,6 @@ module Script : sig
 
   type lazy_expr = expr Data_encoding.lazy_t
 
-  val force_decode : lazy_expr -> expr tzresult
-  val force_bytes : lazy_expr -> MBytes.t tzresult
   val lazy_expr : expr -> lazy_expr
 
   type node = (location, prim) Micheline.node
@@ -301,7 +299,12 @@ module Script : sig
   val prim_encoding: prim Data_encoding.t
   val encoding: t Data_encoding.t
   val lazy_expr_encoding: lazy_expr Data_encoding.t
-  val expr_cost : expr -> Gas.cost
+  val deserialized_cost : expr -> Gas.cost
+  val serialized_cost : MBytes.t -> Gas.cost
+  val force_decode : lazy_expr -> (expr * Gas.cost) tzresult
+  val force_bytes : lazy_expr -> (MBytes.t * Gas.cost) tzresult
+  val minimal_deserialize_cost : lazy_expr -> Gas.cost
+  val minimal_serialize_cost : lazy_expr -> Gas.cost
 end
 
 module Constants : sig

src/proto_alpha/lib_protocol/src/apply.ml

@@ -359,15 +359,16 @@ let apply_manager_operation_content :
         match script with
         | None -> begin
             match parameters with
-            | None -> return_unit
+            | None -> return ctxt
             | Some arg ->
-                Lwt.return (Script.force_decode arg) >>=? fun arg ->
+                Lwt.return (Script.force_decode arg) >>=? fun (arg, cost_arg) ->
+                Lwt.return (Gas.consume ctxt cost_arg) >>=? fun ctxt ->
                 match Micheline.root arg with
                 | Prim (_, D_Unit, [], _) ->
                     (* Allow [Unit] parameter to non-scripted contracts. *)
-                    return_unit
+                    return ctxt
                 | _ -> fail (Script_interpreter.Bad_contract_parameter destination)
-          end >>=? fun () ->
+          end >>=? fun ctxt ->
             let result =
               Transaction_result
                 { storage = None ;
@@ -388,7 +389,8 @@ let apply_manager_operation_content :
                   let unit = Micheline.strip_locations (Prim (0, Script.D_Unit, [], [])) in
                   return (ctxt, unit)
               | Some parameters ->
-                  Lwt.return (Script.force_decode parameters) >>=? fun arg ->
+                  Lwt.return (Script.force_decode parameters) >>=? fun (arg, cost_arg) ->
+                  Lwt.return (Gas.consume ctxt cost_arg) >>=? fun ctxt ->
                   return (ctxt, arg)
             end >>=? fun (ctxt, parameter) ->
             Script_interpreter.execute
@@ -501,13 +503,27 @@ let precheck_manager_contents
     | Reveal pk ->
         Contract.reveal_manager_key ctxt source pk
     | Transaction { parameters = Some arg ; _ } ->
-        let min_gas = Michelson_v1_gas.Cost_of.Typechecking.minimal_deserialize arg in
         (* Fail if not enough gas for minimal deserialization cost *)
-        begin
+        begin match Gas.consume ctxt (Script.minimal_deserialize_cost arg) with
-          match Gas.consume ctxt min_gas with
           | Ok _ -> return ctxt
           | Error _ -> fail Not_enough_gas_minimal_deserialize
-        end
+        end >>=? fun ctxt ->
+        Lwt.return @@ Script.force_decode arg >>=? fun (_arg, cost_arg) ->
+        Lwt.return @@ Gas.consume ctxt cost_arg
+    | Origination { script = Some script ; _ } ->
+        (* Fail if not enough gas for minimal deserialization cost *)
+        begin
+          match
+            Gas.consume ctxt (Script.minimal_deserialize_cost script.code) >>? fun ctxt ->
+            Gas.consume ctxt (Script.minimal_deserialize_cost script.storage)
+          with
+          | Ok _ -> return ctxt
+          | Error _ -> fail Not_enough_gas_minimal_deserialize
+        end >>=? fun ctxt ->
+        Lwt.return @@ Script.force_decode script.code >>=? fun (_code, cost_code) ->
+        Lwt.return @@ Gas.consume ctxt cost_code >>=? fun ctxt ->
+        Lwt.return @@ Script.force_decode script.storage >>=? fun (_storage, cost_storage) ->
+        Lwt.return @@ Gas.consume ctxt cost_storage
     | _ -> return ctxt
   end >>=? fun ctxt ->
   Contract.get_manager_key ctxt source >>=? fun public_key ->

src/proto_alpha/lib_protocol/src/contract_services.ml

@@ -168,8 +168,9 @@ let register () =
           let ctxt = Gas.set_unlimited ctxt in
           let open Script_ir_translator in
           parse_script ctxt script >>=? fun (Ex_script script, ctxt) ->
-          unparse_script ctxt Readable script >>=? fun (script, _ctxt) ->
+          unparse_script ctxt Readable script >>=? fun (script, ctxt) ->
-          Lwt.return (Script.force_decode script.storage) >>=? fun storage ->
+          Lwt.return @@ Script.force_decode script.storage >>=? fun (storage, cost_storage) ->
+          Lwt.return @@ Gas.consume ctxt cost_storage >>=? fun _ctxt ->
           return_some storage) ;
   register_field S.info (fun ctxt contract ->
       Contract.get_balance ctxt contract >>=? fun balance ->

src/proto_alpha/lib_protocol/src/contract_storage.ml

@@ -339,7 +339,8 @@ let get_storage ctxt contract =
   Storage.Contract.Storage.get_option ctxt contract >>=? function
   | (ctxt, None) -> return (ctxt, None)
   | (ctxt, Some storage) ->
-      Lwt.return (Script_repr.force_decode storage) >>=? fun storage ->
+      Lwt.return (Script_repr.force_decode storage) >>=? fun (storage, cost) ->
+      Lwt.return (Raw_context.consume_gas ctxt cost) >>=? fun ctxt ->
       return (ctxt, Some storage)
 
 let get_counter c contract =

src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml

@@ -233,12 +233,6 @@ module Cost_of = struct
       (* TODO: proper handling of (de)serialization costs *)
       let len = MBytes.length b in
       alloc_cost len +@ step_cost (len * 10)
-    let minimal_deserialize expr =
-      Data_encoding.fold_lazy
-        Script.expr_cost
-        (fun b -> alloc_bytes_cost (MBytes.length b))
-        (fun c _ -> c) (* keep expr cost if present *)
-        expr
   end
 
   module Unparse = struct

src/proto_alpha/lib_protocol/src/michelson_v1_gas.mli

@@ -132,8 +132,6 @@ module Cost_of : sig
     val two_arg_type : Gas.cost
 
     val operation : MBytes.t -> Gas.cost
-
-    val minimal_deserialize : Script.lazy_expr -> Gas.cost
   end
 
   module Unparse : sig

src/proto_alpha/lib_protocol/src/script_interpreter.ml

@@ -749,7 +749,8 @@ and execute ?log ctxt mode ~source ~payer ~self script amount arg :
   trace
     (Bad_contract_parameter self)
     (parse_data ctxt arg_type arg) >>=? fun (arg, ctxt) ->
-  Lwt.return (Script.force_decode script.code) >>=? fun script_code ->
+  Lwt.return @@ Script.force_decode script.code >>=? fun (script_code, cost_script_code) ->
+  Lwt.return @@ Gas.consume ctxt cost_script_code >>=? fun ctxt ->
   trace
     (Runtime_contract_error (self, script_code))
     (interp ?log ctxt ~source ~payer ~self amount code (arg, storage))

src/proto_alpha/lib_protocol/src/script_ir_translator.ml

@@ -2550,7 +2550,8 @@ and parse_contract
                ok (ctxt, contract))
         | Some { code ; _ } ->
             Lwt.return
-              (Script.force_decode code >>? fun code ->
+              (Script.force_decode code >>? fun (code, cost_code) ->
+               Gas.consume ctxt cost_code >>? fun ctxt ->
                parse_toplevel code >>? fun (arg_type, _, _) ->
                parse_ty ~allow_big_map:false ~allow_operation:false arg_type >>? fun (Ex_ty targ) ->
                ty_eq targ arg >>? fun Eq ->
@@ -2606,8 +2607,10 @@ let parse_script
   : ?type_logger: type_logger ->
     context -> Script.t -> (ex_script * context) tzresult Lwt.t
   = fun ?type_logger ctxt { code ; storage } ->
-    Lwt.return @@ Script.force_decode code >>=? fun code ->
+    Lwt.return @@ Script.force_decode code >>=? fun (code, cost_code) ->
-    Lwt.return @@ Script.force_decode storage >>=? fun storage ->
+    Lwt.return @@ Gas.consume ctxt cost_code >>=? fun ctxt ->
+    Lwt.return @@ Script.force_decode storage >>=? fun (storage, cost_storage) ->
+    Lwt.return @@ Gas.consume ctxt cost_storage >>=? fun ctxt ->
     Lwt.return @@ parse_toplevel code >>=? fun (arg_type, storage_type, code_field) ->
     trace
       (Ill_formed_type (Some "parameter", code, location arg_type))
@@ -2932,8 +2935,10 @@ let extract_big_map : type a. a ty -> a -> ex_big_map option = fun ty x ->
   | _, _ -> None
 
 let erase_big_map_initialization ctxt mode ({ code ; storage } : Script.t) =
-  Lwt.return (Script.force_decode code) >>=? fun code ->
+  Lwt.return @@ Script.force_decode code >>=? fun (code, cost_code) ->
-  Lwt.return (Script.force_decode storage) >>=? fun storage ->
+  Lwt.return @@ Gas.consume ctxt cost_code >>=? fun ctxt ->
+  Lwt.return @@ Script.force_decode storage >>=? fun (storage, cost_storage) ->
+  Lwt.return @@ Gas.consume ctxt cost_storage >>=? fun ctxt ->
   Lwt.return @@ parse_toplevel code >>=? fun (_, storage_type, _) ->
   Lwt.return @@ parse_ty ~allow_big_map:true ~allow_operation:false storage_type >>=? fun (Ex_ty ty) ->
   parse_data ctxt ty

src/proto_alpha/lib_protocol/src/script_repr.ml

@@ -42,16 +42,6 @@ let lazy_expr_encoding =
 let lazy_expr expr =
   Data_encoding.make_lazy expr_encoding expr
 
-let force_decode expr =
-  match Data_encoding.force_decode expr with
-  | Some v -> ok v
-  | None -> error Lazy_script_decode
-
-let force_bytes expr =
-  match Data_encoding.force_bytes expr with
-  | bytes -> ok bytes
-  | exception _ -> error Lazy_script_decode
-
 type t = {
   code : lazy_expr ;
   storage : lazy_expr
@@ -95,6 +85,62 @@ let rec node_size node =
 let expr_size expr =
   node_size (Micheline.root expr)
 
-let expr_cost expr =
+let traversal_cost expr =
+  let blocks, _words = expr_size expr in
+  Gas_limit_repr.step_cost blocks
+
+let deserialized_cost expr =
+  let open Gas_limit_repr in
   let blocks, words = expr_size expr in
-  Gas_limit_repr.(((Compare.Int.max 0 (blocks - 1)) *@ alloc_cost 0) +@ alloc_cost words)
+  ((Compare.Int.max 0 (blocks - 1)) *@ alloc_cost 0) +@
+  alloc_cost words +@
+  step_cost blocks
+
+let serialized_cost bytes =
+  let open Gas_limit_repr in
+  alloc_bytes_cost (MBytes.length bytes)
+
+let force_decode lexpr =
+  match Data_encoding.force_decode lexpr with
+  | Some v ->
+      let deserialize_cost =
+        Data_encoding.fold_lazy
+          (fun _ -> Gas_limit_repr.free)
+          (fun _ -> deserialized_cost v)
+          (fun c_free _ -> c_free)
+          lexpr in
+      ok (v, deserialize_cost)
+  | None -> error Lazy_script_decode
+
+let force_bytes expr =
+  let open Gas_limit_repr in
+  match Data_encoding.force_bytes expr with
+  | bytes ->
+      let serialize_cost =
+        Data_encoding.fold_lazy
+          (fun v -> traversal_cost v +@ serialized_cost bytes)
+          (fun _ -> Gas_limit_repr.free)
+          (fun _ c_free -> c_free)
+          expr in
+      ok (bytes, serialize_cost)
+  | exception _ -> error Lazy_script_decode
+
+let minimal_deserialize_cost lexpr =
+  let open Gas_limit_repr in
+  Data_encoding.fold_lazy
+    (fun _ -> Gas_limit_repr.free)
+    (fun b -> alloc_bytes_cost (MBytes.length b))
+    (fun c_free _ -> c_free)
+    lexpr
+
+let minimal_serialize_cost lexpr =
+  let open Gas_limit_repr in
+  Data_encoding.fold_lazy
+    (fun v ->
+       let blocks, _words = expr_size v in
+       step_cost blocks +@
+       alloc_bytes_cost blocks (* TODO *)
+    )
+    (fun _ -> Gas_limit_repr.free)
+    (fun _ c_free -> c_free)
+    lexpr

src/proto_alpha/lib_protocol/src/script_repr.mli

@@ -17,10 +17,6 @@ type error += Lazy_script_decode (* `Permanent *)
 
 type lazy_expr = expr Data_encoding.lazy_t
 
-val force_decode : lazy_expr -> expr tzresult
-
-val force_bytes : lazy_expr -> MBytes.t tzresult
-
 type node = (location, Michelson_v1_primitives.prim) Micheline.node
 
 val location_encoding : location Data_encoding.t
@@ -35,4 +31,14 @@ type t = { code : lazy_expr ; storage : lazy_expr }
 
 val encoding : t Data_encoding.encoding
 
-val expr_cost : expr -> Gas_limit_repr.cost
+val deserialized_cost : expr -> Gas_limit_repr.cost
+
+val serialized_cost : MBytes.t -> Gas_limit_repr.cost
+
+val force_decode : lazy_expr -> (expr * Gas_limit_repr.cost) tzresult
+
+val force_bytes : lazy_expr -> (MBytes.t * Gas_limit_repr.cost) tzresult
+
+val minimal_deserialize_cost : lazy_expr -> Gas_limit_repr.cost
+
+val minimal_serialize_cost : lazy_expr -> Gas_limit_repr.cost