diff --git a/.gitignore b/.gitignore index a27ff1458..33c57dea5 100644 --- a/.gitignore +++ b/.gitignore @@ -42,6 +42,7 @@ /test/test-context /test/test-basic /test/test-data-encoding +/test/test-merkle /test/test-p2p-io-scheduler /test/test-p2p-connection /test/test-p2p-connection-pool diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index fdc02559e..8b68dff2d 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -86,6 +86,15 @@ test:data-encoding: dependencies: - build +test:merkle: + stage: test + tags: + - tezos_builder + script: + - make -C test run-test-merkle + dependencies: + - build + test:p2p-io-scheduler: stage: test tags: diff --git a/src/utils/hash.mli b/src/utils/hash.mli index c9e2dd5ce..d33218bc0 100644 --- a/src/utils/hash.mli +++ b/src/utils/hash.mli @@ -175,3 +175,22 @@ module Operation_list_list_hash : module Protocol_hash : INTERNAL_HASH module Generic_hash : INTERNAL_MINIMAL_HASH + +(**/**) + +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) : sig + val compute : H.elt list -> H.t + type path = + | Left of path * H.t + | Right of H.t * path + | Op + val compute_path: H.elt list -> int -> path + val check_path: path -> H.elt -> H.t * int +end diff --git a/test/Makefile b/test/Makefile index 3fe7cb102..ad1e869b5 100644 --- a/test/Makefile +++ b/test/Makefile @@ -1,5 +1,6 @@ TESTS := \ + merkle \ data-encoding \ store context state \ basic basic.sh \ @@ -246,6 +247,29 @@ test-lwt-pipe: ${NODELIB} ${TEST_PIPE_IMPLS:.ml=.cmx} clean:: rm -f test-p2p +############################################################################ +## Merkle test program + +.PHONY:build-test-merkle run-test-merkle +build-test-merkle: test-merkle +run-test-merkle: + ./test-merkle + +TEST_MERKLE_INTFS = + +TEST_MERKLE_IMPLS = \ + lib/assert.ml \ + lib/test.ml \ + test_merkle.ml + +${TEST_MERKLE_IMPLS:.ml=.cmx}: ${NODELIB} +test-merkle: ${NODELIB} ${TEST_MERKLE_IMPLS:.ml=.cmx} + ocamlfind ocamlopt -linkall -linkpkg ${OCAMLFLAGS} -o $@ $^ + +clean:: + rm -f test-merkle + + ############################################################################ ## data encoding test program diff --git a/test/test_merkle.ml b/test/test_merkle.ml new file mode 100644 index 000000000..a30a1685c --- /dev/null +++ b/test/test_merkle.ml @@ -0,0 +1,86 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open Error_monad +open Hash + +let rec (--) i j = + if j < i then [] + else i :: (i+1) -- j + +type tree = + | Empty + | Leaf of int + | Node of tree * tree + +let rec list_of_tree = function + | Empty -> [], 0 + | Leaf x -> [x], 1 + | Node (x, y) -> + let x, sx = list_of_tree x + and y, sy = list_of_tree y in + assert (sx = sy) ; + x @ y, sx + sy + +module Merkle = Hash.Generic_Merkle_tree(struct + type t = tree + type elt = int + let empty = Empty + let leaf i = Leaf i + let node x y = Node (x, y) + let encoding = + (* Fake... *) + Data_encoding.conv (fun _ -> 0) (fun _ -> Empty) Data_encoding.int31 + end) + +let rec compare_list xs ys = + match xs, ys with + | [], [] -> true + | [x], y :: ys when x = y -> ys = [] || compare_list xs ys + | x :: xs, y :: ys when x = y -> compare_list xs ys + | _, _ -> false + +let check_size i = + let l = 0 -- i in + let l2, _ = list_of_tree (Merkle.compute l) in + if compare_list l l2 then + return () + else + failwith "Failed for %d: %a" + i + (Format.pp_print_list + ~pp_sep:(fun ppf () -> Format.pp_print_string ppf ";") + Format.pp_print_int) + l2 + +let test_compute _ = + iter_s check_size (0--99) + +let check_path i = + let l = 0 -- i in + let orig = Merkle.compute l in + iter_s (fun j -> + let path = Merkle.compute_path l j in + let found, pos = Merkle.check_path path j in + if found = orig && j = pos then + return () + else + failwith "Failed for %d in %d." j i) + l + +let test_path _ = + iter_s check_path (0--128) + +let tests : (string * (string -> unit tzresult Lwt.t)) list = [ + "compute", test_compute ; + "path", test_path ; +] + +let () = + Test.run "merkel." tests