diff --git a/.gitlab/ci/templates.yml b/.gitlab/ci/templates.yml index e147bb40df4b020114ab1e8c508f0f7ab9869da9..0aa1c1c3e364f73b29efa87ebe9f76a083bd12a5 100644 --- a/.gitlab/ci/templates.yml +++ b/.gitlab/ci/templates.yml @@ -1,6 +1,6 @@ variables: ## This value MUST be the same as `opam_repository_tag` in `scripts/version.sh` - build_deps_image_version: 736a35328609e04e1c9e320485f3a47b5fa3251c + build_deps_image_version: b53a5e8c3fa7764d5ae6567d7a817315507c9f0d build_deps_image_name: registry.gitlab.com/tezos/opam-repository GIT_STRATEGY: fetch GIT_DEPTH: "1" diff --git a/manifest/main.ml b/manifest/main.ml index 6ebf5a93c66dbef86b75e165391388e8cbc1bf20..d2bfcae667d38d4e144cb5e37189d878c02b5f25 100644 --- a/manifest/main.ml +++ b/manifest/main.ml @@ -106,9 +106,10 @@ let ipaddr = external_lib "ipaddr" [At_least "5.0.0"; Less_than "6.0.0"] let ipaddr_unix = external_sublib ipaddr "ipaddr.unix" -let irmin = external_lib "irmin" [At_least "2.8.0"] +let irmin = external_lib "irmin" [At_least "2.10.0"; Less_than "2.11.0"] -let irmin_pack = external_lib "irmin-pack" [At_least "2.8.0"] +let irmin_pack = + external_lib "irmin-pack" [At_least "2.10.0"; Less_than "2.11.0"] let irmin_pack_mem = external_sublib irmin_pack "irmin-pack.mem" @@ -197,9 +198,9 @@ let resto_cohttp_server = external_lib "resto-cohttp-server" resto_version let resto_directory = external_lib "resto-directory" resto_version -let ringo = external_lib "ringo" [Exactly "0.5"] +let ringo = external_lib "ringo" [Exactly "0.7"] -let ringo_lwt = external_lib "ringo-lwt" [Exactly "0.5"] +let ringo_lwt = external_lib "ringo-lwt" [Exactly "0.7"] let secp256k1_internal = external_lib "secp256k1-internal" [] diff --git a/scripts/version.sh b/scripts/version.sh index 05181a751875fa39f02ff5d6a80f87acccd199f5..e2333947b23214d63e26bbe2c763394c797013cd 100755 --- a/scripts/version.sh +++ b/scripts/version.sh @@ -20,12 +20,12 @@ export recommended_node_version=14.12.0 ## full_opam_repository is a commit hash of the public OPAM repository, i.e. ## https://github.com/ocaml/opam-repository -export full_opam_repository_tag=87bf0c8a02e89350c38353a95c84b0863f710e49 +export full_opam_repository_tag=1c55af16c8ffc84a4dfc35b256be9818f7dbe21a ## opam_repository is an additional, tezos-specific opam repository. ## This value MUST be the same as `build_deps_image_version` in `.gitlab/ci/templates.yml export opam_repository_url=https://gitlab.com/tezos/opam-repository -export opam_repository_tag=736a35328609e04e1c9e320485f3a47b5fa3251c +export opam_repository_tag=b53a5e8c3fa7764d5ae6567d7a817315507c9f0d export opam_repository_git=$opam_repository_url.git export opam_repository=$opam_repository_git\#$opam_repository_tag diff --git a/src/lib_context/context.ml b/src/lib_context/context.ml index 28c109b891a10025d1b8d2ea0b6a3397838b3825..55458036ea18c0e36bfe5ab1e54ffb09ab53c313 100644 --- a/src/lib_context/context.ml +++ b/src/lib_context/context.ml @@ -280,6 +280,7 @@ type value = bytes type tree = Store.tree module Tree = Tezos_context_helpers.Context.Make_tree (Store) +module Proof = Tree.Proof let mem ctxt key = Tree.mem ctxt.tree (data_key key) @@ -290,6 +291,8 @@ let raw_find ctxt key = Tree.find ctxt.tree key let list ctxt ?offset ?length key = Tree.list ctxt.tree ?offset ?length (data_key key) +let length ctxt key = Tree.length ctxt.tree key + let find ctxt key = raw_find ctxt (data_key key) let incr_ops ctxt = {ctxt with ops = ctxt.ops + 1} @@ -505,7 +508,7 @@ let close index = Store.Repo.close index.repo let get_branch chain_id = Format.asprintf "%a" Chain_id.pp chain_id let commit_genesis index ~chain_id ~time ~protocol = - let tree = Store.Tree.empty in + let tree = Store.Tree.empty () in let ctxt = {index; tree; parents = []; ops = 0} in (match index.patch_context with | None -> return ctxt @@ -717,7 +720,7 @@ module Dumpable_context = struct aux tree Fun.id >>= fun () -> Lwt.return !total_visited let make_context index = - {index; tree = Store.Tree.empty; parents = []; ops = 0} + {index; tree = Store.Tree.empty (); parents = []; ops = 0} let update_context context tree = {context with tree} @@ -736,10 +739,10 @@ module Dumpable_context = struct let add_dir batch l = let add sub_tree (step, hash) = match sub_tree with - | None -> Lwt.return_some Store.Tree.empty + | None -> Lwt.return_some (Store.Tree.empty ()) | Some sub_tree -> add_hash batch sub_tree [step] hash in - Seq_es.fold_left_s add (Some Store.Tree.empty) l >>=? function + Seq_es.fold_left_s add (Some (Store.Tree.empty ())) l >>=? function | None -> Lwt.return_ok None | Some tree -> let (Batch (repo, x, y)) = batch in @@ -789,7 +792,7 @@ let check_protocol_commit_consistency index ~expected_context_hash let data_merkle_root = Hash.of_context_hash data_merkle_root in let parents = List.map Hash.of_context_hash parents_contexts in let protocol_hash_bytes = Protocol_hash.to_bytes given_protocol_hash in - let tree = Store.Tree.empty in + let tree = Store.Tree.empty () in Store.Tree.add tree current_protocol_key protocol_hash_bytes >>= fun tree -> let test_chain_status_bytes = Data_encoding.Binary.to_bytes_exn @@ -831,7 +834,7 @@ let check_protocol_commit_consistency index ~expected_context_hash if Context_hash.equal expected_context_hash computed_context_hash then let ctxt = let parent = Store.of_private_commit index.repo commit in - {index; tree = Store.Tree.empty; parents = [parent]; ops = 0} + {index; tree = Store.Tree.empty (); parents = [parent]; ops = 0} in add_test_chain ctxt test_chain_status >>= fun ctxt -> add_protocol ctxt given_protocol_hash >>= fun ctxt -> diff --git a/src/lib_context/encoding/context.ml b/src/lib_context/encoding/context.ml index 6703947cbd52cea7eb4bfdc6a1b806355c8a754c..55940161c1f01d64f44a0e89d1b7835f42a27f74 100644 --- a/src/lib_context/encoding/context.ml +++ b/src/lib_context/encoding/context.ml @@ -37,6 +37,8 @@ module Conf = struct let entries = 32 let stable_hash = 256 + + let inode_child_order = `Seeded_hash end module Hash : sig diff --git a/src/lib_context/helpers/context.ml b/src/lib_context/helpers/context.ml index b1e4d0c0d15c73def7c562eb8e60e8aa41384912..76bc77ad5defc181765d7184cae179ea6b425dc5 100644 --- a/src/lib_context/helpers/context.ml +++ b/src/lib_context/helpers/context.ml @@ -39,13 +39,141 @@ module type DB = module Make_tree (Store : DB) = struct include Store.Tree + module Kinded_hash = struct + let of_context_hash = function + | `Contents h -> `Contents (Hash.of_context_hash h, ()) + | `Node h -> `Node (Hash.of_context_hash h) + + let to_context_hash = function + | `Contents (h, ()) -> `Contents (Hash.to_context_hash h) + | `Node h -> `Node (Hash.to_context_hash h) + end + + module DB_proof = Store.Tree.Proof + + module Proof = struct + include Tezos_context_sigs.Context.Proof_types + + let v ~before ~after state = {before; after; state} + + let before t = t.before + + let after t = t.after + + let state t = t.state + + module State = struct + let rec to_inode : type a b. (a -> b) -> a DB_proof.inode -> b inode = + fun f {length; proofs} -> + {length; proofs = List.map (fun (k, v) -> (k, f v)) proofs} + + and to_tree : DB_proof.tree -> tree = function + | Contents (c, ()) -> Contents c + | Blinded_contents (h, ()) -> Blinded_contents (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) + | Extender e -> Extender (to_inode_extender to_inode_tree e) + + and to_inode_extender : + type a b. (a -> b) -> a DB_proof.inode_extender -> b inode_extender = + fun f {length; segments; proof} -> {length; segments; proof = f proof} + + and to_inode_tree : DB_proof.inode_tree -> tree inode_tree = function + | Blinded_inode h -> Blinded_inode (Hash.to_context_hash h) + | Inode_values l -> + Inode_values (List.map (fun (k, v) -> (k, to_tree v)) l) + | Inode_tree i -> Inode_tree (to_inode to_inode_tree i) + | Inode_extender e -> Inode_extender (to_inode_extender to_inode_tree e) + + let rec of_inode : type a b. (a -> b) -> a inode -> b DB_proof.inode = + fun f {length; proofs} -> + {length; proofs = List.map (fun (k, v) -> (k, f v)) proofs} + + and of_tree : tree -> DB_proof.tree = function + | Contents c -> Contents (c, ()) + | Blinded_contents 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) + | Extender e -> Extender (of_inode_extender of_inode_tree e) + + and of_inode_extender : + type a b. (a -> b) -> a inode_extender -> b DB_proof.inode_extender = + fun f {length; segments; proof} -> {length; segments; proof = f proof} + + and of_inode_tree : tree inode_tree -> DB_proof.inode_tree = function + | Blinded_inode h -> Blinded_inode (Hash.of_context_hash h) + | Inode_values l -> + Inode_values (List.map (fun (k, v) -> (k, of_tree v)) l) + | Inode_tree i -> Inode_tree (of_inode of_inode_tree i) + | Inode_extender e -> Inode_extender (of_inode_extender of_inode_tree e) + + let of_stream_elt : elt -> DB_proof.elt = function + | Contents c -> Contents c + | Node l -> + Node (List.map (fun (k, v) -> (k, Kinded_hash.of_context_hash v)) l) + | Inode i -> Inode (of_inode Hash.of_context_hash i) + | Inode_extender e -> + Inode_extender (of_inode_extender Hash.of_context_hash e) + + let of_stream : stream -> DB_proof.stream = Seq.map of_stream_elt + + let to_stream_elt : DB_proof.elt -> elt = function + | Contents c -> Contents c + | Node l -> + Node (List.map (fun (k, v) -> (k, Kinded_hash.to_context_hash v)) l) + | Inode i -> Inode (to_inode Hash.to_context_hash i) + | Inode_extender e -> + Inode_extender (to_inode_extender Hash.to_context_hash e) + + let to_stream : DB_proof.stream -> stream = Seq.map to_stream_elt + end + + let of_proof f p = + let before = Kinded_hash.to_context_hash (Proof.before p) in + let after = Kinded_hash.to_context_hash (Proof.after p) in + let state = f (Proof.state p) in + v ~before ~after state + + let to_proof f p = + let before = Kinded_hash.of_context_hash p.before in + let after = Kinded_hash.of_context_hash p.after in + let state = f p.state in + DB_proof.v ~before ~after state + + let to_tree = of_proof State.to_tree + + let of_tree = to_proof State.of_tree + + let to_stream = of_proof State.to_stream + + let of_stream = to_proof State.of_stream + end + + let produce_proof repo hash f = + let hash = Kinded_hash.of_context_hash hash in + produce_proof repo hash f >|= fun (p, r) -> (Proof.to_tree p, r) + + let verify_proof proof f = + let proof = Proof.of_tree proof in + verify_proof proof f + + let produce_stream repo hash f = + let hash = Kinded_hash.of_context_hash hash in + produce_stream repo hash f >|= fun (p, r) -> (Proof.to_stream p, r) + + let verify_stream proof f = + let proof = Proof.of_stream proof in + verify_stream proof f + let pp = Irmin.Type.pp Store.tree_t - let empty _ = Store.Tree.empty + let empty _ = Store.Tree.empty () let equal = Irmin.Type.(unstage (equal Store.tree_t)) - let is_empty t = equal Store.Tree.empty t + let is_empty t = equal (Store.Tree.empty ()) t let hash t = Hash.to_context_hash (Store.Tree.hash t) @@ -59,7 +187,7 @@ module Make_tree (Store : DB) = struct | `Contents (c, _) -> Store.Tree.Contents.force_exn c >|= Option.some | `Node _ -> Lwt.return_none - let of_value _ v = Store.Tree.add Store.Tree.empty [] v + let of_value _ v = Store.Tree.add (Store.Tree.empty ()) [] v let fold ?depth t k ~(order : [`Sorted | `Undefined]) ~init ~f = find_tree t k >>= function @@ -166,8 +294,12 @@ module Make_tree (Store : DB) = struct let list tree ?offset ?length key = Store.Tree.list ~cache:true tree ?offset ?length key + let length tree key = Store.Tree.length ~cache:true tree key + exception Context_dangling_hash of string + exception Dangling_hash = Store.Private.Node.Val.Dangling_hash + let find_tree tree key = Lwt.catch (fun () -> Store.Tree.find_tree tree key) diff --git a/src/lib_context/helpers/context.mli b/src/lib_context/helpers/context.mli index 6cb92ca60e4d4888aaab5e550c1997e2cf6143e9..381af4145bd4d9164e817d6e0474b69a5f51e7bd 100644 --- a/src/lib_context/helpers/context.mli +++ b/src/lib_context/helpers/context.mli @@ -44,6 +44,8 @@ module Make_tree (DB : DB) : sig and type value := DB.contents and type tree := DB.tree + module Proof : Tezos_context_sigs.Context.PROOF + val pp : Format.formatter -> DB.tree -> unit val empty : _ -> DB.tree @@ -66,6 +68,29 @@ module Make_tree (DB : DB) : sig val shallow : DB.repo -> kinded_hash -> DB.tree + type tree_proof := Proof.tree Proof.t + + type stream_proof := Proof.stream Proof.t + + type ('proof, 'result) producer := + repo -> + kinded_hash -> + (DB.tree -> (DB.tree * 'result) Lwt.t) -> + ('proof * 'result) Lwt.t + + type ('proof, 'result) verifier := + 'proof -> + (DB.tree -> (DB.tree * 'result) Lwt.t) -> + (DB.tree * 'result, [`Msg of string]) result Lwt.t + + val produce_proof : (tree_proof, 'a) producer + + val verify_proof : (tree_proof, 'a) verifier + + val produce_stream : (stream_proof, 'a) producer + + val verify_stream : (stream_proof, 'a) verifier + (** Exception raised by [find_tree] and [add_tree] when applied to shallow trees. It is exposed for so that the memory context can in turn raise it. *) exception Context_dangling_hash of string diff --git a/src/lib_context/memory/context.ml b/src/lib_context/memory/context.ml index d08da2bc92f7b93dad5912b691dca65c05fd4ba2..ced87f72a5518e624d2348e56b7c8969d51e4ffe 100644 --- a/src/lib_context/memory/context.ml +++ b/src/lib_context/memory/context.ml @@ -115,6 +115,8 @@ let mem_tree ctxt key = Tree.mem_tree ctxt.tree (data_key key) let list ctxt ?offset ?length key = Tree.list ctxt.tree ?offset ?length (data_key key) +let length ctxt key = Tree.length ctxt.tree key + let find ctxt key = Tree.find ctxt.tree (data_key key) let raw_add ctxt key data = @@ -175,7 +177,7 @@ let create () = let cfg = Irmin_pack.config "/tmp" in let promise = Store.Repo.v cfg >>= fun repo -> - Lwt.return {repo; parents = []; tree = Store.Tree.empty} + Lwt.return {repo; parents = []; tree = Store.Tree.empty ()} in match Lwt.state promise with | Lwt.Return result -> result diff --git a/src/lib_context/sigs/context.ml b/src/lib_context/sigs/context.ml index b189055846ed28cabbffa666fc11319b3aeefc4d..a47f2b3f24e96442e96b2281658152d128adfce2 100644 --- a/src/lib_context/sigs/context.ml +++ b/src/lib_context/sigs/context.ml @@ -63,6 +63,13 @@ module type VIEW = sig val list : t -> ?offset:int -> ?length:int -> key -> (string * tree) list Lwt.t + (** [length t key] is an Lwt promise that resolve to the number of + files and sub-nodes stored under [k] in [t]. + + It is equivalent to [list t k >|= List.length] but has a + constant-time complexity. *) + val length : t -> key -> int Lwt.t + (** {2 Setters} *) (** [add t k v] is an Lwt promise that resolves to [c] such that: @@ -179,9 +186,147 @@ module type HASH_VERSION = sig val set_hash_version : t -> Context_hash.Version.t -> t Lwt.t end +module Proof_types = struct + (** The type for node segments. *) + type segment = string + + (** The type for contents. *) + type contents = bytes + + (** The type for hashes. *) + type hash = Context_hash.t + + (** The type for (internal) inode proofs. + + These proofs encode large directories into a more efficient tree-like + structure. + + Invariant are dependent on the backend. + + [length] is the total number of entries in the chidren of the inode. + E.g. the size of the "flattened" version of that inode. This is used + to efficiently implements paginated lists. + + [proofs] have a length of at most [Conf.entries] entries. This list can + be sparse so every proof is indexed by their position between + [0 ... (Conf.entries-1)]. For binary trees, this boolean + index is a segment of the left-right decision proof corresponding + to the path in that binary tree. *) + type 'a inode = {length : int; proofs : (int * 'a) list} + + (** The type for inode extenders. *) + type 'a inode_extender = {length : int; segments : int list; proof : 'a} + [@@deriving irmin] + + (** The type for inode trees. + + Inodes are optimized representations of trees. Pointers in that trees + would refer to blinded nodes, nodes or to other inodes. E.g. + Blinded content nor contents are not expected to appear directly in + an inode tree. *) + type 'tree inode_tree = + | Blinded_inode of hash + | Inode_values of (segment * 'tree) list + | Inode_tree of 'tree inode_tree inode + | Inode_extender of 'tree inode_tree inode_extender + [@@deriving irmin] + + (** The type for compressed and partial Merkle tree proofs. + + [Blinded_contents h] is a shallow pointer to contents having hash [h]. + [Contents c] is the contents [c]. + + Tree proofs do not provide any guarantee with the ordering of + computations. For instance, if two effects commute, they won't be + distinguishable by this kind of proofs. + + [Blinded_node h] is a shallow pointer to a node having hash [h]. + + [Node ls] is a "flat" node containing the list of files [ls]. The length + of [ls] is at most [Conf.stable_hash]. + + [Inode i] is an optimized representation of a node as a tree. + + *) + type tree = + | Contents of contents + | Blinded_contents of hash + | Node of (segment * tree) list + | Blinded_node of hash + | Inode of tree inode_tree inode + | Extender of tree inode_tree inode_extender + [@@deriving irmin] + + (** The type for kinded hashes. *) + type kinded_hash = [`Contents of Context_hash.t | `Node of Context_hash.t] + + (** The type for elements of stream proofs. *) + type elt = + | Contents of contents + | Node of (segment * kinded_hash) list + | Inode of hash inode + | Inode_extender of hash inode_extender + [@@deriving irmin] + + (** The type for stream proofs. Stream poofs provides stronger ordering + guarantees as the read effects have to happen in the exact same order and + they are easier to verify. *) + type stream = elt Seq.t [@@deriving irmin] + + type 'a t = {before : kinded_hash; after : kinded_hash; state : 'a} +end + +module type PROOF = sig + (** Proofs are compact representations of trees which can be shared + between a node and a client. + + The protocol is the following: + + - The node runs a function [f] over a tree [t]. While performing + this computation, the node records: the hash of [t] (called [before] + below), the hash of [f t] (called [after] below) and a subset of [t] + which is needed to replay [f] without any access to the node's storage. + Once done, the node packs this into a proof [p] and sends this to the + client. + + - The client generates an initial tree [t'] from [p] and computes [f t']. + Once done, it compares [t']'s hash and [f t']'s hash to [before] and + [after]. If they match, they know that the result state [f t'] is a + valid context state, without having to have access to the full node's + storage. *) + + include + module type of Proof_types + with type 'a inode = 'a Proof_types.inode + and type 'a inode_extender = 'a Proof_types.inode_extender + and type 'a inode_tree = 'a Proof_types.inode_tree + and type tree = Proof_types.tree + and type elt = Proof_types.elt + and type stream = Proof_types.stream + and type 'a t = 'a Proof_types.t + + (** [t] proves that the state advanced from [before t] to [after t]. + [state t]'s hash is [before], and [state t] contains the minimal + information for the computation to reach [after t]. *) + + (** [before t] it the state's hash at the beginning of the computation. *) + val before : 'a t -> kinded_hash + + (** [after t] is the state's hash at the end of the computation. *) + val after : 'a t -> kinded_hash + + (** [proof t] is a subset of the initial state needed to prove that the proven + computation could run without performing any I/O. *) + val state : 'a t -> 'a + + val v : before:kinded_hash -> after:kinded_hash -> 'a -> 'a t +end + module type S = sig include VIEW with type key = string list and type value = bytes + module Proof : PROOF + module Tree : sig include TREE @@ -216,5 +361,61 @@ module type S = sig val make_repo : unit -> repo Lwt.t val shallow : repo -> kinded_hash -> tree + + (** [produce r h f] runs [f] on top of a real store [r], producing a proof + and a reulst using the initial root hash [h]. + + The trees produced during [f]'s computation will carry the full history + of reads. This history will be reset when [f] is complete so subtrees + escaping the scope of [f] will not cause memory leaks. + + It is possible to call [produce_proof] recursively. In that case, each + input trees will have their own history of reads and will contain only + the reads needed to unshallow that corresponding trees. Proof trees + proof should then interact as if they were all unshallowed (note: in the + case of nested proofs, it's unclear what [verify_proof] should do...). *) + type ('proof, 'result) producer := + repo -> + kinded_hash -> + (tree -> (tree * 'result) Lwt.t) -> + ('proof * 'result) Lwt.t + + (** [verify t f] runs [f] in checking mode, loading data from the proof as + needed. + + The generated tree is the tree after [f] has completed. More operations + can be run on that tree, but it won't be able to access the underlying + storage. + + Raise [Proof.Bad_proof] when the proof is rejected. *) + type ('proof, 'result) verifier := + 'proof -> + (tree -> (tree * 'result) Lwt.t) -> + (tree * 'result, [`Msg of string]) result Lwt.t + + (** The type for tree proofs. + + Guarantee that the given computation performs exactly the same state + operations as the generating computation, *in some order*. *) + type tree_proof := Proof.tree Proof.t + + (** [produce_proof] is the producer of tree proofs. *) + val produce_proof : (tree_proof, 'a) producer + + (** [verify_proof] is the verifier of tree proofs. *) + val verify_proof : (tree_proof, 'a) verifier + + (** The type for stream proofs. + + Guarantee that the given computation performs exactly the same state + operations as the generating computation, in the exact same order.*in + some order*. *) + type stream_proof := Proof.stream Proof.t + + (** [produce_stream] is the producer of stream proofs. *) + val produce_stream : (stream_proof, 'a) producer + + (** [verify_stream] is the verifier of stream proofs. *) + val verify_stream : (stream_proof, 'a) verifier end end diff --git a/src/lib_context/tezos-context.opam b/src/lib_context/tezos-context.opam index 99df4badce85be854ae78356783ec35df3bec219..294cd98fb59a8a1f972282d2dc8e79b916c5d575 100644 --- a/src/lib_context/tezos-context.opam +++ b/src/lib_context/tezos-context.opam @@ -10,8 +10,8 @@ license: "MIT" depends: [ "dune" { >= "2.9" } "tezos-base" - "irmin" { >= "2.8.0" } - "irmin-pack" { >= "2.8.0" } + "irmin" { >= "2.10.0" & < "2.11.0" } + "irmin-pack" { >= "2.10.0" & < "2.11.0" } "bigstringaf" { >= "0.2.0" } "tezos-shell-services" "fmt" diff --git a/src/lib_crypto/signature.ml b/src/lib_crypto/signature.ml index df6131003819ab3a40219872967b23e587e1827c..4dc73c00f8ca0de8765b45dd8b1a783ccbb9f318 100644 --- a/src/lib_crypto/signature.ml +++ b/src/lib_crypto/signature.ml @@ -693,6 +693,8 @@ let make_endorsement_cache = let clear _ = () + let filter _ _ = () + module H = H end in (module Fake_ring : Ringo.MAP_MAKER) diff --git a/src/lib_crypto/tezos-crypto.opam b/src/lib_crypto/tezos-crypto.opam index 78820166514b75261e131a48b1f9bd4d4b4dbc4b..91704ec6ce2e96d9b982fd96f1e0e841de264305 100644 --- a/src/lib_crypto/tezos-crypto.opam +++ b/src/lib_crypto/tezos-crypto.opam @@ -17,7 +17,7 @@ depends: [ "tezos-error-monad" "tezos-rpc" "tezos-stdlib" - "ringo" { = "0.5" } + "ringo" { = "0.7" } "zarith" { >= "1.12" & < "1.13" } "zarith_stubs_js" "tezos-hacl-glue-unix" {with-test} diff --git a/src/lib_p2p/tezos-p2p.opam b/src/lib_p2p/tezos-p2p.opam index 1da471e5b4679af69b35085886866a59c2b73bc3..ac72849e53b2b20e35b78a9be2e7337a83de626c 100644 --- a/src/lib_p2p/tezos-p2p.opam +++ b/src/lib_p2p/tezos-p2p.opam @@ -11,7 +11,7 @@ depends: [ "dune" { >= "2.9" } "lwt-watcher" { = "0.1" } "lwt-canceler" { >= "0.3" & < "0.4" } - "ringo" { = "0.5" } + "ringo" { = "0.7" } "tezos-base" "tezos-stdlib" "tezos-stdlib-unix" diff --git a/src/lib_protocol_environment/dummy_context.ml b/src/lib_protocol_environment/dummy_context.ml index 351abe5ab6f546b6bf5eb77bf58f389563545905..d3dbd7b33b8ce27745b4183563b7d32d3d8f8fe6 100644 --- a/src/lib_protocol_environment/dummy_context.ml +++ b/src/lib_protocol_environment/dummy_context.ml @@ -67,6 +67,8 @@ module M = struct let list _ ?offset:_ ?length:_ _ = assert false + let length _ _ = assert false + let fold ?depth:_ _ _ ~order:_ ~init:_ ~f:_ = assert false end diff --git a/src/lib_protocol_environment/environment_V2.ml b/src/lib_protocol_environment/environment_V2.ml index e7df84b4ef737ae53bf06b94f8e76f7acdf29778..7e52a294c48783efe56251a8f2c9a54c2d626063 100644 --- a/src/lib_protocol_environment/environment_V2.ml +++ b/src/lib_protocol_environment/environment_V2.ml @@ -913,48 +913,7 @@ struct module Context = struct include Context - - type depth = [`Eq of int | `Le of int | `Lt of int | `Ge of int | `Gt of int] - - module type VIEW = sig - include Environment_context.VIEW - - val fold : - ?depth:depth -> - t -> - key -> - init:'a -> - f:(key -> tree -> 'a -> 'a Lwt.t) -> - 'a Lwt.t - end - - module Kind = struct - type t = [`Value | `Tree] - end - - module type TREE = sig - type t - - type tree - - include VIEW with type t := tree and type tree := tree - - val empty : t -> tree - - val is_empty : tree -> bool - - val kind : tree -> Kind.t - - val to_value : tree -> value option Lwt.t - - val of_value : t -> value -> tree Lwt.t - - val hash : tree -> Context_hash.t - - val equal : tree -> tree -> bool - - val clear : ?depth:int -> tree -> unit - end + include Environment_context.V2 let fold ?depth ctxt k ~init ~f = Context.fold ?depth ctxt k ~order:`Sorted ~init ~f diff --git a/src/lib_protocol_environment/environment_V3.ml b/src/lib_protocol_environment/environment_V3.ml index 90a4dd56053313dd9d46e1ae66393153be315df3..c76e16e5edc738e86770be522a6e27642e473d31 100644 --- a/src/lib_protocol_environment/environment_V3.ml +++ b/src/lib_protocol_environment/environment_V3.ml @@ -1039,48 +1039,7 @@ struct module Context = struct include Context - - type depth = [`Eq of int | `Le of int | `Lt of int | `Ge of int | `Gt of int] - - module type VIEW = sig - include Environment_context.VIEW - - val fold : - ?depth:depth -> - t -> - key -> - init:'a -> - f:(key -> tree -> 'a -> 'a Lwt.t) -> - 'a Lwt.t - end - - module Kind = struct - type t = [`Value | `Tree] - end - - module type TREE = sig - type t - - type tree - - include VIEW with type t := tree and type tree := tree - - val empty : t -> tree - - val is_empty : tree -> bool - - val kind : tree -> Kind.t - - val to_value : tree -> value option Lwt.t - - val of_value : t -> value -> tree Lwt.t - - val hash : tree -> Context_hash.t - - val equal : tree -> tree -> bool - - val clear : ?depth:int -> tree -> unit - end + include Environment_context.V3 let fold ?depth ctxt k ~init ~f = Context.fold ?depth ctxt k ~order:`Sorted ~init ~f diff --git a/src/lib_protocol_environment/environment_V4.ml b/src/lib_protocol_environment/environment_V4.ml index c08c5828ae47399047d6d36fb164c980f798b164..3ccf3661db1be47935ebc16f2cde7e315c8ead78 100644 --- a/src/lib_protocol_environment/environment_V4.ml +++ b/src/lib_protocol_environment/environment_V4.ml @@ -1071,18 +1071,7 @@ struct module Context = struct include Context - - type depth = [`Eq of int | `Le of int | `Lt of int | `Ge of int | `Gt of int] - - module type VIEW = Environment_context.VIEW - - module Kind = struct - type t = [`Value | `Tree] - end - - module type TREE = Environment_context.TREE - - module type CACHE = Environment_context.CACHE + include Environment_context.V4 let register_resolver = Base58.register_resolver diff --git a/src/lib_protocol_environment/environment_context.ml b/src/lib_protocol_environment/environment_context.ml index c4e941b4c5952ebdcba9617014c10e11707c1821..cc265a313ac1ff9d5ac1a95f897200e13a741e46 100644 --- a/src/lib_protocol_environment/environment_context.ml +++ b/src/lib_protocol_environment/environment_context.ml @@ -23,6 +23,7 @@ (* *) (*****************************************************************************) +include Environment_context_intf open Error_monad let err_implementation_mismatch ~expected ~got = @@ -32,14 +33,6 @@ let err_implementation_mismatch ~expected ~got = expected got -module type CONTEXT = Environment_context_intf.S - -module type VIEW = Environment_context_intf.VIEW - -module type TREE = Environment_context_intf.TREE - -module type CACHE = Environment_context_intf.CACHE - module Equality_witness : sig type (_, _) eq = Refl : ('a, 'a) eq @@ -85,8 +78,7 @@ module Context = struct type value = Bytes.t - type ('ctxt, 'tree) ops = - (module CONTEXT with type t = 'ctxt and type tree = 'tree) + type ('ctxt, 'tree) ops = (module S with type t = 'ctxt and type tree = 'tree) type _ kind = .. @@ -173,6 +165,8 @@ module Context = struct [] (List.rev ls) + let length (Context {ops = (module Ops); ctxt; _}) key = Ops.length ctxt key + let fold ?depth (Context {ops = (module Ops) as ops; ctxt; equality_witness; impl_name; _}) key @@ -244,6 +238,9 @@ module Context = struct [] (List.rev ls) + let length (Tree {ops = (module Ops); tree; _}) key = + Ops.Tree.length tree key + let fold ?depth (Tree {ops = (module Ops) as ops; tree = t; equality_witness; impl_name}) @@ -598,13 +595,13 @@ module Context = struct Ops.set_hash_version ctxt v >|=? fun ctxt -> Context {c with ctxt} end -module Register (C : CONTEXT) = struct +module Register (C : S) = struct type _ Context.kind += Context : C.t Context.kind let equality_witness : (C.t, C.tree) Context.equality_witness = Context.equality_witness () - let ops = (module C : CONTEXT with type t = 'ctxt and type tree = 'tree) + let ops = (module C : S with type t = 'ctxt and type tree = 'tree) end type validation_result = { diff --git a/src/lib_protocol_environment/environment_context.mli b/src/lib_protocol_environment/environment_context.mli index e7314d33de61750ee1a3231ffe87b84e997f1ed7..656e797c8625c3656be58860fc2806e7a15d2d78 100644 --- a/src/lib_protocol_environment/environment_context.mli +++ b/src/lib_protocol_environment/environment_context.mli @@ -23,25 +23,7 @@ (* *) (*****************************************************************************) -module type CONTEXT = sig - (** @inline *) - include Environment_context_intf.S -end - -module type VIEW = sig - (** @inline *) - include Environment_context_intf.VIEW -end - -module type TREE = sig - (** @inline *) - include Environment_context_intf.TREE -end - -module type CACHE = sig - (** @inline *) - include Environment_context_intf.CACHE -end +include Environment_context_intf.Sigs module Equality_witness : sig type (_, _) eq = Refl : ('a, 'a) eq @@ -56,8 +38,7 @@ module Equality_witness : sig end module Context : sig - type ('ctxt, 'tree) ops = - (module CONTEXT with type t = 'ctxt and type tree = 'tree) + type ('ctxt, 'tree) ops = (module S with type t = 'ctxt and type tree = 'tree) type _ kind = private .. @@ -87,7 +68,7 @@ module Context : sig } -> t - include CONTEXT with type t := t + include S with type t := t (** [make kind impl_name ctxt ops equality_witness] builds a context value. In this context, the cache is uninitialized: one must call @@ -225,7 +206,7 @@ module Context : sig Block_hash.t -> t -> source_of_cache -> builder -> t tzresult Lwt.t end -module Register (C : CONTEXT) : sig +module Register (C : S) : sig type _ Context.kind += Context : C.t Context.kind val equality_witness : (C.t, C.tree) Context.equality_witness diff --git a/src/lib_protocol_environment/environment_context_intf.ml b/src/lib_protocol_environment/environment_context_intf.ml index b9278ef3014ad68afb04fbb5e43d36f3bb7c3fb9..245cd1deb5f46a314dc4d06dafc42bc77db33680 100644 --- a/src/lib_protocol_environment/environment_context_intf.ml +++ b/src/lib_protocol_environment/environment_context_intf.ml @@ -25,6 +25,208 @@ (* *) (*****************************************************************************) +module Kind = struct + type t = [`Value | `Tree] +end + +module type CORE = sig + type t + + val set_protocol : t -> Protocol_hash.t -> t Lwt.t + + val get_protocol : t -> Protocol_hash.t Lwt.t + + val fork_test_chain : + t -> protocol:Protocol_hash.t -> expiration:Time.Protocol.t -> t Lwt.t + + val set_hash_version : t -> Context_hash.Version.t -> t tzresult Lwt.t + + val get_hash_version : t -> Context_hash.Version.t +end + +module type TREE_CORE = sig + type t + + type tree + + type value + + val empty : t -> tree + + val is_empty : tree -> bool + + val kind : tree -> Kind.t + + val to_value : tree -> value option Lwt.t + + val of_value : t -> value -> tree Lwt.t + + val hash : tree -> Context_hash.t + + val equal : tree -> tree -> bool + + val clear : ?depth:int -> tree -> unit +end + +module V2 = struct + type depth = [`Eq of int | `Le of int | `Lt of int | `Ge of int | `Gt of int] + + module type VIEW = sig + type t + + type key + + type value + + type tree + + val mem : t -> key -> bool Lwt.t + + val mem_tree : t -> key -> bool Lwt.t + + val find : t -> key -> value option Lwt.t + + val find_tree : t -> key -> tree option Lwt.t + + val list : + t -> ?offset:int -> ?length:int -> key -> (string * tree) trace Lwt.t + + val add : t -> key -> value -> t Lwt.t + + val add_tree : t -> key -> tree -> t Lwt.t + + val remove : t -> key -> t Lwt.t + + val fold : + ?depth:depth -> + t -> + key -> + init:'a -> + f:(key -> tree -> 'a -> 'a Lwt.t) -> + 'a Lwt.t + end + + module Kind = Kind + + module type TREE = sig + type t + + type tree + + include VIEW with type t := tree and type tree := tree + + include + TREE_CORE with type t := t and type tree := tree and type value := value + end + + module type S = sig + include VIEW with type key = string list and type value = bytes + + module Tree : sig + include + TREE + with type t := t + and type key := key + and type value := value + and type tree := tree + + val pp : Format.formatter -> tree -> unit + end + + include CORE with type t := t + end +end + +module V3 = V2 + +module V4 = struct + type depth = V3.depth + + module type VIEW = sig + include V3.VIEW + + val fold : + ?depth:depth -> + t -> + key -> + order:[`Sorted | `Undefined] -> + init:'a -> + f:(key -> tree -> 'a -> 'a Lwt.t) -> + 'a Lwt.t + end + + module Kind = Kind + + module type TREE = sig + type t + + type tree + + include VIEW with type t := tree and type tree := tree + + include + TREE_CORE with type t := t and type tree := tree and type value := value + end + + module type S = sig + include VIEW with type key = string list and type value = bytes + + module Tree : sig + include + TREE + with type t := t + and type key := key + and type value := value + and type tree := tree + + val pp : Format.formatter -> tree -> unit + end + + include CORE with type t := t + end + + (* Copy of sigs/v3/context.mli:CACHE *) + module type CACHE = sig + type t + + type size + + type index + + type identifier + + type key + + type value = .. + + val key_of_identifier : cache_index:index -> identifier -> key + + val identifier_of_key : key -> identifier + + val pp : Format.formatter -> t -> unit + + val find : t -> key -> value option Lwt.t + + val set_cache_layout : t -> size list -> t Lwt.t + + val update : t -> key -> (value * size) option -> t + + val sync : t -> cache_nonce:Bytes.t -> t Lwt.t + + val clear : t -> t + + val list_keys : t -> cache_index:index -> (key * size) list option + + val key_rank : t -> key -> int option + + val future_cache_expectation : t -> time_in_blocks:int -> t + + val cache_size : t -> cache_index:index -> size option + + val cache_size_limit : t -> cache_index:index -> size option + end +end + module type VIEW = sig (** @inline *) include Tezos_context_sigs.Context.VIEW @@ -54,55 +256,23 @@ module type S = sig val pp : Format.formatter -> tree -> unit end - val set_protocol : t -> Protocol_hash.t -> t Lwt.t - - val get_protocol : t -> Protocol_hash.t Lwt.t - - val fork_test_chain : - t -> protocol:Protocol_hash.t -> expiration:Time.Protocol.t -> t Lwt.t - - val set_hash_version : t -> Context_hash.Version.t -> t tzresult Lwt.t - - val get_hash_version : t -> Context_hash.Version.t + include CORE with type t := t end -(* Copy of sigs/v3/context.mli:CACHE *) -module type CACHE = sig - type t - - type size - - type index - - type identifier - - type key - - type value = .. - - val key_of_identifier : cache_index:index -> identifier -> key - - val identifier_of_key : key -> identifier - - val pp : Format.formatter -> t -> unit - - val find : t -> key -> value option Lwt.t - - val set_cache_layout : t -> size list -> t Lwt.t - - val update : t -> key -> (value * size) option -> t - - val sync : t -> cache_nonce:Bytes.t -> t Lwt.t +module type CACHE = V4.CACHE - val clear : t -> t +module type Sigs = sig + module V2 = V2 + module V3 = V3 + module V4 = V4 - val list_keys : t -> cache_index:index -> (key * size) list option + module type VIEW = VIEW - val key_rank : t -> key -> int option + module type TREE = TREE - val future_cache_expectation : t -> time_in_blocks:int -> t + module type S = S - val cache_size : t -> cache_index:index -> size option + module type HASH_VERSION = HASH_VERSION - val cache_size_limit : t -> cache_index:index -> size option + module type CACHE = CACHE end diff --git a/src/lib_protocol_environment/memory_context.mli b/src/lib_protocol_environment/memory_context.mli index 1afe63cc46360fcc1b114283256f582c0485b9db..2d59afe26a1f8e3fc60c6958c296bad20f3881b8 100644 --- a/src/lib_protocol_environment/memory_context.mli +++ b/src/lib_protocol_environment/memory_context.mli @@ -33,7 +33,7 @@ val empty : Context.t val encoding : Context.t Data_encoding.t -module M : CONTEXT with type t = t +module M : S with type t = t val wrap_memory_context : t -> Context.t diff --git a/src/lib_protocol_environment/proxy_context.ml b/src/lib_protocol_environment/proxy_context.ml index 5aa3c1bce80046108280fc7c37d3f0eb31fda31f..19721eab562799eda69b603175396bbf153ac53c 100644 --- a/src/lib_protocol_environment/proxy_context.ml +++ b/src/lib_protocol_environment/proxy_context.ml @@ -182,6 +182,8 @@ module C = struct let list t ?offset ?length k = data_tree t >>= fun tree -> raw_list tree ?offset ?length k + let length t k = data_tree t >>= fun t -> Local.Tree.length t.tree k + let fold ?depth (t : t) root ~order ~init ~f = find_tree t root >>= function | None -> Lwt.return init @@ -241,6 +243,8 @@ module C = struct Local.Tree.remove t.tree k >|= fun tree -> if tree == t.tree then t else {t with tree} + let length t k = Local.Tree.length t.tree k + let fold ?depth (t : tree) k ~order ~init ~f = Local.Tree.fold ?depth t.tree k ~order ~init ~f:(fun k tree acc -> let tree = {proxy = t.proxy; path = t.path @ k; tree} in diff --git a/src/lib_proxy/tezos-proxy.opam b/src/lib_proxy/tezos-proxy.opam index dbfac0c7379666251aadbb21db6c7bd5faa80fee..179fde1e765ab7101ea2277c4fd49dd4eb8b7522 100644 --- a/src/lib_proxy/tezos-proxy.opam +++ b/src/lib_proxy/tezos-proxy.opam @@ -9,7 +9,7 @@ dev-repo: "git+https://gitlab.com/tezos/tezos.git" license: "MIT" depends: [ "dune" { >= "2.9" } - "ringo-lwt" { = "0.5" } + "ringo-lwt" { = "0.7" } "tezos-base" "tezos-clic" "tezos-client-base" diff --git a/src/lib_store/tezos-store.opam b/src/lib_store/tezos-store.opam index aadc627a39fa2accc979e396dd6a1b5e37749f76..dabd4ae776f5c473184c1fedc8359186f047e600 100644 --- a/src/lib_store/tezos-store.opam +++ b/src/lib_store/tezos-store.opam @@ -12,13 +12,13 @@ depends: [ "tezos-base" "tezos-shell-services" "index" { >= "1.3.0" } - "irmin-pack" { >= "2.8.0" } + "irmin-pack" { >= "2.10.0" & < "2.11.0" } "tezos-stdlib-unix" "tezos-context" "tezos-validation" "tezos-protocol-updater" "lwt-watcher" { = "0.1" } - "ringo-lwt" { = "0.5" } + "ringo-lwt" { = "0.7" } "camlzip" { = "1.10" } "tar" "tar-unix" { = "1.1.0" } diff --git a/src/lib_workers/tezos-workers.opam b/src/lib_workers/tezos-workers.opam index 61d9bb31f5f76de1fb30ea0821c0465bb1be91be..579f1462e46fc2e27e0c15409272bf2730112a61 100644 --- a/src/lib_workers/tezos-workers.opam +++ b/src/lib_workers/tezos-workers.opam @@ -11,7 +11,7 @@ depends: [ "dune" { >= "2.9" } "tezos-base" "tezos-stdlib-unix" - "ringo" { = "0.5" } + "ringo" { = "0.7" } ] build: [ ["dune" "build" "-p" name "-j" jobs]