Alpha: consume (de)serialization gas for big maps in context

src/proto_alpha/lib_protocol/src/alpha_context.mli

@@ -129,6 +129,7 @@ module Gas : sig
   val step_cost : int -> cost
   val alloc_cost : int -> cost
   val alloc_bytes_cost : int -> cost
+  val alloc_mbytes_cost : int -> cost
   val alloc_bits_cost : int -> cost
   val read_bytes_cost : Z.t -> cost
   val write_bytes_cost : Z.t -> cost

src/proto_alpha/lib_protocol/src/gas_limit_repr.ml

@@ -165,6 +165,9 @@ let ( *@ ) x y =
     bytes_read = Z.mul (Z.of_int x) y.bytes_read ;
     bytes_written = Z.mul (Z.of_int x) y.bytes_written }
 
+let alloc_mbytes_cost n =
+  alloc_cost 12 +@ alloc_bytes_cost n
+
 let () =
   let open Data_encoding in
   register_error_kind

src/proto_alpha/lib_protocol/src/gas_limit_repr.mli

@@ -29,6 +29,7 @@ val free : cost
 val step_cost : int -> cost
 val alloc_cost : int -> cost
 val alloc_bytes_cost : int -> cost
+val alloc_mbytes_cost : int -> cost
 val alloc_bits_cost : int -> cost
 val read_bytes_cost : Z.t -> cost
 val write_bytes_cost : Z.t -> cost

src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml

@@ -32,7 +32,7 @@ module Cost_of = struct
     alloc_bytes_cost length
 
   let bytes length =
-    alloc_cost 12 +@ alloc_bytes_cost length
+    alloc_mbytes_cost length
 
   let concat s1 s2 =
     string (String.length s1 + String.length s2)

src/proto_alpha/lib_protocol/src/script_repr.ml

@@ -135,7 +135,7 @@ let deserialized_cost expr =
 
 let serialized_cost bytes =
   let open Gas_limit_repr in
-  alloc_cost 12 +@ alloc_bytes_cost (MBytes.length bytes)
+  alloc_mbytes_cost (MBytes.length bytes)
 
 let force_decode lexpr =
   match Data_encoding.force_decode lexpr with

src/proto_alpha/lib_protocol/src/storage.ml

@@ -143,6 +143,8 @@ module Contract = struct
       (struct let name = ["counter"] end)
       (Z)
 
+  (* Consume gas for serilization and deserialization of expr in this
+     module *)
   module Make_carbonated_map_expr (N : Storage_sigs.NAME) = struct
     module I = Indexed_context.Make_carbonated_map
         (N)
@@ -213,16 +215,48 @@ module Contract = struct
 
   type bigmap_key = Raw_context.t * Contract_repr.t
 
-  module Big_map =
-    Storage_functors.Make_indexed_carbonated_data_storage
-      (Make_subcontext
-         (Indexed_context.Raw_context)
-         (struct let name = ["big_map"] end))
-      (Make_index(Script_expr_hash))
-      (struct
-        type t = Script_repr.expr
-        let encoding = Script_repr.expr_encoding
-      end)
+  (* Consume gas for serilization and deserialization of expr in this
+     module *)
+  module Big_map = struct
+    module I = Storage_functors.Make_indexed_carbonated_data_storage
+        (Make_subcontext
+           (Indexed_context.Raw_context)
+           (struct let name = ["big_map"] end))
+        (Make_index(Script_expr_hash))
+        (struct
+          type t = Script_repr.expr
+          let encoding = Script_repr.expr_encoding
+        end)
+
+    type context = I.context
+    type key = I.key
+    type value = I.value
+
+    let mem = I.mem
+    let delete = I.delete
+    let remove = I.remove
+    let set = I.set
+    let set_option = I.set_option
+    let init = I.init
+    let init_set = I.init_set
+
+    let consume_deserialize_gas ctxt value =
+      Lwt.return @@
+      Raw_context.consume_gas ctxt (Script_repr.deserialized_cost value)
+
+    let get ctxt contract =
+      I.get ctxt contract >>=? fun (ctxt, value) ->
+      consume_deserialize_gas ctxt value >>|? fun ctxt ->
+      (ctxt, value)
+
+    let get_option ctxt contract =
+      I.get_option ctxt contract >>=? fun (ctxt, value_opt) ->
+      match value_opt with
+      | None -> return (ctxt, None)
+      | Some value ->
+          consume_deserialize_gas ctxt value >>|? fun ctxt ->
+          (ctxt, value_opt)
+  end
 
   module Paid_storage_space =
     Indexed_context.Make_map

