From 6f3be375e80b8b20e5758c5faba7b72dccc5d466 Mon Sep 17 00:00:00 2001
From: Benjamin Canou <benjamin@canou.fr>
Date: Sat, 7 Apr 2018 18:28:37 +0200
Subject: [PATCH] Alpha: IO gas accounting

---
 .../lib_protocol/src/alpha_context.mli        | 12 +--
 src/proto_alpha/lib_protocol/src/apply.ml     |  2 +-
 .../lib_protocol/src/contract_services.ml     | 10 +-
 .../lib_protocol/src/contract_storage.ml      | 54 +++++-----
 .../lib_protocol/src/contract_storage.mli     | 12 +--
 src/proto_alpha/lib_protocol/src/gas_repr.ml  | 99 +++++++++++++++----
 src/proto_alpha/lib_protocol/src/gas_repr.mli |  2 +
 .../lib_protocol/src/raw_context.mli          |  1 -
 .../lib_protocol/src/script_interpreter.ml    |  8 +-
 .../lib_protocol/src/script_ir_translator.ml  | 12 +--
 src/proto_alpha/lib_protocol/src/storage.ml   | 12 +--
 src/proto_alpha/lib_protocol/src/storage.mli  |  6 +-
 .../lib_protocol/src/storage_functors.ml      |  2 +-
 .../lib_protocol/test/test_big_maps.ml        |  4 +-
 .../lib_protocol/test/test_michelson.ml       |  2 +-
 15 files changed, 155 insertions(+), 83 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/src/alpha_context.mli b/src/proto_alpha/lib_protocol/src/alpha_context.mli
index 18576a06e..580952231 100644
--- a/src/proto_alpha/lib_protocol/src/alpha_context.mli
+++ b/src/proto_alpha/lib_protocol/src/alpha_context.mli
@@ -502,9 +502,9 @@ module Contract : sig
   val is_spendable:
     context -> contract -> bool tzresult Lwt.t
   val get_script:
-    context -> contract -> (Script.t option) tzresult Lwt.t
+    context -> contract -> (context * Script.t option) tzresult Lwt.t
   val get_storage:
-    context -> contract -> (Script.expr option) tzresult Lwt.t
+    context -> contract -> (context * Script.expr option) tzresult Lwt.t
 
   val get_counter: context -> contract -> int32 tzresult Lwt.t
   val get_balance:
@@ -546,13 +546,13 @@ module Contract : sig
 
   module Big_map : sig
     val set:
-      context -> contract ->
-      string -> Script.expr -> context tzresult Lwt.t
+      context -> contract -> string -> Script.expr -> context tzresult Lwt.t
     val remove:
       context -> contract -> string -> context tzresult Lwt.t
-    val mem: context -> contract -> string -> bool Lwt.t
+    val mem:
+      context -> contract -> string -> (context * bool) tzresult Lwt.t
     val get_opt:
-      context -> contract -> string -> Script_repr.expr option tzresult Lwt.t
+      context -> contract -> string -> (context * Script_repr.expr option) tzresult Lwt.t
   end
 
 end
diff --git a/src/proto_alpha/lib_protocol/src/apply.ml b/src/proto_alpha/lib_protocol/src/apply.ml
index 7ccfb5377..11c0ea2b4 100644
--- a/src/proto_alpha/lib_protocol/src/apply.ml
+++ b/src/proto_alpha/lib_protocol/src/apply.ml
@@ -376,7 +376,7 @@ let apply_manager_operation_content
       begin
         Contract.spend ctxt source amount >>=? fun ctxt ->
         Contract.credit ctxt destination amount >>=? fun ctxt ->
-        Contract.get_script ctxt destination >>=? function
+        Contract.get_script ctxt destination >>=? fun (ctxt, script) -> match script with
         | None -> begin
             match parameters with
             | None ->
