From 4aef5a9f6db03f1d4d3a5d1f5680a67fea890e08 Mon Sep 17 00:00:00 2001 From: Thomas Letan Date: Thu, 16 Mar 2023 11:34:03 +0100 Subject: [PATCH] WASM: Modify the API of the durable storage to hash any subtrees The current implementation of the durable storage forces to hash only values. We extend the API to allow to hash arbitrary subtrees. --- src/lib_scoru_wasm/durable.ml | 21 ++++++++++--- src/lib_scoru_wasm/durable.mli | 23 +++++++------- src/lib_scoru_wasm/fast/module_cache.ml | 2 +- .../test/durable_snapshot/durable.ml | 21 ++++++++++--- .../test/durable_snapshot/durable.mli | 20 ++++++------ .../test/helpers/durable_operation.ml | 26 ++++++++++++---- .../helpers/durable_operation_generator.ml | 10 +++--- .../test/helpers/durable_program_runner.ml | 6 ++-- .../test/helpers/durable_snapshot_util.ml | 31 ++++++++++--------- src/lib_scoru_wasm/wasm_vm.ml | 10 +++--- 10 files changed, 108 insertions(+), 62 deletions(-) diff --git a/src/lib_scoru_wasm/durable.ml b/src/lib_scoru_wasm/durable.ml index b79d83b40540..bfce97b469d1 100644 --- a/src/lib_scoru_wasm/durable.ml +++ b/src/lib_scoru_wasm/durable.ml @@ -169,15 +169,26 @@ let move_tree_exn tree from_key to_key = let* tree = delete tree from_key in T.add_tree tree (key_contents to_key) move_tree -let hash tree key = +let hash ~kind tree key = let open Lwt.Syntax in - let+ opt = T.find_tree tree @@ to_value_key @@ key_contents key in + let key = + match kind with + | `Value -> to_value_key (key_contents key) + | `Subtree -> key_contents key + in + let+ opt = T.find_tree tree key in Option.map (fun subtree -> T.hash subtree) opt -let hash_exn tree key = +let hash_exn ~kind tree key = let open Lwt.Syntax in - let+ opt = hash tree key in - match opt with None -> raise Value_not_found | Some hash -> hash + let+ opt = hash ~kind tree key in + match opt with + | None -> + let exn = + match kind with `Value -> Value_not_found | `Subtree -> Tree_not_found + in + raise exn + | Some hash -> hash let set_value_exn tree ?(edit_readonly = false) key str = if not edit_readonly then assert_key_writeable key ; diff --git a/src/lib_scoru_wasm/durable.mli b/src/lib_scoru_wasm/durable.mli index 9b252beb4e95..0e741208b6a9 100644 --- a/src/lib_scoru_wasm/durable.mli +++ b/src/lib_scoru_wasm/durable.mli @@ -121,17 +121,18 @@ val subtree_name_at : t -> key -> int -> string Lwt.t *) val delete : ?edit_readonly:bool -> t -> key -> t Lwt.t -(** [hash durable key] retrieves the tree hash of the value at the given [key]. - This is not the same as the hash of the value. -*) -val hash : t -> key -> Context_hash.t option Lwt.t - -(** [hash_exn durable key] retrieves the tree hash of the value at the given [key]. - This is not the same as the hash of the value. - - @raise Value_not_found when [key] is not found -*) -val hash_exn : t -> key -> Context_hash.t Lwt.t +(** [hash ~kind durable key] retrieves the tree hash of the value (if + [kind = `Value]) or the subtree ([kind = `Subtree]) at the given + [key]. This is not the same as the hash of the value. *) +val hash : kind:[`Value | `Subtree] -> t -> key -> Context_hash.t option Lwt.t + +(** [hash_exn ~kind durable key] retrieves the tree hash of the value + (if [kind = `Value]) or the subtree ([kind = `Subtree]) at the + given [key]. This is not the same as the hash of the value. + + @raise Value_not_found when [key] is not found and [kind = `Subtree] + @raise Tree_not_found when [key] is not found and [kind = `Value]. *) +val hash_exn : kind:[`Value | `Subtree] -> t -> key -> Context_hash.t Lwt.t (** [set_value_exn durable key str] installs the value [str] in [durable] under [key], replacing any previous contents under this diff --git a/src/lib_scoru_wasm/fast/module_cache.ml b/src/lib_scoru_wasm/fast/module_cache.ml index 77d5a705984c..411ce80eaad3 100644 --- a/src/lib_scoru_wasm/fast/module_cache.ml +++ b/src/lib_scoru_wasm/fast/module_cache.ml @@ -44,7 +44,7 @@ let load_parse_module store key durable = let load_module store key durable = let open Lwt.Syntax in - let* kernel_hash = Durable.hash_exn durable key in + let* kernel_hash = Durable.hash_exn ~kind:`Value durable key in let md = Kernel_cache.find_opt kernel_cache kernel_hash in match md with | None -> diff --git a/src/lib_scoru_wasm/test/durable_snapshot/durable.ml b/src/lib_scoru_wasm/test/durable_snapshot/durable.ml index 6142addc884a..f7a790f5b426 100644 --- a/src/lib_scoru_wasm/test/durable_snapshot/durable.ml +++ b/src/lib_scoru_wasm/test/durable_snapshot/durable.ml @@ -173,15 +173,26 @@ let move_tree_exn tree from_key to_key = let* tree = delete tree from_key in T.add_tree tree (key_contents to_key) move_tree -let hash tree key = +let hash ~kind tree key = let open Lwt.Syntax in - let+ opt = T.find_tree tree @@ to_value_key @@ key_contents key in + let key = + match kind with + | `Value -> to_value_key (key_contents key) + | `Subtree -> key_contents key + in + let+ opt = T.find_tree tree key in Option.map (fun subtree -> T.hash subtree) opt -let hash_exn tree key = +let hash_exn ~kind tree key = let open Lwt.Syntax in - let+ opt = hash tree key in - match opt with None -> raise Value_not_found | Some hash -> hash + let+ opt = hash ~kind tree key in + match opt with + | None -> + let exn = + match kind with `Value -> Value_not_found | `Subtree -> Tree_not_found + in + raise exn + | Some hash -> hash let set_value_exn tree ?(edit_readonly = false) key str = if not edit_readonly then assert_key_writeable key ; diff --git a/src/lib_scoru_wasm/test/durable_snapshot/durable.mli b/src/lib_scoru_wasm/test/durable_snapshot/durable.mli index 99d6e1e04ae1..f1388be09e9a 100644 --- a/src/lib_scoru_wasm/test/durable_snapshot/durable.mli +++ b/src/lib_scoru_wasm/test/durable_snapshot/durable.mli @@ -23,7 +23,7 @@ (* *) (*****************************************************************************) -(* Version of durable storage corresponding to +(* Version of durable storage initially corresponding to https://gitlab.com/tezos/tezos/-/blob/668fe735aa20ce0c68b9f836208e57fa15d389c1/src/lib_scoru_wasm/durable.mli *) @@ -125,17 +125,17 @@ val subtree_name_at : t -> key -> int -> string Lwt.t *) val delete : ?edit_readonly:bool -> t -> key -> t Lwt.t -(** [hash durable key] retrieves the tree hash of the value at the given [key]. - This is not the same as the hash of the value. -*) -val hash : t -> key -> Context_hash.t option Lwt.t +(** [hash ~kind durable key] retrieves the tree hash of the value (if + [kind = `Value]) or the subtree ([kind = `Subtree]) at the given + [key]. This is not the same as the hash of the value. *) +val hash : kind:[`Value | `Subtree] -> t -> key -> Context_hash.t option Lwt.t -(** [hash_exn durable key] retrieves the tree hash of the value at the given [key]. - This is not the same as the hash of the value. +(** [hash_exn ~kind durable key] retrieves the tree hash of the value + (if [kind = `Value]) or the subtree ([kind = `Subtree]) at the + given [key]. This is not the same as the hash of the value. - @raise Value_not_found when [key] is not found -*) -val hash_exn : t -> key -> Context_hash.t Lwt.t + @raise Value_not_found when [key] is not found *) +val hash_exn : kind:[`Value | `Subtree] -> t -> key -> Context_hash.t Lwt.t (** [set_value_exn durable key str] installs the value [str] in [durable] under [key], replacing any previous contents under this diff --git a/src/lib_scoru_wasm/test/helpers/durable_operation.ml b/src/lib_scoru_wasm/test/helpers/durable_operation.ml index 43754ba661e3..3aff540e798c 100644 --- a/src/lib_scoru_wasm/test/helpers/durable_operation.ml +++ b/src/lib_scoru_wasm/test/helpers/durable_operation.ml @@ -32,6 +32,8 @@ let key_to_str key_list = String.concat "/" ("" :: key_list) let key_len key_list = List.fold_left (fun acc seg -> String.length seg + acc + 1) 0 ("" :: key_list) +let kind_to_str = function `Value -> "Value" | `Subtree -> "Subtree" + (* GADT type, each constructor's type represents a type parameters which are taken as input of corresponding operation *) type _ operation_kind = @@ -54,9 +56,9 @@ type _ operation_kind = (* key, idx*) | Substree_name_at : (key * int) operation_kind (* key *) - | Hash : key operation_kind + | Hash : (key * [`Value | `Subtree]) operation_kind (* key *) - | Hash_exn : key operation_kind + | Hash_exn : (key * [`Value | `Subtree]) operation_kind (* edit_readonly, key, offset, value *) | Write_value_exn : (bool * key * int64 * string) operation_kind (* key, offset, len *) @@ -144,10 +146,22 @@ let pp fmt (x : t) = Substree_name_at (key_to_str key) idx - | Operation (Hash, key) -> - Format.fprintf fmt "%a(%s)" pp_operation_kind Hash (key_to_str key) - | Operation (Hash_exn, key) -> - Format.fprintf fmt "%a(%s)" pp_operation_kind Hash_exn (key_to_str key) + | Operation (Hash, (key, kind)) -> + Format.fprintf + fmt + "%a(key: %s, kind: %s)" + pp_operation_kind + Hash + (key_to_str key) + (kind_to_str kind) + | Operation (Hash_exn, (key, kind)) -> + Format.fprintf + fmt + "%a(key: %s, kind: %s)" + pp_operation_kind + Hash_exn + (key_to_str key) + (kind_to_str kind) | Operation (Write_value_exn, (edit_readonly, key, offset, _value)) -> Format.fprintf fmt diff --git a/src/lib_scoru_wasm/test/helpers/durable_operation_generator.ml b/src/lib_scoru_wasm/test/helpers/durable_operation_generator.ml index b1274cbc81e7..8a1e914d3cac 100644 --- a/src/lib_scoru_wasm/test/helpers/durable_operation_generator.ml +++ b/src/lib_scoru_wasm/test/helpers/durable_operation_generator.ml @@ -386,23 +386,25 @@ let gen_subtree_name_at trie = let gen_hash trie = let open Gen in - let+ key = + let* key = gen_key ~key_exists:Operation_probabilities.key_exists_in_read_operation ~prefix_exists:Operation_probabilities.prefix_exists_in_operation trie in - Operation (Hash, key) + let+ kind = oneofl [`Value; `Subtree] in + Operation (Hash, (key, kind)) let gen_hash_exn trie = let open Gen in - let+ key = + let* key = gen_key ~key_exists:Operation_probabilities.key_exists_in_read_operation ~prefix_exists:Operation_probabilities.prefix_exists_in_operation trie in - Operation (Hash_exn, key) + let+ kind = oneofl [`Value; `Subtree] in + Operation (Hash_exn, (key, kind)) let gen_write_value_exn trie = let open Gen in diff --git a/src/lib_scoru_wasm/test/helpers/durable_program_runner.ml b/src/lib_scoru_wasm/test/helpers/durable_program_runner.ml index ec0f8239eea8..6e79453ac42e 100644 --- a/src/lib_scoru_wasm/test/helpers/durable_program_runner.ml +++ b/src/lib_scoru_wasm/test/helpers/durable_program_runner.ml @@ -165,14 +165,16 @@ struct dur (Durable.key_of_string_exn @@ Durable_operation.key_to_str key) idx - | Operation (Hash, key) -> + | Operation (Hash, (key, kind)) -> value_res @@ Durable.hash + ~kind dur (Durable.key_of_string_exn @@ Durable_operation.key_to_str key) - | Operation (Hash_exn, key) -> + | Operation (Hash_exn, (key, kind)) -> value_res @@ Durable.hash_exn + ~kind dur (Durable.key_of_string_exn @@ Durable_operation.key_to_str key) | Operation (Write_value_exn, (edit_readonly, key, offset, value)) -> diff --git a/src/lib_scoru_wasm/test/helpers/durable_snapshot_util.ml b/src/lib_scoru_wasm/test/helpers/durable_snapshot_util.ml index d6ac91ad88fd..41b6aa7f8082 100644 --- a/src/lib_scoru_wasm/test/helpers/durable_snapshot_util.ml +++ b/src/lib_scoru_wasm/test/helpers/durable_snapshot_util.ml @@ -60,9 +60,9 @@ module type Testable_durable_sig = sig val delete : ?edit_readonly:bool -> t -> key -> t Lwt.t - val hash : t -> key -> Context_hash.t option Lwt.t + val hash : kind:[`Subtree | `Value] -> t -> key -> Context_hash.t option Lwt.t - val hash_exn : t -> key -> Context_hash.t Lwt.t + val hash_exn : kind:[`Subtree | `Value] -> t -> key -> Context_hash.t Lwt.t val set_value_exn : t -> ?edit_readonly:bool -> key -> string -> t Lwt.t @@ -369,19 +369,19 @@ end) : Testable_durable_sig with type t = Snapshot.t * Current.t = struct (fun () -> Snapshot.delete ?edit_readonly tree_s key_s) (fun () -> Current.delete ?edit_readonly tree_c key_c) - let hash (tree_s, tree_c) (key_s, key_c) = + let hash ~kind (tree_s, tree_c) (key_s, key_c) = same_values ~pp:(Fmt.option Context_hash.pp) ~eq:(Option.equal Context_hash.equal) - (fun () -> add_tree tree_s @@ Snapshot.hash tree_s key_s) - (fun () -> add_tree tree_c @@ Current.hash tree_c key_c) + (fun () -> add_tree tree_s @@ Snapshot.hash ~kind tree_s key_s) + (fun () -> add_tree tree_c @@ Current.hash ~kind tree_c key_c) - let hash_exn (tree_s, tree_c) (key_s, key_c) = + let hash_exn ~kind (tree_s, tree_c) (key_s, key_c) = same_values ~pp:Context_hash.pp ~eq:Context_hash.equal - (fun () -> add_tree tree_s @@ Snapshot.hash_exn tree_s key_s) - (fun () -> add_tree tree_c @@ Current.hash_exn tree_c key_c) + (fun () -> add_tree tree_s @@ Snapshot.hash_exn ~kind tree_s key_s) + (fun () -> add_tree tree_c @@ Current.hash_exn ~kind tree_c key_c) let set_value_exn (tree_s, tree_c) ?edit_readonly (key_s, key_c) bytes = same_trees @@ -557,16 +557,19 @@ module Traceable_durable = struct (Fun.const true) @@ fun () -> D.delete ~edit_readonly dur key - let hash dur key = - inspect_op Hash (D.Internal_for_tests.key_to_list key) Option.is_some - @@ fun () -> D.hash dur key + let hash ~kind dur key = + inspect_op + Hash + (D.Internal_for_tests.key_to_list key, kind) + Option.is_some + @@ fun () -> D.hash ~kind dur key - let hash_exn dur key = + let hash_exn ~kind dur key = inspect_op Hash_exn - (D.Internal_for_tests.key_to_list key) + (D.Internal_for_tests.key_to_list key, kind) (Fun.const true) - @@ fun () -> D.hash_exn dur key + @@ fun () -> D.hash_exn ~kind dur key let set_value_exn dur ?(edit_readonly = false) key value = inspect_op diff --git a/src/lib_scoru_wasm/wasm_vm.ml b/src/lib_scoru_wasm/wasm_vm.ml index 0df600753f17..4181fd8f701b 100644 --- a/src/lib_scoru_wasm/wasm_vm.ml +++ b/src/lib_scoru_wasm/wasm_vm.ml @@ -104,8 +104,10 @@ let mark_for_reboot {reboot_counter; durable; _} = the currently running kernel. *) let has_fallback_kernel durable = let open Lwt_syntax in - let* kernel_hash = Durable.hash durable Constants.kernel_key in - let+ fallback_hash = Durable.hash durable Constants.kernel_fallback_key in + let* kernel_hash = Durable.hash ~kind:`Value durable Constants.kernel_key in + let+ fallback_hash = + Durable.hash ~kind:`Value durable Constants.kernel_fallback_key + in Option.is_some fallback_hash && kernel_hash <> fallback_hash let initial_boot_state () = @@ -115,9 +117,9 @@ let initial_boot_state () = let save_fallback_kernel durable = let open Lwt.Syntax in - let* kernel_hash = Durable.hash durable Constants.kernel_key in + let* kernel_hash = Durable.hash ~kind:`Value durable Constants.kernel_key in let* kernel_fallback_hash = - Durable.hash durable Constants.kernel_fallback_key + Durable.hash ~kind:`Value durable Constants.kernel_fallback_key in if kernel_hash <> kernel_fallback_hash then Durable.copy_tree_exn -- GitLab