src/proto_alpha/lib_protocol/src/storage_functors.ml

@@ -327,9 +327,10 @@ module Make_indexed_carbonated_data_storage
     get c (len_name i) >>=? fun len ->
     decode_len_value (len_name i) len >>=? fun len ->
     Lwt.return (C.consume_gas c (Gas_limit_repr.read_bytes_cost (Z.of_int len)))
-  let consume_write_gas set c i v =
+  let consume_serialize_write_gas set c i v =
     let bytes = to_bytes v in
     let len = MBytes.length bytes in
+    Lwt.return (C.consume_gas c (Gas_limit_repr.alloc_mbytes_cost len)) >>=? fun c ->
     Lwt.return (C.consume_gas c (Gas_limit_repr.write_bytes_cost (Z.of_int len))) >>=? fun c ->
     set c (len_name i) (encode_len_value bytes) >>=? fun c ->
     return (c, bytes)
@@ -356,19 +357,19 @@ module Make_indexed_carbonated_data_storage
       return (C.project s, None)
   let set s i v =
     existing_size s i >>=? fun prev_size ->
-    consume_write_gas C.set s i v >>=? fun (s, bytes) ->
+    consume_serialize_write_gas C.set s i v >>=? fun (s, bytes) ->
     C.set s (name i) bytes >>=? fun t ->
     let size_diff = MBytes.length bytes - prev_size in
     return (C.project t, size_diff)
   let init s i v =
-    consume_write_gas C.init s i v >>=? fun (s, bytes) ->
+    consume_serialize_write_gas C.init s i v >>=? fun (s, bytes) ->
     C.init s (name i) bytes >>=? fun t ->
     let size = MBytes.length bytes in
     return (C.project t, size)
   let init_set s i v =
     let init_set s i v = C.init_set s i v >>= return in
     existing_size s i >>=? fun prev_size ->
-    consume_write_gas init_set s i v >>=? fun (s, bytes) ->
+    consume_serialize_write_gas init_set s i v >>=? fun (s, bytes) ->
     init_set s (name i) bytes >>=? fun t ->
     let size_diff = MBytes.length bytes - prev_size in
     return (C.project t, size_diff)

src/proto_alpha/lib_protocol/src/storage_sigs.ml

@@ -213,18 +213,21 @@ module type Non_iterable_indexed_carbonated_data_storage = sig
 
   (** Updates the content of a bucket ; returns A {!Storage_Error
       Missing_key} if the value does not exists.
+      Consumes serialization cost.
       Consumes [Gas_repr.write_bytes_cost <size of the new value>].
       Returns the difference from the old to the new size. *)
   val set: context -> key -> value -> (Raw_context.t * int) tzresult Lwt.t
 
   (** Allocates a storage bucket at the given key and initializes it ;
       returns a {!Storage_error Existing_key} if the bucket exists.
+      Consumes serialization cost.
       Consumes [Gas_repr.write_bytes_cost <size of the value>].
       Returns the size. *)
   val init: context -> key -> value -> (Raw_context.t * int) tzresult Lwt.t
 
   (** Allocates a storage bucket at the given key and initializes it
       with a value ; just updates it if the bucket exists.
+      Consumes serialization cost.
       Consumes [Gas_repr.write_bytes_cost <size of the new value>].
       Returns the difference from the old (maybe 0) to the new size. *)
   val init_set: context -> key -> value -> (Raw_context.t * int) tzresult Lwt.t
@@ -233,6 +236,7 @@ module type Non_iterable_indexed_carbonated_data_storage = sig
       it with [v] ; just updates it if the bucket exists. When the
       valus is [None], delete the storage bucket when the value ; does
       nothing if the bucket does not exists.
+      Consumes serialization cost.
       Consumes the same gas cost as either {!remove} or {!init_set}.
       Returns the difference from the old (maybe 0) to the new size. *)
   val set_option: context -> key -> value option -> (Raw_context.t * int) tzresult Lwt.t