diff --git a/src/proto_alpha/lib_protocol/src/contract_services.ml b/src/proto_alpha/lib_protocol/src/contract_services.ml
index 13014ef95..7b054b87d 100644
--- a/src/proto_alpha/lib_protocol/src/contract_services.ml
+++ b/src/proto_alpha/lib_protocol/src/contract_services.ml
@@ -170,8 +170,10 @@ let () =
   register_field S.counter Contract.get_counter ;
   register_field S.spendable Contract.is_spendable ;
   register_field S.delegatable Contract.is_delegatable ;
-  register_opt_field S.script Contract.get_script ;
-  register_opt_field S.storage Contract.get_storage ;
+  register_opt_field S.script
+    (fun c v -> Contract.get_script c v >>=? fun (_, v) -> return v) ;
+  register_opt_field S.storage
+    (fun c v -> Contract.get_storage c v >>=? fun (_, v) -> return v) ;
   register_field S.info (fun ctxt contract ->
       Contract.get_balance ctxt contract >>=? fun balance ->
       Contract.get_manager ctxt contract >>=? fun manager ->
@@ -179,8 +181,8 @@ let () =
       Contract.get_counter ctxt contract >>=? fun counter ->
       Contract.is_delegatable ctxt contract >>=? fun delegatable ->
       Contract.is_spendable ctxt contract >>=? fun spendable ->
-      Contract.get_script ctxt contract >>=? fun script ->
-      Contract.get_storage ctxt contract >>=? fun storage ->
+      Contract.get_script ctxt contract >>=? fun (ctxt, script) ->
+      Contract.get_storage ctxt contract >>=? fun (_ctxt, storage) ->
       return { manager ; balance ;
                spendable ; delegate = (delegatable, delegate) ;
                script ; counter ; storage})
diff --git a/src/proto_alpha/lib_protocol/src/contract_storage.ml b/src/proto_alpha/lib_protocol/src/contract_storage.ml
index db7e27a70..10134619b 100644
--- a/src/proto_alpha/lib_protocol/src/contract_storage.ml
+++ b/src/proto_alpha/lib_protocol/src/contract_storage.ml
@@ -200,8 +200,8 @@ let create_base c contract
   Storage.Contract.Counter.init c contract counter >>=? fun c ->
   (match script with
    | Some ({ Script_repr.code ; storage }, (code_fees, storage_fees)) ->
-       Storage.Contract.Code.init c contract code >>=? fun c ->
-       Storage.Contract.Storage.init c contract storage >>=? fun c ->
+       Storage.Contract.Code.init c contract code >>=? fun (c, _) ->
+       Storage.Contract.Storage.init c contract storage >>=? fun (c, _) ->
        Storage.Contract.Code_fees.init c contract code_fees >>=? fun c ->
        Storage.Contract.Storage_fees.init c contract storage_fees
    | None ->
@@ -225,11 +225,11 @@ let delete c contract =
   Storage.Contract.Spendable.del c contract >>= fun c ->
   Storage.Contract.Delegatable.del c contract >>= fun c ->
   Storage.Contract.Counter.delete c contract >>=? fun c ->
-  Storage.Contract.Code.remove c contract >>= fun c ->
-  Storage.Contract.Storage.remove c contract >>= fun c ->
+  Storage.Contract.Code.remove c contract >>=? fun (c, _) ->
+  Storage.Contract.Storage.remove c contract >>=? fun (c, _) ->
   Storage.Contract.Code_fees.remove c contract >>= fun c ->
   Storage.Contract.Storage_fees.remove c contract >>= fun c ->
-  Storage.Contract.Big_map.clear (c, contract) >>= fun c ->
+  Storage.Contract.Big_map.clear (c, contract) >>=? fun c ->
   return c
 
 let allocated c contract =
@@ -274,11 +274,11 @@ let increment_counter c contract =
   Storage.Contract.Counter.set c contract (Int32.succ contract_counter)
 
 let get_script c contract =
-  Storage.Contract.Code.get_option c contract >>=? fun code ->
-  Storage.Contract.Storage.get_option c contract >>=? fun storage ->
+  Storage.Contract.Code.get_option c contract >>=? fun (c, code) ->
+  Storage.Contract.Storage.get_option c contract >>=? fun (c, storage) ->
   match code, storage with
-  | None, None -> return None
-  | Some code, Some storage -> return (Some { Script_repr.code ; storage })
+  | None, None -> return (c, None)
+  | Some code, Some storage -> return (c, Some { Script_repr.code ; storage })
   | None, Some _ | Some _, None -> failwith "get_script"
 
 let get_storage = Storage.Contract.Storage.get_option
@@ -364,14 +364,15 @@ let update_script_storage c contract storage big_map  =
         fold_left_s (fun c (key, value) ->
             match value with
             | None ->
-                Storage.Contract.Big_map.remove (c, contract) key >>=
-                return
+                Storage.Contract.Big_map.remove (c, contract) key >>=? fun (c, _) ->
+                return c
             | Some v ->
-                Storage.Contract.Big_map.init_set (c, contract) key v >>=
-                return)
+                Storage.Contract.Big_map.init_set (c, contract) key v >>=? fun (c, _) ->
+                return c)
           c diff
   end >>=? fun c ->
