Persistent store with Git semantics: lazy reads, delayed writes, content-addressing
Add ocaml-reed-solomon, full Proximity-1 codec, fuzzers
New package:
- ocaml-reed-solomon: RS error correction over GF(2^8) with
Berlekamp-Massey decoder, Chien search, Forney algorithm.
CCSDS RS(255,223) preset. 17 tests including error correction
up to t=16 symbols.
Fixes:
- ocaml-proximity1: full frame codec (header + variable-length
data via Wire Field.ref on frame_length), not just header
Fuzz tests added for:
- ocaml-cltu: CLTU/BCH roundtrip, ASM, sync parsers (6 tests)
- ocaml-cop1: FOP-1/FARM-1 random event sequences (5 tests)
- ocaml-fsr: encode/decode roundtrip, crash safety (4 tests)
- ocaml-ccsds-time: CUC/CDS roundtrip, pfield (7 tests)
- ocaml-tm-sync: randomizer self-inverse property (5 tests)
- ocaml-proximity1: full frame roundtrip, crash safety (5 tests)
+31
-33
+2
-2
bin/cmd_proof.ml
+2
-2
bin/cmd_proof.ml
···
4
4
open Private
5
5
6
6
let produce ~output ~key data =
7
-
let backend = Backend.Memory.create_cid () in
7
+
let backend = Backend.Memory.cid () in
8
8
(* Parse input: lines of "key=value" *)
9
9
let tree =
10
10
List.fold_left
···
53
53
0
54
54
55
55
let verify ~output ~key data =
56
-
let backend = Backend.Memory.create_cid () in
56
+
let backend = Backend.Memory.cid () in
57
57
let tree =
58
58
List.fold_left
59
59
(fun tree line ->
+2
-4
lib/irmin.ml
+2
-4
lib/irmin.ml
···
579
579
let of_pds pds = T ((module Pds_S), pds)
580
580
581
581
let disk ~sw root =
582
-
v
583
-
(Private.Store.Mst.create
584
-
~backend:(Private.Backend.Disk.create_cid ~sw root))
582
+
v (Private.Store.Mst.create ~backend:(Private.Backend.Disk.cid ~sw root))
585
583
586
584
let memory () =
587
-
v (Private.Store.Mst.create ~backend:(Private.Backend.Memory.create_cid ()))
585
+
v (Private.Store.Mst.create ~backend:(Private.Backend.Memory.cid ()))
588
586
end
+1
-1
test/mst_proof/mst_proof.ml
+1
-1
test/mst_proof/mst_proof.ml
+10
-10
test/test_backend.ml
+10
-10
test/test_backend.ml
···
20
20
Fun.protect ~finally:(fun () -> rm_rf tmp_path) (fun () -> f ~sw tmp_path)
21
21
22
22
let test_memory_backend () =
23
-
let backend = Backend.Memory.create_sha1 () in
23
+
let backend = Backend.Memory.sha1 () in
24
24
let data = "test content" in
25
25
let hash = Hash.sha1 data in
26
26
Backend.write backend hash data;
···
29
29
(Backend.read backend hash)
30
30
31
31
let test_backend_refs () =
32
-
let backend = Backend.Memory.create_sha1 () in
32
+
let backend = Backend.Memory.sha1 () in
33
33
let data = "content" in
34
34
let hash = Hash.sha1 data in
35
35
Backend.write backend hash data;
···
42
42
| None -> Alcotest.fail "ref not found"
43
43
44
44
let test_backend_test_and_set () =
45
-
let backend = Backend.Memory.create_sha1 () in
45
+
let backend = Backend.Memory.sha1 () in
46
46
let h1 = Hash.sha1 "content1" in
47
47
let h2 = Hash.sha1 "content2" in
48
48
Backend.write backend h1 "content1";
···
59
59
60
60
let test_disk_backend () =
61
61
with_temp_dir @@ fun ~sw tmp_path ->
62
-
let backend = Backend.Disk.create_sha1 ~sw tmp_path in
62
+
let backend = Backend.Disk.sha1 ~sw tmp_path in
63
63
let data = "test content" in
64
64
let hash = Hash.sha1 data in
65
65
Backend.write backend hash data;
···
76
76
let data = "persistent content" in
77
77
let hash = Hash.sha1 data in
78
78
Eio.Switch.run (fun sw ->
79
-
let backend = Backend.Disk.create_sha1 ~sw tmp_path in
79
+
let backend = Backend.Disk.sha1 ~sw tmp_path in
80
80
Backend.write backend hash data;
81
81
Backend.set_ref backend "refs/heads/main" hash;
82
82
Backend.flush backend;
83
83
Backend.close backend);
84
84
Eio.Switch.run (fun sw ->
85
-
let backend = Backend.Disk.create_sha1 ~sw tmp_path in
85
+
let backend = Backend.Disk.sha1 ~sw tmp_path in
86
86
Alcotest.(check (option string))
87
87
"read after reopen" (Some data)
88
88
(Backend.read backend hash);
···
94
94
95
95
let test_disk_backend_refs () =
96
96
with_temp_dir @@ fun ~sw tmp_path ->
97
-
let backend = Backend.Disk.create_sha1 ~sw tmp_path in
97
+
let backend = Backend.Disk.sha1 ~sw tmp_path in
98
98
let data = "content" in
99
99
let hash = Hash.sha1 data in
100
100
Backend.write backend hash data;
···
109
109
110
110
let test_disk_backend_write_batch () =
111
111
with_temp_dir @@ fun ~sw tmp_path ->
112
-
let backend = Backend.Disk.create_sha1 ~sw tmp_path in
112
+
let backend = Backend.Disk.sha1 ~sw tmp_path in
113
113
let objects =
114
114
[
115
115
(Hash.sha1 "data1", "data1");
···
134
134
let data = "wal recovery content" in
135
135
let hash = Hash.sha1 data in
136
136
Eio.Switch.run (fun sw ->
137
-
let backend = Backend.Disk.create_sha1 ~sw tmp_path in
137
+
let backend = Backend.Disk.sha1 ~sw tmp_path in
138
138
Backend.write backend hash data;
139
139
Alcotest.(check (option string))
140
140
"readable before crash" (Some data)
141
141
(Backend.read backend hash);
142
142
Backend.close backend);
143
143
Eio.Switch.run (fun sw ->
144
-
let backend = Backend.Disk.create_sha1 ~sw tmp_path in
144
+
let backend = Backend.Disk.sha1 ~sw tmp_path in
145
145
Alcotest.(check (option string))
146
146
"recovered from WAL" (Some data)
147
147
(Backend.read backend hash);
+2
-2
test/test_link.ml
+2
-2
test/test_link.ml
···
67
67
(* of_backend: links persist through the backend and can be fetched by address
68
68
using a second store instance backed by the same backend. *)
69
69
let test_link_of_backend_persist () =
70
-
let backend = Backend.Memory.create_cid () in
70
+
let backend = Backend.Memory.cid () in
71
71
let s : int Link.store = Link.Mst.of_backend backend in
72
72
let l = Link.v s 42 in
73
73
let addr = Link.address l in
···
78
78
79
79
(* of_backend with Git codec *)
80
80
let test_link_of_backend_git () =
81
-
let backend = Backend.Memory.create_sha1 () in
81
+
let backend = Backend.Memory.sha1 () in
82
82
let s : string Link.store = Link.Git.of_backend backend in
83
83
let l = Link.v s "hello" in
84
84
let addr = Link.address l in
+8
-8
test/test_proof.ml
+8
-8
test/test_proof.ml
···
2
2
open Private
3
3
4
4
let test_proof_produce_verify () =
5
-
let backend = Backend.Memory.create_sha1 () in
5
+
let backend = Backend.Memory.sha1 () in
6
6
let tree = Tree.Git.empty () in
7
7
let tree = Tree.Git.add tree [ "foo"; "bar" ] "hello" in
8
8
let tree = Tree.Git.add tree [ "foo"; "baz" ] "world" in
···
23
23
| Error (`Proof_mismatch msg) -> Alcotest.fail ("proof mismatch: " ^ msg)
24
24
25
25
let test_proof_blinded () =
26
-
let backend = Backend.Memory.create_sha1 () in
26
+
let backend = Backend.Memory.sha1 () in
27
27
let tree = Tree.Git.empty () in
28
28
let tree = Tree.Git.add tree [ "a" ] "1" in
29
29
let tree = Tree.Git.add tree [ "b" ] "2" in
···
54
54
| _ -> Alcotest.fail "expected Node"
55
55
56
56
let test_proof_mst () =
57
-
let backend = Backend.Memory.create_cid () in
57
+
let backend = Backend.Memory.cid () in
58
58
let tree = Tree.Mst.empty () in
59
59
let tree = Tree.Mst.add tree [ "key1" ] "value1" in
60
60
let tree = Tree.Mst.add tree [ "key2" ] "value2" in
···
75
75
| Error (`Proof_mismatch msg) -> Alcotest.fail ("proof mismatch: " ^ msg)
76
76
77
77
let test_wrong_expected_root () =
78
-
let backend = Backend.Memory.create_sha1 () in
78
+
let backend = Backend.Memory.sha1 () in
79
79
let tree = Tree.Git.empty () in
80
80
let tree = Tree.Git.add tree [ "foo" ] "bar" in
81
81
let root_hash = Tree.Git.hash tree ~backend in
···
94
94
| Error (`Proof_mismatch _) -> ()
95
95
96
96
let test_wrong_before () =
97
-
let backend = Backend.Memory.create_sha1 () in
97
+
let backend = Backend.Memory.sha1 () in
98
98
let tree = Tree.Git.empty () in
99
99
let tree = Tree.Git.add tree [ "foo" ] "bar" in
100
100
let root_hash = Tree.Git.hash tree ~backend in
···
117
117
| Error (`Proof_mismatch _) -> ()
118
118
119
119
let test_wrong_after () =
120
-
let backend = Backend.Memory.create_sha1 () in
120
+
let backend = Backend.Memory.sha1 () in
121
121
let tree = Tree.Git.empty () in
122
122
let tree = Tree.Git.add tree [ "foo" ] "bar" in
123
123
let root_hash = Tree.Git.hash tree ~backend in
···
140
140
| Error (`Proof_mismatch _) -> ()
141
141
142
142
let test_wrong_state () =
143
-
let backend = Backend.Memory.create_sha1 () in
143
+
let backend = Backend.Memory.sha1 () in
144
144
let tree = Tree.Git.empty () in
145
145
let tree = Tree.Git.add tree [ "foo" ] "bar" in
146
146
let root_hash = Tree.Git.hash tree ~backend in
···
170
170
let test_attacker_crafted_proof () =
171
171
(* An attacker creates a proof for an arbitrary tree and claims it as a
172
172
legitimate root. verify must reject because expected_root won't match. *)
173
-
let backend = Backend.Memory.create_sha1 () in
173
+
let backend = Backend.Memory.sha1 () in
174
174
let real_tree = Tree.Git.empty () in
175
175
let real_tree = Tree.Git.add real_tree [ "secret" ] "real_value" in
176
176
let real_root = Tree.Git.hash real_tree ~backend in
+3
-3
test/test_store.ml
+3
-3
test/test_store.ml
···
7
7
(* {1 Internal API tests (using Private modules directly)} *)
8
8
9
9
let test_store_commit () =
10
-
let backend = Backend.Memory.create_sha1 () in
10
+
let backend = Backend.Memory.sha1 () in
11
11
let store = Store.Git.create ~backend in
12
12
let tree = Tree.Git.empty () in
13
13
let tree = Tree.Git.add tree [ "README.md" ] "# Hello" in
···
18
18
Alcotest.(check bool) "commit hash exists" true (Backend.exists backend hash)
19
19
20
20
let test_store_branches () =
21
-
let backend = Backend.Memory.create_sha1 () in
21
+
let backend = Backend.Memory.sha1 () in
22
22
let store = Store.Git.create ~backend in
23
23
let tree = Tree.Git.empty () in
24
24
let hash =
···
29
29
Alcotest.(check (list string)) "branches" [ "main" ] branches
30
30
31
31
let test_store_diff () =
32
-
let backend = Backend.Memory.create_sha1 () in
32
+
let backend = Backend.Memory.sha1 () in
33
33
let store = Store.Git.create ~backend in
34
34
let tree1 = Tree.Git.empty () in
35
35
let tree1 = Tree.Git.add tree1 [ "file1.txt" ] "content1" in
+3
-3
test/test_subtree.ml
+3
-3
test/test_subtree.ml
···
2
2
open Private
3
3
4
4
let test_split () =
5
-
let backend = Backend.Memory.create_sha1 () in
5
+
let backend = Backend.Memory.sha1 () in
6
6
let store = Store.Git.create ~backend in
7
7
let tree = Tree.Git.empty () in
8
8
let tree = Tree.Git.add tree [ "sub"; "file.txt" ] "content" in
···
15
15
()
16
16
17
17
let test_status_in_sync () =
18
-
let backend1 = Backend.Memory.create_sha1 () in
18
+
let backend1 = Backend.Memory.sha1 () in
19
19
let store1 = Store.Git.create ~backend:backend1 in
20
-
let backend2 = Backend.Memory.create_sha1 () in
20
+
let backend2 = Backend.Memory.sha1 () in
21
21
let store2 = Store.Git.create ~backend:backend2 in
22
22
let tree = Tree.Git.empty () in
23
23
let tree = Tree.Git.add tree [ "sub"; "a.txt" ] "content" in