Alpha: add variants of storage functors with size accounting

src/proto_alpha/lib_protocol/src/raw_context.ml

@@ -380,6 +380,9 @@ module type T = sig
     context -> key -> init:'a -> f:(key -> 'a -> 'a Lwt.t) -> 'a Lwt.t
 
   val project: context -> root_context
+
+  val consume_gas: context -> Gas_repr.cost -> context tzresult
+
 end
 
 let mem ctxt k = Context.mem ctxt.context k

src/proto_alpha/lib_protocol/src/raw_context.mli

@@ -153,6 +153,8 @@ module type T = sig
 
   val project: context -> root_context
 
+  val consume_gas: context -> Gas_repr.cost -> context tzresult
+
 end
 
 include T with type t := t and type context := context

src/proto_alpha/lib_protocol/src/storage_functors.ml

@@ -26,12 +26,37 @@ module Make_value (V : ENCODED_VALUE) = struct
     | None -> MBytes.create 0
 end
 
-module Raw_value = struct
+module Make_carbonated_value (V : ENCODED_VALUE) = struct
-  type t = MBytes.t
+  type t = V.t
-  let of_bytes b = ok b
+  let of_bytes b =
-  let to_bytes b = b
+    match Data_encoding.Binary.of_bytes V.encoding b with
+    | None -> Error [Raw_context.Storage_error (Corrupted_data [(* FIXME??*)])]
+    | Some v -> Ok v
+  let to_bytes v =
+    try Data_encoding.Binary.to_bytes_exn V.encoding v
+    with _ -> MBytes.create 0
+  let size =
+    match Data_encoding.classify V.encoding with
+    | `Fixed size -> Fixed size
+    | `Variable | `Dynamic -> Variable
 end
 
+let rec len_name = function
+  | [] -> assert false
+  | [ last ] ->  [ last ^ "$" ]
+  | first :: rest -> first :: len_name rest
+
+let encode_len_value bytes =
+  let length = MBytes.length bytes in
+  Data_encoding.(Binary.to_bytes int31) length
+
+let decode_len_value key len =
+  match Data_encoding.(Binary.of_bytes int31) len with
+  | None ->
+      fail (Raw_context.Storage_error (Corrupted_data (len_name key)))
+  | Some len ->
+      return len
+
 let map_key f = function
   | `Key k -> `Key (f k)
   | `Dir k -> `Dir (f k)
@@ -62,6 +87,7 @@ module Make_subcontext (C : Raw_context.T) (N : NAME)
   let fold_keys t k ~init ~f =
     C.fold_keys t (to_key k) ~init ~f:(fun k acc -> f (of_key k) acc)
   let project = C.project
+  let consume_gas = C.consume_gas
 end
 
 module Make_single_data_storage (C : Raw_context.T) (N : NAME) (V : VALUE)
@@ -102,6 +128,97 @@ module Make_single_data_storage (C : Raw_context.T) (N : NAME) (V : VALUE)
     return (C.project t)
 end
 
+module Make_single_carbonated_data_storage
+    (C : Raw_context.T) (N : NAME) (V : CARBONATED_VALUE)
+  : Single_carbonated_data_storage with type t = C.t
+                                    and type value = V.t = struct
+  type t = C.t
+  type context = t
+  type value = V.t
+  let consume_mem_gas c =
+    Lwt.return (C.consume_gas c (Gas_repr.read_bytes_cost Z.zero))
+  let existing_size c =
+    match V.size with
+    | Fixed len ->
+        C.mem c N.name >>= fun exists ->
+        if exists then return len else return 0
+    | Variable ->
+        C.get_option c (len_name N.name) >>= function
+        | None -> return 0
+        | Some len -> decode_len_value N.name len
+  let consume_read_gas get c =
+    match V.size with
+    | Fixed len ->
+        Lwt.return (C.consume_gas c (Gas_repr.read_bytes_cost (Z.of_int len)))
+    | Variable ->
+        get c (len_name N.name) >>=? fun len ->
+        decode_len_value N.name len >>=? fun len ->
+        Lwt.return (C.consume_gas c (Gas_repr.read_bytes_cost (Z.of_int len)))
+  let consume_write_gas set c v =
+    match V.size with
+    | Fixed s ->
+        Lwt.return (C.consume_gas c (Gas_repr.write_bytes_cost (Z.of_int s))) >>=? fun c ->
+        return (c, V.to_bytes v)
+    | Variable ->
+        let bytes = V.to_bytes v in
+        let len = MBytes.length bytes in
+        Lwt.return (C.consume_gas c (Gas_repr.write_bytes_cost (Z.of_int len))) >>=? fun c ->
+        set c (len_name N.name) (encode_len_value bytes) >>=? fun c ->
+        return (c, bytes)
+  let consume_remove_gas del c =
+    match V.size with
+    | Fixed _ | Variable ->
+        Lwt.return (C.consume_gas c (Gas_repr.write_bytes_cost Z.zero)) >>=? fun c ->
+        del c (len_name N.name)
+  let mem c =
+    consume_mem_gas c >>=? fun c ->
+    C.mem c N.name >>= fun res ->
+    return (C.project c, res)
+  let get c =
+    consume_read_gas C.get c >>=? fun c ->
+    C.get c N.name >>=? fun bytes ->
+    Lwt.return (V.of_bytes bytes) >>=? fun res ->
+    return (C.project c, res)
+  let get_option c =
+    consume_mem_gas c >>=? fun c ->
+    C.mem c N.name >>= fun exists ->
+    if exists then
+      get c >>=? fun (c, r) ->
+      return (c, Some r)
+    else
+      return (C.project c, None)
+  let init c v =
+    consume_write_gas C.init c v >>=? fun (c, bytes) ->
+    existing_size c >>=? fun prev_size ->
+    C.init c N.name bytes >>=? fun c ->
+    return (C.project c, MBytes.length bytes - prev_size)
+  let set c v =
+    consume_write_gas C.set c v >>=? fun (c, bytes) ->
+    C.set c N.name bytes >>=? fun c ->
+    return (C.project c, MBytes.length bytes)
+  let init_set c v =
+    let init_set c k v = C.init_set c k v >>= return in
+    consume_write_gas init_set c v >>=? fun (c, bytes) ->
+    existing_size c >>=? fun prev_size ->
+    init_set c N.name bytes >>=? fun c ->
+    return (C.project c, MBytes.length bytes - prev_size)
+  let remove c =
+    let remove c k = C.remove c k >>= return in
+    consume_remove_gas remove c >>=? fun c ->
+    existing_size c >>=? fun prev_size ->
+    remove c N.name >>=? fun c ->
+    return (C.project c, prev_size)
+  let delete c =
+    consume_remove_gas C.delete c >>=? fun c ->
+    existing_size c >>=? fun prev_size ->
+    C.delete c N.name >>=? fun c ->
+    return (C.project c, prev_size)
+  let set_option c v =
+    match v with
+    | None -> remove c
+    | Some v -> init_set c v
+end
+
 module type INDEX = sig
   type t
   val path_length: int
@@ -251,6 +368,160 @@ module Make_indexed_data_storage
 
 end
 
+module Make_indexed_carbonated_data_storage
+    (C : Raw_context.T) (I : INDEX) (V : CARBONATED_VALUE)
+  : Indexed_carbonated_data_storage with type t = C.t
+                                     and type key = I.t
+                                     and type value = V.t = struct
+  type t = C.t
+  type context = t
+  type key = I.t
+  type value = V.t
+  let name i =
+    I.to_path i []
+  let len_name i =
+    len_name (I.to_path i [])
+  let rec is_len_name = function
+    | [] | [ "" ] -> false
+    | [ last ] -> Compare.Char.(=) (String.get last (String.length last - 1)) '$'
+    | _ :: rest -> is_len_name rest
+  let consume_mem_gas c =
+    Lwt.return (C.consume_gas c (Gas_repr.read_bytes_cost Z.zero))
+  let existing_size c i =
+    match V.size with
+    | Fixed len ->
+        C.mem c (name i) >>= fun exists ->
+        if exists then return len else return 0
+    | Variable ->
+        C.get_option c (len_name i) >>= function
+        | None -> return 0
+        | Some len -> decode_len_value (name i) len
+  let consume_read_gas get c i =
+    match V.size with
+    | Fixed len ->
+        Lwt.return (C.consume_gas c (Gas_repr.read_bytes_cost (Z.of_int len)))
+    | Variable ->
+        get c (len_name i) >>=? fun len ->
+        decode_len_value (name i) len >>=? fun len ->
+        Lwt.return (C.consume_gas c (Gas_repr.read_bytes_cost (Z.of_int len)))
+  let consume_write_gas set c i v =
+    match V.size with
+    | Fixed s ->
+        Lwt.return (C.consume_gas c (Gas_repr.write_bytes_cost (Z.of_int s))) >>=? fun c ->
+        return (c, V.to_bytes v)
+    | Variable ->
+        let bytes = V.to_bytes v in
+        let len = MBytes.length bytes in
+        Lwt.return (C.consume_gas c (Gas_repr.write_bytes_cost (Z.of_int len))) >>=? fun c ->
+        set c (len_name i) (encode_len_value bytes) >>=? fun c ->
+        return (c, bytes)
+  let consume_remove_gas del c i =
+    match V.size with
+    | Fixed _ | Variable ->
+        Lwt.return (C.consume_gas c (Gas_repr.write_bytes_cost Z.zero)) >>=? fun c ->
+        del c (len_name i)
+  let mem s i =
+    consume_mem_gas s >>=? fun s ->
+    C.mem s (name i) >>= fun exists ->
+    return (C.project s, exists)
+  let get s i =
+    consume_read_gas C.get s i >>=? fun s ->
+    C.get s (name i) >>=? fun b ->
+    Lwt.return (V.of_bytes b) >>=? fun v ->
+    return (C.project s, v)
+  let get_option s i =
+    consume_mem_gas s >>=? fun s ->
+    C.mem s (name i) >>= fun exists ->
+    if exists then
+      get s i >>=? fun (s, v) ->
+      return (s, Some v)
+    else
+      return (C.project s, None)
+  let set s i v =
+    consume_write_gas C.set s i v >>=? fun (s, bytes) ->
+    existing_size s i >>=? fun prev_size ->
+    C.set s (name i) bytes >>=? fun t ->
+    return (C.project t, MBytes.length bytes - prev_size)
+  let init s i v =
+    consume_write_gas C.init s i v >>=? fun (s, bytes) ->
+    C.init s (name i) bytes >>=? fun t ->
+    return (C.project t, MBytes.length bytes)
+  let init_set s i v =
+    let init_set s i v = C.init_set s i v >>= return in
+    consume_write_gas init_set s i v >>=? fun (s, bytes) ->
+    existing_size s i >>=? fun prev_size ->
+    init_set s (name i) bytes >>=? fun t ->
+    return (C.project t, MBytes.length bytes - prev_size)
+  let remove s i =
+    let remove s i = C.remove s i >>= return in
+    consume_remove_gas remove s i >>=? fun s ->
+    existing_size s i >>=? fun prev_size ->
+    remove s (name i) >>=? fun t ->
+    return (C.project t, prev_size)
+  let delete s i =
+    consume_remove_gas C.delete s i >>=? fun s ->
+    existing_size s i >>=? fun prev_size ->
+    C.delete s (name i) >>=? fun t ->
+    return (C.project t, prev_size)
+  let set_option s i v =
+    match v with
+    | None -> remove s i
+    | Some v -> init_set s i v
+
+  let fold_keys_unaccounted s ~init ~f =
+    let rec dig s i path acc =
+      if Compare.Int.(i <= 1) then
+        C.fold s path ~init:(ok (s, acc)) ~f:begin fun k acc ->
+          Lwt.return acc >>=? fun (s, acc) ->
+          match k with
+          | `Dir _ -> return (s, acc)
+          | `Key file ->
+              if is_len_name file then
+                return (s, acc)
+              else
+                match I.of_path file with
+                | None ->
+                    fail (Raw_context.Storage_error (Corrupted_data file))
+                | Some path ->
+                    f path (s, acc)
+        end
+      else
+        C.fold s path ~init:(ok (s, acc)) ~f:begin fun k acc ->
+          Lwt.return acc >>=? fun (s, acc) ->
+          match k with
+          | `Dir k -> dig s (i-1) k acc
+          | `Key _ -> return (s, acc)
+        end in
+    dig s I.path_length [] init >>=? fun (s, acc) ->
+    return (C.project s, acc)
+
+  let fold_keys s ~init ~f =
+    let f path (s, acc) =
+      consume_mem_gas s >>=? fun s ->
+      f path (s, acc) in
+    fold_keys_unaccounted s ~init ~f
+  let clear s =
+    let f path (s, total) =
+      consume_remove_gas C.delete s path >>=? fun s ->
+      existing_size s path >>=? fun prev_size ->
+      C.delete s (name path) >>=? fun s ->
+      return (s, Z.add (Z.of_int prev_size) total) in
+    fold_keys_unaccounted s ~init:Z.zero ~f
+  let fold s ~init ~f =
+    let f path (s, acc) =
+      consume_read_gas C.get s path >>=? fun s ->
+      C.get s (name path) >>=? fun b ->
+      Lwt.return (V.of_bytes b) >>=? fun v ->
+      f path v (s, acc) in
+    fold_keys_unaccounted s ~init ~f
+  let bindings s =
+    fold s ~init:[] ~f:(fun p v (s, acc) -> return (s, (p, v) :: acc))
+  let keys s =
+    fold_keys s ~init:[] ~f:(fun p (s, acc) -> return (s, p :: acc))
+
+end
+
+
 module Make_indexed_data_snapshotable_storage (C : Raw_context.T)
     (Snapshot_index : INDEX) (I : INDEX) (V : VALUE)
   : Indexed_data_snapshotable_storage with type t = C.t
@@ -329,6 +600,7 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX)
     let fold_keys (t, i) k ~init ~f =
       C.fold_keys t (to_key i k) ~init ~f:(fun k acc -> f (of_key k) acc)
     let project (t, _) = C.project t
+    let consume_gas (t, k) c = C.consume_gas t c >>? fun t -> ok (t, k)
   end
 
   let fold_keys t ~init ~f =
@@ -477,6 +749,127 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX)
       fold_keys s ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc))
   end
 
+  module Make_carbonated_map (N : NAME) (V : CARBONATED_VALUE) = struct
+    type t = C.t
+    type context = t
+    type key = I.t
+    type value = V.t
+    let consume_mem_gas c =
+      Lwt.return (Raw_context.consume_gas c (Gas_repr.read_bytes_cost Z.zero))
+    let existing_size c =
+      match V.size with
+      | Fixed len ->
+          Raw_context.mem c N.name >>= fun exists ->
+          if exists then return len else return 0
+      | Variable ->
+          Raw_context.get_option c (len_name N.name) >>= function
+          | None -> return 0
+          | Some len -> decode_len_value N.name len
+    let consume_read_gas get c =
+      match V.size with
+      | Fixed len ->
+          Lwt.return (Raw_context.consume_gas c (Gas_repr.read_bytes_cost (Z.of_int len)))
+      | Variable ->
+          get c (len_name N.name) >>=? fun len ->
+          decode_len_value N.name len >>=? fun len ->
+          Lwt.return (Raw_context.consume_gas c (Gas_repr.read_bytes_cost (Z.of_int len)))
+    let consume_write_gas set c v =
+      match V.size with
+      | Fixed s ->
+          Lwt.return (Raw_context.consume_gas c (Gas_repr.write_bytes_cost (Z.of_int s))) >>=? fun c ->
+          return (c, V.to_bytes v)
+      | Variable ->
+          let bytes = V.to_bytes v in
+          let len = MBytes.length bytes in
+          Lwt.return (Raw_context.consume_gas c (Gas_repr.write_bytes_cost (Z.of_int len))) >>=? fun c ->
+          set c (len_name N.name) (encode_len_value bytes) >>=? fun c ->
+          return (c, bytes)
+    let consume_remove_gas del c =
+      match V.size with
+      | Fixed _ | Variable ->
+          Lwt.return (Raw_context.consume_gas c (Gas_repr.write_bytes_cost Z.zero)) >>=? fun c ->
+          del c (len_name N.name)
+    let mem s i =
+      consume_mem_gas (s, i) >>=? fun c ->
+      Raw_context.mem c N.name >>= fun res ->
+      return (Raw_context.project c, res)
+    let get s i =
+      consume_read_gas Raw_context.get (s, i) >>=? fun c ->
+      Raw_context.get c N.name >>=? fun b ->
+      Lwt.return (V.of_bytes b) >>=? fun v ->
+      return (Raw_context.project c, v)
+    let get_option s i =
+      consume_mem_gas (s, i) >>=? fun (s, _) ->
+      Raw_context.mem (s, i) N.name >>= fun exists ->
+      if exists then
+        get s i >>=? fun (s, v) ->
+        return (s, Some v)
+      else
+        return (C.project s, None)
+    let set s i v =
+      consume_write_gas Raw_context.set (s, i) v >>=? fun (c, bytes) ->
+      existing_size (s, i) >>=? fun prev_size ->
+      Raw_context.set c N.name bytes >>=? fun c ->
+      return (Raw_context.project c, MBytes.length bytes - prev_size)
+    let init s i v =
+      consume_write_gas Raw_context.init (s, i) v >>=? fun (c, bytes) ->
+      Raw_context.init c N.name bytes >>=? fun c ->
+      return (Raw_context.project c, MBytes.length bytes)
+    let init_set s i v =
+      let init_set c k v = Raw_context.init_set c k v >>= return in
+      consume_write_gas init_set (s, i) v >>=? fun (c, bytes) ->
+      existing_size c >>=? fun prev_size ->
+      init_set c N.name bytes >>=? fun c ->
+      return (Raw_context.project c, MBytes.length bytes - prev_size)
+    let remove s i =
+      let remove c k = Raw_context.remove c k >>= return in
+      consume_remove_gas remove (s, i) >>=? fun c ->
+      existing_size (s, i) >>=? fun prev_size ->
+      remove c N.name >>=? fun c ->
+      return (Raw_context.project c, prev_size)
+    let delete s i =
+      consume_remove_gas Raw_context.delete (s, i) >>=? fun c ->
+      existing_size (s, i) >>=? fun prev_size ->
+      Raw_context.delete c N.name >>=? fun c ->
+      return (Raw_context.project c, prev_size)
+    let set_option s i v =
+      match v with
+      | None -> remove s i
+      | Some v -> init_set s i v
+    let clear s =
+      fold_keys s ~init:(ok (s, Z.zero))
+        ~f:begin fun i s ->
+          Lwt.return s >>=? fun (s, total) ->
+          let remove c k = Raw_context.remove c k >>= return in
+          consume_remove_gas remove (s, i) >>=? fun (s, _) ->
+          existing_size (s, i) >>=? fun prev_size ->
+          remove (s,i) N.name >>=? fun (s, _) ->
+          return (s, Z.add total (Z.of_int prev_size))
+        end >>=? fun (s, total) ->
+      return (C.project s, total)
+    let fold s ~init ~f =
+      fold_keys s ~init:(ok (s, init))
+        ~f:(fun i acc ->
+            Lwt.return acc >>=? fun (s, acc) ->
+            consume_read_gas Raw_context.get (s, i) >>=? fun (s, _) ->
+            Raw_context.get (s, i) N.name >>=? fun b ->
+            Lwt.return (V.of_bytes b) >>=? fun v ->
+            f i v (s, acc)) >>=? fun (s, v) ->
+      return (C.project s, v)
+    let bindings s =
+      fold s ~init:[] ~f:(fun p v (c, acc) -> return (c, (p,v) :: acc))
+    let fold_keys s ~init ~f =
+      fold_keys s ~init:(ok (s, init))
+        ~f:(fun i acc ->
+            Lwt.return acc >>=? fun (s, acc) ->
+            consume_mem_gas (s, i) >>=? fun (s, _) ->
+            Raw_context.mem (s, i) N.name >>= function
+            | false -> return (s, acc)
+            | true -> f i (s, acc)) >>=? fun (s, v) ->
+      return (C.project s, v)
+    let keys s =
+      fold_keys s ~init:[] ~f:(fun p (s, acc) -> return (s, p :: acc))
+  end
 end
 
 module Wrap_indexed_data_storage

src/proto_alpha/lib_protocol/src/storage_functors.mli

@@ -18,15 +18,21 @@ end
 
 module Make_value (V : ENCODED_VALUE) : VALUE with type t = V.t
 
-module Raw_value : VALUE with type t = MBytes.t
-
 module Make_subcontext (C : Raw_context.T) (N : NAME)
   : Raw_context.T with type t = C.t
 
-module Make_single_data_storage (C : Raw_context.T) (N : NAME) (V : VALUE)
+module Make_single_data_storage
+    (C : Raw_context.T) (N : NAME) (V : VALUE)
   : Single_data_storage with type t = C.t
                          and type value = V.t
 
+module Make_carbonated_value (V : ENCODED_VALUE) : CARBONATED_VALUE with type t = V.t
+
+module Make_single_carbonated_data_storage
+    (C : Raw_context.T) (N : NAME) (V : CARBONATED_VALUE)
+  : Single_carbonated_data_storage with type t = C.t
+                                    and type value = V.t
+
 module type INDEX = sig
   type t
   val path_length: int
@@ -39,11 +45,18 @@ module Pair(I1 : INDEX)(I2 : INDEX) : INDEX with type t = I1.t * I2.t
 module Make_data_set_storage (C : Raw_context.T) (I : INDEX)
   : Data_set_storage with type t = C.t and type elt = I.t
 
-module Make_indexed_data_storage (C : Raw_context.T) (I : INDEX) (V : VALUE)
+module Make_indexed_data_storage
+    (C : Raw_context.T) (I : INDEX) (V : VALUE)
   : Indexed_data_storage with type t = C.t
                           and type key = I.t
                           and type value = V.t
 
+module Make_indexed_carbonated_data_storage
+    (C : Raw_context.T) (I : INDEX) (V : CARBONATED_VALUE)
+  : Indexed_carbonated_data_storage with type t = C.t
+                                     and type key = I.t
+                                     and type value = V.t
+
 module Make_indexed_data_snapshotable_storage (C : Raw_context.T)
     (Snapshot : INDEX) (I : INDEX) (V : VALUE)
   : Indexed_data_snapshotable_storage with type t = C.t

src/proto_alpha/lib_protocol/src/storage_sigs.ml

@@ -61,6 +61,72 @@ module type Single_data_storage = sig
 
 end
 
+(** Variant of {!Single_data_storage} with gas accounting. *)
+module type Single_carbonated_data_storage = sig
+
+  type t
+  type context = t
+
+  (** The type of the value *)
+  type value
+
+  (** Tells if the data is already defined.
+      Consumes [Gas_repr.read_bytes_cost Z.zero]. *)
+  val mem: context -> (Raw_context.t * bool) tzresult Lwt.t
+
+  (** Retrieve the value from the storage bucket ; returns a
+      {!Storage_error} if the key is not set or if the deserialisation
+      fails.
+      Consumes [Gas_repr.read_bytes_cost <size of the value>]. *)
+  val get: context -> (Raw_context.t * value) tzresult Lwt.t
+
+  (** Retrieves the value from the storage bucket ; returns [None] if
+      the data is not initialized, or {!Storage_helpers.Storage_error}
+      if the deserialisation fails.
+      Consumes [Gas_repr.read_bytes_cost <size of the value>] if present
+      or [Gas_repr.read_bytes_cost Z.zero]. *)
+  val get_option: context -> (Raw_context.t * value option) tzresult Lwt.t
+
+  (** Allocates the storage bucket and initializes it ; returns a
+      {!Storage_error Missing_key} if the bucket exists.
+      Consumes [Gas_repr.write_bytes_cost <size of the value>].
+      Returns the size. *)
+  val init: context -> value -> (Raw_context.t * int) tzresult Lwt.t
+
+  (** Updates the content of the bucket ; returns a {!Storage_Error
+      Existing_key} if the value does not exists.
+      Consumes [Gas_repr.write_bytes_cost <size of the new value>].
+      Returns the difference from the old to the new size. *)
+  val set: context -> value -> (Raw_context.t * int) tzresult Lwt.t
+
+  (** Allocates the data and initializes it with a value ; just
+      updates it if the bucket exists.
+      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 -> value -> (Raw_context.t * int) tzresult Lwt.t
+
+  (** When the value is [Some v], allocates the data and initializes
+      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 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 -> value option -> (Raw_context.t * int) tzresult Lwt.t
+
+  (** Delete the storage bucket ; returns a {!Storage_error
+      Missing_key} if the bucket does not exists.
+      Consumes [Gas_repr.write_bytes_cost Z.zero].
+      Returns the freed size. *)
+  val delete: context -> (Raw_context.t * int) tzresult Lwt.t
+
+  (** Removes the storage bucket and its contents ; does nothing if
+      the bucket does not exists.
+      Consumes [Gas_repr.write_bytes_cost Z.zero].
+      Returns the freed size. *)
+  val remove: context -> (Raw_context.t * int) tzresult Lwt.t
+
+end
+
 (** Restricted version of {!Indexed_data_storage} w/o iterators. *)
 module type Non_iterable_indexed_data_storage = sig
 
@@ -115,6 +181,76 @@ module type Non_iterable_indexed_data_storage = sig
 
 end
 
+(** Variant of {!Non_iterable_indexed_data_storage} with gas accounting. *)
+module type Non_iterable_indexed_carbonated_data_storage = sig
+
+  type t
+  type context = t
+
+  (** An abstract type for keys *)
+  type key
+
+  (** The type of values *)
+  type value
+
+  (** Tells if a given key is already bound to a storage bucket.
+      Consumes [Gas_repr.read_bytes_cost Z.zero]. *)
+  val mem: context -> key -> (Raw_context.t * bool) tzresult Lwt.t
+
+  (** Retrieve a value from the storage bucket at a given key ;
+      returns {!Storage_error Missing_key} if the key is not set ;
+      returns {!Storage_error Corrupted_data} if the deserialisation
+      fails.
+      Consumes [Gas_repr.read_bytes_cost <size of the value>]. *)
+  val get: context -> key -> (Raw_context.t * value) tzresult Lwt.t
+
+  (** Retrieve a value from the storage bucket at a given key ;
+      returns [None] if the value is not set ; returns {!Storage_error
+      Corrupted_data} if the deserialisation fails.
+      Consumes [Gas_repr.read_bytes_cost <size of the value>] if present
+      or [Gas_repr.read_bytes_cost Z.zero]. *)
+  val get_option: context -> key -> (Raw_context.t * value option) tzresult Lwt.t
+
+  (** Updates the content of a bucket ; returns A {!Storage_Error
+      Missing_key} if the value does not exists.
+      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 [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 [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
+
+  (** When the value is [Some v], allocates the data and initializes
+      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 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
+
+  (** Delete a storage bucket and its contents ; returns a
+      {!Storage_error Missing_key} if the bucket does not exists.
+      Consumes [Gas_repr.write_bytes_cost Z.zero].
+      Returns the freed size. *)
+  val delete: context -> key -> (Raw_context.t * int) tzresult Lwt.t
+
+  (** Removes a storage bucket and its contents ; does nothing if the
+      bucket does not exists.
+      Consumes [Gas_repr.write_bytes_cost Z.zero].
+      Returns the freed size. *)
+  val remove: context -> key -> (Raw_context.t * int) tzresult Lwt.t
+
+end
+
 (** The generic signature of indexed data accessors (a set of values
     of the same type indexed by keys of the same form in the
     hierarchical (key x value) database). *)
@@ -141,6 +277,43 @@ module type Indexed_data_storage = sig
 
 end
 
+(** Variant of {!Indexed_data_storage} with gas accounting. *)
+module type Indexed_carbonated_data_storage = sig
+
+  include Non_iterable_indexed_carbonated_data_storage
+
+  (** Empties all the keys and associated data.
+      Consumes [Gas_repr.read_bytes_cost Z.zero] per deleted key.
+      Returns the total freed size. *)
+  val clear: context -> (Raw_context.t * Z.t) tzresult Lwt.t
+
+  (** Lists all the keys.
+      Consumes [Gas_repr.read_bytes_cost Z.zero] per returned key. *)
+  val keys: context -> (Raw_context.t * key list) tzresult Lwt.t
+
+  (** Lists all the keys and associated data.
+      Consumes [Gas_repr.read_bytes_cost <size of the value>] per returned key. *)
+  val bindings: context -> (Raw_context.t * (key * value) list) tzresult Lwt.t
+
+  (** Iterates over all the keys and associated data present in the
+      initial context (keys added or removed during the iteration are
+      not taken into account).
+      Consumes [Gas_repr.read_bytes_cost <size of the value>] per iterated key. *)
+  val fold:
+    context -> init:'a ->
+    f:(key -> value -> (context * 'a) -> (context * 'a) tzresult Lwt.t) ->
+    (Raw_context.t * 'a) tzresult Lwt.t
+
+  (** Iterate over all the keys present in the initial context
+      (keys added or removed during the iteration are not taken into account).
+      Consumes [Gas_repr.read_bytes_cost Z.zero] per iterated key. *)
+  val fold_keys:
+    context -> init:'a ->
+    f:(key -> (context * 'a) -> (context * 'a) tzresult Lwt.t) ->
+    (Raw_context.t * 'a) tzresult Lwt.t
+
+end
+
 module type Indexed_data_snapshotable_storage = sig
   type snapshot
   type key
@@ -203,6 +376,15 @@ module type VALUE = sig
   val to_bytes: t -> MBytes.t
 end
 
+type value_size =
+  | Fixed of int
+  | Variable
+
+module type CARBONATED_VALUE = sig
+  include VALUE
+  val size: value_size
+end
+
 module type Indexed_raw_context = sig
 
   type t
@@ -226,6 +408,11 @@ module type Indexed_raw_context = sig
                             and type key = key
                             and type value = V.t
 
+  module Make_carbonated_map (N : NAME) (V : CARBONATED_VALUE)
+    : Indexed_carbonated_data_storage with type t = t
+                                       and type key = key
+                                       and type value = V.t
+
   module Raw_context : Raw_context.T with type t = t * key
 
 end