-  Storage.Contract.Storage.set c contract storage
+  Storage.Contract.Storage.set c contract storage >>=? fun (c, _) ->
+  return c
 
 let spend_from_script c contract amount =
   Storage.Contract.Balance.get c contract >>=? fun balance ->
@@ -393,16 +394,18 @@ let spend_from_script c contract amount =
                 return c
             | None ->
                 (* Delete empty implicit contract *)
-                delete c contract
+                delete c contract >>=? fun (c, _) ->
+                return c
 
 let credit c contract amount =
   begin
     if Tez_repr.(amount <> Tez_repr.zero) then
-      return ()
+      return c
     else
-      Storage.Contract.Code.mem c contract >>= fun target_has_code ->
-      fail_unless target_has_code (Empty_transaction contract)
-  end >>=? fun () ->
+      Storage.Contract.Code.mem c contract >>=? fun (c, target_has_code) ->
+      fail_unless target_has_code (Empty_transaction contract) >>=? fun () ->
+      return c
+  end >>=? fun c ->
   Storage.Contract.Balance.get_option c contract >>=? function
   | None -> begin
       match Contract_repr.is_implicit contract with
@@ -440,8 +443,13 @@ let init c =
 
 module Big_map = struct
   let set ctxt contract key value =
-    Storage.Contract.Big_map.init_set (ctxt, contract) key value >>= return
-  let remove ctxt contract = Storage.Contract.Big_map.delete (ctxt, contract)
-  let mem ctxt contract = Storage.Contract.Big_map.mem (ctxt, contract)
-  let get_opt ctxt contract = Storage.Contract.Big_map.get_option (ctxt, contract)
+    Storage.Contract.Big_map.init_set (ctxt, contract) key value >>=? fun (c, _) ->
+    return c
+  let remove ctxt contract key =
+    Storage.Contract.Big_map.delete (ctxt, contract) key >>=? fun (c, _) ->
+    return c
+  let mem ctxt contract key =
+    Storage.Contract.Big_map.mem (ctxt, contract) key
+  let get_opt ctxt contract key =
+    Storage.Contract.Big_map.get_option (ctxt, contract) key
 end
diff --git a/src/proto_alpha/lib_protocol/src/contract_storage.mli b/src/proto_alpha/lib_protocol/src/contract_storage.mli
index 932d8cadc..45ddaf644 100644
--- a/src/proto_alpha/lib_protocol/src/contract_storage.mli
+++ b/src/proto_alpha/lib_protocol/src/contract_storage.mli
@@ -56,9 +56,9 @@ val get_balance: Raw_context.t -> Contract_repr.t -> Tez_repr.t tzresult Lwt.t
 val get_counter: Raw_context.t -> Contract_repr.t -> int32 tzresult Lwt.t
 
 val get_script:
