vblt.org
forked from
gazagnaire.org/irmin
Persistent store with Git semantics: lazy reads, delayed writes, content-addressing
1open Irmin
2
3(* Hash tests *)
4let test_sha1_hash () =
5 let h = Hash.sha1 "hello" in
6 let hex = Hash.to_hex h in
7 Alcotest.(check string)
8 "sha1 hex length" (String.make 40 '0')
9 (String.make (String.length hex) '0');
10 Alcotest.(check int) "sha1 bytes length" 20 (String.length (Hash.to_bytes h))
11
12let test_sha256_hash () =
13 let h = Hash.sha256 "hello" in
14 let hex = Hash.to_hex h in
15 Alcotest.(check string)
16 "sha256 hex length" (String.make 64 '0')
17 (String.make (String.length hex) '0');
18 Alcotest.(check int)
19 "sha256 bytes length" 32
20 (String.length (Hash.to_bytes h))
21
22let test_hash_roundtrip () =
23 let h1 = Hash.sha1 "test data" in
24 let hex = Hash.to_hex h1 in
25 match Hash.sha1_of_hex hex with
26 | Ok h2 -> Alcotest.(check bool) "roundtrip" true (Hash.equal h1 h2)
27 | Error (`Msg msg) -> Alcotest.fail msg
28
29let test_mst_depth () =
30 (* Test MST depth calculation *)
31 let h = Hash.sha256 "test" in
32 let depth = Hash.mst_depth h in
33 Alcotest.(check bool) "depth >= 0" true (depth >= 0)
34
35(* Tree tests *)
36let test_empty_tree () =
37 let tree = Tree.Git.empty () in
38 Alcotest.(check (option string))
39 "find empty" None
40 (Tree.Git.find tree [ "foo" ])
41
42let test_tree_add_find () =
43 let tree = Tree.Git.empty () in
44 let tree = Tree.Git.add tree [ "foo"; "bar" ] "content" in
45 Alcotest.(check (option string))
46 "find added" (Some "content")
47 (Tree.Git.find tree [ "foo"; "bar" ])
48
49let test_tree_remove () =
50 let tree = Tree.Git.empty () in
51 let tree = Tree.Git.add tree [ "foo" ] "content" in
52 let tree = Tree.Git.remove tree [ "foo" ] in
53 Alcotest.(check (option string))
54 "find removed" None
55 (Tree.Git.find tree [ "foo" ])
56
57let test_tree_overwrite () =
58 let tree = Tree.Git.empty () in
59 let tree = Tree.Git.add tree [ "key" ] "value1" in
60 let tree = Tree.Git.add tree [ "key" ] "value2" in
61 Alcotest.(check (option string))
62 "find overwritten" (Some "value2")
63 (Tree.Git.find tree [ "key" ])
64
65let test_tree_nested () =
66 let tree = Tree.Git.empty () in
67 let tree = Tree.Git.add tree [ "a"; "b"; "c" ] "deep" in
68 let tree = Tree.Git.add tree [ "a"; "x" ] "shallow" in
69 Alcotest.(check (option string))
70 "find deep" (Some "deep")
71 (Tree.Git.find tree [ "a"; "b"; "c" ]);
72 Alcotest.(check (option string))
73 "find shallow" (Some "shallow")
74 (Tree.Git.find tree [ "a"; "x" ])
75
76(* Backend tests *)
77let test_memory_backend () =
78 let backend = Backend.Memory.create_sha1 () in
79 let data = "test content" in
80 let hash = Hash.sha1 data in
81 backend.write hash data;
82 Alcotest.(check (option string)) "read back" (Some data) (backend.read hash)
83
84let test_backend_refs () =
85 let backend = Backend.Memory.create_sha1 () in
86 let data = "content" in
87 let hash = Hash.sha1 data in
88 backend.write hash data;
89 backend.set_ref "refs/heads/main" hash;
90 Alcotest.(check bool)
91 "ref exists" true
92 (Option.is_some (backend.get_ref "refs/heads/main"));
93 match backend.get_ref "refs/heads/main" with
94 | Some h -> Alcotest.(check bool) "ref matches" true (Hash.equal hash h)
95 | None -> Alcotest.fail "ref not found"
96
97let test_backend_test_and_set () =
98 let backend = Backend.Memory.create_sha1 () in
99 let h1 = Hash.sha1 "content1" in
100 let h2 = Hash.sha1 "content2" in
101 backend.write h1 "content1";
102 backend.write h2 "content2";
103 backend.set_ref "ref" h1;
104
105 (* Should fail with wrong test value *)
106 let result = backend.test_and_set_ref "ref" ~test:(Some h2) ~set:(Some h2) in
107 Alcotest.(check bool) "wrong test fails" false result;
108
109 (* Should succeed with correct test value *)
110 let result = backend.test_and_set_ref "ref" ~test:(Some h1) ~set:(Some h2) in
111 Alcotest.(check bool) "correct test succeeds" true result
112
113(* Disk backend tests *)
114let with_temp_dir f =
115 Eio_main.run @@ fun env ->
116 let fs = Eio.Stdenv.fs env in
117 let cwd = Eio.Stdenv.cwd env in
118 Eio.Switch.run @@ fun sw ->
119 let tmp_name = Printf.sprintf "irmin-test-%d" (Random.int 100000) in
120 let tmp_path = Eio.Path.(cwd / tmp_name) in
121 Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 tmp_path;
122 Fun.protect
123 ~finally:(fun () ->
124 (* Clean up temp directory *)
125 let rec rm path =
126 if Eio.Path.is_directory path then begin
127 List.iter
128 (fun name -> rm Eio.Path.(path / name))
129 (Eio.Path.read_dir path);
130 Eio.Path.rmdir path
131 end
132 else if Eio.Path.is_file path then Eio.Path.unlink path
133 in
134 rm tmp_path)
135 (fun () -> f ~sw ~fs tmp_path)
136
137let test_disk_backend () =
138 with_temp_dir @@ fun ~sw ~fs:_ tmp_path ->
139 let backend = Backend.Disk.create_sha1 ~sw tmp_path in
140 let data = "test content" in
141 let hash = Hash.sha1 data in
142 backend.write hash data;
143 Alcotest.(check (option string)) "read back" (Some data) (backend.read hash);
144 backend.close ()
145
146let test_disk_backend_persistence () =
147 Eio_main.run @@ fun env ->
148 let cwd = Eio.Stdenv.cwd env in
149 let tmp_name = Printf.sprintf "irmin-test-%d" (Random.int 100000) in
150 let tmp_path = Eio.Path.(cwd / tmp_name) in
151 let data = "persistent content" in
152 let hash = Hash.sha1 data in
153 (* Write and close *)
154 Eio.Switch.run (fun sw ->
155 let backend = Backend.Disk.create_sha1 ~sw tmp_path in
156 backend.write hash data;
157 backend.set_ref "refs/heads/main" hash;
158 backend.flush ();
159 backend.close ());
160 (* Reopen and read *)
161 Eio.Switch.run (fun sw ->
162 let backend = Backend.Disk.create_sha1 ~sw tmp_path in
163 Alcotest.(check (option string))
164 "read after reopen" (Some data) (backend.read hash);
165 Alcotest.(check bool)
166 "ref persisted" true
167 (Option.is_some (backend.get_ref "refs/heads/main"));
168 backend.close ());
169 (* Clean up *)
170 let rec rm path =
171 if Eio.Path.is_directory path then begin
172 List.iter (fun name -> rm Eio.Path.(path / name)) (Eio.Path.read_dir path);
173 Eio.Path.rmdir path
174 end
175 else if Eio.Path.is_file path then Eio.Path.unlink path
176 in
177 rm tmp_path
178
179let test_disk_backend_refs () =
180 with_temp_dir @@ fun ~sw ~fs:_ tmp_path ->
181 let backend = Backend.Disk.create_sha1 ~sw tmp_path in
182 let data = "content" in
183 let hash = Hash.sha1 data in
184 backend.write hash data;
185 backend.set_ref "refs/heads/main" hash;
186 Alcotest.(check bool)
187 "ref exists" true
188 (Option.is_some (backend.get_ref "refs/heads/main"));
189 (match backend.get_ref "refs/heads/main" with
190 | Some h -> Alcotest.(check bool) "ref matches" true (Hash.equal hash h)
191 | None -> Alcotest.fail "ref not found");
192 backend.close ()
193
194let test_disk_backend_write_batch () =
195 with_temp_dir @@ fun ~sw ~fs:_ tmp_path ->
196 let backend = Backend.Disk.create_sha1 ~sw tmp_path in
197 let objects =
198 [
199 (Hash.sha1 "data1", "data1");
200 (Hash.sha1 "data2", "data2");
201 (Hash.sha1 "data3", "data3");
202 ]
203 in
204 backend.write_batch objects;
205 List.iter
206 (fun (hash, data) ->
207 Alcotest.(check (option string))
208 "batch item" (Some data) (backend.read hash))
209 objects;
210 backend.close ()
211
212let test_disk_backend_wal_recovery () =
213 (* Test WAL crash recovery: write without flush, reopen, verify data *)
214 Eio_main.run @@ fun env ->
215 let cwd = Eio.Stdenv.cwd env in
216 let tmp_name = Printf.sprintf "irmin-wal-test-%d" (Random.int 100000) in
217 let tmp_path = Eio.Path.(cwd / tmp_name) in
218 let data = "wal recovery content" in
219 let hash = Hash.sha1 data in
220 (* Write but DON'T flush - simulates crash before checkpoint *)
221 Eio.Switch.run (fun sw ->
222 let backend = Backend.Disk.create_sha1 ~sw tmp_path in
223 backend.write hash data;
224 (* Verify it's readable in current session *)
225 Alcotest.(check (option string))
226 "readable before crash" (Some data) (backend.read hash);
227 (* Close without flush - WAL should still have the entry *)
228 backend.close ());
229 (* Reopen - should replay WAL and recover the data *)
230 Eio.Switch.run (fun sw ->
231 let backend = Backend.Disk.create_sha1 ~sw tmp_path in
232 Alcotest.(check (option string))
233 "recovered from WAL" (Some data) (backend.read hash);
234 (* Bloom filter should also have the entry *)
235 Alcotest.(check bool) "exists after recovery" true (backend.exists hash);
236 backend.close ());
237 (* Clean up *)
238 let rec rm path =
239 if Eio.Path.is_directory path then begin
240 List.iter (fun name -> rm Eio.Path.(path / name)) (Eio.Path.read_dir path);
241 Eio.Path.rmdir path
242 end
243 else if Eio.Path.is_file path then Eio.Path.unlink path
244 in
245 rm tmp_path
246
247(* Store tests *)
248let test_store_commit () =
249 let backend = Backend.Memory.create_sha1 () in
250 let store = Store.Git.create ~backend in
251 let tree = Tree.Git.empty () in
252 let tree = Tree.Git.add tree [ "README.md" ] "# Hello" in
253 let hash =
254 Store.Git.commit store ~tree ~parents:[] ~message:"Initial commit"
255 ~author:"test"
256 in
257 Alcotest.(check bool) "commit hash exists" true (backend.exists hash)
258
259let test_store_branches () =
260 let backend = Backend.Memory.create_sha1 () in
261 let store = Store.Git.create ~backend in
262 let tree = Tree.Git.empty () in
263 let hash =
264 Store.Git.commit store ~tree ~parents:[] ~message:"test" ~author:"test"
265 in
266 Store.Git.set_head store ~branch:"main" hash;
267 let branches = Store.Git.branches store in
268 Alcotest.(check (list string)) "branches" [ "main" ] branches
269
270(* Tree format tests *)
271let test_git_tree_format () =
272 let node = Codec.Git.empty_node in
273 Alcotest.(check bool) "empty is empty" true (Codec.Git.is_empty node);
274 let h = Hash.sha1 "content" in
275 let node = Codec.Git.add node "file.txt" (`Contents h) in
276 Alcotest.(check bool) "not empty after add" false (Codec.Git.is_empty node);
277 match Codec.Git.find node "file.txt" with
278 | Some (`Contents h') ->
279 Alcotest.(check bool) "find matches" true (Hash.equal h h')
280 | _ -> Alcotest.fail "entry not found"
281
282let test_git_tree_serialization () =
283 let h = Hash.sha1 "content" in
284 let node = Codec.Git.empty_node in
285 let node = Codec.Git.add node "file.txt" (`Contents h) in
286 let bytes = Codec.Git.bytes_of_node node in
287 match Codec.Git.node_of_bytes bytes with
288 | Ok node' ->
289 let entries = Codec.Git.list node' in
290 Alcotest.(check int) "one entry" 1 (List.length entries)
291 | Error (`Msg msg) -> Alcotest.fail msg
292
293(* Test suites *)
294let hash_tests =
295 [
296 Alcotest.test_case "sha1 hash" `Quick test_sha1_hash;
297 Alcotest.test_case "sha256 hash" `Quick test_sha256_hash;
298 Alcotest.test_case "hash roundtrip" `Quick test_hash_roundtrip;
299 Alcotest.test_case "mst depth" `Quick test_mst_depth;
300 ]
301
302let tree_tests =
303 [
304 Alcotest.test_case "empty tree" `Quick test_empty_tree;
305 Alcotest.test_case "tree add/find" `Quick test_tree_add_find;
306 Alcotest.test_case "tree remove" `Quick test_tree_remove;
307 Alcotest.test_case "tree overwrite" `Quick test_tree_overwrite;
308 Alcotest.test_case "tree nested" `Quick test_tree_nested;
309 ]
310
311let backend_tests =
312 [
313 Alcotest.test_case "memory backend" `Quick test_memory_backend;
314 Alcotest.test_case "backend refs" `Quick test_backend_refs;
315 Alcotest.test_case "backend test_and_set" `Quick test_backend_test_and_set;
316 Alcotest.test_case "disk backend" `Quick test_disk_backend;
317 Alcotest.test_case "disk backend persistence" `Quick
318 test_disk_backend_persistence;
319 Alcotest.test_case "disk backend refs" `Quick test_disk_backend_refs;
320 Alcotest.test_case "disk backend write_batch" `Quick
321 test_disk_backend_write_batch;
322 Alcotest.test_case "disk backend WAL recovery" `Quick
323 test_disk_backend_wal_recovery;
324 ]
325
326let test_store_diff () =
327 let backend = Backend.Memory.create_sha1 () in
328 let store = Store.Git.create ~backend in
329 (* Create first commit with two files *)
330 let tree1 = Tree.Git.empty () in
331 let tree1 = Tree.Git.add tree1 [ "file1.txt" ] "content1" in
332 let tree1 = Tree.Git.add tree1 [ "file2.txt" ] "content2" in
333 let hash1 = Tree.Git.hash tree1 ~backend in
334 (* Create second tree: modify file1, remove file2, add file3 *)
335 let tree2 = Tree.Git.empty () in
336 let tree2 = Tree.Git.add tree2 [ "file1.txt" ] "modified1" in
337 let tree2 = Tree.Git.add tree2 [ "file3.txt" ] "content3" in
338 let hash2 = Tree.Git.hash tree2 ~backend in
339 (* Compute diff *)
340 let changes = Store.Git.diff store ~old:hash1 ~new_:hash2 |> List.of_seq in
341 (* Check we have the expected changes *)
342 let has_remove_file2 =
343 List.exists
344 (function `Remove [ "file2.txt" ] -> true | _ -> false)
345 changes
346 in
347 let has_add_file3 =
348 List.exists
349 (function `Add ([ "file3.txt" ], _) -> true | _ -> false)
350 changes
351 in
352 let has_change_file1 =
353 List.exists
354 (function `Change ([ "file1.txt" ], _, _) -> true | _ -> false)
355 changes
356 in
357 Alcotest.(check bool) "file2 removed" true has_remove_file2;
358 Alcotest.(check bool) "file3 added" true has_add_file3;
359 Alcotest.(check bool) "file1 changed" true has_change_file1
360
361let store_tests =
362 [
363 Alcotest.test_case "store commit" `Quick test_store_commit;
364 Alcotest.test_case "store branches" `Quick test_store_branches;
365 Alcotest.test_case "store diff" `Quick test_store_diff;
366 ]
367
368let test_git_inline_roundtrip () =
369 let node = Codec.Git.empty_node in
370 let node = Codec.Git.add node "small" (`Contents_inlined "hello") in
371 let h = Hash.sha1 "some content" in
372 let node = Codec.Git.add node "big" (`Contents h) in
373 let node = Codec.Git.add node "dir" (`Node h) in
374 let bytes = Codec.Git.bytes_of_node node in
375 match Codec.Git.node_of_bytes bytes with
376 | Error (`Msg m) -> Alcotest.fail m
377 | Ok node' ->
378 (match Codec.Git.find node' "small" with
379 | Some (`Contents_inlined s) ->
380 Alcotest.(check string) "inlined content" "hello" s
381 | _ -> Alcotest.fail "inlined entry not found");
382 (match Codec.Git.find node' "big" with
383 | Some (`Contents h') ->
384 Alcotest.(check bool) "hash content" true (Hash.equal h h')
385 | _ -> Alcotest.fail "hash entry not found");
386 (match Codec.Git.find node' "dir" with
387 | Some (`Node h') ->
388 Alcotest.(check bool) "node entry" true (Hash.equal h h')
389 | _ -> Alcotest.fail "node entry not found");
390 let entries = Codec.Git.list node' in
391 Alcotest.(check int) "3 entries" 3 (List.length entries)
392
393let test_tree_inline_write_read () =
394 let backend = Backend.Memory.create_sha1 () in
395 let tree = Tree.Git.empty () in
396 let tree = Tree.Git.add tree [ "small" ] "hi" in
397 let tree = Tree.Git.add tree [ "big" ] (String.make 100 'x') in
398 (* Write with inlining enabled *)
399 let hash = Tree.Git.hash ~inline_threshold:48 tree ~backend in
400 (* Read back *)
401 let tree2 = Tree.Git.of_hash ~backend hash in
402 Alcotest.(check (option string))
403 "small inlined" (Some "hi")
404 (Tree.Git.find tree2 [ "small" ]);
405 Alcotest.(check (option string))
406 "big not inlined" (Some (String.make 100 'x'))
407 (Tree.Git.find tree2 [ "big" ]);
408 let entries = Tree.Git.list tree2 [] in
409 Alcotest.(check int) "2 entries" 2 (List.length entries)
410
411let test_tree_inline_nested () =
412 let backend = Backend.Memory.create_sha1 () in
413 let tree = Tree.Git.empty () in
414 let tree = Tree.Git.add tree [ "dir"; "a" ] "small value" in
415 let tree = Tree.Git.add tree [ "dir"; "b" ] (String.make 100 'y') in
416 let tree = Tree.Git.add tree [ "root" ] "top" in
417 let hash = Tree.Git.hash ~inline_threshold:48 tree ~backend in
418 let tree2 = Tree.Git.of_hash ~backend hash in
419 Alcotest.(check (option string))
420 "nested small" (Some "small value")
421 (Tree.Git.find tree2 [ "dir"; "a" ]);
422 Alcotest.(check (option string))
423 "nested big" (Some (String.make 100 'y'))
424 (Tree.Git.find tree2 [ "dir"; "b" ]);
425 Alcotest.(check (option string))
426 "top level" (Some "top")
427 (Tree.Git.find tree2 [ "root" ])
428
429let tree_format_tests =
430 [
431 Alcotest.test_case "git tree format" `Quick test_git_tree_format;
432 Alcotest.test_case "git tree serialization" `Quick
433 test_git_tree_serialization;
434 Alcotest.test_case "git inline roundtrip" `Quick test_git_inline_roundtrip;
435 Alcotest.test_case "tree inline write/read" `Quick
436 test_tree_inline_write_read;
437 Alcotest.test_case "tree inline nested" `Quick test_tree_inline_nested;
438 ]
439
440(* Link tests *)
441let test_link_v_get () =
442 let s = Link.Mst.v () in
443 let l = Link.v s 42 in
444 Alcotest.(check int) "get (v s x) = x" 42 (Link.get l)
445
446let test_link_is_val () =
447 let s = Link.Mst.v () in
448 let l = Link.v s "hello" in
449 Alcotest.(check bool) "in-memory is_val" true (Link.is_val l)
450
451let test_link_equal () =
452 let s = Link.Mst.v () in
453 let l0 = Link.v s [ 1; 2; 3 ] in
454 let l1 = Link.v s [ 1; 2; 3 ] in
455 let l2 = Link.v s [ 1; 2; 4 ] in
456 Alcotest.(check bool) "same value equal" true (Link.equal l0 l1);
457 Alcotest.(check bool) "diff value not equal" false (Link.equal l0 l2)
458
459let test_link_address () =
460 let s = Link.Mst.v () in
461 let l0 = Link.v s "test" in
462 let l1 = Link.v s "test" in
463 Alcotest.(check bool) "same address" true (Link.address l0 = Link.address l1)
464
465let test_link_pp () =
466 let s = Link.Mst.v () in
467 let l = Link.v s "test" in
468 let _ = Link.address l in
469 (* force address computation *)
470 let str = Format.asprintf "%a" Link.pp l in
471 Alcotest.(check int) "pp is 7 chars" 7 (String.length str)
472
473let test_link_read_write () =
474 let s : int Link.store = Link.Mst.v () in
475 Link.write s 42;
476 Alcotest.(check int) "after write" 42 (Link.read s);
477 Link.write s 100;
478 Alcotest.(check int) "after second write" 100 (Link.read s)
479
480let test_link_is_open () =
481 let s = Link.Mst.v () in
482 Alcotest.(check bool) "initially open" true (Link.is_open s);
483 Link.close s;
484 Alcotest.(check bool) "closed after close" false (Link.is_open s)
485
486(* Tree types for the tree example test *)
487type test_tree = test_node Link.t
488and test_node = TEmpty | TNode of { l : test_tree; x : int; r : test_tree }
489
490let test_link_tree () =
491 let s = Link.Mst.v () in
492 let empty = Link.v s TEmpty in
493 let leaf x = Link.v s (TNode { l = empty; x; r = empty }) in
494 let node l x r = Link.v s (TNode { l; x; r }) in
495 let t = node (leaf 1) 2 (leaf 3) in
496 match Link.get t with
497 | TEmpty -> Alcotest.fail "expected node"
498 | TNode n -> (
499 Alcotest.(check int) "root" 2 n.x;
500 match (Link.get n.l, Link.get n.r) with
501 | TNode l, TNode r ->
502 Alcotest.(check int) "left" 1 l.x;
503 Alcotest.(check int) "right" 3 r.x
504 | _ -> Alcotest.fail "expected leaves")
505
506let link_tests =
507 [
508 Alcotest.test_case "v/get" `Quick test_link_v_get;
509 Alcotest.test_case "is_val" `Quick test_link_is_val;
510 Alcotest.test_case "equal" `Quick test_link_equal;
511 Alcotest.test_case "address" `Quick test_link_address;
512 Alcotest.test_case "pp" `Quick test_link_pp;
513 Alcotest.test_case "read/write" `Quick test_link_read_write;
514 Alcotest.test_case "is_open" `Quick test_link_is_open;
515 Alcotest.test_case "tree" `Quick test_link_tree;
516 ]
517
518(* Proof tests *)
519let test_proof_produce_verify () =
520 let backend = Backend.Memory.create_sha1 () in
521 (* Build a tree: foo/bar = "hello", foo/baz = "world" *)
522 let tree = Tree.Git.empty () in
523 let tree = Tree.Git.add tree [ "foo"; "bar" ] "hello" in
524 let tree = Tree.Git.add tree [ "foo"; "baz" ] "world" in
525 let root_hash = Tree.Git.hash tree ~backend in
526 (* Produce a proof that only accesses foo/bar *)
527 let proof, result =
528 Proof.Git.produce backend root_hash (fun t ->
529 let v = Proof.Git.Tree.find t [ "foo"; "bar" ] in
530 (t, v))
531 in
532 Alcotest.(check (option string)) "found value" (Some "hello") result;
533 (* Verify the proof *)
534 match
535 Proof.Git.verify proof (fun t ->
536 let v = Proof.Git.Tree.find t [ "foo"; "bar" ] in
537 (t, v))
538 with
539 | Ok (_, v) ->
540 Alcotest.(check (option string)) "verified value" (Some "hello") v
541 | Error (`Proof_mismatch msg) -> Alcotest.fail ("proof mismatch: " ^ msg)
542
543let test_proof_blinded () =
544 let backend = Backend.Memory.create_sha1 () in
545 let tree = Tree.Git.empty () in
546 let tree = Tree.Git.add tree [ "a" ] "1" in
547 let tree = Tree.Git.add tree [ "b" ] "2" in
548 let root_hash = Tree.Git.hash tree ~backend in
549 (* Only access "a", "b" should be blinded *)
550 let proof, _ =
551 Proof.Git.produce backend root_hash (fun t ->
552 let _ = Proof.Git.Tree.find t [ "a" ] in
553 (t, ()))
554 in
555 (* Check proof state has blinded nodes *)
556 let state = Proof.state proof in
557 match state with
558 | Proof.Node entries ->
559 let has_a =
560 List.exists
561 (fun (k, v) ->
562 k = "a" && match v with Proof.Contents "1" -> true | _ -> false)
563 entries
564 in
565 let has_blinded_b =
566 List.exists
567 (fun (k, v) ->
568 k = "b"
569 && match v with Proof.Blinded_contents _ -> true | _ -> false)
570 entries
571 in
572 Alcotest.(check bool) "has a" true has_a;
573 Alcotest.(check bool) "b is blinded" true has_blinded_b
574 | _ -> Alcotest.fail "expected Node"
575
576let test_proof_mst () =
577 let backend = Backend.Memory.create_sha256 () in
578 let tree = Tree.Mst.empty () in
579 let tree = Tree.Mst.add tree [ "key1" ] "value1" in
580 let tree = Tree.Mst.add tree [ "key2" ] "value2" in
581 let root_hash = Tree.Mst.hash tree ~backend in
582 let proof, result =
583 Proof.Mst.produce backend root_hash (fun t ->
584 let v = Proof.Mst.Tree.find t [ "key1" ] in
585 (t, v))
586 in
587 Alcotest.(check (option string)) "found value" (Some "value1") result;
588 match
589 Proof.Mst.verify proof (fun t ->
590 let v = Proof.Mst.Tree.find t [ "key1" ] in
591 (t, v))
592 with
593 | Ok (_, v) ->
594 Alcotest.(check (option string)) "verified value" (Some "value1") v
595 | Error (`Proof_mismatch msg) -> Alcotest.fail ("proof mismatch: " ^ msg)
596
597let proof_tests =
598 [
599 Alcotest.test_case "produce/verify" `Quick test_proof_produce_verify;
600 Alcotest.test_case "blinded nodes" `Quick test_proof_blinded;
601 Alcotest.test_case "mst proofs" `Quick test_proof_mst;
602 ]
603
604let () =
605 Alcotest.run "Irmin"
606 [
607 ("Hash", hash_tests);
608 ("Tree", tree_tests);
609 ("Backend", backend_tests);
610 ("Store", store_tests);
611 ("Codec", tree_format_tests);
612 ("Link", link_tests);
613 ("Proof", proof_tests);
614 ]