From a067cdc7a32066cc5f4e425fc423c18a1bff2cf8 Mon Sep 17 00:00:00 2001 From: mattiasdrp Date: Tue, 18 Jun 2024 18:01:38 +0200 Subject: [PATCH 1/3] Brassaia: Prefixing created files with "brassaia_" --- brassaia/index/src/layout.ml | 4 +- brassaia/lib_brassaia_pack/layout.ml | 37 +++++++++++-------- .../lib_brassaia_pack/unix/file_manager.ml | 4 +- brassaia/lib_brassaia_pack/unix/io.ml | 32 +++++++++++++++- src/lib_context_brassaia/disk/context.ml | 8 ++-- 5 files changed, 62 insertions(+), 23 deletions(-) diff --git a/brassaia/index/src/layout.ml b/brassaia/index/src/layout.ml index a70a93c92813..0b33447a9f78 100644 --- a/brassaia/index/src/layout.ml +++ b/brassaia/index/src/layout.ml @@ -1,6 +1,8 @@ open! Import -let toplevel ~root name = Filename.(concat (concat root "index") name) +let toplevel ~root name = + Filename.(concat (concat root "index") ("brassaia_" ^ name)) + let log = toplevel "log" let log_async = toplevel "log_async" let data = toplevel "data" diff --git a/brassaia/lib_brassaia_pack/layout.ml b/brassaia/lib_brassaia_pack/layout.ml index f254c2444528..fbc55609fc49 100644 --- a/brassaia/lib_brassaia_pack/layout.ml +++ b/brassaia/lib_brassaia_pack/layout.ml @@ -14,7 +14,7 @@ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *) -let toplevel name ~root = Filename.(concat root name) +let toplevel name ~root = Filename.(concat root ("brassaia_" ^ name)) module V1_and_v2 = struct let pack = toplevel "store.pack" @@ -125,18 +125,23 @@ module Classification = struct let init s : t = match String.split_on_char '.' s with - | [ "store"; "pack" ] -> `V1_or_v2_pack - | [ "store"; "branches" ] -> `Branch - | [ "store"; "control" ] -> `Control - | [ "store"; "control"; "tmp" ] -> `Control_tmp - | [ "store"; "dict" ] -> `Dict - | [ "store"; g; "out" ] when is_number g -> `Gc_result (int_of_string g) - | [ "store"; g; "reachable" ] when is_number g -> + | [ "brassaia_store"; "pack" ] -> `V1_or_v2_pack + | [ "brassaia_store"; "branches" ] -> `Branch + | [ "brassaia_store"; "control" ] -> `Control + | [ "brassaia_store"; "control"; "tmp" ] -> `Control_tmp + | [ "brassaia_store"; "dict" ] -> `Dict + | [ "brassaia_store"; g; "out" ] when is_number g -> + `Gc_result (int_of_string g) + | [ "brassaia_store"; g; "reachable" ] when is_number g -> `Reachable (int_of_string g) - | [ "store"; g; "sorted" ] when is_number g -> `Sorted (int_of_string g) - | [ "store"; g; "mapping" ] when is_number g -> `Mapping (int_of_string g) - | [ "store"; g; "prefix" ] when is_number g -> `Prefix (int_of_string g) - | [ "store"; g; "suffix" ] when is_number g -> `Suffix (int_of_string g) + | [ "brassaia_store"; g; "sorted" ] when is_number g -> + `Sorted (int_of_string g) + | [ "brassaia_store"; g; "mapping" ] when is_number g -> + `Mapping (int_of_string g) + | [ "brassaia_store"; g; "prefix" ] when is_number g -> + `Prefix (int_of_string g) + | [ "brassaia_store"; g; "suffix" ] when is_number g -> + `Suffix (int_of_string g) | _ -> `Unknown end @@ -146,11 +151,11 @@ module Classification = struct let open_volume s : t = match String.split_on_char '.' s with - | [ "volume"; "control" ] -> `Control - | [ "volume"; g; "control" ] when is_number g -> + | [ "brassaia_volume"; "control" ] -> `Control + | [ "brassaia_volume"; g; "control" ] when is_number g -> `Control_tmp (int_of_string g) - | [ "volume"; "mapping" ] -> `Mapping - | [ "volume"; "data" ] -> `Data + | [ "brassaia_volume"; "mapping" ] -> `Mapping + | [ "brassaia_volume"; "data" ] -> `Data | _ -> `Unknown end end diff --git a/brassaia/lib_brassaia_pack/unix/file_manager.ml b/brassaia/lib_brassaia_pack/unix/file_manager.ml index 004813241b46..54b861c0240e 100644 --- a/brassaia/lib_brassaia_pack/unix/file_manager.ml +++ b/brassaia/lib_brassaia_pack/unix/file_manager.ml @@ -389,8 +389,8 @@ struct (Int64.of_int pl.volume_num); Control.set_payload control pl - let finish_constructing_rw config control ~make_dict ~make_suffix ~make_index - ~make_lower = + let finish_constructing_rw (config : Brassaia.config) control ~make_dict + ~make_suffix ~make_index ~make_lower = let open Result_syntax in let root = Brassaia_pack.Conf.root config in let use_fsync = Brassaia_pack.Conf.use_fsync config in diff --git a/brassaia/lib_brassaia_pack/unix/io.ml b/brassaia/lib_brassaia_pack/unix/io.ml index 4608b6fb5aea..554113f3aa68 100644 --- a/brassaia/lib_brassaia_pack/unix/io.ml +++ b/brassaia/lib_brassaia_pack/unix/io.ml @@ -93,6 +93,23 @@ module Unix = struct path : string; } + let file_copy input_name output_name = + let buffer_size = 8192 in + let buffer = Bytes.create buffer_size in + let open Unix in + let fd_in = openfile input_name [ O_RDONLY ] 0 in + let fd_out = openfile output_name [ O_WRONLY; O_CREAT; O_TRUNC ] 0o666 in + let rec copy_loop () = + match read fd_in buffer 0 buffer_size with + | 0 -> () + | r -> + ignore (write fd_out buffer 0 r); + copy_loop () + in + copy_loop (); + close fd_in; + close fd_out + let classify_path p = Unix.( try @@ -100,7 +117,20 @@ module Unix = struct | S_REG -> `File | S_DIR -> `Directory | _ -> `Other - with _ -> `No_such_file_or_directory) + with _ -> ( + let basename = Filename.basename p in + let irmin_file = + Filename.concat (Filename.dirname p) + (String.split_on_char '_' basename |> List.tl |> List.hd) + in + try + match (stat irmin_file).st_kind with + | S_REG -> + file_copy irmin_file p; + `File + | S_DIR -> `Directory + | _ -> `Other + with _ -> `No_such_file_or_directory)) let default_create_perm = 0o644 let default_open_perm = 0o644 diff --git a/src/lib_context_brassaia/disk/context.ml b/src/lib_context_brassaia/disk/context.ml index 97b076587269..0aba3389e0d7 100644 --- a/src/lib_context_brassaia/disk/context.ml +++ b/src/lib_context_brassaia/disk/context.ml @@ -87,12 +87,12 @@ module Events = struct let section = ["node"; "context_brassaia"; "disk"] let init_context = - declare_3 + declare_4 ~section ~level:Info ~name:"init_context" ~msg: - "initializing context (readonly: {readonly}, index_log_size: \ + "initializing context in {root} (readonly: {readonly}, index_log_size: \ {index_log_size}, lru_size: {lru_size})" ~pp1:Format.pp_print_bool ("readonly", Data_encoding.bool) @@ -100,6 +100,7 @@ module Events = struct ("index_log_size", Data_encoding.int31) ~pp3:Format.pp_print_int ("lru_size", Data_encoding.int31) + ("root", Data_encoding.string) let starting_gc = declare_1 @@ -731,7 +732,7 @@ module Make (Encoding : module type of Tezos_context_encoding.Context) = struct in let lru_size = env.lru_size in let* () = - Events.(emit init_context (readonly, index_log_size, lru_size)) + Events.(emit init_context (readonly, index_log_size, lru_size, root)) in let* () = Events.(emit warning_experimental ()) in Store.Repo.init @@ -742,6 +743,7 @@ module Make (Encoding : module type of Tezos_context_encoding.Context) = struct ~lru_size root) in + {path = root; repo; patch_context; readonly} let close index = -- GitLab From f16b43b1e4008b32722630d3cf076d9fdc095182 Mon Sep 17 00:00:00 2001 From: mattiasdrp Date: Tue, 18 Jun 2024 18:02:09 +0200 Subject: [PATCH 2/3] Lib_protocol_environment: Adding a duo context option This option uses an Irmin and a Brassaia context in parallel --- manifest/product_octez.ml | 14 + src/lib_context_brassaia/disk/context.ml | 1 - .../context_ops/context_ops.ml | 278 ++++++- src/lib_protocol_environment/context_ops/dune | 6 +- .../duo_context_lib/context_wrapper.ml | 681 ++++++++++++++++++ .../duo_context_lib/dune | 15 + .../duo_context_lib/duo_context.ml | 67 ++ .../duo_context_lib/duo_context.mli | 59 ++ .../duo_context_lib/duo_context_lib.ml | 9 + .../duo_context_lib/duo_memory_context.ml | 67 ++ .../duo_context_lib/duo_memory_context.mli | 56 ++ src/lib_shell/index.mld | 1 + 12 files changed, 1225 insertions(+), 29 deletions(-) create mode 100644 src/lib_protocol_environment/duo_context_lib/context_wrapper.ml create mode 100644 src/lib_protocol_environment/duo_context_lib/dune create mode 100644 src/lib_protocol_environment/duo_context_lib/duo_context.ml create mode 100644 src/lib_protocol_environment/duo_context_lib/duo_context.mli create mode 100644 src/lib_protocol_environment/duo_context_lib/duo_context_lib.ml create mode 100644 src/lib_protocol_environment/duo_context_lib/duo_memory_context.ml create mode 100644 src/lib_protocol_environment/duo_context_lib/duo_memory_context.mli diff --git a/manifest/product_octez.ml b/manifest/product_octez.ml index 5ad1db80c34b..a94f9c8637f9 100644 --- a/manifest/product_octez.ml +++ b/manifest/product_octez.ml @@ -3194,6 +3194,19 @@ let octez_brassaia_context = octez_context_brassaia; ] +let octez_duo_context_lib = + octez_shell_lib + "duo-context-lib" + ~internal_name:"tezos_duo_context_lib" + ~path:"src/lib_protocol_environment/duo_context_lib" + ~deps: + [ + octez_base |> open_ ~m:"TzPervasives"; + octez_protocol_environment; + octez_context_brassaia; + octez_context; + ] + let _octez_protocol_environment_tests = tezt [ @@ -3231,6 +3244,7 @@ let octez_context_ops = octez_context_brassaia |> open_; octez_shell_context |> open_; octez_brassaia_context |> open_; + octez_duo_context_lib |> open_; ] let _octez_protocol_shell_context_tests = diff --git a/src/lib_context_brassaia/disk/context.ml b/src/lib_context_brassaia/disk/context.ml index 0aba3389e0d7..49fb9ba21e33 100644 --- a/src/lib_context_brassaia/disk/context.ml +++ b/src/lib_context_brassaia/disk/context.ml @@ -743,7 +743,6 @@ module Make (Encoding : module type of Tezos_context_encoding.Context) = struct ~lru_size root) in - {path = root; repo; patch_context; readonly} let close index = diff --git a/src/lib_protocol_environment/context_ops/context_ops.ml b/src/lib_protocol_environment/context_ops/context_ops.ml index 9f03289b6294..1063f9c5c9cb 100644 --- a/src/lib_protocol_environment/context_ops/context_ops.ml +++ b/src/lib_protocol_environment/context_ops/context_ops.ml @@ -20,12 +20,37 @@ module Brassaia_memory_context = let err_implementation_mismatch = Tezos_protocol_environment.err_implementation_mismatch +module Events = struct + include Internal_event.Simple + + let section = ["node"; "context_ops"] + + let initializing_context = + declare_2 + ~section + ~level:Warning + ~name:"initializing_context" + ~msg:"initializing {context} context at {path}" + ("context", Data_encoding.string) + ("path", Data_encoding.string) + + let warning_experimental = + declare_0 + ~section + ~level:Warning + ~name:"duocontext_warning_experimental" + ~msg:"creating a duo context with Brassaia and Irmin." + () +end + (** Values of type [index] are used to [checkout] contexts specified by their hash. *) type index = | Disk_index of Context.index | Memory_index of Tezos_context_memory.Context.index | Brassaia_index of Brassaia.index | Brassaia_memory_index of Brassaia_memory.index + | Duo_index of Context_wrapper.Context.index + | Duo_memory_index of Context_wrapper.Memory_context.index open Environment_context @@ -36,51 +61,96 @@ let err_impl_mismatch ~got = ~expected:"shell, memory, brassaia or brassaia_memory" ~got -let init ~kind ?patch_context ?readonly ?index_log_size s = +let init ~kind ?patch_context ?readonly ?index_log_size path = + let open Lwt_syntax in + let init_context () = + let* () = Events.(emit initializing_context) ("irmin", path) in + let patch_context = + Option.map + (fun f context -> + let open Lwt_result_syntax in + let* context = f (Shell_context.wrap_disk_context context) in + return @@ Shell_context.unwrap_disk_context context) + patch_context + in + Context.init ?patch_context ?readonly ?index_log_size path + in + + let init_brassaia_context () = + let* () = Events.(emit initializing_context) ("brassaia", path) in + let patch_context = + Option.map + (fun f context -> + let open Lwt_result_syntax in + let* context = f (Brassaia_context.wrap_disk_context context) in + return @@ Brassaia_context.unwrap_disk_context context) + patch_context + in + Brassaia.init ?patch_context ?readonly ?index_log_size path + in + let open Lwt_syntax in match kind with | `Disk -> - let patch_context = - Option.map - (fun f context -> - let open Lwt_result_syntax in - let* context = f (Shell_context.wrap_disk_context context) in - return @@ Shell_context.unwrap_disk_context context) - patch_context - in - let+ index = Context.init ?patch_context ?readonly ?index_log_size s in + let+ index = init_context () in Disk_index index | `Memory -> let+ index = - Tezos_context_memory.Context.init ?readonly ?index_log_size s + Tezos_context_memory.Context.init ?readonly ?index_log_size path in Memory_index index | `Brassaia -> - let patch_context = - Option.map - (fun f context -> - let open Lwt_result_syntax in - let* context = f (Brassaia_context.wrap_disk_context context) in - return @@ Brassaia_context.unwrap_disk_context context) - patch_context - in - let+ index = Brassaia.init ?patch_context ?readonly ?index_log_size s in + let+ index = init_brassaia_context () in Brassaia_index index | `Brassaia_memory -> - let+ index = Brassaia_memory.init ?readonly ?index_log_size s in + let+ index = Brassaia_memory.init ?readonly ?index_log_size path in Brassaia_memory_index index + | `Duo_index -> + let* irmin_index = init_context () in + let+ brassaia_index = init_brassaia_context () in + Duo_index {irmin_index; brassaia_index} + | `Duo_index_memory -> + let* irmin_index = + Tezos_context_memory.Context.init ?readonly ?index_log_size path + in + let+ brassaia_index = + Brassaia_memory.init ?readonly ?index_log_size path + in + Duo_memory_index {irmin_index; brassaia_index} (* Wrapper over init that uses an environment variable ('TEZOS_CONTEXT_BACKEND') to select the backend between Memory|Brassaia_memory and Disk|Brassaia *) -let init ~kind = +let init ~kind ?patch_context ?readonly ?index_log_size path = + let open Lwt_syntax in let backend_variable = "TEZOS_CONTEXT_BACKEND" in match Sys.getenv_opt backend_variable with | Some "Brassaia" -> ( match kind with - | `Disk -> init ~kind:`Brassaia - | `Memory -> init ~kind:`Brassaia_memory - | _ -> init ~kind) - | _ -> init ~kind + | `Disk -> + init ~kind:`Brassaia ?patch_context ?readonly ?index_log_size path + | `Memory -> + init + ~kind:`Brassaia_memory + ?patch_context + ?readonly + ?index_log_size + path + | _ -> init ~kind ?patch_context ?readonly ?index_log_size path) + | Some "Duo" -> ( + match kind with + | `Disk -> + let* () = Events.(emit warning_experimental) () in + init ~kind:`Duo_index ?patch_context ?readonly ?index_log_size path + | `Memory -> + let* () = Events.(emit warning_experimental) () in + init + ~kind:`Duo_index_memory + ?patch_context + ?readonly + ?index_log_size + path + | _ -> init ~kind ?patch_context ?readonly ?index_log_size path) + | _ -> init ~kind ?patch_context ?readonly ?index_log_size path let index (context : Environment_context.t) = match context with @@ -92,6 +162,10 @@ let index (context : Environment_context.t) = Brassaia_index (Brassaia.index ctxt) | Context {kind = Brassaia_memory_context.Context; ctxt; _} -> Brassaia_memory_index (Brassaia_memory.index ctxt) + | Context {kind = Duo_context.Context; ctxt; _} -> + Duo_index (Context_wrapper.Context.index ctxt) + | Context {kind = Duo_memory_context.Context; ctxt; _} -> + Duo_memory_index (Context_wrapper.Memory_context.index ctxt) | Context t -> err_impl_mismatch ~got:t.impl_name let mem (context : Environment_context.t) key = @@ -100,6 +174,10 @@ let mem (context : Environment_context.t) key = | Context {kind = Memory_context.Context; ctxt; _} -> Tezos_context_memory.Context.mem ctxt key | Context {kind = Brassaia_context.Context; ctxt; _} -> Brassaia.mem ctxt key + | Context {kind = Duo_context.Context; ctxt; _} -> + Context_wrapper.Context.mem ctxt key + | Context {kind = Duo_memory_context.Context; ctxt; _} -> + Context_wrapper.Memory_context.mem ctxt key | Context t -> err_impl_mismatch ~got:t.impl_name let mem_tree (context : Environment_context.t) key = @@ -111,6 +189,10 @@ let mem_tree (context : Environment_context.t) key = Brassaia.mem_tree ctxt key | Context {kind = Brassaia_memory_context.Context; ctxt; _} -> Brassaia_memory.mem_tree ctxt key + | Context {kind = Duo_context.Context; ctxt; _} -> + Context_wrapper.Context.mem_tree ctxt key + | Context {kind = Duo_memory_context.Context; ctxt; _} -> + Context_wrapper.Memory_context.mem_tree ctxt key | Context t -> err_impl_mismatch ~got:t.impl_name let find (context : Environment_context.t) key = @@ -121,6 +203,10 @@ let find (context : Environment_context.t) key = | Context {kind = Brassaia_context.Context; ctxt; _} -> Brassaia.find ctxt key | Context {kind = Brassaia_memory_context.Context; ctxt; _} -> Brassaia_memory.find ctxt key + | Context {kind = Duo_context.Context; ctxt; _} -> + Context_wrapper.Context.find ctxt key + | Context {kind = Duo_memory_context.Context; ctxt; _} -> + Context_wrapper.Memory_context.find ctxt key | Context t -> err_impl_mismatch ~got:t.impl_name let add (context : Environment_context.t) key data = @@ -138,6 +224,12 @@ let add (context : Environment_context.t) key data = | Context {kind = Brassaia_memory_context.Context; ctxt; _} -> let+ ctxt = Brassaia_memory.add ctxt key data in Brassaia_memory_context.wrap_memory_context ctxt + | Context {kind = Duo_context.Context; ctxt; _} -> + let+ ctxt = Context_wrapper.Context.add ctxt key data in + Duo_context.wrap_disk_context ctxt + | Context {kind = Duo_memory_context.Context; ctxt; _} -> + let+ ctxt = Context_wrapper.Memory_context.add ctxt key data in + Duo_memory_context.wrap_memory_context ctxt | Context t -> err_impl_mismatch ~got:t.impl_name let fold_value ?depth (context : Environment_context.t) key ~order ~init ~f = @@ -159,6 +251,26 @@ let fold_value ?depth (context : Environment_context.t) key ~order ~init ~f = Brassaia_memory.fold ?depth ctxt key ~order ~init ~f:(fun k tree acc -> let v () = Brassaia_memory.Tree.to_value tree in f k v acc) + | Context {kind = Duo_context.Context; ctxt; _} -> + Context_wrapper.Context.fold + ?depth + ctxt + key + ~order + ~init + ~f:(fun k tree acc -> + let v () = Context_wrapper.Context.Tree.to_value tree in + f k v acc) + | Context {kind = Duo_memory_context.Context; ctxt; _} -> + Context_wrapper.Memory_context.fold + ?depth + ctxt + key + ~order + ~init + ~f:(fun k tree acc -> + let v () = Context_wrapper.Memory_context.Tree.to_value tree in + f k v acc) | Context t -> err_impl_mismatch ~got:t.impl_name let add_protocol (context : Environment_context.t) proto_hash = @@ -176,6 +288,12 @@ let add_protocol (context : Environment_context.t) proto_hash = | Context {kind = Brassaia_memory_context.Context; ctxt; _} -> let+ ctxt = Brassaia_memory.add_protocol ctxt proto_hash in Brassaia_memory_context.wrap_memory_context ctxt + | Context {kind = Duo_context.Context; ctxt; _} -> + let+ ctxt = Context_wrapper.Context.add_protocol ctxt proto_hash in + Duo_context.wrap_disk_context ctxt + | Context {kind = Duo_memory_context.Context; ctxt; _} -> + let+ ctxt = Context_wrapper.Memory_context.add_protocol ctxt proto_hash in + Duo_memory_context.wrap_memory_context ctxt | Context t -> err_impl_mismatch ~got:t.impl_name let get_protocol (context : Environment_context.t) = @@ -187,6 +305,10 @@ let get_protocol (context : Environment_context.t) = Brassaia.get_protocol ctxt | Context {kind = Brassaia_memory_context.Context; ctxt; _} -> Brassaia_memory.get_protocol ctxt + | Context {kind = Duo_context.Context; ctxt; _} -> + Context_wrapper.Context.get_protocol ctxt + | Context {kind = Duo_memory_context.Context; ctxt; _} -> + Context_wrapper.Memory_context.get_protocol ctxt | Context t -> err_impl_mismatch ~got:t.impl_name let add_predecessor_block_metadata_hash (context : Environment_context.t) hash = @@ -210,6 +332,18 @@ let add_predecessor_block_metadata_hash (context : Environment_context.t) hash = Brassaia_memory.add_predecessor_block_metadata_hash ctxt hash in Brassaia_memory_context.wrap_memory_context ctxt + | Context {kind = Duo_context.Context; ctxt; _} -> + let+ ctxt = + Context_wrapper.Context.add_predecessor_block_metadata_hash ctxt hash + in + Duo_context.wrap_disk_context ctxt + | Context {kind = Duo_memory_context.Context; ctxt; _} -> + let+ ctxt = + Context_wrapper.Memory_context.add_predecessor_block_metadata_hash + ctxt + hash + in + Duo_memory_context.wrap_memory_context ctxt | Context t -> err_impl_mismatch ~got:t.impl_name let add_predecessor_ops_metadata_hash (context : Environment_context.t) hash = @@ -229,6 +363,18 @@ let add_predecessor_ops_metadata_hash (context : Environment_context.t) hash = | Context {kind = Brassaia_memory_context.Context; ctxt; _} -> let+ ctxt = Brassaia_memory.add_predecessor_ops_metadata_hash ctxt hash in Brassaia_memory_context.wrap_memory_context ctxt + | Context {kind = Duo_context.Context; ctxt; _} -> + let+ ctxt = + Context_wrapper.Context.add_predecessor_ops_metadata_hash ctxt hash + in + Duo_context.wrap_disk_context ctxt + | Context {kind = Duo_memory_context.Context; ctxt; _} -> + let+ ctxt = + Context_wrapper.Memory_context.add_predecessor_ops_metadata_hash + ctxt + hash + in + Duo_memory_context.wrap_memory_context ctxt | Context t -> err_impl_mismatch ~got:t.impl_name let hash ~time ?message (context : Environment_context.t) = @@ -241,6 +387,10 @@ let hash ~time ?message (context : Environment_context.t) = Brassaia.hash ~time ?message ctxt | Context {kind = Brassaia_memory_context.Context; ctxt; _} -> Brassaia_memory.hash ~time ?message ctxt + | Context {kind = Duo_context.Context; ctxt; _} -> + Context_wrapper.Context.hash ~time ?message ctxt + | Context {kind = Duo_memory_context.Context; ctxt; _} -> + Context_wrapper.Memory_context.hash ~time ?message ctxt | Context t -> err_impl_mismatch ~got:t.impl_name let get_test_chain (context : Environment_context.t) = @@ -253,6 +403,10 @@ let get_test_chain (context : Environment_context.t) = Brassaia.get_test_chain ctxt | Context {kind = Brassaia_memory_context.Context; ctxt; _} -> Brassaia_memory.get_test_chain ctxt + | Context {kind = Duo_context.Context; ctxt; _} -> + Context_wrapper.Context.get_test_chain ctxt + | Context {kind = Duo_memory_context.Context; ctxt; _} -> + Context_wrapper.Memory_context.get_test_chain ctxt | Context t -> err_impl_mismatch ~got:t.impl_name let add_test_chain (context : Environment_context.t) status = @@ -270,6 +424,12 @@ let add_test_chain (context : Environment_context.t) status = | Context {kind = Brassaia_memory_context.Context; ctxt; _} -> let+ ctxt = Brassaia_memory.add_test_chain ctxt status in Brassaia_memory_context.wrap_memory_context ctxt + | Context {kind = Duo_context.Context; ctxt; _} -> + let+ ctxt = Context_wrapper.Context.add_test_chain ctxt status in + Duo_context.wrap_disk_context ctxt + | Context {kind = Duo_memory_context.Context; ctxt; _} -> + let+ ctxt = Context_wrapper.Memory_context.add_test_chain ctxt status in + Duo_memory_context.wrap_memory_context ctxt | Context t -> err_impl_mismatch ~got:t.impl_name let fork_test_chain (context : Environment_context.t) ~protocol ~expiration = @@ -289,6 +449,19 @@ let fork_test_chain (context : Environment_context.t) ~protocol ~expiration = | Context {kind = Brassaia_memory_context.Context; ctxt; _} -> let+ ctxt = Brassaia_memory.fork_test_chain ctxt ~protocol ~expiration in Brassaia_memory_context.wrap_memory_context ctxt + | Context {kind = Duo_context.Context; ctxt; _} -> + let+ ctxt = + Context_wrapper.Context.fork_test_chain ctxt ~protocol ~expiration + in + Duo_context.wrap_disk_context ctxt + | Context {kind = Duo_memory_context.Context; ctxt; _} -> + let+ ctxt = + Context_wrapper.Memory_context.fork_test_chain + ctxt + ~protocol + ~expiration + in + Duo_memory_context.wrap_memory_context ctxt | Context t -> err_impl_mismatch ~got:t.impl_name let commit ~time ?message (context : Environment_context.t) = @@ -301,6 +474,10 @@ let commit ~time ?message (context : Environment_context.t) = Brassaia.commit ~time ?message ctxt | Context {kind = Brassaia_memory_context.Context; ctxt; _} -> Brassaia_memory.commit ~time ?message ctxt + | Context {kind = Duo_context.Context; ctxt; _} -> + Context_wrapper.Context.commit ~time ?message ctxt + | Context {kind = Duo_memory_context.Context; ctxt; _} -> + Context_wrapper.Memory_context.commit ~time ?message ctxt | Context t -> err_impl_mismatch ~got:t.impl_name let gc context_index context_hash = @@ -309,6 +486,9 @@ let gc context_index context_hash = | Memory_index index -> Tezos_context_memory.Context.gc index context_hash | Brassaia_index index -> Brassaia.gc index context_hash | Brassaia_memory_index index -> Brassaia_memory.gc index context_hash + | Duo_index index -> Context_wrapper.Context.gc index context_hash + | Duo_memory_index index -> + Context_wrapper.Memory_context.gc index context_hash let wait_gc_completion context_index = match context_index with @@ -316,6 +496,9 @@ let wait_gc_completion context_index = | Memory_index index -> Tezos_context_memory.Context.wait_gc_completion index | Brassaia_index index -> Brassaia.wait_gc_completion index | Brassaia_memory_index index -> Brassaia_memory.wait_gc_completion index + | Duo_index index -> Context_wrapper.Context.wait_gc_completion index + | Duo_memory_index index -> + Context_wrapper.Memory_context.wait_gc_completion index let is_gc_allowed context_index = match context_index with @@ -323,6 +506,8 @@ let is_gc_allowed context_index = | Memory_index index -> Tezos_context_memory.Context.is_gc_allowed index | Brassaia_index index -> Brassaia.is_gc_allowed index | Brassaia_memory_index index -> Brassaia_memory.is_gc_allowed index + | Duo_index index -> Context_wrapper.Context.is_gc_allowed index + | Duo_memory_index index -> Context_wrapper.Memory_context.is_gc_allowed index let split context_index = match context_index with @@ -330,12 +515,16 @@ let split context_index = | Memory_index index -> Tezos_context_memory.Context.split index | Brassaia_index index -> Brassaia.split index | Brassaia_memory_index index -> Brassaia_memory.split index + | Duo_index index -> Context_wrapper.Context.split index + | Duo_memory_index index -> Context_wrapper.Memory_context.split index let sync = function | Disk_index index -> Context.sync index | Memory_index index -> Tezos_context_memory.Context.sync index | Brassaia_index index -> Brassaia.sync index | Brassaia_memory_index index -> Brassaia_memory.sync index + | Duo_index index -> Context_wrapper.Context.sync index + | Duo_memory_index index -> Context_wrapper.Memory_context.sync index let commit_test_chain_genesis (context : Environment_context.t) block_header = match context with @@ -347,6 +536,10 @@ let commit_test_chain_genesis (context : Environment_context.t) block_header = Brassaia.commit_test_chain_genesis ctxt block_header | Context {kind = Brassaia_memory_context.Context; ctxt; _} -> Brassaia_memory.commit_test_chain_genesis ctxt block_header + | Context {kind = Duo_context.Context; ctxt; _} -> + Context_wrapper.Context.commit_test_chain_genesis ctxt block_header + | Context {kind = Duo_memory_context.Context; ctxt; _} -> + Context_wrapper.Memory_context.commit_test_chain_genesis ctxt block_header | Context t -> err_impl_mismatch ~got:t.impl_name let compute_testchain_genesis (context : Environment_context.t) block_hash = @@ -359,6 +552,10 @@ let compute_testchain_genesis (context : Environment_context.t) block_hash = Brassaia.compute_testchain_genesis block_hash | Context {kind = Brassaia_memory_context.Context; _} -> Brassaia_memory.compute_testchain_genesis block_hash + | Context {kind = Duo_context.Context; _} -> + Context_wrapper.Context.compute_testchain_genesis block_hash + | Context {kind = Duo_memory_context.Context; _} -> + Context_wrapper.Memory_context.compute_testchain_genesis block_hash | Context t -> err_impl_mismatch ~got:t.impl_name let merkle_tree (context : Environment_context.t) leaf_kind path = @@ -371,6 +568,10 @@ let merkle_tree (context : Environment_context.t) leaf_kind path = Brassaia.merkle_tree ctxt leaf_kind path | Context {kind = Brassaia_memory_context.Context; ctxt; _} -> Brassaia_memory.merkle_tree ctxt leaf_kind path + | Context {kind = Duo_context.Context; ctxt; _} -> + Context_wrapper.Context.merkle_tree ctxt leaf_kind path + | Context {kind = Duo_memory_context.Context; ctxt; _} -> + Context_wrapper.Memory_context.merkle_tree ctxt leaf_kind path | Context t -> err_impl_mismatch ~got:t.impl_name let merkle_tree_v2 (context : Environment_context.t) leaf_kind path = @@ -383,6 +584,10 @@ let merkle_tree_v2 (context : Environment_context.t) leaf_kind path = Brassaia.merkle_tree_v2 ctxt leaf_kind path | Context {kind = Brassaia_memory_context.Context; ctxt; _} -> Brassaia_memory.merkle_tree_v2 ctxt leaf_kind path + | Context {kind = Duo_context.Context; ctxt; _} -> + Context_wrapper.Context.merkle_tree_v2 ctxt leaf_kind path + | Context {kind = Duo_memory_context.Context; ctxt; _} -> + Context_wrapper.Memory_context.merkle_tree_v2 ctxt leaf_kind path | Context t -> err_impl_mismatch ~got:t.impl_name let commit_genesis context_index ~chain_id ~time ~protocol = @@ -398,6 +603,14 @@ let commit_genesis context_index ~chain_id ~time ~protocol = Brassaia.commit_genesis index ~chain_id ~time ~protocol | Brassaia_memory_index index -> Brassaia_memory.commit_genesis index ~chain_id ~time ~protocol + | Duo_index index -> + Context_wrapper.Context.commit_genesis index ~chain_id ~time ~protocol + | Duo_memory_index index -> + Context_wrapper.Memory_context.commit_genesis + index + ~chain_id + ~time + ~protocol let checkout context_index context_hash = let open Lwt_syntax in @@ -414,6 +627,8 @@ let checkout context_index context_hash = | Brassaia_memory_index index -> let+ ctxt = Brassaia_memory.checkout index context_hash in Option.map Brassaia_memory_context.wrap_memory_context ctxt + | Duo_index index -> Duo_context.checkout index context_hash + | Duo_memory_index index -> Duo_memory_context.checkout index context_hash let checkout_exn context_index context_hash = let open Lwt_syntax in @@ -432,6 +647,8 @@ let checkout_exn context_index context_hash = | Brassaia_memory_index index -> let+ ctxt = Brassaia_memory.checkout_exn index context_hash in Brassaia_memory_context.wrap_memory_context ctxt + | Duo_index index -> Duo_context.checkout_exn index context_hash + | Duo_memory_index index -> Duo_memory_context.checkout_exn index context_hash let exists context_index context_hash = match context_index with @@ -439,6 +656,9 @@ let exists context_index context_hash = | Memory_index index -> Tezos_context_memory.Context.exists index context_hash | Brassaia_index index -> Brassaia.exists index context_hash | Brassaia_memory_index index -> Brassaia_memory.exists index context_hash + | Duo_index index -> Context_wrapper.Context.exists index context_hash + | Duo_memory_index index -> + Context_wrapper.Memory_context.exists index context_hash let close context_index = match context_index with @@ -446,6 +666,8 @@ let close context_index = | Memory_index index -> Tezos_context_memory.Context.close index | Brassaia_index index -> Brassaia.close index | Brassaia_memory_index index -> Brassaia_memory.close index + | Duo_index index -> Context_wrapper.Context.close index + | Duo_memory_index index -> Context_wrapper.Memory_context.close index let compute_testchain_chain_id (context : Environment_context.t) block_hash = match context with @@ -457,4 +679,8 @@ let compute_testchain_chain_id (context : Environment_context.t) block_hash = Brassaia.compute_testchain_chain_id block_hash | Context {kind = Brassaia_memory_context.Context; _} -> Brassaia_memory.compute_testchain_chain_id block_hash + | Context {kind = Duo_context.Context; _} -> + Context_wrapper.Context.compute_testchain_chain_id block_hash + | Context {kind = Duo_memory_context.Context; _} -> + Context_wrapper.Memory_context.compute_testchain_chain_id block_hash | Context t -> err_impl_mismatch ~got:t.impl_name diff --git a/src/lib_protocol_environment/context_ops/dune b/src/lib_protocol_environment/context_ops/dune index 3be71adfc1b9..b766c4264138 100644 --- a/src/lib_protocol_environment/context_ops/dune +++ b/src/lib_protocol_environment/context_ops/dune @@ -12,7 +12,8 @@ octez-libs.tezos-context octez-libs.tezos-context-brassaia octez-shell-libs.shell-context - octez-shell-libs.brassaia-context) + octez-shell-libs.brassaia-context + octez-shell-libs.duo-context-lib) (flags (:standard) -open Tezos_base.TzPervasives @@ -20,4 +21,5 @@ -open Tezos_context -open Tezos_context_brassaia -open Tezos_shell_context - -open Tezos_brassaia_context)) + -open Tezos_brassaia_context + -open Tezos_duo_context_lib)) diff --git a/src/lib_protocol_environment/duo_context_lib/context_wrapper.ml b/src/lib_protocol_environment/duo_context_lib/context_wrapper.ml new file mode 100644 index 000000000000..29956c38ae68 --- /dev/null +++ b/src/lib_protocol_environment/duo_context_lib/context_wrapper.ml @@ -0,0 +1,681 @@ +(*****************************************************************************) +(* *) +(* SPDX-License-Identifier: MIT *) +(* SPDX-FileCopyrightText: 2024 Nomadic Labs *) +(* *) +(*****************************************************************************) + +module type IRMIN_CONTEXT = + Tezos_context_sigs.Context.TEZOS_CONTEXT + with type memory_context_tree := Tezos_context_memory.Context.tree + +module type BRASSAIA_CONTEXT = + Tezos_context_sigs.Context.TEZOS_CONTEXT + with type memory_context_tree := + Tezos_context_brassaia_memory.Tezos_context_memory.Context.tree + +module Make + (Irmin_Context : IRMIN_CONTEXT) + (Brassaia_Context : BRASSAIA_CONTEXT) = +struct + open Lwt_syntax + + type index = { + irmin_index : Irmin_Context.index; + brassaia_index : Brassaia_Context.index; + } + + type t = { + irmin_context : Irmin_Context.t; + brassaia_context : Brassaia_Context.t; + } + + type key = Irmin_Context.key + + type value = Irmin_Context.value + + type tree = { + irmin_tree : Irmin_Context.tree; + brassaia_tree : Brassaia_Context.tree; + } + + module Tree = struct + module Irmin_Tree = Irmin_Context.Tree + module Brassaia_Tree = Brassaia_Context.Tree + + let mem : tree -> key -> bool Lwt.t = + fun t key -> + let* b1 = Irmin_Tree.mem t.irmin_tree key in + let+ b2 = Brassaia_Tree.mem t.brassaia_tree key in + assert (b1 = b2) ; + b1 + + let mem_tree : tree -> key -> bool Lwt.t = + fun t key -> + let* b1 = Irmin_Tree.mem_tree t.irmin_tree key in + let+ b2 = Brassaia_Tree.mem_tree t.brassaia_tree key in + assert (b1 = b2) ; + b1 + + let find : tree -> key -> value option Lwt.t = + fun t key -> + let* v1 = Irmin_Tree.find t.irmin_tree key in + let+ v2 = Brassaia_Tree.find t.brassaia_tree key in + assert (v1 = v2) ; + v1 + + let find_tree : tree -> key -> tree option Lwt.t = + fun t key -> + let* irmin_tree = Irmin_Tree.find_tree t.irmin_tree key in + let+ brassaia_tree = Brassaia_Tree.find_tree t.brassaia_tree key in + match (irmin_tree, brassaia_tree) with + | Some irmin_tree, Some brassaia_tree -> Some {irmin_tree; brassaia_tree} + | None, None -> None + | _ -> Fmt.failwith "Received Some tree and None" + + let list : + tree -> ?offset:int -> ?length:int -> key -> (string * tree) list Lwt.t + = + fun t ?offset ?length key -> + let* irmin_list = Irmin_Tree.list t.irmin_tree ?offset ?length key in + let+ brassaia_list = + Brassaia_Tree.list t.brassaia_tree ?offset ?length key + in + assert (List.compare_lengths irmin_list brassaia_list = 0) ; + List.map + (fun (key, irmin_tree) -> + let brassaia_tree = + List.find (fun (key2, _) -> String.equal key key2) brassaia_list + |> Option.value + ~default:(Fmt.failwith "No value associated to %s" key) + |> snd + in + (key, {irmin_tree; brassaia_tree})) + irmin_list + + let length : tree -> key -> int Lwt.t = + fun t key -> + let* length1 = Irmin_Tree.length t.irmin_tree key in + let+ length2 = Brassaia_Tree.length t.brassaia_tree key in + assert (length1 = length2) ; + length1 + + let add : tree -> key -> value -> tree Lwt.t = + fun t key value -> + let* irmin_tree = Irmin_Tree.add t.irmin_tree key value in + let+ brassaia_tree = Brassaia_Tree.add t.brassaia_tree key value in + {irmin_tree; brassaia_tree} + + let add_tree : tree -> key -> tree -> tree Lwt.t = + fun t key tree -> + let* irmin_tree = Irmin_Tree.add_tree t.irmin_tree key tree.irmin_tree in + let+ brassaia_tree = + Brassaia_Tree.add_tree t.brassaia_tree key tree.brassaia_tree + in + {irmin_tree; brassaia_tree} + + let remove : tree -> key -> tree Lwt.t = + fun t key -> + let* irmin_tree = Irmin_Tree.remove t.irmin_tree key in + let+ brassaia_tree = Brassaia_Tree.remove t.brassaia_tree key in + {irmin_tree; brassaia_tree} + + let fold : + ?depth:Tezos_context_sigs.Context.depth -> + tree -> + key -> + order:[`Sorted | `Undefined] -> + init:'a -> + f:(key -> tree -> 'a -> 'a Lwt.t) -> + 'a Lwt.t = + fun ?depth t key ~order ~init ~f -> + let f_irmin key irmin_tree acc = f key {t with irmin_tree} acc in + let res1 = + Irmin_Tree.fold ?depth t.irmin_tree key ~order ~init ~f:f_irmin + in + let f_brassaia key brassaia_tree acc = f key {t with brassaia_tree} acc in + let _res2 = + Brassaia_Tree.fold ?depth t.brassaia_tree key ~order ~init ~f:f_brassaia + in + (* assert (res1 = res2) ; *) + res1 + + let config : tree -> Tezos_context_sigs.Config.t = + fun t -> + let config1 = Irmin_Tree.config t.irmin_tree in + let config2 = Brassaia_Tree.config t.brassaia_tree in + assert (Tezos_context_sigs.Config.equal config1 config2) ; + config1 + + let empty : t -> tree = + fun t -> + let irmin_tree = Irmin_Tree.empty t.irmin_context in + let brassaia_tree = Brassaia_Tree.empty t.brassaia_context in + {irmin_tree; brassaia_tree} + + let irmin_tree : Irmin_Context.tree -> tree = + fun irmin_tree -> {irmin_tree; brassaia_tree = Obj.magic irmin_tree} + + let brassaia_tree : Brassaia_Context.tree -> tree = + fun brassaia_tree -> {brassaia_tree; irmin_tree = Obj.magic brassaia_tree} + + let is_empty : tree -> bool = + fun t -> + let bool1 = Irmin_Tree.is_empty t.irmin_tree in + let bool2 = Brassaia_Tree.is_empty t.brassaia_tree in + assert (bool1 = bool2) ; + bool1 + + let kind : tree -> Tezos_context_sigs.Context.Kind.t = + fun t -> + let kind1 = Irmin_Tree.kind t.irmin_tree in + let kind2 = Brassaia_Tree.kind t.brassaia_tree in + assert (kind1 = kind2) ; + kind1 + + let to_value : tree -> value option Lwt.t = + fun t -> + let* value1 = Irmin_Tree.to_value t.irmin_tree in + let+ value2 = Brassaia_Tree.to_value t.brassaia_tree in + match (value1, value2) with + | Some value1, Some value2 -> + assert (value1 = value2) ; + Some value1 + | None, None -> None + | _ -> Fmt.failwith "Received Some value and None" + + let of_value : t -> value -> tree Lwt.t = + fun t value -> + let* irmin_tree = Irmin_Tree.of_value t.irmin_context value in + let+ brassaia_tree = Brassaia_Tree.of_value t.brassaia_context value in + {irmin_tree; brassaia_tree} + + let hash : tree -> Context_hash.t = + fun t -> + let context_hash1 = Irmin_Tree.hash t.irmin_tree in + let context_hash2 = Brassaia_Tree.hash t.brassaia_tree in + assert (context_hash1 = context_hash2) ; + context_hash1 + + let equal : tree -> tree -> bool = + fun t1 t2 -> + let bool1 = Irmin_Tree.equal t1.irmin_tree t2.irmin_tree in + let bool2 = Brassaia_Tree.equal t1.brassaia_tree t2.brassaia_tree in + assert (bool1 = bool2) ; + bool1 + + let clear : ?depth:int -> tree -> unit = + fun ?depth t -> + let () = Irmin_Tree.clear ?depth t.irmin_tree in + Brassaia_Tree.clear ?depth t.brassaia_tree + + let pp : Format.formatter -> tree -> unit = + fun ppf t -> + Irmin_Tree.pp ppf t.irmin_tree ; + Brassaia_Tree.pp ppf t.brassaia_tree + + type raw = Irmin_Tree.raw + (* [`Tree of raw Tezos_base.TzPervasives.String.Map.t | `Value of value] *) + + let raw_encoding : raw Tezos_base.TzPervasives.Data_encoding.t = + Irmin_Tree.raw_encoding + + let to_raw : tree -> raw Lwt.t = + fun t -> + let* raw1 = Irmin_Tree.to_raw t.irmin_tree in + let+ raw2 = Brassaia_Tree.to_raw t.brassaia_tree in + assert (raw1 = raw2) ; + raw1 + + let of_raw : raw -> tree = + fun raw -> + let irmin_tree = Irmin_Tree.of_raw raw in + let brassaia_tree = Brassaia_Tree.of_raw raw in + {irmin_tree; brassaia_tree} + + let unshallow : tree -> tree Lwt.t = + fun t -> + let* irmin_tree = Irmin_Tree.unshallow t.irmin_tree in + let+ brassaia_tree = Brassaia_Tree.unshallow t.brassaia_tree in + {irmin_tree; brassaia_tree} + + type repo = Irmin_Tree.repo + + let make_repo : unit -> repo Lwt.t = Irmin_Tree.make_repo + + let is_shallow : tree -> bool = + fun t -> + let bool1 = Irmin_Tree.is_shallow t.irmin_tree in + let bool2 = Brassaia_Tree.is_shallow t.brassaia_tree in + assert (bool1 = bool2) ; + bool1 + + let kinded_key : tree -> Irmin_Context.kinded_key option = + fun t -> + let kinded_key1 = Irmin_Tree.kinded_key t.irmin_tree in + let kinded_key2 = Brassaia_Tree.kinded_key t.brassaia_tree in + assert (kinded_key1 = Obj.magic kinded_key2) ; + kinded_key1 + end + + module Proof = Irmin_Context.Proof + + let add_protocol : t -> Protocol_hash.t -> t Lwt.t = + fun t hash -> + let* irmin_context = Irmin_Context.add_protocol t.irmin_context hash in + let+ brassaia_context = + Brassaia_Context.add_protocol t.brassaia_context hash + in + {irmin_context; brassaia_context} + + let equal_config config1 config2 = + let bool1 = Irmin_Context.equal_config config1 config2 in + let bool2 = Brassaia_Context.equal_config config1 config2 in + assert (bool1 = bool2) ; + bool1 + + let mem : t -> key -> bool Lwt.t = + fun t key -> + let* bool1 = Irmin_Context.mem t.irmin_context key in + let+ bool2 = Brassaia_Context.mem t.brassaia_context (Obj.magic key) in + assert (bool1 = bool2) ; + bool1 + + let mem_tree : t -> key -> bool Lwt.t = + fun t key -> + let* bool1 = Irmin_Context.mem_tree t.irmin_context key in + let+ bool2 = Brassaia_Context.mem_tree t.brassaia_context key in + assert (bool1 = bool2) ; + bool1 + + let find : t -> key -> value option Lwt.t = + fun t key -> + let* value1 = Irmin_Context.find t.irmin_context key in + let+ value2 = Brassaia_Context.find t.brassaia_context key in + assert (value1 = value2) ; + value1 + + let find_tree : t -> key -> tree option Lwt.t = + fun t key -> + let* irmin_tree = Irmin_Context.find_tree t.irmin_context key in + let+ brassaia_tree = Brassaia_Context.find_tree t.brassaia_context key in + match (irmin_tree, brassaia_tree) with + | Some irmin_tree, Some brassaia_tree -> Some {irmin_tree; brassaia_tree} + | None, None -> None + | _ -> Fmt.failwith "Received Some tree and None" + + let list : + t -> ?offset:int -> ?length:int -> key -> (string * tree) list Lwt.t = + fun t ?offset ?length key -> + let* irmin_list = Irmin_Context.list t.irmin_context ?offset ?length key in + let+ brassaia_list = + Brassaia_Context.list t.brassaia_context ?offset ?length key + in + assert (List.compare_lengths irmin_list brassaia_list = 0) ; + List.map + (fun (key, irmin_tree) -> + let brassaia_tree = + List.find (fun (key2, _) -> String.equal key key2) brassaia_list + |> Option.value + ~default:(Fmt.failwith "No value associated to %s" key) + |> snd + in + (key, {irmin_tree; brassaia_tree})) + irmin_list + + let length : t -> key -> int Lwt.t = + fun t key -> + let* length1 = Irmin_Context.length t.irmin_context key in + let+ length2 = Brassaia_Context.length t.brassaia_context key in + assert (length1 = length2) ; + length1 + + let add : t -> key -> value -> t Lwt.t = + fun t key value -> + let* irmin_context = Irmin_Context.add t.irmin_context key value in + let+ brassaia_context = Brassaia_Context.add t.brassaia_context key value in + {irmin_context; brassaia_context} + + let add_tree : t -> key -> tree -> t Lwt.t = + fun t key tree -> + let* irmin_context = + Irmin_Context.add_tree t.irmin_context key tree.irmin_tree + in + let+ brassaia_context = + Brassaia_Context.add_tree t.brassaia_context key tree.brassaia_tree + in + {irmin_context; brassaia_context} + + let remove : t -> key -> t Lwt.t = + fun t key -> + let* irmin_context = Irmin_Context.remove t.irmin_context key in + let+ brassaia_context = Brassaia_Context.remove t.brassaia_context key in + {irmin_context; brassaia_context} + + let fold : + ?depth:Tezos_context_sigs.Context.depth -> + t -> + key -> + order:[`Sorted | `Undefined] -> + init:'a -> + f:(key -> tree -> 'a -> 'a Lwt.t) -> + 'a Lwt.t = + fun ?depth t key ~order ~init ~f -> + let f_irmin key irmin_tree acc = + f key {(Tree.empty t) with irmin_tree} acc + in + let res1 = + Irmin_Context.fold ?depth t.irmin_context key ~order ~init ~f:f_irmin + in + let f_brassaia key brassaia_tree acc = + f key {(Tree.empty t) with brassaia_tree} acc + in + let _res2 = + Brassaia_Context.fold + ?depth + t.brassaia_context + key + ~order + ~init + ~f:f_brassaia + in + (* assert (res1 = res2) ; *) + res1 + + let config : t -> Tezos_context_sigs.Config.t = + fun t -> + let config1 = Irmin_Context.config t.irmin_context in + let config2 = Brassaia_Context.config t.brassaia_context in + assert (Tezos_context_sigs.Config.equal config1 config2) ; + config1 + + let get_protocol : t -> Protocol_hash.t Lwt.t = + fun t -> + let* hash1 = Irmin_Context.get_protocol t.irmin_context in + let+ hash2 = Brassaia_Context.get_protocol t.brassaia_context in + assert (Protocol_hash.equal hash1 hash2) ; + hash1 + + let fork_test_chain : + t -> protocol:Protocol_hash.t -> expiration:Time.Protocol.t -> t Lwt.t = + fun t ~protocol ~expiration -> + let* irmin_context = + Irmin_Context.fork_test_chain t.irmin_context ~protocol ~expiration + in + let+ brassaia_context = + Brassaia_Context.fork_test_chain t.brassaia_context ~protocol ~expiration + in + {irmin_context; brassaia_context} + + let set_hash_version : t -> Context_hash.version -> t tzresult Lwt.t = + fun t version -> + let open Lwt_result_syntax in + let* irmin_context = + Irmin_Context.set_hash_version t.irmin_context version + in + let+ brassaia_context = + Brassaia_Context.set_hash_version t.brassaia_context version + in + {irmin_context; brassaia_context} + + let get_hash_version : t -> Context_hash.version = + fun t -> + let version1 = Irmin_Context.get_hash_version t.irmin_context in + let version2 = Brassaia_Context.get_hash_version t.brassaia_context in + assert (Context_hash.Version.equal version1 version2) ; + version1 + + let verify_tree_proof : + Proof.tree Proof.t -> + (tree -> (tree * 'a) Lwt.t) -> + ( tree * 'a, + [ `Proof_mismatch of string + | `Stream_too_long of string + | `Stream_too_short of string ] ) + result + Lwt.t = + fun proof f -> + let open Lwt_result_syntax in + let f_irmin irmin_tree = + let open Lwt_syntax in + let+ tree, res = f (Tree.irmin_tree irmin_tree) in + (tree.irmin_tree, res) + in + let* irmin_tree, res1 = Irmin_Context.verify_tree_proof proof f_irmin in + let f_brassaia brassaia_tree = + let open Lwt_syntax in + let+ tree, res = f (Tree.brassaia_tree brassaia_tree) in + (tree.brassaia_tree, res) + in + let+ brassaia_tree, res2 = + Brassaia_Context.verify_tree_proof proof f_brassaia + in + assert (res1 = res2) ; + ({irmin_tree; brassaia_tree}, res1) + + let verify_stream_proof : + Proof.stream Proof.t -> + (tree -> (tree * 'a) Lwt.t) -> + ( tree * 'a, + [ `Proof_mismatch of string + | `Stream_too_long of string + | `Stream_too_short of string ] ) + result + Lwt.t = + fun proof f -> + let open Lwt_result_syntax in + let f_irmin irmin_tree = + let open Lwt_syntax in + let+ tree, res = f (Tree.irmin_tree irmin_tree) in + (tree.irmin_tree, res) + in + let* irmin_tree, res1 = Irmin_Context.verify_stream_proof proof f_irmin in + let f_brassaia brassaia_tree = + let open Lwt_syntax in + let+ tree, res = f (Tree.brassaia_tree brassaia_tree) in + (tree.brassaia_tree, res) + in + let+ brassaia_tree, res2 = + Brassaia_Context.verify_stream_proof proof f_brassaia + in + assert (res1 = res2) ; + ({irmin_tree; brassaia_tree}, res1) + + (** Exported functions *) + + let index context = + let irmin_index = Irmin_Context.index context.irmin_context in + let brassaia_index = Brassaia_Context.index context.brassaia_context in + {irmin_index; brassaia_index} + + (** GC functions *) + + let gc : index -> Context_hash.t -> unit Lwt.t = + fun index context_hash -> + let* () = Irmin_Context.gc index.irmin_index context_hash in + Brassaia_Context.gc index.brassaia_index context_hash + + let wait_gc_completion : index -> unit Lwt.t = + fun index -> + let* () = Irmin_Context.wait_gc_completion index.irmin_index in + Brassaia_Context.wait_gc_completion index.brassaia_index + + let is_gc_allowed : index -> bool = + fun index -> + let bool1 = Irmin_Context.is_gc_allowed index.irmin_index in + let bool2 = Brassaia_Context.is_gc_allowed index.brassaia_index in + assert (bool1 = bool2) ; + bool1 + + let split : index -> unit Lwt.t = + fun index -> + let* () = Irmin_Context.split index.irmin_index in + Brassaia_Context.split index.brassaia_index + + let sync : index -> unit Lwt.t = + fun index -> + let* () = Irmin_Context.sync index.irmin_index in + Brassaia_Context.sync index.brassaia_index + + let exists : index -> Context_hash.t -> bool Lwt.t = + fun index context_hash -> + let* bool1 = Irmin_Context.exists index.irmin_index context_hash in + let+ bool2 = Brassaia_Context.exists index.brassaia_index context_hash in + assert (bool1 = bool2) ; + bool1 + + let close : index -> unit Lwt.t = + fun index -> + let* () = Irmin_Context.close index.irmin_index in + Brassaia_Context.close index.brassaia_index + + let compute_testchain_chain_id : Block_hash.t -> Chain_id.t = + fun block_hash -> + let chain_id1 = Irmin_Context.compute_testchain_chain_id block_hash in + let chain_id2 = Brassaia_Context.compute_testchain_chain_id block_hash in + assert (Chain_id.equal chain_id1 chain_id2) ; + chain_id1 + + (** Miscellaneous *) + + let add_predecessor_block_metadata_hash : + t -> Block_metadata_hash.t -> t Lwt.t = + fun t hash -> + let* irmin_context = + Irmin_Context.add_predecessor_block_metadata_hash t.irmin_context hash + in + let+ brassaia_context = + Brassaia_Context.add_predecessor_block_metadata_hash + t.brassaia_context + hash + in + {irmin_context; brassaia_context} + + let add_predecessor_ops_metadata_hash : + t -> Operation_metadata_list_list_hash.t -> t Lwt.t = + fun t hash -> + let* irmin_context = + Irmin_Context.add_predecessor_ops_metadata_hash t.irmin_context hash + in + let+ brassaia_context = + Brassaia_Context.add_predecessor_ops_metadata_hash t.brassaia_context hash + in + {irmin_context; brassaia_context} + + let hash : time:Time.Protocol.t -> ?message:string -> t -> Context_hash.t = + fun ~time ?message t -> + let context_hash1 = Irmin_Context.hash ~time ?message t.irmin_context in + let context_hash2 = + Brassaia_Context.hash ~time ?message t.brassaia_context + in + assert (Context_hash.equal context_hash1 context_hash2) ; + context_hash1 + + let commit_test_chain_genesis : t -> Block_header.t -> Block_header.t Lwt.t = + fun context block_header -> + let* block_header1 = + Irmin_Context.commit_test_chain_genesis context.irmin_context block_header + in + let+ block_header2 = + Brassaia_Context.commit_test_chain_genesis + context.brassaia_context + block_header + in + assert (Block_header.equal block_header1 block_header2) ; + block_header1 + + let get_test_chain : t -> Test_chain_status.t Lwt.t = + fun t -> + let* status1 = Irmin_Context.get_test_chain t.irmin_context in + let+ status2 = Brassaia_Context.get_test_chain t.brassaia_context in + assert (Test_chain_status.equal status1 status2) ; + status1 + + let add_test_chain : t -> Test_chain_status.t -> t Lwt.t = + fun t status -> + let* irmin_context = Irmin_Context.add_test_chain t.irmin_context status in + let+ brassaia_context = + Brassaia_Context.add_test_chain t.brassaia_context status + in + {irmin_context; brassaia_context} + + let commit : + time:Time.Protocol.t -> ?message:string -> t -> Context_hash.t Lwt.t = + fun ~time ?message t -> + let* context_hash1 = Irmin_Context.commit ~time ?message t.irmin_context in + let+ context_hash2 = + Brassaia_Context.commit ~time ?message t.brassaia_context + in + assert (Context_hash.equal context_hash1 context_hash2) ; + context_hash1 + + let commit_genesis : + index -> + chain_id:Chain_id.t -> + time:Time.Protocol.t -> + protocol:Protocol_hash.t -> + Context_hash.t tzresult Lwt.t = + fun index ~chain_id ~time ~protocol -> + let open Lwt_result_syntax in + let* context_hash1 = + Irmin_Context.commit_genesis index.irmin_index ~chain_id ~time ~protocol + in + let+ context_hash2 = + Brassaia_Context.commit_genesis + index.brassaia_index + ~chain_id + ~time + ~protocol + in + assert (Context_hash.equal context_hash1 context_hash2) ; + context_hash1 + + let compute_testchain_genesis : Block_hash.t -> Block_hash.t = + fun block_hash -> + let block_hash1 = Irmin_Context.compute_testchain_genesis block_hash in + let block_hash2 = Brassaia_Context.compute_testchain_genesis block_hash in + assert (Block_hash.equal block_hash1 block_hash2) ; + block_hash1 + + let merkle_tree : + t -> + Proof.merkle_leaf_kind -> + key -> + Tezos_context_sigs.Context.Proof_types.merkle_tree Lwt.t = + fun context leaf_kind path -> + let* proof1 = + Irmin_Context.merkle_tree context.irmin_context leaf_kind path + in + let+ _proof2 = + Brassaia_Context.merkle_tree context.brassaia_context leaf_kind path + in + proof1 + + let merkle_tree_v2 : + t -> Proof.merkle_leaf_kind -> key -> Proof.tree Proof.t Lwt.t = + fun context leaf_kind path -> + let* proof1 = + Irmin_Context.merkle_tree_v2 context.irmin_context leaf_kind path + in + let+ _proof2 = + Brassaia_Context.merkle_tree_v2 context.brassaia_context leaf_kind path + in + proof1 +end + +module Context = + Make (Tezos_context.Context) (Tezos_context_brassaia.Tezos_context.Context) +module Context_binary = + Make + (Tezos_context.Context_binary) + (Tezos_context_brassaia.Tezos_context.Context_binary) + +module Memory_context = + Make + (Tezos_context_memory.Context) + (Tezos_context_brassaia_memory.Tezos_context_memory.Context) + +(* module Memory_context_binary = *) +(* Make *) +(* (Tezos_context_memory.Context_binary) *) +(* (Tezos_context_brassaia_memory.Tezos_context_memory.Context_binary) *) diff --git a/src/lib_protocol_environment/duo_context_lib/dune b/src/lib_protocol_environment/duo_context_lib/dune new file mode 100644 index 000000000000..6a1e7f5c8db8 --- /dev/null +++ b/src/lib_protocol_environment/duo_context_lib/dune @@ -0,0 +1,15 @@ +; This file was automatically generated, do not edit. +; Edit file manifest/main.ml instead. + +(library + (name tezos_duo_context_lib) + (public_name octez-shell-libs.duo-context-lib) + (instrumentation (backend bisect_ppx)) + (libraries + octez-libs.base + octez-proto-libs.protocol-environment + octez-libs.tezos-context-brassaia + octez-libs.tezos-context) + (flags + (:standard) + -open Tezos_base.TzPervasives)) diff --git a/src/lib_protocol_environment/duo_context_lib/duo_context.ml b/src/lib_protocol_environment/duo_context_lib/duo_context.ml new file mode 100644 index 000000000000..ebcce9c69bac --- /dev/null +++ b/src/lib_protocol_environment/duo_context_lib/duo_context.ml @@ -0,0 +1,67 @@ +(*****************************************************************************) +(* *) +(* SPDX-License-Identifier: MIT *) +(* SPDX-FileCopyrightText: 2024 Nomadic Labs *) +(* *) +(*****************************************************************************) + +open Tezos_protocol_environment +open Context + +module C = struct + include Context_wrapper.Context + + let set_protocol = add_protocol +end + +include Register (C) + +let impl_name = "duo" + +let checkout : C.index -> Context_hash.t -> t option Lwt.t = + fun index context_hash -> + let open Lwt_syntax in + let* irmin_context = + Tezos_context.Context.checkout index.C.irmin_index context_hash + in + let+ brassaia_context = + Tezos_context_brassaia.Tezos_context.Context.checkout + index.brassaia_index + context_hash + in + match (irmin_context, brassaia_context) with + | Some irmin_context, Some brassaia_context -> + Some + (Context.make + ~ops + ~ctxt:{irmin_context; brassaia_context} + ~kind:Context + ~equality_witness + ~impl_name) + | _ -> None + +let checkout_exn : C.index -> Context_hash.t -> t Lwt.t = + fun index context_hash -> + let open Lwt_syntax in + let* irmin_context = + Tezos_context.Context.checkout_exn index.C.irmin_index context_hash + in + let+ brassaia_context = + Tezos_context_brassaia.Tezos_context.Context.checkout_exn + index.C.brassaia_index + context_hash + in + Context.make + ~ops + ~ctxt:{irmin_context; brassaia_context} + ~kind:Context + ~equality_witness + ~impl_name + +let wrap_disk_context ctxt = + Context.make ~ops ~ctxt ~kind:Context ~equality_witness ~impl_name + +let unwrap_disk_context : t -> C.t = function + | Context.Context {ctxt; kind = Context; _} -> ctxt + | Context.Context t -> + err_implementation_mismatch ~expected:impl_name ~got:t.impl_name diff --git a/src/lib_protocol_environment/duo_context_lib/duo_context.mli b/src/lib_protocol_environment/duo_context_lib/duo_context.mli new file mode 100644 index 000000000000..e6b2df2e83b2 --- /dev/null +++ b/src/lib_protocol_environment/duo_context_lib/duo_context.mli @@ -0,0 +1,59 @@ +(*****************************************************************************) +(* *) +(* SPDX-License-Identifier: MIT *) +(* SPDX-FileCopyrightText: 2024 Nomadic Labs *) +(* *) +(*****************************************************************************) + +(** [Brassaia_context] is a persisting recursive map backed by an on-disk Brassaia tree, + i.e. {!Tezos_context.Context} (in [src/lib_context]), used + by nodes. It is the "main" kind of context. It abstracts away + {!Tezos_context.Context}, by hiding the internals, and making it + an instance of the generic {!Protocol_environment.Context.t}. + Other [*_context] modules of {!Tezos_protocol_environment}, i.e. + siblings of this file, are backed by different type of values coming + from {!Tezos_context}. + + [Brassaia_context] is one of the instances of {!Environment_context} along + {!Memory_context} and {!Proxy_context}. All these 3 instances + can implement the same API (i.e. {!Environment_context}), because + this API is highly polymorphic, thanks to {!Environment_context.Context.ops}. + + As such, a {!Brassaia_context} value is an instance of {!Environment_context} + whose [kind] is the one declared in this file. + + Instances of {!Brassaia_context} are harder to obtain than {!Memory_context} ones, because + they require a dedicated folder on disk (the subdirectory [context] + of the node's [--data-dir] when it runs). As such, instances of + {!Brassaia_context} are harder to initialize and use than {!Memory_context}; + making them less amenable to testing for example. *) + +open Tezos_protocol_environment +(* open Tezos_context_brassaia *) + +(** The additional kind identifying {!Brassaia_context} values. Used to + detect at runtime when a brassaia context is expected, to disambiguate + from other kinds. *) +type _ Context.kind += Context : Context_wrapper.Context.t Context.kind + +(** [checkout index ctxt_hash] checks whether the underlying data on disk + contain an entry for [ctxt_hash]. If so, it is returned; otherwise + [Nothing] is returned. *) +val checkout : + Context_wrapper.Context.index -> Context_hash.t -> Context.t option Lwt.t + +(** [checkout_exn index ctxt_hash] checks whether the underlying data on disk + contain an entry for [ctxt_hash]. If so, the data are loaded and returned; + otherwise the exception thrown by {!Tezos_context_brassaia.Context.checkout_exn} + is forwarded. Prefer using {!checkout}. *) +val checkout_exn : + Context_wrapper.Context.index -> Context_hash.t -> Context.t Lwt.t + +(** [wrap_disk_context t] creates a brassaia context from an Brassaia on-disk folder + (i.e. {!Tezos_context.Context.t}). This function hereby abstracts away + a value, from the low-level [lib_context] to the higher-level [lib_protocol_environment]. *) +val wrap_disk_context : Context_wrapper.Context.t -> Context.t + +(** [unwrap_disk_context t] gives access to the lower-level {!Tezos_context.Context.t} + value underlying a {!Brassaia_context}. *) +val unwrap_disk_context : Context.t -> Context_wrapper.Context.t diff --git a/src/lib_protocol_environment/duo_context_lib/duo_context_lib.ml b/src/lib_protocol_environment/duo_context_lib/duo_context_lib.ml new file mode 100644 index 000000000000..ab9ff6307813 --- /dev/null +++ b/src/lib_protocol_environment/duo_context_lib/duo_context_lib.ml @@ -0,0 +1,9 @@ +(*****************************************************************************) +(* *) +(* SPDX-License-Identifier: MIT *) +(* SPDX-FileCopyrightText: 2024 Nomadic Labs *) +(* *) +(*****************************************************************************) + +module Duo_context = Duo_context +module Duo_memory_context = Duo_memory_context diff --git a/src/lib_protocol_environment/duo_context_lib/duo_memory_context.ml b/src/lib_protocol_environment/duo_context_lib/duo_memory_context.ml new file mode 100644 index 000000000000..9ddd1b65bba8 --- /dev/null +++ b/src/lib_protocol_environment/duo_context_lib/duo_memory_context.ml @@ -0,0 +1,67 @@ +(*****************************************************************************) +(* *) +(* SPDX-License-Identifier: MIT *) +(* SPDX-FileCopyrightText: 2024 Nomadic Labs *) +(* *) +(*****************************************************************************) + +open Tezos_protocol_environment +open Context + +module C = struct + include Context_wrapper.Memory_context + + let set_protocol = add_protocol +end + +include Register (C) + +let impl_name = "duo_memory" + +let checkout : C.index -> Context_hash.t -> t option Lwt.t = + fun index context_hash -> + let open Lwt_syntax in + let* irmin_context = + Tezos_context_memory.Context.checkout index.irmin_index context_hash + in + let+ brassaia_context = + Tezos_context_brassaia_memory.Tezos_context_memory.Context.checkout + index.brassaia_index + context_hash + in + match (irmin_context, brassaia_context) with + | Some irmin_context, Some brassaia_context -> + Some + (Context.make + ~ops + ~ctxt:{irmin_context; brassaia_context} + ~kind:Context + ~equality_witness + ~impl_name) + | _ -> None + +let checkout_exn : C.index -> Context_hash.t -> t Lwt.t = + fun index context_hash -> + let open Lwt_syntax in + let* irmin_context = + Tezos_context_memory.Context.checkout_exn index.C.irmin_index context_hash + in + let+ brassaia_context = + Tezos_context_brassaia_memory.Tezos_context_memory.Context.checkout_exn + index.C.brassaia_index + context_hash + in + Context.make + ~ops + ~ctxt:{irmin_context; brassaia_context} + ~kind:Context + ~equality_witness + ~impl_name + +let wrap_memory_context ctxt = + Context.make ~ops ~ctxt ~kind:Context ~equality_witness ~impl_name + +let unwrap_memory_context : t -> C.t = function + | Context.Context {ctxt; kind = Context; _} -> ctxt + | Context.Context t -> + err_implementation_mismatch ~expected:impl_name ~got:t.impl_name diff --git a/src/lib_protocol_environment/duo_context_lib/duo_memory_context.mli b/src/lib_protocol_environment/duo_context_lib/duo_memory_context.mli new file mode 100644 index 000000000000..70ca3beadf2f --- /dev/null +++ b/src/lib_protocol_environment/duo_context_lib/duo_memory_context.mli @@ -0,0 +1,56 @@ +(*****************************************************************************) +(* *) +(* SPDX-License-Identifier: MIT *) +(* SPDX-FileCopyrightText: 2024 Nomadic Labs *) +(* *) +(*****************************************************************************) + +(** [Memory_context] is a recursive map backed by an in-memory Brassaia tree, + i.e. {!Tezos_context_memory.Context} (in [src/lib_context]), used + by the mockup mode and by proof verifiers (i.e. clients + of {!Tezos_context_helpers.Context.Make_tree.Proof}). + It abstracts away {!Tezos_context_memory.Context.t}. + + It is one of the instances of {!Environment_context} along + {!Shell_context} and {!Proxy_context}. All these 3 instances + can implement the same API (i.e. {!Environment_context}), because + this API is highly polymorphic, thanks to {!Environment_context.Context.ops}. + + As such, a {!Memory_context} value is an instance of {!Environment_context} + whose {!Environment_context.Context.kind} is the one declared below in this + file, i.e. {!extension-Context}. + + Instances of {!t} are easier to obtain than {!Shell_context} (which + are used by nodes), because they don't require access to a disk: they + live completely in memory. That is why they are ideal for testing. *) + +open Tezos_protocol_environment + +(** The additional kind identifying {!Memory_context} values. Used to + detect at runtime when a memory context is expected, to disambiguate + from other kinds. *) +type _ Context.kind += Context : Context_wrapper.Memory_context.t Context.kind + +(** [checkout index ctxt_hash] checks whether the underlying data on disk + contain an entry for [ctxt_hash]. If so, it is returned; otherwise + [Nothing] is returned. *) +val checkout : + Context_wrapper.Memory_context.index -> + Context_hash.t -> + Context.t option Lwt.t + +(** [checkout_exn index ctxt_hash] checks whether the underlying data on disk + contain an entry for [ctxt_hash]. If so, the data are loaded and returned; + otherwise the exception thrown by {!Tezos_context_brassaia.Context.checkout_exn} + is forwarded. Prefer using {!checkout}. *) +val checkout_exn : + Context_wrapper.Memory_context.index -> Context_hash.t -> Context.t Lwt.t + +(** [wrap_disk_context t] creates a brassaia context from an Brassaia on-disk folder + (i.e. {!Tezos_context.Context.t}). This function hereby abstracts away + a value, from the low-level [lib_context] to the higher-level [lib_protocol_environment]. *) +val wrap_memory_context : Context_wrapper.Memory_context.t -> Context.t + +(** [unwrap_disk_context t] gives access to the lower-level {!Tezos_context.Context.t} + value underlying a {!Brassaia_context}. *) +val unwrap_memory_context : Context.t -> Context_wrapper.Memory_context.t diff --git a/src/lib_shell/index.mld b/src/lib_shell/index.mld index 8b3411194b8f..eb714163ea5d 100644 --- a/src/lib_shell/index.mld +++ b/src/lib_shell/index.mld @@ -10,6 +10,7 @@ It contains the following libraries: - {{!module-Tezos_client_base_unix}Tezos_client_base_unix}: Tezos: common helpers for `octez-client` (unix-specific fragment) - {{!module-Tezos_client_commands}Tezos_client_commands}: Tezos: protocol agnostic commands for `octez-client` - {{!module-Tezos_context_ops}Tezos_context_ops}: Backend-agnostic operations on contexts +- {{!module-Tezos_duo_context_lib}Tezos_duo_context_lib} - {{!module-Tezos_mockup}Tezos_mockup}: Tezos: library of auto-documented RPCs (mockup mode) - {{!module-Tezos_mockup_commands}Tezos_mockup_commands}: Tezos: library of auto-documented RPCs (commands) - {{!module-Tezos_mockup_proxy}Tezos_mockup_proxy}: Tezos: local RPCs -- GitLab From cc145181ba4c555bbcbcb603436dce437ad69d70 Mon Sep 17 00:00:00 2001 From: mattiasdrp Date: Thu, 4 Jul 2024 14:59:59 +0200 Subject: [PATCH 3/3] Lib_protocol_environment: Proper events when duo contexts output different results --- src/lib_context/sigs/config.ml | 11 + src/lib_context/sigs/config.mli | 3 + .../duo_context_lib/context_wrapper.ml | 487 ++++++++++++++---- 3 files changed, 392 insertions(+), 109 deletions(-) diff --git a/src/lib_context/sigs/config.ml b/src/lib_context/sigs/config.ml index 66e7798ba66c..25d2f865363c 100644 --- a/src/lib_context/sigs/config.ml +++ b/src/lib_context/sigs/config.ml @@ -44,5 +44,16 @@ let equal x y = && x.stable_hash = y.stable_hash && equal_inode_child_order x.inode_child_order y.inode_child_order +let pp ppf t = + Format.fprintf + ppf + "{entries: %d; stable_hash: %d, inode_child_order: %s}" + t.entries + t.stable_hash + (match t.inode_child_order with + | `Seeded_hash -> "seeded_hash" + | `Hash_bits -> "hash_bits" + | `Custom _ -> "custom") + let v ~entries ~stable_hash ~inode_child_order = {entries; stable_hash; inode_child_order} diff --git a/src/lib_context/sigs/config.mli b/src/lib_context/sigs/config.mli index fb76f74c558d..f818b7bb0bbe 100644 --- a/src/lib_context/sigs/config.mli +++ b/src/lib_context/sigs/config.mli @@ -30,6 +30,9 @@ type t same configuration, they will generate the same context hashes. *) val equal : t -> t -> bool +(** Pretty printing for context configurations *) +val pp : Format.formatter -> t -> unit + (** Constructor. *) val v : entries:int -> diff --git a/src/lib_protocol_environment/duo_context_lib/context_wrapper.ml b/src/lib_protocol_environment/duo_context_lib/context_wrapper.ml index 29956c38ae68..bb676e365aee 100644 --- a/src/lib_protocol_environment/duo_context_lib/context_wrapper.ml +++ b/src/lib_protocol_environment/duo_context_lib/context_wrapper.ml @@ -14,6 +14,26 @@ module type BRASSAIA_CONTEXT = with type memory_context_tree := Tezos_context_brassaia_memory.Tezos_context_memory.Context.tree +let pp_print_option pp ppf = function + | Some v -> Format.fprintf ppf "Some %a" pp v + | None -> Format.fprintf ppf "None" + +module Events = struct + include Internal_event.Simple + + let section = ["node"; "duo_context"] + + let assertion_failure = + declare_3 + ~section + ~level:Warning + ~name:"assertion_failure" + ~msg:"{function} returned {res1} for Irmin and {res2} for Brassaia" + ("res1", Data_encoding.string) + ("res2", Data_encoding.string) + ("function", Data_encoding.string) +end + module Make (Irmin_Context : IRMIN_CONTEXT) (Brassaia_Context : BRASSAIA_CONTEXT) = @@ -39,66 +59,144 @@ struct brassaia_tree : Brassaia_Context.tree; } + let assert_and_return_result_lwt res1 res2 equal pp1 pp2 function_name + final_res = + if equal res1 res2 then Lwt.return final_res + else + let+ () = + Events.( + emit + assertion_failure + ( Format.asprintf "%a" pp1 res1, + Format.asprintf "%a" pp2 res2, + function_name )) + in + final_res + + let assert_and_return_result res1 res2 equal pp1 pp2 function_name final_res = + if equal res1 res2 then final_res + else ( + Events.( + emit__dont_wait__use_with_care + assertion_failure + ( Format.asprintf "%a" pp1 res1, + Format.asprintf "%a" pp2 res2, + function_name )) ; + final_res) + + let option_equal_no_traversal o1 o2 = + match (o1, o2) with Some _, Some _ | None, None -> true | _ -> false + + let pp_option_no_traversal ppf = function + | Some _ -> Format.fprintf ppf "Some _" + | None -> Format.fprintf ppf "None" + module Tree = struct module Irmin_Tree = Irmin_Context.Tree module Brassaia_Tree = Brassaia_Context.Tree let mem : tree -> key -> bool Lwt.t = fun t key -> - let* b1 = Irmin_Tree.mem t.irmin_tree key in - let+ b2 = Brassaia_Tree.mem t.brassaia_tree key in - assert (b1 = b2) ; - b1 + let* bool1 = Irmin_Tree.mem t.irmin_tree key in + let* bool2 = Brassaia_Tree.mem t.brassaia_tree key in + assert_and_return_result_lwt + bool1 + bool2 + Bool.equal + Format.pp_print_bool + Format.pp_print_bool + "Tree.mem" + bool1 let mem_tree : tree -> key -> bool Lwt.t = fun t key -> - let* b1 = Irmin_Tree.mem_tree t.irmin_tree key in - let+ b2 = Brassaia_Tree.mem_tree t.brassaia_tree key in - assert (b1 = b2) ; - b1 + let* bool1 = Irmin_Tree.mem_tree t.irmin_tree key in + let* bool2 = Brassaia_Tree.mem_tree t.brassaia_tree key in + assert_and_return_result_lwt + bool1 + bool2 + Bool.equal + Format.pp_print_bool + Format.pp_print_bool + "Tree.mem_tree" + bool1 let find : tree -> key -> value option Lwt.t = fun t key -> - let* v1 = Irmin_Tree.find t.irmin_tree key in - let+ v2 = Brassaia_Tree.find t.brassaia_tree key in - assert (v1 = v2) ; - v1 + let* value1 = Irmin_Tree.find t.irmin_tree key in + let* value2 = Brassaia_Tree.find t.brassaia_tree key in + assert_and_return_result_lwt + value1 + value2 + (Option.equal Bytes.equal) + (pp_print_option Format.pp_print_bytes) + (pp_print_option Format.pp_print_bytes) + "Tree.find" + value1 let find_tree : tree -> key -> tree option Lwt.t = fun t key -> let* irmin_tree = Irmin_Tree.find_tree t.irmin_tree key in - let+ brassaia_tree = Brassaia_Tree.find_tree t.brassaia_tree key in - match (irmin_tree, brassaia_tree) with - | Some irmin_tree, Some brassaia_tree -> Some {irmin_tree; brassaia_tree} - | None, None -> None - | _ -> Fmt.failwith "Received Some tree and None" + let* brassaia_tree = Brassaia_Tree.find_tree t.brassaia_tree key in + let final_res = + match (irmin_tree, brassaia_tree) with + | Some irmin_tree, Some brassaia_tree -> + Some {irmin_tree; brassaia_tree} + | _ -> None + in + assert_and_return_result_lwt + irmin_tree + brassaia_tree + option_equal_no_traversal + pp_option_no_traversal + pp_option_no_traversal + "Tree.find_tree" + final_res let list : tree -> ?offset:int -> ?length:int -> key -> (string * tree) list Lwt.t = fun t ?offset ?length key -> let* irmin_list = Irmin_Tree.list t.irmin_tree ?offset ?length key in - let+ brassaia_list = + let* brassaia_list = Brassaia_Tree.list t.brassaia_tree ?offset ?length key in - assert (List.compare_lengths irmin_list brassaia_list = 0) ; - List.map - (fun (key, irmin_tree) -> - let brassaia_tree = - List.find (fun (key2, _) -> String.equal key key2) brassaia_list - |> Option.value - ~default:(Fmt.failwith "No value associated to %s" key) - |> snd - in - (key, {irmin_tree; brassaia_tree})) + let final_res = + List.map + (fun (key, irmin_tree) -> + let brassaia_tree = + List.find (fun (key2, _) -> String.equal key key2) brassaia_list + |> Option.value + ~default:(Fmt.failwith "No value associated to %s" key) + |> snd + in + (key, {irmin_tree; brassaia_tree})) + irmin_list + in + let pp_list ppf l = + Format.pp_print_list (fun ppf (s, _) -> Format.fprintf ppf "%s" s) ppf l + in + assert_and_return_result_lwt irmin_list + brassaia_list + (fun l1 l2 -> List.compare_lengths l1 l2 = 0) + pp_list + pp_list + "Tree.list" + final_res let length : tree -> key -> int Lwt.t = fun t key -> let* length1 = Irmin_Tree.length t.irmin_tree key in - let+ length2 = Brassaia_Tree.length t.brassaia_tree key in - assert (length1 = length2) ; - length1 + let* length2 = Brassaia_Tree.length t.brassaia_tree key in + assert_and_return_result_lwt + length1 + length2 + Int.equal + Format.pp_print_int + Format.pp_print_int + "Tree.length" + length1 let add : tree -> key -> value -> tree Lwt.t = fun t key value -> @@ -144,8 +242,14 @@ struct fun t -> let config1 = Irmin_Tree.config t.irmin_tree in let config2 = Brassaia_Tree.config t.brassaia_tree in - assert (Tezos_context_sigs.Config.equal config1 config2) ; - config1 + assert_and_return_result + config1 + config2 + Tezos_context_sigs.Config.equal + Tezos_context_sigs.Config.pp + Tezos_context_sigs.Config.pp + "Tree.config" + config1 let empty : t -> tree = fun t -> @@ -163,26 +267,44 @@ struct fun t -> let bool1 = Irmin_Tree.is_empty t.irmin_tree in let bool2 = Brassaia_Tree.is_empty t.brassaia_tree in - assert (bool1 = bool2) ; - bool1 + assert_and_return_result + bool1 + bool2 + Bool.equal + Format.pp_print_bool + Format.pp_print_bool + "Tree.is_empty" + bool1 let kind : tree -> Tezos_context_sigs.Context.Kind.t = fun t -> let kind1 = Irmin_Tree.kind t.irmin_tree in let kind2 = Brassaia_Tree.kind t.brassaia_tree in - assert (kind1 = kind2) ; - kind1 + let pp_kind ppf = function + | `Value -> Format.fprintf ppf "value" + | `Tree -> Format.fprintf ppf "tree" + in + assert_and_return_result + kind1 + kind2 + ( = ) + pp_kind + pp_kind + "Tree.kind" + kind1 let to_value : tree -> value option Lwt.t = fun t -> let* value1 = Irmin_Tree.to_value t.irmin_tree in - let+ value2 = Brassaia_Tree.to_value t.brassaia_tree in - match (value1, value2) with - | Some value1, Some value2 -> - assert (value1 = value2) ; - Some value1 - | None, None -> None - | _ -> Fmt.failwith "Received Some value and None" + let* value2 = Brassaia_Tree.to_value t.brassaia_tree in + assert_and_return_result_lwt + value1 + value2 + Option.(equal Bytes.equal) + (pp_print_option Format.pp_print_bytes) + (pp_print_option Format.pp_print_bytes) + "Tree.to_value" + value1 let of_value : t -> value -> tree Lwt.t = fun t value -> @@ -194,15 +316,27 @@ struct fun t -> let context_hash1 = Irmin_Tree.hash t.irmin_tree in let context_hash2 = Brassaia_Tree.hash t.brassaia_tree in - assert (context_hash1 = context_hash2) ; - context_hash1 + assert_and_return_result + context_hash1 + context_hash2 + Context_hash.equal + Context_hash.pp + Context_hash.pp + "Tree.hash" + context_hash1 let equal : tree -> tree -> bool = fun t1 t2 -> let bool1 = Irmin_Tree.equal t1.irmin_tree t2.irmin_tree in let bool2 = Brassaia_Tree.equal t1.brassaia_tree t2.brassaia_tree in - assert (bool1 = bool2) ; - bool1 + assert_and_return_result + bool1 + bool2 + Bool.equal + Format.pp_print_bool + Format.pp_print_bool + "Tree.equal" + bool1 let clear : ?depth:int -> tree -> unit = fun ?depth t -> @@ -215,7 +349,6 @@ struct Brassaia_Tree.pp ppf t.brassaia_tree type raw = Irmin_Tree.raw - (* [`Tree of raw Tezos_base.TzPervasives.String.Map.t | `Value of value] *) let raw_encoding : raw Tezos_base.TzPervasives.Data_encoding.t = Irmin_Tree.raw_encoding @@ -224,8 +357,17 @@ struct fun t -> let* raw1 = Irmin_Tree.to_raw t.irmin_tree in let+ raw2 = Brassaia_Tree.to_raw t.brassaia_tree in - assert (raw1 = raw2) ; - raw1 + let equal raw1 raw2 = + match (raw1, raw2) with + | `Value b1, `Value b2 -> Bytes.equal b1 b2 + | `Tree _, `Tree _ -> true + | _ -> false + in + let pp ppf = function + | `Value b -> Format.fprintf ppf "Value %s" (Bytes.to_string b) + | `Tree _ -> Format.fprintf ppf "Tree" + in + assert_and_return_result raw1 raw2 equal pp pp "Tree.to_raw" raw1 let of_raw : raw -> tree = fun raw -> @@ -247,15 +389,31 @@ struct fun t -> let bool1 = Irmin_Tree.is_shallow t.irmin_tree in let bool2 = Brassaia_Tree.is_shallow t.brassaia_tree in - assert (bool1 = bool2) ; - bool1 + assert_and_return_result + bool1 + bool2 + Bool.equal + Format.pp_print_bool + Format.pp_print_bool + "Tree.is_shallow" + bool1 let kinded_key : tree -> Irmin_Context.kinded_key option = fun t -> let kinded_key1 = Irmin_Tree.kinded_key t.irmin_tree in let kinded_key2 = Brassaia_Tree.kinded_key t.brassaia_tree in - assert (kinded_key1 = Obj.magic kinded_key2) ; - kinded_key1 + let pp ppf = function + | `Node _node_key -> Format.fprintf ppf "Node" + | `Value _value_key -> Format.fprintf ppf "Value" + in + assert_and_return_result + kinded_key1 + kinded_key2 + (fun k1 k2 -> k1 = Obj.magic k2) + (pp_print_option pp) + (pp_print_option pp) + "Tree.kinded_key" + kinded_key1 end module Proof = Irmin_Context.Proof @@ -271,64 +429,115 @@ struct let equal_config config1 config2 = let bool1 = Irmin_Context.equal_config config1 config2 in let bool2 = Brassaia_Context.equal_config config1 config2 in - assert (bool1 = bool2) ; - bool1 + assert_and_return_result + bool1 + bool2 + Bool.equal + Format.pp_print_bool + Format.pp_print_bool + "equal_config" + bool1 let mem : t -> key -> bool Lwt.t = fun t key -> let* bool1 = Irmin_Context.mem t.irmin_context key in - let+ bool2 = Brassaia_Context.mem t.brassaia_context (Obj.magic key) in - assert (bool1 = bool2) ; - bool1 + let* bool2 = Brassaia_Context.mem t.brassaia_context (Obj.magic key) in + assert_and_return_result_lwt + bool1 + bool2 + Bool.equal + Format.pp_print_bool + Format.pp_print_bool + "mem" + bool1 let mem_tree : t -> key -> bool Lwt.t = fun t key -> let* bool1 = Irmin_Context.mem_tree t.irmin_context key in - let+ bool2 = Brassaia_Context.mem_tree t.brassaia_context key in - assert (bool1 = bool2) ; - bool1 + let* bool2 = Brassaia_Context.mem_tree t.brassaia_context key in + assert_and_return_result_lwt + bool1 + bool2 + Bool.equal + Format.pp_print_bool + Format.pp_print_bool + "mem_tree" + bool1 let find : t -> key -> value option Lwt.t = fun t key -> let* value1 = Irmin_Context.find t.irmin_context key in - let+ value2 = Brassaia_Context.find t.brassaia_context key in - assert (value1 = value2) ; - value1 + let* value2 = Brassaia_Context.find t.brassaia_context key in + assert_and_return_result_lwt + value1 + value2 + (Option.equal Bytes.equal) + (pp_print_option Format.pp_print_bytes) + (pp_print_option Format.pp_print_bytes) + "find" + value1 let find_tree : t -> key -> tree option Lwt.t = fun t key -> let* irmin_tree = Irmin_Context.find_tree t.irmin_context key in - let+ brassaia_tree = Brassaia_Context.find_tree t.brassaia_context key in - match (irmin_tree, brassaia_tree) with - | Some irmin_tree, Some brassaia_tree -> Some {irmin_tree; brassaia_tree} - | None, None -> None - | _ -> Fmt.failwith "Received Some tree and None" + let* brassaia_tree = Brassaia_Context.find_tree t.brassaia_context key in + let final_res = + match (irmin_tree, brassaia_tree) with + | Some irmin_tree, Some brassaia_tree -> Some {irmin_tree; brassaia_tree} + | _ -> None + in + assert_and_return_result_lwt + irmin_tree + brassaia_tree + option_equal_no_traversal + pp_option_no_traversal + pp_option_no_traversal + "find_tree" + final_res let list : t -> ?offset:int -> ?length:int -> key -> (string * tree) list Lwt.t = fun t ?offset ?length key -> let* irmin_list = Irmin_Context.list t.irmin_context ?offset ?length key in - let+ brassaia_list = + let* brassaia_list = Brassaia_Context.list t.brassaia_context ?offset ?length key in - assert (List.compare_lengths irmin_list brassaia_list = 0) ; - List.map - (fun (key, irmin_tree) -> - let brassaia_tree = - List.find (fun (key2, _) -> String.equal key key2) brassaia_list - |> Option.value - ~default:(Fmt.failwith "No value associated to %s" key) - |> snd - in - (key, {irmin_tree; brassaia_tree})) + let final_res = + List.map + (fun (key, irmin_tree) -> + let brassaia_tree = + List.find (fun (key2, _) -> String.equal key key2) brassaia_list + |> Option.value + ~default:(Fmt.failwith "No value associated to %s" key) + |> snd + in + (key, {irmin_tree; brassaia_tree})) + irmin_list + in + let pp_list ppf l = + Format.pp_print_list (fun ppf (s, _) -> Format.fprintf ppf "%s" s) ppf l + in + assert_and_return_result_lwt irmin_list + brassaia_list + (fun l1 l2 -> List.compare_lengths l1 l2 = 0) + pp_list + pp_list + "list" + final_res let length : t -> key -> int Lwt.t = fun t key -> let* length1 = Irmin_Context.length t.irmin_context key in - let+ length2 = Brassaia_Context.length t.brassaia_context key in - assert (length1 = length2) ; - length1 + let* length2 = Brassaia_Context.length t.brassaia_context key in + assert_and_return_result_lwt + length1 + length2 + Int.equal + Format.pp_print_int + Format.pp_print_int + "length" + length1 let add : t -> key -> value -> t Lwt.t = fun t key value -> @@ -386,15 +595,27 @@ struct fun t -> let config1 = Irmin_Context.config t.irmin_context in let config2 = Brassaia_Context.config t.brassaia_context in - assert (Tezos_context_sigs.Config.equal config1 config2) ; - config1 + assert_and_return_result + config1 + config2 + Tezos_context_sigs.Config.equal + Tezos_context_sigs.Config.pp + Tezos_context_sigs.Config.pp + "config" + config1 let get_protocol : t -> Protocol_hash.t Lwt.t = fun t -> let* hash1 = Irmin_Context.get_protocol t.irmin_context in - let+ hash2 = Brassaia_Context.get_protocol t.brassaia_context in - assert (Protocol_hash.equal hash1 hash2) ; - hash1 + let* hash2 = Brassaia_Context.get_protocol t.brassaia_context in + assert_and_return_result_lwt + hash1 + hash2 + Protocol_hash.equal + Protocol_hash.pp + Protocol_hash.pp + "get_protocol" + hash1 let fork_test_chain : t -> protocol:Protocol_hash.t -> expiration:Time.Protocol.t -> t Lwt.t = @@ -422,8 +643,14 @@ struct fun t -> let version1 = Irmin_Context.get_hash_version t.irmin_context in let version2 = Brassaia_Context.get_hash_version t.brassaia_context in - assert (Context_hash.Version.equal version1 version2) ; - version1 + assert_and_return_result + version1 + version2 + Context_hash.Version.equal + Context_hash.Version.pp + Context_hash.Version.pp + "get_hash_version" + version1 let verify_tree_proof : Proof.tree Proof.t -> @@ -504,8 +731,14 @@ struct fun index -> let bool1 = Irmin_Context.is_gc_allowed index.irmin_index in let bool2 = Brassaia_Context.is_gc_allowed index.brassaia_index in - assert (bool1 = bool2) ; - bool1 + assert_and_return_result + bool1 + bool2 + Bool.equal + Format.pp_print_bool + Format.pp_print_bool + "is_gc_allowed" + bool1 let split : index -> unit Lwt.t = fun index -> @@ -520,9 +753,15 @@ struct let exists : index -> Context_hash.t -> bool Lwt.t = fun index context_hash -> let* bool1 = Irmin_Context.exists index.irmin_index context_hash in - let+ bool2 = Brassaia_Context.exists index.brassaia_index context_hash in - assert (bool1 = bool2) ; - bool1 + let* bool2 = Brassaia_Context.exists index.brassaia_index context_hash in + assert_and_return_result_lwt + bool1 + bool2 + Bool.equal + Format.pp_print_bool + Format.pp_print_bool + "exists" + bool1 let close : index -> unit Lwt.t = fun index -> @@ -533,8 +772,14 @@ struct fun block_hash -> let chain_id1 = Irmin_Context.compute_testchain_chain_id block_hash in let chain_id2 = Brassaia_Context.compute_testchain_chain_id block_hash in - assert (Chain_id.equal chain_id1 chain_id2) ; - chain_id1 + assert_and_return_result + chain_id1 + chain_id2 + Chain_id.equal + Chain_id.pp + Chain_id.pp + "compute_testchain_chain_id" + chain_id1 (** Miscellaneous *) @@ -568,21 +813,33 @@ struct let context_hash2 = Brassaia_Context.hash ~time ?message t.brassaia_context in - assert (Context_hash.equal context_hash1 context_hash2) ; - context_hash1 + assert_and_return_result + context_hash1 + context_hash2 + Context_hash.equal + Context_hash.pp + Context_hash.pp + "hash" + context_hash1 let commit_test_chain_genesis : t -> Block_header.t -> Block_header.t Lwt.t = fun context block_header -> let* block_header1 = Irmin_Context.commit_test_chain_genesis context.irmin_context block_header in - let+ block_header2 = + let* block_header2 = Brassaia_Context.commit_test_chain_genesis context.brassaia_context block_header in - assert (Block_header.equal block_header1 block_header2) ; - block_header1 + assert_and_return_result_lwt + block_header1 + block_header2 + Block_header.equal + Block_header.pp + Block_header.pp + "commit_test_chain_genesis" + block_header1 let get_test_chain : t -> Test_chain_status.t Lwt.t = fun t -> @@ -603,11 +860,17 @@ struct time:Time.Protocol.t -> ?message:string -> t -> Context_hash.t Lwt.t = fun ~time ?message t -> let* context_hash1 = Irmin_Context.commit ~time ?message t.irmin_context in - let+ context_hash2 = + let* context_hash2 = Brassaia_Context.commit ~time ?message t.brassaia_context in - assert (Context_hash.equal context_hash1 context_hash2) ; - context_hash1 + assert_and_return_result_lwt + context_hash1 + context_hash2 + Context_hash.equal + Context_hash.pp + Context_hash.pp + "hash" + context_hash1 let commit_genesis : index -> @@ -634,8 +897,14 @@ struct fun block_hash -> let block_hash1 = Irmin_Context.compute_testchain_genesis block_hash in let block_hash2 = Brassaia_Context.compute_testchain_genesis block_hash in - assert (Block_hash.equal block_hash1 block_hash2) ; - block_hash1 + assert_and_return_result + block_hash1 + block_hash2 + Block_hash.equal + Block_hash.pp + Block_hash.pp + "hash" + block_hash1 let merkle_tree : t -> -- GitLab