gazagnaire.org
Minimal SQLite key-value store for OCaml
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3 SPDX-License-Identifier: MIT
4 ---------------------------------------------------------------------------*)
5
6let with_temp_db f =
7 Eio_main.run @@ fun env ->
8 let fs = Eio.Stdenv.fs env in
9 let cwd = Eio.Stdenv.cwd env in
10 let tmp_dir = Eio.Path.(cwd / "_build" / "test_sqlite") in
11 (try Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 tmp_dir with Eio.Io _ -> ());
12 let path = Eio.Path.(tmp_dir / Fmt.str "test_%d.db" (Random.int 1_000_000)) in
13 Eio.Switch.run @@ fun sw ->
14 let db = Sqlite.v ~sw path in
15 Fun.protect ~finally:(fun () -> Sqlite.close db) (fun () -> f fs db)
16
17(* Basic operations *)
18
19let test_put_get () =
20 with_temp_db @@ fun _fs db ->
21 Sqlite.put db "key1" "value1";
22 let result = Sqlite.find db "key1" in
23 Alcotest.(check (option string))
24 "get returns put value" (Some "value1") result
25
26let test_get_missing () =
27 with_temp_db @@ fun _fs db ->
28 let result = Sqlite.find db "nonexistent" in
29 Alcotest.(check (option string)) "missing key returns None" None result
30
31let test_put_overwrite () =
32 with_temp_db @@ fun _fs db ->
33 Sqlite.put db "key1" "value1";
34 Sqlite.put db "key1" "value2";
35 let result = Sqlite.find db "key1" in
36 Alcotest.(check (option string)) "overwrite works" (Some "value2") result
37
38let test_delete () =
39 with_temp_db @@ fun _fs db ->
40 Sqlite.put db "key1" "value1";
41 Sqlite.delete db "key1";
42 let result = Sqlite.find db "key1" in
43 Alcotest.(check (option string)) "delete removes key" None result
44
45let test_delete_missing () =
46 with_temp_db @@ fun _fs db ->
47 (* Should not raise *)
48 Sqlite.delete db "nonexistent";
49 Alcotest.(check bool) "delete missing key is no-op" true true
50
51let test_mem () =
52 with_temp_db @@ fun _fs db ->
53 Sqlite.put db "key1" "value1";
54 Alcotest.(check bool) "mem finds existing key" true (Sqlite.mem db "key1");
55 Alcotest.(check bool)
56 "mem returns false for missing" false (Sqlite.mem db "missing")
57
58let test_iter () =
59 with_temp_db @@ fun _fs db ->
60 Sqlite.put db "a" "1";
61 Sqlite.put db "b" "2";
62 Sqlite.put db "c" "3";
63 let items = ref [] in
64 Sqlite.iter db ~f:(fun k v -> items := (k, v) :: !items);
65 let sorted = List.sort compare !items in
66 Alcotest.(check (list (pair string string)))
67 "iter visits all entries"
68 [ ("a", "1"); ("b", "2"); ("c", "3") ]
69 sorted
70
71let test_fold () =
72 with_temp_db @@ fun _fs db ->
73 Sqlite.put db "a" "1";
74 Sqlite.put db "b" "2";
75 let count = Sqlite.fold db ~init:0 ~f:(fun _ _ acc -> acc + 1) in
76 Alcotest.(check int) "fold counts entries" 2 count
77
78(* Binary data *)
79
80let test_binary_values () =
81 with_temp_db @@ fun _fs db ->
82 let binary = "\x00\x01\x02\xff\xfe\xfd" in
83 Sqlite.put db "binary" binary;
84 let result = Sqlite.find db "binary" in
85 Alcotest.(check (option string)) "binary data preserved" (Some binary) result
86
87let test_empty_value () =
88 with_temp_db @@ fun _fs db ->
89 Sqlite.put db "empty" "";
90 let result = Sqlite.find db "empty" in
91 Alcotest.(check (option string)) "empty value works" (Some "") result
92
93let test_large_value () =
94 with_temp_db @@ fun _fs db ->
95 (* Note: B-tree has page splitting constraints limiting max entry size *)
96 let large = String.make 1000 'x' in
97 Sqlite.put db "large" large;
98 let result = Sqlite.find db "large" in
99 Alcotest.(check (option string)) "large value works" (Some large) result
100
101(* Namespaced tables *)
102
103let test_table_basic () =
104 with_temp_db @@ fun _fs db ->
105 let table = Sqlite.Table.create db ~name:"blocks" in
106 Sqlite.Table.put table "cid1" "data1";
107 let result = Sqlite.Table.find table "cid1" in
108 Alcotest.(check (option string)) "table get/put works" (Some "data1") result
109
110let test_table_isolation () =
111 with_temp_db @@ fun _fs db ->
112 let t1 = Sqlite.Table.create db ~name:"table1" in
113 let t2 = Sqlite.Table.create db ~name:"table2" in
114 Sqlite.Table.put t1 "key" "value1";
115 Sqlite.Table.put t2 "key" "value2";
116 (* Also put in default table *)
117 Sqlite.put db "key" "default";
118 Alcotest.(check (option string))
119 "t1 isolated" (Some "value1")
120 (Sqlite.Table.find t1 "key");
121 Alcotest.(check (option string))
122 "t2 isolated" (Some "value2")
123 (Sqlite.Table.find t2 "key");
124 Alcotest.(check (option string))
125 "default isolated" (Some "default") (Sqlite.find db "key")
126
127let test_table_mem_delete () =
128 with_temp_db @@ fun _fs db ->
129 let table = Sqlite.Table.create db ~name:"test" in
130 Sqlite.Table.put table "key1" "value1";
131 Alcotest.(check bool) "mem works" true (Sqlite.Table.mem table "key1");
132 Sqlite.Table.delete table "key1";
133 Alcotest.(check bool) "delete works" false (Sqlite.Table.mem table "key1")
134
135let test_table_iter () =
136 with_temp_db @@ fun _fs db ->
137 let table = Sqlite.Table.create db ~name:"iter_test" in
138 Sqlite.Table.put table "a" "1";
139 Sqlite.Table.put table "b" "2";
140 let items = ref [] in
141 Sqlite.Table.iter table ~f:(fun k v -> items := (k, v) :: !items);
142 let sorted = List.sort compare !items in
143 Alcotest.(check (list (pair string string)))
144 "table iter works"
145 [ ("a", "1"); ("b", "2") ]
146 sorted
147
148(* Security tests - SQL injection resistance *)
149
150let test_sql_injection_key () =
151 with_temp_db @@ fun _fs db ->
152 (* These malicious keys should be treated as literal strings *)
153 let malicious_keys =
154 [
155 "'; DROP TABLE kv; --";
156 "key' OR '1'='1";
157 "key\"; DELETE FROM kv; --";
158 "key\x00injection";
159 "Robert'); DROP TABLE Students;--";
160 ]
161 in
162 List.iter
163 (fun key ->
164 Sqlite.put db key "value";
165 let result = Sqlite.find db key in
166 Alcotest.(check (option string))
167 (Fmt.str "injection key %S safe" key)
168 (Some "value") result)
169 malicious_keys
170
171let test_sql_injection_value () =
172 with_temp_db @@ fun _fs db ->
173 let malicious_values =
174 [ "'; DROP TABLE kv; --"; "value' OR '1'='1"; "\x00\x00\x00" ]
175 in
176 List.iter
177 (fun value ->
178 Sqlite.put db "key" value;
179 let result = Sqlite.find db "key" in
180 Alcotest.(check (option string))
181 (Fmt.str "injection value safe")
182 (Some value) result)
183 malicious_values
184
185let test_table_name_validation () =
186 with_temp_db @@ fun _fs db ->
187 let invalid_names =
188 [
189 "";
190 "table; DROP TABLE kv;";
191 "table'";
192 "table\"";
193 "table\x00";
194 "table name";
195 "123start";
196 ]
197 in
198 List.iter
199 (fun name ->
200 try
201 let _ = Sqlite.Table.create db ~name in
202 Alcotest.failf "should reject invalid name: %S" name
203 with Invalid_argument _ -> ())
204 invalid_names
205
206let test_valid_table_names () =
207 with_temp_db @@ fun _fs db ->
208 let valid_names =
209 [ "blocks"; "refs"; "meta"; "Table1"; "my_table"; "a"; "A123_test" ]
210 in
211 List.iter
212 (fun name ->
213 let table = Sqlite.Table.create db ~name in
214 Sqlite.Table.put table "key" "value";
215 let result = Sqlite.Table.find table "key" in
216 Alcotest.(check (option string))
217 (Fmt.str "valid table %S works" name)
218 (Some "value") result)
219 valid_names
220
221(* Unicode and special characters *)
222
223let test_unicode_keys () =
224 with_temp_db @@ fun _fs db ->
225 let unicode_keys = [ "café"; "日本語"; "emoji🎉"; "Ω≈ç√∫" ] in
226 List.iter
227 (fun key ->
228 Sqlite.put db key "value";
229 let result = Sqlite.find db key in
230 Alcotest.(check (option string))
231 (Fmt.str "unicode key %S" key)
232 (Some "value") result)
233 unicode_keys
234
235let test_unicode_values () =
236 with_temp_db @@ fun _fs db ->
237 let unicode = "日本語テスト🎉" in
238 Sqlite.put db "key" unicode;
239 let result = Sqlite.find db "key" in
240 Alcotest.(check (option string)) "unicode value" (Some unicode) result
241
242(* Sync *)
243
244let test_sync () =
245 with_temp_db @@ fun _fs db ->
246 Sqlite.put db "key" "value";
247 (* sync should not raise *)
248 Sqlite.sync db;
249 let result = Sqlite.find db "key" in
250 Alcotest.(check (option string))
251 "data persists after sync" (Some "value") result
252
253(* Persistence - critical for correctness *)
254
255let test_persistence_basic () =
256 Eio_main.run @@ fun env ->
257 let cwd = Eio.Stdenv.cwd env in
258 let tmp_dir = Eio.Path.(cwd / "_build" / "test_sqlite") in
259 (try Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 tmp_dir with Eio.Io _ -> ());
260 let path =
261 Eio.Path.(tmp_dir / Fmt.str "persist_%d.db" (Random.int 1_000_000))
262 in
263 (* Create and write *)
264 Eio.Switch.run (fun sw ->
265 let db = Sqlite.v ~sw path in
266 Sqlite.put db "key1" "value1";
267 Sqlite.put db "key2" "value2";
268 Sqlite.close db);
269 (* Reopen and read *)
270 Eio.Switch.run (fun sw ->
271 let db = Sqlite.open_ ~sw path in
272 let r1 = Sqlite.find db "key1" in
273 let r2 = Sqlite.find db "key2" in
274 Alcotest.(check (option string)) "key1 persisted" (Some "value1") r1;
275 Alcotest.(check (option string)) "key2 persisted" (Some "value2") r2;
276 Sqlite.close db)
277
278let test_persistence_with_delete () =
279 Eio_main.run @@ fun env ->
280 let cwd = Eio.Stdenv.cwd env in
281 let tmp_dir = Eio.Path.(cwd / "_build" / "test_sqlite") in
282 (try Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 tmp_dir with Eio.Io _ -> ());
283 let path =
284 Eio.Path.(tmp_dir / Fmt.str "persist_del_%d.db" (Random.int 1_000_000))
285 in
286 (* Create, write, delete *)
287 Eio.Switch.run (fun sw ->
288 let db = Sqlite.v ~sw path in
289 Sqlite.put db "keep" "value1";
290 Sqlite.put db "delete" "value2";
291 Sqlite.delete db "delete";
292 Sqlite.close db);
293 (* Reopen and verify *)
294 Eio.Switch.run (fun sw ->
295 let db = Sqlite.open_ ~sw path in
296 let r1 = Sqlite.find db "keep" in
297 let r2 = Sqlite.find db "delete" in
298 Alcotest.(check (option string)) "kept key persisted" (Some "value1") r1;
299 Alcotest.(check (option string)) "deleted key gone" None r2;
300 Sqlite.close db)
301
302let test_persistence_tables () =
303 Eio_main.run @@ fun env ->
304 let cwd = Eio.Stdenv.cwd env in
305 let tmp_dir = Eio.Path.(cwd / "_build" / "test_sqlite") in
306 (try Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 tmp_dir with Eio.Io _ -> ());
307 let path =
308 Eio.Path.(tmp_dir / Fmt.str "persist_tbl_%d.db" (Random.int 1_000_000))
309 in
310 (* Create with tables *)
311 Eio.Switch.run (fun sw ->
312 let db = Sqlite.v ~sw path in
313 let t1 = Sqlite.Table.create db ~name:"blocks" in
314 let t2 = Sqlite.Table.create db ~name:"refs" in
315 Sqlite.Table.put t1 "cid1" "data1";
316 Sqlite.Table.put t2 "head" "cid123";
317 Sqlite.close db);
318 (* Reopen and verify tables *)
319 Eio.Switch.run (fun sw ->
320 let db = Sqlite.open_ ~sw path in
321 let t1 = Sqlite.Table.create db ~name:"blocks" in
322 let t2 = Sqlite.Table.create db ~name:"refs" in
323 let r1 = Sqlite.Table.find t1 "cid1" in
324 let r2 = Sqlite.Table.find t2 "head" in
325 Alcotest.(check (option string)) "table1 data persisted" (Some "data1") r1;
326 Alcotest.(check (option string))
327 "table2 data persisted" (Some "cid123") r2;
328 Sqlite.close db)
329
330(* Edge cases *)
331
332let test_empty_key () =
333 with_temp_db @@ fun _fs db ->
334 Sqlite.put db "" "value_for_empty_key";
335 let result = Sqlite.find db "" in
336 Alcotest.(check (option string))
337 "empty key works" (Some "value_for_empty_key") result
338
339let test_key_with_nulls () =
340 with_temp_db @@ fun _fs db ->
341 let key = "key\x00with\x00nulls" in
342 let value = "value\x00also\x00has\x00nulls" in
343 Sqlite.put db key value;
344 let result = Sqlite.find db key in
345 Alcotest.(check (option string)) "null bytes preserved" (Some value) result
346
347let test_long_key () =
348 with_temp_db @@ fun _fs db ->
349 (* Note: B-tree has page splitting constraints limiting max entry size *)
350 let key = String.make 500 'k' in
351 let value = "value" in
352 Sqlite.put db key value;
353 let result = Sqlite.find db key in
354 Alcotest.(check (option string)) "long key works" (Some value) result
355
356let test_all_byte_values () =
357 with_temp_db @@ fun _fs db ->
358 (* Test all possible byte values in keys and values *)
359 let all_bytes = String.init 256 Char.chr in
360 Sqlite.put db all_bytes all_bytes;
361 let result = Sqlite.find db all_bytes in
362 Alcotest.(check (option string))
363 "all byte values preserved" (Some all_bytes) result
364
365let test_max_int_key_length () =
366 with_temp_db @@ fun _fs db ->
367 (* Test key length near encoding boundaries *)
368 let lengths = [ 127; 128; 255; 256; 400 ] in
369 List.iter
370 (fun len ->
371 let key = String.make len 'x' in
372 let value = Fmt.str "value_%d" len in
373 Sqlite.put db key value;
374 let result = Sqlite.find db key in
375 Alcotest.(check (option string))
376 (Fmt.str "key length %d" len)
377 (Some value) result)
378 lengths
379
380(* Stress tests *)
381
382let test_many_keys () =
383 with_temp_db @@ fun _fs db ->
384 let n = 1000 in
385 (* Insert many keys *)
386 for i = 0 to n - 1 do
387 Sqlite.put db (Fmt.str "key_%05d" i) (Fmt.str "value_%d" i)
388 done;
389 (* Verify all present *)
390 for i = 0 to n - 1 do
391 let result = Sqlite.find db (Fmt.str "key_%05d" i) in
392 Alcotest.(check (option string))
393 (Fmt.str "key %d present" i)
394 (Some (Fmt.str "value_%d" i))
395 result
396 done
397
398let test_many_updates () =
399 with_temp_db @@ fun _fs db ->
400 let n = 100 in
401 (* Update same key many times *)
402 for i = 0 to n - 1 do
403 Sqlite.put db "key" (Fmt.str "value_%d" i)
404 done;
405 let result = Sqlite.find db "key" in
406 Alcotest.(check (option string))
407 "final value"
408 (Some (Fmt.str "value_%d" (n - 1)))
409 result
410
411let test_interleaved_operations () =
412 with_temp_db @@ fun _fs db ->
413 (* Mix of puts, gets, deletes *)
414 for i = 0 to 99 do
415 Sqlite.put db (Fmt.str "a_%d" i) "value";
416 Sqlite.put db (Fmt.str "b_%d" i) "value";
417 if i mod 2 = 0 then Sqlite.delete db (Fmt.str "a_%d" i)
418 done;
419 (* Verify state *)
420 let a_count = ref 0 in
421 let b_count = ref 0 in
422 Sqlite.iter db ~f:(fun k _ ->
423 if String.length k > 2 && k.[0] = 'a' then incr a_count
424 else if String.length k > 2 && k.[0] = 'b' then incr b_count);
425 Alcotest.(check int) "a keys (half deleted)" 50 !a_count;
426 Alcotest.(check int) "b keys (all present)" 100 !b_count
427
428(* Multiple tables stress *)
429
430let test_many_tables () =
431 with_temp_db @@ fun _fs db ->
432 let n = 20 in
433 (* Create many tables *)
434 let tables =
435 Array.init n (fun i -> Sqlite.Table.create db ~name:(Fmt.str "table%d" i))
436 in
437 (* Write to all tables *)
438 Array.iteri
439 (fun i t -> Sqlite.Table.put t "key" (Fmt.str "value_%d" i))
440 tables;
441 (* Verify isolation *)
442 Array.iteri
443 (fun i t ->
444 let result = Sqlite.Table.find t "key" in
445 Alcotest.(check (option string))
446 (Fmt.str "table %d" i)
447 (Some (Fmt.str "value_%d" i))
448 result)
449 tables
450
451(* Regression tests based on SQLite CVE patterns *)
452
453let test_cve_key_overflow () =
454 with_temp_db @@ fun _fs db ->
455 (* Ensure large key doesn't cause integer overflow in length encoding *)
456 let key = String.make 500 'x' in
457 Sqlite.put db key "value";
458 let result = Sqlite.find db key in
459 Alcotest.(check (option string)) "large key no overflow" (Some "value") result
460
461let test_cve_like_boundary_conditions () =
462 with_temp_db @@ fun _fs db ->
463 (* Test boundary conditions within B-tree page constraints *)
464 let sizes = [ 100; 200; 300; 400; 500 ] in
465 List.iter
466 (fun size ->
467 let key = Fmt.str "key_%d" size in
468 let value = String.make size 'v' in
469 Sqlite.put db key value;
470 let result = Sqlite.find db key in
471 Alcotest.(check (option string))
472 (Fmt.str "boundary size %d" size)
473 (Some value) result)
474 sizes
475
476(* CREATE TABLE parser tests *)
477
478let check_columns msg expected actual =
479 let pp_col ppf (c : Sqlite.column) =
480 Fmt.pf ppf "{name=%S; affinity=%S; rowid=%b}" c.col_name c.col_affinity
481 c.col_is_rowid_alias
482 in
483 let col_eq (a : Sqlite.column) (b : Sqlite.column) =
484 a.col_name = b.col_name
485 && a.col_affinity = b.col_affinity
486 && a.col_is_rowid_alias = b.col_is_rowid_alias
487 in
488 let col_testable = Alcotest.testable pp_col col_eq in
489 Alcotest.(check (list col_testable)) msg expected actual
490
491let test_parse_simple () =
492 let cols =
493 Sqlite.parse_create_table "CREATE TABLE kv (key TEXT, value BLOB)"
494 in
495 check_columns "simple kv schema"
496 [
497 { col_name = "key"; col_affinity = "TEXT"; col_is_rowid_alias = false };
498 { col_name = "value"; col_affinity = "BLOB"; col_is_rowid_alias = false };
499 ]
500 cols
501
502let test_parse_integer_primary_key () =
503 let cols =
504 Sqlite.parse_create_table
505 "CREATE TABLE users (id INTEGER PRIMARY KEY, name TEXT, age INTEGER)"
506 in
507 check_columns "integer primary key"
508 [
509 { col_name = "id"; col_affinity = "INTEGER"; col_is_rowid_alias = true };
510 { col_name = "name"; col_affinity = "TEXT"; col_is_rowid_alias = false };
511 { col_name = "age"; col_affinity = "INTEGER"; col_is_rowid_alias = false };
512 ]
513 cols
514
515let test_parse_if_not_exists () =
516 let cols =
517 Sqlite.parse_create_table
518 "CREATE TABLE IF NOT EXISTS foo (bar TEXT, baz REAL)"
519 in
520 check_columns "if not exists"
521 [
522 { col_name = "bar"; col_affinity = "TEXT"; col_is_rowid_alias = false };
523 { col_name = "baz"; col_affinity = "REAL"; col_is_rowid_alias = false };
524 ]
525 cols
526
527let test_parse_nested_parens () =
528 let cols =
529 Sqlite.parse_create_table
530 "CREATE TABLE t (a DECIMAL(10,2), b VARCHAR(255) NOT NULL)"
531 in
532 check_columns "nested parens in types"
533 [
534 {
535 col_name = "a";
536 col_affinity = "DECIMAL(10,2)";
537 col_is_rowid_alias = false;
538 };
539 {
540 col_name = "b";
541 col_affinity = "VARCHAR(255)";
542 col_is_rowid_alias = false;
543 };
544 ]
545 cols
546
547let test_parse_table_constraints () =
548 let cols =
549 Sqlite.parse_create_table
550 "CREATE TABLE t (a INTEGER, b TEXT, PRIMARY KEY(a), UNIQUE(b))"
551 in
552 check_columns "table-level constraints skipped"
553 [
554 { col_name = "a"; col_affinity = "INTEGER"; col_is_rowid_alias = false };
555 { col_name = "b"; col_affinity = "TEXT"; col_is_rowid_alias = false };
556 ]
557 cols
558
559let test_parse_no_type () =
560 let cols = Sqlite.parse_create_table "CREATE TABLE t (a, b, c)" in
561 check_columns "columns without types"
562 [
563 { col_name = "a"; col_affinity = ""; col_is_rowid_alias = false };
564 { col_name = "b"; col_affinity = ""; col_is_rowid_alias = false };
565 { col_name = "c"; col_affinity = ""; col_is_rowid_alias = false };
566 ]
567 cols
568
569let test_parse_autoincrement () =
570 let cols =
571 Sqlite.parse_create_table
572 "CREATE TABLE t (id INTEGER PRIMARY KEY AUTOINCREMENT, name TEXT)"
573 in
574 check_columns "autoincrement"
575 [
576 { col_name = "id"; col_affinity = "INTEGER"; col_is_rowid_alias = true };
577 { col_name = "name"; col_affinity = "TEXT"; col_is_rowid_alias = false };
578 ]
579 cols
580
581let test_parse_invalid () =
582 let cols = Sqlite.parse_create_table "not valid sql at all" in
583 Alcotest.(check int) "invalid sql returns empty" 0 (List.length cols)
584
585(* Generic table read tests *)
586
587let with_temp_path f =
588 Eio_main.run @@ fun env ->
589 let fs = Eio.Stdenv.fs env in
590 let tmp_dir = "/tmp/test_sqlite" in
591 (try Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 Eio.Path.(fs / tmp_dir)
592 with Eio.Io _ -> ());
593 let fpath = Fmt.str "%s/test_%d.db" tmp_dir (Random.int 1_000_000) in
594 let path = Eio.Path.(fs / fpath) in
595 Fun.protect
596 ~finally:(fun () -> try Sys.remove fpath with Sys_error _ -> ())
597 (fun () -> f env fpath path)
598
599let test_open_no_kv () =
600 with_temp_path @@ fun _env fpath path ->
601 let rc =
602 Sys.command
603 (Fmt.str
604 "sqlite3 '%s' \"CREATE TABLE users (id INTEGER PRIMARY KEY, name \
605 TEXT, age INTEGER)\""
606 fpath)
607 in
608 if rc <> 0 then Alcotest.skip ();
609 Eio.Switch.run @@ fun sw ->
610 let t = Sqlite.open_ ~sw path in
611 let schemas = Sqlite.tables t in
612 Alcotest.(check int) "one table" 1 (List.length schemas);
613 let s = List.hd schemas in
614 Alcotest.(check string) "table name" "users" s.Sqlite.tbl_name;
615 Alcotest.(check int) "3 columns" 3 (List.length s.Sqlite.columns);
616 (* KV API should fail *)
617 (try
618 Sqlite.iter t ~f:(fun _ _ -> ());
619 Alcotest.fail "should have raised"
620 with Failure _ -> ());
621 Sqlite.close t
622
623let test_read_generic_table () =
624 with_temp_path @@ fun _env fpath path ->
625 let rc =
626 Sys.command
627 (Fmt.str
628 "sqlite3 '%s' \"CREATE TABLE users (id INTEGER PRIMARY KEY, name \
629 TEXT, age INTEGER); INSERT INTO users VALUES (1, 'Alice', 30); \
630 INSERT INTO users VALUES (2, 'Bob', 25);\""
631 fpath)
632 in
633 if rc <> 0 then Alcotest.skip ();
634 Eio.Switch.run @@ fun sw ->
635 let t = Sqlite.open_ ~sw path in
636 let rows = Sqlite.read_table t "users" in
637 Alcotest.(check int) "2 rows" 2 (List.length rows);
638 let _rowid1, values1 = List.nth rows 0 in
639 (match values1 with
640 | [ Sqlite.Vint 1L; Sqlite.Vtext "Alice"; Sqlite.Vint 30L ] -> ()
641 | _ ->
642 Alcotest.failf "unexpected row 1: %a" Fmt.(list Sqlite.pp_value) values1);
643 let _rowid2, values2 = List.nth rows 1 in
644 (match values2 with
645 | [ Sqlite.Vint 2L; Sqlite.Vtext "Bob"; Sqlite.Vint 25L ] -> ()
646 | _ ->
647 Alcotest.failf "unexpected row 2: %a" Fmt.(list Sqlite.pp_value) values2);
648 Sqlite.close t
649
650let test_integer_primary_key () =
651 with_temp_path @@ fun _env fpath path ->
652 let rc =
653 Sys.command
654 (Fmt.str
655 "sqlite3 '%s' \"CREATE TABLE t (id INTEGER PRIMARY KEY, val TEXT); \
656 INSERT INTO t VALUES (42, 'hello');\""
657 fpath)
658 in
659 if rc <> 0 then Alcotest.skip ();
660 Eio.Switch.run @@ fun sw ->
661 let t = Sqlite.open_ ~sw path in
662 let rows = Sqlite.read_table t "t" in
663 Alcotest.(check int) "1 row" 1 (List.length rows);
664 let rowid, values = List.hd rows in
665 Alcotest.(check int64) "rowid is 42" 42L rowid;
666 (match values with
667 | [ Sqlite.Vint 42L; Sqlite.Vtext "hello" ] -> ()
668 | _ ->
669 Alcotest.failf "expected [Vint 42; Vtext hello], got: %a"
670 Fmt.(list Sqlite.pp_value)
671 values);
672 Sqlite.close t
673
674let test_tables_lists_all () =
675 with_temp_path @@ fun _env fpath path ->
676 let rc =
677 Sys.command
678 (Fmt.str
679 "sqlite3 '%s' \"CREATE TABLE t1 (a TEXT); CREATE TABLE t2 (b INTEGER, \
680 c REAL);\""
681 fpath)
682 in
683 if rc <> 0 then Alcotest.skip ();
684 Eio.Switch.run @@ fun sw ->
685 let t = Sqlite.open_ ~sw path in
686 let schemas = Sqlite.tables t in
687 let names =
688 List.map (fun (s : Sqlite.schema) -> s.tbl_name) schemas
689 |> List.sort String.compare
690 in
691 Alcotest.(check (list string)) "table names" [ "t1"; "t2" ] names;
692 Sqlite.close t
693
694let sum_int_values _rowid values acc =
695 match values with [ Sqlite.Vint n ] -> Int64.add acc n | _ -> acc
696
697let test_fold_table () =
698 with_temp_path @@ fun _env fpath path ->
699 let rc =
700 Sys.command
701 (Fmt.str
702 "sqlite3 '%s' \"CREATE TABLE nums (n INTEGER); INSERT INTO nums \
703 VALUES (10); INSERT INTO nums VALUES (20); INSERT INTO nums VALUES \
704 (30);\""
705 fpath)
706 in
707 if rc <> 0 then Alcotest.skip ();
708 Eio.Switch.run @@ fun sw ->
709 let t = Sqlite.open_ ~sw path in
710 let sum = Sqlite.fold_table t "nums" ~init:0L ~f:sum_int_values in
711 Alcotest.(check int64) "sum of values" 60L sum;
712 Sqlite.close t
713
714(* ---- SQLite file format spec test vectors ---- *)
715
716let with_temp_db_path f =
717 Eio_main.run @@ fun env ->
718 let cwd = Eio.Stdenv.cwd env in
719 let tmp_dir = Eio.Path.(cwd / "_build" / "test_sqlite") in
720 (try Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 tmp_dir with Eio.Io _ -> ());
721 let path = Eio.Path.(tmp_dir / Fmt.str "spec_%d.db" (Random.int 1_000_000)) in
722 Eio.Switch.run @@ fun sw ->
723 let db = Sqlite.v ~sw path in
724 Fun.protect ~finally:(fun () -> Sqlite.close db) (fun () -> f path db)
725
726(* Section 1.2: Database header byte-level verification *)
727let test_db_header_magic () =
728 with_temp_db_path @@ fun path db ->
729 Sqlite.sync db;
730 let data = Eio.Path.load path in
731 let magic = String.sub data 0 16 in
732 Alcotest.(check string) "magic" "SQLite format 3\000" magic
733
734let test_db_header_fixed_values () =
735 with_temp_db_path @@ fun path db ->
736 Sqlite.sync db;
737 let data = Eio.Path.load path in
738 (* Offset 16-17: page size (4096 = 0x10 0x00) *)
739 Alcotest.(check int) "page size hi" 0x10 (Char.code data.[16]);
740 Alcotest.(check int) "page size lo" 0x00 (Char.code data.[17]);
741 (* Offset 18: write version = 1 (legacy) *)
742 Alcotest.(check int) "write version" 1 (Char.code data.[18]);
743 (* Offset 19: read version = 1 (legacy) *)
744 Alcotest.(check int) "read version" 1 (Char.code data.[19]);
745 (* Offset 20: reserved bytes = 0 *)
746 Alcotest.(check int) "reserved" 0 (Char.code data.[20]);
747 (* Offset 21: max_embedded_payload_fraction = 64 (MUST be 64) *)
748 Alcotest.(check int) "max payload fraction" 64 (Char.code data.[21]);
749 (* Offset 22: min_embedded_payload_fraction = 32 (MUST be 32) *)
750 Alcotest.(check int) "min payload fraction" 32 (Char.code data.[22]);
751 (* Offset 23: leaf_payload_fraction = 32 (MUST be 32) *)
752 Alcotest.(check int) "leaf payload fraction" 32 (Char.code data.[23]);
753 (* Offset 44: schema format = 4 *)
754 let schema_format =
755 (Char.code data.[44] lsl 24)
756 lor (Char.code data.[45] lsl 16)
757 lor (Char.code data.[46] lsl 8)
758 lor Char.code data.[47]
759 in
760 Alcotest.(check int) "schema format" 4 schema_format;
761 (* Offset 56: text encoding = 1 (UTF-8) *)
762 let encoding =
763 (Char.code data.[56] lsl 24)
764 lor (Char.code data.[57] lsl 16)
765 lor (Char.code data.[58] lsl 8)
766 lor Char.code data.[59]
767 in
768 Alcotest.(check int) "text encoding UTF-8" 1 encoding;
769 (* Offset 72-91: reserved for expansion = all zeros *)
770 for i = 72 to 91 do
771 Alcotest.(check int) (Fmt.str "reserved byte %d" i) 0 (Char.code data.[i])
772 done
773
774let test_db_header_change_counter () =
775 with_temp_db_path @@ fun path db ->
776 Sqlite.put db "key" "value";
777 Sqlite.sync db;
778 let data = Eio.Path.load path in
779 let read_u32 off =
780 (Char.code data.[off] lsl 24)
781 lor (Char.code data.[off + 1] lsl 16)
782 lor (Char.code data.[off + 2] lsl 8)
783 lor Char.code data.[off + 3]
784 in
785 let change_counter = read_u32 24 in
786 let version_valid_for = read_u32 92 in
787 Alcotest.(check int)
788 "change_counter == version_valid_for" change_counter version_valid_for
789
790(* Section 1.5: Page 1 B-tree header at offset 100 *)
791let test_page1_btree_header () =
792 with_temp_db_path @@ fun path db ->
793 Sqlite.sync db;
794 let data = Eio.Path.load path in
795 (* Offset 100: page type = 0x0d (leaf table) *)
796 Alcotest.(check int) "page1 type" 0x0d (Char.code data.[100]);
797 (* Offset 107: fragmented bytes <= 60 *)
798 Alcotest.(check bool) "fragmented <= 60" true (Char.code data.[107] <= 60)
799
800(* Section 2.1: sqlite_schema table format —
801 columns: type, name, tbl_name, rootpage, sql *)
802let test_sqlite_schema_format () =
803 with_temp_db @@ fun _fs db ->
804 let table = Sqlite.Table.create db ~name:"test_table" in
805 Sqlite.Table.put table "key" "value";
806 let schemas = Sqlite.tables db in
807 let names =
808 List.map (fun (s : Sqlite.schema) -> s.tbl_name) schemas
809 |> List.sort String.compare
810 in
811 (* Should have both the default kv table and test_table *)
812 Alcotest.(check bool) "has test_table" true (List.mem "test_table" names)
813
814(* Overflow values in SQLite-compatible files *)
815let test_sqlite_overflow_values () =
816 with_temp_db @@ fun _fs db ->
817 (* Values larger than max_local (4061 for 4096-byte pages) *)
818 let large = String.make 5000 'X' in
819 Sqlite.put db "overflow_key" large;
820 let result = Sqlite.find db "overflow_key" in
821 Alcotest.(check (option string))
822 "overflow value roundtrip" (Some large) result
823
824let test_sqlite_overflow_persistence () =
825 Eio_main.run @@ fun env ->
826 let cwd = Eio.Stdenv.cwd env in
827 let tmp_dir = Eio.Path.(cwd / "_build" / "test_sqlite") in
828 (try Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 tmp_dir with Eio.Io _ -> ());
829 let path =
830 Eio.Path.(tmp_dir / Fmt.str "overflow_%d.db" (Random.int 1_000_000))
831 in
832 let large = String.make 10000 'Y' in
833 (* Write *)
834 Eio.Switch.run (fun sw ->
835 let db = Sqlite.v ~sw path in
836 Sqlite.put db "big" large;
837 Sqlite.close db);
838 (* Read back *)
839 Eio.Switch.run (fun sw ->
840 let db = Sqlite.open_ ~sw path in
841 let result = Sqlite.find db "big" in
842 Alcotest.(check (option string)) "overflow persists" (Some large) result;
843 Sqlite.close db)
844
845let suite =
846 ( "sqlite",
847 List.concat
848 [
849 [
850 Alcotest.test_case "put/get" `Quick test_put_get;
851 Alcotest.test_case "get missing" `Quick test_get_missing;
852 Alcotest.test_case "put overwrite" `Quick test_put_overwrite;
853 Alcotest.test_case "delete" `Quick test_delete;
854 Alcotest.test_case "delete missing" `Quick test_delete_missing;
855 Alcotest.test_case "mem" `Quick test_mem;
856 Alcotest.test_case "iter" `Quick test_iter;
857 Alcotest.test_case "fold" `Quick test_fold;
858 ];
859 [
860 Alcotest.test_case "binary values" `Quick test_binary_values;
861 Alcotest.test_case "empty value" `Quick test_empty_value;
862 Alcotest.test_case "large value" `Quick test_large_value;
863 ];
864 [
865 Alcotest.test_case "table basic" `Quick test_table_basic;
866 Alcotest.test_case "table isolation" `Quick test_table_isolation;
867 Alcotest.test_case "table mem/delete" `Quick test_table_mem_delete;
868 Alcotest.test_case "table iter" `Quick test_table_iter;
869 ];
870 [
871 Alcotest.test_case "sql injection key" `Quick test_sql_injection_key;
872 Alcotest.test_case "sql injection value" `Quick
873 test_sql_injection_value;
874 Alcotest.test_case "table name validation" `Quick
875 test_table_name_validation;
876 Alcotest.test_case "valid table names" `Quick test_valid_table_names;
877 ];
878 [
879 Alcotest.test_case "unicode keys" `Quick test_unicode_keys;
880 Alcotest.test_case "unicode values" `Quick test_unicode_values;
881 ];
882 [
883 Alcotest.test_case "sync" `Quick test_sync;
884 Alcotest.test_case "persistence basic" `Quick test_persistence_basic;
885 Alcotest.test_case "persistence with delete" `Quick
886 test_persistence_with_delete;
887 Alcotest.test_case "persistence tables" `Quick test_persistence_tables;
888 ];
889 [
890 Alcotest.test_case "empty key" `Quick test_empty_key;
891 Alcotest.test_case "key with nulls" `Quick test_key_with_nulls;
892 Alcotest.test_case "long key" `Quick test_long_key;
893 Alcotest.test_case "all byte values" `Quick test_all_byte_values;
894 Alcotest.test_case "max int key length" `Quick test_max_int_key_length;
895 ];
896 [
897 Alcotest.test_case "many keys" `Slow test_many_keys;
898 Alcotest.test_case "many updates" `Quick test_many_updates;
899 Alcotest.test_case "interleaved ops" `Quick
900 test_interleaved_operations;
901 Alcotest.test_case "many tables" `Quick test_many_tables;
902 ];
903 [
904 Alcotest.test_case "overflow key length" `Quick test_cve_key_overflow;
905 Alcotest.test_case "boundary conditions" `Quick
906 test_cve_like_boundary_conditions;
907 ];
908 [
909 Alcotest.test_case "parse simple" `Quick test_parse_simple;
910 Alcotest.test_case "parse integer pk" `Quick
911 test_parse_integer_primary_key;
912 Alcotest.test_case "parse if not exists" `Quick
913 test_parse_if_not_exists;
914 Alcotest.test_case "parse nested parens" `Quick
915 test_parse_nested_parens;
916 Alcotest.test_case "parse table constraints" `Quick
917 test_parse_table_constraints;
918 Alcotest.test_case "parse no type" `Quick test_parse_no_type;
919 Alcotest.test_case "parse autoincrement" `Quick
920 test_parse_autoincrement;
921 Alcotest.test_case "parse invalid" `Quick test_parse_invalid;
922 Alcotest.test_case "open no kv" `Quick test_open_no_kv;
923 Alcotest.test_case "read generic table" `Quick test_read_generic_table;
924 Alcotest.test_case "integer primary key" `Quick
925 test_integer_primary_key;
926 Alcotest.test_case "tables lists all" `Quick test_tables_lists_all;
927 Alcotest.test_case "fold table" `Quick test_fold_table;
928 ];
929 [
930 Alcotest.test_case "spec header magic" `Quick test_db_header_magic;
931 Alcotest.test_case "spec header values" `Quick
932 test_db_header_fixed_values;
933 Alcotest.test_case "spec change counter" `Quick
934 test_db_header_change_counter;
935 Alcotest.test_case "spec page1 btree" `Quick test_page1_btree_header;
936 Alcotest.test_case "spec schema format" `Quick
937 test_sqlite_schema_format;
938 Alcotest.test_case "spec overflow values" `Quick
939 test_sqlite_overflow_values;
940 Alcotest.test_case "spec overflow persist" `Quick
941 test_sqlite_overflow_persistence;
942 ];
943 ] )