From 9352c4ce423b5aa060e16a0884ec25dfdf6d96b4 Mon Sep 17 00:00:00 2001 From: Nicolas Ayache Date: Tue, 27 Sep 2022 16:13:54 +0200 Subject: [PATCH 1/6] Proto: parameterized Make_map with data access. We will instantiate it differently whether its for an uncarbonated or a carbonated map. --- .../lib_protocol/storage_functors.ml | 77 ++++++++++++------- 1 file changed, 48 insertions(+), 29 deletions(-) diff --git a/src/proto_alpha/lib_protocol/storage_functors.ml b/src/proto_alpha/lib_protocol/storage_functors.ml index bde65c9d0273..2ca290be82ba 100644 --- a/src/proto_alpha/lib_protocol/storage_functors.ml +++ b/src/proto_alpha/lib_protocol/storage_functors.ml @@ -275,6 +275,10 @@ module Make_data_set_storage (C : Raw_context.T) (I : INDEX) : Data_encoding.bool end +module type DATA_NAME = sig + val data_name : string list +end + 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 = struct @@ -911,12 +915,8 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) : Data_encoding.bool end - module Make_map (R : REGISTER) (N : NAME) (V : VALUE) : - Indexed_data_storage_with_local_context - with type t = t - and type key = key - and type value = V.t - and type local_context = local_context = struct + module Make_map_param (D : DATA_NAME) (R : REGISTER) (N : NAME) (V : VALUE) = + struct type t = C.t type context = t @@ -927,56 +927,58 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) : type nonrec local_context = local_context + let data_name = D.data_name @ N.name + include Make_encoder (V) - let mem s i = Raw_context.mem (pack s i) N.name + let mem s i = Raw_context.mem (pack s i) data_name let get s i = - Raw_context.get (pack s i) N.name >>=? fun b -> - let key () = Raw_context.absolute_key (pack s i) N.name in + Raw_context.get (pack s i) data_name >>=? fun b -> + let key () = Raw_context.absolute_key (pack s i) data_name in Lwt.return (of_bytes ~key b) let find s i = - Raw_context.find (pack s i) N.name >|= function + Raw_context.find (pack s i) data_name >|= function | None -> Result.return_none | Some b -> - let key () = Raw_context.absolute_key (pack s i) N.name in + let key () = Raw_context.absolute_key (pack s i) data_name in of_bytes ~key b >|? fun v -> Some v let update s i v = - Raw_context.update (pack s i) N.name (to_bytes v) >|=? fun c -> + Raw_context.update (pack s i) data_name (to_bytes v) >|=? fun c -> let s, _ = unpack c in C.project s let init s i v = - Raw_context.init (pack s i) N.name (to_bytes v) >|=? fun c -> + Raw_context.init (pack s i) data_name (to_bytes v) >|=? fun c -> let s, _ = unpack c in C.project s let add s i v = - Raw_context.add (pack s i) N.name (to_bytes v) >|= fun c -> + Raw_context.add (pack s i) data_name (to_bytes v) >|= fun c -> let s, _ = unpack c in C.project s let add_or_remove s i v = - Raw_context.add_or_remove (pack s i) N.name (Option.map to_bytes v) + Raw_context.add_or_remove (pack s i) data_name (Option.map to_bytes v) >|= fun c -> let s, _ = unpack c in C.project s let remove s i = - Raw_context.remove (pack s i) N.name >|= fun c -> + Raw_context.remove (pack s i) data_name >|= fun c -> let s, _ = unpack c in C.project s let remove_existing s i = - Raw_context.remove_existing (pack s i) N.name >|=? fun c -> + Raw_context.remove_existing (pack s i) data_name >|=? fun c -> let s, _ = unpack c in C.project s let clear s = fold_keys s ~order:`Sorted ~init:s ~f:(fun i s -> - Raw_context.remove (pack s i) N.name >|= fun c -> + Raw_context.remove (pack s i) data_name >|= fun c -> let s, _ = unpack c in s) >|= fun t -> C.project t @@ -1014,41 +1016,58 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) : module Local = struct type context = Raw_context.Local_context.t - let mem local = Raw_context.Local_context.mem local N.name + let mem local = Raw_context.Local_context.mem local data_name let get local = - Raw_context.Local_context.get local N.name >|= fun r -> - let key () = Raw_context.Local_context.absolute_key local N.name in + Raw_context.Local_context.get local data_name >|= fun r -> + let key () = Raw_context.Local_context.absolute_key local data_name in r >>? of_bytes ~key let find local = - Raw_context.Local_context.find local N.name >|= function + Raw_context.Local_context.find local data_name >|= function | None -> Result.return_none | Some b -> - let key () = Raw_context.Local_context.absolute_key local N.name in + let key () = + Raw_context.Local_context.absolute_key local data_name + in of_bytes ~key b >|? fun v -> Some v let init local v = - Raw_context.Local_context.init local N.name (to_bytes v) + Raw_context.Local_context.init local data_name (to_bytes v) let update local v = - Raw_context.Local_context.update local N.name (to_bytes v) + Raw_context.Local_context.update local data_name (to_bytes v) - let add local v = Raw_context.Local_context.add local N.name (to_bytes v) + let add local v = + Raw_context.Local_context.add local data_name (to_bytes v) let add_or_remove local vo = Raw_context.Local_context.add_or_remove local - N.name + data_name (Option.map to_bytes vo) let remove_existing local = - Raw_context.Local_context.remove_existing local N.name + Raw_context.Local_context.remove_existing local data_name - let remove local = Raw_context.Local_context.remove local N.name + let remove local = Raw_context.Local_context.remove local data_name end end + module Make_map (R : REGISTER) (N : NAME) (V : VALUE) : + Indexed_data_storage_with_local_context + with type t = t + and type key = key + and type value = V.t + and type local_context = local_context = + Make_map_param + (struct + let data_name = [] + end) + (R) + (N) + (V) + module Make_carbonated_map (R : REGISTER) (N : NAME) (V : VALUE) : Non_iterable_indexed_carbonated_data_storage with type t = t -- GitLab From 92edad98fb49376abf4cff616312b18b0f0fe265 Mon Sep 17 00:00:00 2001 From: Nicolas Ayache Date: Tue, 27 Sep 2022 16:21:58 +0200 Subject: [PATCH 2/6] Proto: parameterized Make_carbonated_map with data access. This is not mandatory, but we want to keep it synchronized with the one in Make_map when they're going to be used together, so it's less error prone like this. --- .../lib_protocol/storage_functors.ml | 26 ++++++++++++++----- 1 file changed, 20 insertions(+), 6 deletions(-) diff --git a/src/proto_alpha/lib_protocol/storage_functors.ml b/src/proto_alpha/lib_protocol/storage_functors.ml index 2ca290be82ba..928936b494ca 100644 --- a/src/proto_alpha/lib_protocol/storage_functors.ml +++ b/src/proto_alpha/lib_protocol/storage_functors.ml @@ -1068,11 +1068,12 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) : (N) (V) - module Make_carbonated_map (R : REGISTER) (N : NAME) (V : VALUE) : - Non_iterable_indexed_carbonated_data_storage - with type t = t - and type key = key - and type value = V.t = struct + module Make_carbonated_map_param + (D : DATA_NAME) + (R : REGISTER) + (N : NAME) + (V : VALUE) = + struct type t = C.t type context = t @@ -1085,7 +1086,7 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) : let len_name = len_name :: N.name - let data_name = data_name :: N.name + let data_name = D.data_name @ N.name let consume_mem_gas c = let path_length = List.length (Raw_context.absolute_key c N.name) + 1 in @@ -1198,6 +1199,19 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) : (register_named_subcontext description N.name) V.encoding end + + module Make_carbonated_map (R : REGISTER) (N : NAME) (V : VALUE) : + Non_iterable_indexed_carbonated_data_storage + with type t = t + and type key = key + and type value = V.t = + Make_carbonated_map_param + (struct + let data_name = [data_name] + end) + (R) + (N) + (V) end module type WRAPPER = sig -- GitLab From 9acd1f8fa218486a89b5f0a2f0865ef8c664be19 Mon Sep 17 00:00:00 2001 From: Nicolas Ayache Date: Wed, 28 Sep 2022 10:16:08 +0200 Subject: [PATCH 3/6] Proto: maps with carbonated and uncarbonated functions, internally. It will be exposed in the next commit. Also, the top-level behavior of carbonated maps has been removed because it's already exactly the same in uncarbonated maps, and the latter is always instantiated when a carbonated map is instantiated. --- .../lib_protocol/storage_functors.ml | 39 +++++++++---------- 1 file changed, 18 insertions(+), 21 deletions(-) diff --git a/src/proto_alpha/lib_protocol/storage_functors.ml b/src/proto_alpha/lib_protocol/storage_functors.ml index 928936b494ca..5bb3a000f9ad 100644 --- a/src/proto_alpha/lib_protocol/storage_functors.ml +++ b/src/proto_alpha/lib_protocol/storage_functors.ml @@ -1184,34 +1184,31 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) : let keys_unaccounted s = fold_keys_unaccounted s ~order:`Sorted ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc)) + end - let () = - let open Storage_description in - let unpack = unpack I.args in - let description = - if R.ghost then Storage_description.create () - else Raw_context.description - in - register_value - ~get:(fun c -> - let c, k = unpack c in - find c k >|=? fun (_, v) -> v) - (register_named_subcontext description N.name) - V.encoding + module Make_carbonated_map_with_uncarbonated_accesses_INTERNAL + (R : REGISTER) + (N : NAME) + (V : VALUE) = + struct + module D = struct + let data_name = [data_name] + end + + include Make_map_param (D) (R) (N) (V) + module Carbonated = Make_carbonated_map_param (D) (R) (N) (V) end module Make_carbonated_map (R : REGISTER) (N : NAME) (V : VALUE) : Non_iterable_indexed_carbonated_data_storage with type t = t and type key = key - and type value = V.t = - Make_carbonated_map_param - (struct - let data_name = [data_name] - end) - (R) - (N) - (V) + and type value = V.t = struct + module M = + Make_carbonated_map_with_uncarbonated_accesses_INTERNAL (R) (N) (V) + + include M.Carbonated + end end module type WRAPPER = sig -- GitLab From 3a69c1711fdd3d696a863957cad4d89a85f5eac0 Mon Sep 17 00:00:00 2001 From: Nicolas Ayache Date: Tue, 27 Sep 2022 16:39:58 +0200 Subject: [PATCH 4/6] Proto: add storage signatures. Implementing functors are coming next. --- src/proto_alpha/lib_protocol/storage_sigs.ml | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/src/proto_alpha/lib_protocol/storage_sigs.ml b/src/proto_alpha/lib_protocol/storage_sigs.ml index 7654bc4f1d81..2be1f4bfb7de 100644 --- a/src/proto_alpha/lib_protocol/storage_sigs.ml +++ b/src/proto_alpha/lib_protocol/storage_sigs.ml @@ -325,6 +325,26 @@ module type Indexed_data_storage_with_local_context = sig end end +module type Carbonated_data_storage_with_uncarbonated_accesses = sig + include Indexed_data_storage + + module Carbonated : + Non_iterable_indexed_carbonated_data_storage + with type key := key + and type value := value + and type t := t +end + +module type Carbonated_data_storage_with_uncarbonated_accesses_and_local_context = sig + include Indexed_data_storage_with_local_context + + module Carbonated : + Non_iterable_indexed_carbonated_data_storage + with type key := key + and type value := value + and type t := t +end + module type Indexed_data_snapshotable_storage = sig type snapshot -- GitLab From 16f9b93da825de6f3ea4fc2aa4cf00fec72d331b Mon Sep 17 00:00:00 2001 From: Nicolas Ayache Date: Wed, 28 Sep 2022 10:55:09 +0200 Subject: [PATCH 5/6] Proto: maps with carbonated and uncarbonated functions. --- .../lib_protocol/storage_functors.ml | 21 +++++++++++++++++++ src/proto_alpha/lib_protocol/storage_sigs.ml | 19 +++++++++++++++++ 2 files changed, 40 insertions(+) diff --git a/src/proto_alpha/lib_protocol/storage_functors.ml b/src/proto_alpha/lib_protocol/storage_functors.ml index 5bb3a000f9ad..732972dcd1c5 100644 --- a/src/proto_alpha/lib_protocol/storage_functors.ml +++ b/src/proto_alpha/lib_protocol/storage_functors.ml @@ -1209,6 +1209,27 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) : include M.Carbonated end + + module Make_carbonated_map_with_uncarbonated_accesses + (R : REGISTER) + (N : NAME) + (V : VALUE) : + Carbonated_data_storage_with_uncarbonated_accesses + with type t = t + and type key = key + and type value = V.t = + Make_carbonated_map_with_uncarbonated_accesses_INTERNAL (R) (N) (V) + + module Make_carbonated_map_with_uncarbonated_accesses_and_local_context + (R : REGISTER) + (N : NAME) + (V : VALUE) : + Carbonated_data_storage_with_uncarbonated_accesses_and_local_context + with type t = t + and type key = key + and type value = V.t + and type local_context = local_context = + Make_carbonated_map_with_uncarbonated_accesses_INTERNAL (R) (N) (V) end module type WRAPPER = sig diff --git a/src/proto_alpha/lib_protocol/storage_sigs.ml b/src/proto_alpha/lib_protocol/storage_sigs.ml index 2be1f4bfb7de..83d3bd48a9c6 100644 --- a/src/proto_alpha/lib_protocol/storage_sigs.ml +++ b/src/proto_alpha/lib_protocol/storage_sigs.ml @@ -508,5 +508,24 @@ module type Indexed_raw_context = sig and type key = key and type value = V.t + module Make_carbonated_map_with_uncarbonated_accesses + (_ : REGISTER) + (_ : NAME) + (V : VALUE) : + Carbonated_data_storage_with_uncarbonated_accesses + with type t = t + and type key = key + and type value = V.t + + module Make_carbonated_map_with_uncarbonated_accesses_and_local_context + (_ : REGISTER) + (_ : NAME) + (V : VALUE) : + Carbonated_data_storage_with_uncarbonated_accesses_and_local_context + with type t = t + and type key = key + and type value = V.t + and type local_context = local_context + module Raw_context : Raw_context.T with type t = t ipath end -- GitLab From fe9f21a263ffff532306352c77937d6dc7a8653e Mon Sep 17 00:00:00 2001 From: Nicolas Ayache Date: Wed, 28 Sep 2022 14:05:32 +0200 Subject: [PATCH 6/6] Proto: refactor keys_unaccounted. Because keys_unaccounted from carbonated maps is exactly keys from uncarbonated maps. --- .../lib_protocol/storage_functors.ml | 19 ++++++------------- 1 file changed, 6 insertions(+), 13 deletions(-) diff --git a/src/proto_alpha/lib_protocol/storage_functors.ml b/src/proto_alpha/lib_protocol/storage_functors.ml index 732972dcd1c5..25c5c333bf4f 100644 --- a/src/proto_alpha/lib_protocol/storage_functors.ml +++ b/src/proto_alpha/lib_protocol/storage_functors.ml @@ -1172,18 +1172,6 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) : let add_or_remove s i v = match v with None -> remove s i | Some v -> add s i v - - let mem_unaccounted s i = Raw_context.mem (pack s i) data_name - - let fold_keys_unaccounted s ~order ~init ~f = - fold_keys s ~order ~init ~f:(fun i acc -> - mem_unaccounted s i >>= function - | false -> Lwt.return acc - | true -> f i acc) - - let keys_unaccounted s = - fold_keys_unaccounted s ~order:`Sorted ~init:[] ~f:(fun p acc -> - Lwt.return (p :: acc)) end module Make_carbonated_map_with_uncarbonated_accesses_INTERNAL @@ -1196,7 +1184,12 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) : end include Make_map_param (D) (R) (N) (V) - module Carbonated = Make_carbonated_map_param (D) (R) (N) (V) + + module Carbonated = struct + include Make_carbonated_map_param (D) (R) (N) (V) + + let keys_unaccounted = keys + end end module Make_carbonated_map (R : REGISTER) (N : NAME) (V : VALUE) : -- GitLab