-  Raw_context.t -> Contract_repr.t -> Script_repr.t option tzresult Lwt.t
+  Raw_context.t -> Contract_repr.t -> (Raw_context.t * Script_repr.t option) tzresult Lwt.t
 val get_storage:
-  Raw_context.t -> Contract_repr.t -> Script_repr.expr option tzresult Lwt.t
+  Raw_context.t -> Contract_repr.t -> (Raw_context.t * Script_repr.expr option) tzresult Lwt.t
 
 type big_map_diff = (string * Script_repr.expr option) list
 
@@ -103,11 +103,11 @@ val init:
 
 module Big_map : sig
   val set :
-    Raw_context.t -> Contract_repr.t ->
-    string -> Script_repr.expr -> Raw_context.t tzresult Lwt.t
+    Raw_context.t -> Contract_repr.t -> string -> Script_repr.expr -> Raw_context.t tzresult Lwt.t
   val remove :
     Raw_context.t -> Contract_repr.t -> string -> Raw_context.t tzresult Lwt.t
-  val mem : Raw_context.t -> Contract_repr.t -> string -> bool Lwt.t
+  val mem :
+    Raw_context.t -> Contract_repr.t -> string -> (Raw_context.t * bool) tzresult Lwt.t
   val get_opt :
-    Raw_context.t -> Contract_repr.t -> string -> Script_repr.expr option tzresult Lwt.t
+    Raw_context.t -> Contract_repr.t -> string -> (Raw_context.t * Script_repr.expr option) tzresult Lwt.t
 end
diff --git a/src/proto_alpha/lib_protocol/src/gas_repr.ml b/src/proto_alpha/lib_protocol/src/gas_repr.ml
index 468b3f5f7..8646d2048 100644
--- a/src/proto_alpha/lib_protocol/src/gas_repr.ml
+++ b/src/proto_alpha/lib_protocol/src/gas_repr.ml
@@ -13,7 +13,11 @@ type t =
 
 type cost =
   { allocations : Z.t ;
-    steps : Z.t }
+    steps : Z.t ;
+    reads : Z.t ;
+    writes : Z.t  ;
+    bytes_read : Z.t ;
+    bytes_written : Z.t }
 
 let encoding =
   let open Data_encoding in
@@ -34,32 +38,53 @@ let pp ppf = function
 let cost_encoding =
   let open Data_encoding in
   conv
-    (fun { allocations ; steps } ->
-       (allocations, steps))
-    (fun (allocations, steps) ->
-       { allocations ; steps })
-    (obj2
+    (fun { allocations ; steps ; reads ; writes ; bytes_read ; bytes_written } ->
+       (allocations, steps, reads, writes, bytes_read, bytes_written))
+    (fun (allocations, steps, reads, writes, bytes_read, bytes_written) ->
+       { allocations ; steps ; reads ; writes ; bytes_read ; bytes_written })
+    (obj6
        (req "allocations" z)
-       (req "steps" z))
+       (req "steps" z)
+       (req "reads" z)
+       (req "writes" z)
+       (req "bytes_read" z)
+       (req "bytes_written" z))
 
-let pp_cost ppf { allocations ; steps } =
+let pp_cost ppf { allocations ; steps ; reads ; writes ; bytes_read ; bytes_written } =
   Format.fprintf ppf
-    "(steps: %s, allocs: %s)"
-    (Z.to_string steps) (Z.to_string allocations)
+    "(steps: %s, allocs: %s, reads: %s (%s bytes), writes: %s (%s bytes))"
+    (Z.to_string steps)
+    (Z.to_string allocations)
+    (Z.to_string reads)
+    (Z.to_string bytes_read)
+    (Z.to_string writes)
+    (Z.to_string bytes_written)
 
 type error += Block_quota_exceeded (* `Temporary *)
 type error += Operation_quota_exceeded (* `Temporary *)
 
