From b05e8c42b317d164f6962f6f932ce611c7810973 Mon Sep 17 00:00:00 2001 From: Ilya Peresadin Date: Wed, 29 Mar 2023 14:52:58 +0100 Subject: [PATCH 1/2] Scoru: Replace irmin durable with in-memory durable implementation --- src/bin_wasm_debugger/commands.ml | 4 +- .../immutable_chunked_byte_vector.ml | 8 + .../immutable_chunked_byte_vector.mli | 3 + src/lib_lazy_containers/lazy_dirs.ml | 84 ++++++ src/lib_lazy_containers/lazy_dirs.mli | 80 ++++++ src/lib_lazy_containers/lazy_fs.ml | 165 ++++++++++++ src/lib_lazy_containers/lazy_fs.mli | 81 ++++++ src/lib_lazy_containers/lazy_map.mli | 6 +- src/lib_scoru_wasm/durable.ml | 244 +++++++++++------- src/lib_scoru_wasm/durable.mli | 11 +- src/lib_scoru_wasm/fast/module_cache.ml | 4 +- src/lib_scoru_wasm/helpers/wasm_utils.ml | 9 +- src/lib_scoru_wasm/host_funcs.ml | 4 +- .../test/durable_snapshot/durable.ml | 7 - .../test/durable_snapshot/durable.mli | 8 - .../test/helpers/durable_program_runner.ml | 26 +- .../test/helpers/durable_snapshot_util.ml | 36 ++- .../test/test_durable_shapshot.ml | 4 +- .../test/test_durable_storage.ml | 42 +-- src/lib_scoru_wasm/test/test_get_set.ml | 22 +- src/lib_scoru_wasm/test/test_reveal.ml | 2 +- src/lib_scoru_wasm/test/test_wasm_pvm.ml | 24 +- src/lib_scoru_wasm/wasm_vm.ml | 7 +- src/lib_tree_encoding/decoding.ml | 28 +- src/lib_tree_encoding/decoding.mli | 12 +- src/lib_tree_encoding/encoding.ml | 12 +- src/lib_tree_encoding/encoding.mli | 5 + src/lib_tree_encoding/tezos_tree_encoding.ml | 112 +++++++- src/lib_tree_encoding/tezos_tree_encoding.mli | 83 +++--- .../runtime/durable_storage.ml | 5 +- .../runtime/durable_storage.mli | 16 +- .../lib_sc_rollup_node/wasm_2_0_0_pvm.ml | 8 +- .../lib_sc_rollup_node/wasm_2_0_0_pvm.ml | 8 +- .../lib_sc_rollup_node/wasm_2_0_0_pvm.ml | 8 +- 34 files changed, 935 insertions(+), 243 deletions(-) create mode 100644 src/lib_lazy_containers/lazy_dirs.ml create mode 100644 src/lib_lazy_containers/lazy_dirs.mli create mode 100644 src/lib_lazy_containers/lazy_fs.ml create mode 100644 src/lib_lazy_containers/lazy_fs.mli diff --git a/src/bin_wasm_debugger/commands.ml b/src/bin_wasm_debugger/commands.ml index 881d0aabcbf3..2b96b27d9716 100644 --- a/src/bin_wasm_debugger/commands.ml +++ b/src/bin_wasm_debugger/commands.ml @@ -509,7 +509,9 @@ let show_key_gen tree key kind = Format.printf "Key not found\n%!" ; return_unit | Some v -> - let+ str_value = Tezos_lazy_containers.Chunked_byte_vector.to_string v in + let+ str_value = + Tezos_lazy_containers.Immutable_chunked_byte_vector.to_string v + in Format.printf "%s\n%!" @@ show_value kind str_value (* [show_key tree key] looks for the given [key] in the durable storage and diff --git a/src/lib_lazy_containers/immutable_chunked_byte_vector.ml b/src/lib_lazy_containers/immutable_chunked_byte_vector.ml index cebbb5441c0f..8a2e068c07b1 100644 --- a/src/lib_lazy_containers/immutable_chunked_byte_vector.ml +++ b/src/lib_lazy_containers/immutable_chunked_byte_vector.ml @@ -309,3 +309,11 @@ end module Encoding = Tezos_tree_encoding.CBV_encoding.Make (Enc_intf) let encoding = Encoding.cbv Chunk.encoding + +let to_chunked_byte_vector v = + Chunked_byte_vector.create + ?origin:(origin v) + ~get_chunk:(fun i -> + Lwt.map (fun x -> Chunked_byte_vector.Chunk.of_bytes @@ Bytes.of_string x) + @@ get_chunk i v) + v.length diff --git a/src/lib_lazy_containers/immutable_chunked_byte_vector.mli b/src/lib_lazy_containers/immutable_chunked_byte_vector.mli index 2c4d1b1e04a1..7361c6485647 100644 --- a/src/lib_lazy_containers/immutable_chunked_byte_vector.mli +++ b/src/lib_lazy_containers/immutable_chunked_byte_vector.mli @@ -127,3 +127,6 @@ val loaded_chunks : t -> (int64 * Chunk.t option) list (** [encoding] is a [Tezos_tree_encoding] for [t]. *) val encoding : t Tezos_tree_encoding.t + +(** [to_chunked_byte_vector cbv] converts [t] to [Chunked_byte_vector.t] *) +val to_chunked_byte_vector : t -> Chunked_byte_vector.t diff --git a/src/lib_lazy_containers/lazy_dirs.ml b/src/lib_lazy_containers/lazy_dirs.ml new file mode 100644 index 000000000000..6df835f0d720 --- /dev/null +++ b/src/lib_lazy_containers/lazy_dirs.ml @@ -0,0 +1,84 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2023 TriliTech *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +module Names = Set.Make (String) + +module Map = Lazy_map.Make (struct + include String + + let to_string = Fun.id +end) + +type 'a t = {names : Names.t; contents : 'a Map.t} + +let origin fs = Map.origin @@ fs.contents + +let create ?names ?contents () = + let lazy_value x ~default = match x with Some x -> x | None -> default () in + { + names = + lazy_value names ~default:(fun () -> + match contents with + | None -> Names.empty + | Some contents -> + Map.loaded_bindings contents |> List.map fst |> Names.of_list); + contents = lazy_value contents ~default:Map.create; + } + +let is_empty {names; _} = Names.is_empty names + +let find tree key = + let open Lwt.Syntax in + if Names.mem key tree.names then + let+ content = Map.get key tree.contents in + Some content + else Lwt.return_none + +let set tree key value = + {names = Names.add key tree.names; contents = Map.set key value tree.contents} + +let remove tree key = + {names = Names.remove key tree.names; contents = Map.remove key tree.contents} + +let list tree = Names.elements tree.names + +let length tree = Names.cardinal tree.names + +let nth_name tree n = List.nth_opt (Names.elements tree.names) n + +module Encoding = Tezos_tree_encoding.Lazy_dirs_encoding.Make (struct + type nonrec 'a t = 'a t + + module Names = Names + module Map = Map + + let contents x = x.contents + + let create = create + + let remove = remove +end) + +let encoding = Encoding.lazy_dirs diff --git a/src/lib_lazy_containers/lazy_dirs.mli b/src/lib_lazy_containers/lazy_dirs.mli new file mode 100644 index 000000000000..f116ea1951ac --- /dev/null +++ b/src/lib_lazy_containers/lazy_dirs.mli @@ -0,0 +1,80 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2023 TriliTech *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** + This module is basically a wrapper around [Lazy_map] with key instantiated to string + that eagerly loads map's keys (but not values) during decoding. + For the more information see [Tezos_tree_encoding.Lazy_dirs_encoding]. + This behaviour resembles how folders on an OS shown. +*) + +(** This module is to work with keys. *) +module Names : Set.S with type elt = String.t + +(** This module is to work with the underlying lazy map holding content. *) +module Map : Lazy_map.S with type key = String.t + +type 'a t = {names : Names.t; contents : 'a Map.t} + +(** [origin dirs] returns the tree of origin of the container, if it exists. *) +val origin : 'a t -> Tezos_tree_encoding.wrapped_tree option + +(** [create names contents] creates lazy dirs. + If [names] is not provided then [Map.loaded_bindings contents] used to initialise names. + If [contents] is not provided as well then empty lazy_dirs will be created. + It is responsibility of the caller to supply consistent [names] and [contents], + for instance, [names] has to be subset of keys of [contents]. +*) +val create : ?names:Names.t -> ?contents:'a Map.t -> unit -> 'a t + +(** [is_empty dirs] returns true if the container is empty, + Relies on size of underlying names. *) +val is_empty : 'a t -> bool + +(** [find dirs key] retrieves the element at [key]. *) +val find : 'a t -> Names.elt -> 'a option Lwt.t + +(** [set dirs key value] sets the element at [key] to [value]. *) +val set : 'a t -> Names.elt -> 'a -> 'a t + +(** [remove dirs key] marks the element at [key] as removed, + this will be synced with the origin during encoding. *) +val remove : 'a t -> Names.elt -> 'a t + +(** [list dirs] lists all the keys in alphabetically sorted order. *) +val list : 'a t -> Names.elt list + +(** [length dirs] returns number of elements. *) +val length : 'a t -> int + +(** [nth_name dirs index] returns [index]-th key. + Aligns with the order of keys of [list]. +*) +val nth_name : 'a t -> int -> Names.elt option + +(** [encoding value_enc] returns an encoding for the container wrt + encoding of the value [value_enc] +*) +val encoding : 'a Tezos_tree_encoding.t -> 'a t Tezos_tree_encoding.t diff --git a/src/lib_lazy_containers/lazy_fs.ml b/src/lib_lazy_containers/lazy_fs.ml new file mode 100644 index 000000000000..253ae635d1ed --- /dev/null +++ b/src/lib_lazy_containers/lazy_fs.ml @@ -0,0 +1,165 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2023 TriliTech *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type tree_source = Origin | From_parent + +type 'a t = { + content : 'a option; + dirs : 'a t Lazy_dirs.t; + parent_origin : Tezos_tree_encoding.wrapped_tree; +} + +let origin t = Lazy_dirs.origin t.dirs + +let tree_instance t = + Option.fold + ~none:(t.parent_origin, From_parent) + ~some:(fun org -> (org, Origin)) + (origin t) + +let create_with_empty_dirs content parent_origin = + let dirs = Lazy_dirs.create () in + {content; dirs; parent_origin} + +let rec find_tree tree key = + let open Lwt.Syntax in + match key with + | [] -> Lwt.return_some tree + | step :: steps -> ( + let* maybe_tree = Lazy_dirs.find tree.dirs step in + match maybe_tree with + | Some tree -> find_tree tree steps + | None -> Lwt.return_none) + +let find tree key = + let open Lwt.Syntax in + let+ tree = find_tree tree key in + Option.map (fun tree -> tree.content) tree |> Option.join + +let rec construct_new_tree parent_origin key value_tree = + match key with + | [] -> value_tree + | step :: steps -> + let contents = + Lazy_dirs.Map.( + create + ~values: + (Map.singleton + step + (construct_new_tree parent_origin steps value_tree)) + ()) + in + let dirs = Lazy_dirs.create ~contents () in + {content = None; dirs; parent_origin} + +let rec place_tree tree key f = + let open Lwt.Syntax in + match key with + | [] -> Lwt.return (f (Some tree)) + | step :: steps -> ( + let* maybe_tree = Lazy_dirs.find tree.dirs step in + match maybe_tree with + | Some sub_tree -> + let+ new_tree = place_tree sub_tree steps f in + let dirs = Lazy_dirs.set tree.dirs step new_tree in + {tree with dirs} + | None -> + let dirs = + Lazy_dirs.set + tree.dirs + step + (construct_new_tree tree.parent_origin steps (f None)) + in + Lwt.return {tree with dirs}) + +let add_tree tree key value_tree = place_tree tree key (fun _ -> value_tree) + +let set tree key value = + place_tree tree key @@ function + | None -> create_with_empty_dirs (Some value) tree.parent_origin + | Some tree -> {tree with content = Some value} + +let remove_value tree key = + place_tree tree key @@ function + | None -> create_with_empty_dirs None tree.parent_origin + | Some tree -> {tree with content = None} + +let rec remove tree key = + let open Lwt.Syntax in + match key with + | [] -> Lwt.return tree + | [step] -> Lwt.return {tree with dirs = Lazy_dirs.remove tree.dirs step} + | step :: steps -> ( + let* maybe_tree = Lazy_dirs.find tree.dirs step in + match maybe_tree with + | Some sub_tree -> + let is_empty {content; dirs; _} = + Option.is_none content && Lazy_dirs.is_empty dirs + in + let+ new_subtree = remove sub_tree steps in + if is_empty new_subtree then + (* We remove new_subtree from tree, it shouldn't dangle *) + let tree = {tree with dirs = Lazy_dirs.remove tree.dirs step} in + if is_empty tree then + (* If [step] was the only child of [tree] and [tree] has no value, + then we should remove current node as well *) + create_with_empty_dirs None sub_tree.parent_origin + else + (* If [new_tree] is empty: we don't need to store it anymore *) + tree + else + (* Otherwise, just replace old k with new one*) + {tree with dirs = Lazy_dirs.set tree.dirs step new_subtree} + | None -> Lwt.return tree) + +let count_subtrees tree = Lazy_dirs.length tree.dirs + +let list_subtrees tree = Lazy_dirs.list tree.dirs + +let nth_name tree n = if n < 0 then None else Lazy_dirs.nth_name tree.dirs n + +module Encoding = Tezos_tree_encoding.Lazy_fs_encoding.Make (struct + type nonrec 'a t = 'a t + + module Dirs = struct + include Lazy_dirs + + let contents x = x.contents + end + + let dirs x = x.dirs + + let content x = x.content + + let create ?value ?dirs origin = + { + content = value; + dirs = (match dirs with None -> Lazy_dirs.create () | Some dirs -> dirs); + (* Not exactly parent origin but ours *) + parent_origin = origin; + } +end) + +let encoding = Encoding.lazy_fs diff --git a/src/lib_lazy_containers/lazy_fs.mli b/src/lib_lazy_containers/lazy_fs.mli new file mode 100644 index 000000000000..f93cd7f6004b --- /dev/null +++ b/src/lib_lazy_containers/lazy_fs.mli @@ -0,0 +1,81 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2023 TriliTech *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** + This module provides an interface of tree, + where nodes accessed by a path (list of strings) + and each intermediate node can hold a value. + It is lazy decodable and take advantage of [Lazy_dirs]. +*) + +type tree_source = Origin | From_parent + +type 'a t = { + content : 'a option; + dirs : 'a t Lazy_dirs.t; + parent_origin : Tezos_tree_encoding.wrapped_tree; +} + +(** [origin fs] returns the tree origin of the container, if it exists. *) +val origin : 'a t -> Tezos_tree_encoding.wrapped_tree option + +(** [tree_instance fs] returns either origin tree of the current node + or a parent's origin. Necessary to be able to encode Lazy_fs to this instance. +*) +val tree_instance : 'a t -> Tezos_tree_encoding.wrapped_tree * tree_source + +(** [find_tree fs path] finds a tree node corresponding to the [path]. *) +val find_tree : 'a t -> string list -> 'a t option Lwt.t + +(** [find fs path] finds a node value corresponding to the [path]. *) +val find : 'a t -> string list -> 'a option Lwt.t + +(** [add_tree fs path subtree] adds a subtree under the given [path]. *) +val add_tree : 'a t -> string list -> 'a t -> 'a t Lwt.t + +(** [set fs path value] set a value of the node corresponding to [path] to [value]. *) +val set : 'a t -> string list -> 'a -> 'a t Lwt.t + +(** [remove fs path] removes a subtree under the given [path] togehter with its value. *) +val remove : 'a t -> string list -> 'a t Lwt.t + +(** [remove_value fs path] removes a subtree's value under the given [path]. *) +val remove_value : 'a t -> string list -> 'a t Lwt.t + +(** [count_subtrees fs] returns number of direct subtrees of the given [fs]. *) +val count_subtrees : 'a t -> int + +(** [list_subtrees fs] returns subtrees of the given [fs] in alphabetically sorted order. *) +val list_subtrees : 'a t -> string list + +(** [nth_name fs index] returns [index]-th subtree of the given [fs]. + Aligns with the order of keys of [list_subtrees]. +*) +val nth_name : 'a t -> int -> string option + +(** [encoding value_enc] returns an encoding for the container wrt + encoding of the value [value_enc] +*) +val encoding : 'a Tezos_tree_encoding.t -> 'a t Tezos_tree_encoding.t diff --git a/src/lib_lazy_containers/lazy_map.mli b/src/lib_lazy_containers/lazy_map.mli index db4eb2421904..7f8a6e9dad3c 100644 --- a/src/lib_lazy_containers/lazy_map.mli +++ b/src/lib_lazy_containers/lazy_map.mli @@ -62,9 +62,9 @@ module type S = sig mutation. *) val to_string : ('a -> string) -> 'a t -> string - (** [create ?values ?produce_value ?origin num_elements] produces a - lazy map with [num_elements] entries where each is created using - [produce_value]. [values] may be provided to supply an initial + (** [create ?values ?produce_value ?origin] produces a + lazy map with [produce_value] and [origin]. + [values] may be provided to supply an initial set of entries. {b Note:} This function is intended to be used [produce_value] diff --git a/src/lib_scoru_wasm/durable.ml b/src/lib_scoru_wasm/durable.ml index 3592522adf06..0ad0dba80b7a 100644 --- a/src/lib_scoru_wasm/durable.ml +++ b/src/lib_scoru_wasm/durable.ml @@ -27,9 +27,9 @@ module T = Tezos_tree_encoding.Wrapped module Runner = Tezos_tree_encoding.Runner.Make (Tezos_tree_encoding.Wrapped) module E = Tezos_tree_encoding module Storage = Tezos_webassembly_interpreter.Durable_storage -open Tezos_lazy_containers +module CBV = Tezos_lazy_containers.Immutable_chunked_byte_vector -type t = T.tree +type t = CBV.t Tezos_lazy_containers.Lazy_fs.t (* The maximum size of bytes allowed to be read/written at once. *) let max_store_io_size = 2048L @@ -42,15 +42,19 @@ exception Value_not_found exception Tree_not_found -exception Durable_empty = Storage.Durable_empty - exception Out_of_bounds of (int64 * int64) exception IO_too_large exception Readonly_value -let encoding = E.wrapped_tree +exception Durable_empty + +let encoding = Tezos_lazy_containers.Lazy_fs.encoding CBV.encoding + +type kind = Value | Directory + +type key = Writeable of string list | Readonly of string list let of_storage ~default s = match Storage.to_tree s with Some t -> t | None -> default @@ -59,10 +63,6 @@ let of_storage_exn s = Storage.to_tree_exn s let to_storage d = Storage.of_tree d -type kind = Value | Directory - -type key = Writeable of string list | Readonly of string list - (* A key is bounded to 250 bytes, including the implicit '/durable' prefix. Additionally, values are implicitly appended with '_'. **) let max_key_length = 250 - String.length "/durable" - String.length "/@" @@ -92,18 +92,6 @@ let key_of_string_exn s = let key_of_string_opt s = try Some (key_of_string_exn s) with Invalid_key _ -> None -(** We append all values with '@', which is an invalid key-character w.r.t. - external use. - - This ensures that an external user is prevented from accidentally writing a - value to a place which is part of another value (e.g. writing a - chunked_byte_vector to "/a/length", where "/a/length" previously existed as - part of another chunked_byte_vector encoding.) -*) -let value_marker = "@" - -let to_value_key k = List.append k [value_marker] - let assert_key_writeable = function | Readonly _ -> raise Readonly_value | Writeable _ -> () @@ -113,15 +101,107 @@ let assert_max_bytes max_bytes = let key_contents = function Readonly k | Writeable k -> k -let find_value tree key = - let open Lwt.Syntax in +(* This module contains helpers, + that used to implement Durable storage functions + from the previous versions, + in order to keep backward compatibility +*) +module Backward_compatible = struct + module E = Tezos_tree_encoding + module Lazy_fs = Tezos_lazy_containers.Lazy_fs + + let value_marker = "@" + + (* This function encodes either Lazy_fs subtree to irmin tree + or just value, depending on [kind]. + If origin of the Lazy_fs is known, + we encode a tree to this origin, + otherwise we will encode to a freshly created in-memory tree. + + The function might return None if the all subkeys were removed + in the passed Lazy_fs instance. + + This function doesn't retain encoded tree as a new origin. + This might cause perfomance degrade (for instance, + for repeating invocation of [subtree_name_at]). + TODO: https://gitlab.com/tezos/tezos/-/issues/5287 + *) + let encode_to_tree ?(kind = Directory) subtree : E.wrapped_tree option Lwt.t = + let open Lwt_syntax in + let value = subtree.Lazy_fs.content in + let value_encoding = E.scope_option ["@"] CBV.encoding in + let E.Wrapped_tree (underlying, (module M)), origin_soruce = + Lazy_fs.tree_instance subtree + in + let unaccessible_path = ["@"; "unaccessible_path"] in + let module M_runner = E.Runner.Make (M) in + let+ new_uderlying = + match (kind, origin_soruce) with + | Directory, Origin -> + Lwt.map Option.some @@ M_runner.encode encoding subtree underlying + | Directory, From_parent -> + let* tree = + M_runner.encode + (E.scope unaccessible_path encoding) + subtree + underlying + in + M.find_tree tree unaccessible_path + | Value, Origin -> + Lwt.map Option.some @@ M_runner.encode value_encoding value underlying + | Value, From_parent -> + let* tree = + M_runner.encode + (E.scope unaccessible_path value_encoding) + value + underlying + in + M.find_tree tree unaccessible_path + in + Option.map + (fun new_uderlying -> E.Wrapped_tree (new_uderlying, (module M))) + new_uderlying + + let hash ~kind subtree = + let open Lwt_syntax in + let* wrapped_opt = encode_to_tree ~kind subtree in + match wrapped_opt with + | None -> Lwt.return_none + | Some (E.Wrapped_tree (tree, (module T))) -> + let+ opt_tree = + match kind with + | Value -> T.find_tree tree [value_marker] + | Directory -> Lwt.return_some tree + in + Option.map T.hash opt_tree + + let list subtree = + let open Lwt.Syntax in + let* wrapped_opt = encode_to_tree subtree in + match wrapped_opt with + | None -> Lwt.return [] + | Some (E.Wrapped_tree (tree, (module T))) -> + let+ subtrees = T.list tree [] in + List.map (fun (name, _) -> if name = "@" then "" else name) subtrees + + let subtree_name_at subtree index = + let open Lwt.Syntax in + let* wrapped_opt = encode_to_tree subtree in + match wrapped_opt with + | None -> raise (Index_too_large index) + | Some (E.Wrapped_tree (tree, (module T))) -> ( + let* list = T.list ~offset:index ~length:1 tree [] in + let nth = List.nth list 0 in + match nth with + | Some (step, _) when Compare.String.(step = value_marker) -> + Lwt.return "" + | Some (step, _) -> Lwt.return step + | None -> raise (Index_too_large index)) +end + +let find_value (tree : t) key = let key = key_contents key in - let* opt = T.find_tree tree @@ to_value_key key in - match opt with - | None -> Lwt.return_none - | Some subtree -> - let+ value = Runner.decode Chunked_byte_vector.encoding subtree in - Some value + Tezos_lazy_containers.Lazy_fs.find tree key let find_value_exn tree key = let open Lwt.Syntax in @@ -129,41 +209,47 @@ let find_value_exn tree key = match opt with None -> raise Value_not_found | Some value -> value (** helper function used in the copy/move *) -let find_tree_exn tree key = +let find_tree_exn (tree : t) key = let open Lwt.Syntax in let key = key_contents key in - let+ opt = T.find_tree tree key in + let+ opt = Tezos_lazy_containers.Lazy_fs.find_tree tree key in match opt with None -> raise Tree_not_found | Some subtree -> subtree -let copy_tree_exn tree ?(edit_readonly = false) from_key to_key = +let copy_tree_exn (tree : t) ?(edit_readonly = false) from_key to_key = let open Lwt.Syntax in if not edit_readonly then assert_key_writeable to_key ; let* move_tree = find_tree_exn tree from_key in let to_key = key_contents to_key in - T.add_tree tree to_key move_tree + Tezos_lazy_containers.Lazy_fs.add_tree tree to_key move_tree -let count_subtrees tree key = T.length tree @@ key_contents key +let list (tree : t) key = + let open Lwt.Syntax in + let key = key_contents key in + let* subtree = Tezos_lazy_containers.Lazy_fs.find_tree tree key in + match subtree with + | None -> Lwt.return [] + | Some subtree -> Backward_compatible.list subtree -let list tree key = +let count_subtrees tree key = let open Lwt.Syntax in - let+ subtrees = T.list tree @@ key_contents key in - List.map (fun (name, _) -> if name = "@" then "" else name) subtrees + let key = key_contents key in + let+ tree = Tezos_lazy_containers.Lazy_fs.find_tree tree key in + match tree with + | Some tree -> + Tezos_lazy_containers.Lazy_dirs.length tree.dirs + + Option.fold ~none:0 ~some:(fun _ -> 1) tree.content + | None -> 0 let delete ?(edit_readonly = false) ~kind tree key = if not edit_readonly then assert_key_writeable key ; match kind with - | Value -> T.remove tree @@ to_value_key (key_contents key) - | Directory -> T.remove tree @@ key_contents key + | Value -> Tezos_lazy_containers.Lazy_fs.remove_value tree (key_contents key) + | Directory -> Tezos_lazy_containers.Lazy_fs.remove tree (key_contents key) -let subtree_name_at tree key index = +let subtree_name_at tree key (index : int) : string Lwt.t = let open Lwt.Syntax in let* subtree = find_tree_exn tree key in - let* list = T.list ~offset:index ~length:1 subtree [] in - let nth = List.nth list 0 in - match nth with - | Some (step, _) when Compare.String.(step = value_marker) -> Lwt.return "" - | Some (step, _) -> Lwt.return step - | None -> raise (Index_too_large index) + Backward_compatible.subtree_name_at subtree index let move_tree_exn tree from_key to_key = let open Lwt.Syntax in @@ -171,17 +257,16 @@ let move_tree_exn tree from_key to_key = assert_key_writeable to_key ; let* move_tree = find_tree_exn tree from_key in let* tree = delete ~kind:Directory tree from_key in - T.add_tree tree (key_contents to_key) move_tree + Tezos_lazy_containers.Lazy_fs.add_tree tree (key_contents to_key) move_tree -let hash ~kind tree key = +let hash ~kind (tree : t) key : Context_hash.t option Lwt.t = let open Lwt.Syntax in - let key = - match kind with - | Value -> to_value_key (key_contents key) - | Directory -> key_contents key - in - let+ opt = T.find_tree tree key in - Option.map (fun subtree -> T.hash subtree) opt + let key = key_contents key in + let* subtree = Tezos_lazy_containers.Lazy_fs.find_tree tree key in + Option.fold + ~none:Lwt.return_none + ~some:(Backward_compatible.hash ~kind) + subtree let hash_exn ~kind tree key = let open Lwt.Syntax in @@ -194,62 +279,47 @@ let hash_exn ~kind tree key = raise exn | Some hash -> hash -let set_value_exn tree ?(edit_readonly = false) key str = +let set_value_exn (tree : t) ?(edit_readonly = false) key str = if not edit_readonly then assert_key_writeable key ; - let key = to_value_key @@ key_contents key in - let encoding = E.scope key Chunked_byte_vector.encoding in - Runner.encode - encoding - (Tezos_lazy_containers.Chunked_byte_vector.of_string str) - tree + let key = key_contents key in + Tezos_lazy_containers.Lazy_fs.set tree key (CBV.of_string str) let create_value_exn tree ?(edit_readonly = false) key size = let open Lwt.Syntax in - let open Tezos_lazy_containers in if not edit_readonly then assert_key_writeable key ; - let key = to_value_key @@ key_contents key in - let* opt = T.find_tree tree key in - let encoding = E.scope key Chunked_byte_vector.encoding in + let key = key_contents key in + let* opt = Tezos_lazy_containers.Lazy_fs.find tree key in match opt with | None -> - let* durable = - Runner.encode encoding (Chunked_byte_vector.allocate size) tree - in - Lwt.return_some durable + Lwt.map Option.some + @@ Tezos_lazy_containers.Lazy_fs.set tree key (CBV.allocate size) | Some _subtree -> Lwt.return_none let write_value_exn tree ?(edit_readonly = false) key offset bytes = if not edit_readonly then assert_key_writeable key ; let open Lwt.Syntax in - let open Tezos_lazy_containers in let num_bytes = Int64.of_int @@ String.length bytes in assert_max_bytes num_bytes ; - let key = to_value_key @@ key_contents key in - let* opt = T.find_tree tree key in - let encoding = E.scope key Chunked_byte_vector.encoding in - let* value = - match opt with - | None -> Lwt.return @@ Chunked_byte_vector.allocate 0L - | Some _subtree -> Runner.decode encoding tree - in - let vec_len = Chunked_byte_vector.length value in + let key = key_contents key in + let* opt = Tezos_lazy_containers.Lazy_fs.find tree key in + let value = match opt with None -> CBV.allocate 0L | Some cbv -> cbv in + let vec_len = CBV.length value in if offset > vec_len then raise (Out_of_bounds (offset, vec_len)) ; let grow_by = Int64.(num_bytes |> add offset |> Fun.flip sub vec_len) in - if Int64.compare grow_by 0L > 0 then Chunked_byte_vector.grow value grow_by ; - let* () = - Chunked_byte_vector.store_bytes value offset @@ Bytes.of_string bytes + let value = + if Int64.compare grow_by 0L > 0 then CBV.grow value grow_by else value in - Runner.encode encoding value tree + let* value = CBV.store_bytes value offset @@ Bytes.of_string bytes in + Tezos_lazy_containers.Lazy_fs.set tree key value let read_value_exn tree key offset num_bytes = let open Lwt.Syntax in - let open Tezos_lazy_containers in assert_max_bytes num_bytes ; let* value = find_value_exn tree key in - let vec_len = Chunked_byte_vector.length value in + let vec_len = CBV.length value in if offset < 0L || offset >= vec_len then raise (Out_of_bounds (offset, vec_len)) ; @@ -257,7 +327,7 @@ let read_value_exn tree key offset num_bytes = let num_bytes = Int64.(num_bytes |> add offset |> min vec_len |> Fun.flip sub offset) in - let+ bytes = Chunked_byte_vector.load_bytes value offset num_bytes in + let+ bytes = CBV.load_bytes value offset num_bytes in Bytes.to_string bytes module Internal_for_tests = struct diff --git a/src/lib_scoru_wasm/durable.mli b/src/lib_scoru_wasm/durable.mli index 346c5e2a3e4a..0d338e6c5e84 100644 --- a/src/lib_scoru_wasm/durable.mli +++ b/src/lib_scoru_wasm/durable.mli @@ -23,9 +23,10 @@ (* *) (*****************************************************************************) -(** [t] allows a [wrapped_tree] to be manipulated as a tree of - [chunked_byte_vector] *) -type t +(** [t] provides an interface of the tree of [immutable_chunked_byte_vector] *) +type t = + Tezos_lazy_containers.Immutable_chunked_byte_vector.t + Tezos_lazy_containers.Lazy_fs.t (** [key] was too long, or contained invalid steps. *) exception Invalid_key of string @@ -90,11 +91,11 @@ val key_of_string_opt : string -> key option (** [find_value durable key] optionally looks for the value encoded at [key] in [durable]. *) val find_value : - t -> key -> Tezos_lazy_containers.Chunked_byte_vector.t option Lwt.t + t -> key -> Tezos_lazy_containers.Immutable_chunked_byte_vector.t option Lwt.t (** @raise Value_not_found *) val find_value_exn : - t -> key -> Tezos_lazy_containers.Chunked_byte_vector.t Lwt.t + t -> key -> Tezos_lazy_containers.Immutable_chunked_byte_vector.t Lwt.t (** [copy_tree_exn tree ?edit_readonly from_key to_key] produces a new tree in which a copy of the entire subtree at from_key is copied to to_key. diff --git a/src/lib_scoru_wasm/fast/module_cache.ml b/src/lib_scoru_wasm/fast/module_cache.ml index af9b08c0b5a5..c220a749e878 100644 --- a/src/lib_scoru_wasm/fast/module_cache.ml +++ b/src/lib_scoru_wasm/fast/module_cache.ml @@ -39,7 +39,9 @@ let kernel_cache = Kernel_cache.create 2 let load_parse_module store key durable = let open Lwt.Syntax in let* kernel = Durable.find_value_exn durable key in - let+ kernel = Lazy_containers.Chunked_byte_vector.to_string kernel in + let+ kernel = + Lazy_containers.Immutable_chunked_byte_vector.to_string kernel + in Wasmer.Module.(create store Binary kernel) let load_module store key durable = diff --git a/src/lib_scoru_wasm/helpers/wasm_utils.ml b/src/lib_scoru_wasm/helpers/wasm_utils.ml index 8425382bdc59..7732fa984537 100644 --- a/src/lib_scoru_wasm/helpers/wasm_utils.ml +++ b/src/lib_scoru_wasm/helpers/wasm_utils.ml @@ -450,7 +450,7 @@ let wrap_as_durable_storage tree = let open Lwt.Syntax in let+ tree = Tree_encoding_runner.decode - Tezos_tree_encoding.(scope ["durable"] wrapped_tree) + Tezos_tree_encoding.(scope ["durable"] Durable.encoding) tree in Tezos_webassembly_interpreter.Durable_storage.of_tree tree @@ -465,12 +465,7 @@ let has_stuck_flag tree = let make_durable list_key_vals = let open Lwt_syntax in let* tree = empty_tree () in - let* tree = - Tree_encoding_runner.encode - (Tezos_tree_encoding.value ["durable"; "@"; "keep_me"] Data_encoding.bool) - true - tree - in + let* tree = Wasm.initial_state V0 tree in let* durable = wrap_as_durable_storage tree in let+ tree = List.fold_left diff --git a/src/lib_scoru_wasm/host_funcs.ml b/src/lib_scoru_wasm/host_funcs.ml index d7a9758b073c..558973b70f54 100644 --- a/src/lib_scoru_wasm/host_funcs.ml +++ b/src/lib_scoru_wasm/host_funcs.ml @@ -527,7 +527,9 @@ module Aux = struct let* bytes = guard (fun () -> Durable.find_value durable key) in match bytes with | Some bytes -> - let size = Tezos_lazy_containers.Chunked_byte_vector.length bytes in + let size = + Tezos_lazy_containers.Immutable_chunked_byte_vector.length bytes + in return (Int64.to_int32 size) | None -> fail Error.Store_not_a_value diff --git a/src/lib_scoru_wasm/test/durable_snapshot/durable.ml b/src/lib_scoru_wasm/test/durable_snapshot/durable.ml index e3cded1efd71..8026fb34c198 100644 --- a/src/lib_scoru_wasm/test/durable_snapshot/durable.ml +++ b/src/lib_scoru_wasm/test/durable_snapshot/durable.ml @@ -56,13 +56,6 @@ exception Readonly_value let encoding = E.wrapped_tree -let of_storage ~default s = - match Storage.to_tree s with Some t -> t | None -> default - -let of_storage_exn s = Storage.to_tree_exn s - -let to_storage d = Storage.of_tree d - type key = Writeable of string list | Readonly of string list (* A key is bounded to 250 bytes, including the implicit '/durable' prefix. diff --git a/src/lib_scoru_wasm/test/durable_snapshot/durable.mli b/src/lib_scoru_wasm/test/durable_snapshot/durable.mli index 07db26e22fa5..c57a1465796d 100644 --- a/src/lib_scoru_wasm/test/durable_snapshot/durable.mli +++ b/src/lib_scoru_wasm/test/durable_snapshot/durable.mli @@ -59,14 +59,6 @@ exception IO_too_large (** [encoding] is a [Tezos_tree_encoding] for [t]. *) val encoding : t Tezos_tree_encoding.t -val of_storage : - default:t -> Tezos_webassembly_interpreter.Durable_storage.t -> t - -(** @raise Durable_empty *) -val of_storage_exn : Tezos_webassembly_interpreter.Durable_storage.t -> t - -val to_storage : t -> Tezos_webassembly_interpreter.Durable_storage.t - (** [key] is the type that indexes [t]. It enforces several constraints: - a key's length is bounded. - a key is a series of non-empty steps, where 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..389f91795823 100644 --- a/src/lib_scoru_wasm/test/helpers/durable_program_runner.ml +++ b/src/lib_scoru_wasm/test/helpers/durable_program_runner.ml @@ -71,7 +71,6 @@ struct (* Create new tree with passed list of key values *) let initialize_tree (kvs : (key * string) list) = let open Lwt_syntax in - let open Tezos_scoru_wasm_durable_snapshot in let ro, wo = List.partition (fun (k, _) -> Option.equal String.equal (List.hd k) (Some "readonly")) @@ -79,18 +78,29 @@ struct in let ro = List.map (fun (k, v) -> (Durable_operation.key_to_str k, v)) ro in let wo = List.map (fun (k, v) -> (Durable_operation.key_to_str k, v)) wo in - (* Create Durable_storage out of WO keys. - Basically taking advantage of Current durable encoding - *) - let* init_wo = Lwt.map Durable.of_storage_exn @@ make_durable wo in + + (* Create Durable_storage out of WO keys. *) + let* tree = empty_tree () in + let* tree = Wasm.initial_state V0 tree in + let module Snapshotted = Tezos_scoru_wasm_durable_snapshot.Durable in + let* init_durable = Tree_encoding_runner.decode Snapshotted.encoding tree in + let* init_wo = + List.fold_left + (fun acc (key, value) -> + let* tree = acc in + let key = Snapshotted.key_of_string_exn key in + Snapshotted.write_value_exn tree key 0L value) + (Lwt.return init_durable) + wo + in (* Add RO keys in the tree *) let* init_tezos_durable = Lwt_list.fold_left_s (fun dur (k, v) -> - Durable.set_value_exn + Snapshotted.set_value_exn ~edit_readonly:true dur - (Durable.key_of_string_exn k) + (Snapshotted.key_of_string_exn k) v) init_wo ro @@ -98,7 +108,7 @@ struct (* Encode tree to the irmin one *) let* init_tree = empty_tree () in Tree_encoding_runner.encode - Tezos_scoru_wasm_durable_snapshot.Durable.encoding + Snapshotted.encoding init_tezos_durable init_tree 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 b3ea89d0e885..66443c170e30 100644 --- a/src/lib_scoru_wasm/test/helpers/durable_snapshot_util.ml +++ b/src/lib_scoru_wasm/test/helpers/durable_snapshot_util.ml @@ -77,6 +77,7 @@ module type Testable_durable_sig = sig end module CBV = Tezos_lazy_containers.Chunked_byte_vector +module ICBV = Tezos_lazy_containers.Immutable_chunked_byte_vector (* Adapter of snapshotted durable interface with additional cbv type, which it doesn't have *) @@ -112,12 +113,12 @@ module Current : Testable_durable_sig = struct let* cbv = find_value tree key in match cbv with | None -> Lwt.return None - | Some cbv -> Lwt.map Option.some (CBV.to_bytes cbv) + | Some cbv -> Lwt.map Option.some (ICBV.to_bytes cbv) let find_value_exn tree key = let open Lwt_syntax in let* cbv = find_value_exn tree key in - CBV.to_bytes cbv + ICBV.to_bytes cbv end (* Returns Ok () or Error (string * string) with diverged hashes *) @@ -175,21 +176,28 @@ end) : Testable_durable_sig with type t = Snapshot.t * Current.t = struct Without this function there are two different sets of exceptions: Tezos_scoru_wasm_durable_snapshot.Durable.Value_not_found - Tezos_scoru_wasm.Durable.Value_not_found + Tezos_scoru_wasm_test_helpers.Inmemory_durable.Value_not_found even though essentially it's the same exception. *) let convert_to_snapshot_durable_exception (e : exn) = - Tezos_scoru_wasm_durable_snapshot.Durable.( - match e with - | Tezos_scoru_wasm.Durable.Invalid_key k -> Invalid_key k - | Tezos_scoru_wasm.Durable.Index_too_large i -> Index_too_large i - | Tezos_scoru_wasm.Durable.Value_not_found -> Value_not_found - | Tezos_scoru_wasm.Durable.Tree_not_found -> Tree_not_found - | Tezos_scoru_wasm.Durable.Out_of_bounds b -> Out_of_bounds b - | Tezos_scoru_wasm.Durable.Durable_empty -> Durable_empty - | Tezos_scoru_wasm.Durable.Readonly_value -> Readonly_value - | Tezos_scoru_wasm.Durable.IO_too_large -> IO_too_large - | e -> e) + match e with + | Tezos_scoru_wasm.Durable.Invalid_key k -> + Tezos_scoru_wasm_durable_snapshot.Durable.Invalid_key k + | Tezos_scoru_wasm.Durable.Index_too_large i -> + Tezos_scoru_wasm_durable_snapshot.Durable.Index_too_large i + | Tezos_scoru_wasm.Durable.Value_not_found -> + Tezos_scoru_wasm_durable_snapshot.Durable.Value_not_found + | Tezos_scoru_wasm.Durable.Tree_not_found -> + Tezos_scoru_wasm_durable_snapshot.Durable.Tree_not_found + | Tezos_scoru_wasm.Durable.Out_of_bounds b -> + Tezos_scoru_wasm_durable_snapshot.Durable.Out_of_bounds b + | Tezos_scoru_wasm.Durable.Readonly_value -> + Tezos_scoru_wasm_durable_snapshot.Durable.Readonly_value + | Tezos_scoru_wasm.Durable.IO_too_large -> + Tezos_scoru_wasm_durable_snapshot.Durable.IO_too_large + | Tezos_lazy_containers.Immutable_chunked_byte_vector.Bounds -> + Tezos_lazy_containers.Chunked_byte_vector.Bounds + | e -> e let ensure_same_outcome (type a) ~(pp : Format.formatter -> a -> unit) ~(eq : a -> a -> bool) (f_s : unit -> (a * Snapshot.t) Lwt.t) diff --git a/src/lib_scoru_wasm/test/test_durable_shapshot.ml b/src/lib_scoru_wasm/test/test_durable_shapshot.ml index 1d009283d9cb..aef0c4266350 100644 --- a/src/lib_scoru_wasm/test/test_durable_shapshot.ml +++ b/src/lib_scoru_wasm/test/test_durable_shapshot.ml @@ -228,8 +228,8 @@ let tests : unit Alcotest_lwt.test_case trace = List.append [ tztest "Do several operations on durable" `Quick test_several_operations; - stress_test_desceding ~init_size:2000 ~rounds:3000; - stress_test_uniform ~init_size:2000 ~rounds:20000; + stress_test_desceding ~init_size:2000 ~rounds:30000; + stress_test_uniform ~init_size:2000 ~rounds:50000; stress_strcture_ops ~init_size:2000 ~rounds:3000; ] (stress_each_op ()) diff --git a/src/lib_scoru_wasm/test/test_durable_storage.ml b/src/lib_scoru_wasm/test/test_durable_storage.ml index a8f077c41539..e26e7ea386cc 100644 --- a/src/lib_scoru_wasm/test/test_durable_storage.ml +++ b/src/lib_scoru_wasm/test/test_durable_storage.ml @@ -41,8 +41,8 @@ let value_store_key_too_large = let equal_chunks c1 c2 = let open Lwt.Syntax in - let* c1 = Chunked_byte_vector.to_string c1 in - let* c2 = Chunked_byte_vector.to_string c2 in + let* c1 = Immutable_chunked_byte_vector.to_string c1 in + let* c2 = Immutable_chunked_byte_vector.to_string c2 in Lwt.return @@ assert (String.equal c1 c2) (* Test checking that if [key] is missing, [store_has key] returns [false] *) @@ -514,14 +514,14 @@ let test_durable_find_value () = assert (Option.is_some r) ; let* x = match r with - | Some y -> Chunked_byte_vector.to_string y + | Some y -> Immutable_chunked_byte_vector.to_string y | None -> assert false in assert (x = "a very long value") ; let* v = Durable.find_value_exn durable @@ Durable.key_of_string_exn "/hello/value" in - let* x = Chunked_byte_vector.to_string v in + let* x = Immutable_chunked_byte_vector.to_string v in assert (x = "a very long value") ; let* r = Durable.find_value durable @@ Durable.key_of_string_exn "/hello/other" @@ -563,7 +563,7 @@ let test_durable_count_subtrees_and_list () = let* () = assert_subtree_count tree 2 "/hello/you" in let* () = assert_subtree_count tree 1 "/hello/you/too" in let* () = assert_subtree_count tree 0 "/bye" in - let* () = assert_list tree [""; "hello"; "long"] "" in + let* () = assert_list tree ["hello"; "long"; "readonly"] "" in let* () = assert_list tree [""; "world"; "you"] "/hello" in let* () = assert_list tree [""; "too"] "/hello/you" in let* () = assert_list tree [""] "/hello/you/too" in @@ -580,7 +580,7 @@ let test_durable_count_subtrees_and_list () = the tree that existed previously at [to_key] *) let test_store_copy ~version () = let open Lwt_syntax in - let value () = Chunked_byte_vector.of_string "a very long value" in + let value () = Immutable_chunked_byte_vector.of_string "a very long value" in (* Store the following tree: /durable/a/short/path/_ = "a very long value" @@ -1008,7 +1008,7 @@ let test_store_write ~version () = let* value = Durable.find_value_exn tree @@ Durable.key_of_string_exn existing_key in - let* result = Chunked_byte_vector.to_string value in + let* result = Immutable_chunked_byte_vector.to_string value in (* We started writing at an offset into the value. *) let expected_write_bytes = (String.sub contents 0 @@ Int32.to_int write_offset) ^ contents @@ -1065,12 +1065,13 @@ let test_store_write ~version () = let* value = Durable.find_value_exn tree @@ Durable.key_of_string_exn new_key in - let* result = Chunked_byte_vector.to_string value in + let* result = Immutable_chunked_byte_vector.to_string value in assert (contents = result) ; return_ok_unit let test_store_create ~version = let open Lwt_syntax in + let open Tezos_scoru_wasm_helpers.Encodings_util in (* The durable storage is initialized with the following tree: /durable/a/path/@ = "a value of sorts" @@ -1119,10 +1120,10 @@ let test_store_create ~version = let* new_value = Durable.find_value_exn tree @@ Durable.key_of_string_exn new_key in - let new_value_size_length = Chunked_byte_vector.length new_value in + let new_value_size_length = Immutable_chunked_byte_vector.length new_value in assert (Int64.of_int32 valid_size = new_value_size_length) ; let expected_value = String.make (Int32.to_int valid_size) '\000' in - let* value_as_string = Chunked_byte_vector.to_string new_value in + let* value_as_string = Immutable_chunked_byte_vector.to_string new_value in assert (expected_value = value_as_string) ; (* Check that creating an already existing value returns 1 and doesn't @@ -1156,9 +1157,14 @@ let test_store_create ~version = (* Check the vector has been allocated, with a length but no chunks. Note that this test relies a lot on the encoding of values and chunked byte vectors, and will fail if one or both fails. *) - let wrapped_tree = - Tezos_webassembly_interpreter.Durable_storage.to_tree_exn durable + let* tree = empty_tree () in + let* wrapped_tree = + Tree_encoding_runner.encode + Durable.encoding + (Tezos_webassembly_interpreter.Durable_storage.to_tree_exn durable) + tree in + (* The value is located under the "@" subkey. *) let value_key = List.append @@ -1166,26 +1172,22 @@ let test_store_create ~version = |> Durable.Internal_for_tests.key_to_list) ["@"] in - let* encoded_value_tree = - Tezos_tree_encoding.Wrapped.find_tree wrapped_tree value_key - in + let* encoded_value_tree = Tree.find_tree wrapped_tree value_key in let encoded_value_tree = match encoded_value_tree with | None -> Stdlib.failwith "The value has not been encoded" | Some tree -> tree in - let* encoded_value = Tezos_tree_encoding.Wrapped.list encoded_value_tree [] in + let* encoded_value = Tree.list encoded_value_tree [] in assert ( List.for_all (fun (key, _) -> key = "length") encoded_value && encoded_value <> []) ; (* Chunks are encoded under the subkey "contents" *) - let* encoded_chunks = - Tezos_tree_encoding.Wrapped.list wrapped_tree (value_key @ ["contents"]) - in + let* encoded_chunks = Tree.list wrapped_tree (value_key @ ["contents"]) in assert (encoded_chunks = []) ; (* Check the value will be loaded with zero values. *) - let value_size_in_durable = Chunked_byte_vector.length value in + let value_size_in_durable = Immutable_chunked_byte_vector.length value in assert (value_size_in_durable = Int64.of_int32 contents_size) ; (* Creating a value of an invalid size (> 2GB) should fail *) diff --git a/src/lib_scoru_wasm/test/test_get_set.ml b/src/lib_scoru_wasm/test/test_get_set.ml index 95fdaf44cf23..f19b1b24d852 100644 --- a/src/lib_scoru_wasm/test/test_get_set.ml +++ b/src/lib_scoru_wasm/test/test_get_set.ml @@ -38,27 +38,7 @@ open Tztest_helper (* Use context-binary for testing. *) module Context = Tezos_context_memory.Context_binary module Vector = Tezos_lazy_containers.Lazy_vector.Int32Vector - -let empty_tree () = - let open Lwt_syntax in - let* index = Context.init "/tmp" in - let empty_store = Context.empty index in - return @@ Context.Tree.empty empty_store - -type Tezos_tree_encoding.tree_instance += Tree of Context.tree - -module Tree : Tezos_tree_encoding.TREE with type tree = Context.tree = struct - type tree = Context.tree - - include Context.Tree - - let select = function - | Tree t -> t - | _ -> raise Tezos_tree_encoding.Incorrect_tree_type - - let wrap t = Tree t -end - +module Tree = Tezos_scoru_wasm_helpers.Encodings_util.Tree module Tree_encoding_runner = Tezos_tree_encoding.Runner.Make (Tree) let current_tick_encoding = diff --git a/src/lib_scoru_wasm/test/test_reveal.ml b/src/lib_scoru_wasm/test/test_reveal.ml index e8eab80eec0a..29ada9a08781 100644 --- a/src/lib_scoru_wasm/test/test_reveal.ml +++ b/src/lib_scoru_wasm/test/test_reveal.ml @@ -344,7 +344,7 @@ let test_fast_exec_reveal ~version () = Durable.(find_value_exn durable (key_of_string_exn "/foo")) in let* written_value = - Tezos_lazy_containers.Chunked_byte_vector.to_string written_value + Tezos_lazy_containers.Immutable_chunked_byte_vector.to_string written_value in assert (String.equal written_value example_preimage) ; diff --git a/src/lib_scoru_wasm/test/test_wasm_pvm.ml b/src/lib_scoru_wasm/test/test_wasm_pvm.ml index 6f04f572a42c..244684748dd5 100644 --- a/src/lib_scoru_wasm/test/test_wasm_pvm.ml +++ b/src/lib_scoru_wasm/test/test_wasm_pvm.ml @@ -112,12 +112,12 @@ let should_run_debug_kernel ~version () = let add_value ?(content = "a very long value") tree key_steps = let open Tezos_lazy_containers in - let value = Chunked_byte_vector.of_string content in + let value = Immutable_chunked_byte_vector.of_string content in Tree_encoding_runner.encode Tezos_tree_encoding.( scope ("durable" :: List.append key_steps ["@"]) - Chunked_byte_vector.encoding) + Immutable_chunked_byte_vector.encoding) value tree @@ -322,7 +322,7 @@ let assert_store_value tree path expected_value = let* durable = wrap_as_durable_storage tree in let durable = Durable.of_storage_exn durable in let* value = Durable.find_value durable (Durable.key_of_string_exn path) in - let+ value = Option.map_s Chunked_byte_vector.to_string value in + let+ value = Option.map_s Immutable_chunked_byte_vector.to_string value in assert (Option.equal String.equal value expected_value) (* store_move *) @@ -977,7 +977,9 @@ let test_durable_store_io ~version () = let*! value = Durable.find_value_exn durable (Durable.key_of_string_exn "/to/value") in - let*! value = Tezos_lazy_containers.Chunked_byte_vector.to_string value in + let*! value = + Tezos_lazy_containers.Immutable_chunked_byte_vector.to_string value + in let expected = String.sub content read_offset 1 in assert (expected = value) ; return_unit @@ -1047,7 +1049,9 @@ let assert_fallback_kernel tree expected_kernel = let durable = Durable.of_storage_exn durable in let* value = Durable.find_value durable Constants.kernel_fallback_key in let+ value = - Option.map_s Tezos_lazy_containers.Chunked_byte_vector.to_string value + Option.map_s + Tezos_lazy_containers.Immutable_chunked_byte_vector.to_string + value in assert (Option.equal String.equal value expected_kernel) @@ -1057,7 +1061,9 @@ let assert_kernel tree expected_kernel = let durable = Durable.of_storage_exn durable in let* value = Durable.find_value durable Constants.kernel_key in let+ value = - Option.map_s Tezos_lazy_containers.Chunked_byte_vector.to_string value + Option.map_s + Tezos_lazy_containers.Immutable_chunked_byte_vector.to_string + value in assert (Option.equal String.equal value expected_kernel) @@ -1241,7 +1247,7 @@ let test_pvm_reboot_counter ~version ~pvm_max_reboots () = storage" | Some value -> let*! value = - Tezos_lazy_containers.Chunked_byte_vector.to_bytes value + Tezos_lazy_containers.Immutable_chunked_byte_vector.to_bytes value in (* WASM Values in memories are encoded in little-endian order. *) return @@ Bytes.get_int32_le value 0 @@ -1455,7 +1461,9 @@ let test_kernel_reboot_gen ~version ~reboots ~expected_reboots ~pvm_max_reboots "Evaluation error: couldn't find the reboot counter in the durable \ storage" | Some value -> - let*! value = Tezos_lazy_containers.Chunked_byte_vector.to_bytes value in + let*! value = + Tezos_lazy_containers.Immutable_chunked_byte_vector.to_bytes value + in (* WASM Values in memories are encoded in little-endian order. *) let value = Bytes.get_int32_le value 0 in assert (value = expected_reboots) ; diff --git a/src/lib_scoru_wasm/wasm_vm.ml b/src/lib_scoru_wasm/wasm_vm.ml index f136581a5502..74dbe1c1c365 100644 --- a/src/lib_scoru_wasm/wasm_vm.ml +++ b/src/lib_scoru_wasm/wasm_vm.ml @@ -25,6 +25,7 @@ module Wasm = Tezos_webassembly_interpreter open Wasm_pvm_state.Internal_state +open Tezos_lazy_containers let version_for_protocol : Pvm_input_kind.protocol -> Wasm_pvm_state.version = function @@ -70,7 +71,9 @@ let has_upgrade_error_flag durable = let get_wasm_version {durable; _} = let open Lwt_syntax in let* cbv = Durable.find_value_exn durable Constants.version_key in - let+ bytes = Tezos_lazy_containers.Chunked_byte_vector.to_bytes cbv in + let+ bytes = + Tezos_lazy_containers.Immutable_chunked_byte_vector.to_bytes cbv + in Data_encoding.Binary.of_bytes_exn Wasm_pvm_state.version_encoding bytes let stack_size_limit = function Wasm_pvm_state.V0 -> 300 | V1 -> 60_000 @@ -214,7 +217,7 @@ let unsafe_next_tick_state ~version ~stack_size_limit host_funcs let* m = Tezos_webassembly_interpreter.Decode.module_step ~allow_floats:false - kernel + (Immutable_chunked_byte_vector.to_chunked_byte_vector kernel) m in return (Decode m) diff --git a/src/lib_tree_encoding/decoding.ml b/src/lib_tree_encoding/decoding.ml index 95a4db16153a..deecd9cc99e6 100644 --- a/src/lib_tree_encoding/decoding.ml +++ b/src/lib_tree_encoding/decoding.ml @@ -160,6 +160,20 @@ let subtree backend tree prefix = in subtree +let scope_option key value = + { + decode = + (fun backend tree prefix -> + let open Lwt.Syntax in + let value_prefix = append_key prefix key in + let* subtree_opt = Tree.find_tree backend tree (value_prefix []) in + match subtree_opt with + | Some _ -> + let+ content = value.decode backend tree value_prefix in + Some content + | None -> Lwt.return_none); + } + let scope key {decode} = { decode = @@ -178,7 +192,19 @@ let lazy_mapping to_key field_enc = input_prefix in let+ tree = subtree backend input_tree input_prefix in - (Some (Tree.Wrapped_tree (tree, backend)), produce_value)); + (Tree.Wrapped_tree (tree, backend), produce_value)); + } + +let lazy_mapping_with_names to_key field_enc = + { + decode = + (fun backend input_tree input_prefix -> + let open Lwt_syntax in + let* wrapped, produce_value = + (lazy_mapping to_key field_enc).decode backend input_tree input_prefix + in + let+ names = Tree.list backend input_tree (input_prefix []) in + (wrapped, List.map fst names, produce_value)); } let case_lwt tag decode extract = Case {tag; decode; extract} diff --git a/src/lib_tree_encoding/decoding.mli b/src/lib_tree_encoding/decoding.mli index 812da28c200a..b5c7624227c3 100644 --- a/src/lib_tree_encoding/decoding.mli +++ b/src/lib_tree_encoding/decoding.mli @@ -58,6 +58,11 @@ val raw : key -> bytes t @raises Decode_error when decoding of the value fails *) val value_option : key -> 'a Data_encoding.t -> 'a option t +(** [scope_option key dec] tries to retrieve the subtree under + the given [key] by checking if such subtree exists, + or return [None] if [key] is missing. *) +val scope_option : key -> 'a t -> 'a option t + (** [value ?default key data_encoding] retrieves the value at a given [key] by decoding its raw value using the provided [data_encoding]. @@ -85,7 +90,12 @@ val scope : key -> 'a t -> 'a t This function is primarily useful when providing a [~produce_value] function to [Lazy_map.create]. *) val lazy_mapping : - ('i -> key) -> 'a t -> (Tree.wrapped_tree option * ('i -> 'a Lwt.t)) t + ('i -> key) -> 'a t -> (Tree.wrapped_tree * ('i -> 'a Lwt.t)) t + +(** [lazy_mapping_with_names to_key decoder] does the same as [lazy_mapping] + but also eagerly decodes names of subtrees. *) +val lazy_mapping_with_names : + ('i -> key) -> 'a t -> (Tree.wrapped_tree * string list * ('i -> 'a Lwt.t)) t (** [delayed f] produces a tree decoder that delays evaluation of [f ()] until the decoder is actually needed. This is required to allow for directly diff --git a/src/lib_tree_encoding/encoding.ml b/src/lib_tree_encoding/encoding.ml index 081c5046acae..6a66339fbf86 100644 --- a/src/lib_tree_encoding/encoding.ml +++ b/src/lib_tree_encoding/encoding.ml @@ -114,6 +114,16 @@ let value_option key encoding = | None -> Tree.remove backend tree (prefix key)); } +let scope_option key value_enc = + { + encode = + (fun backend v prefix tree -> + let value_prefix = append_key prefix key in + match v with + | Some v -> value_enc.encode backend v value_prefix tree + | None -> Tree.remove backend tree (value_prefix [])); + } + let scope key {encode} = { encode = @@ -135,7 +145,7 @@ let lazy_mapping to_key enc_value = (prefix []) (Tree.select backend @@ Tree.wrap origin_backend origin) (* Will fetch a tree of the same type as backend or throw an error. - Basically checking that origin's backend and encoding backeds are the same *) + Basically checking that origin's tree and encoding's tree are the same *) | None -> Tree.remove backend tree (prefix []) in List.fold_left_s diff --git a/src/lib_tree_encoding/encoding.mli b/src/lib_tree_encoding/encoding.mli index 3a673ae0463e..1f57fc371b03 100644 --- a/src/lib_tree_encoding/encoding.mli +++ b/src/lib_tree_encoding/encoding.mli @@ -65,6 +65,11 @@ val raw : key -> bytes t value stored at [key] if [None] is provided. *) val value_option : key -> 'a Data_encoding.t -> 'a option t +(** [scope_option key enc] encodes the value under subtree of the given [key] + using the provided [enc] encoder for the value, or remove any previous + value stored at [key] if [None] is provided. *) +val scope_option : key -> 'a t -> 'a option t + (** [value key enc] encodes the value at a given [key] using the provided [enc] encoder for the value. *) val value : key -> 'a Data_encoding.t -> 'a t diff --git a/src/lib_tree_encoding/tezos_tree_encoding.ml b/src/lib_tree_encoding/tezos_tree_encoding.ml index 3470494a7ba2..75663b38edcd 100644 --- a/src/lib_tree_encoding/tezos_tree_encoding.ml +++ b/src/lib_tree_encoding/tezos_tree_encoding.ml @@ -52,6 +52,9 @@ let conv_lwt d e {encode; decode} = let scope key {encode; decode} = {encode = E.scope key encode; decode = D.scope key decode} +let scope_option key {encode; decode} = + {encode = E.scope_option key encode; decode = D.scope_option key decode} + let tup2_ a b = {encode = E.tup2 a.encode b.encode; decode = D.Syntax.both a.decode b.decode} @@ -232,7 +235,7 @@ module Lazy_map_encoding = struct in let decode = D.map - (fun (origin, produce_value) -> Map.create ?origin ~produce_value ()) + (fun (origin, produce_value) -> Map.create ~origin ~produce_value ()) (let open D.Syntax in let+ produce_value = D.lazy_mapping to_key value.decode in produce_value) @@ -295,7 +298,7 @@ module Lazy_vector_encoding = struct let decode = D.map (fun ((origin, produce_value), len, head) -> - Vector.create ~produce_value ~first_key:head ?origin len) + Vector.create ~produce_value ~first_key:head ~origin len) (let open D.Syntax in let+ x = D.scope ["contents"] (D.lazy_mapping to_key value.decode) and+ y = D.scope ["length"] with_key.decode @@ -343,7 +346,7 @@ module CBV_encoding = struct in let decode = D.map - (fun ((origin, get_chunk), len) -> CBV.create ?origin ~get_chunk len) + (fun ((origin, get_chunk), len) -> CBV.create ~origin ~get_chunk len) (let open D.Syntax in let+ x = D.scope ["contents"] @@ D.lazy_mapping to_key chunk.decode and+ y = D.value ["length"] Data_encoding.int64 in @@ -353,6 +356,106 @@ module CBV_encoding = struct end end +module Lazy_dirs_encoding = struct + module type Lazy_dirs_sig = sig + type 'a t + + module Names : Stdlib.Set.S with type elt = String.t + + module Map : Lazy_map_encoding.Lazy_map_sig with type key = String.t + + val contents : 'a t -> 'a Map.t + + val create : ?names:Names.t -> ?contents:'a Map.t -> unit -> 'a t + + val remove : 'a t -> Names.elt -> 'a t + end + + module type S = sig + type 'a dirs + + val lazy_dirs : 'a t -> 'a dirs t + end + + module Make (Dirs : Lazy_dirs_sig) = struct + let decode_lazy_dirs_with_origin value_decoder = + let to_key k = [Dirs.Map.string_of_key k] in + D.map + (fun (origin, names, produce_value) -> + let contents = Dirs.Map.create ~origin ~produce_value () in + (Dirs.create ~names:(Dirs.Names.of_list names) ~contents (), origin)) + (D.lazy_mapping_with_names to_key value_decoder) + + let lazy_dirs value = + let to_key k = [Dirs.Map.string_of_key k] in + let encode = + E.contramap + (fun tree -> + let contents = Dirs.contents tree in + (Dirs.Map.origin contents, Dirs.Map.loaded_bindings contents)) + (E.lazy_mapping to_key value.encode) + in + let decode = + D.map + (fun (dirs, _) -> dirs) + (decode_lazy_dirs_with_origin value.decode) + in + {encode; decode} + end +end + +module Lazy_fs_encoding = struct + module type Lazy_fs_sig = sig + type 'a t + + module Dirs : Lazy_dirs_encoding.Lazy_dirs_sig + + val dirs : 'a t -> 'a t Dirs.t + + val content : 'a t -> 'a option + + val create : ?value:'a -> ?dirs:'a t Dirs.t -> Tree.wrapped_tree -> 'a t + end + + module type S = sig + type 'a fs + + val lazy_fs : 'a t -> 'a fs t + end + + module Make (Fs : Lazy_fs_sig) = struct + module Lazy_dirs_enc = Lazy_dirs_encoding.Make (Fs.Dirs) + + let lazy_dirs = Lazy_dirs_enc.lazy_dirs + + let decode_lazy_dirs_with_origin = + Lazy_dirs_enc.decode_lazy_dirs_with_origin + + let rec lazy_fs value = + let encode = + E.contramap + (fun fs -> (Fs.dirs fs, Fs.content fs)) + (E.tup2 + (E.delayed @@ fun () -> (lazy_dirs (lazy_fs value)).encode) + (E.scope_option ["@"] value.encode)) + in + let decode = + D.map + (fun (value, (dirs, origin)) -> + let dirs = Fs.Dirs.remove dirs "@" in + Fs.create ?value ~dirs origin) + (let open D.Syntax in + let+ x = D.scope_option ["@"] value.decode + and+ dirs_n_origin = + D.delayed @@ fun () -> + decode_lazy_dirs_with_origin (lazy_fs value).decode + in + (x, dirs_n_origin)) + in + {encode; decode} + end +end + type ('tag, 'a) case = | Case : { tag : 'tag; @@ -432,7 +535,8 @@ let either enc_a enc_b = module type TREE = S -type wrapped_tree = Tree.wrapped_tree +type wrapped_tree = Tree.wrapped_tree = + | Wrapped_tree : 'tree * 'tree backend -> wrapped_tree module Wrapped : TREE with type tree = wrapped_tree = Tree.Wrapped diff --git a/src/lib_tree_encoding/tezos_tree_encoding.mli b/src/lib_tree_encoding/tezos_tree_encoding.mli index 66d01df6f9b1..ef048f0094b7 100644 --- a/src/lib_tree_encoding/tezos_tree_encoding.mli +++ b/src/lib_tree_encoding/tezos_tree_encoding.mli @@ -201,6 +201,10 @@ val value : ?default:'a -> key -> 'a Data_encoding.t -> 'a t branch [key]. *) val scope : key -> 'a t -> 'a t +(** [scope_option key enc] moves the given encoder [enc] to encode value under a + branch [key] if the given value is Some, otherwise it removes the [key] from the tree. *) +val scope_option : key -> 'a t -> 'a option t + (** [case tag enc inj proj] returns a partial encoder that represents a case in a sum-type. The encoder hides the (existentially bound) type of the parameter to the specific case, provided converter functions [inj] and @@ -236,37 +240,10 @@ val delayed : (unit -> 'a t) -> 'a t the left case of [Either.t], and [enc_b] for the [Right] case. *) val either : 'a t -> 'b t -> ('a, 'b) Either.t t -module type TREE = sig - type tree - - type key := string list - - type value := bytes - - (** @raise Incorrect_tree_type *) - val select : Tree.tree_instance -> tree - - val wrap : tree -> Tree.tree_instance - - val remove : tree -> key -> tree Lwt.t - - val add : tree -> key -> value -> tree Lwt.t - - val add_tree : tree -> key -> tree -> tree Lwt.t - - val find : tree -> key -> value option Lwt.t - - val find_tree : tree -> key -> tree option Lwt.t - - val hash : tree -> Context_hash.t +module type TREE = Tree.S - val length : tree -> key -> int Lwt.t - - val list : - tree -> ?offset:int -> ?length:int -> key -> (string * tree) list Lwt.t -end - -type wrapped_tree +type wrapped_tree = Tree.wrapped_tree = + | Wrapped_tree : 'tree * 'tree Tree.backend -> wrapped_tree module Wrapped : TREE with type tree = wrapped_tree @@ -436,3 +413,49 @@ module CBV_encoding : sig module Make (CBV : CBV_sig) : S with type cbv := CBV.t and type chunk := CBV.chunk end + +module Lazy_dirs_encoding : sig + module type Lazy_dirs_sig = sig + type 'a t + + module Names : Stdlib.Set.S with type elt = String.t + + module Map : Lazy_map_encoding.Lazy_map_sig with type key = String.t + + val contents : 'a t -> 'a Map.t + + val create : ?names:Names.t -> ?contents:'a Map.t -> unit -> 'a t + + val remove : 'a t -> Names.elt -> 'a t + end + + module type S = sig + type 'a dirs + + val lazy_dirs : 'a t -> 'a dirs t + end + + module Make (Dirs : Lazy_dirs_sig) : S with type 'a dirs := 'a Dirs.t +end + +module Lazy_fs_encoding : sig + module type Lazy_fs_sig = sig + type 'a t + + module Dirs : Lazy_dirs_encoding.Lazy_dirs_sig + + val dirs : 'a t -> 'a t Dirs.t + + val content : 'a t -> 'a option + + val create : ?value:'a -> ?dirs:'a t Dirs.t -> Tree.wrapped_tree -> 'a t + end + + module type S = sig + type 'a fs + + val lazy_fs : 'a t -> 'a fs t + end + + module Make (Fs : Lazy_fs_sig) : S with type 'a fs := 'a Fs.t +end diff --git a/src/lib_webassembly/runtime/durable_storage.ml b/src/lib_webassembly/runtime/durable_storage.ml index 008789c87fb2..cb470959f883 100644 --- a/src/lib_webassembly/runtime/durable_storage.ml +++ b/src/lib_webassembly/runtime/durable_storage.ml @@ -1,4 +1,7 @@ -type t = Tezos_tree_encoding.wrapped_tree option +type t = + Tezos_lazy_containers.Immutable_chunked_byte_vector.t + Tezos_lazy_containers.Lazy_fs.t + option exception Durable_empty diff --git a/src/lib_webassembly/runtime/durable_storage.mli b/src/lib_webassembly/runtime/durable_storage.mli index 25ecd16ec580..2f5c75760cf2 100644 --- a/src/lib_webassembly/runtime/durable_storage.mli +++ b/src/lib_webassembly/runtime/durable_storage.mli @@ -5,9 +5,19 @@ exception Durable_empty val empty : t -val of_tree : Tezos_tree_encoding.wrapped_tree -> t +val of_tree : + Tezos_lazy_containers.Immutable_chunked_byte_vector.t + Tezos_lazy_containers.Lazy_fs.t -> + t (** @raise Durable_empty *) -val to_tree_exn : t -> Tezos_tree_encoding.wrapped_tree +val to_tree_exn : + t -> + Tezos_lazy_containers.Immutable_chunked_byte_vector.t + Tezos_lazy_containers.Lazy_fs.t -val to_tree : t -> Tezos_tree_encoding.wrapped_tree option +val to_tree : + t -> + Tezos_lazy_containers.Immutable_chunked_byte_vector.t + Tezos_lazy_containers.Lazy_fs.t + option diff --git a/src/proto_016_PtMumbai/lib_sc_rollup_node/wasm_2_0_0_pvm.ml b/src/proto_016_PtMumbai/lib_sc_rollup_node/wasm_2_0_0_pvm.ml index 6266648dd1b7..9055ede0a79b 100644 --- a/src/proto_016_PtMumbai/lib_sc_rollup_node/wasm_2_0_0_pvm.ml +++ b/src/proto_016_PtMumbai/lib_sc_rollup_node/wasm_2_0_0_pvm.ml @@ -85,7 +85,9 @@ module Make_durable_state let key = Tezos_scoru_wasm.Durable.key_of_string_exn key_str in let* durable = decode_durable tree in let+ res_opt = Tezos_scoru_wasm.Durable.find_value durable key in - Option.map Tezos_lazy_containers.Chunked_byte_vector.length res_opt + Option.map + Tezos_lazy_containers.Immutable_chunked_byte_vector.length + res_opt let lookup tree key_str = let open Lwt_syntax in @@ -95,7 +97,9 @@ module Make_durable_state match res_opt with | None -> return_none | Some v -> - let+ bts = Tezos_lazy_containers.Chunked_byte_vector.to_bytes v in + let+ bts = + Tezos_lazy_containers.Immutable_chunked_byte_vector.to_bytes v + in Some bts let list tree key_str = diff --git a/src/proto_017_PtNairob/lib_sc_rollup_node/wasm_2_0_0_pvm.ml b/src/proto_017_PtNairob/lib_sc_rollup_node/wasm_2_0_0_pvm.ml index cec950da0239..d031a672d9ff 100644 --- a/src/proto_017_PtNairob/lib_sc_rollup_node/wasm_2_0_0_pvm.ml +++ b/src/proto_017_PtNairob/lib_sc_rollup_node/wasm_2_0_0_pvm.ml @@ -82,7 +82,9 @@ module Make_durable_state let key = Tezos_scoru_wasm.Durable.key_of_string_exn key_str in let* durable = decode_durable tree in let+ res_opt = Tezos_scoru_wasm.Durable.find_value durable key in - Option.map Tezos_lazy_containers.Chunked_byte_vector.length res_opt + Option.map + Tezos_lazy_containers.Immutable_chunked_byte_vector.length + res_opt let lookup tree key_str = let open Lwt_syntax in @@ -92,7 +94,9 @@ module Make_durable_state match res_opt with | None -> return_none | Some v -> - let+ bts = Tezos_lazy_containers.Chunked_byte_vector.to_bytes v in + let+ bts = + Tezos_lazy_containers.Immutable_chunked_byte_vector.to_bytes v + in Some bts let list tree key_str = diff --git a/src/proto_alpha/lib_sc_rollup_node/wasm_2_0_0_pvm.ml b/src/proto_alpha/lib_sc_rollup_node/wasm_2_0_0_pvm.ml index cec950da0239..d031a672d9ff 100644 --- a/src/proto_alpha/lib_sc_rollup_node/wasm_2_0_0_pvm.ml +++ b/src/proto_alpha/lib_sc_rollup_node/wasm_2_0_0_pvm.ml @@ -82,7 +82,9 @@ module Make_durable_state let key = Tezos_scoru_wasm.Durable.key_of_string_exn key_str in let* durable = decode_durable tree in let+ res_opt = Tezos_scoru_wasm.Durable.find_value durable key in - Option.map Tezos_lazy_containers.Chunked_byte_vector.length res_opt + Option.map + Tezos_lazy_containers.Immutable_chunked_byte_vector.length + res_opt let lookup tree key_str = let open Lwt_syntax in @@ -92,7 +94,9 @@ module Make_durable_state match res_opt with | None -> return_none | Some v -> - let+ bts = Tezos_lazy_containers.Chunked_byte_vector.to_bytes v in + let+ bts = + Tezos_lazy_containers.Immutable_chunked_byte_vector.to_bytes v + in Some bts let list tree key_str = -- GitLab From 9966118c86a509176cd793cd30d38bf51c6d76c5 Mon Sep 17 00:00:00 2001 From: Ilya Peresadin Date: Sat, 6 May 2023 10:49:16 +0100 Subject: [PATCH 2/2] Scoru: Remove eager decoding of subtrees and value in durable storage --- manifest/main.ml | 4 +- opam/tezos-lazy-containers.opam | 1 + src/lib_lazy_containers/dune | 1 + src/lib_lazy_containers/lazy_dirs.mli | 80 --- src/lib_lazy_containers/lazy_fs.ml | 165 ------- src/lib_lazy_containers/lazy_fs.mli | 81 ---- src/lib_lazy_containers/lazy_tree.ml | 459 ++++++++++++++++++ .../{lazy_dirs.ml => lazy_tree.mli} | 71 +-- src/lib_lazy_containers/lazy_tree_sig.ml | 75 +++ src/lib_scoru_wasm/durable.ml | 170 ++----- src/lib_scoru_wasm/durable.mli | 4 +- src/lib_scoru_wasm/durable_pvm.ml | 251 ++++++++++ src/lib_scoru_wasm/durable_pvm.mli | 26 + src/lib_scoru_wasm/durable_sig.ml | 191 ++++++++ src/lib_scoru_wasm/test/dune | 2 +- ...e_shapshot.ml => test_durable_snapshot.ml} | 0 src/lib_tree_encoding/decoding.ml | 21 +- src/lib_tree_encoding/decoding.mli | 7 +- src/lib_tree_encoding/encoding.ml | 19 + src/lib_tree_encoding/encoding.mli | 17 + src/lib_tree_encoding/tezos_tree_encoding.ml | 112 ++--- src/lib_tree_encoding/tezos_tree_encoding.mli | 47 +- .../runtime/durable_storage.ml | 5 +- .../runtime/durable_storage.mli | 16 +- 24 files changed, 1168 insertions(+), 657 deletions(-) delete mode 100644 src/lib_lazy_containers/lazy_dirs.mli delete mode 100644 src/lib_lazy_containers/lazy_fs.ml delete mode 100644 src/lib_lazy_containers/lazy_fs.mli create mode 100644 src/lib_lazy_containers/lazy_tree.ml rename src/lib_lazy_containers/{lazy_dirs.ml => lazy_tree.mli} (57%) create mode 100644 src/lib_lazy_containers/lazy_tree_sig.ml create mode 100644 src/lib_scoru_wasm/durable_pvm.ml create mode 100644 src/lib_scoru_wasm/durable_pvm.mli create mode 100644 src/lib_scoru_wasm/durable_sig.ml rename src/lib_scoru_wasm/test/{test_durable_shapshot.ml => test_durable_snapshot.ml} (100%) diff --git a/manifest/main.ml b/manifest/main.ml index b5d67eaf9fbc..b5f44949edf2 100644 --- a/manifest/main.ml +++ b/manifest/main.ml @@ -1996,7 +1996,7 @@ let lazy_containers = ~synopsis: "A collection of lazy containers whose contents is fetched from \ arbitrary backend on-demand" - ~deps:[zarith; tree_encoding] + ~deps:[octez_base; zarith; tree_encoding] let _lazy_containers_tests = tezt @@ -4225,7 +4225,7 @@ let _octez_scoru_wasm_tests = (* TODO: https://gitlab.com/tezos/tezos/-/issues/5028 Beware: there is a weird test failure when Durable snapshot test doesn't go first *) - "test_durable_shapshot"; + "test_durable_snapshot"; "test_durable_storage"; "test_fixed_nb_ticks"; "test_get_set"; diff --git a/opam/tezos-lazy-containers.opam b/opam/tezos-lazy-containers.opam index b66074b996a4..70f41866a685 100644 --- a/opam/tezos-lazy-containers.opam +++ b/opam/tezos-lazy-containers.opam @@ -10,6 +10,7 @@ license: "MIT" depends: [ "dune" { >= "3.0" } "ocaml" { >= "4.14" } + "tezos-base" "zarith" { >= "1.12" & < "1.13" } "tezos-tree-encoding" ] diff --git a/src/lib_lazy_containers/dune b/src/lib_lazy_containers/dune index 484711152ce5..d07f0eda54f5 100644 --- a/src/lib_lazy_containers/dune +++ b/src/lib_lazy_containers/dune @@ -6,5 +6,6 @@ (public_name tezos-lazy-containers) (instrumentation (backend bisect_ppx)) (libraries + tezos-base zarith tezos-tree-encoding)) diff --git a/src/lib_lazy_containers/lazy_dirs.mli b/src/lib_lazy_containers/lazy_dirs.mli deleted file mode 100644 index f116ea1951ac..000000000000 --- a/src/lib_lazy_containers/lazy_dirs.mli +++ /dev/null @@ -1,80 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2023 TriliTech *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -(** - This module is basically a wrapper around [Lazy_map] with key instantiated to string - that eagerly loads map's keys (but not values) during decoding. - For the more information see [Tezos_tree_encoding.Lazy_dirs_encoding]. - This behaviour resembles how folders on an OS shown. -*) - -(** This module is to work with keys. *) -module Names : Set.S with type elt = String.t - -(** This module is to work with the underlying lazy map holding content. *) -module Map : Lazy_map.S with type key = String.t - -type 'a t = {names : Names.t; contents : 'a Map.t} - -(** [origin dirs] returns the tree of origin of the container, if it exists. *) -val origin : 'a t -> Tezos_tree_encoding.wrapped_tree option - -(** [create names contents] creates lazy dirs. - If [names] is not provided then [Map.loaded_bindings contents] used to initialise names. - If [contents] is not provided as well then empty lazy_dirs will be created. - It is responsibility of the caller to supply consistent [names] and [contents], - for instance, [names] has to be subset of keys of [contents]. -*) -val create : ?names:Names.t -> ?contents:'a Map.t -> unit -> 'a t - -(** [is_empty dirs] returns true if the container is empty, - Relies on size of underlying names. *) -val is_empty : 'a t -> bool - -(** [find dirs key] retrieves the element at [key]. *) -val find : 'a t -> Names.elt -> 'a option Lwt.t - -(** [set dirs key value] sets the element at [key] to [value]. *) -val set : 'a t -> Names.elt -> 'a -> 'a t - -(** [remove dirs key] marks the element at [key] as removed, - this will be synced with the origin during encoding. *) -val remove : 'a t -> Names.elt -> 'a t - -(** [list dirs] lists all the keys in alphabetically sorted order. *) -val list : 'a t -> Names.elt list - -(** [length dirs] returns number of elements. *) -val length : 'a t -> int - -(** [nth_name dirs index] returns [index]-th key. - Aligns with the order of keys of [list]. -*) -val nth_name : 'a t -> int -> Names.elt option - -(** [encoding value_enc] returns an encoding for the container wrt - encoding of the value [value_enc] -*) -val encoding : 'a Tezos_tree_encoding.t -> 'a t Tezos_tree_encoding.t diff --git a/src/lib_lazy_containers/lazy_fs.ml b/src/lib_lazy_containers/lazy_fs.ml deleted file mode 100644 index 253ae635d1ed..000000000000 --- a/src/lib_lazy_containers/lazy_fs.ml +++ /dev/null @@ -1,165 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2023 TriliTech *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -type tree_source = Origin | From_parent - -type 'a t = { - content : 'a option; - dirs : 'a t Lazy_dirs.t; - parent_origin : Tezos_tree_encoding.wrapped_tree; -} - -let origin t = Lazy_dirs.origin t.dirs - -let tree_instance t = - Option.fold - ~none:(t.parent_origin, From_parent) - ~some:(fun org -> (org, Origin)) - (origin t) - -let create_with_empty_dirs content parent_origin = - let dirs = Lazy_dirs.create () in - {content; dirs; parent_origin} - -let rec find_tree tree key = - let open Lwt.Syntax in - match key with - | [] -> Lwt.return_some tree - | step :: steps -> ( - let* maybe_tree = Lazy_dirs.find tree.dirs step in - match maybe_tree with - | Some tree -> find_tree tree steps - | None -> Lwt.return_none) - -let find tree key = - let open Lwt.Syntax in - let+ tree = find_tree tree key in - Option.map (fun tree -> tree.content) tree |> Option.join - -let rec construct_new_tree parent_origin key value_tree = - match key with - | [] -> value_tree - | step :: steps -> - let contents = - Lazy_dirs.Map.( - create - ~values: - (Map.singleton - step - (construct_new_tree parent_origin steps value_tree)) - ()) - in - let dirs = Lazy_dirs.create ~contents () in - {content = None; dirs; parent_origin} - -let rec place_tree tree key f = - let open Lwt.Syntax in - match key with - | [] -> Lwt.return (f (Some tree)) - | step :: steps -> ( - let* maybe_tree = Lazy_dirs.find tree.dirs step in - match maybe_tree with - | Some sub_tree -> - let+ new_tree = place_tree sub_tree steps f in - let dirs = Lazy_dirs.set tree.dirs step new_tree in - {tree with dirs} - | None -> - let dirs = - Lazy_dirs.set - tree.dirs - step - (construct_new_tree tree.parent_origin steps (f None)) - in - Lwt.return {tree with dirs}) - -let add_tree tree key value_tree = place_tree tree key (fun _ -> value_tree) - -let set tree key value = - place_tree tree key @@ function - | None -> create_with_empty_dirs (Some value) tree.parent_origin - | Some tree -> {tree with content = Some value} - -let remove_value tree key = - place_tree tree key @@ function - | None -> create_with_empty_dirs None tree.parent_origin - | Some tree -> {tree with content = None} - -let rec remove tree key = - let open Lwt.Syntax in - match key with - | [] -> Lwt.return tree - | [step] -> Lwt.return {tree with dirs = Lazy_dirs.remove tree.dirs step} - | step :: steps -> ( - let* maybe_tree = Lazy_dirs.find tree.dirs step in - match maybe_tree with - | Some sub_tree -> - let is_empty {content; dirs; _} = - Option.is_none content && Lazy_dirs.is_empty dirs - in - let+ new_subtree = remove sub_tree steps in - if is_empty new_subtree then - (* We remove new_subtree from tree, it shouldn't dangle *) - let tree = {tree with dirs = Lazy_dirs.remove tree.dirs step} in - if is_empty tree then - (* If [step] was the only child of [tree] and [tree] has no value, - then we should remove current node as well *) - create_with_empty_dirs None sub_tree.parent_origin - else - (* If [new_tree] is empty: we don't need to store it anymore *) - tree - else - (* Otherwise, just replace old k with new one*) - {tree with dirs = Lazy_dirs.set tree.dirs step new_subtree} - | None -> Lwt.return tree) - -let count_subtrees tree = Lazy_dirs.length tree.dirs - -let list_subtrees tree = Lazy_dirs.list tree.dirs - -let nth_name tree n = if n < 0 then None else Lazy_dirs.nth_name tree.dirs n - -module Encoding = Tezos_tree_encoding.Lazy_fs_encoding.Make (struct - type nonrec 'a t = 'a t - - module Dirs = struct - include Lazy_dirs - - let contents x = x.contents - end - - let dirs x = x.dirs - - let content x = x.content - - let create ?value ?dirs origin = - { - content = value; - dirs = (match dirs with None -> Lazy_dirs.create () | Some dirs -> dirs); - (* Not exactly parent origin but ours *) - parent_origin = origin; - } -end) - -let encoding = Encoding.lazy_fs diff --git a/src/lib_lazy_containers/lazy_fs.mli b/src/lib_lazy_containers/lazy_fs.mli deleted file mode 100644 index f93cd7f6004b..000000000000 --- a/src/lib_lazy_containers/lazy_fs.mli +++ /dev/null @@ -1,81 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2023 TriliTech *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -(** - This module provides an interface of tree, - where nodes accessed by a path (list of strings) - and each intermediate node can hold a value. - It is lazy decodable and take advantage of [Lazy_dirs]. -*) - -type tree_source = Origin | From_parent - -type 'a t = { - content : 'a option; - dirs : 'a t Lazy_dirs.t; - parent_origin : Tezos_tree_encoding.wrapped_tree; -} - -(** [origin fs] returns the tree origin of the container, if it exists. *) -val origin : 'a t -> Tezos_tree_encoding.wrapped_tree option - -(** [tree_instance fs] returns either origin tree of the current node - or a parent's origin. Necessary to be able to encode Lazy_fs to this instance. -*) -val tree_instance : 'a t -> Tezos_tree_encoding.wrapped_tree * tree_source - -(** [find_tree fs path] finds a tree node corresponding to the [path]. *) -val find_tree : 'a t -> string list -> 'a t option Lwt.t - -(** [find fs path] finds a node value corresponding to the [path]. *) -val find : 'a t -> string list -> 'a option Lwt.t - -(** [add_tree fs path subtree] adds a subtree under the given [path]. *) -val add_tree : 'a t -> string list -> 'a t -> 'a t Lwt.t - -(** [set fs path value] set a value of the node corresponding to [path] to [value]. *) -val set : 'a t -> string list -> 'a -> 'a t Lwt.t - -(** [remove fs path] removes a subtree under the given [path] togehter with its value. *) -val remove : 'a t -> string list -> 'a t Lwt.t - -(** [remove_value fs path] removes a subtree's value under the given [path]. *) -val remove_value : 'a t -> string list -> 'a t Lwt.t - -(** [count_subtrees fs] returns number of direct subtrees of the given [fs]. *) -val count_subtrees : 'a t -> int - -(** [list_subtrees fs] returns subtrees of the given [fs] in alphabetically sorted order. *) -val list_subtrees : 'a t -> string list - -(** [nth_name fs index] returns [index]-th subtree of the given [fs]. - Aligns with the order of keys of [list_subtrees]. -*) -val nth_name : 'a t -> int -> string option - -(** [encoding value_enc] returns an encoding for the container wrt - encoding of the value [value_enc] -*) -val encoding : 'a Tezos_tree_encoding.t -> 'a t Tezos_tree_encoding.t diff --git a/src/lib_lazy_containers/lazy_tree.ml b/src/lib_lazy_containers/lazy_tree.ml new file mode 100644 index 000000000000..3688d8269c3c --- /dev/null +++ b/src/lib_lazy_containers/lazy_tree.ml @@ -0,0 +1,459 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2023 TriliTech *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +module type VALUE = sig + type t + + val encoding : t Tezos_tree_encoding.t +end + +module Make (Value : VALUE) = struct + open Tezos_tree_encoding + + type tree_source = Origin | From_parent + + type elt = Value.t + + module Map = Map.Make (String) + module Set = Set.Make (String) + + (* This module keeps a map of direct subtrees, + basically for each tree "step" storing + information about corresponding subtree. + + For a "step" a corresponding subtree could be either decoded from an origin, + hence, a decoded subtree is just kept cached, or alternatively, + a subtree could be rewritten with new subtree. + This distinguishment made in order to omit encoding unchanged subtrees. + + Also apart from mantaining this map, + [length_at_least] is being recomputed accordingly on each change. + This is a number of existing subtrees, essentially, + just number of cached subtrees plus number of rewritten ones. + [length_at_least] is necessary to put off encoding values back to tree + as long as possible in [is_empty] function, + which is being extensively used in [remove_tree]/[remove_value] ones. + *) + module Subtrees = struct + type 'a subtree_status = [`Cached of 'a option | `Rewrite of 'a | `Removed] + + type 'a t = {changes : 'a subtree_status Map.t; length_at_least : int} + + let empty = {changes = Map.empty; length_at_least = 0} + + (* Create only cached values out of key-value pairs. *) + let new_cache cache = + { + changes = + Map.of_seq @@ List.to_seq + @@ List.map (fun (step, x) -> (step, `Cached x)) cache; + length_at_least = + List.length @@ List.filter (fun (_, x) -> Option.is_some x) cache; + } + + (* Update a step in changes map with `Rewritten + and recompute length_at_least carefully *) + let set_subtree step new_subtree subtrees = + let new_changes = Map.add step (`Rewrite new_subtree) subtrees.changes in + let new_length_at_least = + match Map.find_opt step subtrees.changes with + | None | Some (`Cached None) -> subtrees.length_at_least + 1 + | Some (`Rewrite _) | Some (`Cached (Some _)) -> + subtrees.length_at_least + | Some `Removed -> subtrees.length_at_least + 1 + in + {changes = new_changes; length_at_least = new_length_at_least} + + (* Update a step in changes map with `Removed + and recompute length_at_least carefully *) + let remove_subtree step subtrees = + let new_changes = Map.add step `Removed subtrees.changes in + let new_length_at_least = + match Map.find_opt step subtrees.changes with + | None | Some (`Cached None) | Some `Removed -> subtrees.length_at_least + | Some (`Rewrite _) | Some (`Cached (Some _)) -> + subtrees.length_at_least - 1 + in + {changes = new_changes; length_at_least = new_length_at_least} + + (* Update a step in changes map with `Cached + and recompute length_at_least carefully. + When a step is being cached it cannot exist in a changes map. + *) + let cache step new_subtree subtrees = + { + changes = Map.add step (`Cached new_subtree) subtrees.changes; + length_at_least = + (subtrees.length_at_least + + if Option.is_some new_subtree then 1 else 0); + } + + let subtrees_diff t = + List.filter_map (function + | step, `Removed -> Some (step, None) + | step, `Rewrite x -> Some (step, Some x) + | _ -> None) + @@ Map.bindings t.changes + + let known_values t = + List.filter_map (function + | step, `Cached x -> Some (step, x) + | step, `Rewrite x -> Some (step, Some x) + | _ -> None) + @@ Map.bindings t.changes + end + + (* Those mutable fields look untrustworthy, + however, it's implemented in this way in order + to update those fields in read methods. + It's been done in order to avoid returning from all the read methods + new instance of the lazy_tree. + + The only questionable aspect when a node is being copied, + then those mutable fields are shared between two nodes but + it's more or less safe because the implementation + written in a way, that whenever we change a node + (add, remove a subtree or add, remove a value), + modified node will be copied, what will lead to unbinding + fields of those two nodes from each other. + + A little bit motivation why [origin], [subtrees], [value] are + stored here explicitly, instead of using lazy_map: + 1. producers function (encode_subtree & encode_value) return option + instead of throwing an exception + 2. value and subtrees share common origin + 3. need to keep track of length_at_least, + in order to implement [is_empty] in more effective way + 4. better control of what should be cached + *) + type t = { + mutable origin : Tezos_tree_encoding.wrapped_tree option; + mutable subtrees : t Subtrees.t; + mutable value : Value.t Subtrees.t; + parent_origin : Tezos_tree_encoding.wrapped_tree; + } + + let origin t = t.origin + + let tree_instance t = + Option.fold + ~none:(t.parent_origin, From_parent) + ~some:(fun org -> (org, Origin)) + (origin t) + + let create_from_value parent_origin value = + { + origin = None; + subtrees = Subtrees.empty; + value = + Option.fold + ~none:(Subtrees.cache "@" None Subtrees.empty) + ~some:(fun x -> Subtrees.set_subtree "@" x Subtrees.empty) + value; + parent_origin; + } + + module Encoding = Lazy_tree_encoding.Make (struct + type nonrec elt = elt + + type nonrec lt = t + + let value_encoding = Value.encoding + + let origin t = t.origin + + let subtrees_diff t = Subtrees.subtrees_diff t.subtrees + + let value t = + match Subtrees.subtrees_diff t.value with + | [(_, Some v)] -> `NewValue v + | [(_, None)] -> `Removed + | _ -> `NoChange + + let create origin = + { + origin = Some origin; + subtrees = Subtrees.empty; + value = Subtrees.empty; + parent_origin = origin; + } + end) + + (* This module contains auxiliary methods which are being used in + implementation of the exposed ones from lazy_tree. + Most of the methods in Aux are intend to decode/enconde and properly update caches/changes. *) + module Aux = struct + (* This function encodes the given lazy_tree to an irmin tree. + + If origin of the tree is known, we encode a tree back to this origin, + otherwise we will encode to a freshly created non-existing path in the tree. + + The function might return None if the all subkeys have been removed + in the given tree, what essentially means that final tree is empty *) + let encode_tree tree = + let open Lwt.Syntax in + let Wrapped_tree (underlying, (module M)), origin_soruce = + tree_instance tree + in + let module M_runner = Tezos_tree_encoding.Runner.Make (M) in + let lazy_tree_encoding = Encoding.lazy_tree () in + let+ new_underlying = + match origin_soruce with + | Origin -> + Lwt.map Option.some + @@ M_runner.encode lazy_tree_encoding tree underlying + | From_parent -> + let unaccessible_path = ["@@@@"; "unaccessible_path"] in + let* new_origin = + M_runner.encode + (scope unaccessible_path lazy_tree_encoding) + tree + underlying + in + M.find_tree new_origin unaccessible_path + in + Option.map + (fun new_uderlying -> Wrapped_tree (new_uderlying, (module M))) + new_underlying + + (* This function encode both addition and deletion changes back to origin + but retain additions as a cache. *) + let flush_changes tree = + let open Lwt.Syntax in + let+ new_origin = encode_tree tree in + tree.origin <- new_origin ; + (* Remove deletions from changes, and turn additions to cached values *) + tree.subtrees <- Subtrees.new_cache @@ Subtrees.known_values tree.subtrees ; + tree.value <- Subtrees.new_cache @@ Subtrees.known_values tree.value ; + new_origin + + let get_or_decode_subtree_general ~decode ~on_decode step origin_opt + subtrees = + let open Lwt.Syntax in + match Map.find_opt step subtrees.Subtrees.changes with + | None -> + let+ decoded_subtree = + match origin_opt with + | None -> Lwt.return_none + | Some origin -> decode origin + in + on_decode decoded_subtree ; + decoded_subtree + | Some `Removed -> Lwt.return_none + | Some (`Cached value) -> Lwt.return value + | Some (`Rewrite value) -> Lwt.return_some value + + let get_or_decode_subtree step tree = + get_or_decode_subtree_general + ~decode:(fun org -> Encoding.decode_subtree org step) + ~on_decode:(fun decoded_subtree -> + (* Cache decoded_subtree, avoid caching an absent subtree *) + if Option.is_some decoded_subtree then + tree.subtrees <- Subtrees.cache step decoded_subtree tree.subtrees) + step + tree.origin + tree.subtrees + + let get_or_decode_value tree = + get_or_decode_subtree_general + ~on_decode:(fun decoded_subtree -> + tree.value <- Subtrees.cache "@" decoded_subtree tree.value) + ~decode:(fun org -> Encoding.decode_value org) + "@" + tree.origin + tree.value + + (* This function aspires to postone encoding back to tree as much as possible *) + let is_empty tree = + let open Lwt.Syntax in + (* There are additions or value exists, meaning NOT EMPTY for sure *) + if tree.subtrees.length_at_least > 0 || tree.value.length_at_least > 0 + then Lwt.return_false + (* There is no origin, additions is empty and value is either removed or unknown, + then the tree IS empty for sure *) + else if + Option.is_none (origin tree) + && tree.subtrees.length_at_least = 0 + && tree.value.length_at_least = 0 + then Lwt.return_true + (* Otherwise we need to encode changes back to the tree to check if it's empty or not *) + else + let* encoded = flush_changes tree in + match encoded with + | None -> Lwt.return_true + | Some encoded -> Lwt.map (fun x -> x = 0) @@ Wrapped.length encoded [] + end + + let rec find_tree tree key = + let open Lwt.Syntax in + match key with + | [] -> Lwt.return_some tree + | step :: steps -> ( + let* maybe_subtree = Aux.get_or_decode_subtree step tree in + match maybe_subtree with + | Some subtree -> find_tree subtree steps + | None -> Lwt.return_none) + + let find_value tree key = + let open Lwt.Syntax in + let* tree = find_tree tree key in + Option.fold + ~none:Lwt.return_none + ~some:(fun tree -> Aux.get_or_decode_value tree) + tree + + let rec construct_branch parent_origin key inserting_tree = + match key with + | [] -> inserting_tree + | step :: steps -> + let tree = create_from_value parent_origin None in + let subtree = construct_branch parent_origin steps inserting_tree in + {tree with subtrees = Subtrees.set_subtree step subtree tree.subtrees} + + let rec modify_tree tree key f = + let open Lwt.Syntax in + match key with + | [] -> Lwt.return (f @@ Some tree) + | step :: steps -> ( + let* maybe_subtree = Aux.get_or_decode_subtree step tree in + match maybe_subtree with + | Some subtree -> + let+ modified_subtree = modify_tree subtree steps f in + { + tree with + subtrees = + Subtrees.set_subtree step modified_subtree tree.subtrees; + } + | None -> + let subtree = construct_branch tree.parent_origin steps (f None) in + Lwt.return + { + tree with + subtrees = Subtrees.set_subtree step subtree tree.subtrees; + }) + + let add_tree tree key value_tree = modify_tree tree key (fun _ -> value_tree) + + let set tree key value = + modify_tree tree key @@ function + | Some subtree -> + {subtree with value = Subtrees.set_subtree "@" value tree.value} + | None -> create_from_value tree.parent_origin (Some value) + + let rec remove_generic tree key action = + let open Lwt.Syntax in + match (key, action) with + | [], `Remove_tree -> Lwt.return tree + | [], `Remove_value -> + Lwt.return {tree with value = Subtrees.remove_subtree "@" tree.value} + | [step], `Remove_tree -> + Lwt.return + {tree with subtrees = Subtrees.remove_subtree step tree.subtrees} + | step :: steps, _ -> ( + let* maybe_subtree = Aux.get_or_decode_subtree step tree in + match maybe_subtree with + | Some subtree -> + let* new_subtree = remove_generic subtree steps action in + let* new_subtree_empty = Aux.is_empty new_subtree in + if new_subtree_empty then + (* We remove new_subtree from tree, it shouldn't dangle *) + let tree = + { + tree with + subtrees = Subtrees.remove_subtree step tree.subtrees; + } + in + let+ tree_empty = Aux.is_empty tree in + if tree_empty then + (* If [step] was the only child of [tree] and [tree] has no value, + then we should remove current node as well *) + create_from_value subtree.parent_origin None + else + (* If [new_tree] is empty: we don't need to store it anymore *) + tree + else + (* Otherwise, just replace old k with new one*) + Lwt.return + @@ { + tree with + subtrees = + Subtrees.set_subtree step new_subtree tree.subtrees; + } + | None -> Lwt.return tree) + + let remove_value tree key = remove_generic tree key `Remove_value + + let remove_tree tree key = remove_generic tree key `Remove_tree + + let count_subtrees tree = + let open Lwt.Syntax in + (* We have to flush changes in order to keep backward compatibility with irmin. *) + let* encoded = Aux.flush_changes tree in + match encoded with + | None -> Lwt.return 0 + | Some encoded -> Wrapped.length encoded [] + + let hash_value tree = + (* TODO not flush the whole tree, we only need to flush "@" subtree *) + let open Lwt.Syntax in + let value_marker = "@" in + (* We have to flush changes in order to keep backward compatibility with irmin. *) + let* encoded = Aux.flush_changes tree in + match encoded with + | None -> Lwt.return_none + | Some encoded -> + let+ value_subtree = Wrapped.find_tree encoded [value_marker] in + Option.map Wrapped.hash value_subtree + + let hash_tree tree = + let open Lwt.Syntax in + (* We have to flush changes in order to keep backward compatibility with irmin. *) + let* encoded = Aux.flush_changes tree in + match encoded with + | None -> Lwt.return_none + | Some encoded -> Lwt.return @@ Some (Wrapped.hash encoded) + + let list_subtree_names tree ?offset ?length key = + let open Lwt.Syntax in + let* tree = find_tree tree key in + match tree with + | None -> Lwt.return_none + | Some tree -> ( + (* We have to flush changes in order to keep backward compatibility with irmin. *) + let* encoded = Aux.flush_changes tree in + match encoded with + | None -> Lwt.return_none + | Some encoded -> + Lwt.map (fun x -> Option.some @@ List.map fst x) + @@ Wrapped.list encoded ?offset ?length []) + + let encoding = Encoding.lazy_tree () +end + +module CBV_lazy_tree = Make (struct + type t = Immutable_chunked_byte_vector.t + + let encoding = Immutable_chunked_byte_vector.encoding +end) diff --git a/src/lib_lazy_containers/lazy_dirs.ml b/src/lib_lazy_containers/lazy_tree.mli similarity index 57% rename from src/lib_lazy_containers/lazy_dirs.ml rename to src/lib_lazy_containers/lazy_tree.mli index 6df835f0d720..fc571ee41edc 100644 --- a/src/lib_lazy_containers/lazy_dirs.ml +++ b/src/lib_lazy_containers/lazy_tree.mli @@ -23,62 +23,25 @@ (* *) (*****************************************************************************) -module Names = Set.Make (String) +(** + This module provides an interface of tree, + where nodes accessed by a path (list of strings) + and each intermediate node can contain a value. -module Map = Lazy_map.Make (struct - include String + The container strongly relies on a underlying wrapped_tree, + where original tree is persistent. + Subtrees of each node and value get decoded on demand, + and when decoded they are cached and kept in the + internal in-memory representation. +*) - let to_string = Fun.id -end) +module type VALUE = sig + type t -type 'a t = {names : Names.t; contents : 'a Map.t} + val encoding : t Tezos_tree_encoding.t +end -let origin fs = Map.origin @@ fs.contents +module Make (Value : VALUE) : Lazy_tree_sig.S with type elt := Value.t -let create ?names ?contents () = - let lazy_value x ~default = match x with Some x -> x | None -> default () in - { - names = - lazy_value names ~default:(fun () -> - match contents with - | None -> Names.empty - | Some contents -> - Map.loaded_bindings contents |> List.map fst |> Names.of_list); - contents = lazy_value contents ~default:Map.create; - } - -let is_empty {names; _} = Names.is_empty names - -let find tree key = - let open Lwt.Syntax in - if Names.mem key tree.names then - let+ content = Map.get key tree.contents in - Some content - else Lwt.return_none - -let set tree key value = - {names = Names.add key tree.names; contents = Map.set key value tree.contents} - -let remove tree key = - {names = Names.remove key tree.names; contents = Map.remove key tree.contents} - -let list tree = Names.elements tree.names - -let length tree = Names.cardinal tree.names - -let nth_name tree n = List.nth_opt (Names.elements tree.names) n - -module Encoding = Tezos_tree_encoding.Lazy_dirs_encoding.Make (struct - type nonrec 'a t = 'a t - - module Names = Names - module Map = Map - - let contents x = x.contents - - let create = create - - let remove = remove -end) - -let encoding = Encoding.lazy_dirs +module CBV_lazy_tree : + Lazy_tree_sig.S with type elt := Immutable_chunked_byte_vector.t diff --git a/src/lib_lazy_containers/lazy_tree_sig.ml b/src/lib_lazy_containers/lazy_tree_sig.ml new file mode 100644 index 000000000000..1c9044405a92 --- /dev/null +++ b/src/lib_lazy_containers/lazy_tree_sig.ml @@ -0,0 +1,75 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2023 TriliTech *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +module type S = sig + type elt + + type t + + module Set : Set.S with type elt = string + + module Map : Map.S with type key = string + + type tree_source = Origin | From_parent + + (** [origin fs] returns the tree origin of the container, if it exists. *) + val origin : t -> Tezos_tree_encoding.wrapped_tree option + + (** [tree_instance fs] returns either origin tree of the current node + or a parent's origin. Necessary to be able to encode Lazy_fs to this instance. *) + val tree_instance : t -> Tezos_tree_encoding.wrapped_tree * tree_source + + (** [find_tree fs path] finds a tree node corresponding to the [path]. *) + val find_tree : t -> string list -> t option Lwt.t + + (** [find fs path] finds a node value corresponding to the [path]. *) + val find_value : t -> string list -> elt option Lwt.t + + (** [add_tree fs path subtree] adds a subtree under the given [path]. *) + val add_tree : t -> string list -> t -> t Lwt.t + + (** [set fs path value] set a value of the node corresponding to [path] to [value]. *) + val set : t -> string list -> elt -> t Lwt.t + + (** [remove fs path] removes a subtree under the given [path] togehter with its value. *) + val remove_tree : t -> string list -> t Lwt.t + + (** [remove_value fs path] removes a subtree's value under the given [path]. *) + val remove_value : t -> string list -> t Lwt.t + + (** [count_subtrees fs] returns number of direct subtrees of the given [fs]. *) + val count_subtrees : t -> int Lwt.t + + val hash_value : t -> Tezos_base.TzPervasives.Context_hash.t option Lwt.t + + val hash_tree : t -> Tezos_base.TzPervasives.Context_hash.t option Lwt.t + + val list_subtree_names : + t -> ?offset:int -> ?length:int -> string list -> string list option Lwt.t + + (** [encoding value_enc] returns an encoding for the container wrt + encoding of the value [value_enc] *) + val encoding : t Tezos_tree_encoding.t +end diff --git a/src/lib_scoru_wasm/durable.ml b/src/lib_scoru_wasm/durable.ml index 0ad0dba80b7a..4dd0c5afccc3 100644 --- a/src/lib_scoru_wasm/durable.ml +++ b/src/lib_scoru_wasm/durable.ml @@ -28,8 +28,9 @@ module Runner = Tezos_tree_encoding.Runner.Make (Tezos_tree_encoding.Wrapped) module E = Tezos_tree_encoding module Storage = Tezos_webassembly_interpreter.Durable_storage module CBV = Tezos_lazy_containers.Immutable_chunked_byte_vector +module Lazy_tree = Tezos_lazy_containers.Lazy_tree.CBV_lazy_tree -type t = CBV.t Tezos_lazy_containers.Lazy_fs.t +type t = Lazy_tree.t (* The maximum size of bytes allowed to be read/written at once. *) let max_store_io_size = 2048L @@ -50,7 +51,7 @@ exception Readonly_value exception Durable_empty -let encoding = Tezos_lazy_containers.Lazy_fs.encoding CBV.encoding +let encoding = Lazy_tree.encoding type kind = Value | Directory @@ -101,107 +102,9 @@ let assert_max_bytes max_bytes = let key_contents = function Readonly k | Writeable k -> k -(* This module contains helpers, - that used to implement Durable storage functions - from the previous versions, - in order to keep backward compatibility -*) -module Backward_compatible = struct - module E = Tezos_tree_encoding - module Lazy_fs = Tezos_lazy_containers.Lazy_fs - - let value_marker = "@" - - (* This function encodes either Lazy_fs subtree to irmin tree - or just value, depending on [kind]. - If origin of the Lazy_fs is known, - we encode a tree to this origin, - otherwise we will encode to a freshly created in-memory tree. - - The function might return None if the all subkeys were removed - in the passed Lazy_fs instance. - - This function doesn't retain encoded tree as a new origin. - This might cause perfomance degrade (for instance, - for repeating invocation of [subtree_name_at]). - TODO: https://gitlab.com/tezos/tezos/-/issues/5287 - *) - let encode_to_tree ?(kind = Directory) subtree : E.wrapped_tree option Lwt.t = - let open Lwt_syntax in - let value = subtree.Lazy_fs.content in - let value_encoding = E.scope_option ["@"] CBV.encoding in - let E.Wrapped_tree (underlying, (module M)), origin_soruce = - Lazy_fs.tree_instance subtree - in - let unaccessible_path = ["@"; "unaccessible_path"] in - let module M_runner = E.Runner.Make (M) in - let+ new_uderlying = - match (kind, origin_soruce) with - | Directory, Origin -> - Lwt.map Option.some @@ M_runner.encode encoding subtree underlying - | Directory, From_parent -> - let* tree = - M_runner.encode - (E.scope unaccessible_path encoding) - subtree - underlying - in - M.find_tree tree unaccessible_path - | Value, Origin -> - Lwt.map Option.some @@ M_runner.encode value_encoding value underlying - | Value, From_parent -> - let* tree = - M_runner.encode - (E.scope unaccessible_path value_encoding) - value - underlying - in - M.find_tree tree unaccessible_path - in - Option.map - (fun new_uderlying -> E.Wrapped_tree (new_uderlying, (module M))) - new_uderlying - - let hash ~kind subtree = - let open Lwt_syntax in - let* wrapped_opt = encode_to_tree ~kind subtree in - match wrapped_opt with - | None -> Lwt.return_none - | Some (E.Wrapped_tree (tree, (module T))) -> - let+ opt_tree = - match kind with - | Value -> T.find_tree tree [value_marker] - | Directory -> Lwt.return_some tree - in - Option.map T.hash opt_tree - - let list subtree = - let open Lwt.Syntax in - let* wrapped_opt = encode_to_tree subtree in - match wrapped_opt with - | None -> Lwt.return [] - | Some (E.Wrapped_tree (tree, (module T))) -> - let+ subtrees = T.list tree [] in - List.map (fun (name, _) -> if name = "@" then "" else name) subtrees - - let subtree_name_at subtree index = - let open Lwt.Syntax in - let* wrapped_opt = encode_to_tree subtree in - match wrapped_opt with - | None -> raise (Index_too_large index) - | Some (E.Wrapped_tree (tree, (module T))) -> ( - let* list = T.list ~offset:index ~length:1 tree [] in - let nth = List.nth list 0 in - match nth with - | Some (step, _) when Compare.String.(step = value_marker) -> - Lwt.return "" - | Some (step, _) -> Lwt.return step - | None -> raise (Index_too_large index)) -end - let find_value (tree : t) key = let key = key_contents key in - Tezos_lazy_containers.Lazy_fs.find tree key + Lazy_tree.find_value tree key let find_value_exn tree key = let open Lwt.Syntax in @@ -212,7 +115,7 @@ let find_value_exn tree key = let find_tree_exn (tree : t) key = let open Lwt.Syntax in let key = key_contents key in - let+ opt = Tezos_lazy_containers.Lazy_fs.find_tree tree key in + let+ opt = Lazy_tree.find_tree tree key in match opt with None -> raise Tree_not_found | Some subtree -> subtree let copy_tree_exn (tree : t) ?(edit_readonly = false) from_key to_key = @@ -220,36 +123,46 @@ let copy_tree_exn (tree : t) ?(edit_readonly = false) from_key to_key = if not edit_readonly then assert_key_writeable to_key ; let* move_tree = find_tree_exn tree from_key in let to_key = key_contents to_key in - Tezos_lazy_containers.Lazy_fs.add_tree tree to_key move_tree + Lazy_tree.add_tree tree to_key move_tree let list (tree : t) key = let open Lwt.Syntax in let key = key_contents key in - let* subtree = Tezos_lazy_containers.Lazy_fs.find_tree tree key in - match subtree with - | None -> Lwt.return [] - | Some subtree -> Backward_compatible.list subtree + let+ subtree_list = Lazy_tree.list_subtree_names tree key in + match subtree_list with + | None -> [] + | Some subtree_list -> + List.map (fun name -> if name = "@" then "" else name) subtree_list let count_subtrees tree key = let open Lwt.Syntax in let key = key_contents key in - let+ tree = Tezos_lazy_containers.Lazy_fs.find_tree tree key in + let* tree = Lazy_tree.find_tree tree key in match tree with - | Some tree -> - Tezos_lazy_containers.Lazy_dirs.length tree.dirs - + Option.fold ~none:0 ~some:(fun _ -> 1) tree.content - | None -> 0 + | Some tree -> Lazy_tree.count_subtrees tree + | None -> Lwt.return 0 let delete ?(edit_readonly = false) ~kind tree key = if not edit_readonly then assert_key_writeable key ; match kind with - | Value -> Tezos_lazy_containers.Lazy_fs.remove_value tree (key_contents key) - | Directory -> Tezos_lazy_containers.Lazy_fs.remove tree (key_contents key) + | Value -> Lazy_tree.remove_value tree (key_contents key) + | Directory -> Lazy_tree.remove_tree tree (key_contents key) let subtree_name_at tree key (index : int) : string Lwt.t = let open Lwt.Syntax in + let value_marker = "@" in let* subtree = find_tree_exn tree key in - Backward_compatible.subtree_name_at subtree index + let* subtree_names = + Lazy_tree.list_subtree_names ~offset:index ~length:1 subtree [] + in + match subtree_names with + | None -> raise (Index_too_large index) + | Some subtree_names -> ( + let nth = List.nth subtree_names 0 in + match nth with + | Some step when Compare.String.(step = value_marker) -> Lwt.return "" + | Some step -> Lwt.return step + | None -> raise (Index_too_large index)) let move_tree_exn tree from_key to_key = let open Lwt.Syntax in @@ -257,16 +170,19 @@ let move_tree_exn tree from_key to_key = assert_key_writeable to_key ; let* move_tree = find_tree_exn tree from_key in let* tree = delete ~kind:Directory tree from_key in - Tezos_lazy_containers.Lazy_fs.add_tree tree (key_contents to_key) move_tree + Lazy_tree.add_tree tree (key_contents to_key) move_tree let hash ~kind (tree : t) key : Context_hash.t option Lwt.t = let open Lwt.Syntax in let key = key_contents key in - let* subtree = Tezos_lazy_containers.Lazy_fs.find_tree tree key in - Option.fold - ~none:Lwt.return_none - ~some:(Backward_compatible.hash ~kind) - subtree + let* subtree = Lazy_tree.find_tree tree key in + + match subtree with + | None -> Lwt.return_none + | Some subtree -> ( + match kind with + | Value -> Lazy_tree.hash_value subtree + | Directory -> Lazy_tree.hash_tree subtree) let hash_exn ~kind tree key = let open Lwt.Syntax in @@ -282,17 +198,15 @@ let hash_exn ~kind tree key = let set_value_exn (tree : t) ?(edit_readonly = false) key str = if not edit_readonly then assert_key_writeable key ; let key = key_contents key in - Tezos_lazy_containers.Lazy_fs.set tree key (CBV.of_string str) + Lazy_tree.set tree key (CBV.of_string str) let create_value_exn tree ?(edit_readonly = false) key size = let open Lwt.Syntax in if not edit_readonly then assert_key_writeable key ; let key = key_contents key in - let* opt = Tezos_lazy_containers.Lazy_fs.find tree key in + let* opt = Lazy_tree.find_tree tree key in match opt with - | None -> - Lwt.map Option.some - @@ Tezos_lazy_containers.Lazy_fs.set tree key (CBV.allocate size) + | None -> Lwt.map Option.some @@ Lazy_tree.set tree key (CBV.allocate size) | Some _subtree -> Lwt.return_none let write_value_exn tree ?(edit_readonly = false) key offset bytes = @@ -303,7 +217,7 @@ let write_value_exn tree ?(edit_readonly = false) key offset bytes = assert_max_bytes num_bytes ; let key = key_contents key in - let* opt = Tezos_lazy_containers.Lazy_fs.find tree key in + let* opt = Lazy_tree.find_value tree key in let value = match opt with None -> CBV.allocate 0L | Some cbv -> cbv in let vec_len = CBV.length value in if offset > vec_len then raise (Out_of_bounds (offset, vec_len)) ; @@ -312,7 +226,7 @@ let write_value_exn tree ?(edit_readonly = false) key offset bytes = if Int64.compare grow_by 0L > 0 then CBV.grow value grow_by else value in let* value = CBV.store_bytes value offset @@ Bytes.of_string bytes in - Tezos_lazy_containers.Lazy_fs.set tree key value + Lazy_tree.set tree key value let read_value_exn tree key offset num_bytes = let open Lwt.Syntax in diff --git a/src/lib_scoru_wasm/durable.mli b/src/lib_scoru_wasm/durable.mli index 0d338e6c5e84..e240762f999c 100644 --- a/src/lib_scoru_wasm/durable.mli +++ b/src/lib_scoru_wasm/durable.mli @@ -24,9 +24,7 @@ (*****************************************************************************) (** [t] provides an interface of the tree of [immutable_chunked_byte_vector] *) -type t = - Tezos_lazy_containers.Immutable_chunked_byte_vector.t - Tezos_lazy_containers.Lazy_fs.t +type t = Tezos_lazy_containers.Lazy_tree.CBV_lazy_tree.t (** [key] was too long, or contained invalid steps. *) exception Invalid_key of string diff --git a/src/lib_scoru_wasm/durable_pvm.ml b/src/lib_scoru_wasm/durable_pvm.ml new file mode 100644 index 000000000000..4dd0c5afccc3 --- /dev/null +++ b/src/lib_scoru_wasm/durable_pvm.ml @@ -0,0 +1,251 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022-2023 TriliTech *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +module T = Tezos_tree_encoding.Wrapped +module Runner = Tezos_tree_encoding.Runner.Make (Tezos_tree_encoding.Wrapped) +module E = Tezos_tree_encoding +module Storage = Tezos_webassembly_interpreter.Durable_storage +module CBV = Tezos_lazy_containers.Immutable_chunked_byte_vector +module Lazy_tree = Tezos_lazy_containers.Lazy_tree.CBV_lazy_tree + +type t = Lazy_tree.t + +(* The maximum size of bytes allowed to be read/written at once. *) +let max_store_io_size = 2048L + +exception Invalid_key of string + +exception Index_too_large of int + +exception Value_not_found + +exception Tree_not_found + +exception Out_of_bounds of (int64 * int64) + +exception IO_too_large + +exception Readonly_value + +exception Durable_empty + +let encoding = Lazy_tree.encoding + +type kind = Value | Directory + +type key = Writeable of string list | Readonly of string list + +let of_storage ~default s = + match Storage.to_tree s with Some t -> t | None -> default + +let of_storage_exn s = Storage.to_tree_exn s + +let to_storage d = Storage.of_tree d + +(* A key is bounded to 250 bytes, including the implicit '/durable' prefix. + Additionally, values are implicitly appended with '_'. **) +let max_key_length = 250 - String.length "/durable" - String.length "/@" + +let key_of_string_exn s = + if String.length s > max_key_length then raise (Invalid_key s) ; + let key = + match String.split '/' s with + | "" :: tl -> tl (* Must start with '/' *) + | _ -> raise (Invalid_key s) + in + let assert_valid_char = function + | '.' | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '-' | '_' -> () + | _ -> raise (Invalid_key s) + in + let all_steps_valid = + List.for_all (fun x -> + x <> "" + && + (String.iter assert_valid_char x ; + true)) + in + if all_steps_valid key then + match key with "readonly" :: _ | [] -> Readonly key | _ -> Writeable key + else raise (Invalid_key s) + +let key_of_string_opt s = + try Some (key_of_string_exn s) with Invalid_key _ -> None + +let assert_key_writeable = function + | Readonly _ -> raise Readonly_value + | Writeable _ -> () + +let assert_max_bytes max_bytes = + if max_store_io_size < max_bytes then raise IO_too_large + +let key_contents = function Readonly k | Writeable k -> k + +let find_value (tree : t) key = + let key = key_contents key in + Lazy_tree.find_value tree key + +let find_value_exn tree key = + let open Lwt.Syntax in + let+ opt = find_value tree key in + match opt with None -> raise Value_not_found | Some value -> value + +(** helper function used in the copy/move *) +let find_tree_exn (tree : t) key = + let open Lwt.Syntax in + let key = key_contents key in + let+ opt = Lazy_tree.find_tree tree key in + match opt with None -> raise Tree_not_found | Some subtree -> subtree + +let copy_tree_exn (tree : t) ?(edit_readonly = false) from_key to_key = + let open Lwt.Syntax in + if not edit_readonly then assert_key_writeable to_key ; + let* move_tree = find_tree_exn tree from_key in + let to_key = key_contents to_key in + Lazy_tree.add_tree tree to_key move_tree + +let list (tree : t) key = + let open Lwt.Syntax in + let key = key_contents key in + let+ subtree_list = Lazy_tree.list_subtree_names tree key in + match subtree_list with + | None -> [] + | Some subtree_list -> + List.map (fun name -> if name = "@" then "" else name) subtree_list + +let count_subtrees tree key = + let open Lwt.Syntax in + let key = key_contents key in + let* tree = Lazy_tree.find_tree tree key in + match tree with + | Some tree -> Lazy_tree.count_subtrees tree + | None -> Lwt.return 0 + +let delete ?(edit_readonly = false) ~kind tree key = + if not edit_readonly then assert_key_writeable key ; + match kind with + | Value -> Lazy_tree.remove_value tree (key_contents key) + | Directory -> Lazy_tree.remove_tree tree (key_contents key) + +let subtree_name_at tree key (index : int) : string Lwt.t = + let open Lwt.Syntax in + let value_marker = "@" in + let* subtree = find_tree_exn tree key in + let* subtree_names = + Lazy_tree.list_subtree_names ~offset:index ~length:1 subtree [] + in + match subtree_names with + | None -> raise (Index_too_large index) + | Some subtree_names -> ( + let nth = List.nth subtree_names 0 in + match nth with + | Some step when Compare.String.(step = value_marker) -> Lwt.return "" + | Some step -> Lwt.return step + | None -> raise (Index_too_large index)) + +let move_tree_exn tree from_key to_key = + let open Lwt.Syntax in + assert_key_writeable from_key ; + assert_key_writeable to_key ; + let* move_tree = find_tree_exn tree from_key in + let* tree = delete ~kind:Directory tree from_key in + Lazy_tree.add_tree tree (key_contents to_key) move_tree + +let hash ~kind (tree : t) key : Context_hash.t option Lwt.t = + let open Lwt.Syntax in + let key = key_contents key in + let* subtree = Lazy_tree.find_tree tree key in + + match subtree with + | None -> Lwt.return_none + | Some subtree -> ( + match kind with + | Value -> Lazy_tree.hash_value subtree + | Directory -> Lazy_tree.hash_tree subtree) + +let hash_exn ~kind tree key = + let open Lwt.Syntax in + let+ opt = hash ~kind tree key in + match opt with + | None -> + let exn = + match kind with Value -> Value_not_found | Directory -> Tree_not_found + in + raise exn + | Some hash -> hash + +let set_value_exn (tree : t) ?(edit_readonly = false) key str = + if not edit_readonly then assert_key_writeable key ; + let key = key_contents key in + Lazy_tree.set tree key (CBV.of_string str) + +let create_value_exn tree ?(edit_readonly = false) key size = + let open Lwt.Syntax in + if not edit_readonly then assert_key_writeable key ; + let key = key_contents key in + let* opt = Lazy_tree.find_tree tree key in + match opt with + | None -> Lwt.map Option.some @@ Lazy_tree.set tree key (CBV.allocate size) + | Some _subtree -> Lwt.return_none + +let write_value_exn tree ?(edit_readonly = false) key offset bytes = + if not edit_readonly then assert_key_writeable key ; + + let open Lwt.Syntax in + let num_bytes = Int64.of_int @@ String.length bytes in + assert_max_bytes num_bytes ; + + let key = key_contents key in + let* opt = Lazy_tree.find_value tree key in + let value = match opt with None -> CBV.allocate 0L | Some cbv -> cbv in + let vec_len = CBV.length value in + if offset > vec_len then raise (Out_of_bounds (offset, vec_len)) ; + let grow_by = Int64.(num_bytes |> add offset |> Fun.flip sub vec_len) in + let value = + if Int64.compare grow_by 0L > 0 then CBV.grow value grow_by else value + in + let* value = CBV.store_bytes value offset @@ Bytes.of_string bytes in + Lazy_tree.set tree key value + +let read_value_exn tree key offset num_bytes = + let open Lwt.Syntax in + assert_max_bytes num_bytes ; + + let* value = find_value_exn tree key in + let vec_len = CBV.length value in + + if offset < 0L || offset >= vec_len then + raise (Out_of_bounds (offset, vec_len)) ; + + let num_bytes = + Int64.(num_bytes |> add offset |> min vec_len |> Fun.flip sub offset) + in + let+ bytes = CBV.load_bytes value offset num_bytes in + Bytes.to_string bytes + +module Internal_for_tests = struct + let key_is_readonly = function Readonly _ -> true | Writeable _ -> false + + let key_to_list = key_contents +end diff --git a/src/lib_scoru_wasm/durable_pvm.mli b/src/lib_scoru_wasm/durable_pvm.mli new file mode 100644 index 000000000000..fd2aa01333da --- /dev/null +++ b/src/lib_scoru_wasm/durable_pvm.mli @@ -0,0 +1,26 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022-2023 TriliTech *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +include Durable_sig.S diff --git a/src/lib_scoru_wasm/durable_sig.ml b/src/lib_scoru_wasm/durable_sig.ml new file mode 100644 index 000000000000..2e9718ebaf03 --- /dev/null +++ b/src/lib_scoru_wasm/durable_sig.ml @@ -0,0 +1,191 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022-2023 TriliTech *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +module type S = sig + (** [t] provides an interface of the tree of [immutable_chunked_byte_vector] *) + type t + + (** [key] was too long, or contained invalid steps. *) + exception Invalid_key of string + + (** Invalid index for a subkey *) + exception Index_too_large of int + + (** A value was not found in the durable store. *) + exception Value_not_found + + (** A tree does not exists under key in the durable store. *) + exception Tree_not_found + + (** Attempted to write/read to/from a value at [offset], + beyond the [limit]. *) + exception Out_of_bounds of (int64 * int64) + + (** [Durable_storage.t] was empty. *) + exception Durable_empty + + (** Cannot modify a readonly value. *) + exception Readonly_value + + (** Cannot read from or write to more than 2,048 bytes *) + exception IO_too_large + + (** [encoding] is a [Tezos_tree_encoding] for [t]. *) + val encoding : t Tezos_tree_encoding.t + + val of_storage : + default:t -> Tezos_webassembly_interpreter.Durable_storage.t -> t + + (** @raise Durable_empty *) + val of_storage_exn : Tezos_webassembly_interpreter.Durable_storage.t -> t + + val to_storage : t -> Tezos_webassembly_interpreter.Durable_storage.t + + (** Type describing the behavior of generic functions: + - [Value] indicates the operation should work on the value only + - [Directory] indicates the operation should work on the value and all + subkeys under the given key. + + See [hash], for example. +*) + type kind = Value | Directory + + (** [key] is the type that indexes [t]. It enforces several constraints: + - a key's length is bounded. + - a key is a series of non-empty steps, where + - a step is preceded by '/' + - a step only contains alphanumeric ascii, or dots ('.') *) + type key + + (** [max_key_length] is the maximum length of a key in bytes. *) + val max_key_length : int + + (** @raise Invalid_key *) + val key_of_string_exn : string -> key + + val key_of_string_opt : string -> key option + + (** [find_value durable key] optionally looks for the value encoded at [key] + in [durable]. *) + val find_value : + t -> + key -> + Tezos_lazy_containers.Immutable_chunked_byte_vector.t option Lwt.t + + (** @raise Value_not_found *) + val find_value_exn : + t -> key -> Tezos_lazy_containers.Immutable_chunked_byte_vector.t Lwt.t + + (** [copy_tree_exn tree ?edit_readonly from_key to_key] produces a new tree in which a copy of + the entire subtree at from_key is copied to to_key. + + [~edit_readonly:true] allows a a tree to be copied into a readonly location. + + @raise Readonly_value +*) + val copy_tree_exn : t -> ?edit_readonly:bool -> key -> key -> t Lwt.t + + (** [move_tree_exn tree from_key to_key] produces a new tree in which + the entire subtree at from_key is moved to to_key. + + @raise Readonly_value +*) + val move_tree_exn : t -> key -> key -> t Lwt.t + + (** [list durable key] returns the subkeys under [key]. *) + val list : t -> key -> string list Lwt.t + + (** [count_subtrees durable key] returns the number of subtrees under [key]. *) + val count_subtrees : t -> key -> int Lwt.t + + (** [subtree_name_at durable key n] returns the name of the n_th subtree + under [key]. *) + val subtree_name_at : t -> key -> int -> string Lwt.t + + (** [delete ?edit_readonly ~kind durable key] deletes the value of [key] if + [kind = `Value], and subtrees and/or values of [key] if [kind = `All]. + + @raise Readonly_value when [edit_readonly] is not set while trying + to edit the readonly section. +*) + val delete : ?edit_readonly:bool -> kind:kind -> t -> key -> t Lwt.t + + (** [hash ~kind durable key] retrieves the tree hash of the value (if [kind = + Value]) or the complete directory ([kind = Directory]) at the given [key]. + This is not the same as the hash of the value. *) + val hash : kind:kind -> 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 complete directory ([kind = Directory]) 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 = Value] + @raise Tree_not_found when [key] is not found and [kind = Directory]. *) + val hash_exn : kind:kind -> 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 + key without fetching it. *) + val set_value_exn : t -> ?edit_readonly:bool -> key -> string -> t Lwt.t + + (** [create_value_exn ?edit_readonly durable key size] allocates a new value of + [size] at the given [key]. Returns [Some durable] if the value didn't exist, + and [None] if there was already a value at the given [key] + + @raise Invalid_key if the key is invalid. + @raise Readonly_value iff [edit_readonly] is not set to [true] + when attempting to write in the [readonly] section. +*) + val create_value_exn : + t -> ?edit_readonly:bool -> key -> int64 -> t option Lwt.t + + (** [write_value_exn ?edit_readonly durable key offset bytes] writes + [bytes] to [key], starting at the given [offset]. + + If no value at [key] exists, it is created. + + [~edit_readonly:true] allows a value to be written into a readonly location. + + @raise Out_of_bounds + @raise Readonly_value iff [edit_readonly] is not set to [true] + when attempting to write in the [readonly] section. +*) + val write_value_exn : + t -> ?edit_readonly:bool -> key -> int64 -> string -> t Lwt.t + + (** [read_value durable key offset max_bytes] reads up to [max_bytes] + bytes from the value at [key], starting at the given [offset]. + + @raise Value_not_found when [key] is not found. + @raise Out_of_bounds when [offset] is larger than the value. +*) + val read_value_exn : t -> key -> int64 -> int64 -> string Lwt.t + + module Internal_for_tests : sig + val key_is_readonly : key -> bool + + val key_to_list : key -> string list + end +end diff --git a/src/lib_scoru_wasm/test/dune b/src/lib_scoru_wasm/test/dune index b58c0cda29b1..ec2e2c86501c 100644 --- a/src/lib_scoru_wasm/test/dune +++ b/src/lib_scoru_wasm/test/dune @@ -33,7 +33,7 @@ (modules test_ast_generators test_debug - test_durable_shapshot + test_durable_snapshot test_durable_storage test_fixed_nb_ticks test_get_set diff --git a/src/lib_scoru_wasm/test/test_durable_shapshot.ml b/src/lib_scoru_wasm/test/test_durable_snapshot.ml similarity index 100% rename from src/lib_scoru_wasm/test/test_durable_shapshot.ml rename to src/lib_scoru_wasm/test/test_durable_snapshot.ml diff --git a/src/lib_tree_encoding/decoding.ml b/src/lib_tree_encoding/decoding.ml index deecd9cc99e6..31e717db67cb 100644 --- a/src/lib_tree_encoding/decoding.ml +++ b/src/lib_tree_encoding/decoding.ml @@ -180,13 +180,13 @@ let scope key {decode} = (fun backend tree prefix -> decode backend tree (append_key prefix key)); } -let lazy_mapping to_key field_enc = +let lazy_mapping to_key field_dec = { decode = (fun backend input_tree input_prefix -> let open Lwt_syntax in let produce_value index = - (scope (to_key index) field_enc).decode + (scope (to_key index) field_dec).decode backend input_tree input_prefix @@ -195,16 +195,17 @@ let lazy_mapping to_key field_enc = (Tree.Wrapped_tree (tree, backend), produce_value)); } -let lazy_mapping_with_names to_key field_enc = +let subtree_wrapped_tree key = { decode = - (fun backend input_tree input_prefix -> - let open Lwt_syntax in - let* wrapped, produce_value = - (lazy_mapping to_key field_enc).decode backend input_tree input_prefix - in - let+ names = Tree.list backend input_tree (input_prefix []) in - (wrapped, List.map fst names, produce_value)); + (fun backend tree prefix -> + let open Lwt.Syntax in + let subtree_prefix = append_key prefix key in + let* subtree_opt = Tree.find_tree backend tree (subtree_prefix []) in + match subtree_opt with + | None -> Lwt.return_none + | Some subtree -> + Lwt.return @@ Some (Tree.Wrapped_tree (subtree, backend))); } let case_lwt tag decode extract = Case {tag; decode; extract} diff --git a/src/lib_tree_encoding/decoding.mli b/src/lib_tree_encoding/decoding.mli index b5c7624227c3..d670619423ed 100644 --- a/src/lib_tree_encoding/decoding.mli +++ b/src/lib_tree_encoding/decoding.mli @@ -92,10 +92,9 @@ val scope : key -> 'a t -> 'a t val lazy_mapping : ('i -> key) -> 'a t -> (Tree.wrapped_tree * ('i -> 'a Lwt.t)) t -(** [lazy_mapping_with_names to_key decoder] does the same as [lazy_mapping] - but also eagerly decodes names of subtrees. *) -val lazy_mapping_with_names : - ('i -> key) -> 'a t -> (Tree.wrapped_tree * string list * ('i -> 'a Lwt.t)) t +(** [subtree_wrapped_tree key] is semantically equvalent to + [scope_option key wrapped_tree] but which makes one less find_tree in the irmin tree *) +val subtree_wrapped_tree : key -> Tree.wrapped_tree option t (** [delayed f] produces a tree decoder that delays evaluation of [f ()] until the decoder is actually needed. This is required to allow for directly diff --git a/src/lib_tree_encoding/encoding.ml b/src/lib_tree_encoding/encoding.ml index 6a66339fbf86..ecf8b7b0a362 100644 --- a/src/lib_tree_encoding/encoding.ml +++ b/src/lib_tree_encoding/encoding.ml @@ -159,6 +159,25 @@ let lazy_mapping to_key enc_value = bindings); } +let lazy_tree enc_value enc_tree = + { + encode = + (fun backend (origin_opt, value_change, subtree_bindings) prefix tree -> + let open Lwt_syntax in + let* new_tree = + (lazy_mapping (fun x -> [x]) enc_tree).encode + backend + (origin_opt, subtree_bindings) + prefix + tree + in + let value_pref = append_key prefix ["@"] in + match value_change with + | `NoChange -> Lwt.return new_tree + | `Removed -> Tree.remove backend new_tree (value_pref []) + | `NewValue v -> enc_value.encode backend v value_pref new_tree); + } + type ('tag, 'a) case = | Case : { tag : 'tag; diff --git a/src/lib_tree_encoding/encoding.mli b/src/lib_tree_encoding/encoding.mli index 1f57fc371b03..a1348a8e303b 100644 --- a/src/lib_tree_encoding/encoding.mli +++ b/src/lib_tree_encoding/encoding.mli @@ -88,6 +88,23 @@ val scope : key -> 'a t -> 'a t val lazy_mapping : ('k -> key) -> 'v t -> (Tree.wrapped_tree option * ('k * 'v option) list) t +(** [lazy_tree value_enc subtree_enc] returns a subtree plus, + value encoder which could be left unchanged, rewritten or removed, + and finally key-value list + encoder that encodes subtrees from a given key-value list using the + the provided encoder [enc] for the values. + + This one is similar to [lazy_mapping] but specifies key to string, + and also makes possible to encode an additional (meta) value with different encoder. +*) +val lazy_tree : + 'v t -> + 'sub t -> + (Tree.wrapped_tree option + * [`NoChange | `NewValue of 'v | `Removed] + * (string * 'sub option) list) + t + (** [case tag enc f] return a partial encoder that represents a case in a sum-type. The encoder hides the (existentially bound) type of the parameter to the specific case, provided a converter function [f] and diff --git a/src/lib_tree_encoding/tezos_tree_encoding.ml b/src/lib_tree_encoding/tezos_tree_encoding.ml index 75663b38edcd..f1ab9c96ae79 100644 --- a/src/lib_tree_encoding/tezos_tree_encoding.ml +++ b/src/lib_tree_encoding/tezos_tree_encoding.ml @@ -236,9 +236,7 @@ module Lazy_map_encoding = struct let decode = D.map (fun (origin, produce_value) -> Map.create ~origin ~produce_value ()) - (let open D.Syntax in - let+ produce_value = D.lazy_mapping to_key value.decode in - produce_value) + (D.lazy_mapping to_key value.decode) in {encode; decode} end @@ -356,103 +354,53 @@ module CBV_encoding = struct end end -module Lazy_dirs_encoding = struct - module type Lazy_dirs_sig = sig - type 'a t - - module Names : Stdlib.Set.S with type elt = String.t - - module Map : Lazy_map_encoding.Lazy_map_sig with type key = String.t - - val contents : 'a t -> 'a Map.t - - val create : ?names:Names.t -> ?contents:'a Map.t -> unit -> 'a t - - val remove : 'a t -> Names.elt -> 'a t - end - - module type S = sig - type 'a dirs - - val lazy_dirs : 'a t -> 'a dirs t - end +module Lazy_tree_encoding = struct + module type Lazy_tree_sig = sig + type elt - module Make (Dirs : Lazy_dirs_sig) = struct - let decode_lazy_dirs_with_origin value_decoder = - let to_key k = [Dirs.Map.string_of_key k] in - D.map - (fun (origin, names, produce_value) -> - let contents = Dirs.Map.create ~origin ~produce_value () in - (Dirs.create ~names:(Dirs.Names.of_list names) ~contents (), origin)) - (D.lazy_mapping_with_names to_key value_decoder) - - let lazy_dirs value = - let to_key k = [Dirs.Map.string_of_key k] in - let encode = - E.contramap - (fun tree -> - let contents = Dirs.contents tree in - (Dirs.Map.origin contents, Dirs.Map.loaded_bindings contents)) - (E.lazy_mapping to_key value.encode) - in - let decode = - D.map - (fun (dirs, _) -> dirs) - (decode_lazy_dirs_with_origin value.decode) - in - {encode; decode} - end -end + type lt -module Lazy_fs_encoding = struct - module type Lazy_fs_sig = sig - type 'a t + val origin : lt -> wrapped_tree option - module Dirs : Lazy_dirs_encoding.Lazy_dirs_sig + val subtrees_diff : lt -> (string * lt option) list - val dirs : 'a t -> 'a t Dirs.t + val value : lt -> [`NoChange | `NewValue of elt | `Removed] - val content : 'a t -> 'a option + val value_encoding : elt t - val create : ?value:'a -> ?dirs:'a t Dirs.t -> Tree.wrapped_tree -> 'a t + val create : Tree.wrapped_tree -> lt end module type S = sig - type 'a fs + type elt - val lazy_fs : 'a t -> 'a fs t - end + type lt - module Make (Fs : Lazy_fs_sig) = struct - module Lazy_dirs_enc = Lazy_dirs_encoding.Make (Fs.Dirs) + val lazy_tree : unit -> lt t - let lazy_dirs = Lazy_dirs_enc.lazy_dirs + val decode_subtree : wrapped_tree -> string -> lt option Lwt.t - let decode_lazy_dirs_with_origin = - Lazy_dirs_enc.decode_lazy_dirs_with_origin + val decode_value : wrapped_tree -> elt option Lwt.t + end - let rec lazy_fs value = + module Make (Lt : Lazy_tree_sig) = struct + let rec lazy_tree () = let encode = E.contramap - (fun fs -> (Fs.dirs fs, Fs.content fs)) - (E.tup2 - (E.delayed @@ fun () -> (lazy_dirs (lazy_fs value)).encode) - (E.scope_option ["@"] value.encode)) - in - let decode = - D.map - (fun (value, (dirs, origin)) -> - let dirs = Fs.Dirs.remove dirs "@" in - Fs.create ?value ~dirs origin) - (let open D.Syntax in - let+ x = D.scope_option ["@"] value.decode - and+ dirs_n_origin = - D.delayed @@ fun () -> - decode_lazy_dirs_with_origin (lazy_fs value).decode - in - (x, dirs_n_origin)) + (fun lt -> (Lt.origin lt, Lt.value lt, Lt.subtrees_diff lt)) + (E.lazy_tree + Lt.value_encoding.encode + (E.delayed @@ fun () -> (lazy_tree ()).encode)) in + let decode = D.map Lt.create D.wrapped_tree in {encode; decode} + + let decode_subtree (Wrapped_tree (undelying, (module M))) step = + Lwt.map (Option.map Lt.create) + @@ D.run (module M) (D.subtree_wrapped_tree [step]) undelying + + let decode_value (Wrapped_tree (undelying, (module M))) = + D.run (module M) (D.scope_option ["@"] Lt.value_encoding.decode) undelying end end diff --git a/src/lib_tree_encoding/tezos_tree_encoding.mli b/src/lib_tree_encoding/tezos_tree_encoding.mli index ef048f0094b7..8368af64ba24 100644 --- a/src/lib_tree_encoding/tezos_tree_encoding.mli +++ b/src/lib_tree_encoding/tezos_tree_encoding.mli @@ -414,48 +414,35 @@ module CBV_encoding : sig S with type cbv := CBV.t and type chunk := CBV.chunk end -module Lazy_dirs_encoding : sig - module type Lazy_dirs_sig = sig - type 'a t - - module Names : Stdlib.Set.S with type elt = String.t +module Lazy_tree_encoding : sig + module type Lazy_tree_sig = sig + type elt - module Map : Lazy_map_encoding.Lazy_map_sig with type key = String.t + type lt - val contents : 'a t -> 'a Map.t + val origin : lt -> wrapped_tree option - val create : ?names:Names.t -> ?contents:'a Map.t -> unit -> 'a t + val subtrees_diff : lt -> (string * lt option) list - val remove : 'a t -> Names.elt -> 'a t - end + val value : lt -> [`NoChange | `NewValue of elt | `Removed] - module type S = sig - type 'a dirs + val value_encoding : elt t - val lazy_dirs : 'a t -> 'a dirs t + val create : Tree.wrapped_tree -> lt end - module Make (Dirs : Lazy_dirs_sig) : S with type 'a dirs := 'a Dirs.t -end - -module Lazy_fs_encoding : sig - module type Lazy_fs_sig = sig - type 'a t - - module Dirs : Lazy_dirs_encoding.Lazy_dirs_sig - - val dirs : 'a t -> 'a t Dirs.t + module type S = sig + type elt - val content : 'a t -> 'a option + type lt - val create : ?value:'a -> ?dirs:'a t Dirs.t -> Tree.wrapped_tree -> 'a t - end + val lazy_tree : unit -> lt t - module type S = sig - type 'a fs + val decode_subtree : wrapped_tree -> string -> lt option Lwt.t - val lazy_fs : 'a t -> 'a fs t + val decode_value : wrapped_tree -> elt option Lwt.t end - module Make (Fs : Lazy_fs_sig) : S with type 'a fs := 'a Fs.t + module Make (Lt : Lazy_tree_sig) : + S with type lt := Lt.lt and type elt := Lt.elt end diff --git a/src/lib_webassembly/runtime/durable_storage.ml b/src/lib_webassembly/runtime/durable_storage.ml index cb470959f883..56601b7b8ac9 100644 --- a/src/lib_webassembly/runtime/durable_storage.ml +++ b/src/lib_webassembly/runtime/durable_storage.ml @@ -1,7 +1,4 @@ -type t = - Tezos_lazy_containers.Immutable_chunked_byte_vector.t - Tezos_lazy_containers.Lazy_fs.t - option +type t = Tezos_lazy_containers.Lazy_tree.CBV_lazy_tree.t option exception Durable_empty diff --git a/src/lib_webassembly/runtime/durable_storage.mli b/src/lib_webassembly/runtime/durable_storage.mli index 2f5c75760cf2..050815e595da 100644 --- a/src/lib_webassembly/runtime/durable_storage.mli +++ b/src/lib_webassembly/runtime/durable_storage.mli @@ -5,19 +5,9 @@ exception Durable_empty val empty : t -val of_tree : - Tezos_lazy_containers.Immutable_chunked_byte_vector.t - Tezos_lazy_containers.Lazy_fs.t -> - t +val of_tree : Tezos_lazy_containers.Lazy_tree.CBV_lazy_tree.t -> t (** @raise Durable_empty *) -val to_tree_exn : - t -> - Tezos_lazy_containers.Immutable_chunked_byte_vector.t - Tezos_lazy_containers.Lazy_fs.t +val to_tree_exn : t -> Tezos_lazy_containers.Lazy_tree.CBV_lazy_tree.t -val to_tree : - t -> - Tezos_lazy_containers.Immutable_chunked_byte_vector.t - Tezos_lazy_containers.Lazy_fs.t - option +val to_tree : t -> Tezos_lazy_containers.Lazy_tree.CBV_lazy_tree.t option -- GitLab