diff --git a/src/proto_alpha/lib_protocol/src/raw_context.ml b/src/proto_alpha/lib_protocol/src/raw_context.ml index ee7b8b7ed..b5f0d1a5a 100644 --- a/src/proto_alpha/lib_protocol/src/raw_context.ml +++ b/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 diff --git a/src/proto_alpha/lib_protocol/src/raw_context.mli b/src/proto_alpha/lib_protocol/src/raw_context.mli index b5a8b0b24..2c3875534 100644 --- a/src/proto_alpha/lib_protocol/src/raw_context.mli +++ b/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 diff --git a/src/proto_alpha/lib_protocol/src/storage_functors.ml b/src/proto_alpha/lib_protocol/src/storage_functors.ml index 18ae22508..00a5311e4 100644 --- a/src/proto_alpha/lib_protocol/src/storage_functors.ml +++ b/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 - type t = MBytes.t - let of_bytes b = ok b - let to_bytes b = b +module Make_carbonated_value (V : ENCODED_VALUE) = struct + type t = V.t + let of_bytes 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 diff --git a/src/proto_alpha/lib_protocol/src/storage_functors.mli b/src/proto_alpha/lib_protocol/src/storage_functors.mli index dafb3836a..3023fb7bd 100644 --- a/src/proto_alpha/lib_protocol/src/storage_functors.mli +++ b/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 diff --git a/src/proto_alpha/lib_protocol/src/storage_sigs.ml b/src/proto_alpha/lib_protocol/src/storage_sigs.ml index 31950da55..178352db0 100644 --- a/src/proto_alpha/lib_protocol/src/storage_sigs.ml +++ b/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 ]. *) + 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 ] 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 ]. + 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 ]. + 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 ]. + 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 ]. *) + 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 ] 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 ]. + 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 ]. + 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 ]. + 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 ] 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 ] 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