-let allocation_weight = Z.of_int 2
-let step_weight = Z.of_int 1
+let allocation_weight = Z.of_int 2 (* FIXME: placeholder *)
+let step_weight = Z.of_int 1 (* FIXME: placeholder *)
+let read_base_weight = Z.of_int 10 (* FIXME: placeholder *)
+let write_base_weight = Z.of_int 20 (* FIXME: placeholder *)
+let byte_read_weight = Z.of_int 10 (* FIXME: placeholder *)
+let byte_written_weight = Z.of_int 20 (* FIXME: placeholder *)
 
 let consume block_gas operation_gas cost = match operation_gas with
   | Unaccounted -> ok (block_gas, Unaccounted)
   | Limited { remaining } ->
       let weighted_cost =
         Z.add
-          (Z.mul allocation_weight cost.allocations)
-          (Z.mul step_weight cost.steps) in
+          (Z.add
+             (Z.mul allocation_weight cost.allocations)
+             (Z.mul step_weight cost.steps))
+          (Z.add
+             (Z.add
+                (Z.mul read_base_weight cost.reads)
+                (Z.mul write_base_weight cost.writes))
+             (Z.add
+                (Z.mul byte_read_weight cost.bytes_read)
+                (Z.mul byte_written_weight cost.bytes_written))) in
       let remaining =
         Z.sub remaining weighted_cost in
       let block_remaining =
@@ -72,7 +97,11 @@ let consume block_gas operation_gas cost = match operation_gas with
 
 let alloc_cost n =
   { allocations = Z.of_int (n + 1) ;
-    steps = Z.zero }
+    steps = Z.zero ;
+    reads = Z.zero ;
+    writes = Z.zero ;
+    bytes_read = Z.zero ;
+    bytes_written = Z.zero }
 
 let alloc_bytes_cost n =
   alloc_cost (n / 8)
@@ -82,19 +111,51 @@ let alloc_bits_cost n =
 
 let step_cost n =
   { allocations = Z.zero ;
-    steps = Z.of_int n }
+    steps = Z.of_int n ;
+    reads = Z.zero ;
+    writes = Z.zero ;
+    bytes_read = Z.zero ;
+    bytes_written = Z.zero }
 
 let free =
   { allocations = Z.zero ;
-    steps = Z.zero }
+    steps = Z.zero ;
+    reads = Z.zero ;
+    writes = Z.zero ;
+    bytes_read = Z.zero ;
+    bytes_written = Z.zero }
+
+let read_bytes_cost n =
+  { allocations = Z.zero ;
+    steps = Z.zero ;
+    reads = Z.one ;
+    writes = Z.zero ;
+    bytes_read = n ;
+    bytes_written = Z.zero }
+
+let write_bytes_cost n =
+  { allocations = Z.zero ;
+    steps = Z.zero ;
+    reads = Z.zero ;
+    writes = Z.one ;
+    bytes_read = Z.zero ;
+    bytes_written = n }
 
 let ( +@ ) x y =
   { allocations = Z.add x.allocations y.allocations ;
-    steps = Z.add x.steps y.steps }
+    steps = Z.add x.steps y.steps ;
+    reads = Z.add x.reads y.reads ;
+    writes = Z.add x.writes y.writes ;
+    bytes_read = Z.add x.bytes_read y.bytes_read ;
+    bytes_written = Z.add x.bytes_written y.bytes_written }
 
 let ( *@ ) x y =
   { allocations = Z.mul (Z.of_int x) y.allocations ;
-    steps = Z.mul (Z.of_int x) y.steps }
+    steps = Z.mul (Z.of_int x) y.steps ;
+    reads = Z.mul (Z.of_int x) y.reads ;
+    writes = Z.mul (Z.of_int x) y.writes ;
+    bytes_read = Z.mul (Z.of_int x) y.bytes_read ;
+    bytes_written = Z.mul (Z.of_int x) y.bytes_written }
 
 let () =
   let open Data_encoding in
