Alpha, Gas: consume gas for storage serialization and deserialization

src/proto_alpha/lib_protocol/src/alpha_context.ml

@@ -70,6 +70,12 @@ module Voting_period = Voting_period_repr
 module Gas = struct
   include Gas_limit_repr
   type error += Gas_limit_too_high = Raw_context.Gas_limit_too_high
+  type error += Not_enough_gas_minimal_deserialize_parameters =
+    Script_repr.Not_enough_gas_minimal_deserialize_parameters
+  type error += Not_enough_gas_minimal_deserialize_storage =
+    Script_repr.Not_enough_gas_minimal_deserialize_storage
+  type error += Not_enough_gas_minimal_serialize_storage =
+    Script_repr.Not_enough_gas_minimal_deserialize_storage
   let check_limit = Raw_context.check_gas_limit
   let set_limit = Raw_context.set_gas_limit
   let set_unlimited = Raw_context.set_gas_unlimited

src/proto_alpha/lib_protocol/src/alpha_context.mli

@@ -124,6 +124,9 @@ module Gas : sig
   type error += Block_quota_exceeded (* `Temporary *)
   type error += Operation_quota_exceeded (* `Temporary *)
   type error += Gas_limit_too_high (* `Permanent *)
+  type error += Not_enough_gas_minimal_deserialize_parameters (* `Permanent *)
+  type error += Not_enough_gas_minimal_deserialize_storage (* `Temporary *)
+  type error += Not_enough_gas_minimal_serialize_storage (* `Temporary *)
 
   val free : cost
   val step_cost : int -> cost

src/proto_alpha/lib_protocol/src/apply.ml

