From 3bf8b524c5ab58082e50c6ff71cb83727e2ba7c3 Mon Sep 17 00:00:00 2001 From: Yoshihiro Imai Date: Wed, 21 Sep 2022 15:25:09 +0900 Subject: [PATCH 1/6] Protocol Storage: introduce Local_context for local access to Raw_context --- src/proto_alpha/lib_protocol/raw_context.ml | 110 ++++++++++++++++++ src/proto_alpha/lib_protocol/raw_context.mli | 4 +- .../lib_protocol/raw_context_intf.ml | 37 ++++++ 3 files changed, 150 insertions(+), 1 deletion(-) diff --git a/src/proto_alpha/lib_protocol/raw_context.ml b/src/proto_alpha/lib_protocol/raw_context.ml index ec772df2d097..29ca7b93275d 100644 --- a/src/proto_alpha/lib_protocol/raw_context.ml +++ b/src/proto_alpha/lib_protocol/raw_context.ml @@ -1643,3 +1643,113 @@ module Dal = struct let shards ctxt ~endorser = compute_shards ~index:0 ctxt ~endorser end + +(* The type for relative context accesses instead from the root. In order for + the carbonated storage functions to consume the gas, this has gas infomation +*) +type local_context = { + tree : tree; + path : key; + remaining_operation_gas : Gas_limit_repr.Arith.fp; + unlimited_operation_gas : bool; +} + +let with_local_context ctxt key f = + (find_tree ctxt key >|= function None -> Tree.empty ctxt | Some tree -> tree) + >>= fun tree -> + let local_ctxt = + { + tree; + path = key; + remaining_operation_gas = remaining_operation_gas ctxt; + unlimited_operation_gas = unlimited_operation_gas ctxt; + } + in + f local_ctxt >>=? fun (local_ctxt, res) -> + add_tree ctxt key local_ctxt.tree >|= fun ctxt -> + update_remaining_operation_gas ctxt local_ctxt.remaining_operation_gas + |> fun ctxt -> + update_unlimited_operation_gas ctxt local_ctxt.unlimited_operation_gas + |> fun ctxt -> ok (ctxt, res) + +module Local_context : sig + include + Raw_context_intf.VIEW + with type t = local_context + and type key := key + and type value := value + and type tree := tree + + val consume_gas : + local_context -> Gas_limit_repr.cost -> local_context tzresult + + val absolute_key : local_context -> key -> key +end = struct + type t = local_context + + let consume_gas local cost = + match Gas_limit_repr.raw_consume local.remaining_operation_gas cost with + | Some gas_counter -> Ok {local with remaining_operation_gas = gas_counter} + | None -> + if local.unlimited_operation_gas then ok local + else error Operation_quota_exceeded + + let tree local = local.tree + + let update_root_tree local tree = {local with tree} + + let absolute_key local key = local.path @ key + + let find local = Tree.find (tree local) + + let find_tree local = Tree.find_tree (tree local) + + let mem local = Tree.mem (tree local) + + let mem_tree local = Tree.mem_tree (tree local) + + let get local = Tree.get (tree local) + + let get_tree local = Tree.get_tree (tree local) + + let update local key b = + Tree.update (tree local) key b >|=? update_root_tree local + + let update_tree local key b = + Tree.update_tree (tree local) key b >|=? update_root_tree local + + let init local key b = + Tree.init (tree local) key b >|=? update_root_tree local + + let init_tree local key t = + Tree.init_tree (tree local) key t >|=? update_root_tree local + + let add local i b = Tree.add (tree local) i b >|= update_root_tree local + + let add_tree local i t = + Tree.add_tree (tree local) i t >|= update_root_tree local + + let remove local i = Tree.remove (tree local) i >|= update_root_tree local + + let remove_existing local key = + Tree.remove_existing (tree local) key >|=? update_root_tree local + + let remove_existing_tree local key = + Tree.remove_existing_tree (tree local) key >|=? update_root_tree local + + let add_or_remove local key vopt = + Tree.add_or_remove (tree local) key vopt >|= update_root_tree local + + let add_or_remove_tree local key topt = + Tree.add_or_remove_tree (tree local) key topt >|= update_root_tree local + + let fold ?depth local key ~order ~init ~f = + Tree.fold ?depth (tree local) key ~order ~init ~f + + let list local ?offset ?length key = + Tree.list (tree local) ?offset ?length key + + let config local = Tree.config (tree local) + + let length local i = Tree.length (tree local) i +end diff --git a/src/proto_alpha/lib_protocol/raw_context.mli b/src/proto_alpha/lib_protocol/raw_context.mli index cd353fa5cfcb..da8419d76d57 100644 --- a/src/proto_alpha/lib_protocol/raw_context.mli +++ b/src/proto_alpha/lib_protocol/raw_context.mli @@ -183,6 +183,8 @@ type value = bytes type tree +type local_context + module type T = Raw_context_intf.T with type root := root @@ -190,7 +192,7 @@ module type T = and type value := value and type tree := tree -include T with type t := t +include T with type t := t and type local_context := local_context (** Initialize the local nonce used for preventing a script to duplicate an internal operation to replay it. *) diff --git a/src/proto_alpha/lib_protocol/raw_context_intf.ml b/src/proto_alpha/lib_protocol/raw_context_intf.ml index f4c935c2f95f..fa4789f7c8bd 100644 --- a/src/proto_alpha/lib_protocol/raw_context_intf.ml +++ b/src/proto_alpha/lib_protocol/raw_context_intf.ml @@ -559,4 +559,41 @@ module type T = sig val check_enough_gas : t -> Gas_limit_repr.cost -> unit tzresult val description : t Storage_description.t + + (** The type for local context accesses instead from the root. In order for + the carbonated storage functions to consume the gas, this has gas + infomation *) + type local_context + + (** + [with_local_context ctxt key f] runs function [f] over the local + context at path [key] of the global [ctxt]. Using the local context [f] + can perform faster context accesses under [key]. + *) + val with_local_context : + t -> + key -> + (local_context -> (local_context * 'a) tzresult Lwt.t) -> + (t * 'a) tzresult Lwt.t + + (** [Local_context] provides functions for local access from a specific + directory. *) + module Local_context : sig + include + VIEW + with type t = local_context + and type tree := tree + and type key := key + and type value := value + + (** Internally used in {!Storage_functors} to consume gas from + within a view. May raise {!Block_quota_exceeded} or + {!Operation_quota_exceeded}. *) + val consume_gas : + local_context -> Gas_limit_repr.cost -> local_context tzresult + + (** Internally used in {!Storage_functors} to retrieve the full key of a + partial key relative to the [local_context]. *) + val absolute_key : local_context -> key -> key + end end -- GitLab From 7d842349b065a13287e7c50d3fa34788ddb4e02c Mon Sep 17 00:00:00 2001 From: Yoshihiro Imai Date: Wed, 21 Sep 2022 15:28:08 +0900 Subject: [PATCH 2/6] Protocol Storage : changes to storage_functors/storage_sigs --- .../lib_protocol/storage_functors.ml | 78 +++++++++++++++++-- src/proto_alpha/lib_protocol/storage_sigs.ml | 63 ++++++++++++++- 2 files changed, 135 insertions(+), 6 deletions(-) diff --git a/src/proto_alpha/lib_protocol/storage_functors.ml b/src/proto_alpha/lib_protocol/storage_functors.ml index 5b85863bee77..bde65c9d0273 100644 --- a/src/proto_alpha/lib_protocol/storage_functors.ml +++ b/src/proto_alpha/lib_protocol/storage_functors.ml @@ -68,9 +68,12 @@ let decode_len_value key len = | Some len -> ok len module Make_subcontext (R : REGISTER) (C : Raw_context.T) (N : NAME) : - Raw_context.T with type t = C.t = struct + Raw_context.T with type t = C.t and type local_context = C.local_context = +struct type t = C.t + type local_context = C.local_context + let to_key k = N.name @ k let mem t k = C.mem t (to_key k) @@ -142,6 +145,10 @@ module Make_subcontext (R : REGISTER) (C : Raw_context.T) (N : NAME) : Storage_description.register_named_subcontext description N.name let length = C.length + + let with_local_context ctxt k f = C.with_local_context ctxt (to_key k) f + + module Local_context = C.Local_context end module Make_single_data_storage @@ -662,7 +669,8 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) : Indexed_raw_context with type t = C.t and type key = I.t - and type 'a ipath = 'a I.ipath = struct + and type 'a ipath = 'a I.ipath + and type local_context = C.local_context = struct type t = C.t type context = t @@ -671,6 +679,8 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) : type 'a ipath = 'a I.ipath + type local_context = C.local_context + let clear t = C.remove t [] >|= fun t -> C.project t let fold_keys t ~order ~init ~f = @@ -706,9 +716,14 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) : let pack = Storage_description.pack I.args - module Raw_context : Raw_context.T with type t = C.t I.ipath = struct + module Raw_context : + Raw_context.T + with type t = C.t I.ipath + and type local_context = C.local_context = struct type t = C.t I.ipath + type local_context = C.local_context + let to_key i k = I.to_path i k let mem c k = @@ -832,8 +847,19 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) : let length c = let t, _i = unpack c in C.length t + + let with_local_context c k f = + let t, i = unpack c in + C.with_local_context t (to_key i k) f >|=? fun (t, res) -> (pack t i, res) + + module Local_context = C.Local_context end + let with_local_context s i f = + Raw_context.with_local_context (pack s i) [] f >|=? fun (c, x) -> + let s, _ = unpack c in + (s, x) + module Make_set (R : REGISTER) (N : NAME) : Data_set_storage with type t = t and type elt = key = struct type t = C.t @@ -886,8 +912,11 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) : end module Make_map (R : REGISTER) (N : NAME) (V : VALUE) : - Indexed_data_storage with type t = t and type key = key and type value = V.t = - struct + 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 type t = C.t type context = t @@ -896,6 +925,8 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) : type value = V.t + type nonrec local_context = local_context + include Make_encoder (V) let mem s i = Raw_context.mem (pack s i) N.name @@ -979,6 +1010,43 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) : find c k) (register_named_subcontext description N.name) V.encoding + + module Local = struct + type context = Raw_context.Local_context.t + + let mem local = Raw_context.Local_context.mem local N.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 + r >>? of_bytes ~key + + let find local = + Raw_context.Local_context.find local N.name >|= function + | None -> Result.return_none + | Some b -> + let key () = Raw_context.Local_context.absolute_key local N.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) + + let update local v = + Raw_context.Local_context.update local N.name (to_bytes v) + + let add local v = Raw_context.Local_context.add local N.name (to_bytes v) + + let add_or_remove local vo = + Raw_context.Local_context.add_or_remove + local + N.name + (Option.map to_bytes vo) + + let remove_existing local = + Raw_context.Local_context.remove_existing local N.name + + let remove local = Raw_context.Local_context.remove local N.name + end end module Make_carbonated_map (R : REGISTER) (N : NAME) (V : VALUE) : diff --git a/src/proto_alpha/lib_protocol/storage_sigs.ml b/src/proto_alpha/lib_protocol/storage_sigs.ml index e85da6645fc9..7654bc4f1d81 100644 --- a/src/proto_alpha/lib_protocol/storage_sigs.ml +++ b/src/proto_alpha/lib_protocol/storage_sigs.ml @@ -276,6 +276,55 @@ module type Indexed_data_storage = sig 'a Lwt.t end +module type Indexed_data_storage_with_local_context = sig + include Indexed_data_storage + + type local_context + + module Local : sig + type context = local_context + + (** Tells if the data is already defined *) + val mem : context -> bool Lwt.t + + (** Retrieves the value from the storage bucket; returns a + {!Storage_error} if the key is not set or if the deserialisation + fails *) + val get : context -> 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 *) + val find : context -> value option tzresult Lwt.t + + (** Allocates the storage bucket and initializes it ; returns a + {!Storage_error Existing_key} if the bucket exists *) + val init : context -> value -> context tzresult Lwt.t + + (** Updates the content of the bucket; returns a {!Storage_Error + Missing_key} if the value does not exist *) + val update : context -> value -> context tzresult Lwt.t + + (** Allocates the data and initializes it with a value ; just + updates it if the bucket exists *) + val add : context -> value -> context 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 + value is [None], deletes the storage bucket; it does + nothing if the bucket does not exists. *) + val add_or_remove : context -> value option -> context Lwt.t + + (** Delete the storage bucket ; returns a {!Storage_error + Missing_key} if the bucket does not exists *) + val remove_existing : context -> context tzresult Lwt.t + + (** Removes the storage bucket and its contents; does nothing if + the bucket does not exist *) + val remove : context -> context Lwt.t + end +end + module type Indexed_data_snapshotable_storage = sig type snapshot @@ -400,6 +449,8 @@ module type Indexed_raw_context = sig type 'a ipath + type local_context + val clear : context -> Raw_context.t Lwt.t val fold_keys : @@ -415,11 +466,21 @@ module type Indexed_raw_context = sig val copy : context -> from:key -> to_:key -> context tzresult Lwt.t + val with_local_context : + context -> + key -> + (local_context -> (local_context * 'a) tzresult Lwt.t) -> + (context * 'a) tzresult Lwt.t + module Make_set (_ : REGISTER) (_ : NAME) : Data_set_storage with type t = t and type elt = key module Make_map (_ : REGISTER) (_ : NAME) (V : VALUE) : - Indexed_data_storage with type t = t and type key = key and type value = V.t + 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 module Make_carbonated_map (_ : REGISTER) (_ : NAME) (V : VALUE) : Non_iterable_indexed_carbonated_data_storage -- GitLab From c349f0b6007c10d0e8a6e998be6873a35a302778 Mon Sep 17 00:00:00 2001 From: Yoshihiro Imai Date: Wed, 21 Sep 2022 15:28:43 +0900 Subject: [PATCH 3/6] Protocol Storage : changes to storage --- src/proto_alpha/lib_protocol/storage.ml | 4 ++++ src/proto_alpha/lib_protocol/storage.mli | 21 +++++++++++++++++---- 2 files changed, 21 insertions(+), 4 deletions(-) diff --git a/src/proto_alpha/lib_protocol/storage.ml b/src/proto_alpha/lib_protocol/storage.ml index 0ed27eb90751..87668addf5c0 100644 --- a/src/proto_alpha/lib_protocol/storage.ml +++ b/src/proto_alpha/lib_protocol/storage.ml @@ -188,6 +188,10 @@ module Contract = struct let list = Indexed_context.keys + type local_context = Indexed_context.local_context + + let with_local_context = Indexed_context.with_local_context + module Spendable_balance = Indexed_context.Make_map (Registered) diff --git a/src/proto_alpha/lib_protocol/storage.mli b/src/proto_alpha/lib_protocol/storage.mli index afb9deace229..c55c58d5dadc 100644 --- a/src/proto_alpha/lib_protocol/storage.mli +++ b/src/proto_alpha/lib_protocol/storage.mli @@ -69,15 +69,26 @@ module Contract : sig val list : Raw_context.t -> Contract_repr.t list Lwt.t + (** see {!Raw_context_intf.T.local_context} *) + type local_context + + (** see {!Raw_context_intf.T.with_local_context} *) + val with_local_context : + Raw_context.t -> + Contract_repr.t -> + (local_context -> (local_context * 'a) tzresult Lwt.t) -> + (Raw_context.t * 'a) tzresult Lwt.t + (** The tez possessed by a contract and that can be used. A contract may also possess tez in frozen deposits. Empty balances (of zero tez) are only allowed for originated contracts, not for implicit ones. *) module Spendable_balance : - Indexed_data_storage + Indexed_data_storage_with_local_context with type key = Contract_repr.t and type value = Tez_repr.t and type t := Raw_context.t + and type local_context := local_context (** If the value is not set, the delegate didn't miss any endorsing opportunity. If it is set, this value is a record of type @@ -99,10 +110,11 @@ module Contract : sig (** The manager of a contract *) module Manager : - Indexed_data_storage + Indexed_data_storage_with_local_context with type key = Contract_repr.t and type value = Manager_repr.t and type t := Raw_context.t + and type local_context := local_context (** The active consensus key of a delegate *) module Consensus_key : @@ -162,10 +174,11 @@ module Contract : sig and type t := Raw_context.t module Counter : - Indexed_data_storage + Indexed_data_storage_with_local_context with type key = Contract_repr.t and type value = Z.t and type t := Raw_context.t + and type local_context := local_context module Code : Non_iterable_indexed_carbonated_data_storage @@ -260,7 +273,7 @@ module Big_map : sig end module Total_bytes : - Indexed_data_storage + Indexed_data_storage_with_local_context with type key = id and type value = Z.t and type t := Raw_context.t -- GitLab From 1088661388205720c493b821c7f2c98d2e4d461a Mon Sep 17 00:00:00 2001 From: Yoshihiro Imai Date: Wed, 21 Sep 2022 15:29:58 +0900 Subject: [PATCH 4/6] Protocol Storage : tests for local context --- .../lib_protocol/test/unit/main.ml | 1 + .../test/unit/test_local_contexts.ml | 133 ++++++++++++++++++ 2 files changed, 134 insertions(+) create mode 100644 src/proto_alpha/lib_protocol/test/unit/test_local_contexts.ml diff --git a/src/proto_alpha/lib_protocol/test/unit/main.ml b/src/proto_alpha/lib_protocol/test/unit/main.ml index b79bb9239518..c7964f3314dd 100644 --- a/src/proto_alpha/lib_protocol/test/unit/main.ml +++ b/src/proto_alpha/lib_protocol/test/unit/main.ml @@ -85,5 +85,6 @@ let () = Unit_test.spec "zk rollup storage" Test_zk_rollup_storage.tests; Unit_test.spec "compare operations" Test_compare_operations.tests; Unit_test.spec "Delegate_consensus_key.ml" Test_consensus_key.tests; + Unit_test.spec "local_contexts" Test_local_contexts.tests; ] |> Lwt_main.run diff --git a/src/proto_alpha/lib_protocol/test/unit/test_local_contexts.ml b/src/proto_alpha/lib_protocol/test/unit/test_local_contexts.ml new file mode 100644 index 000000000000..a78b30f96eee --- /dev/null +++ b/src/proto_alpha/lib_protocol/test/unit/test_local_contexts.ml @@ -0,0 +1,133 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 proof ninja, Inc |=? fun alpha_ctxt -> + A.Internal_for_tests.to_raw alpha_ctxt + +(* /a/b/c *) +let dir1 = ["a"; "b"; "c"] + +module Sub = + Make_subcontext (Registered) (Raw_context) + (struct + let name = dir1 + end) + +module Index : INDEX with type t = string = struct + type t = string + + let path_length = 1 + + let to_path x l = x :: l + + let of_path = function [x] -> Some x | _ -> None + + type 'a ipath = 'a * t + + let args = + Storage_description.One + { + rpc_arg = Environment.RPC_arg.string; + encoding = Data_encoding.string; + compare; + } +end + +module Indexed_context = Make_indexed_subcontext (Sub) (Index) + +module Value : Storage_sigs.VALUE with type t = bytes = struct + type t = bytes + + let encoding = Data_encoding.bytes +end + +module C = + Indexed_context.Make_map + (Registered) + (struct + let name = ["name"] + end) + (Value) + +let eq_context ctxt1 ctxt2 = + let hash ctxt = + Raw_context.get_tree ctxt [] >|= Environment.wrap_tzresult >|=? fun root -> + Raw_context.Tree.hash root + in + hash ctxt1 >>=? fun x -> + hash ctxt2 >>=? fun y -> + Assert.equal + ~loc:__LOC__ + Context_hash.equal + "check context" + Context_hash.pp + x + y + +let write_with_local ctxt local_dir f = + Indexed_context.with_local_context ctxt local_dir (fun local -> + f local >|=? fun local -> (local, ())) + >|=? fun (ctxt, ()) -> ctxt + +let test_local_remove_existing () = + create () >>=? fun ctxt -> + let subdir = "foo" in + let value = Bytes.of_string "ABCDE" in + (* init *) + write_with_local ctxt subdir (fun local -> C.Local.init local value) + >|= Environment.wrap_tzresult + >>=? fun ctxt1 -> + C.init ctxt subdir value >|= Environment.wrap_tzresult >>=? fun ctxt2 -> + eq_context ctxt1 ctxt2 >>=? fun () -> + let ctxt = ctxt2 in + (* remove_existing *) + write_with_local ctxt subdir C.Local.remove_existing + >|= Environment.wrap_tzresult + >>=? fun ctxt1 -> + C.remove_existing ctxt subdir >|= Environment.wrap_tzresult >>=? fun ctxt2 -> + eq_context ctxt1 ctxt2 + +let tests = + [ + Tztest.tztest + "Local.remove_existing: check whether local access has the same behavior" + `Quick + test_local_remove_existing; + ] -- GitLab From 03b294c758b473a87f68c3c4ef153ad332158ba9 Mon Sep 17 00:00:00 2001 From: Yoshihiro Imai Date: Wed, 21 Sep 2022 15:30:22 +0900 Subject: [PATCH 5/6] Protocol Storage : changes to contract_storage --- src/proto_alpha/lib_protocol/contract_storage.ml | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/src/proto_alpha/lib_protocol/contract_storage.ml b/src/proto_alpha/lib_protocol/contract_storage.ml index 4e17ed75ccb6..3b712faaf2e6 100644 --- a/src/proto_alpha/lib_protocol/contract_storage.ml +++ b/src/proto_alpha/lib_protocol/contract_storage.ml @@ -441,10 +441,15 @@ let delete c contract = do not exist). An implicit contract deletion should not cost extra gas. *) Contract_delegate_storage.unlink c contract >>=? fun c -> - Storage.Contract.Spendable_balance.remove_existing c contract - >>=? fun c -> - Contract_manager_storage.remove_existing c contract >>=? fun c -> - Storage.Contract.Counter.remove_existing c contract + let update local = + Storage.Contract.Spendable_balance.Local.remove_existing local + >>=? fun local -> + Storage.Contract.Manager.Local.remove_existing local >>=? fun local -> + Storage.Contract.Counter.Local.remove_existing local + in + Storage.Contract.with_local_context c contract (fun local -> + update local >|=? fun local -> (local, ())) + >|=? fun (c, ()) -> c let allocated c contract = Storage.Contract.Spendable_balance.mem c contract -- GitLab From 934d7fa0a33b997e00a2338723a931fefc933787 Mon Sep 17 00:00:00 2001 From: Yoshihiro Imai Date: Wed, 21 Sep 2022 15:30:44 +0900 Subject: [PATCH 6/6] Protocol Storage : changelog --- docs/protocols/alpha.rst | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/docs/protocols/alpha.rst b/docs/protocols/alpha.rst index 97d6aad0dffd..97685fd0706a 100644 --- a/docs/protocols/alpha.rst +++ b/docs/protocols/alpha.rst @@ -379,4 +379,6 @@ Internal API allowing a light validation of operations. This as well as maintaining a commutative set of operations that may also be efficiently merged with another. This enables the implementation of - a parallelized shell's mempool. (MR :gl:`!6274`) + +- Introduce local context access APIs to the indexed subcontext for optimized accesses with locality. (MR :gl:`!5922`) +- Optimized cleaning of implicit contract with 0 balance using local context accesses (MR :gl:`!5922`) -- GitLab