From 9097809589d817bf800a86b3461486bad15eb41e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Thu, 16 Mar 2017 17:17:06 +0100 Subject: [PATCH] Shell: Merkle tree of operations --- src/minutils/utils.ml | 5 + src/minutils/utils.mli | 1 + src/proto/environment/hash.mli | 21 ++++ src/utils/base58.ml | 2 + src/utils/base58.mli | 2 + src/utils/hash.ml | 212 ++++++++++++++++++++++++++++----- src/utils/hash.mli | 35 ++++++ 7 files changed, 251 insertions(+), 27 deletions(-) diff --git a/src/minutils/utils.ml b/src/minutils/utils.ml index 9a195791d..189aede0f 100644 --- a/src/minutils/utils.ml +++ b/src/minutils/utils.ml @@ -90,6 +90,11 @@ let list_hd_opt = function | [] -> None | h :: _ -> Some h +let rec list_last_exn = function + | [] -> raise Not_found + | [x] -> x + | _ :: xs -> list_last_exn xs + let merge_filter_list2 ?(finalize = List.rev) ?(compare = compare) ?(f = first_some) diff --git a/src/minutils/utils.mli b/src/minutils/utils.mli index ea27466e0..2ba60cd35 100644 --- a/src/minutils/utils.mli +++ b/src/minutils/utils.mli @@ -44,6 +44,7 @@ val list_rev_sub : 'a list -> int -> 'a list (** [list_sub l n] is l capped to max n elements *) val list_sub: 'a list -> int -> 'a list val list_hd_opt: 'a list -> 'a option +val list_last_exn: 'a list -> 'a (** [merge_filter_list2 ~compare ~f l1 l2] merges two lists ordered by [compare] and whose items can be merged with [f]. Item is discarded or kept whether diff --git a/src/proto/environment/hash.mli b/src/proto/environment/hash.mli index 32812e829..bc33d1081 100644 --- a/src/proto/environment/hash.mli +++ b/src/proto/environment/hash.mli @@ -71,6 +71,20 @@ module type HASH = sig end +module type MERKLE_TREE = sig + type elt + include HASH + val compute: elt list -> t + val empty: t + type path = + | Left of path * t + | Right of t * path + | Op + val compute_path: elt list -> int -> path + val check_path: path -> elt -> t * int + val path_encoding: path Data_encoding.t +end + (** {2 Building Hashes} *******************************************************) (** The parameters for creating a new Hash type using @@ -111,5 +125,12 @@ module Block_hash : HASH (** Operations hashes / IDs. *) module Operation_hash : HASH +(** List of operations hashes / IDs. *) +module Operation_list_hash : + MERKLE_TREE with type elt = Operation_hash.t + +module Operation_list_list_hash : + MERKLE_TREE with type elt = Operation_list_hash.t + (** Protocol versions / source hashes. *) module Protocol_hash : HASH diff --git a/src/utils/base58.ml b/src/utils/base58.ml index 17bf69494..08e65fefe 100644 --- a/src/utils/base58.ml +++ b/src/utils/base58.ml @@ -292,6 +292,8 @@ module Prefix = struct (* 32 *) let block_hash = "\001\052" (* B(51) *) let operation_hash = "\005\116" (* o(51) *) + let operation_list_hash = "\133\233" (* Lo(52) *) + let operation_list_list_hash = "\029\159\109" (* LLo(53) *) let protocol_hash = "\002\170" (* P(51) *) (* 20 *) diff --git a/src/utils/base58.mli b/src/utils/base58.mli index 99895b910..990efe81b 100644 --- a/src/utils/base58.mli +++ b/src/utils/base58.mli @@ -13,6 +13,8 @@ module Prefix : sig val block_hash: string val operation_hash: string + val operation_list_hash: string + val operation_list_list_hash: string val protocol_hash: string val ed25519_public_key_hash: string val cryptobox_public_key_hash: string diff --git a/src/utils/hash.ml b/src/utils/hash.ml index 60fd8923e..73e7c8e13 100644 --- a/src/utils/hash.ml +++ b/src/utils/hash.ml @@ -98,6 +98,34 @@ module type INTERNAL_HASH = sig module Table : Hashtbl.S with type key = t end +module type INTERNAL_MERKLE_TREE = sig + type elt + include INTERNAL_HASH + val compute: elt list -> t + val empty: t + type path = + | Left of path * t + | Right of t * path + | Op + val compute_path: elt list -> int -> path + val check_path: path -> elt -> t * int + val path_encoding: path Data_encoding.t +end + +module type MERKLE_TREE = sig + type elt + include HASH + val compute: elt list -> t + val empty: t + type path = + | Left of path * t + | Right of t * path + | Op + val compute_path: elt list -> int -> path + val check_path: path -> elt -> t * int + val path_encoding: path Data_encoding.t +end + module type Name = sig val name: string val title: string @@ -297,36 +325,148 @@ module Make_Blake2B (R : sig end -(*-- Hash sets and maps -----------------------------------------------------*) +module Generic_Merkle_tree (H : sig + type t + type elt + val encoding : t Data_encoding.t + val empty : t + val leaf : elt -> t + val node : t -> t -> t + end) = struct + + let rec step a n = + let m = (n+1) / 2 in + for i = 0 to m - 1 do + a.(i) <- H.node a.(2*i) a.(2*i+1) + done ; + a.(m) <- H.node a.(n) a.(n) ; + if m = 1 then + a.(0) + else if m mod 2 = 0 then + step a m + else begin + a.(m+1) <- a.(m) ; + step a (m+1) + end + + let empty = H.empty + + let compute xs = + match xs with + | [] -> H.empty + | [x] -> H.leaf x + | _ :: _ :: _ -> + let last = Utils.list_last_exn xs in + let n = List.length xs in + let a = Array.make (n+1) (H.leaf last) in + List.iteri (fun i x -> a.(i) <- H.leaf x) xs ; + step a n + + type path = + | Left of path * H.t + | Right of H.t * path + | Op + + let rec step_path a n p j = + let m = (n+1) / 2 in + let p = if j mod 2 = 0 then Left (p, a.(j+1)) else Right (a.(j-1), p) in + for i = 0 to m - 1 do + a.(i) <- H.node a.(2*i) a.(2*i+1) + done ; + a.(m) <- H.node a.(n) a.(n) ; + if m = 1 then + p + else if m mod 2 = 0 then + step_path a m p (j/2) + else begin + a.(m+1) <- a.(m) ; + step_path a (m+1) p (j/2) + end + + let compute_path xs i = + match xs with + | [] -> invalid_arg "compute_path" + | [_] -> Op + | _ :: _ :: _ -> + let last = Utils.list_last_exn xs in + let n = List.length xs in + if i < 0 || n <= i then invalid_arg "compute_path" ; + let a = Array.make (n+1) (H.leaf last) in + List.iteri (fun i x -> a.(i) <- H.leaf x) xs ; + step_path a n Op i + + let rec check_path p h = + match p with + | Op -> + H.leaf h, 1, 0 + | Left (p, r) -> + let l, s, pos = check_path p h in + H.node l r, s * 2, pos + | Right (l, p) -> + let r, s, pos = check_path p h in + H.node l r, s * 2, pos + s + + let check_path p h = + let h, _, pos = check_path p h in + h, pos + + let path_encoding = + let open Data_encoding in + mu "path" + (fun path_encoding -> + union [ + case ~tag:240 + (obj2 + (req "path" path_encoding) + (req "right" H.encoding)) + (function Left (p, r) -> Some (p, r) | _ -> None) + (fun (p, r) -> Left (p, r)) ; + case ~tag:15 + (obj2 + (req "left" H.encoding) + (req "path" path_encoding)) + (function Right (r, p) -> Some (r, p) | _ -> None) + (fun (r, p) -> Right (r, p)) ; + case ~tag:0 + unit + (function Op -> Some () | _ -> None) + (fun () -> Op) + ]) -module Hash_set (Hash : HASH) = struct - include Set.Make (Hash) - let encoding = - Data_encoding.conv - elements - (fun l -> List.fold_left (fun m x -> add x m) empty l) - Data_encoding.(list Hash.encoding) end -module Hash_map (Hash : HASH) = struct - include Map.Make (Hash) - let encoding arg_encoding = - Data_encoding.conv - bindings - (fun l -> List.fold_left (fun m (k,v) -> add k v m) empty l) - Data_encoding.(list (tup2 Hash.encoding arg_encoding)) -end +module Make_merkle_tree + (R : sig + val register_encoding: + prefix: string -> + length:int -> + to_raw: ('a -> string) -> + of_raw: (string -> 'a option) -> + wrap: ('a -> Base58.data) -> + 'a Base58.encoding + end) + (K : PrefixedName) + (Contents: sig + type t + val to_bytes: t -> MBytes.t + end) = struct -module Hash_table (Hash : MINIMAL_HASH) - : Hashtbl.S with type key = Hash.t - = Hashtbl.Make (struct - type t = Hash.t - let equal = Hash.equal - let hash v = - let raw_hash = Hash.to_string v in - let int64_hash = EndianString.BigEndian.get_int64 raw_hash 0 in - Int64.to_int int64_hash - end) + include Make_Blake2B (R) (K) + + type elt = Contents.t + + let empty = hash_bytes [] + + include Generic_Merkle_tree(struct + type nonrec t = t + type nonrec elt = elt + let encoding = encoding + let empty = empty + let leaf x = hash_bytes [Contents.to_bytes x] + let node x y = hash_bytes [to_bytes x; to_bytes y] + end) + +end (*-- Pre-instanciated hashes ------------------------------------------------*) @@ -344,7 +484,23 @@ module Operation_hash = let title = "A Tezos operation ID" let b58check_prefix = Base58.Prefix.operation_hash let size = None - end) + end) + +module Operation_list_hash = + Make_merkle_tree (Base58) (struct + let name = "Operation_list_hash" + let title = "A list of operations" + let b58check_prefix = Base58.Prefix.operation_list_hash + let size = None + end) (Operation_hash) + +module Operation_list_list_hash = + Make_merkle_tree (Base58) (struct + let name = "Operation_list_list_hash" + let title = "A list of list of operations" + let b58check_prefix = Base58.Prefix.operation_list_list_hash + let size = None + end) (Operation_list_hash) module Protocol_hash = Make_Blake2B (Base58) (struct @@ -364,4 +520,6 @@ module Generic_hash = let () = Base58.check_encoded_prefix Block_hash.b58check_encoding "B" 51 ; Base58.check_encoded_prefix Operation_hash.b58check_encoding "o" 51 ; + Base58.check_encoded_prefix Operation_list_hash.b58check_encoding "Lo" 52 ; + Base58.check_encoded_prefix Operation_list_list_hash.b58check_encoding "LLo" 53 ; Base58.check_encoded_prefix Protocol_hash.b58check_encoding "P" 51 diff --git a/src/utils/hash.mli b/src/utils/hash.mli index a45d4b9c4..c9e2dd5ce 100644 --- a/src/utils/hash.mli +++ b/src/utils/hash.mli @@ -90,6 +90,34 @@ module type INTERNAL_HASH = sig module Table : Hashtbl.S with type key = t end +module type INTERNAL_MERKLE_TREE = sig + type elt + include INTERNAL_HASH + val compute: elt list -> t + val empty: t + type path = + | Left of path * t + | Right of t * path + | Op + val compute_path: elt list -> int -> path + val check_path: path -> elt -> t * int + val path_encoding: path Data_encoding.t +end + +module type MERKLE_TREE = sig + type elt + include HASH + val compute: elt list -> t + val empty: t + type path = + | Left of path * t + | Right of t * path + | Op + val compute_path: elt list -> int -> path + val check_path: path -> elt -> t * int + val path_encoding: path Data_encoding.t +end + (** {2 Building Hashes} *******************************************************) (** The parameters for creating a new Hash type using @@ -136,6 +164,13 @@ end (** Operations hashes / IDs. *) module Operation_hash : INTERNAL_HASH +(** List of operations hashes / IDs. *) +module Operation_list_hash : + INTERNAL_MERKLE_TREE with type elt = Operation_hash.t + +module Operation_list_list_hash : + INTERNAL_MERKLE_TREE with type elt = Operation_list_hash.t + (** Protocol versions / source hashes. *) module Protocol_hash : INTERNAL_HASH