@@ -41,7 +41,6 @@ type error += Outdated_double_baking_evidence
   of { level: Raw_level.t ; last: Raw_level.t } (* `Permanent *)
 type error += Invalid_activation of { pkh : Ed25519.Public_key_hash.t }
 type error += Multiple_revelation
-type error += Not_enough_gas_minimal_deserialize
 
 let () =
   register_error_kind
@@ -319,15 +318,7 @@ let () =
           "Multiple revelations were included in a manager operation")
     Data_encoding.empty
     (function Multiple_revelation -> Some () | _ -> None)
-    (fun () -> Multiple_revelation) ;
-  register_error_kind
-    `Permanent
-    ~id:"not_enough_gas.minimal_deserialization"
-    ~title:"Not enough gas for minimal deserialization of transaction parameters"
-    ~description:"Gas quota is not enough for deserializing the transaction parameters, even for the cheapest case"
-    Data_encoding.empty
-    (function Not_enough_gas_minimal_deserialize -> Some () | _ -> None)
-    (fun () -> Not_enough_gas_minimal_deserialize)
+    (fun () -> Multiple_revelation)
 
 open Apply_results
 
@@ -506,7 +497,7 @@ let precheck_manager_contents
         (* Fail if not enough gas for minimal deserialization cost *)
         begin match Gas.consume ctxt (Script.minimal_deserialize_cost arg) with
           | Ok _ -> return ctxt
-          | Error _ -> fail Not_enough_gas_minimal_deserialize
+          | Error _ -> fail Gas.Not_enough_gas_minimal_deserialize_parameters
         end >>=? fun ctxt ->
         Lwt.return @@ Script.force_decode arg >>=? fun (_arg, cost_arg) ->
         Lwt.return @@ Gas.consume ctxt cost_arg
@@ -518,7 +509,7 @@ let precheck_manager_contents
             Gas.consume ctxt (Script.minimal_deserialize_cost script.storage)
           with
           | Ok _ -> return ctxt
-          | Error _ -> fail Not_enough_gas_minimal_deserialize
+          | Error _ -> fail Gas.Not_enough_gas_minimal_deserialize_parameters
         end >>=? fun ctxt ->
         Lwt.return @@ Script.force_decode script.code >>=? fun (_code, cost_code) ->
         Lwt.return @@ Gas.consume ctxt cost_code >>=? fun ctxt ->

src/proto_alpha/lib_protocol/src/script_repr.ml

@@ -25,6 +25,9 @@ let expr_encoding =
     Michelson_v1_primitives.prim_encoding
 
 type error += Lazy_script_decode (* `Permanent *)
+type error += Not_enough_gas_minimal_deserialize_parameters (* `Permanent *)
+type error += Not_enough_gas_minimal_deserialize_storage (* `Temporary *)
+type error += Not_enough_gas_minimal_serialize_storage (* `Temporary *)
 
 let () =
   register_error_kind `Permanent
@@ -34,7 +37,34 @@ let () =
                   from its binary representation"
     Data_encoding.empty
     (function Lazy_script_decode -> Some () | _ -> None)
-    (fun () -> Lazy_script_decode)
+    (fun () -> Lazy_script_decode) ;
+  register_error_kind
+    `Permanent
+    ~id:"gas_exhausted.minimal_deserialization_parameters"
+    ~title:"Not enough gas for minimal deserialization of transaction parameters"
+    ~description:"Gas quota is not enough for deserializing the transaction \
+                  parameters, even for the cheapest case"
+    Data_encoding.empty
+    (function Not_enough_gas_minimal_deserialize_parameters -> Some () | _ -> None)
+    (fun () -> Not_enough_gas_minimal_deserialize_parameters) ;
+  register_error_kind
+    `Temporary
+    ~id:"gas_exhausted.minimal_deserialization_storage"
+    ~title:"Not enough gas for minimal deserialization of contract storage"
+    ~description:"Gas quota is not enough for deserializing the contract \
+                  storage or code, even for the cheapest case"
+    Data_encoding.empty
+    (function Not_enough_gas_minimal_deserialize_storage -> Some () | _ -> None)
+    (fun () -> Not_enough_gas_minimal_deserialize_storage) ;
+  register_error_kind
+    `Temporary
+    ~id:"gas_exhausted.minimal_serialization_storage"
+    ~title:"Not enough gas for minimal serialization of contract storage"
+    ~description:"Gas quota is not enough for serializing the contract \
+                  storage or code, even for the cheapest case"
+    Data_encoding.empty
+    (function Not_enough_gas_minimal_deserialize_storage -> Some () | _ -> None)
+    (fun () -> Not_enough_gas_minimal_deserialize_storage)
 
 let lazy_expr_encoding =
   Data_encoding.lazy_encoding expr_encoding

src/proto_alpha/lib_protocol/src/script_repr.mli

@@ -14,6 +14,9 @@ type annot = Micheline.annot
 type expr = Michelson_v1_primitives.prim Micheline.canonical
 
 type error += Lazy_script_decode (* `Permanent *)
+type error += Not_enough_gas_minimal_deserialize_parameters (* `Permanent *)
+type error += Not_enough_gas_minimal_deserialize_storage (* `Temporary *)
+type error += Not_enough_gas_minimal_serialize_storage (* `Temporary *)
 
 type lazy_expr = expr Data_encoding.lazy_t
 

src/proto_alpha/lib_protocol/src/storage.ml

@@ -143,21 +143,74 @@ module Contract = struct
       (struct let name = ["counter"] end)
       (Z)
 
+  module Make_carbonated_map_expr (N : Storage_sigs.NAME) = struct
+    include Indexed_context.Make_carbonated_map
+        (N)
+        (struct
+          type t = Script_repr.lazy_expr
+          let encoding = Script_repr.lazy_expr_encoding
+        end)
+
+    let consume_deserialize_gas ctxt value =
+      begin match Raw_context.consume_gas ctxt (Script_repr.minimal_deserialize_cost value) with
+          | Ok _ -> return ctxt
+          | Error _ ->
+              fail Script_repr.Not_enough_gas_minimal_deserialize_storage
+      end >>=? fun ctxt ->
+      Lwt.return @@
+      (Script_repr.force_decode value >>? fun (_value, value_cost) ->
+       Raw_context.consume_gas ctxt value_cost)
+
+    let consume_serialize_gas ctxt value =
+      begin match Raw_context.consume_gas ctxt (Script_repr.minimal_serialize_cost value) with
+          | Ok _ -> return ctxt
+          | Error _ ->
+              fail Script_repr.Not_enough_gas_minimal_serialize_storage
+      end >>=? fun ctxt ->
+      Lwt.return @@
+      (Script_repr.force_bytes value >>? fun (_value, value_cost) ->
+       Raw_context.consume_gas ctxt value_cost)
+
+    let get ctxt contract =
+      get ctxt contract >>=? fun (ctxt, value) ->
+      consume_deserialize_gas ctxt value >>|? fun ctxt ->
+      (ctxt, value)
+
+    let get_option ctxt contract =
+      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)
+
+    let set ctxt contract value =
+      consume_serialize_gas ctxt value >>=? fun ctxt ->
+      set ctxt contract value
+
+    let set_option ctxt contract value_opt =
+      match value_opt with
+      | None -> set_option ctxt contract None
+      | Some value ->
+          consume_serialize_gas ctxt value >>=? fun ctxt ->
+          set_option ctxt contract value_opt
+
+    let init ctxt contract value =
+      consume_serialize_gas ctxt value >>=? fun ctxt ->
+      init ctxt contract value
+
+    let init_set ctxt contract value =
+      consume_serialize_gas ctxt value >>=? fun ctxt ->
+      init_set ctxt contract value
+  end
+
   module Code =
-    Indexed_context.Make_carbonated_map
+    Make_carbonated_map_expr
       (struct let name = ["code"] end)
-      (struct
-        type t = Script_repr.lazy_expr
-        let encoding = Script_repr.lazy_expr_encoding
-      end)
 
   module Storage =
-    Indexed_context.Make_carbonated_map
+    Make_carbonated_map_expr
       (struct let name = ["storage"] end)
-      (struct
-        type t = Script_repr.lazy_expr
-        let encoding = Script_repr.lazy_expr_encoding
-      end)
 
   type bigmap_key = Raw_context.t * Contract_repr.t