From 59f293b7f5016ff501ab304cb5ff0b56e930db97 Mon Sep 17 00:00:00 2001 From: mattiasdrp Date: Fri, 21 Jun 2024 19:37:03 +0200 Subject: [PATCH 1/2] Brassaia: Replace metadata with unit everywhere --- brassaia/lib_brassaia/backend.ml | 2 - brassaia/lib_brassaia/brassaia.ml | 12 +- brassaia/lib_brassaia/brassaia.mli | 10 +- brassaia/lib_brassaia/key_intf.ml | 2 +- brassaia/lib_brassaia/mem/brassaia_mem.mli | 1 - brassaia/lib_brassaia/metadata.ml | 25 --- brassaia/lib_brassaia/metadata.mli | 18 -- brassaia/lib_brassaia/metadata_intf.ml | 31 --- brassaia/lib_brassaia/node.ml | 117 ++++------- brassaia/lib_brassaia/node_intf.ml | 51 +---- brassaia/lib_brassaia/proof.ml | 17 +- brassaia/lib_brassaia/proof_intf.ml | 19 +- brassaia/lib_brassaia/schema.ml | 13 +- brassaia/lib_brassaia/store.ml | 26 ++- brassaia/lib_brassaia/store_intf.ml | 30 +-- brassaia/lib_brassaia/tree.ml | 187 ++++++++---------- brassaia/lib_brassaia/tree_intf.ml | 38 ++-- brassaia/lib_brassaia_pack/brassaia_pack.ml | 1 - .../lib_brassaia_pack/brassaia_pack_intf.ml | 1 - brassaia/lib_brassaia_pack/inode.ml | 91 ++++----- brassaia/lib_brassaia_pack/inode_intf.ml | 25 +-- .../mem/brassaia_pack_mem.ml | 2 - .../unix/brassaia_pack_unix.ml | 3 - brassaia/lib_brassaia_pack/unix/inode.ml | 1 - brassaia/lib_brassaia_pack/unix/inode_intf.ml | 5 +- brassaia/lib_brassaia_pack/unix/store.ml | 4 +- brassaia/lib_brassaia_pack/unix/store_intf.ml | 6 +- .../lib_brassaia_tezos/brassaia_tezos.mli | 1 - brassaia/lib_brassaia_tezos/schema.ml | 16 +- brassaia/lib_brassaia_tezos/schema.mli | 1 - brassaia/test/brassaia-mem/test_mem.ml | 6 +- brassaia/test/brassaia-pack/common.ml | 3 +- brassaia/test/brassaia-pack/common.mli | 1 - .../data/version_1_large/README.md | 2 +- .../brassaia-pack/test_existing_stores.ml | 3 +- brassaia/test/brassaia-pack/test_hashes.ml | 1 - brassaia/test/brassaia-pack/test_inode.ml | 7 +- brassaia/test/brassaia-pack/test_lower.ml | 2 +- brassaia/test/brassaia-pack/test_pack.ml | 4 +- brassaia/test/brassaia-pack/test_readonly.ml | 2 +- brassaia/test/brassaia/test_tree.ml | 64 ++---- brassaia/test/helpers/brassaia_test.mli | 4 +- brassaia/test/helpers/common.ml | 13 +- brassaia/test/helpers/node.ml | 2 +- brassaia/test/helpers/store.ml | 30 ++- brassaia/test/helpers/store_graph.ml | 8 +- src/lib_context_brassaia/encoding/context.ml | 9 +- src/lib_context_brassaia/encoding/context.mli | 1 - src/lib_context_brassaia/memory/context.ml | 2 +- src/lib_shell/distributed_db_event.ml | 2 +- 50 files changed, 287 insertions(+), 635 deletions(-) delete mode 100644 brassaia/lib_brassaia/metadata.ml delete mode 100644 brassaia/lib_brassaia/metadata.mli delete mode 100644 brassaia/lib_brassaia/metadata_intf.ml diff --git a/brassaia/lib_brassaia/backend.ml b/brassaia/lib_brassaia/backend.ml index f9c1deba7531..de75c80f7b97 100644 --- a/brassaia/lib_brassaia/backend.ml +++ b/brassaia/lib_brassaia/backend.ml @@ -41,7 +41,6 @@ module type S = sig with type hash = Hash.t and type Val.contents_key = Contents.key and module Path = Schema.Path - and module Metadata = Schema.Metadata (** A node abstraction that is portable from different repos. Similar to [Node.Val]. *) @@ -49,7 +48,6 @@ module type S = sig Node_portable with type node := Node.value and type hash := Hash.t - and type metadata := Schema.Metadata.t and type step := Schema.Path.step (** A commit store. *) diff --git a/brassaia/lib_brassaia/brassaia.ml b/brassaia/lib_brassaia/brassaia.ml index d04b8f8f0cb1..a6a00e983fde 100644 --- a/brassaia/lib_brassaia/brassaia.ml +++ b/brassaia/lib_brassaia/brassaia.ml @@ -67,15 +67,12 @@ module Maker_generic_key (Backend : Maker_generic_key_args) = struct module Node = struct module Value = - Node.Generic_key.Make (S.Hash) (S.Path) (S.Metadata) (Contents_key) - (Node_key) + Node.Generic_key.Make (S.Hash) (S.Path) (Contents_key) (Node_key) module Backend = Backend.Node_store.Make (S.Hash) (Value) include - Node.Generic_key.Store (Contents) (Backend) (S.Hash) (Value) - (S.Metadata) - (S.Path) + Node.Generic_key.Store (Contents) (Backend) (S.Hash) (Value) (S.Path) end module Node_portable = Node.Value.Portable @@ -171,7 +168,6 @@ end module KV_maker (CA : Content_addressable.Maker) (AW : Atomic_write.Maker) = struct - type metadata = unit type hash = Schema.default_hash type info = Info.default @@ -222,7 +218,6 @@ let remote_store (type t) (module M : Generic_key.S with type t = t) (t : t) = let module X : Store.Generic_key.S with type t = t = M in Sync.remote_store (module X) t -module Metadata = Metadata module Json_tree = Store.Json_tree module Export_for_backends = Export_for_backends module Storage = Storage @@ -236,10 +231,9 @@ module Of_storage (M : Storage.Make) (H : Hash.S) (V : Contents.S) = struct module Hash = H module Contents = V module Info = Info.Default - module Metadata = Metadata.None module Path = Path.String_list module Branch = Branch.String - module Node = Node.Make (Hash) (Path) (Metadata) + module Node = Node.Make (Hash) (Path) module Commit = Commit.Make (Hash) end) end diff --git a/brassaia/lib_brassaia/brassaia.mli b/brassaia/lib_brassaia/brassaia.mli index 6ef7de587c24..22e1a95e12df 100644 --- a/brassaia/lib_brassaia/brassaia.mli +++ b/brassaia/lib_brassaia/brassaia.mli @@ -77,11 +77,6 @@ module Info = Info module Node = Node module Commit = Commit -module Metadata = Metadata -(** [Metadata] defines metadata that is attached to contents but stored in - nodes. For instance, the Git backend uses this to indicate the type of file - (normal, executable or symlink). *) - module Path = Path (** Store paths. @@ -201,10 +196,7 @@ module Maker (CA : Content_addressable.Maker) (AW : Atomic_write.Maker) : (** [KV_maker] is like {!module-Maker} but uses sensible default implementations for everything except the contents type. *) module KV_maker (CA : Content_addressable.Maker) (AW : Atomic_write.Maker) : - KV_maker - with type endpoint = unit - and type metadata = unit - and type info = Info.default + KV_maker with type endpoint = unit and type info = Info.default (** {2 Backend} *) diff --git a/brassaia/lib_brassaia/key_intf.ml b/brassaia/lib_brassaia/key_intf.ml index dd4524e0746d..6d506404bdf1 100644 --- a/brassaia/lib_brassaia/key_intf.ml +++ b/brassaia/lib_brassaia/key_intf.ml @@ -52,7 +52,7 @@ module type Sigs = sig module type Hash_like = Hash_like (** The simplest possible [Key] implementation is just a hash of the - corresponding value, attaching no additional metadata about the value. *) + corresponding value *) module Of_hash (H : Type.S) : Hash_like with type t = H.t and type hash = H.t module Store_spec : sig diff --git a/brassaia/lib_brassaia/mem/brassaia_mem.mli b/brassaia/lib_brassaia/mem/brassaia_mem.mli index ee3202ca8707..d8101e3ce53a 100644 --- a/brassaia/lib_brassaia/mem/brassaia_mem.mli +++ b/brassaia/lib_brassaia/mem/brassaia_mem.mli @@ -40,7 +40,6 @@ module Atomic_write : Brassaia.Atomic_write.Maker module KV : Brassaia.KV_maker with type endpoint = unit - and type metadata = unit and type info = Brassaia.Info.default include Brassaia.Maker with type endpoint = unit diff --git a/brassaia/lib_brassaia/metadata.ml b/brassaia/lib_brassaia/metadata.ml deleted file mode 100644 index 314d88ec95c0..000000000000 --- a/brassaia/lib_brassaia/metadata.ml +++ /dev/null @@ -1,25 +0,0 @@ -(* - * Copyright (c) 2013-2022 Thomas Gazagnaire - * - * Permission to use, copy, modify, and distribute this software for any - * purpose with or without fee is hereby granted, provided that the above - * copyright notice and this permission notice appear in all copies. - * - * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES - * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR - * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES - * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN - * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF - * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. - *) - -include Metadata_intf - -module None = struct - type t = unit [@@deriving brassaia] - - let encoding = Data_encoding.unit - let default = () - let merge = Merge.init t (fun ~old:_ () () -> Merge.ok ()) -end diff --git a/brassaia/lib_brassaia/metadata.mli b/brassaia/lib_brassaia/metadata.mli deleted file mode 100644 index c8808836a354..000000000000 --- a/brassaia/lib_brassaia/metadata.mli +++ /dev/null @@ -1,18 +0,0 @@ -(* - * Copyright (c) 2013-2022 Thomas Gazagnaire - * - * Permission to use, copy, modify, and distribute this software for any - * purpose with or without fee is hereby granted, provided that the above - * copyright notice and this permission notice appear in all copies. - * - * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES - * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR - * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES - * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN - * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF - * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. - *) - -include Metadata_intf.Sigs -(** @inline *) diff --git a/brassaia/lib_brassaia/metadata_intf.ml b/brassaia/lib_brassaia/metadata_intf.ml deleted file mode 100644 index 3ecacde227fe..000000000000 --- a/brassaia/lib_brassaia/metadata_intf.ml +++ /dev/null @@ -1,31 +0,0 @@ -(* - * Copyright (c) 2013-2022 Thomas Gazagnaire - * - * Permission to use, copy, modify, and distribute this software for any - * purpose with or without fee is hereby granted, provided that the above - * copyright notice and this permission notice appear in all copies. - * - * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES - * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR - * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES - * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN - * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF - * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. - *) - -(** Node metadata. *) - -module type S = sig - include Type.Defaultable - - val merge : t Merge.t - (** [merge] is the merge function for metadata. *) -end - -module type Sigs = sig - module type S = S - - module None : S with type t = unit - (** A metadata definition for systems that don't use metadata. *) -end diff --git a/brassaia/lib_brassaia/node.ml b/brassaia/lib_brassaia/node.ml index 4ecc54bad798..6948b9cb58bf 100644 --- a/brassaia/lib_brassaia/node.ml +++ b/brassaia/lib_brassaia/node.ml @@ -39,22 +39,24 @@ module Of_core (S : Core) = struct (fun acc -> function k, `Node n -> (k, n) :: acc | _ -> acc) [] kvs + let merge = Merge.init Type.unit (fun ~old:_ () () -> Merge.ok ()) + (* [Merge.alist] expects us to return an option. [C.merge] does that, but we need to consider the metadata too... *) let merge_metadata merge_contents = (* This gets us [C.t option, S.Val.Metadata.t]. We want [(C.t * S.Val.Metadata.t) option]. *) let explode = function - | None -> (None, S.Metadata.default) - | Some (c, m) -> (Some c, m) + | None -> (None, ()) + | Some (c, ()) -> (Some c, ()) in - let implode = function None, _ -> None | Some c, m -> Some (c, m) in - Merge.like [%typ: (S.contents_key * S.metadata) option] - (Merge.pair merge_contents S.Metadata.merge) + let implode = function None, _ -> None | Some c, () -> Some (c, ()) in + Merge.like [%typ: (S.contents_key * unit) option] + (Merge.pair merge_contents merge) explode implode let merge_contents merge_key = - Merge.alist S.step_t (Type.pair S.contents_key_t S.metadata_t) (fun _step -> + Merge.alist S.step_t (Type.pair S.contents_key_t Type.unit) (fun _step -> merge_metadata merge_key) let merge_node merge_key = @@ -84,12 +86,9 @@ module Make_core val step_encoding : step Data_encoding.t end) - (Metadata : Metadata.S) (Contents_key : Key.S with type hash = Hash.t) (Node_key : Key.S with type hash = Hash.t) = struct - module Metadata = Metadata - type contents_key = Contents_key.t [@@deriving brassaia] let contents_key_encoding = Contents_key.encoding @@ -102,10 +101,6 @@ struct let step_encoding = Path.step_encoding - type metadata = Metadata.t [@@deriving brassaia ~equal] - - let metadata_encoding = Metadata.encoding - type hash = Hash.t [@@deriving brassaia] let hash_encoding = Hash.encoding @@ -114,7 +109,7 @@ struct [@@deriving brassaia] type 'key contents_m_entry = { - metadata : Metadata.t; + metadata : unit; name : Path.step; contents : 'key; } @@ -156,7 +151,7 @@ struct (fun l -> List.to_seq l |> StepMap.of_seq) Data_encoding.(list (tup2 StepMap.key_encoding entry_encoding)) - type value = [ `Node of node_key | `Contents of contents_key * metadata ] + type value = [ `Node of node_key | `Contents of contents_key * unit ] let value_encoding = let open Data_encoding in @@ -166,12 +161,12 @@ struct (function `Node k -> Some k | _ -> None) (fun k -> `Node k); case (Tag 2) ~title:"`Contents" - (tup2 contents_key_encoding metadata_encoding) + (tup2 contents_key_encoding unit) (function `Contents k -> Some k | _ -> None) (fun k -> `Contents k); ] - type weak_value = [ `Contents of hash * metadata | `Node of hash ] + type weak_value = [ `Contents of hash * unit | `Node of hash ] [@@deriving brassaia] let weak_value_encoding = @@ -181,8 +176,7 @@ struct case (Tag 1) ~title:"`Node" hash_encoding (function `Node k -> Some k | _ -> None) (fun k -> `Node k); - case (Tag 2) ~title:"`Contents" - (tup2 hash_encoding metadata_encoding) + case (Tag 2) ~title:"`Contents" (tup2 hash_encoding unit) (function `Contents k -> Some k | _ -> None) (fun k -> `Contents k); ] @@ -190,29 +184,23 @@ struct (* FIXME: special-case the default metadata in the default signature? *) let value_t = let open Type in - variant "value" (fun n c x -> function - | `Node h -> n h - | `Contents (h, m) -> - if equal_metadata m Metadata.default then c h else x (h, m)) + variant "value" (fun n c _ -> function + | `Node h -> n h | `Contents (h, ()) -> c h) |~ case1 "node" node_key_t (fun k -> `Node k) - |~ case1 "contents" contents_key_t (fun h -> - `Contents (h, Metadata.default)) - |~ case1 "contents-x" (pair contents_key_t Metadata.t) (fun (h, m) -> - `Contents (h, m)) + |~ case1 "contents" contents_key_t (fun h -> `Contents (h, ())) + |~ case1 "contents-x" (pair contents_key_t unit) (fun (h, ()) -> + `Contents (h, ())) |> sealv let to_entry (k, (v : value)) = match v with | `Node h -> Node { name = k; node = h } - | `Contents (h, m) -> - if equal_metadata m Metadata.default then - Contents { name = k; contents = h } - else Contents_m { metadata = m; name = k; contents = h } + | `Contents (h, ()) -> Contents { name = k; contents = h } let inspect_nonportable_entry_exn : entry -> step * value = function | Node n -> (n.name, `Node n.node) - | Contents c -> (c.name, `Contents (c.contents, Metadata.default)) - | Contents_m c -> (c.name, `Contents (c.contents, c.metadata)) + | Contents c -> (c.name, `Contents (c.contents, ())) + | Contents_m c -> (c.name, `Contents (c.contents, ())) | Node_hash _ | Contents_hash _ | Contents_m_hash _ -> (* Not reachable after [Portable.of_node]. See invariant on {!entry}. *) assert false @@ -229,12 +217,10 @@ struct let weak_of_entry : entry -> step * weak_value = function | Node n -> (n.name, `Node (Node_key.to_hash n.node)) | Node_hash n -> (n.name, `Node n.node) - | Contents c -> - (c.name, `Contents (Contents_key.to_hash c.contents, Metadata.default)) - | Contents_m c -> - (c.name, `Contents (Contents_key.to_hash c.contents, c.metadata)) - | Contents_hash c -> (c.name, `Contents (c.contents, Metadata.default)) - | Contents_m_hash c -> (c.name, `Contents (c.contents, c.metadata)) + | Contents c -> (c.name, `Contents (Contents_key.to_hash c.contents, ())) + | Contents_m c -> (c.name, `Contents (Contents_key.to_hash c.contents, ())) + | Contents_hash c -> (c.name, `Contents (c.contents, ())) + | Contents_m_hash c -> (c.name, `Contents (c.contents, ())) let of_seq l = Seq.fold_left @@ -404,11 +390,10 @@ module Make_generic_key val step_encoding : step Data_encoding.t end) - (Metadata : Metadata.S) (Contents_key : Key.S with type hash = Hash.t) (Node_key : Key.S with type hash = Hash.t) = struct - module Core = Make_core (Hash) (Path) (Metadata) (Contents_key) (Node_key) + module Core = Make_core (Hash) (Path) (Contents_key) (Node_key) include Core include Of_core (Core) @@ -430,10 +415,7 @@ struct let to_entry name = function | `Node node -> Node_hash { name; node } - | `Contents (contents, metadata) -> - if equal_metadata metadata Metadata.default then - Contents_hash { name; contents } - else Contents_m_hash { name; contents; metadata } + | `Contents (contents, ()) -> Contents_hash { name; contents } let of_seq s = Seq.fold_left @@ -483,11 +465,10 @@ module Make_generic_key_v2 val step_encoding : step Data_encoding.t end) - (Metadata : Metadata.S) (Contents_key : Key.S with type hash = Hash.t) (Node_key : Key.S with type hash = Hash.t) = struct - include Make_generic_key (Hash) (Path) (Metadata) (Contents_key) (Node_key) + include Make_generic_key (Hash) (Path) (Contents_key) (Node_key) let t = t_not_prefixed @@ -504,11 +485,10 @@ module Make type step [@@deriving brassaia] val step_encoding : step Data_encoding.t - end) - (Metadata : Metadata.S) = + end) = struct module Key = Key.Of_hash (Hash) - include Make_generic_key (Hash) (Path) (Metadata) (Key) (Key) + include Make_generic_key (Hash) (Path) (Key) (Key) end module Store_generic_key @@ -519,7 +499,6 @@ module Store_generic_key with type t = S.value and type contents_key = C.Key.t and type node_key = S.Key.t) - (M : Metadata.S with type t = V.metadata) (P : Path.S with type step = V.step) = struct module Val = struct @@ -532,7 +511,6 @@ struct module Key = S.Key module Hash = Hash.Typed (H) (Val) module Path = P - module Metadata = M type 'a t = 'a C.t * 'a S.t type value = S.value @@ -582,26 +560,20 @@ module Store (S : Content_addressable.S with type key = C.key) (H : Hash.S with type t = S.key) (V : S with type t = S.value and type hash = S.key) - (M : Metadata.S with type t = V.metadata) (P : Path.S with type step = V.step) = struct module S = Indexable.Of_content_addressable (H) (S) - include Store_generic_key (C) (S) (H) (V) (M) (P) + include Store_generic_key (C) (S) (H) (V) (P) end module Graph (S : Store) = struct module Path = S.Path module Contents_key = S.Contents.Key - module Metadata = S.Metadata type step = Path.step [@@deriving brassaia] let _step_encoding = Path.step_encoding - type metadata = Metadata.t [@@deriving brassaia] - - let _metadata_encoding = Metadata.encoding - type contents_key = Contents_key.t [@@deriving brassaia] let _contents_key_encoding = Contents_key.encoding @@ -612,7 +584,7 @@ module Graph (S : Store) = struct type path = Path.t [@@deriving brassaia] type 'a t = 'a S.t - type value = [ `Contents of contents_key * metadata | `Node of node_key ] + type value = [ `Contents of contents_key * unit | `Node of node_key ] let empty t = S.add t (S.Val.empty ()) @@ -630,7 +602,7 @@ module Graph (S : Store) = struct let edges t = List.rev_map - (function _, `Node n -> `Node n | _, `Contents (c, _) -> `Contents c) + (function _, `Node n -> `Node n | _, `Contents (c, ()) -> `Contents c) (S.Val.list t) let pp_key = Type.pp S.Key.t @@ -788,8 +760,6 @@ module V1 (N : Generic_key.S with type step = string) = struct let encoding = N.contents_key_encoding end) - module Metadata = N.Metadata - type step = N.step let step_encoding = N.step_encoding @@ -802,10 +772,6 @@ module V1 (N : Generic_key.S with type step = string) = struct let contents_key_encoding = Contents_key.encoding - type metadata = N.metadata [@@deriving brassaia] - - let metadata_encoding = N.metadata_encoding - type hash = N.hash [@@deriving brassaia] let hash_encoding = N.hash_encoding @@ -873,22 +839,17 @@ module V1 (N : Generic_key.S with type step = string) = struct in Type.(map (string_of `Int64)) of_string to_string - let is_default = Type.(unstage (equal N.metadata_t)) Metadata.default - let value_t = let open Type in - record "node" (fun contents metadata node -> - match (contents, metadata, node) with - | Some c, None, None -> `Contents (c, Metadata.default) - | Some c, Some m, None -> `Contents (c, m) - | None, None, Some n -> `Node n + record "node" (fun contents _ node -> + match (contents, node) with + | Some c, None -> `Contents (c, ()) + | None, Some n -> `Node n | _ -> failwith "invalid node") |+ field "contents" (option Contents_key.t) (function - | `Contents (x, _) -> Some x - | _ -> None) - |+ field "metadata" (option metadata_t) (function - | `Contents (_, x) when not (is_default x) -> Some x + | `Contents (x, ()) -> Some x | _ -> None) + |+ field "metadata" (option unit) (fun _ -> None) |+ field "node" (option Node_key.t) (function | `Node n -> Some n | _ -> None) diff --git a/brassaia/lib_brassaia/node_intf.ml b/brassaia/lib_brassaia/node_intf.ml index 29b824779f62..092312d3667f 100644 --- a/brassaia/lib_brassaia/node_intf.ml +++ b/brassaia/lib_brassaia/node_intf.ml @@ -26,12 +26,6 @@ module type Core = sig val encoding : t Data_encoding.t (** [encoding] is the data_encoding for {!type-t}. *) - type metadata [@@deriving brassaia] - (** The type for node metadata. *) - - val metadata_encoding : metadata Data_encoding.t - (** [metadata_encoding] is the data_encoding for {!type-metadata}. *) - type contents_key [@@deriving brassaia] (** The type for contents keys. *) @@ -50,10 +44,9 @@ module type Core = sig val step_encoding : step Data_encoding.t (** [step_encoding] is the data_encoding for {!type-step}. *) - type value = [ `Node of node_key | `Contents of contents_key * metadata ] + type value = [ `Node of node_key | `Contents of contents_key * unit ] [@@deriving brassaia] - (** The type for either (node) keys or (contents) keys combined with their - metadata. *) + (** The type for either (node) keys or (contents) keys combined *) val value_encoding : value Data_encoding.t (** [value_encoding] is the data_encoding for {!type-value}. *) @@ -121,9 +114,6 @@ module type Core = sig (** [remove t s] is the node where [find t s] is [None] but is similar to [t] otherwise. *) - module Metadata : Metadata.S with type t = metadata - (** Metadata functions. *) - (** {2:caching caching} [cache] regulates the caching behaviour regarding the node's internal data @@ -241,24 +231,18 @@ module type Maker_generic_key = functor val step_encoding : step Data_encoding.t end) - (Metadata : Metadata.S) (Contents_key : Key.S with type hash = Hash.t) (Node_key : Key.S with type hash = Hash.t) -> sig include S_generic_key - with type metadata = Metadata.t - and type step = Path.step + with type step = Path.step and type hash = Hash.t and type contents_key = Contents_key.t and type node_key = Node_key.t module Portable : - Portable - with type node := t - and type step := step - and type metadata := metadata - and type hash := hash + Portable with type node := t and type step := step and type hash := hash end module type Store = sig @@ -270,16 +254,12 @@ module type Store = sig val merge : [> read_write ] t -> key option Merge.t (** [merge] is the 3-way merge function for nodes keys. *) - module Metadata : Metadata.S - (** [Metadata] provides base functions for node metadata. *) - (** [Val] provides base functions for node values. *) module Val : S_generic_key with type t = value and type hash = hash and type node_key = key - and type metadata = Metadata.t and type step = Path.step module Hash : Hash.Typed with type t = hash and type value = value @@ -294,9 +274,6 @@ module type Graph = sig type 'a t (** The type for store handles. *) - type metadata [@@deriving brassaia] - (** The type for node metadata. *) - type contents_key [@@deriving brassaia] (** The type of user-defined contents. *) @@ -309,7 +286,7 @@ module type Graph = sig type path [@@deriving brassaia] (** The type of store paths. A path is composed of {{!step} steps}. *) - type value = [ `Node of node_key | `Contents of contents_key * metadata ] + type value = [ `Node of node_key | `Contents of contents_key * unit ] [@@deriving brassaia] (** The type for store values. *) @@ -370,8 +347,8 @@ end module type Sigs = sig module type S = S - (** [Make] provides a simple node implementation, parameterized by hash, path - and metadata implementations. The contents and node values are addressed + (** [Make] provides a simple node implementation, parameterized by hash and + path implementations. The contents and node values are addressed directly by their hash. *) module Make (Hash : Hash.S) @@ -379,12 +356,7 @@ module type Sigs = sig type step [@@deriving brassaia] val step_encoding : step Data_encoding.t - end) - (Metadata : Metadata.S) : - S - with type hash = Hash.t - and type metadata = Metadata.t - and type step = Path.step + end) : S with type hash = Hash.t and type step = Path.step (** [Generic_key] generalises the concept of "node" to one that supports object keys that are not strictly equal to hashes. *) @@ -408,7 +380,6 @@ module type Sigs = sig and type hash = H.t and type contents_key = C.key and type node_key = S.key) - (M : Metadata.S with type t = V.metadata) (P : Path.S with type step = V.step) : Store with type 'a t = 'a C.t * 'a S.t @@ -416,7 +387,6 @@ module type Sigs = sig and type hash = S.hash and type value = S.value and module Path = P - and module Metadata = M and module Val = V end @@ -427,7 +397,6 @@ module type Sigs = sig with type contents_key = N.contents_key and type node_key = N.node_key and type step = N.step - and type metadata = N.metadata val import : N.t -> t val export : t -> N.t @@ -461,7 +430,6 @@ module type Sigs = sig with type node := S.t and type t = S.t and type step = S.step - and type metadata = S.metadata and type hash = S.hash module type S = Portable @@ -476,7 +444,6 @@ module type Sigs = sig (S : Content_addressable.S with type key = C.key) (H : Hash.S with type t = S.key) (V : S with type t = S.value and type hash = S.key) - (M : Metadata.S with type t = V.metadata) (P : Path.S with type step = V.step) : Store with type 'a t = 'a C.t * 'a S.t @@ -484,7 +451,6 @@ module type Sigs = sig and type value = S.value and type hash = H.t and module Path = P - and module Metadata = M and module Val = V module type Graph = Graph @@ -496,7 +462,6 @@ module type Sigs = sig with type 'a t = 'a N.t and type contents_key = N.Contents.key and type node_key = N.key - and type metadata = N.Metadata.t and type step = N.Path.step and type path = N.Path.t end diff --git a/brassaia/lib_brassaia/proof.ml b/brassaia/lib_brassaia/proof.ml index 47c6cff55b5c..5116a9f8f884 100644 --- a/brassaia/lib_brassaia/proof.ml +++ b/brassaia/lib_brassaia/proof.ml @@ -22,15 +22,13 @@ module Make (H : Type.S) (S : sig type step [@@deriving brassaia] - end) - (M : Type.S) = + end) = struct type contents = C.t [@@deriving brassaia] type hash = H.t [@@deriving brassaia] type step = S.step [@@deriving brassaia] - type metadata = M.t [@@deriving brassaia] - type kinded_hash = [ `Contents of hash * metadata | `Node of hash ] + type kinded_hash = [ `Contents of hash * unit | `Node of hash ] [@@deriving brassaia] type 'a inode = { length : int; proofs : (int * 'a) list } @@ -40,8 +38,8 @@ struct [@@deriving brassaia] type tree = - | Contents of contents * metadata - | Blinded_contents of hash * metadata + | Contents of contents * unit + | Blinded_contents of hash * unit | Node of (step * tree) list | Blinded_node of hash | Inode of inode_tree inode @@ -102,8 +100,7 @@ module Env (P : S with type contents := B.Contents.Val.t and type hash := B.Hash.t - and type step := B.Node.Val.step - and type metadata := B.Node.Val.metadata) = + and type step := B.Node.Val.step) = struct module H = B.Hash @@ -345,8 +342,8 @@ struct let l = List.map (function - | step, `Contents (k, m) -> - (step, `Contents (B.Contents.Key.to_hash k, m)) + | step, `Contents (k, ()) -> + (step, `Contents (B.Contents.Key.to_hash k, ())) | step, `Node k -> (step, `Node (B.Node.Key.to_hash k))) l in diff --git a/brassaia/lib_brassaia/proof_intf.ml b/brassaia/lib_brassaia/proof_intf.ml index bbbef40d3a63..e1ccd8892a50 100644 --- a/brassaia/lib_brassaia/proof_intf.ml +++ b/brassaia/lib_brassaia/proof_intf.ml @@ -36,9 +36,8 @@ module type S = sig type contents type hash type step - type metadata - type kinded_hash = [ `Contents of hash * metadata | `Node of hash ] + type kinded_hash = [ `Contents of hash * unit | `Node of hash ] [@@deriving brassaia] type 'a inode = { length : int; proofs : (int * 'a) list } @@ -97,8 +96,8 @@ module type S = sig [Extender e] proves that an inode extender [e] exist in the store. *) type tree = - | Contents of contents * metadata - | Blinded_contents of hash * metadata + | Contents of contents * unit + | Blinded_contents of hash * unit | Node of (step * tree) list | Blinded_node of hash | Inode of inode_tree inode @@ -333,14 +332,9 @@ module type Proof = sig (H : Hash.S) (P : sig type step [@@deriving brassaia] - end) - (M : Type.S) : sig + end) : sig include - S - with type contents := C.t - and type hash := H.t - and type step := P.step - and type metadata := M.t + S with type contents := C.t and type hash := H.t and type step := P.step end module Env @@ -348,8 +342,7 @@ module type Proof = sig (P : S with type contents := B.Contents.Val.t and type hash := B.Hash.t - and type step := B.Node.Val.step - and type metadata := B.Node.Val.metadata) : + and type step := B.Node.Val.step) : Env with type hash := B.Hash.t and type contents := B.Contents.Val.t diff --git a/brassaia/lib_brassaia/schema.ml b/brassaia/lib_brassaia/schema.ml index 6b4c178a570c..2de08f506401 100644 --- a/brassaia/lib_brassaia/schema.ml +++ b/brassaia/lib_brassaia/schema.ml @@ -19,11 +19,15 @@ module type S = sig module Hash : Hash.S module Branch : Branch.S module Info : Info.S - module Metadata : Metadata.S module Path : Path.S module Contents : Contents.S end +(* module Hash = Hash.BLAKE2B *) +(* module Branch = Branch.String *) +(* module Path = Path.String_list *) +(* module Contents = Contents.String *) + module type Extended = sig include S @@ -31,8 +35,7 @@ module type Extended = sig (Contents_key : Key.S with type hash = Hash.t) (Node_key : Key.S with type hash = Hash.t) : Node.Generic_key.S - with type metadata = Metadata.t - and type step = Path.step + with type step = Path.step and type hash = Hash.t and type contents_key = Contents_key.t and type node_key = Node_key.t @@ -57,7 +60,6 @@ module type KV = with type Hash.t = default_hash and type Branch.t = string and type Info.t = Info.default - and type Metadata.t = unit and type Path.step = string and type Path.t = string list @@ -66,8 +68,7 @@ module KV (C : Contents.S) : KV with module Contents = C = struct module Info = Info.Default module Branch = Branch.String module Path = Path.String_list - module Metadata = Metadata.None module Contents = C - module Node = Node.Generic_key.Make (Hash) (Path) (Metadata) + module Node = Node.Generic_key.Make (Hash) (Path) module Commit = Commit.Generic_key.Make (Hash) end diff --git a/brassaia/lib_brassaia/store.ml b/brassaia/lib_brassaia/store.ml index defbf924ac1d..16a59518ac24 100644 --- a/brassaia/lib_brassaia/store.ml +++ b/brassaia/lib_brassaia/store.ml @@ -34,7 +34,6 @@ module Make (B : Backend.S) = struct module Contents_key = B.Contents.Key module Node_key = B.Node.Key module Commit_key = B.Commit.Key - module Metadata = B.Node.Metadata module Typed = Hash.Typed (B.Hash) module Hash = B.Hash module Branch_store = B.Branch @@ -76,10 +75,10 @@ module Make (B : Backend.S) = struct B.Node.index (B.Repo.node_t r) h >|= function | None -> None | Some k -> Some (`Node k)) - | `Contents (h, m) -> ( + | `Contents (h, ()) -> ( B.Contents.index (B.Repo.contents_t r) h >|= function | None -> None - | Some k -> Some (`Contents (k, m)))) + | Some k -> Some (`Contents (k, ())))) let of_key r k = import r k @@ -88,17 +87,17 @@ module Make (B : Backend.S) = struct B.Node.index (B.Repo.node_t r) h >>= function | None -> Lwt.return_none | Some k -> of_key r (`Node k)) - | `Contents (h, m) -> ( + | `Contents (h, ()) -> ( B.Contents.index (B.Repo.contents_t r) h >>= function | None -> Lwt.return_none - | Some k -> of_key r (`Contents (k, m))) + | Some k -> of_key r (`Contents (k, ()))) let shallow r h = import_no_check r h let kinded_hash = hash let hash : ?cache:bool -> t -> hash = fun ?cache tr -> - match hash ?cache tr with `Node h -> h | `Contents (h, _) -> h + match hash ?cache tr with `Node h -> h | `Contents (h, ()) -> h let pp = Type.pp t end @@ -112,7 +111,6 @@ module Make (B : Backend.S) = struct type hash = Hash.t [@@deriving brassaia ~equal ~pp ~compare] type node = Tree.node [@@deriving brassaia] type contents = Contents.t [@@deriving brassaia ~equal] - type metadata = Metadata.t [@@deriving brassaia] type tree = Tree.t [@@deriving brassaia ~pp] type path = Path.t [@@deriving brassaia ~pp] type step = Path.step [@@deriving brassaia] @@ -151,7 +149,7 @@ module Make (B : Backend.S) = struct let save_tree ?(clear = true) r x y (tr : Tree.t) = match Tree.destruct tr with - | `Contents (c, _) -> + | `Contents (c, ()) -> let* c = Tree.Contents.force_exn c in let+ k = save_contents x c in `Contents k @@ -310,7 +308,7 @@ module Make (B : Backend.S) = struct | Some v -> List.iter (function - | _, `Contents (c, _) -> + | _, `Contents (c, ()) -> contents := Contents_keys.add c !contents | _ -> ()) (B.Node.Val.list v); @@ -396,7 +394,7 @@ module Make (B : Backend.S) = struct | Some v -> List.rev_map (function - | _, `Node n -> `Node n | _, `Contents (c, _) -> `Contents c) + | _, `Node n -> `Node n | _, `Contents (c, ()) -> `Contents c) (B.Node.Val.list v) let default_pred_commit t c = @@ -955,7 +953,7 @@ module Make (B : Backend.S) = struct | None -> None | Some tree -> ( match Tree.key tree with - | Some (`Contents (key, _)) -> Some (`Contents key) + | Some (`Contents (key, ())) -> Some (`Contents key) | Some (`Node key) -> Some (`Node key) | None -> None) @@ -1262,9 +1260,7 @@ struct | Ok key -> obj l ((key, node v []) :: acc) | _ -> obj l acc) and node j acc = - match j with - | `O j -> obj j acc - | _ -> `Contents (j, Store.Metadata.default) + match j with `O j -> obj j acc | _ -> `Contents (j, ()) in node j [] @@ -1275,7 +1271,7 @@ struct | [] -> `O acc | (k, v) :: l -> tree l ((step k, contents v []) :: acc) and contents t acc = - match t with `Contents (c, _) -> c | `Tree c -> tree c acc + match t with `Contents (c, ()) -> c | `Tree c -> tree c acc in contents c [] diff --git a/brassaia/lib_brassaia/store_intf.ml b/brassaia/lib_brassaia/store_intf.ml index f5c084cd4e7e..c665c65d3ad6 100644 --- a/brassaia/lib_brassaia/store_intf.ml +++ b/brassaia/lib_brassaia/store_intf.ml @@ -47,9 +47,6 @@ module type S_generic_key = sig type path = Schema.Path.t [@@deriving brassaia] (** The type for store keys. A key is a sequence of {!step}s. *) - type metadata = Schema.Metadata.t [@@deriving brassaia] - (** The type for store metadata. *) - type contents = Schema.Contents.t [@@deriving brassaia] (** The type for store contents. *) @@ -425,7 +422,6 @@ module type S_generic_key = sig with type t := tree and type step := step and type path := path - and type metadata := metadata and type contents := contents and type contents_key := contents_key and type node := node @@ -437,12 +433,10 @@ module type S_generic_key = sig (** {1 Import/Export} *) - type kinded_key = - [ `Contents of contents_key * metadata | `Node of node_key ] + type kinded_key = [ `Contents of contents_key * unit | `Node of node_key ] [@@deriving brassaia] (** Keys in the Brassaia store are tagged with the type of the value they - reference (either {!contents} or {!node}). In the [contents] case, the - key is paired with corresponding {!metadata}. *) + reference (either {!contents} or {!node}). *) val key : tree -> kinded_key option (** [key t] is the key of tree [t] in the underlying repository, if it @@ -465,7 +459,7 @@ module type S_generic_key = sig val hash : ?cache:bool -> tree -> hash (** [hash t] is the hash of tree [t]. *) - type kinded_hash = [ `Contents of hash * metadata | `Node of hash ] + type kinded_hash = [ `Contents of hash * unit | `Node of hash ] (** Like {!kinded_key}, but with hashes as value references rather than keys. *) @@ -585,13 +579,13 @@ module type S_generic_key = sig val mem_tree : t -> path -> bool Lwt.t (** [mem_tree t] is {!Tree.mem_tree} applied to [t]'s root tree. *) - val find_all : t -> path -> (contents * metadata) option Lwt.t + val find_all : t -> path -> (contents * unit) option Lwt.t (** [find_all t] is {!Tree.find_all} applied to [t]'s root tree. *) val find : t -> path -> contents option Lwt.t (** [find t] is {!Tree.find} applied to [t]'s root tree. *) - val get_all : t -> path -> (contents * metadata) Lwt.t + val get_all : t -> path -> (contents * unit) Lwt.t (** [get_all t] is {!Tree.get_all} applied on [t]'s root tree. *) val get : t -> path -> contents Lwt.t @@ -637,9 +631,6 @@ module type S_generic_key = sig (** [set t k ~info v] sets [k] to the value [v] in [t]. Discard any previous results but ensure that no operation is lost in the history. - This function always uses {!Metadata.default} as metadata. Use {!set_tree} - with `[Contents (c, m)] for different ones. - When [clear] is set (the default), the tree cache is emptied upon the function's completion, mirroring the effect of invoking {!Tree.clear}. @@ -725,9 +716,6 @@ module type S_generic_key = sig (** [test_and_set ~test ~set] is like {!set} but it atomically checks that the tree is [test] before modifying it to [set]. - This function always uses {!Metadata.default} as metadata. Use - {!test_and_set_tree} with `[Contents (c, m)] for different ones. - The result is [Error (`Test t)] if the current tree is [t] instead of [test]. @@ -847,9 +835,6 @@ module type S_generic_key = sig (** [merge ~old] is like {!set} but merge the current tree and the new tree using [old] as ancestor in case of conflicts. - This function always uses {!Metadata.default} as metadata. Use - {!merge_tree} with `[Contents (c, m)] for different ones. - The result is [Error (`Conflict c)] if the merge failed with the conflict [c]. @@ -1096,9 +1081,6 @@ module type S_generic_key = sig (** [Path] provides base functions for the stores's paths. *) module Path : Path.S with type t = path and type step = step - module Metadata : Metadata.S with type t = metadata - (** [Metadata] provides base functions for node metadata. *) - (** Backend functions, which might be used by the backends. *) module Backend : Backend.S @@ -1224,7 +1206,6 @@ module type KV = module type KV_maker_generic_key = sig type endpoint - type metadata type hash type info @@ -1233,7 +1214,6 @@ module type KV_maker_generic_key = sig module Make (C : Contents.S) : KV_generic_key with module Schema.Contents = C - and type Schema.Metadata.t = metadata and type Backend.Remote.endpoint = endpoint and type Schema.Hash.t = hash and type contents_key = (hash, C.t) contents_key diff --git a/brassaia/lib_brassaia/tree.ml b/brassaia/lib_brassaia/tree.ml index 2add9b1a6a55..56999108fdf3 100644 --- a/brassaia/lib_brassaia/tree.ml +++ b/brassaia/lib_brassaia/tree.ml @@ -146,9 +146,8 @@ module Make (P : Backend.S) = struct List.fold_right f steps init end - module Metadata = P.Node.Metadata module Brassaia_proof = Proof - module Tree_proof = Proof.Make (P.Contents.Val) (P.Hash) (Path) (Metadata) + module Tree_proof = Proof.Make (P.Contents.Val) (P.Hash) (Path) module Env = Proof.Env (P) (Tree_proof) let merge_env x y = @@ -185,7 +184,6 @@ module Make (P : Backend.S) = struct arr end - type metadata = Metadata.t [@@deriving brassaia ~equal] type path = Path.t [@@deriving brassaia ~pp] type hash = P.Hash.t [@@deriving brassaia ~pp ~equal ~compare] type step = Path.step [@@deriving brassaia ~pp ~compare] @@ -433,7 +431,7 @@ module Make (P : Backend.S) = struct type portable = Portable.t [@@deriving brassaia ~equal ~pp] (* [elt] is a tree *) - type elt = [ `Node of t | `Contents of Contents.t * Metadata.t ] + type elt = [ `Node of t | `Contents of Contents.t * unit ] and update = Add of elt | Remove and updatemap = update StepMap.t and map = elt StepMap.t @@ -461,14 +459,11 @@ module Make (P : Backend.S) = struct let elt_t (t : t Type.t) : elt Type.t = let open Type in - variant "Node.value" (fun node contents contents_m -> function - | `Node x -> node x - | `Contents (c, m) -> - if equal_metadata m Metadata.default then contents c - else contents_m (c, m)) + variant "Node.value" (fun node contents _ -> function + | `Node x -> node x | `Contents (c, ()) -> contents c) |~ case1 "Node" t (fun x -> `Node x) - |~ case1 "Contents" Contents.t (fun x -> `Contents (x, Metadata.default)) - |~ case1 "Contents-x" (pair Contents.t Metadata.t) (fun x -> `Contents x) + |~ case1 "Contents" Contents.t (fun x -> `Contents (x, ())) + |~ case1 "Contents-x" (pair Contents.t unit) (fun x -> `Contents x) |> sealv let stepmap_t : 'a. 'a Type.t -> 'a StepMap.t Type.t = @@ -544,7 +539,7 @@ module Make (P : Backend.S) = struct let rec clear_elt ~max_depth depth v = match v with - | `Contents (c, _) -> if depth + 1 > max_depth then Contents.clear c + | `Contents (c, ()) -> if depth + 1 > max_depth then Contents.clear c | `Node t -> clear ~max_depth (depth + 1) t and clear_info ~max_depth ~v depth i = @@ -585,10 +580,7 @@ module Make (P : Backend.S) = struct assert false module Core_value - (N : Node.Generic_key.Core - with type step := step - and type hash := hash - and type metadata := metadata) + (N : Node.Generic_key.Core with type step := step and type hash := hash) (To_elt : sig type repo @@ -647,7 +639,7 @@ module Make (P : Backend.S) = struct let t ~env repo = function | `Node k -> `Node (of_key ~env repo k) - | `Contents (k, m) -> `Contents (Contents.of_key ~env repo k, m) + | `Contents (k, ()) -> `Contents (Contents.of_key ~env repo k, ()) end) module Portable_value = @@ -658,7 +650,7 @@ module Make (P : Backend.S) = struct let t ~env () = function | `Node h -> `Node (pruned ~env h) - | `Contents (h, m) -> `Contents (Contents.pruned ~env h, m) + | `Contents (h, ()) -> `Contents (Contents.pruned ~env h, ()) end) (** This [Scan] module contains function that scan the content of [t.v] and @@ -848,7 +840,7 @@ module Make (P : Backend.S) = struct | Pnode_value of pnode_value let weaken_value : node_value -> pnode_value = function - | `Contents (key, m) -> `Contents (P.Contents.Key.to_hash key, m) + | `Contents (key, ()) -> `Contents (P.Contents.Key.to_hash key, ()) | `Node key -> `Node (P.Node.Key.to_hash key) let rec hash : type a. cache:bool -> t -> (hash -> a) -> a = @@ -889,14 +881,14 @@ module Make (P : Backend.S) = struct |> Seq.exists (fun (_, v) -> match v with | `Node n -> Option.is_none (cached_key n) - | `Contents (c, _) -> Option.is_none (Contents.cached_key c)) + | `Contents (c, ()) -> Option.is_none (Contents.cached_key c)) in if must_build_portable_node then let pnode = bindings |> Seq.map (fun (step, v) -> match v with - | `Contents (c, m) -> (step, `Contents (Contents.hash c, m)) + | `Contents (c, ()) -> (step, `Contents (Contents.hash c, ())) | `Node n -> hash ~cache n (fun k -> (step, `Node k))) |> Portable.of_seq in @@ -906,9 +898,9 @@ module Make (P : Backend.S) = struct bindings |> Seq.map (fun (step, v) -> match v with - | `Contents (c, m) -> ( + | `Contents (c, ()) -> ( match Contents.cached_key c with - | Some k -> (step, `Contents (k, m)) + | Some k -> (step, `Contents (k, ())) | None -> (* We checked that all child keys are cached above *) assert false) @@ -927,10 +919,10 @@ module Make (P : Backend.S) = struct type r. cache:bool -> elt -> (hash_preimage_value, r) cont = fun ~cache e k -> match e with - | `Contents (c, m) -> ( + | `Contents (c, ()) -> ( match Contents.key c with - | Some key -> k (Node_value (`Contents (key, m))) - | None -> k (Pnode_value (`Contents (Contents.hash c, m)))) + | Some key -> k (Node_value (`Contents (key, ()))) + | None -> k (Pnode_value (`Contents (Contents.hash c, ())))) | `Node n -> ( match key n with | Some key -> k (Node_value (`Node key)) @@ -1100,8 +1092,7 @@ module Make (P : Backend.S) = struct | Portable_dirty (p, um) -> ok (of_portable_value p (Some um)) | Pruned h -> err_pruned_hash h |> Lwt.return - let contents_equal ((c1, m1) as x1) ((c2, m2) as x2) = - x1 == x2 || (Contents.equal c1 c2 && equal_metadata m1 m2) + let contents_equal (c1, ()) (c2, ()) = Contents.equal c1 c2 let rec elt_equal (x : elt) (y : elt) = x == y @@ -1629,22 +1620,15 @@ module Make (P : Backend.S) = struct let f : elt Merge.f = fun ~old x y -> match (x, y) with - | `Contents (x, cx), `Contents (y, cy) -> - let mold = - Merge.bind_promise old (fun old () -> - match old with - | `Contents (_, m) -> ok (Some m) - | `Node _ -> ok None) - in - Merge.(f Metadata.merge) ~old:mold cx cy >>=* fun m -> + | `Contents (c1, ()), `Contents (c2, ()) -> let old = Merge.bind_promise old (fun old () -> match old with - | `Contents (c, _) -> ok (Some c) + | `Contents (c, ()) -> ok (Some c) | `Node _ -> ok None) in - Merge.(f Contents.merge) ~old x y >>=* fun c -> - Merge.ok (`Contents (c, m)) + Merge.(f Contents.merge) ~old c1 c2 >>=* fun c -> + Merge.ok (`Contents (c, ())) | `Node x, `Node y -> (merge [@tailcall]) (fun m -> let old = @@ -1665,13 +1649,13 @@ module Make (P : Backend.S) = struct type node_key = Node.key [@@deriving brassaia ~pp] type contents_key = Contents.key [@@deriving brassaia ~pp] - type kinded_key = [ `Contents of Contents.key * metadata | `Node of Node.key ] + type kinded_key = [ `Contents of Contents.key * unit | `Node of Node.key ] [@@deriving brassaia] - type kinded_hash = [ `Contents of hash * metadata | `Node of hash ] + type kinded_hash = [ `Contents of hash * unit | `Node of hash ] [@@deriving brassaia ~equal] - type t = [ `Node of node | `Contents of Contents.t * Metadata.t ] + type t = [ `Node of node | `Contents of Contents.t * unit ] [@@deriving brassaia] let to_backend_node n = @@ -1687,12 +1671,9 @@ module Make (P : Backend.S) = struct let dump ppf = function | `Node n -> Fmt.pf ppf "node: %a" Node.dump n - | `Contents (c, _) -> Fmt.pf ppf "contents: %a" (Type.pp Contents.t) c + | `Contents (c, ()) -> Fmt.pf ppf "contents: %a" (Type.pp Contents.t) c - let contents_equal ((c1, m1) as x1) ((c2, m2) as x2) = - x1 == x2 - || (c1 == c2 && m1 == m2) - || (Contents.equal c1 c2 && equal_metadata m1 m2) + let contents_equal (c1, ()) (c2, ()) = Contents.equal c1 c2 let equal (x : t) (y : t) = x == y @@ -1706,21 +1687,21 @@ module Make (P : Backend.S) = struct | `Node n -> Node.is_empty ~cache:true n | `Contents _ -> false - type elt = [ `Node of node | `Contents of contents * metadata ] + type elt = [ `Node of node | `Contents of contents * unit ] let of_node n = `Node n - let of_contents ?(metadata = Metadata.default) c = + let of_contents c = let env = Env.empty () in let c = Contents.of_value ~env c in - `Contents (c, metadata) + `Contents (c, ()) let init : elt -> t = function - | `Contents (c, metadata) -> of_contents ~metadata c + | `Contents (c, ()) -> of_contents c | `Node n -> `Node n let pruned_with_env ~env = function - | `Contents (h, meta) -> `Contents (Contents.pruned ~env h, meta) + | `Contents (h, ()) -> `Contents (Contents.pruned ~env h, ()) | `Node h -> `Node (Node.pruned ~env h) let pruned h = @@ -1764,7 +1745,7 @@ module Make (P : Backend.S) = struct let fold ?(order = `Sorted) ?(force = `True) ?(cache = false) ?(uniq = `False) ?pre ?post ?depth ?(contents = id) ?(node = id) ?(tree = id) (t : t) acc = match t with - | `Contents (c, _) as c' -> + | `Contents (c, ()) as c' -> let tree path = tree path c' in Contents.fold ~force ~cache ~path:Path.empty contents tree c acc | `Node n -> @@ -1805,19 +1786,18 @@ module Make (P : Backend.S) = struct let find_all t k = find_tree t k >>= function | None | Some (`Node _) -> Lwt.return_none - | Some (`Contents (c, m)) -> + | Some (`Contents (c, ())) -> let+ c = Contents.to_value ~cache:true c in - Some (get_ok "find_all" c, m) + Some (get_ok "find_all" c, ()) - let find t k = - find_all t k >|= function None -> None | Some (c, _) -> Some c + let find t k = find_all t k >|= Option.map fst let get_all t k = find_all t k >>= function | None -> err_not_found "get" k | Some v -> Lwt.return v - let get t k = get_all t k >|= fun (c, _) -> c + let get t k = get_all t k >|= fst let mem t k = find t k >|= function None -> false | _ -> true let mem_tree t k = find_tree t k >|= function None -> false | _ -> true @@ -1862,11 +1842,11 @@ module Make (P : Backend.S) = struct let empty () = `Node (Node.empty ()) - let singleton path ?(metadata = Metadata.default) c = + let singleton path c = Events.(emit__dont_wait__use_with_care tree_function) ("singleton", Logging.to_string_exn Path.encoding path); let env = Env.empty () in - let base_tree = `Contents (Contents.of_value ~env c, metadata) in + let base_tree = `Contents (Contents.of_value ~env c, ()) in Path.fold_right path ~f:(fun step child -> `Node (Node.singleton ~env step child)) ~init:base_tree @@ -1885,7 +1865,7 @@ module Make (P : Backend.S) = struct let get_env = function | `Node n -> n.Node.info.env - | `Contents (c, _) -> c.Contents.info.env + | `Contents (c, ()) -> c.Contents.info.env let update_tree ~cache ~f_might_return_empty_node ~f root_tree path = (* User-introduced empty nodes will be removed immediately if necessary. *) @@ -1977,7 +1957,7 @@ module Make (P : Backend.S) = struct Env.copy ~into:node.info.env (get_env root_tree); Lwt.return (`Node node)) - let update t k ?(metadata = Metadata.default) f = + let update t k f = let cache = true in let* () = Events.(emit tree_function) @@ -1987,20 +1967,20 @@ module Make (P : Backend.S) = struct let+ old_contents = match t with | Some (`Node _) | None -> Lwt.return_none - | Some (`Contents (c, _)) -> + | Some (`Contents (c, ())) -> let+ c = Contents.to_value ~cache c in Some (get_ok "update" c) in match f old_contents with | None -> None - | Some c -> of_contents ~metadata c |> Option.some) + | Some c -> of_contents c |> Option.some) - let add t k ?(metadata = Metadata.default) c = + let add t k c = let* () = Events.(emit tree_function) ("add", Logging.to_string_exn Path.encoding k) in update_tree ~cache:true t k - ~f:(fun _ -> Lwt.return_some (of_contents ~metadata c)) + ~f:(fun _ -> Lwt.return_some (of_contents c)) ~f_might_return_empty_node:false let add_tree t k v = @@ -2029,12 +2009,12 @@ module Make (P : Backend.S) = struct update_tree ~cache:true t k ~f:(Lwt.wrap1 f) ~f_might_return_empty_node:true let import repo = function - | `Contents (k, m) -> ( + | `Contents (k, ()) -> ( cnt.contents_mem <- cnt.contents_mem + 1; P.Contents.mem (P.Repo.contents_t repo) k >|= function | true -> let env = Env.empty () in - Some (`Contents (Contents.of_key ~env repo k, m)) + Some (`Contents (Contents.of_key ~env repo k, ())) | false -> None) | `Node k -> ( cnt.node_mem <- cnt.node_mem + 1; @@ -2046,7 +2026,7 @@ module Make (P : Backend.S) = struct let import_with_env ~env repo = function | `Node k -> `Node (Node.of_key ~env repo k) - | `Contents (k, m) -> `Contents (Contents.of_key ~env repo k, m) + | `Contents (k, ()) -> `Contents (Contents.of_key ~env repo k, ()) let import_no_check repo f = let env = Env.empty () in @@ -2110,9 +2090,9 @@ module Make (P : Backend.S) = struct "Encountered child node value with uncached key \ during export:@,\ @ @[%a@]" dump v) - | `Contents (c, m) -> ( + | `Contents (c, ()) -> ( match Contents.cached_key c with - | Some k -> (step, `Contents (k, m)) + | Some k -> (step, `Contents (k, ())) | None -> assertion_failure "Encountered child contents value with uncached key \ @@ -2137,9 +2117,9 @@ module Make (P : Backend.S) = struct "Encountered child node value with uncached key during \ export:@,\ @ @[%a@]" dump v) - | Add (`Contents (c, m) as v) -> ( + | Add (`Contents (c, ()) as v) -> ( match Contents.cached_key c with - | Some ptr -> P.Node.Val.add acc k (`Contents (ptr, m)) + | Some ptr -> P.Node.Val.add acc k (`Contents (ptr, ())) | None -> assertion_failure "Encountered child contents value with uncached key \ @@ -2268,9 +2248,9 @@ module Make (P : Backend.S) = struct assert false))) and on_contents : type r. - [ `Contents of Contents.t * metadata ] -> + [ `Contents of Contents.t * unit ] -> ([ `Content_exported ], r) cont_lwt = - fun (`Contents (c, _)) k -> + fun (`Contents (c, ())) k -> match c.Contents.v with | Contents.Key (_, key) -> Contents.export ?clear repo c key; @@ -2353,7 +2333,7 @@ module Make (P : Backend.S) = struct let* cx = Contents.to_value ~cache:true (fst x) in let+ cy = Contents.to_value ~cache:true (fst y) in diff_force_result cx cy ~empty:[] ~diff_ok:(fun (cx, cy) -> - [ `Updated ((cx, snd x), (cy, snd y)) ]) + [ `Updated ((cx, ()), (cy, ())) ]) let diff_node (x : node) (y : node) = let bindings n = @@ -2361,13 +2341,13 @@ module Make (P : Backend.S) = struct | Ok m -> Ok (StepMap.bindings m) | Error _ as e -> e in - let removed acc (k, (c, m)) = + let removed acc (k, (c, ())) = let+ c = Contents.to_value ~cache:true c >|= get_ok "diff_node" in - (k, `Removed (c, m)) :: acc + (k, `Removed (c, ())) :: acc in - let added acc (k, (c, m)) = + let added acc (k, (c, ())) = let+ c = Contents.to_value ~cache:true c >|= get_ok "diff_node" in - (k, `Added (c, m)) :: acc + (k, `Added (c, ())) :: acc in let rec diff_bindings acc todo path x y = let acc = ref acc in @@ -2430,25 +2410,25 @@ module Make (P : Backend.S) = struct let diff (x : t) (y : t) = match (x, y) with - | `Contents ((c1, m1) as x), `Contents ((c2, m2) as y) -> - if contents_equal x y then Lwt.return_nil + | `Contents (c1, ()), `Contents (c2, ()) -> + if Contents.equal c1 c2 then Lwt.return_nil else let* c1 = Contents.to_value ~cache:true c1 >|= get_ok "diff" in let* c2 = Contents.to_value ~cache:true c2 >|= get_ok "diff" in - Lwt.return [ (Path.empty, `Updated ((c1, m1), (c2, m2))) ] + Lwt.return [ (Path.empty, `Updated ((c1, ()), (c2, ()))) ] | `Node x, `Node y -> diff_node x y - | `Contents (x, m), `Node y -> + | `Contents (x, ()), `Node y -> let* diff = diff_node (Node.empty ()) y in let+ x = Contents.to_value ~cache:true x >|= get_ok "diff" in - (Path.empty, `Removed (x, m)) :: diff - | `Node x, `Contents (y, m) -> + (Path.empty, `Removed (x, ())) :: diff + | `Node x, `Contents (y, ()) -> let* diff = diff_node x (Node.empty ()) in let+ y = Contents.to_value ~cache:true y >|= get_ok "diff" in - (Path.empty, `Added (y, m)) :: diff + (Path.empty, `Added (y, ())) :: diff type concrete = [ `Tree of (Path.step * concrete) list - | `Contents of P.Contents.Val.t * Metadata.t ] + | `Contents of P.Contents.Val.t * unit ] [@@deriving brassaia] type 'a or_empty = Empty | Non_empty of 'a @@ -2457,7 +2437,7 @@ module Make (P : Backend.S) = struct let rec concrete : type r. concrete -> (t or_empty, r) cont = fun t k -> match t with - | `Contents (c, m) -> k (Non_empty (of_contents ~metadata:m c)) + | `Contents (c, ()) -> k (Non_empty (of_contents c)) | `Tree childs -> tree StepMap.empty childs (function | Empty -> k Empty @@ -2501,10 +2481,10 @@ module Make (P : Backend.S) = struct (node [@tailcall]) [] bindings (fun n -> let n = List.sort (fun (s, _) (s', _) -> compare_step s s') n in k (`Tree n)) - and contents : type r. Contents.t * metadata -> (concrete, r) cont_lwt = - fun (c, m) k -> + and contents : type r. Contents.t * unit -> (concrete, r) cont_lwt = + fun (c, ()) k -> let* c = Contents.to_value ~cache:true c >|= get_ok "to_concrete" in - k (`Contents (c, m)) + k (`Contents (c, ())) and node : type r. (step * concrete) list -> @@ -2528,16 +2508,16 @@ module Make (P : Backend.S) = struct match t with | `Node n -> ( match Node.key n with Some key -> Some (`Node key) | None -> None) - | `Contents (c, m) -> ( + | `Contents (c, ()) -> ( match Contents.key c with - | Some key -> Some (`Contents (key, m)) + | Some key -> Some (`Contents (key, ())) | None -> None) let hash ?(cache = true) (t : t) = Events.(emit__dont_wait__use_with_care tree_hash) (); match t with | `Node n -> `Node (Node.hash ~cache n) - | `Contents (c, m) -> `Contents (Contents.hash ~cache c, m) + | `Contents (c, ()) -> `Contents (Contents.hash ~cache c, ()) let stats ?(force = false) (t : t) = let cache = true in @@ -2586,15 +2566,14 @@ module Make (P : Backend.S) = struct let rec proof_of_tree : type a. brassaia_tree -> (proof_tree -> a) -> a = fun tree k -> match tree with - | `Contents (c, h) -> proof_of_contents c h k + | `Contents (c, ()) -> proof_of_contents c k | `Node node -> proof_of_node node k - and proof_of_contents : - type a. Contents.t -> metadata -> (proof_tree -> a) -> a = - fun c m k -> + and proof_of_contents : type a. Contents.t -> (proof_tree -> a) -> a = + fun c k -> match Contents.cached_value c with - | Some v -> k (Contents (v, m)) - | None -> k (Blinded_contents (Contents.hash c, m)) + | Some v -> k (Contents (v, ())) + | None -> k (Blinded_contents (Contents.hash c, ())) and proof_of_node : type a. node -> (proof_tree -> a) -> a = fun node k -> @@ -2703,11 +2682,11 @@ module Make (P : Backend.S) = struct | Blinded_node h -> k (`Node h) | Node n -> load_node_proof ~env n k | Inode { length; proofs } -> load_inode_proof ~env length proofs k - | Blinded_contents (h, m) -> k (`Contents (h, m)) - | Contents (v, m) -> + | Blinded_contents (h, ()) -> k (`Contents (h, ())) + | Contents (v, ()) -> let h = P.Contents.Hash.hash v in Env.add_contents_from_proof env h v; - k (`Contents (h, m)) + k (`Contents (h, ())) | Extender { length; segments; proof } -> load_extender_proof ~env length segments proof k diff --git a/brassaia/lib_brassaia/tree_intf.ml b/brassaia/lib_brassaia/tree_intf.ml index 862744e55258..74dd36c296da 100644 --- a/brassaia/lib_brassaia/tree_intf.ml +++ b/brassaia/lib_brassaia/tree_intf.ml @@ -20,7 +20,6 @@ open! Import module type S = sig type path [@@deriving brassaia] type step [@@deriving brassaia] - type metadata [@@deriving brassaia] type contents [@@deriving brassaia] type contents_key [@@deriving brassaia] type node [@@deriving brassaia] @@ -45,23 +44,23 @@ module type S = sig backend configuration values, as they can perform in-memory operation, independently of any given backend. *) - val singleton : path -> ?metadata:metadata -> contents -> t + val singleton : path -> contents -> t (** [singleton k c] is the tree with a single binding mapping the key [k] to the contents [c]. *) - val of_contents : ?metadata:metadata -> contents -> t + val of_contents : contents -> t (** [of_contents c] is the subtree built from the contents [c]. *) val of_node : node -> t (** [of_node n] is the subtree built from the node [n]. *) - type elt = [ `Node of node | `Contents of contents * metadata ] + type elt = [ `Node of node | `Contents of contents * unit ] (** The type for tree elements. *) val init : elt -> t (** General-purpose constructor for trees. *) - type kinded_hash = [ `Contents of hash * metadata | `Node of hash ] + type kinded_hash = [ `Contents of hash * unit | `Node of hash ] [@@deriving brassaia] val pruned : kinded_hash -> t @@ -84,7 +83,7 @@ module type S = sig (** {1 Diffs} *) - val diff : t -> t -> (path * (contents * metadata) Diff.t) list Lwt.t + val diff : t -> t -> (path * (contents * unit) Diff.t) list Lwt.t (** [diff x y] is the difference of contents between [x] and [y]. *) (** {1 Manipulating Contents} *) @@ -146,9 +145,9 @@ module type S = sig val mem : t -> path -> bool Lwt.t (** [mem t k] is true iff [k] is associated to some contents in [t]. *) - val find_all : t -> path -> (contents * metadata) option Lwt.t + val find_all : t -> path -> (contents * unit) option Lwt.t (** [find_all t k] is [Some (b, m)] if [k] is associated to the contents [b] - and metadata [m] in [t] and [None] if [k] is not present in [t]. *) + in [t] and [None] if [k] is not present in [t]. *) val length : t -> ?cache:bool -> path -> int Lwt.t (** [length t key] is the number of files and sub-nodes stored under [key] in @@ -161,9 +160,9 @@ module type S = sig parameter.*) val find : t -> path -> contents option Lwt.t - (** [find] is similar to {!find_all} but it discards metadata. *) + (** [find] is similar to {!find_all} *) - val get_all : t -> path -> (contents * metadata) Lwt.t + val get_all : t -> path -> (contents * unit) Lwt.t (** Same as {!find_all} but raise [Invalid_arg] if [k] is not present in [t]. *) val list : @@ -191,18 +190,13 @@ module type S = sig (** [seq t key] follows the same behavior as {!list} but returns a sequence. *) val get : t -> path -> contents Lwt.t - (** Same as {!get_all} but ignore the metadata. *) + (** Same as {!get_all} *) - val add : t -> path -> ?metadata:metadata -> contents -> t Lwt.t + val add : t -> path -> contents -> t Lwt.t (** [add t k c] is the tree where the key [k] is bound to the contents [c] but is similar to [t] for other bindings. *) - val update : - t -> - path -> - ?metadata:metadata -> - (contents option -> contents option) -> - t Lwt.t + val update : t -> path -> (contents option -> contents option) -> t Lwt.t (** [update t k f] is the tree [t'] that is the same as [t] for all keys except [k], and whose binding for [k] is determined by [f (find t k)]. @@ -245,7 +239,7 @@ module type S = sig (** {1 Folds} *) - val destruct : t -> [ `Node of node | `Contents of Contents.t * metadata ] + val destruct : t -> [ `Node of node | `Contents of Contents.t * unit ] (** General-purpose destructor for trees. *) type marks @@ -345,7 +339,7 @@ module type S = sig (** {1 Concrete Trees} *) type concrete = - [ `Tree of (step * concrete) list | `Contents of contents * metadata ] + [ `Tree of (step * concrete) list | `Contents of contents * unit ] [@@deriving brassaia] (** The type for concrete trees. *) @@ -366,7 +360,6 @@ module type S = sig with type contents := contents and type hash := hash and type step := step - and type metadata := metadata type brassaia_tree @@ -445,13 +438,12 @@ module type Sigs = sig S with type path = B.Node.Path.t and type step = B.Node.Path.step - and type metadata = B.Node.Metadata.t and type contents = B.Contents.value and type contents_key = B.Contents.Key.t and type hash = B.Hash.t type kinded_key = - [ `Contents of B.Contents.Key.t * metadata | `Node of B.Node.Key.t ] + [ `Contents of B.Contents.Key.t * unit | `Node of B.Node.Key.t ] [@@deriving brassaia] val import : B.Repo.t -> kinded_key -> t option Lwt.t diff --git a/brassaia/lib_brassaia_pack/brassaia_pack.ml b/brassaia/lib_brassaia_pack/brassaia_pack.ml index 9640f89e50fa..39064faa0404 100644 --- a/brassaia/lib_brassaia_pack/brassaia_pack.ml +++ b/brassaia/lib_brassaia_pack/brassaia_pack.ml @@ -23,7 +23,6 @@ module Indexable = Indexable module Atomic_write = Atomic_write module Hash = Brassaia.Hash.BLAKE2B module Path = Brassaia.Path.String_list -module Metadata = Brassaia.Metadata.None module Version = Version module Conf = Conf module Stats = Stats diff --git a/brassaia/lib_brassaia_pack/brassaia_pack_intf.ml b/brassaia/lib_brassaia_pack/brassaia_pack_intf.ml index 37026a387462..74873c3b5090 100644 --- a/brassaia/lib_brassaia_pack/brassaia_pack_intf.ml +++ b/brassaia/lib_brassaia_pack/brassaia_pack_intf.ml @@ -49,7 +49,6 @@ module type Maker = sig TODO: extract these extensions as a separate functor argument instead. *) with type Schema.Hash.t = Schema.Hash.t and type Schema.Branch.t = Schema.Branch.t - and type Schema.Metadata.t = Schema.Metadata.t and type Schema.Path.t = Schema.Path.t and type Schema.Path.step = Schema.Path.step and type Schema.Contents.t = Schema.Contents.t diff --git a/brassaia/lib_brassaia_pack/inode.ml b/brassaia/lib_brassaia_pack/inode.ml index 52db45c527f1..682c4abce66d 100644 --- a/brassaia/lib_brassaia_pack/inode.ml +++ b/brassaia/lib_brassaia_pack/inode.ml @@ -88,16 +88,10 @@ struct let step_encoding = Node.step_encoding - type metadata = Node.metadata [@@deriving brassaia ~equal] - - let metadata_encoding = Node.metadata_encoding - type value = Node.value [@@deriving brassaia ~equal] let value_encoding = Node.value_encoding - module Metadata = Node.Metadata - exception Dangling_hash = Node.Dangling_hash let raise_dangling_hash c hash = @@ -105,11 +99,11 @@ struct raise (Dangling_hash { context; hash }) let unsafe_keyvalue_of_hashvalue = function - | `Contents (h, m) -> `Contents (Key.unfindable_of_hash h, m) + | `Contents (h, ()) -> `Contents (Key.unfindable_of_hash h, ()) | `Node h -> `Node (Key.unfindable_of_hash h) let hashvalue_of_keyvalue = function - | `Contents (k, m) -> `Contents (Key.to_hash k, m) + | `Contents (k, ()) -> `Contents (Key.to_hash k, ()) | `Node k -> `Node (Key.to_hash k) end @@ -403,11 +397,7 @@ struct type tree = { depth : int; length : int; entries : ptr list } [@@deriving brassaia] - type value = - | Contents of name * address * metadata - | Node of name * address - - let is_default = T.(equal_metadata Metadata.default) + type value = Contents of name * address * unit | Node of name * address (* We distribute products over sums in the type representation of [value] in order to pack many possible cases into a single tag character in the @@ -415,10 +405,6 @@ struct - whether the referenced value is a [Node] or a [Contents] value; - - in the [Contents] case, whether the associated metadata is [default] - (in which case the serialised representation elides it), or if it is - included; - - whether the [name] of the entry is provided inline [Direct], or is stored in the dict and refernced via a dict key [Indirect]; @@ -432,37 +418,38 @@ struct let do_ = [%typ: step * pack_offset] let dh = [%typ: step * H.t] (* As above but for contents values with non-default metadata: *) - let x_io = [%typ: dict_key * pack_offset * metadata] - let x_ih = [%typ: dict_key * H.t * metadata] - let x_do = [%typ: step * pack_offset * metadata] - let x_dh = [%typ: step * H.t * metadata] + let x_io = [%typ: dict_key * pack_offset * unit] + let x_ih = [%typ: dict_key * H.t * unit] + let x_do = [%typ: step * pack_offset * unit] + let x_dh = [%typ: step * H.t * unit] end in let open Brassaia.Type in variant "Compress.value" (fun (* The ordering of these arguments determines which tags are assigned to the cases, so should not be changed: *) - contents_io contents_x_io node_io contents_ih contents_x_ih node_ih - contents_do contents_x_do node_do contents_dh contents_x_dh node_dh + contents_io _contents_x_io node_io contents_ih _contents_x_ih node_ih + contents_do _contents_x_do node_do contents_dh _contents_x_dh node_dh -> function | Node (Indirect n, Offset o) -> node_io (n, o) | Node (Indirect n, Hash h) -> node_ih (n, h) | Node (Direct n, Offset o) -> node_do (n, o) | Node (Direct n, Hash h) -> node_dh (n, h) - | Contents (Indirect n, Offset o, m) -> if is_default m then contents_io (n, o) else contents_x_io (n, o, m) - | Contents (Indirect n, Hash h, m) -> if is_default m then contents_ih (n, h) else contents_x_ih (n, h, m) - | Contents (Direct n, Offset o, m) -> if is_default m then contents_do (n, o) else contents_x_do (n, o, m) - | Contents (Direct n, Hash h, m) -> if is_default m then contents_dh (n, h) else contents_x_dh (n, h, m)) - |~ case1 "contents-io" Payload.io (fun (n, o) -> Contents (Indirect n, Offset o, Metadata.default)) + | Contents (Indirect n, Offset o, ()) -> contents_io (n, o) + | Contents (Indirect n, Hash h, ()) -> contents_ih (n, h) + | Contents (Direct n, Offset o, ()) -> contents_do (n, o) + | Contents (Direct n, Hash h, ()) -> contents_dh (n, h) ) + |~ case1 "contents-io" Payload.io (fun (n, o) -> Contents (Indirect n, Offset o, ())) |~ case1 "contents-x-io" Payload.x_io (fun (n, i, m) -> Contents (Indirect n, Offset i, m)) + |~ case1 "node-io" Payload.io (fun (n, i) -> Node (Indirect n, Offset i)) - |~ case1 "contents-ih" Payload.ih (fun (n, h) -> Contents (Indirect n, Hash h, Metadata.default)) + |~ case1 "contents-ih" Payload.ih (fun (n, h) -> Contents (Indirect n, Hash h, ())) |~ case1 "contents-x-ih" Payload.x_ih (fun (n, h, m) -> Contents (Indirect n, Hash h, m)) |~ case1 "node-ih" Payload.ih (fun (n, h) -> Node (Indirect n, Hash h)) - |~ case1 "contents-do" Payload.do_ (fun (n, i) -> Contents (Direct n, Offset i, Metadata.default)) + |~ case1 "contents-do" Payload.do_ (fun (n, i) -> Contents (Direct n, Offset i, ())) |~ case1 "contents-x-do" Payload.x_do (fun (n, i, m) -> Contents (Direct n, Offset i, m)) |~ case1 "node-do" Payload.do_ (fun (n, i) -> Node (Direct n, Offset i)) - |~ case1 "contents-dh" Payload.dh (fun (n, i) -> Contents (Direct n, Hash i, Metadata.default)) + |~ case1 "contents-dh" Payload.dh (fun (n, i) -> Contents (Direct n, Hash i, ())) |~ case1 "contents-x-dh" Payload.x_dh (fun (n, i, m) -> Contents (Direct n, Hash i, m)) |~ case1 "node-dd" Payload.dh (fun (n, i) -> Node (Direct n, Hash i)) |> sealv @@ -881,7 +868,7 @@ struct let v = match v with | `Node _ as k -> (Some s, k) - | `Contents (k, _) -> (Some s, `Contents k) + | `Contents (k, ()) -> (Some s, `Contents k) in v :: acc) l [] @@ -1042,7 +1029,7 @@ struct module Concrete = struct type kinded_key = | Contents of contents_key - | Contents_x of metadata * contents_key + | Contents_x of unit * contents_key | Node of node_key [@@deriving brassaia] @@ -1059,17 +1046,14 @@ struct let to_entry (name, v) = match v with - | `Contents (contents_key, m) -> - if T.equal_metadata m Metadata.default then - { name; key = Contents contents_key } - else { name; key = Contents_x (m, contents_key) } + | `Contents (contents_key, ()) -> { name; key = Contents contents_key } | `Node node_key -> { name; key = Node node_key } let of_entry e = ( e.name, match e.key with - | Contents key -> `Contents (key, Metadata.default) - | Contents_x (m, key) -> `Contents (key, m) + | Contents key -> `Contents (key, ()) + | Contents_x ((), key) -> `Contents (key, ()) | Node key -> `Node key ) type error = @@ -1654,7 +1638,7 @@ struct let is_tree t = match t.v with Tree _ -> true | Values _ -> false module Proof = struct - type value = [ `Contents of hash * metadata | `Node of hash ] + type value = [ `Contents of hash * unit | `Node of hash ] [@@deriving brassaia] type t = @@ -1811,7 +1795,7 @@ struct module Snapshot = struct include T - type kinded_hash = Contents of hash * metadata | Node of hash + type kinded_hash = Contents of hash * unit | Node of hash [@@deriving brassaia] type entry = { step : string; hash : kinded_hash } [@@deriving brassaia] @@ -1837,9 +1821,9 @@ struct in ( step, match e.hash with - | Snapshot.Contents (hash, m) -> + | Snapshot.Contents (hash, ()) -> let key = index hash in - `Contents (key, m) + `Contents (key, ()) | Node hash -> let key = index hash in `Node key ) @@ -1869,7 +1853,6 @@ struct type hash = H.t [@@deriving brassaia] type key = Key.t type t = T.key Bin.t [@@deriving brassaia] - type metadata = T.metadata [@@deriving brassaia] type Pack_value.kinded += Node of t let to_kinded t = Node t @@ -1950,10 +1933,10 @@ struct { index = n.index; hash } in let value : T.step * T.value -> Compress.value = function - | s, `Contents (c, m) -> + | s, `Contents (c, ()) -> let s = step s in let v = address_of_key c in - Compress.Contents (s, v, m) + Compress.Contents (s, v, ()) | s, `Node n -> let s = step s in let v = address_of_key n in @@ -1999,10 +1982,10 @@ struct { index = n.index; vref } in let value : Compress.value -> T.step * T.value = function - | Contents (n, h, metadata) -> + | Contents (n, h, ()) -> let name = step n in let hash = key h in - (name, `Contents (hash, metadata)) + (name, `Contents (hash, ())) | Node (n, h) -> let name = step n in let hash = key h in @@ -2045,7 +2028,7 @@ struct | Values ls -> List.map (function - | Compress.Contents (_, address, _) | Node (_, address) -> + | Compress.Contents (_, address, ()) | Node (_, address) -> entry_of_address address) ls | Tree { entries; _ } -> @@ -2059,9 +2042,9 @@ struct fun (name, v) -> let step = step_to_bin name in match v with - | `Contents (contents_key, m) -> + | `Contents (contents_key, ()) -> let h = Key.to_hash contents_key in - { Snapshot.step; hash = Contents (h, m) } + { Snapshot.step; hash = Contents (h, ()) } | `Node node_key -> let h = Key.to_hash node_key in { step; hash = Node h } @@ -2331,15 +2314,14 @@ struct let contents_key_encoding = hash_encoding - type value = [ `Contents of hash * metadata | `Node of hash ] + type value = [ `Contents of hash * unit | `Node of hash ] [@@deriving brassaia] let value_encoding = let open Data_encoding in union [ - case (Tag 1) ~title:"`Contents" - (tup2 hash_encoding metadata_encoding) + case (Tag 1) ~title:"`Contents" (tup2 hash_encoding unit) (function `Contents t -> Some t | _ -> None) (fun t -> `Contents t); case (Tag 2) ~title:"`Node" hash_encoding @@ -2449,7 +2431,6 @@ module Make (Inter : Internal with type hash = H.t and type key = Key.t - and type Snapshot.metadata = Node.metadata and type Val.step = Node.step) (Pack : Indexable.S with type hash = H.t diff --git a/brassaia/lib_brassaia_pack/inode_intf.ml b/brassaia/lib_brassaia_pack/inode_intf.ml index 93150bb8af93..367ec56db0d1 100644 --- a/brassaia/lib_brassaia_pack/inode_intf.ml +++ b/brassaia/lib_brassaia_pack/inode_intf.ml @@ -26,9 +26,8 @@ end module type Snapshot = sig type hash - type metadata - type kinded_hash = Contents of hash * metadata | Node of hash + type kinded_hash = Contents of hash * unit | Node of hash [@@deriving brassaia] type entry = { step : string; hash : kinded_hash } [@@deriving brassaia] @@ -61,7 +60,6 @@ module type Value = sig with type node := t and type hash = hash and type step := step - and type metadata := metadata val nb_children : t -> int @@ -105,14 +103,13 @@ end module type Compress = sig type step type hash - type metadata type dict_key = int type pack_offset = int63 type name = Indirect of dict_key | Direct of step type address = Offset of pack_offset | Hash of hash type ptr = { index : dict_key; hash : address } type tree = { depth : dict_key; length : dict_key; entries : ptr list } - type value = Contents of name * address * metadata | Node of name * address + type value = Contents of name * address * unit | Node of name * address type v = Values of value list | Tree of tree type v1 = { mutable length : int; v : v } @@ -137,11 +134,7 @@ module type Internal = sig module Raw : Raw with type hash = hash and type key = key module Val : sig - include - Value - with type hash = hash - and type key = key - and type metadata = Snapshot.metadata + include Value with type hash = hash and type key = key val of_raw : (expected_depth:int -> key -> Raw.t option) -> Raw.t -> t val to_raw : t -> Raw.t @@ -167,7 +160,7 @@ module type Internal = sig (** The type for pointer kinds. *) type kinded_key = | Contents of contents_key - | Contents_x of metadata * contents_key + | Contents_x of unit * contents_key | Node of node_key [@@deriving brassaia] @@ -236,12 +229,7 @@ module type Internal = sig val to_snapshot : Raw.t -> Snapshot.inode - module Compress : - Compress - with type hash := hash - and type step := Val.step - and type metadata := Val.metadata - + module Compress : Compress with type hash := hash and type step := Val.step module Child_ordering : Child_ordering with type step := Val.step end @@ -269,7 +257,6 @@ module type Sigs = sig Internal with type hash = H.t and type key = Key.t - and type Snapshot.metadata = Node.metadata and type Val.step = Node.step module Make @@ -282,7 +269,6 @@ module type Sigs = sig (Inter : Internal with type hash = H.t and type key = Key.t - and type Snapshot.metadata = Node.metadata and type Val.step = Node.step) (Pack : Indexable.S with type key = Key.t @@ -292,7 +278,6 @@ module type Sigs = sig with type 'a t = 'a Pack.t and type key = Key.t and type hash = H.t - and type Val.metadata = Node.metadata and type Val.step = Node.step and type value = Inter.Val.t end diff --git a/brassaia/lib_brassaia_pack/mem/brassaia_pack_mem.ml b/brassaia/lib_brassaia_pack/mem/brassaia_pack_mem.ml index 5af456712e91..7c15611b44ef 100644 --- a/brassaia/lib_brassaia_pack/mem/brassaia_pack_mem.ml +++ b/brassaia/lib_brassaia_pack/mem/brassaia_pack_mem.ml @@ -46,7 +46,6 @@ module Maker (Config : Brassaia_pack.Conf.S) = struct module H = Schema.Hash module C = Schema.Contents module P = Schema.Path - module M = Schema.Metadata module B = Schema.Branch module Pack = Indexable.Maker (H) @@ -85,7 +84,6 @@ module Maker (Config : Brassaia_pack.Conf.S) = struct include Brassaia.Node.Generic_key.Store (Contents) (Indexable) (H) (Indexable.Val) - (M) (P) end diff --git a/brassaia/lib_brassaia_pack/unix/brassaia_pack_unix.ml b/brassaia/lib_brassaia_pack/unix/brassaia_pack_unix.ml index 8188ebffd7b3..395b858e306e 100644 --- a/brassaia/lib_brassaia_pack/unix/brassaia_pack_unix.ml +++ b/brassaia/lib_brassaia_pack/unix/brassaia_pack_unix.ml @@ -26,9 +26,6 @@ module KV (Config : Brassaia_pack.Conf.S) = struct include Pack_key.Store_spec module Maker = Maker (Config) - - type metadata = Brassaia.Metadata.None.t - module Make (C : Brassaia.Contents.S) = Maker.Make (Brassaia.Schema.KV (C)) end diff --git a/brassaia/lib_brassaia_pack/unix/inode.ml b/brassaia/lib_brassaia_pack/unix/inode.ml index ff8c2b1fb1d4..d6a9fdcdbf9f 100644 --- a/brassaia/lib_brassaia_pack/unix/inode.ml +++ b/brassaia/lib_brassaia_pack/unix/inode.ml @@ -26,7 +26,6 @@ module Make_persistent (Inter : Internal with type hash = H.t and type key = H.t Pack_key.t - and type Snapshot.metadata = Node.metadata and type Val.step = Node.step) (Pack : Pack_store.S with type hash = H.t diff --git a/brassaia/lib_brassaia_pack/unix/inode_intf.ml b/brassaia/lib_brassaia_pack/unix/inode_intf.ml index 85ab9f8deac8..5d628e69e6d8 100644 --- a/brassaia/lib_brassaia_pack/unix/inode_intf.ml +++ b/brassaia/lib_brassaia_pack/unix/inode_intf.ml @@ -52,8 +52,7 @@ module type Persistent = sig and type hash := hash and type key := hash Pack_key.t - module Snapshot : - Snapshot with type hash = hash and type metadata = Val.metadata + module Snapshot : Snapshot with type hash = hash val to_snapshot : Raw.t -> Snapshot.inode val of_snapshot : 'a t -> index:(hash -> key) -> Snapshot.inode -> value @@ -77,7 +76,6 @@ module type Sigs = sig (Inter : Internal with type hash = H.t and type key = H.t Pack_key.t - and type Snapshot.metadata = Node.metadata and type Val.step = Node.step) (Pack : Pack_store.S with type hash = H.t @@ -86,7 +84,6 @@ module type Sigs = sig Persistent with type key = H.t Pack_key.t and type hash = H.t - and type Val.metadata = Node.metadata and type Val.step = Node.step and type file_manager = Pack.file_manager and type dict = Pack.dict diff --git a/brassaia/lib_brassaia_pack/unix/store.ml b/brassaia/lib_brassaia_pack/unix/store.ml index ecc3f879eb70..d3b456af2548 100644 --- a/brassaia/lib_brassaia_pack/unix/store.ml +++ b/brassaia/lib_brassaia_pack/unix/store.ml @@ -25,7 +25,6 @@ module Maker (Config : Conf.S) = struct module Make (Schema : Brassaia.Schema.Extended) = struct open struct module P = Schema.Path - module M = Schema.Metadata module C = Schema.Contents module B = Schema.Branch end @@ -69,8 +68,7 @@ module Maker (Config : Conf.S) = struct include Inode.Make_persistent (H) (Value) (Inter) (Pack') end - include - Brassaia.Node.Generic_key.Store (Contents) (CA) (H) (CA.Val) (M) (P) + include Brassaia.Node.Generic_key.Store (Contents) (CA) (H) (CA.Val) (P) end module Node_portable = Node.CA.Val.Portable diff --git a/brassaia/lib_brassaia_pack/unix/store_intf.ml b/brassaia/lib_brassaia_pack/unix/store_intf.ml index d1d7e1f1ac0a..ea584c81d99a 100644 --- a/brassaia/lib_brassaia_pack/unix/store_intf.ml +++ b/brassaia/lib_brassaia_pack/unix/store_intf.ml @@ -217,7 +217,7 @@ module type S = sig (** {1 Snapshots} *) module Snapshot : sig - type kinded_hash = Contents of hash * metadata | Node of hash + type kinded_hash = Contents of hash * unit | Node of hash [@@deriving brassaia] type entry = { step : string; hash : kinded_hash } [@@deriving brassaia] @@ -341,7 +341,6 @@ module type Maker = sig TODO: extract these extensions as a separate functor argument instead. *) with type Schema.Hash.t = Schema.Hash.t and type Schema.Branch.t = Schema.Branch.t - and type Schema.Metadata.t = Schema.Metadata.t and type Schema.Path.t = Schema.Path.t and type Schema.Path.step = Schema.Path.step and type Schema.Contents.t = Schema.Contents.t @@ -361,12 +360,9 @@ module type KV = sig include Pack_key.Store_spec - type metadata = Brassaia.Metadata.None.t - module Make (C : Brassaia.Contents.S) : S with module Schema.Contents = C - and type Schema.Metadata.t = metadata and type Backend.Remote.endpoint = endpoint and type Schema.Hash.t = hash and type contents_key = (hash, C.t) contents_key diff --git a/brassaia/lib_brassaia_tezos/brassaia_tezos.mli b/brassaia/lib_brassaia_tezos/brassaia_tezos.mli index dd666a34f735..85d412f18f85 100644 --- a/brassaia/lib_brassaia_tezos/brassaia_tezos.mli +++ b/brassaia/lib_brassaia_tezos/brassaia_tezos.mli @@ -21,7 +21,6 @@ module Store : Brassaia_pack_unix.S with type Schema.Hash.t = Schema.Hash.t and type Schema.Branch.t = Schema.Branch.t - and type Schema.Metadata.t = Schema.Metadata.t and type Schema.Path.t = Schema.Path.t and type Schema.Path.step = Schema.Path.step and type Schema.Contents.t = Schema.Contents.t diff --git a/brassaia/lib_brassaia_tezos/schema.ml b/brassaia/lib_brassaia_tezos/schema.ml index 06d2766ae7d4..9b58237d33b4 100644 --- a/brassaia/lib_brassaia_tezos/schema.ml +++ b/brassaia/lib_brassaia_tezos/schema.ml @@ -15,7 +15,6 @@ *) module Path = Brassaia.Path.String_list -module Metadata = Brassaia.Metadata.None module Branch = Brassaia.Branch.String module Hash : Brassaia.Hash.S = struct @@ -67,8 +66,7 @@ module Node (Node_key : Brassaia.Key.S with type hash = Hash.t) = struct module M = - Brassaia.Node.Generic_key.Make (Hash) (Path) (Metadata) (Contents_key) - (Node_key) + Brassaia.Node.Generic_key.Make (Hash) (Path) (Contents_key) (Node_key) (* [V1] is only used to compute preimage hashes. [assert false] statements should be unreachable.*) @@ -86,6 +84,11 @@ struct be the case for all filenames ever produced by Brassaia 1.4. *) let step_t = Brassaia.Type.string + let hash_of_entry (_, t) = + match t with + | `Node h -> Node_key.to_hash h + | `Contents (h, ()) -> Contents_key.to_hash h + let metadata_t = let some = "\255\000\000\000\000\000\000\000" in let none = "\000\000\000\000\000\000\000\000" in @@ -94,12 +97,7 @@ struct (function Some _ -> some | None -> none) let metadata_of_entry (_, t) = - match t with `Node _ -> None | `Contents (_, m) -> Some m - - let hash_of_entry (_, t) = - match t with - | `Node h -> Node_key.to_hash h - | `Contents (h, _) -> Contents_key.to_hash h + match t with `Node _ -> None | `Contents _ -> Some () (* Brassaia 1.4 uses int64 to store list lengths *) let entry_t : entry Brassaia.Type.t = diff --git a/brassaia/lib_brassaia_tezos/schema.mli b/brassaia/lib_brassaia_tezos/schema.mli index a1edb78990bc..a7ac48abf02c 100644 --- a/brassaia/lib_brassaia_tezos/schema.mli +++ b/brassaia/lib_brassaia_tezos/schema.mli @@ -17,7 +17,6 @@ include Brassaia.Schema.Extended with type Contents.t = bytes - and type Metadata.t = unit and type Path.t = string list and type Path.step = string and type Branch.t = string diff --git a/brassaia/test/brassaia-mem/test_mem.ml b/brassaia/test/brassaia-mem/test_mem.ml index 479067e1cbae..e57e7fecd5fa 100644 --- a/brassaia/test/brassaia-mem/test_mem.ml +++ b/brassaia/test/brassaia-mem/test_mem.ml @@ -14,11 +14,7 @@ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *) -let store = - Brassaia_test_helpers.Brassaia_test.store - (module Brassaia_mem) - (module Brassaia.Metadata.None) - +let store = Brassaia_test_helpers.Brassaia_test.store (module Brassaia_mem) let config = Brassaia_mem.config () let init ~config:_ = Lwt.return_unit diff --git a/brassaia/test/brassaia-pack/common.ml b/brassaia/test/brassaia-pack/common.ml index 389ad9b6ac14..08f1a8f0b347 100644 --- a/brassaia/test/brassaia-pack/common.ml +++ b/brassaia/test/brassaia-pack/common.ml @@ -39,12 +39,11 @@ module Conf = Brassaia_tezos.Conf module Schema = struct open Brassaia - module Metadata = Metadata.None module Contents = Contents.String_v2 module Path = Path.String_list module Branch = Branch.String module Hash = Hash.SHA1 - module Node = Node.Generic_key.Make_v2 (Hash) (Path) (Metadata) + module Node = Node.Generic_key.Make_v2 (Hash) (Path) module Commit = Commit.Generic_key.Make_v2 (Hash) module Info = Info.Default end diff --git a/brassaia/test/brassaia-pack/common.mli b/brassaia/test/brassaia-pack/common.mli index 31d2d5ba8105..e9dd7b835794 100644 --- a/brassaia/test/brassaia-pack/common.mli +++ b/brassaia/test/brassaia-pack/common.mli @@ -33,7 +33,6 @@ module Schema : and type Path.t = string list and type Branch.t = string and type Contents.t = string - and type Metadata.t = unit module Filename : sig include module type of Filename diff --git a/brassaia/test/brassaia-pack/data/version_1_large/README.md b/brassaia/test/brassaia-pack/data/version_1_large/README.md index 35fc216907d5..99b08f0a93b0 100644 --- a/brassaia/test/brassaia-pack/data/version_1_large/README.md +++ b/brassaia/test/brassaia-pack/data/version_1_large/README.md @@ -16,7 +16,7 @@ let rm_dir () = module Conf = Irmin_tezos.Conf module Store = - Irmin_pack.V1 (Conf) (Irmin.Metadata.None) (Irmin.Contents.String) + Irmin_pack.V1 (Conf) (Irmin.Contents.String) (Irmin.Path.String_list) (Irmin.Branch.String) (Irmin.Hash.SHA1) diff --git a/brassaia/test/brassaia-pack/test_existing_stores.ml b/brassaia/test/brassaia-pack/test_existing_stores.ml index cdafe38bb048..b7a1c343b3ab 100644 --- a/brassaia/test/brassaia-pack/test_existing_stores.ml +++ b/brassaia/test/brassaia-pack/test_existing_stores.ml @@ -95,12 +95,11 @@ module V2_maker = Brassaia_pack_unix.Maker (Conf) module Schema_v2 = struct open Brassaia - module Metadata = Metadata.None module Contents = Contents.String_v2 module Path = Path.String_list module Branch = Branch.String module Hash = Hash.SHA1 - module Node = Node.Generic_key.Make_v2 (Hash) (Path) (Metadata) + module Node = Node.Generic_key.Make_v2 (Hash) (Path) module Commit = Commit.Generic_key.Make_v2 (Hash) module Info = Info.Default end diff --git a/brassaia/test/brassaia-pack/test_hashes.ml b/brassaia/test/brassaia-pack/test_hashes.ml index b7286b3e1519..ba31f7af463b 100644 --- a/brassaia/test/brassaia-pack/test_hashes.ml +++ b/brassaia/test/brassaia-pack/test_hashes.ml @@ -49,7 +49,6 @@ module Test (Conf : Brassaia_pack.Conf.S) (Schema : Brassaia.Schema.Extended with type Contents.t = bytes - and type Metadata.t = unit and type Path.t = string list and type Path.step = string and type Branch.t = string diff --git a/brassaia/test/brassaia-pack/test_inode.ml b/brassaia/test/brassaia-pack/test_inode.ml index fbe4fc29047c..b66a42056e8b 100644 --- a/brassaia/test/brassaia-pack/test_inode.ml +++ b/brassaia/test/brassaia-pack/test_inode.ml @@ -38,10 +38,7 @@ struct module Key = Brassaia_pack_unix.Pack_key.Make (Schema.Hash) module Node = - Brassaia.Node.Generic_key.Make_v2 (Schema.Hash) (Schema.Path) - (Schema.Metadata) - (Key) - (Key) + Brassaia.Node.Generic_key.Make_v2 (Schema.Hash) (Schema.Path) (Key) (Key) module Index = Brassaia_pack_unix.Index.Make (Schema.Hash) @@ -195,7 +192,7 @@ let pp_pred = Brassaia.Type.pp pred_t module H_contents = Brassaia.Hash.Typed (Hash) (Schema.Contents) -let normal x = `Contents (x, Metadata.default) +let normal x = `Contents (x, ()) let node x = `Node x let check_hash = Alcotest.check_repr Inode.Val.hash_t let check_values = Alcotest.check_repr Inode.Val.t diff --git a/brassaia/test/brassaia-pack/test_lower.ml b/brassaia/test/brassaia-pack/test_lower.ml index 82e7cd27671c..b77a9b49a4a0 100644 --- a/brassaia/test/brassaia-pack/test_lower.ml +++ b/brassaia/test/brassaia-pack/test_lower.ml @@ -476,7 +476,7 @@ module Store_tc = struct let key_identifier = match kinded_key with | None -> assert false - | Some (`Contents (k, _)) -> get_volume_identifier k + | Some (`Contents (k, ())) -> get_volume_identifier k | Some (`Node k) -> get_volume_identifier k in [%log.debug "identifier: %s" key_identifier]; diff --git a/brassaia/test/brassaia-pack/test_pack.ml b/brassaia/test/brassaia-pack/test_pack.ml index 0a149307adee..4fabf42ab33f 100644 --- a/brassaia/test/brassaia-pack/test_pack.ml +++ b/brassaia/test/brassaia-pack/test_pack.ml @@ -25,7 +25,7 @@ module Brassaia_pack_store (Config : Brassaia_pack.Conf.S) : include Make (struct include Brassaia_test.Schema - module Node = Brassaia.Node.Generic_key.Make (Hash) (Path) (Metadata) + module Node = Brassaia.Node.Generic_key.Make (Hash) (Path) module Commit_maker = Brassaia.Commit.Generic_key.Maker (Info) module Commit = Commit_maker.Make (Hash) end) @@ -62,7 +62,7 @@ module Brassaia_pack_mem_maker : Brassaia_test.Generic_key = struct include Make (struct include Brassaia_test.Schema - module Node = Brassaia.Node.Generic_key.Make (Hash) (Path) (Metadata) + module Node = Brassaia.Node.Generic_key.Make (Hash) (Path) module Commit_maker = Brassaia.Commit.Generic_key.Maker (Info) module Commit = Commit_maker.Make (Hash) end) diff --git a/brassaia/test/brassaia-pack/test_readonly.ml b/brassaia/test/brassaia-pack/test_readonly.ml index 69127ec66a96..d9905fb155f7 100644 --- a/brassaia/test/brassaia-pack/test_readonly.ml +++ b/brassaia/test/brassaia-pack/test_readonly.ml @@ -99,7 +99,7 @@ let ro_reload_after_close () = rm_dir root; let* rw = S.Repo.init (config ~readonly:false ~fresh:true root) in let* ro = S.Repo.init (config ~readonly:true ~fresh:false root) in - let tree = binding (S.Tree.singleton ?metadata:None) in + let tree = binding S.Tree.singleton in let* c1 = S.Commit.init rw ~parents:[] ~info:(info ()) tree in S.Repo.close rw >>= fun () -> S.reload ro; diff --git a/brassaia/test/brassaia/test_tree.ml b/brassaia/test/brassaia/test_tree.ml index 92e39fa13565..61b09e56e9d3 100644 --- a/brassaia/test/brassaia/test_tree.ml +++ b/brassaia/test/brassaia/test_tree.ml @@ -17,37 +17,12 @@ open Brassaia.Export_for_backends open Brassaia -module Metadata = struct - type t = Default | Left | Right [@@deriving brassaia] - - let encoding = - let open Data_encoding in - union - [ - case (Tag 1) ~title:"Default" empty - (function Default -> Some () | _ -> None) - (fun () -> Default); - case (Tag 2) ~title:"Left" empty - (function Left -> Some () | _ -> None) - (fun () -> Left); - case (Tag 3) ~title:"Right" empty - (function Right -> Some () | _ -> None) - (fun () -> Right); - ] - - let merge = - Merge.init t (fun ~old:_ _ _ -> Merge.conflict "Can't merge metadata") - - let default = Default -end - module Schema = struct - module Metadata = Metadata module Contents = Contents.String module Path = Path.String_list module Branch = Branch.String module Hash = Hash.BLAKE2B - module Node = Node.Generic_key.Make (Hash) (Path) (Metadata) + module Node = Node.Generic_key.Make (Hash) (Path) module Commit = Commit.Make (Hash) module Info = Info.Default end @@ -56,7 +31,7 @@ module Store = Brassaia_mem.Make (Schema) module Tree = Store.Tree open Schema -type diffs = (string list * (Contents.t * Metadata.t) Diff.t) list +type diffs = (string list * (Contents.t * unit) Diff.t) list [@@deriving brassaia] type kind = [ `Contents | `Node ] [@@deriving brassaia] @@ -105,7 +80,7 @@ let ( let&* ) x f = Lwt_list.iter_s f x and ( and&* ) l m = List.concat_map (fun a -> List.map (fun b -> (a, b)) m) l let ( >> ) f g x = g (f x) -let c ?(info = Metadata.default) blob = `Contents (blob, info) +let c blob = `Contents (blob, ()) let invalid_tree () = let+ repo = Store.Repo.init (Brassaia_mem.config ()) in @@ -173,22 +148,16 @@ let test_diff _ () = Tree.diff empty single >|= Alcotest.(check diffs) "Added [k \226\134\146 v]" - [ ([ "k" ], `Added ("v", Default)) ] + [ ([ "k" ], `Added ("v", ())) ] in (* Removing a single key *) let* () = Tree.diff single empty >|= Alcotest.(check diffs) "Removed [k \226\134\146 v]" - [ ([ "k" ], `Removed ("v", Default)) ] + [ ([ "k" ], `Removed ("v", ())) ] in - (* Changing metadata *) - Tree.diff - (tree [ ("k", c ~info:Left "v") ]) - (tree [ ("k", c ~info:Right "v") ]) - >|= Alcotest.(check diffs) - "Changed metadata" - [ ([ "k" ], `Updated (("v", Left), ("v", Right))) ] + Lwt.return_unit let test_empty _ () = let* () = @@ -319,9 +288,8 @@ let transform_once : type a b. a Type.t -> a -> b -> a -> b = let test_update _ () = let unrelated_binding = ("a_unrelated", c "<>") in - let abc ?info v = - `Tree - [ ("a", `Tree [ ("b", `Tree [ ("c", c ?info v) ]) ]); unrelated_binding ] + let abc v = + `Tree [ ("a", `Tree [ ("b", `Tree [ ("c", c v) ]) ]); unrelated_binding ] in let abc1 = Tree.of_concrete (abc "1") in let ( --> ) = transform_once [%typ: string option] in @@ -344,9 +312,9 @@ let test_update _ () = let* () = Alcotest.check_tree_lwt "Updating a root node to a contents value removes all bindings and sets \ - the correct metadata." - ~expected:(c ~info:Metadata.Right "2") - (Tree.update ~metadata:Metadata.Right abc1 [] (None --> Some "2")) + the correct." + ~expected:(c "2") + (Tree.update abc1 [] (None --> Some "2")) in let* () = @@ -388,14 +356,6 @@ let test_update _ () = (abc1 == abc1') in - let* () = - Alcotest.check_tree_lwt - "Changing the metadata of an existing contents value updates the tree." - ~expected:(abc ~info:Metadata.Left "1") - (Tree.update ~metadata:Metadata.Left abc1 [ "a"; "b"; "c" ] - (Some "1" --> Some "1")) - in - let* () = Alcotest.check_tree_lwt "Removing a siblingless contents value causes newly-empty directories to \ @@ -678,7 +638,7 @@ module Broken = struct let random_contents () = let value = Tree.of_concrete (c (random_string32 ())) in - let value_ptr = `Contents (Tree.hash value, Metadata.default) in + let value_ptr = `Contents (Tree.hash value, ()) in (value, value_ptr) let random_node () = diff --git a/brassaia/test/helpers/brassaia_test.mli b/brassaia/test/helpers/brassaia_test.mli index f2c80271bbcb..a92b1b0d00c7 100644 --- a/brassaia/test/helpers/brassaia_test.mli +++ b/brassaia/test/helpers/brassaia_test.mli @@ -55,9 +55,7 @@ val line : string -> unit module Schema = Common.Schema -val store : - (module Brassaia.Maker) -> (module Brassaia.Metadata.S) -> (module S) - +val store : (module Brassaia.Maker) -> (module S) val testable : 'a Brassaia.Type.t -> 'a Alcotest.testable val check : 'a Brassaia.Type.t -> string -> 'a -> 'a -> unit val checks : 'a Brassaia.Type.t -> string -> 'a list -> 'a list -> unit diff --git a/brassaia/test/helpers/common.ml b/brassaia/test/helpers/common.ml index 0f6821f5b706..0f09d20f27fd 100644 --- a/brassaia/test/helpers/common.ml +++ b/brassaia/test/helpers/common.ml @@ -52,20 +52,17 @@ module Schema = struct module Hash = Brassaia.Hash.SHA1 module Commit = Brassaia.Commit.Make (Hash) module Path = Brassaia.Path.String_list - module Metadata = Brassaia.Metadata.None - module Node = Brassaia.Node.Generic_key.Make (Hash) (Path) (Metadata) + module Node = Brassaia.Node.Generic_key.Make (Hash) (Path) module Branch = Brassaia.Branch.String module Info = Brassaia.Info.Default module Contents = Brassaia.Contents.String end -let store : - (module Brassaia.Maker) -> (module Brassaia.Metadata.S) -> (module S) = - fun (module B) (module M) -> +let store : (module Brassaia.Maker) -> (module S) = + fun (module B) -> let module Schema = struct include Schema - module Metadata = M - module Node = Brassaia.Node.Generic_key.Make (Hash) (Path) (Metadata) + module Node = Brassaia.Node.Generic_key.Make (Hash) (Path) end in let module S = B.Make (Schema) in (module S) @@ -169,7 +166,7 @@ module Make_helpers (S : Generic_key) = struct let with_info repo n f = with_commit repo (fun h -> f h ~info:(info n)) let kv1 ~repo = with_contents repo (fun t -> B.Contents.add t v1) let kv2 ~repo = with_contents repo (fun t -> B.Contents.add t v2) - let normal x = `Contents (x, S.Metadata.default) + let normal x = `Contents (x, ()) let b1 = "foo" let b2 = "bar/toto" diff --git a/brassaia/test/helpers/node.ml b/brassaia/test/helpers/node.ml index 833fc6cca553..b919a142590e 100644 --- a/brassaia/test/helpers/node.ml +++ b/brassaia/test/helpers/node.ml @@ -113,7 +113,7 @@ end = struct module Schema = Brassaia.Schema.KV (Brassaia.Contents.String) module Hash = Schema.Hash module Key = Brassaia.Key.Of_hash (Hash) - module Node = Make_node (Hash) (Schema.Path) (Schema.Metadata) (Key) (Key) + module Node = Make_node (Hash) (Schema.Path) (Key) (Key) type key = Key.t [@@deriving brassaia] diff --git a/brassaia/test/helpers/store.ml b/brassaia/test/helpers/store.ml index 36301e739a5b..8fabd131a6e6 100644 --- a/brassaia/test/helpers/store.ml +++ b/brassaia/test/helpers/store.ml @@ -74,7 +74,7 @@ module Make (S : Generic_key) = struct in may repo heads hook - let contents c = S.Tree.init (`Contents (c, S.Metadata.default)) + let contents c = S.Tree.init (`Contents (c, ())) let test_contents x () = let test repo = @@ -483,7 +483,7 @@ module Make (S : Generic_key) = struct Lwt_list.fold_left_s (fun t (k, v) -> let* v = with_contents repo (fun t -> B.Contents.add t v) in - Graph.add g t k (`Contents (v, S.Metadata.default))) + Graph.add g t k (`Contents (v, ()))) empty bindings) in let tree bindings = @@ -1108,7 +1108,7 @@ module Make (S : Generic_key) = struct let pp_depth = Brassaia.Type.pp S.Tree.depth_t let pp_key = Brassaia.Type.pp S.Path.t - let contents_t = T.pair S.contents_t S.metadata_t + let contents_t = T.pair S.contents_t Repr.unit let diff_t = T.(pair S.path_t (Brassaia.Diff.t contents_t)) let check_diffs = checks diff_t let check_ls = checks T.(pair S.step_t S.tree_t) @@ -1209,13 +1209,13 @@ module Make (S : Generic_key) = struct node; (* Testing [Tree.diff] *) - let contents_t = T.pair S.contents_t S.metadata_t in + let contents_t = T.pair S.contents_t Repr.unit in let diff = T.(pair S.path_t (Brassaia.Diff.t contents_t)) in let check_diffs = checks diff in let check_val = check T.(option contents_t) in let check_ls = checks T.(pair S.step_t S.tree_t) in - let normal c = Some (c, S.Metadata.default) in - let d0 = S.Metadata.default in + let normal c = Some (c, ()) in + let d0 = () in let v0 = S.Tree.empty () in let v1 = S.Tree.empty () in let v2 = S.Tree.empty () in @@ -1261,7 +1261,7 @@ module Make (S : Generic_key) = struct (* Testing paginated lists *) let tree = - let c ?(info = S.Metadata.default) blob = `Contents (blob, info) in + let c ?(info = ()) blob = `Contents (blob, info) in S.Tree.of_concrete (`Tree [ @@ -1683,12 +1683,9 @@ module Make (S : Generic_key) = struct (* check env sharing *) let tree () = - S.Tree.of_concrete - (`Tree [ ("foo", `Contents ("bar", S.Metadata.default)) ]) - in - let contents () = - S.Tree.of_concrete (`Contents ("bar", S.Metadata.default)) + S.Tree.of_concrete (`Tree [ ("foo", `Contents ("bar", ())) ]) in + let contents () = S.Tree.of_concrete (`Contents ("bar", ())) in let check_env_empty msg t b = let env = S.Tree.Private.get_env t in Alcotest.(check bool) msg b (S.Tree.Private.Env.is_empty env) @@ -1767,8 +1764,8 @@ module Make (S : Generic_key) = struct Blinded_node wrong_hash; Node []; Inode { length = 1024; proofs = [] }; - Blinded_contents (wrong_hash, S.Metadata.default); - Contents ("yo", S.Metadata.default); + Blinded_contents (wrong_hash, ()); + Contents ("yo", ()); ] in let* () = @@ -2333,10 +2330,7 @@ module Make (S : Generic_key) = struct let* node_3 = let+ contents_foo = contents "foo" in S.Backend.Node.Val.of_list - [ - ("foo", `Contents (contents_foo, S.Metadata.default)); - ("bar", `Node bar_k); - ] + [ ("foo", `Contents (contents_foo, ())); ("bar", `Node bar_k) ] in let tree_3 = S.Tree.of_node (S.of_backend_node repo node_3) in let* _ = diff --git a/brassaia/test/helpers/store_graph.ml b/brassaia/test/helpers/store_graph.ml index 23dea20517be..55938279bfa5 100644 --- a/brassaia/test/helpers/store_graph.ml +++ b/brassaia/test/helpers/store_graph.ml @@ -44,7 +44,7 @@ module Make (S : Generic_key) = struct Lwt.return_unit in let contents ?order k = - let e = `Contents (k, S.Metadata.default) in + let e = `Contents (k, ()) in if mem e !visited then Alcotest.failf "contents %a visited twice" (Brassaia.Type.pp B.Contents.Key.t) @@ -114,7 +114,7 @@ module Make (S : Generic_key) = struct in let test1 () = let* foo = with_contents repo (fun c -> B.Contents.add c "foo") in - let foo_k = (foo, S.Metadata.default) in + let foo_k = (foo, ()) in let* k1 = with_node repo (fun g -> Graph.init g [ ("b", normal foo) ]) in @@ -142,7 +142,7 @@ module Make (S : Generic_key) = struct (* Graph.iter requires a node as max, we cannot test a graph with only contents. *) let* foo = with_contents repo (fun c -> B.Contents.add c "foo") in - let foo_k = (foo, S.Metadata.default) in + let foo_k = (foo, ()) in let* k1 = with_node repo (fun g -> Graph.init g [ ("b", normal foo) ]) in @@ -157,7 +157,7 @@ module Make (S : Generic_key) = struct in let test3 () = let* foo = with_contents repo (fun c -> B.Contents.add c "foo") in - let foo_k = (foo, S.Metadata.default) in + let foo_k = (foo, ()) in let* kb1 = with_node repo (fun g -> Graph.init g [ ("b1", normal foo) ]) in diff --git a/src/lib_context_brassaia/encoding/context.ml b/src/lib_context_brassaia/encoding/context.ml index 37c1f31094a4..41bc43e95667 100644 --- a/src/lib_context_brassaia/encoding/context.ml +++ b/src/lib_context_brassaia/encoding/context.ml @@ -24,7 +24,6 @@ (*****************************************************************************) module Path = Brassaia.Path.String_list -module Metadata = Brassaia.Metadata.None module Branch = Brassaia.Branch.String module Conf = struct @@ -113,8 +112,7 @@ module Node (Node_key : Brassaia.Key.S with type hash = Hash.t) = struct module M = - Brassaia.Node.Generic_key.Make (Hash) (Path) (Metadata) (Contents_key) - (Node_key) + Brassaia.Node.Generic_key.Make (Hash) (Path) (Contents_key) (Node_key) (* [V1] is only used to compute preimage hashes. [assert false] statements should be unreachable.*) @@ -135,12 +133,12 @@ struct (function Some _ -> some | None -> none) let metadata_of_entry (_, t) = - match t with `Node _ -> None | `Contents (_, m) -> Some m + match t with `Node _ -> None | `Contents _ -> Some () let hash_of_entry (_, t) = match t with | `Node h -> Node_key.to_hash h - | `Contents (h, _) -> Contents_key.to_hash h + | `Contents (h, ()) -> Contents_key.to_hash h (* Brassaia 1.4 uses int64 to store list lengths *) let entry_t : entry Brassaia.Type.t = @@ -208,7 +206,6 @@ module Schema = struct module Hash = Hash module Branch = Branch module Info = Info - module Metadata = Metadata module Path = Path module Contents = Contents module Node = Node diff --git a/src/lib_context_brassaia/encoding/context.mli b/src/lib_context_brassaia/encoding/context.mli index a3539d6fa5b1..bd6f3411fee5 100644 --- a/src/lib_context_brassaia/encoding/context.mli +++ b/src/lib_context_brassaia/encoding/context.mli @@ -40,7 +40,6 @@ module Conf : Brassaia_pack.Conf.S module Schema : Brassaia.Schema.Extended with type Contents.t = bytes - and type Metadata.t = unit and type Path.t = string list and type Path.step = string and type Branch.t = string diff --git a/src/lib_context_brassaia/memory/context.ml b/src/lib_context_brassaia/memory/context.ml index 606ad7ff5526..5ab92dca4eca 100644 --- a/src/lib_context_brassaia/memory/context.ml +++ b/src/lib_context_brassaia/memory/context.ml @@ -49,7 +49,7 @@ module Make (Encoding : module type of Tezos_context_encoding.Context) = struct open Encoding module Store = struct - module Maker = Brassaia_pack_mem.Maker (Conf) + module Maker = Brassaia_pack_mem.Maker (Encoding.Conf) include Maker.Make (Schema) module Schema = Tezos_context_encoding.Context.Schema end diff --git a/src/lib_shell/distributed_db_event.ml b/src/lib_shell/distributed_db_event.ml index c61051b5f663..fd183838f208 100644 --- a/src/lib_shell/distributed_db_event.ml +++ b/src/lib_shell/distributed_db_event.ml @@ -79,7 +79,7 @@ module P2p_reader_event = struct ~section ~name:"received_future_block" ~msg:"received future block {block_hash} from peer {peer_id}" - ~level:Notice + ~level:Info ("block_hash", Block_hash.encoding) ("peer_id", P2p_peer.Id.encoding) end -- GitLab From 21410bf032af37901343463b208329a53c4b646c Mon Sep 17 00:00:00 2001 From: mattiasdrp Date: Fri, 5 Jul 2024 13:38:47 +0200 Subject: [PATCH 2/2] Brassaia: Remove Metadata and some ppx deriving The ppx need to be manually implemented to stay coherent with the previous binary representations of some values that included metadatas --- brassaia/lib_brassaia/dot.ml | 2 +- brassaia/lib_brassaia/node.ml | 116 +++++----- brassaia/lib_brassaia/node_intf.ml | 4 +- brassaia/lib_brassaia/proof.ml | 44 +++- brassaia/lib_brassaia/proof_intf.ml | 8 +- brassaia/lib_brassaia/store.ml | 25 +-- brassaia/lib_brassaia/store_intf.ml | 8 +- brassaia/lib_brassaia/tree.ml | 208 +++++++++++------- brassaia/lib_brassaia/tree_intf.ml | 19 +- brassaia/lib_brassaia_pack/inode.ml | 108 +++++---- brassaia/lib_brassaia_pack/inode_intf.ml | 9 +- brassaia/lib_brassaia_pack/unix/store_intf.ml | 4 +- brassaia/lib_brassaia_tezos/schema.ml | 2 +- brassaia/test/brassaia-pack/test_inode.ml | 2 +- brassaia/test/brassaia-pack/test_lower.ml | 2 +- brassaia/test/brassaia-pack/test_tree.ml | 7 +- brassaia/test/brassaia-pack/test_upgrade.ml | 6 +- brassaia/test/brassaia/test_tree.ml | 12 +- brassaia/test/helpers/common.ml | 2 +- brassaia/test/helpers/node.ml | 13 +- brassaia/test/helpers/store.ml | 38 ++-- brassaia/test/helpers/store_graph.ml | 8 +- src/lib_context_brassaia/disk/context.ml | 2 +- src/lib_context_brassaia/encoding/context.ml | 2 +- src/lib_context_brassaia/helpers/context.ml | 28 +-- src/lib_context_brassaia/memory/context.ml | 8 +- 26 files changed, 385 insertions(+), 302 deletions(-) diff --git a/brassaia/lib_brassaia/dot.ml b/brassaia/lib_brassaia/dot.ml index c65d9e0bdd20..4f47819dce83 100644 --- a/brassaia/lib_brassaia/dot.ml +++ b/brassaia/lib_brassaia/dot.ml @@ -182,7 +182,7 @@ module Make (S : Store.Generic_key.S) = struct List.iter (fun (l, v) -> match v with - | `Contents (v, _meta) -> + | `Contents v -> let v = Contents.Key.to_hash v in add_edge (`Node k) [ `Style `Dotted; label_of_step l ] diff --git a/brassaia/lib_brassaia/node.ml b/brassaia/lib_brassaia/node.ml index 6948b9cb58bf..19170696df9d 100644 --- a/brassaia/lib_brassaia/node.ml +++ b/brassaia/lib_brassaia/node.ml @@ -39,25 +39,8 @@ module Of_core (S : Core) = struct (fun acc -> function k, `Node n -> (k, n) :: acc | _ -> acc) [] kvs - let merge = Merge.init Type.unit (fun ~old:_ () () -> Merge.ok ()) - - (* [Merge.alist] expects us to return an option. [C.merge] does - that, but we need to consider the metadata too... *) - let merge_metadata merge_contents = - (* This gets us [C.t option, S.Val.Metadata.t]. We want [(C.t * - S.Val.Metadata.t) option]. *) - let explode = function - | None -> (None, ()) - | Some (c, ()) -> (Some c, ()) - in - let implode = function None, _ -> None | Some c, () -> Some (c, ()) in - Merge.like [%typ: (S.contents_key * unit) option] - (Merge.pair merge_contents merge) - explode implode - let merge_contents merge_key = - Merge.alist S.step_t (Type.pair S.contents_key_t Type.unit) (fun _step -> - merge_metadata merge_key) + Merge.alist S.step_t S.contents_key_t (fun _step -> merge_key) let merge_node merge_key = Merge.alist S.step_t S.node_key_t (fun _step -> merge_key) @@ -108,12 +91,17 @@ struct type 'key contents_entry = { name : Path.step; contents : 'key } [@@deriving brassaia] - type 'key contents_m_entry = { - metadata : unit; - name : Path.step; - contents : 'key; - } - [@@deriving brassaia] + type 'key contents_m_entry = { name : Path.step; contents : 'key } + + (* Custom Repr encoding to be coherent with the previous binary + representation that included metadatas *) + let contents_m_entry_t key_t = + let open Type in + record "contents_m_entry" (fun () name contents -> { name; contents }) + |+ field "metadata" unit (fun _ -> ()) + |+ field "name" Path.step_t (fun cont -> cont.name) + |+ field "contents" key_t (fun cont -> cont.contents) + |> sealr module StepMap = struct include Map.Make (struct @@ -151,7 +139,19 @@ struct (fun l -> List.to_seq l |> StepMap.of_seq) Data_encoding.(list (tup2 StepMap.key_encoding entry_encoding)) - type value = [ `Node of node_key | `Contents of contents_key * unit ] + type value = [ `Node of node_key | `Contents of contents_key ] + + (* Custom Repr encoding to be coherent with the previous binary + representation that included metadatas *) + let value_t = + let open Type in + variant "value" (fun n c _ -> function + | `Node h -> n h | `Contents h -> c (h, ())) + |~ case1 "node" node_key_t (fun k -> `Node k) + |~ case1 "contents" (pair contents_key_t unit) (fun (h, ()) -> `Contents h) + |~ case1 "contents-x" (pair contents_key_t unit) (fun (h, ()) -> + `Contents h) + |> sealv let value_encoding = let open Data_encoding in @@ -162,12 +162,11 @@ struct (fun k -> `Node k); case (Tag 2) ~title:"`Contents" (tup2 contents_key_encoding unit) - (function `Contents k -> Some k | _ -> None) - (fun k -> `Contents k); + (function `Contents k -> Some (k, ()) | _ -> None) + (fun (k, ()) -> `Contents k); ] - type weak_value = [ `Contents of hash * unit | `Node of hash ] - [@@deriving brassaia] + type weak_value = [ `Contents of hash | `Node of hash ] let weak_value_encoding = let open Data_encoding in @@ -177,30 +176,19 @@ struct (function `Node k -> Some k | _ -> None) (fun k -> `Node k); case (Tag 2) ~title:"`Contents" (tup2 hash_encoding unit) - (function `Contents k -> Some k | _ -> None) - (fun k -> `Contents k); + (function `Contents k -> Some (k, ()) | _ -> None) + (fun (k, ()) -> `Contents k); ] - (* FIXME: special-case the default metadata in the default signature? *) - let value_t = - let open Type in - variant "value" (fun n c _ -> function - | `Node h -> n h | `Contents (h, ()) -> c h) - |~ case1 "node" node_key_t (fun k -> `Node k) - |~ case1 "contents" contents_key_t (fun h -> `Contents (h, ())) - |~ case1 "contents-x" (pair contents_key_t unit) (fun (h, ()) -> - `Contents (h, ())) - |> sealv - let to_entry (k, (v : value)) = match v with | `Node h -> Node { name = k; node = h } - | `Contents (h, ()) -> Contents { name = k; contents = h } + | `Contents h -> Contents { name = k; contents = h } let inspect_nonportable_entry_exn : entry -> step * value = function | Node n -> (n.name, `Node n.node) - | Contents c -> (c.name, `Contents (c.contents, ())) - | Contents_m c -> (c.name, `Contents (c.contents, ())) + | Contents c -> (c.name, `Contents c.contents) + | Contents_m c -> (c.name, `Contents c.contents) | Node_hash _ | Contents_hash _ | Contents_m_hash _ -> (* Not reachable after [Portable.of_node]. See invariant on {!entry}. *) assert false @@ -217,10 +205,10 @@ struct let weak_of_entry : entry -> step * weak_value = function | Node n -> (n.name, `Node (Node_key.to_hash n.node)) | Node_hash n -> (n.name, `Node n.node) - | Contents c -> (c.name, `Contents (Contents_key.to_hash c.contents, ())) - | Contents_m c -> (c.name, `Contents (Contents_key.to_hash c.contents, ())) - | Contents_hash c -> (c.name, `Contents (c.contents, ())) - | Contents_m_hash c -> (c.name, `Contents (c.contents, ())) + | Contents c -> (c.name, `Contents (Contents_key.to_hash c.contents)) + | Contents_m c -> (c.name, `Contents (Contents_key.to_hash c.contents)) + | Contents_hash c -> (c.name, `Contents c.contents) + | Contents_m_hash c -> (c.name, `Contents c.contents) let of_seq l = Seq.fold_left @@ -302,14 +290,14 @@ struct | Contents { name; contents } -> Contents_hash { name; contents = Contents_key.to_hash contents } - | Contents_m { metadata; name; contents } -> + | Contents_m { name; contents } -> Contents_m_hash - { metadata; name; contents = Contents_key.to_hash contents } + { name; contents = Contents_key.to_hash contents } | Node_hash { name; node } -> Node_hash { name; node } | Contents_hash { name; contents } -> Contents_hash { name; contents } - | Contents_m_hash { metadata; name; contents } -> - Contents_m_hash { metadata; name; contents }) + | Contents_m_hash { name; contents } -> + Contents_m_hash { name; contents }) |> Seq.fold_left (fun xs x -> x :: xs) [] in pre_hash entries f @@ -409,13 +397,23 @@ struct let node_key_encoding = hash_encoding - type value = weak_value [@@deriving brassaia] + type value = weak_value + + (* Custom Repr encoding to be coherent with the previous binary + representation that included metadatas *) + let value_t = + let open Type in + variant "Portable.value" (fun c n -> function + | `Contents h -> c (h, ()) | `Node h -> n h) + |~ case1 "contents" (pair hash_t unit) (fun (h, ()) -> `Contents h) + |~ case1 "node" hash_t (fun h -> `Node h) + |> sealv let value_encoding = weak_value_encoding let to_entry name = function | `Node node -> Node_hash { name; node } - | `Contents (contents, ()) -> Contents_hash { name; contents } + | `Contents contents -> Contents_hash { name; contents } let of_seq s = Seq.fold_left @@ -584,7 +582,7 @@ module Graph (S : Store) = struct type path = Path.t [@@deriving brassaia] type 'a t = 'a S.t - type value = [ `Contents of contents_key * unit | `Node of node_key ] + type value = [ `Contents of contents_key | `Node of node_key ] let empty t = S.add t (S.Val.empty ()) @@ -602,7 +600,7 @@ module Graph (S : Store) = struct let edges t = List.rev_map - (function _, `Node n -> `Node n | _, `Contents (c, ()) -> `Contents c) + (function _, `Node n -> `Node n | _, `Contents c -> `Contents c) (S.Val.list t) let pp_key = Type.pp S.Key.t @@ -843,11 +841,11 @@ module V1 (N : Generic_key.S with type step = string) = struct let open Type in record "node" (fun contents _ node -> match (contents, node) with - | Some c, None -> `Contents (c, ()) + | Some c, None -> `Contents c | None, Some n -> `Node n | _ -> failwith "invalid node") |+ field "contents" (option Contents_key.t) (function - | `Contents (x, ()) -> Some x + | `Contents x -> Some x | _ -> None) |+ field "metadata" (option unit) (fun _ -> None) |+ field "node" (option Node_key.t) (function diff --git a/brassaia/lib_brassaia/node_intf.ml b/brassaia/lib_brassaia/node_intf.ml index 092312d3667f..296832be41f1 100644 --- a/brassaia/lib_brassaia/node_intf.ml +++ b/brassaia/lib_brassaia/node_intf.ml @@ -44,7 +44,7 @@ module type Core = sig val step_encoding : step Data_encoding.t (** [step_encoding] is the data_encoding for {!type-step}. *) - type value = [ `Node of node_key | `Contents of contents_key * unit ] + type value = [ `Node of node_key | `Contents of contents_key ] [@@deriving brassaia] (** The type for either (node) keys or (contents) keys combined *) @@ -286,7 +286,7 @@ module type Graph = sig type path [@@deriving brassaia] (** The type of store paths. A path is composed of {{!step} steps}. *) - type value = [ `Node of node_key | `Contents of contents_key * unit ] + type value = [ `Node of node_key | `Contents of contents_key ] [@@deriving brassaia] (** The type for store values. *) diff --git a/brassaia/lib_brassaia/proof.ml b/brassaia/lib_brassaia/proof.ml index 5116a9f8f884..1db1e3172240 100644 --- a/brassaia/lib_brassaia/proof.ml +++ b/brassaia/lib_brassaia/proof.ml @@ -27,9 +27,17 @@ struct type contents = C.t [@@deriving brassaia] type hash = H.t [@@deriving brassaia] type step = S.step [@@deriving brassaia] - - type kinded_hash = [ `Contents of hash * unit | `Node of hash ] - [@@deriving brassaia] + type kinded_hash = [ `Contents of hash | `Node of hash ] + + (* Custom Repr encoding to be coherent with the previous binary + representation that included metadatas *) + let kinded_hash_t = + let open Type in + variant "kinded_hash" (fun c n -> function + | `Contents h -> c ((), h) | `Node h -> n h) + |~ case1 "contents" (pair unit hash_t) (fun ((), h) -> `Contents h) + |~ case1 "node" hash_t (fun h -> `Node h) + |> sealv type 'a inode = { length : int; proofs : (int * 'a) list } [@@deriving brassaia] @@ -38,13 +46,12 @@ struct [@@deriving brassaia] type tree = - | Contents of contents * unit - | Blinded_contents of hash * unit + | Contents of contents + | Blinded_contents of hash | Node of (step * tree) list | Blinded_node of hash | Inode of inode_tree inode | Extender of inode_tree inode_extender - [@@deriving brassaia] and inode_tree = | Blinded_inode of hash @@ -53,6 +60,28 @@ struct | Inode_extender of inode_tree inode_extender [@@deriving brassaia] + (* Custom Repr encoding to be coherent with the previous binary + representation that included metadatas *) + let tree_t = + let open Type in + variant "tree" + (fun contents blinded_contents node blinded_node inode extender -> + function + | Contents c -> contents (c, ()) + | Blinded_contents h -> blinded_contents (h, ()) + | Node l -> node l + | Blinded_node h -> blinded_node h + | Inode i -> inode i + | Extender e -> extender e) + |~ case1 "contents" (pair contents_t unit) (fun (c, ()) -> Contents c) + |~ case1 "blinded-contents" (pair hash_t unit) (fun (h, ()) -> + Blinded_contents h) + |~ case1 "node" (list (pair step_t tree_t)) (fun h -> Node h) + |~ case1 "blinded-node" hash_t (fun h -> Blinded_node h) + |~ case1 "inode" (inode_t inode_tree_t) (fun i -> Inode i) + |~ case1 "extender" (inode_extender_t inode_tree_t) (fun e -> Extender e) + |> sealv + type elt = | Contents of contents | Node of (step * kinded_hash) list @@ -342,8 +371,7 @@ struct let l = List.map (function - | step, `Contents (k, ()) -> - (step, `Contents (B.Contents.Key.to_hash k, ())) + | step, `Contents k -> (step, `Contents (B.Contents.Key.to_hash k)) | step, `Node k -> (step, `Node (B.Node.Key.to_hash k))) l in diff --git a/brassaia/lib_brassaia/proof_intf.ml b/brassaia/lib_brassaia/proof_intf.ml index e1ccd8892a50..504ba107caef 100644 --- a/brassaia/lib_brassaia/proof_intf.ml +++ b/brassaia/lib_brassaia/proof_intf.ml @@ -36,9 +36,7 @@ module type S = sig type contents type hash type step - - type kinded_hash = [ `Contents of hash * unit | `Node of hash ] - [@@deriving brassaia] + type kinded_hash = [ `Contents of hash | `Node of hash ] [@@deriving brassaia] type 'a inode = { length : int; proofs : (int * 'a) list } [@@deriving brassaia] @@ -96,8 +94,8 @@ module type S = sig [Extender e] proves that an inode extender [e] exist in the store. *) type tree = - | Contents of contents * unit - | Blinded_contents of hash * unit + | Contents of contents + | Blinded_contents of hash | Node of (step * tree) list | Blinded_node of hash | Inode of inode_tree inode diff --git a/brassaia/lib_brassaia/store.ml b/brassaia/lib_brassaia/store.ml index 16a59518ac24..4b5e756c47fb 100644 --- a/brassaia/lib_brassaia/store.ml +++ b/brassaia/lib_brassaia/store.ml @@ -75,10 +75,10 @@ module Make (B : Backend.S) = struct B.Node.index (B.Repo.node_t r) h >|= function | None -> None | Some k -> Some (`Node k)) - | `Contents (h, ()) -> ( + | `Contents h -> ( B.Contents.index (B.Repo.contents_t r) h >|= function | None -> None - | Some k -> Some (`Contents (k, ())))) + | Some k -> Some (`Contents k))) let of_key r k = import r k @@ -87,17 +87,17 @@ module Make (B : Backend.S) = struct B.Node.index (B.Repo.node_t r) h >>= function | None -> Lwt.return_none | Some k -> of_key r (`Node k)) - | `Contents (h, ()) -> ( + | `Contents h -> ( B.Contents.index (B.Repo.contents_t r) h >>= function | None -> Lwt.return_none - | Some k -> of_key r (`Contents (k, ()))) + | Some k -> of_key r (`Contents k)) let shallow r h = import_no_check r h let kinded_hash = hash let hash : ?cache:bool -> t -> hash = fun ?cache tr -> - match hash ?cache tr with `Node h -> h | `Contents (h, ()) -> h + match hash ?cache tr with `Node h -> h | `Contents h -> h let pp = Type.pp t end @@ -149,7 +149,7 @@ module Make (B : Backend.S) = struct let save_tree ?(clear = true) r x y (tr : Tree.t) = match Tree.destruct tr with - | `Contents (c, ()) -> + | `Contents c -> let* c = Tree.Contents.force_exn c in let+ k = save_contents x c in `Contents k @@ -308,7 +308,7 @@ module Make (B : Backend.S) = struct | Some v -> List.iter (function - | _, `Contents (c, ()) -> + | _, `Contents c -> contents := Contents_keys.add c !contents | _ -> ()) (B.Node.Val.list v); @@ -393,8 +393,7 @@ module Make (B : Backend.S) = struct | None -> [] | Some v -> List.rev_map - (function - | _, `Node n -> `Node n | _, `Contents (c, ()) -> `Contents c) + (function _, `Node n -> `Node n | _, `Contents c -> `Contents c) (B.Node.Val.list v) let default_pred_commit t c = @@ -953,7 +952,7 @@ module Make (B : Backend.S) = struct | None -> None | Some tree -> ( match Tree.key tree with - | Some (`Contents (key, ())) -> Some (`Contents key) + | Some (`Contents key) -> Some (`Contents key) | Some (`Node key) -> Some (`Node key) | None -> None) @@ -1259,9 +1258,7 @@ struct match Type.of_string Store.Path.step_t k with | Ok key -> obj l ((key, node v []) :: acc) | _ -> obj l acc) - and node j acc = - match j with `O j -> obj j acc | _ -> `Contents (j, ()) - in + and node j acc = match j with `O j -> obj j acc | _ -> `Contents j in node j [] let of_concrete_tree c : json = @@ -1271,7 +1268,7 @@ struct | [] -> `O acc | (k, v) :: l -> tree l ((step k, contents v []) :: acc) and contents t acc = - match t with `Contents (c, ()) -> c | `Tree c -> tree c acc + match t with `Contents c -> c | `Tree c -> tree c acc in contents c [] diff --git a/brassaia/lib_brassaia/store_intf.ml b/brassaia/lib_brassaia/store_intf.ml index c665c65d3ad6..26332e7e69d1 100644 --- a/brassaia/lib_brassaia/store_intf.ml +++ b/brassaia/lib_brassaia/store_intf.ml @@ -433,7 +433,7 @@ module type S_generic_key = sig (** {1 Import/Export} *) - type kinded_key = [ `Contents of contents_key * unit | `Node of node_key ] + type kinded_key = [ `Contents of contents_key | `Node of node_key ] [@@deriving brassaia] (** Keys in the Brassaia store are tagged with the type of the value they reference (either {!contents} or {!node}). *) @@ -459,7 +459,7 @@ module type S_generic_key = sig val hash : ?cache:bool -> tree -> hash (** [hash t] is the hash of tree [t]. *) - type kinded_hash = [ `Contents of hash * unit | `Node of hash ] + type kinded_hash = [ `Contents of hash | `Node of hash ] (** Like {!kinded_key}, but with hashes as value references rather than keys. *) @@ -579,13 +579,13 @@ module type S_generic_key = sig val mem_tree : t -> path -> bool Lwt.t (** [mem_tree t] is {!Tree.mem_tree} applied to [t]'s root tree. *) - val find_all : t -> path -> (contents * unit) option Lwt.t + val find_all : t -> path -> contents option Lwt.t (** [find_all t] is {!Tree.find_all} applied to [t]'s root tree. *) val find : t -> path -> contents option Lwt.t (** [find t] is {!Tree.find} applied to [t]'s root tree. *) - val get_all : t -> path -> (contents * unit) Lwt.t + val get_all : t -> path -> contents Lwt.t (** [get_all t] is {!Tree.get_all} applied on [t]'s root tree. *) val get : t -> path -> contents Lwt.t diff --git a/brassaia/lib_brassaia/tree.ml b/brassaia/lib_brassaia/tree.ml index 56999108fdf3..575ff5def749 100644 --- a/brassaia/lib_brassaia/tree.ml +++ b/brassaia/lib_brassaia/tree.ml @@ -431,7 +431,7 @@ module Make (P : Backend.S) = struct type portable = Portable.t [@@deriving brassaia ~equal ~pp] (* [elt] is a tree *) - type elt = [ `Node of t | `Contents of Contents.t * unit ] + type elt = [ `Node of t | `Contents of Contents.t ] and update = Add of elt | Remove and updatemap = update StepMap.t and map = elt StepMap.t @@ -457,13 +457,15 @@ module Make (P : Backend.S) = struct [t.info.map] is only populated during a call to [Node.to_map]. *) + (* Custom Repr encoding to be coherent with the previous binary + representation that included metadatas *) let elt_t (t : t Type.t) : elt Type.t = let open Type in - variant "Node.value" (fun node contents _ -> function - | `Node x -> node x | `Contents (c, ()) -> contents c) + variant "Node.elt" (fun node contents _ -> function + | `Node x -> node x | `Contents c -> contents c) |~ case1 "Node" t (fun x -> `Node x) - |~ case1 "Contents" Contents.t (fun x -> `Contents (x, ())) - |~ case1 "Contents-x" (pair Contents.t unit) (fun x -> `Contents x) + |~ case1 "Contents" Contents.t (fun x -> `Contents x) + |~ case1 "Contents-x" (pair Contents.t unit) (fun (x, ()) -> `Contents x) |> sealv let stepmap_t : 'a. 'a Type.t -> 'a StepMap.t Type.t = @@ -539,7 +541,7 @@ module Make (P : Backend.S) = struct let rec clear_elt ~max_depth depth v = match v with - | `Contents (c, ()) -> if depth + 1 > max_depth then Contents.clear c + | `Contents c -> if depth + 1 > max_depth then Contents.clear c | `Node t -> clear ~max_depth (depth + 1) t and clear_info ~max_depth ~v depth i = @@ -639,7 +641,7 @@ module Make (P : Backend.S) = struct let t ~env repo = function | `Node k -> `Node (of_key ~env repo k) - | `Contents (k, ()) -> `Contents (Contents.of_key ~env repo k, ()) + | `Contents k -> `Contents (Contents.of_key ~env repo k) end) module Portable_value = @@ -650,7 +652,7 @@ module Make (P : Backend.S) = struct let t ~env () = function | `Node h -> `Node (pruned ~env h) - | `Contents (h, ()) -> `Contents (Contents.pruned ~env h, ()) + | `Contents h -> `Contents (Contents.pruned ~env h) end) (** This [Scan] module contains function that scan the content of [t.v] and @@ -840,7 +842,7 @@ module Make (P : Backend.S) = struct | Pnode_value of pnode_value let weaken_value : node_value -> pnode_value = function - | `Contents (key, ()) -> `Contents (P.Contents.Key.to_hash key, ()) + | `Contents key -> `Contents (P.Contents.Key.to_hash key) | `Node key -> `Node (P.Node.Key.to_hash key) let rec hash : type a. cache:bool -> t -> (hash -> a) -> a = @@ -881,14 +883,14 @@ module Make (P : Backend.S) = struct |> Seq.exists (fun (_, v) -> match v with | `Node n -> Option.is_none (cached_key n) - | `Contents (c, ()) -> Option.is_none (Contents.cached_key c)) + | `Contents c -> Option.is_none (Contents.cached_key c)) in if must_build_portable_node then let pnode = bindings |> Seq.map (fun (step, v) -> match v with - | `Contents (c, ()) -> (step, `Contents (Contents.hash c, ())) + | `Contents c -> (step, `Contents (Contents.hash c)) | `Node n -> hash ~cache n (fun k -> (step, `Node k))) |> Portable.of_seq in @@ -898,9 +900,9 @@ module Make (P : Backend.S) = struct bindings |> Seq.map (fun (step, v) -> match v with - | `Contents (c, ()) -> ( + | `Contents c -> ( match Contents.cached_key c with - | Some k -> (step, `Contents (k, ())) + | Some k -> (step, `Contents k) | None -> (* We checked that all child keys are cached above *) assert false) @@ -919,10 +921,10 @@ module Make (P : Backend.S) = struct type r. cache:bool -> elt -> (hash_preimage_value, r) cont = fun ~cache e k -> match e with - | `Contents (c, ()) -> ( + | `Contents c -> ( match Contents.key c with - | Some key -> k (Node_value (`Contents (key, ()))) - | None -> k (Pnode_value (`Contents (Contents.hash c, ())))) + | Some key -> k (Node_value (`Contents key)) + | None -> k (Pnode_value (`Contents (Contents.hash c)))) | `Node n -> ( match key n with | Some key -> k (Node_value (`Node key)) @@ -1092,7 +1094,7 @@ module Make (P : Backend.S) = struct | Portable_dirty (p, um) -> ok (of_portable_value p (Some um)) | Pruned h -> err_pruned_hash h |> Lwt.return - let contents_equal (c1, ()) (c2, ()) = Contents.equal c1 c2 + let contents_equal c1 c2 = Contents.equal c1 c2 let rec elt_equal (x : elt) (y : elt) = x == y @@ -1448,7 +1450,7 @@ module Make (P : Backend.S) = struct | `Contents c -> ( let apply () = let tree path = tree path (`Contents c) in - Contents.fold ~force ~cache ~path contents tree (fst c) acc >>= k + Contents.fold ~force ~cache ~path contents tree c acc >>= k in match depth with | None -> apply () @@ -1620,15 +1622,15 @@ module Make (P : Backend.S) = struct let f : elt Merge.f = fun ~old x y -> match (x, y) with - | `Contents (c1, ()), `Contents (c2, ()) -> + | `Contents c1, `Contents c2 -> let old = Merge.bind_promise old (fun old () -> match old with - | `Contents (c, ()) -> ok (Some c) + | `Contents c -> ok (Some c) | `Node _ -> ok None) in Merge.(f Contents.merge) ~old c1 c2 >>=* fun c -> - Merge.ok (`Contents (c, ())) + Merge.ok (`Contents c) | `Node x, `Node y -> (merge [@tailcall]) (fun m -> let old = @@ -1648,15 +1650,46 @@ module Make (P : Backend.S) = struct type node = Node.t [@@deriving brassaia ~pp] type node_key = Node.key [@@deriving brassaia ~pp] type contents_key = Contents.key [@@deriving brassaia ~pp] - - type kinded_key = [ `Contents of Contents.key * unit | `Node of Node.key ] - [@@deriving brassaia] - - type kinded_hash = [ `Contents of hash * unit | `Node of hash ] - [@@deriving brassaia ~equal] - - type t = [ `Node of node | `Contents of Contents.t * unit ] - [@@deriving brassaia] + type kinded_key = [ `Contents of Contents.key | `Node of Node.key ] + + (* Custom Repr encoding to be coherent with the previous binary + representation that included metadatas *) + let kinded_key_t : kinded_key Type.ty = + let open Type in + variant "kinded_key" (fun contents node -> function + | `Contents c -> contents (c, ()) | `Node x -> node x) + |~ case1 "Contents" (pair Contents.key_t unit) (fun (x, ()) -> `Contents x) + |~ case1 "Node" Node.key_t (fun x -> `Node x) + |> sealv + + type kinded_hash = [ `Contents of hash | `Node of hash ] + + (* Custom Repr encoding to be coherent with the previous binary + representation that included metadatas *) + let kinded_hash_t : kinded_hash Type.ty = + let open Type in + variant "kinded_hash" (fun contents node -> function + | `Contents h -> contents (h, ()) | `Node h -> node h) + |~ case1 "Contents" (pair hash_t unit) (fun (h, ()) -> `Contents h) + |~ case1 "Node" hash_t (fun h -> `Node h) + |> sealv + + let equal_kinded_hash kh1 kh2 = + match (kh1, kh2) with + | `Node h1, `Node h2 | `Contents h1, `Contents h2 -> equal_hash h1 h2 + | _ -> false + + type t = [ `Node of node | `Contents of Contents.t ] + + (* Custom Repr encoding to be coherent with the previous binary + representation that included metadatas *) + let t : t Type.ty = + let open Type in + variant "t" (fun node contents -> function + | `Node n -> node n | `Contents c -> contents (c, ())) + |~ case1 "Node" node_t (fun n -> `Node n) + |~ case1 "Contents" (pair Contents.t unit) (fun (x, ()) -> `Contents x) + |> sealv let to_backend_node n = Node.to_value ~cache:true n >|= get_ok "to_backend_node" @@ -1671,9 +1704,9 @@ module Make (P : Backend.S) = struct let dump ppf = function | `Node n -> Fmt.pf ppf "node: %a" Node.dump n - | `Contents (c, ()) -> Fmt.pf ppf "contents: %a" (Type.pp Contents.t) c + | `Contents c -> Fmt.pf ppf "contents: %a" (Type.pp Contents.t) c - let contents_equal (c1, ()) (c2, ()) = Contents.equal c1 c2 + let contents_equal c1 c2 = Contents.equal c1 c2 let equal (x : t) (y : t) = x == y @@ -1687,21 +1720,21 @@ module Make (P : Backend.S) = struct | `Node n -> Node.is_empty ~cache:true n | `Contents _ -> false - type elt = [ `Node of node | `Contents of contents * unit ] + type elt = [ `Node of node | `Contents of contents ] let of_node n = `Node n let of_contents c = let env = Env.empty () in let c = Contents.of_value ~env c in - `Contents (c, ()) + `Contents c let init : elt -> t = function - | `Contents (c, ()) -> of_contents c + | `Contents c -> of_contents c | `Node n -> `Node n let pruned_with_env ~env = function - | `Contents (h, ()) -> `Contents (Contents.pruned ~env h, ()) + | `Contents h -> `Contents (Contents.pruned ~env h) | `Node h -> `Node (Node.pruned ~env h) let pruned h = @@ -1745,7 +1778,7 @@ module Make (P : Backend.S) = struct let fold ?(order = `Sorted) ?(force = `True) ?(cache = false) ?(uniq = `False) ?pre ?post ?depth ?(contents = id) ?(node = id) ?(tree = id) (t : t) acc = match t with - | `Contents (c, ()) as c' -> + | `Contents c as c' -> let tree path = tree path c' in Contents.fold ~force ~cache ~path:Path.empty contents tree c acc | `Node n -> @@ -1786,18 +1819,18 @@ module Make (P : Backend.S) = struct let find_all t k = find_tree t k >>= function | None | Some (`Node _) -> Lwt.return_none - | Some (`Contents (c, ())) -> + | Some (`Contents c) -> let+ c = Contents.to_value ~cache:true c in - Some (get_ok "find_all" c, ()) + Some (get_ok "find_all" c) - let find t k = find_all t k >|= Option.map fst + let find t k = find_all t k let get_all t k = find_all t k >>= function | None -> err_not_found "get" k | Some v -> Lwt.return v - let get t k = get_all t k >|= fst + let get t k = get_all t k let mem t k = find t k >|= function None -> false | _ -> true let mem_tree t k = find_tree t k >|= function None -> false | _ -> true @@ -1846,7 +1879,7 @@ module Make (P : Backend.S) = struct Events.(emit__dont_wait__use_with_care tree_function) ("singleton", Logging.to_string_exn Path.encoding path); let env = Env.empty () in - let base_tree = `Contents (Contents.of_value ~env c, ()) in + let base_tree = `Contents (Contents.of_value ~env c) in Path.fold_right path ~f:(fun step child -> `Node (Node.singleton ~env step child)) ~init:base_tree @@ -1865,7 +1898,7 @@ module Make (P : Backend.S) = struct let get_env = function | `Node n -> n.Node.info.env - | `Contents (c, ()) -> c.Contents.info.env + | `Contents c -> c.Contents.info.env let update_tree ~cache ~f_might_return_empty_node ~f root_tree path = (* User-introduced empty nodes will be removed immediately if necessary. *) @@ -1967,7 +2000,7 @@ module Make (P : Backend.S) = struct let+ old_contents = match t with | Some (`Node _) | None -> Lwt.return_none - | Some (`Contents (c, ())) -> + | Some (`Contents c) -> let+ c = Contents.to_value ~cache c in Some (get_ok "update" c) in @@ -2009,12 +2042,12 @@ module Make (P : Backend.S) = struct update_tree ~cache:true t k ~f:(Lwt.wrap1 f) ~f_might_return_empty_node:true let import repo = function - | `Contents (k, ()) -> ( + | `Contents k -> ( cnt.contents_mem <- cnt.contents_mem + 1; P.Contents.mem (P.Repo.contents_t repo) k >|= function | true -> let env = Env.empty () in - Some (`Contents (Contents.of_key ~env repo k, ())) + Some (`Contents (Contents.of_key ~env repo k)) | false -> None) | `Node k -> ( cnt.node_mem <- cnt.node_mem + 1; @@ -2026,7 +2059,7 @@ module Make (P : Backend.S) = struct let import_with_env ~env repo = function | `Node k -> `Node (Node.of_key ~env repo k) - | `Contents (k, ()) -> `Contents (Contents.of_key ~env repo k, ()) + | `Contents k -> `Contents (Contents.of_key ~env repo k) let import_no_check repo f = let env = Env.empty () in @@ -2090,9 +2123,9 @@ module Make (P : Backend.S) = struct "Encountered child node value with uncached key \ during export:@,\ @ @[%a@]" dump v) - | `Contents (c, ()) -> ( + | `Contents c -> ( match Contents.cached_key c with - | Some k -> (step, `Contents (k, ())) + | Some k -> (step, `Contents k) | None -> assertion_failure "Encountered child contents value with uncached key \ @@ -2117,9 +2150,9 @@ module Make (P : Backend.S) = struct "Encountered child node value with uncached key during \ export:@,\ @ @[%a@]" dump v) - | Add (`Contents (c, ()) as v) -> ( + | Add (`Contents c as v) -> ( match Contents.cached_key c with - | Some ptr -> P.Node.Val.add acc k (`Contents (ptr, ())) + | Some ptr -> P.Node.Val.add acc k (`Contents ptr) | None -> assertion_failure "Encountered child contents value with uncached key \ @@ -2248,9 +2281,8 @@ module Make (P : Backend.S) = struct assert false))) and on_contents : type r. - [ `Contents of Contents.t * unit ] -> - ([ `Content_exported ], r) cont_lwt = - fun (`Contents (c, ())) k -> + [ `Contents of Contents.t ] -> ([ `Content_exported ], r) cont_lwt = + fun (`Contents c) k -> match c.Contents.v with | Contents.Key (_, key) -> Contents.export ?clear repo c key; @@ -2330,10 +2362,10 @@ module Make (P : Backend.S) = struct let diff_contents x y = if Node.contents_equal x y then Lwt.return_nil else - let* cx = Contents.to_value ~cache:true (fst x) in - let+ cy = Contents.to_value ~cache:true (fst y) in + let* cx = Contents.to_value ~cache:true x in + let+ cy = Contents.to_value ~cache:true y in diff_force_result cx cy ~empty:[] ~diff_ok:(fun (cx, cy) -> - [ `Updated ((cx, ()), (cy, ())) ]) + [ `Updated (cx, cy) ]) let diff_node (x : node) (y : node) = let bindings n = @@ -2341,13 +2373,13 @@ module Make (P : Backend.S) = struct | Ok m -> Ok (StepMap.bindings m) | Error _ as e -> e in - let removed acc (k, (c, ())) = + let removed acc (k, c) = let+ c = Contents.to_value ~cache:true c >|= get_ok "diff_node" in - (k, `Removed (c, ())) :: acc + (k, `Removed c) :: acc in - let added acc (k, (c, ())) = + let added acc (k, c) = let+ c = Contents.to_value ~cache:true c >|= get_ok "diff_node" in - (k, `Added (c, ())) :: acc + (k, `Added c) :: acc in let rec diff_bindings acc todo path x y = let acc = ref acc in @@ -2410,26 +2442,36 @@ module Make (P : Backend.S) = struct let diff (x : t) (y : t) = match (x, y) with - | `Contents (c1, ()), `Contents (c2, ()) -> + | `Contents c1, `Contents c2 -> if Contents.equal c1 c2 then Lwt.return_nil else let* c1 = Contents.to_value ~cache:true c1 >|= get_ok "diff" in let* c2 = Contents.to_value ~cache:true c2 >|= get_ok "diff" in - Lwt.return [ (Path.empty, `Updated ((c1, ()), (c2, ()))) ] + Lwt.return [ (Path.empty, `Updated (c1, c2)) ] | `Node x, `Node y -> diff_node x y - | `Contents (x, ()), `Node y -> + | `Contents x, `Node y -> let* diff = diff_node (Node.empty ()) y in let+ x = Contents.to_value ~cache:true x >|= get_ok "diff" in - (Path.empty, `Removed (x, ())) :: diff - | `Node x, `Contents (y, ()) -> + (Path.empty, `Removed x) :: diff + | `Node x, `Contents y -> let* diff = diff_node x (Node.empty ()) in let+ y = Contents.to_value ~cache:true y >|= get_ok "diff" in - (Path.empty, `Added (y, ())) :: diff + (Path.empty, `Added y) :: diff type concrete = - [ `Tree of (Path.step * concrete) list - | `Contents of P.Contents.Val.t * unit ] - [@@deriving brassaia] + [ `Tree of (Path.step * concrete) list | `Contents of P.Contents.Val.t ] + + (* Custom Repr encoding to be coherent with the previous binary + representation that included metadatas *) + let concrete_t : concrete Type.ty = + let open Type in + mu (fun concrete_t -> + variant "concrete" (fun tree contents -> function + | `Tree l -> tree l | `Contents c -> contents (c, ())) + |~ case1 "Tree" (list (pair Path.step_t concrete_t)) (fun t -> `Tree t) + |~ case1 "Contents" (pair P.Contents.Val.t unit) (fun (x, ()) -> + `Contents x) + |> sealv) type 'a or_empty = Empty | Non_empty of 'a @@ -2437,7 +2479,7 @@ module Make (P : Backend.S) = struct let rec concrete : type r. concrete -> (t or_empty, r) cont = fun t k -> match t with - | `Contents (c, ()) -> k (Non_empty (of_contents c)) + | `Contents c -> k (Non_empty (of_contents c)) | `Tree childs -> tree StepMap.empty childs (function | Empty -> k Empty @@ -2481,10 +2523,10 @@ module Make (P : Backend.S) = struct (node [@tailcall]) [] bindings (fun n -> let n = List.sort (fun (s, _) (s', _) -> compare_step s s') n in k (`Tree n)) - and contents : type r. Contents.t * unit -> (concrete, r) cont_lwt = - fun (c, ()) k -> + and contents : type r. Contents.t -> (concrete, r) cont_lwt = + fun c k -> let* c = Contents.to_value ~cache:true c >|= get_ok "to_concrete" in - k (`Contents (c, ())) + k (`Contents c) and node : type r. (step * concrete) list -> @@ -2508,16 +2550,16 @@ module Make (P : Backend.S) = struct match t with | `Node n -> ( match Node.key n with Some key -> Some (`Node key) | None -> None) - | `Contents (c, ()) -> ( + | `Contents c -> ( match Contents.key c with - | Some key -> Some (`Contents (key, ())) + | Some key -> Some (`Contents key) | None -> None) let hash ?(cache = true) (t : t) = Events.(emit__dont_wait__use_with_care tree_hash) (); match t with | `Node n -> `Node (Node.hash ~cache n) - | `Contents (c, ()) -> `Contents (Contents.hash ~cache c, ()) + | `Contents c -> `Contents (Contents.hash ~cache c) let stats ?(force = false) (t : t) = let cache = true in @@ -2566,14 +2608,14 @@ module Make (P : Backend.S) = struct let rec proof_of_tree : type a. brassaia_tree -> (proof_tree -> a) -> a = fun tree k -> match tree with - | `Contents (c, ()) -> proof_of_contents c k + | `Contents c -> proof_of_contents c k | `Node node -> proof_of_node node k and proof_of_contents : type a. Contents.t -> (proof_tree -> a) -> a = fun c k -> match Contents.cached_value c with - | Some v -> k (Contents (v, ())) - | None -> k (Blinded_contents (Contents.hash c, ())) + | Some v -> k (Contents v) + | None -> k (Blinded_contents (Contents.hash c)) and proof_of_node : type a. node -> (proof_tree -> a) -> a = fun node k -> @@ -2682,11 +2724,11 @@ module Make (P : Backend.S) = struct | Blinded_node h -> k (`Node h) | Node n -> load_node_proof ~env n k | Inode { length; proofs } -> load_inode_proof ~env length proofs k - | Blinded_contents (h, ()) -> k (`Contents (h, ())) - | Contents (v, ()) -> + | Blinded_contents h -> k (`Contents h) + | Contents v -> let h = P.Contents.Hash.hash v in Env.add_contents_from_proof env h v; - k (`Contents (h, ())) + k (`Contents h) | Extender { length; segments; proof } -> load_extender_proof ~env length segments proof k diff --git a/brassaia/lib_brassaia/tree_intf.ml b/brassaia/lib_brassaia/tree_intf.ml index 74dd36c296da..d720b47c4892 100644 --- a/brassaia/lib_brassaia/tree_intf.ml +++ b/brassaia/lib_brassaia/tree_intf.ml @@ -54,14 +54,13 @@ module type S = sig val of_node : node -> t (** [of_node n] is the subtree built from the node [n]. *) - type elt = [ `Node of node | `Contents of contents * unit ] + type elt = [ `Node of node | `Contents of contents ] (** The type for tree elements. *) val init : elt -> t (** General-purpose constructor for trees. *) - type kinded_hash = [ `Contents of hash * unit | `Node of hash ] - [@@deriving brassaia] + type kinded_hash = [ `Contents of hash | `Node of hash ] [@@deriving brassaia] val pruned : kinded_hash -> t (** [pruned h] is a purely in-memory tree with the hash [h]. Such trees can be @@ -83,7 +82,7 @@ module type S = sig (** {1 Diffs} *) - val diff : t -> t -> (path * (contents * unit) Diff.t) list Lwt.t + val diff : t -> t -> (path * contents Diff.t) list Lwt.t (** [diff x y] is the difference of contents between [x] and [y]. *) (** {1 Manipulating Contents} *) @@ -145,7 +144,7 @@ module type S = sig val mem : t -> path -> bool Lwt.t (** [mem t k] is true iff [k] is associated to some contents in [t]. *) - val find_all : t -> path -> (contents * unit) option Lwt.t + val find_all : t -> path -> contents option Lwt.t (** [find_all t k] is [Some (b, m)] if [k] is associated to the contents [b] in [t] and [None] if [k] is not present in [t]. *) @@ -162,7 +161,7 @@ module type S = sig val find : t -> path -> contents option Lwt.t (** [find] is similar to {!find_all} *) - val get_all : t -> path -> (contents * unit) Lwt.t + val get_all : t -> path -> contents Lwt.t (** Same as {!find_all} but raise [Invalid_arg] if [k] is not present in [t]. *) val list : @@ -239,7 +238,7 @@ module type S = sig (** {1 Folds} *) - val destruct : t -> [ `Node of node | `Contents of Contents.t * unit ] + val destruct : t -> [ `Node of node | `Contents of Contents.t ] (** General-purpose destructor for trees. *) type marks @@ -338,8 +337,7 @@ module type S = sig (** {1 Concrete Trees} *) - type concrete = - [ `Tree of (step * concrete) list | `Contents of contents * unit ] + type concrete = [ `Tree of (step * concrete) list | `Contents of contents ] [@@deriving brassaia] (** The type for concrete trees. *) @@ -442,8 +440,7 @@ module type Sigs = sig and type contents_key = B.Contents.Key.t and type hash = B.Hash.t - type kinded_key = - [ `Contents of B.Contents.Key.t * unit | `Node of B.Node.Key.t ] + type kinded_key = [ `Contents of B.Contents.Key.t | `Node of B.Node.Key.t ] [@@deriving brassaia] val import : B.Repo.t -> kinded_key -> t option Lwt.t diff --git a/brassaia/lib_brassaia_pack/inode.ml b/brassaia/lib_brassaia_pack/inode.ml index 682c4abce66d..69313eeaafaf 100644 --- a/brassaia/lib_brassaia_pack/inode.ml +++ b/brassaia/lib_brassaia_pack/inode.ml @@ -99,11 +99,11 @@ struct raise (Dangling_hash { context; hash }) let unsafe_keyvalue_of_hashvalue = function - | `Contents (h, ()) -> `Contents (Key.unfindable_of_hash h, ()) + | `Contents h -> `Contents (Key.unfindable_of_hash h) | `Node h -> `Node (Key.unfindable_of_hash h) let hashvalue_of_keyvalue = function - | `Contents (k, ()) -> `Contents (Key.to_hash k, ()) + | `Contents k -> `Contents (Key.to_hash k) | `Node k -> `Node (Key.to_hash k) end @@ -397,7 +397,7 @@ struct type tree = { depth : int; length : int; entries : ptr list } [@@deriving brassaia] - type value = Contents of name * address * unit | Node of name * address + type value = Contents of name * address | Node of name * address (* We distribute products over sums in the type representation of [value] in order to pack many possible cases into a single tag character in the @@ -435,22 +435,22 @@ struct | Node (Indirect n, Hash h) -> node_ih (n, h) | Node (Direct n, Offset o) -> node_do (n, o) | Node (Direct n, Hash h) -> node_dh (n, h) - | Contents (Indirect n, Offset o, ()) -> contents_io (n, o) - | Contents (Indirect n, Hash h, ()) -> contents_ih (n, h) - | Contents (Direct n, Offset o, ()) -> contents_do (n, o) - | Contents (Direct n, Hash h, ()) -> contents_dh (n, h) ) - |~ case1 "contents-io" Payload.io (fun (n, o) -> Contents (Indirect n, Offset o, ())) - |~ case1 "contents-x-io" Payload.x_io (fun (n, i, m) -> Contents (Indirect n, Offset i, m)) + | Contents (Indirect n, Offset o) -> contents_io (n, o) + | Contents (Indirect n, Hash h) -> contents_ih (n, h) + | Contents (Direct n, Offset o) -> contents_do (n, o) + | Contents (Direct n, Hash h) -> contents_dh (n, h) ) + |~ case1 "contents-io" Payload.io (fun (n, o) -> Contents (Indirect n, Offset o)) + |~ case1 "contents-x-io" Payload.x_io (fun (n, i, _) -> Contents (Indirect n, Offset i)) |~ case1 "node-io" Payload.io (fun (n, i) -> Node (Indirect n, Offset i)) - |~ case1 "contents-ih" Payload.ih (fun (n, h) -> Contents (Indirect n, Hash h, ())) - |~ case1 "contents-x-ih" Payload.x_ih (fun (n, h, m) -> Contents (Indirect n, Hash h, m)) + |~ case1 "contents-ih" Payload.ih (fun (n, h) -> Contents (Indirect n, Hash h)) + |~ case1 "contents-x-ih" Payload.x_ih (fun (n, h, _) -> Contents (Indirect n, Hash h)) |~ case1 "node-ih" Payload.ih (fun (n, h) -> Node (Indirect n, Hash h)) - |~ case1 "contents-do" Payload.do_ (fun (n, i) -> Contents (Direct n, Offset i, ())) - |~ case1 "contents-x-do" Payload.x_do (fun (n, i, m) -> Contents (Direct n, Offset i, m)) + |~ case1 "contents-do" Payload.do_ (fun (n, i) -> Contents (Direct n, Offset i)) + |~ case1 "contents-x-do" Payload.x_do (fun (n, i, _) -> Contents (Direct n, Offset i)) |~ case1 "node-do" Payload.do_ (fun (n, i) -> Node (Direct n, Offset i)) - |~ case1 "contents-dh" Payload.dh (fun (n, i) -> Contents (Direct n, Hash i, ())) - |~ case1 "contents-x-dh" Payload.x_dh (fun (n, i, m) -> Contents (Direct n, Hash i, m)) + |~ case1 "contents-dh" Payload.dh (fun (n, i) -> Contents (Direct n, Hash i)) + |~ case1 "contents-x-dh" Payload.x_dh (fun (n, i, _) -> Contents (Direct n, Hash i)) |~ case1 "node-dd" Payload.dh (fun (n, i) -> Node (Direct n, Hash i)) |> sealv @@ -868,7 +868,7 @@ struct let v = match v with | `Node _ as k -> (Some s, k) - | `Contents (k, ()) -> (Some s, `Contents k) + | `Contents k -> (Some s, `Contents k) in v :: acc) l [] @@ -1029,9 +1029,20 @@ struct module Concrete = struct type kinded_key = | Contents of contents_key - | Contents_x of unit * contents_key + | Contents_x of contents_key | Node of node_key - [@@deriving brassaia] + + let kinded_key_t : kinded_key Repr.ty = + let open Repr in + variant "kinded_key" (fun contents contents_x node -> function + | Contents h -> contents h + | Contents_x c -> contents_x ((), c) + | Node h -> node h) + |~ case1 "contents" contents_key_t (fun ck -> Contents ck) + |~ case1 "contents-x" (pair unit contents_key_t) (fun ((), ck) -> + Contents_x ck) + |~ case1 "node" node_key_t (fun k -> Node k) + |> sealv type entry = { name : step; key : kinded_key } [@@deriving brassaia] @@ -1046,14 +1057,14 @@ struct let to_entry (name, v) = match v with - | `Contents (contents_key, ()) -> { name; key = Contents contents_key } + | `Contents contents_key -> { name; key = Contents contents_key } | `Node node_key -> { name; key = Node node_key } let of_entry e = ( e.name, match e.key with - | Contents key -> `Contents (key, ()) - | Contents_x ((), key) -> `Contents (key, ()) + | Contents key -> `Contents key + | Contents_x key -> `Contents key | Node key -> `Node key ) type error = @@ -1638,8 +1649,15 @@ struct let is_tree t = match t.v with Tree _ -> true | Values _ -> false module Proof = struct - type value = [ `Contents of hash * unit | `Node of hash ] - [@@deriving brassaia] + type value = [ `Contents of hash | `Node of hash ] + + let value_t : value Repr.ty = + let open Repr in + variant "Proof.value" (fun contents node -> function + | `Contents h -> contents (h, ()) | `Node h -> node h) + |~ case1 "contents" (pair hash_t unit) (fun (h, ()) -> `Contents h) + |~ case1 "node" hash_t (fun h -> `Node h) + |> sealv type t = [ `Blinded of hash @@ -1795,8 +1813,15 @@ struct module Snapshot = struct include T - type kinded_hash = Contents of hash * unit | Node of hash - [@@deriving brassaia] + type kinded_hash = Contents of hash | Node of hash + + let kinded_hash_t : kinded_hash Repr.ty = + let open Repr in + variant "Proof.value" (fun contents node -> function + | Contents h -> contents (h, ()) | Node h -> node h) + |~ case1 "contents" (pair hash_t unit) (fun (h, ()) -> Contents h) + |~ case1 "node" hash_t (fun h -> Node h) + |> sealv type entry = { step : string; hash : kinded_hash } [@@deriving brassaia] @@ -1821,9 +1846,9 @@ struct in ( step, match e.hash with - | Snapshot.Contents (hash, ()) -> + | Snapshot.Contents hash -> let key = index hash in - `Contents (key, ()) + `Contents key | Node hash -> let key = index hash in `Node key ) @@ -1933,10 +1958,10 @@ struct { index = n.index; hash } in let value : T.step * T.value -> Compress.value = function - | s, `Contents (c, ()) -> + | s, `Contents c -> let s = step s in let v = address_of_key c in - Compress.Contents (s, v, ()) + Compress.Contents (s, v) | s, `Node n -> let s = step s in let v = address_of_key n in @@ -1982,10 +2007,10 @@ struct { index = n.index; vref } in let value : Compress.value -> T.step * T.value = function - | Contents (n, h, ()) -> + | Contents (n, h) -> let name = step n in let hash = key h in - (name, `Contents (hash, ())) + (name, `Contents hash) | Node (n, h) -> let name = step n in let hash = key h in @@ -2028,7 +2053,7 @@ struct | Values ls -> List.map (function - | Compress.Contents (_, address, ()) | Node (_, address) -> + | Compress.Contents (_, address) | Node (_, address) -> entry_of_address address) ls | Tree { entries; _ } -> @@ -2042,9 +2067,9 @@ struct fun (name, v) -> let step = step_to_bin name in match v with - | `Contents (contents_key, ()) -> + | `Contents contents_key -> let h = Key.to_hash contents_key in - { Snapshot.step; hash = Contents (h, ()) } + { Snapshot.step; hash = Contents h } | `Node node_key -> let h = Key.to_hash node_key in { step; hash = Node h } @@ -2314,16 +2339,23 @@ struct let contents_key_encoding = hash_encoding - type value = [ `Contents of hash * unit | `Node of hash ] - [@@deriving brassaia] + type value = [ `Contents of hash | `Node of hash ] + + let value_t : value Repr.ty = + let open Repr in + variant "Proof.value" (fun contents node -> function + | `Contents h -> contents (h, ()) | `Node h -> node h) + |~ case1 "contents" (pair hash_t unit) (fun (h, ()) -> `Contents h) + |~ case1 "node" hash_t (fun h -> `Node h) + |> sealv let value_encoding = let open Data_encoding in union [ case (Tag 1) ~title:"`Contents" (tup2 hash_encoding unit) - (function `Contents t -> Some t | _ -> None) - (fun t -> `Contents t); + (function `Contents t -> Some (t, ()) | _ -> None) + (fun (t, ()) -> `Contents t); case (Tag 2) ~title:"`Node" hash_encoding (function `Node h -> Some h | _ -> None) (fun h -> `Node h); diff --git a/brassaia/lib_brassaia_pack/inode_intf.ml b/brassaia/lib_brassaia_pack/inode_intf.ml index 367ec56db0d1..53e53d22b4a5 100644 --- a/brassaia/lib_brassaia_pack/inode_intf.ml +++ b/brassaia/lib_brassaia_pack/inode_intf.ml @@ -26,10 +26,7 @@ end module type Snapshot = sig type hash - - type kinded_hash = Contents of hash * unit | Node of hash - [@@deriving brassaia] - + type kinded_hash = Contents of hash | Node of hash [@@deriving brassaia] type entry = { step : string; hash : kinded_hash } [@@deriving brassaia] type inode_tree = { depth : int; length : int; pointers : (int * hash) list } @@ -109,7 +106,7 @@ module type Compress = sig type address = Offset of pack_offset | Hash of hash type ptr = { index : dict_key; hash : address } type tree = { depth : dict_key; length : dict_key; entries : ptr list } - type value = Contents of name * address * unit | Node of name * address + type value = Contents of name * address | Node of name * address type v = Values of value list | Tree of tree type v1 = { mutable length : int; v : v } @@ -160,7 +157,7 @@ module type Internal = sig (** The type for pointer kinds. *) type kinded_key = | Contents of contents_key - | Contents_x of unit * contents_key + | Contents_x of contents_key | Node of node_key [@@deriving brassaia] diff --git a/brassaia/lib_brassaia_pack/unix/store_intf.ml b/brassaia/lib_brassaia_pack/unix/store_intf.ml index ea584c81d99a..bcc011ccfe58 100644 --- a/brassaia/lib_brassaia_pack/unix/store_intf.ml +++ b/brassaia/lib_brassaia_pack/unix/store_intf.ml @@ -217,9 +217,7 @@ module type S = sig (** {1 Snapshots} *) module Snapshot : sig - type kinded_hash = Contents of hash * unit | Node of hash - [@@deriving brassaia] - + type kinded_hash = Contents of hash | Node of hash [@@deriving brassaia] type entry = { step : string; hash : kinded_hash } [@@deriving brassaia] type inode_tree = { diff --git a/brassaia/lib_brassaia_tezos/schema.ml b/brassaia/lib_brassaia_tezos/schema.ml index 9b58237d33b4..5db06070e537 100644 --- a/brassaia/lib_brassaia_tezos/schema.ml +++ b/brassaia/lib_brassaia_tezos/schema.ml @@ -87,7 +87,7 @@ struct let hash_of_entry (_, t) = match t with | `Node h -> Node_key.to_hash h - | `Contents (h, ()) -> Contents_key.to_hash h + | `Contents h -> Contents_key.to_hash h let metadata_t = let some = "\255\000\000\000\000\000\000\000" in diff --git a/brassaia/test/brassaia-pack/test_inode.ml b/brassaia/test/brassaia-pack/test_inode.ml index b66a42056e8b..66f2c7ebb1d7 100644 --- a/brassaia/test/brassaia-pack/test_inode.ml +++ b/brassaia/test/brassaia-pack/test_inode.ml @@ -192,7 +192,7 @@ let pp_pred = Brassaia.Type.pp pred_t module H_contents = Brassaia.Hash.Typed (Hash) (Schema.Contents) -let normal x = `Contents (x, ()) +let normal x = `Contents x let node x = `Node x let check_hash = Alcotest.check_repr Inode.Val.hash_t let check_values = Alcotest.check_repr Inode.Val.t diff --git a/brassaia/test/brassaia-pack/test_lower.ml b/brassaia/test/brassaia-pack/test_lower.ml index b77a9b49a4a0..db1600fee379 100644 --- a/brassaia/test/brassaia-pack/test_lower.ml +++ b/brassaia/test/brassaia-pack/test_lower.ml @@ -476,7 +476,7 @@ module Store_tc = struct let key_identifier = match kinded_key with | None -> assert false - | Some (`Contents (k, ())) -> get_volume_identifier k + | Some (`Contents k) -> get_volume_identifier k | Some (`Node k) -> get_volume_identifier k in [%log.debug "identifier: %s" key_identifier]; diff --git a/brassaia/test/brassaia-pack/test_tree.ml b/brassaia/test/brassaia-pack/test_tree.ml index ef2c34d533d9..65b6b6c8db18 100644 --- a/brassaia/test/brassaia-pack/test_tree.ml +++ b/brassaia/test/brassaia-pack/test_tree.ml @@ -516,7 +516,7 @@ let check_hash h s = let check_contents_hash h s = match h with | `Node _ -> Alcotest.failf "Expected kinded hash to be contents" - | `Contents (h, ()) -> + | `Contents h -> let s' = Brassaia.Type.(to_string Hash.t) h in Alcotest.(check string) "check hash" s s' @@ -632,8 +632,7 @@ let test_hardcoded_proof () = let state = P.state p in let check_depth_2 = function - | P.Inode_values - [ ("00000", Contents ("x", ())); ("00001", Blinded_contents (h1, ())) ] + | P.Inode_values [ ("00000", Contents "x"); ("00001", Blinded_contents h1) ] -> check_hash h1 "95cb0bfd2977c761298d9624e4b4d4c72a39974a" | t -> fail_with_inode_tree t @@ -665,7 +664,7 @@ let test_proof_exn _ = let stream_elt1 : P.elt = Contents y in let stream_elt2 : P.elt = Contents x in let stream_elt3 : P.elt = - Node [ ("bx", `Contents (hx, ())); ("by", `Contents (hy, ())) ] + Node [ ("bx", `Contents hx); ("by", `Contents hy) ] in let* tree = tree_of_list [ ([ "bx" ], "x"); ([ "by" ], "y") ] in let hash = Tree.hash tree in diff --git a/brassaia/test/brassaia-pack/test_upgrade.ml b/brassaia/test/brassaia-pack/test_upgrade.ml index 7d6b1c5df2fa..d2b6d18763af 100644 --- a/brassaia/test/brassaia-pack/test_upgrade.ml +++ b/brassaia/test/brassaia-pack/test_upgrade.ml @@ -293,7 +293,7 @@ module Store = struct let put_n01 bstore nstore = let* k_b01 = put_b01 bstore in let step = "step-b01" in - let childs = [ (step, `Contents (k_b01, ())) ] in + let childs = [ (step, `Contents k_b01) ] in let n = S.Backend.Node.Val.of_list childs in let+ k = S.Backend.Node.add nstore n in assert (k = key_of_entry n01); @@ -326,7 +326,7 @@ module Store = struct let k_n01 = key_of_entry n01 in let step = "step-b1" in let step' = "step-b01" in - let childs = [ (step, `Contents (k_b1, ())); (step', `Node k_n01) ] in + let childs = [ (step, `Contents k_b1); (step', `Node k_n01) ] in let n = S.Backend.Node.Val.of_list childs in let+ k = S.Backend.Node.add nstore n in assert (k = key_of_entry n1); @@ -355,7 +355,7 @@ module Store = struct let put_n2 bstore nstore = let* k_b2 = put_b2 bstore in let step = "step-b2" in - let childs = [ (step, `Contents (k_b2, ())) ] in + let childs = [ (step, `Contents k_b2) ] in let n = S.Backend.Node.Val.of_list childs in let+ k = S.Backend.Node.add nstore n in assert (k = key_of_entry n2); diff --git a/brassaia/test/brassaia/test_tree.ml b/brassaia/test/brassaia/test_tree.ml index 61b09e56e9d3..865e29f0b901 100644 --- a/brassaia/test/brassaia/test_tree.ml +++ b/brassaia/test/brassaia/test_tree.ml @@ -31,9 +31,7 @@ module Store = Brassaia_mem.Make (Schema) module Tree = Store.Tree open Schema -type diffs = (string list * (Contents.t * unit) Diff.t) list -[@@deriving brassaia] - +type diffs = (string list * Contents.t Diff.t) list [@@deriving brassaia] type kind = [ `Contents | `Node ] [@@deriving brassaia] module Alcotest = struct @@ -80,7 +78,7 @@ let ( let&* ) x f = Lwt_list.iter_s f x and ( and&* ) l m = List.concat_map (fun a -> List.map (fun b -> (a, b)) m) l let ( >> ) f g x = g (f x) -let c blob = `Contents (blob, ()) +let c blob = `Contents blob let invalid_tree () = let+ repo = Store.Repo.init (Brassaia_mem.config ()) in @@ -148,14 +146,14 @@ let test_diff _ () = Tree.diff empty single >|= Alcotest.(check diffs) "Added [k \226\134\146 v]" - [ ([ "k" ], `Added ("v", ())) ] + [ ([ "k" ], `Added "v") ] in (* Removing a single key *) let* () = Tree.diff single empty >|= Alcotest.(check diffs) "Removed [k \226\134\146 v]" - [ ([ "k" ], `Removed ("v", ())) ] + [ ([ "k" ], `Removed "v") ] in Lwt.return_unit @@ -638,7 +636,7 @@ module Broken = struct let random_contents () = let value = Tree.of_concrete (c (random_string32 ())) in - let value_ptr = `Contents (Tree.hash value, ()) in + let value_ptr = `Contents (Tree.hash value) in (value, value_ptr) let random_node () = diff --git a/brassaia/test/helpers/common.ml b/brassaia/test/helpers/common.ml index 0f09d20f27fd..dd627dc24ab3 100644 --- a/brassaia/test/helpers/common.ml +++ b/brassaia/test/helpers/common.ml @@ -166,7 +166,7 @@ module Make_helpers (S : Generic_key) = struct let with_info repo n f = with_commit repo (fun h -> f h ~info:(info n)) let kv1 ~repo = with_contents repo (fun t -> B.Contents.add t v1) let kv2 ~repo = with_contents repo (fun t -> B.Contents.add t v2) - let normal x = `Contents (x, ()) + let normal x = `Contents x let b1 = "foo" let b2 = "bar/toto" diff --git a/brassaia/test/helpers/node.ml b/brassaia/test/helpers/node.ml index b919a142590e..2cfdc999c664 100644 --- a/brassaia/test/helpers/node.ml +++ b/brassaia/test/helpers/node.ml @@ -118,8 +118,15 @@ end = struct type key = Key.t [@@deriving brassaia] module Extras = struct - type data = [ `Node of Key.t | `Contents of Key.t * unit ] - [@@deriving brassaia] + type data = [ `Node of Key.t | `Contents of Key.t ] + + let data_t = + let open Repr in + variant "weak_value" (fun node contents -> function + | `Node k -> node k | `Contents k -> contents (k, ())) + |~ case1 "node" key_t (fun k -> `Node k) + |~ case1 "contents" (pair key_t unit) (fun (k, ()) -> `Contents k) + |> sealv let random_data = let hash_of_string = Brassaia.Type.(unstage (of_bin_string Hash.t)) in @@ -132,7 +139,7 @@ end = struct | Ok x -> ( match Random.int 2 with | 0 -> `Node x - | 1 -> `Contents (x, ()) + | 1 -> `Contents x | _ -> assert false) end diff --git a/brassaia/test/helpers/store.ml b/brassaia/test/helpers/store.ml index 8fabd131a6e6..2191242ab0e2 100644 --- a/brassaia/test/helpers/store.ml +++ b/brassaia/test/helpers/store.ml @@ -74,7 +74,7 @@ module Make (S : Generic_key) = struct in may repo heads hook - let contents c = S.Tree.init (`Contents (c, ())) + let contents c = S.Tree.init (`Contents c) let test_contents x () = let test repo = @@ -483,7 +483,7 @@ module Make (S : Generic_key) = struct Lwt_list.fold_left_s (fun t (k, v) -> let* v = with_contents repo (fun t -> B.Contents.add t v) in - Graph.add g t k (`Contents (v, ()))) + Graph.add g t k (`Contents v)) empty bindings) in let tree bindings = @@ -1108,7 +1108,7 @@ module Make (S : Generic_key) = struct let pp_depth = Brassaia.Type.pp S.Tree.depth_t let pp_key = Brassaia.Type.pp S.Path.t - let contents_t = T.pair S.contents_t Repr.unit + let contents_t = S.contents_t let diff_t = T.(pair S.path_t (Brassaia.Diff.t contents_t)) let check_diffs = checks diff_t let check_ls = checks T.(pair S.step_t S.tree_t) @@ -1209,13 +1209,12 @@ module Make (S : Generic_key) = struct node; (* Testing [Tree.diff] *) - let contents_t = T.pair S.contents_t Repr.unit in + let contents_t = S.contents_t in let diff = T.(pair S.path_t (Brassaia.Diff.t contents_t)) in let check_diffs = checks diff in let check_val = check T.(option contents_t) in let check_ls = checks T.(pair S.step_t S.tree_t) in - let normal c = Some (c, ()) in - let d0 = () in + let normal c = Some c in let v0 = S.Tree.empty () in let v1 = S.Tree.empty () in let v2 = S.Tree.empty () in @@ -1231,21 +1230,20 @@ module Make (S : Generic_key) = struct let* v2 = S.Tree.add v2 [ "foo"; "1" ] foo2 in let* v2 = S.Tree.add v2 [ "foo"; "2" ] foo1 in let* d1 = S.Tree.diff v0 v1 in - check_diffs "diff 1" [ ([ "foo"; "1" ], `Added (foo1, d0)) ] d1; + check_diffs "diff 1" [ ([ "foo"; "1" ], `Added foo1) ] d1; let* d2 = S.Tree.diff v1 v0 in - check_diffs "diff 2" [ ([ "foo"; "1" ], `Removed (foo1, d0)) ] d2; + check_diffs "diff 2" [ ([ "foo"; "1" ], `Removed foo1) ] d2; let* d3 = S.Tree.diff v1 v2 in check_diffs "diff 3" [ - ([ "foo"; "1" ], `Updated ((foo1, d0), (foo2, d0))); - ([ "foo"; "2" ], `Added (foo1, d0)); + ([ "foo"; "1" ], `Updated (foo1, foo2)); ([ "foo"; "2" ], `Added foo1); ] d3; let* v3 = S.Tree.add v2 [ "foo"; "bar"; "1" ] foo1 in let* d4 = S.Tree.diff v2 v3 in - check_diffs "diff 4" [ ([ "foo"; "bar"; "1" ], `Added (foo1, d0)) ] d4; + check_diffs "diff 4" [ ([ "foo"; "bar"; "1" ], `Added foo1) ] d4; let* d5 = S.Tree.diff v3 v2 in - check_diffs "diff 4" [ ([ "foo"; "bar"; "1" ], `Removed (foo1, d0)) ] d5; + check_diffs "diff 4" [ ([ "foo"; "bar"; "1" ], `Removed foo1) ] d5; (* Testing length *) let check_length msg t = @@ -1261,7 +1259,7 @@ module Make (S : Generic_key) = struct (* Testing paginated lists *) let tree = - let c ?(info = ()) blob = `Contents (blob, info) in + let c blob = `Contents blob in S.Tree.of_concrete (`Tree [ @@ -1682,10 +1680,8 @@ module Make (S : Generic_key) = struct let* () = Lwt_list.iter_s check_proof [ f0; f1 ] in (* check env sharing *) - let tree () = - S.Tree.of_concrete (`Tree [ ("foo", `Contents ("bar", ())) ]) - in - let contents () = S.Tree.of_concrete (`Contents ("bar", ())) in + let tree () = S.Tree.of_concrete (`Tree [ ("foo", `Contents "bar") ]) in + let contents () = S.Tree.of_concrete (`Contents "bar") in let check_env_empty msg t b = let env = S.Tree.Private.get_env t in Alcotest.(check bool) msg b (S.Tree.Private.Env.is_empty env) @@ -1764,8 +1760,8 @@ module Make (S : Generic_key) = struct Blinded_node wrong_hash; Node []; Inode { length = 1024; proofs = [] }; - Blinded_contents (wrong_hash, ()); - Contents ("yo", ()); + Blinded_contents wrong_hash; + Contents "yo"; ] in let* () = @@ -1847,7 +1843,7 @@ module Make (S : Generic_key) = struct in (match B.Node.Val.find v "499999" with | None | Some (`Node _) -> Alcotest.fail "value 499999 not found" - | Some (`Contents (x, _)) -> + | Some (`Contents x) -> let x = B.Contents.Key.to_hash x in let x' = B.Contents.Hash.hash "499999" in check B.Contents.Hash.t "find 499999" x x'); @@ -2330,7 +2326,7 @@ module Make (S : Generic_key) = struct let* node_3 = let+ contents_foo = contents "foo" in S.Backend.Node.Val.of_list - [ ("foo", `Contents (contents_foo, ())); ("bar", `Node bar_k) ] + [ ("foo", `Contents contents_foo); ("bar", `Node bar_k) ] in let tree_3 = S.Tree.of_node (S.of_backend_node repo node_3) in let* _ = diff --git a/brassaia/test/helpers/store_graph.ml b/brassaia/test/helpers/store_graph.ml index 55938279bfa5..db793128d35f 100644 --- a/brassaia/test/helpers/store_graph.ml +++ b/brassaia/test/helpers/store_graph.ml @@ -44,7 +44,7 @@ module Make (S : Generic_key) = struct Lwt.return_unit in let contents ?order k = - let e = `Contents (k, ()) in + let e = `Contents k in if mem e !visited then Alcotest.failf "contents %a visited twice" (Brassaia.Type.pp B.Contents.Key.t) @@ -114,7 +114,7 @@ module Make (S : Generic_key) = struct in let test1 () = let* foo = with_contents repo (fun c -> B.Contents.add c "foo") in - let foo_k = (foo, ()) in + let foo_k = foo in let* k1 = with_node repo (fun g -> Graph.init g [ ("b", normal foo) ]) in @@ -142,7 +142,7 @@ module Make (S : Generic_key) = struct (* Graph.iter requires a node as max, we cannot test a graph with only contents. *) let* foo = with_contents repo (fun c -> B.Contents.add c "foo") in - let foo_k = (foo, ()) in + let foo_k = foo in let* k1 = with_node repo (fun g -> Graph.init g [ ("b", normal foo) ]) in @@ -157,7 +157,7 @@ module Make (S : Generic_key) = struct in let test3 () = let* foo = with_contents repo (fun c -> B.Contents.add c "foo") in - let foo_k = (foo, ()) in + let foo_k = foo in let* kb1 = with_node repo (fun g -> Graph.init g [ ("b1", normal foo) ]) in diff --git a/src/lib_context_brassaia/disk/context.ml b/src/lib_context_brassaia/disk/context.ml index 49fb9ba21e33..450387e99c47 100644 --- a/src/lib_context_brassaia/disk/context.ml +++ b/src/lib_context_brassaia/disk/context.ml @@ -451,7 +451,7 @@ module Make (Encoding : module type of Tezos_context_encoding.Context) = struct let rec tree_to_raw_context tree = let open Lwt_syntax in match Store.Tree.destruct tree with - | `Contents (v, _) -> + | `Contents v -> let+ v = Store.Tree.Contents.force_exn v in Proof.Key v | `Node _ -> diff --git a/src/lib_context_brassaia/encoding/context.ml b/src/lib_context_brassaia/encoding/context.ml index 41bc43e95667..3b1fbb8fedb3 100644 --- a/src/lib_context_brassaia/encoding/context.ml +++ b/src/lib_context_brassaia/encoding/context.ml @@ -138,7 +138,7 @@ struct let hash_of_entry (_, t) = match t with | `Node h -> Node_key.to_hash h - | `Contents (h, ()) -> Contents_key.to_hash h + | `Contents h -> Contents_key.to_hash h (* Brassaia 1.4 uses int64 to store list lengths *) let entry_t : entry Brassaia.Type.t = diff --git a/src/lib_context_brassaia/helpers/context.ml b/src/lib_context_brassaia/helpers/context.ml index 4497908f6768..21867c9972d4 100644 --- a/src/lib_context_brassaia/helpers/context.ml +++ b/src/lib_context_brassaia/helpers/context.ml @@ -33,11 +33,11 @@ module type DB = Brassaia.Generic_key.S with module Schema = Schema module Kinded_hash = struct let of_context_hash = function - | `Value h -> `Contents (Hash.of_context_hash h, ()) + | `Value h -> `Contents (Hash.of_context_hash h) | `Node h -> `Node (Hash.of_context_hash h) let to_context_hash = function - | `Contents (h, ()) -> `Value (Hash.to_context_hash h) + | `Contents h -> `Value (Hash.to_context_hash h) | `Node h -> `Node (Hash.to_context_hash h) end @@ -89,7 +89,7 @@ module Make_tree (Conf : Conf) (Store : DB) = struct let to_value t = let open Lwt_syntax in match Store.Tree.destruct t with - | `Contents (c, _) -> + | `Contents c -> let+ v = Store.Tree.Contents.force_exn c in Some v | `Node _ -> Lwt.return_none @@ -125,7 +125,7 @@ module Make_tree (Conf : Conf) (Store : DB) = struct let rec raw_of_concrete : type a. (raw -> a) -> concrete -> a = fun k -> function | `Tree l -> raw_of_node (fun l -> k (`Tree (String.Map.of_seq l))) l - | `Contents (v, _) -> k (`Value v) + | `Contents v -> k (`Value v) and raw_of_node : type a. ((string * raw) Seq.t -> a) -> (string * concrete) list -> a = @@ -144,7 +144,7 @@ module Make_tree (Conf : Conf) (Store : DB) = struct let rec concrete_of_raw : type a. (concrete -> a) -> raw -> a = fun k -> function | `Tree l -> concrete_of_node (fun l -> k (`Tree l)) (String.Map.to_seq l) - | `Value v -> k (`Contents (v, ())) + | `Value v -> k (`Contents v) and concrete_of_node : type a. ((string * concrete) list -> a) -> (string * raw) Seq.t -> a = @@ -208,7 +208,7 @@ module Make_tree (Conf : Conf) (Store : DB) = struct let kinded_key t = match Store.Tree.key t with | (None | Some (`Node _)) as r -> r - | Some (`Contents (v, ())) -> Some (`Value v) + | Some (`Contents v) -> Some (`Value v) let is_shallow tree = match Store.Tree.inspect tree with @@ -272,8 +272,8 @@ struct {length; proofs = List.map (fun (k, v) -> (k, f v)) proofs} and to_tree : DB_proof.tree -> tree = function - | Contents (c, ()) -> Value c - | Blinded_contents (h, ()) -> Blinded_value (Hash.to_context_hash h) + | Contents c -> Value c + | Blinded_contents h -> Blinded_value (Hash.to_context_hash h) | Node l -> Node (List.map (fun (k, v) -> (k, to_tree v)) l) | Blinded_node h -> Blinded_node (Hash.to_context_hash h) | Inode i -> Inode (to_inode to_inode_tree i) @@ -296,8 +296,8 @@ struct {length; proofs = List.map (fun (k, v) -> (k, f v)) proofs} and of_tree : tree -> DB_proof.tree = function - | Value c -> Contents (c, ()) - | Blinded_value h -> Blinded_contents (Hash.of_context_hash h, ()) + | Value c -> Contents c + | Blinded_value h -> Blinded_contents (Hash.of_context_hash h) | Node l -> Node (List.map (fun (k, v) -> (k, of_tree v)) l) | Blinded_node h -> Blinded_node (Hash.of_context_hash h) | Inode i -> Inode (of_inode of_inode_tree i) @@ -365,9 +365,7 @@ struct let produce_tree_proof repo key f = let open Lwt_syntax in - let key = - match key with `Node n -> `Node n | `Value v -> `Contents (v, ()) - in + let key = match key with `Node n -> `Node n | `Value v -> `Contents v in let+ p, r = Store.Tree.produce_proof repo key f in (Proof.to_tree p, r) @@ -377,9 +375,7 @@ struct let produce_stream_proof repo key f = let open Lwt_syntax in - let key = - match key with `Node n -> `Node n | `Value v -> `Contents (v, ()) - in + let key = match key with `Node n -> `Node n | `Value v -> `Contents v in let+ p, r = Store.Tree.produce_stream repo key f in (Proof.to_stream p, r) diff --git a/src/lib_context_brassaia/memory/context.ml b/src/lib_context_brassaia/memory/context.ml index 5ab92dca4eca..bb1af8ee1f05 100644 --- a/src/lib_context_brassaia/memory/context.ml +++ b/src/lib_context_brassaia/memory/context.ml @@ -73,7 +73,7 @@ module Make (Encoding : module type of Tezos_context_encoding.Context) = struct Some (match h with | `Node hash -> `Node (Hash.to_context_hash hash) - | `Contents (hash, ()) -> `Value (Hash.to_context_hash hash)) + | `Contents hash -> `Value (Hash.to_context_hash hash)) end type index = { @@ -255,7 +255,7 @@ module Make (Encoding : module type of Tezos_context_encoding.Context) = struct let rec tree_to_raw_context tree = let open Lwt_syntax in match Store.Tree.destruct tree with - | `Contents (v, _) -> + | `Contents v -> let+ v = Store.Tree.Contents.force_exn v in Proof.Key v | `Node _ -> @@ -562,8 +562,8 @@ module Make (Encoding : module type of Tezos_context_encoding.Context) = struct ~title:"value" (Tag 1) bytes - (function `Contents (v, _) -> Some v | `Tree _ -> None) - (fun v -> `Contents (v, ())); + (function `Contents v -> Some v | `Tree _ -> None) + (fun v -> `Contents v); ]) let encoding : t Data_encoding.t = -- GitLab