vblt.org
forked from
gazagnaire.org/irmin
Persistent store with Git semantics: lazy reads, delayed writes, content-addressing
1(** MST Proof commands. *)
2
3open Irmin
4
5let produce ~output ~key data =
6 let backend = Backend.Memory.create_sha256 () in
7 (* Parse input: lines of "key=value" *)
8 let tree =
9 List.fold_left
10 (fun tree line ->
11 match String.index_opt line '=' with
12 | None -> tree
13 | Some i ->
14 let k = String.sub line 0 i in
15 let v = String.sub line (i + 1) (String.length line - i - 1) in
16 Tree.Mst.add tree [ k ] v)
17 (Tree.Mst.empty ()) data
18 in
19 let root = Tree.Mst.hash tree ~backend in
20
21 let path = [ key ] in
22 let proof, result =
23 Proof.Mst.produce backend root (fun t ->
24 let v = Proof.Mst.Tree.find t path in
25 (t, v))
26 in
27
28 let hash_str h = String.sub (Hash.to_hex h) 0 16 in
29 let before_hash =
30 match Proof.before proof with
31 | `Node h -> hash_str h
32 | `Contents h -> hash_str h
33 in
34 let after_hash =
35 match Proof.after proof with
36 | `Node h -> hash_str h
37 | `Contents h -> hash_str h
38 in
39
40 (match output with
41 | `Human ->
42 Fmt.pr "Root: %s@." (hash_str root);
43 Fmt.pr "Key: %s@." key;
44 Fmt.pr "Value: %s@." (Option.value ~default:"<not found>" result);
45 Fmt.pr "Before: %s@." before_hash;
46 Fmt.pr "After: %s@." after_hash
47 | `Json ->
48 Fmt.pr {|{"root":%S,"key":%S,"value":%s,"before":%S,"after":%S}@.|}
49 (Hash.to_hex root) key
50 (match result with Some v -> Fmt.str "%S" v | None -> "null")
51 before_hash after_hash);
52 0
53
54let verify ~output ~key data =
55 let backend = Backend.Memory.create_sha256 () in
56 let tree =
57 List.fold_left
58 (fun tree line ->
59 match String.index_opt line '=' with
60 | None -> tree
61 | Some i ->
62 let k = String.sub line 0 i in
63 let v = String.sub line (i + 1) (String.length line - i - 1) in
64 Tree.Mst.add tree [ k ] v)
65 (Tree.Mst.empty ()) data
66 in
67 let root = Tree.Mst.hash tree ~backend in
68
69 let path = [ key ] in
70 let proof, _ =
71 Proof.Mst.produce backend root (fun t ->
72 let v = Proof.Mst.Tree.find t path in
73 (t, v))
74 in
75
76 match
77 Proof.Mst.verify proof (fun t ->
78 let v = Proof.Mst.Tree.find t path in
79 (t, v))
80 with
81 | Ok (_, v) ->
82 (match output with
83 | `Human ->
84 Common.success "Verified: %s" (Option.value ~default:"<none>" v)
85 | `Json ->
86 Fmt.pr {|{"verified":true,"value":%s}@.|}
87 (match v with Some x -> Fmt.str "%S" x | None -> "null"));
88 0
89 | Error (`Proof_mismatch msg) ->
90 (match output with
91 | `Human -> Common.error "Invalid: %s" msg
92 | `Json -> Fmt.pr {|{"verified":false,"error":%S}@.|} msg);
93 1