diff --git a/src/proto_alpha/lib_protocol/src/gas_repr.mli b/src/proto_alpha/lib_protocol/src/gas_repr.mli
index e0b644426..c07512f1d 100644
--- a/src/proto_alpha/lib_protocol/src/gas_repr.mli
+++ b/src/proto_alpha/lib_protocol/src/gas_repr.mli
@@ -29,6 +29,8 @@ val step_cost : int -> cost
 val alloc_cost : int -> cost
 val alloc_bytes_cost : int -> cost
 val alloc_bits_cost : int -> cost
+val read_bytes_cost : Z.t -> cost
+val write_bytes_cost : Z.t -> cost
 
 val ( *@ ) : int -> cost -> cost
 val ( +@ ) : cost -> cost -> cost
diff --git a/src/proto_alpha/lib_protocol/src/raw_context.mli b/src/proto_alpha/lib_protocol/src/raw_context.mli
index 2c3875534..5a222038f 100644
--- a/src/proto_alpha/lib_protocol/src/raw_context.mli
+++ b/src/proto_alpha/lib_protocol/src/raw_context.mli
@@ -77,7 +77,6 @@ type error += Gas_limit_too_high (* `Permanent *)
 
 val set_gas_limit: t -> Z.t -> t tzresult
 val set_gas_unlimited: t -> t
-val consume_gas: t -> Gas_repr.cost -> t tzresult
 val gas_level: t -> Gas_repr.t
 val block_gas_level: t -> Z.t
 
diff --git a/src/proto_alpha/lib_protocol/src/script_interpreter.ml b/src/proto_alpha/lib_protocol/src/script_interpreter.ml
index be0bc2f7f..92b5b118d 100644
--- a/src/proto_alpha/lib_protocol/src/script_interpreter.ml
+++ b/src/proto_alpha/lib_protocol/src/script_interpreter.ml
@@ -648,7 +648,7 @@ let rec interp
             Lwt.return (Gas.consume ctxt Interp_costs.transfer) >>=? fun ctxt ->
             Contract.spend_from_script ctxt source amount >>=? fun ctxt ->
             Contract.credit ctxt destination amount >>=? fun ctxt ->
-            Contract.get_script ctxt destination >>=? fun destination_script ->
+            Contract.get_script ctxt destination >>=? fun (ctxt, destination_script) ->
             Lwt.return (unparse_data ctxt storage_type storage) >>=? fun (sto, ctxt) ->
             let sto = Micheline.strip_locations sto in
             begin match Script_ir_translator.extract_big_map storage_type storage with
@@ -685,7 +685,7 @@ let rec interp
                     destination dummy_storage_fee >>=? fun ctxt ->
                   return (ctxt, origination)
             end >>=? fun (ctxt, origination) ->
-            Contract.get_script ctxt source >>=? (function
+            Contract.get_script ctxt source >>=? (fun (ctxt, script) -> match script with
                 | None -> assert false
                 | Some { storage; _ } ->
                     parse_data ctxt storage_type (Micheline.root storage) >>=? fun (sto, ctxt) ->
@@ -696,7 +696,7 @@ let rec interp
             Lwt.return (Gas.consume ctxt Interp_costs.transfer) >>=? fun ctxt ->
             Contract.spend_from_script ctxt source amount >>=? fun ctxt ->
             Contract.credit ctxt destination amount >>=? fun ctxt ->
-            Contract.get_script ctxt destination >>=? function
+            Contract.get_script ctxt destination >>=? fun (ctxt, script) -> match script with
             | None -> fail (Invalid_contract (loc, destination))
             | Some script ->
                 begin match extract_big_map storage_type sto with
@@ -727,7 +727,7 @@ let rec interp
                 trace
                   (Invalid_contract (loc, destination))
                   (parse_data ctxt tr ret) >>=? fun (v, ctxt) ->
-                Contract.get_script ctxt source >>=? (function
+                Contract.get_script ctxt source >>=? (fun (ctxt, script) -> match script with
                     | None -> assert false
                     | Some { storage ; _ } ->
                         parse_data ctxt storage_type (Micheline.root storage) >>=? fun (sto, ctxt) ->
diff --git a/src/proto_alpha/lib_protocol/src/script_ir_translator.ml b/src/proto_alpha/lib_protocol/src/script_ir_translator.ml
index 220006859..72f4d4baf 100644
--- a/src/proto_alpha/lib_protocol/src/script_ir_translator.ml
+++ b/src/proto_alpha/lib_protocol/src/script_ir_translator.ml
@@ -2159,7 +2159,7 @@ and parse_contract
         Lwt.return (Gas.consume ctxt Typecheck_costs.get_script) >>=? fun ctxt ->
         trace
           (Invalid_contract (loc, contract)) @@
-        Contract.get_script ctxt contract >>=? function
+        Contract.get_script ctxt contract >>=? fun (ctxt, script) -> match script with
         | None ->
             Lwt.return
               (ty_eq arg Unit_t >>? fun Eq ->
@@ -2303,7 +2303,7 @@ let hash_data ctxt typ data =
 let big_map_mem ctxt contract key { diff ; key_type ; _ } =
   match map_get key diff with
   | None -> Lwt.return @@ hash_data ctxt key_type key >>=? fun (hash, ctxt) ->
-      Alpha_context.Contract.Big_map.mem ctxt contract hash >>= fun res ->
+      Alpha_context.Contract.Big_map.mem ctxt contract hash >>=? fun (ctxt, res) ->
       return (res, ctxt)
   | Some None -> return (false, ctxt)
   | Some (Some _) -> return (true, ctxt)
@@ -2315,10 +2315,10 @@ let big_map_get ctxt contract key { diff ; key_type ; value_type } =
       Lwt.return @@ hash_data ctxt key_type key >>=? fun (hash, ctxt) ->
       Alpha_context.Contract.Big_map.get_opt
         ctxt contract hash >>=? begin function
-        | None -> return (None, ctxt)
-        | Some value ->
-            parse_data ctxt value_type (Micheline.root value) >>|? fun (x, ctxt) ->
-            (Some x, ctxt)
+        | (ctxt, None) -> return (None, ctxt)
+        | (ctxt, Some value) ->
+            parse_data ctxt value_type (Micheline.root value) >>=? fun (x, ctxt) ->
+            return (Some x, ctxt)
       end
 
 let big_map_update key value ({ diff ; _ } as map) =
diff --git a/src/proto_alpha/lib_protocol/src/storage.ml b/src/proto_alpha/lib_protocol/src/storage.ml
index 130672def..0d82ffea2 100644
--- a/src/proto_alpha/lib_protocol/src/storage.ml
+++ b/src/proto_alpha/lib_protocol/src/storage.ml
@@ -127,17 +127,17 @@ module Contract = struct
       (Make_value(Int32))
 
   module Code =
-    Indexed_context.Make_map
+    Indexed_context.Make_carbonated_map
       (struct let name = ["code"] end)
-      (Make_value(struct
+      (Make_carbonated_value(struct
          type t = Script_repr.expr
          let encoding = Script_repr.expr_encoding
        end))
 
   module Storage =
-    Indexed_context.Make_map
+    Indexed_context.Make_carbonated_map
       (struct let name = ["storage"] end)
-      (Make_value(struct
+      (Make_carbonated_value(struct
          type t = Script_repr.expr
          let encoding = Script_repr.expr_encoding
        end))
@@ -145,12 +145,12 @@ module Contract = struct
   type bigmap_key = Raw_context.t * Contract_repr.t
 
   module Big_map =
-    Storage_functors.Make_indexed_data_storage
+    Storage_functors.Make_indexed_carbonated_data_storage
       (Make_subcontext
          (Indexed_context.Raw_context)
          (struct let name = ["big_map"] end))
       (String_index)
-      (Make_value (struct
+      (Make_carbonated_value (struct
          type t = Script_repr.expr
          let encoding = Script_repr.expr_encoding
        end))
diff --git a/src/proto_alpha/lib_protocol/src/storage.mli b/src/proto_alpha/lib_protocol/src/storage.mli
index 0d578d3ef..389aa9e32 100644
--- a/src/proto_alpha/lib_protocol/src/storage.mli
+++ b/src/proto_alpha/lib_protocol/src/storage.mli
@@ -156,12 +156,12 @@ module Contract : sig
      and type value = int32
      and type t := Raw_context.t
 
-  module Code : Indexed_data_storage
+  module Code : Indexed_carbonated_data_storage
     with type key = Contract_repr.t
      and type value = Script_repr.expr
      and type t := Raw_context.t
 
-  module Storage : Indexed_data_storage
+  module Storage : Indexed_carbonated_data_storage
     with type key = Contract_repr.t
      and type value = Script_repr.expr
      and type t := Raw_context.t
@@ -178,7 +178,7 @@ module Contract : sig
 
   type bigmap_key = Raw_context.t * Contract_repr.t
 
-  module Big_map : Indexed_data_storage
+  module Big_map : Indexed_carbonated_data_storage
     with type key = string
      and type value = Script_repr.expr
      and type t := bigmap_key
diff --git a/src/proto_alpha/lib_protocol/src/storage_functors.ml b/src/proto_alpha/lib_protocol/src/storage_functors.ml
index 00a5311e4..43b124ec7 100644
--- a/src/proto_alpha/lib_protocol/src/storage_functors.ml
+++ b/src/proto_alpha/lib_protocol/src/storage_functors.ml
@@ -48,7 +48,7 @@ let rec len_name = function
 
 let encode_len_value bytes =
   let length = MBytes.length bytes in
-  Data_encoding.(Binary.to_bytes int31) length
+  Data_encoding.(Binary.to_bytes_exn int31) length
 
 let decode_len_value key len =
   match Data_encoding.(Binary.of_bytes int31) len with
diff --git a/src/proto_alpha/lib_protocol/test/test_big_maps.ml b/src/proto_alpha/lib_protocol/test/test_big_maps.ml
index cad1fa241..37f32aa41 100644
--- a/src/proto_alpha/lib_protocol/test/test_big_maps.ml
+++ b/src/proto_alpha/lib_protocol/test/test_big_maps.ml
@@ -46,8 +46,8 @@ let expect_big_map tc contract print_key key_type print_data data_type contents
   let open Proto_alpha.Error_monad in
   iter_p
     (fun (n, exp) ->
-       Lwt.return @@ Proto_alpha.Script_ir_translator.hash_data tc key_type n >>=? fun (key, _tc) ->
-       Proto_alpha.Alpha_context.Contract.Big_map.get_opt tc contract key >>=? fun data ->
+       Lwt.return @@ Proto_alpha.Script_ir_translator.hash_data tc key_type n >>=? fun (key, tc) ->
+       Proto_alpha.Alpha_context.Contract.Big_map.get_opt tc contract key >>=? fun (_tc, data) ->
        match data, exp with
        | None, None ->
            debug " - big_map[%a] is not defined (ok)" print_key n ;
diff --git a/src/proto_alpha/lib_protocol/test/test_michelson.ml b/src/proto_alpha/lib_protocol/test/test_michelson.ml
index 35102de46..6c38e4eb4 100644
--- a/src/proto_alpha/lib_protocol/test/test_michelson.ml
+++ b/src/proto_alpha/lib_protocol/test/test_michelson.ml
@@ -434,7 +434,7 @@ let test_example () =
   test_contract ~tc "create_contract" account_str account_str >>=? fun (cs, tc) ->
   Assert.equal_int 1 @@ List.length cs ;
   let contract = List.hd cs in
-  Proto_alpha.Alpha_context.Contract.get_script tc contract >>=?? fun res ->
+  Proto_alpha.Alpha_context.Contract.get_script tc contract >>=?? fun (_, res) ->
   let script = Option.unopt_exn (Failure "get_script") res in
   Script.execute_code_pred ~tc sb script (parse_param "\"abc\"") >>=?? fun (_, ret, _, _, _) ->
   Assert.equal_string ~msg: __LOC__ "\"abc\"" @@ string_of_canon ret ;