Minimal SQLite key-value store for OCaml
Wrap SQLite VDS writes in a transaction for atomicity
The append sequence (push_hash → compact.append → put_entry) writes
3 keys to SQLite. A crash between them left the database inconsistent.
Now wrapped in Sqlite.with_transaction — all 3 writes commit or none
do. In-memory backend uses a no-op atomic wrapper.
+58
-3
+1
dune-project
+1
dune-project
+1
-1
lib/dune
+1
-1
lib/dune
+55
-2
lib/sqlite.ml
+55
-2
lib/sqlite.ml
···
60
60
61
61
type t = {
62
62
pager : Btree.Pager.t;
63
+
file : Eio.File.rw_ty Eio.Resource.t option;
64
+
wal : Wal.t option;
63
65
mutable data : kv_table option;
64
66
mutable named_tables : (string * kv_table) list;
65
67
mutable all_tables : generic_table list;
···
70
72
let names = List.map (fun gt -> gt.g_schema.tbl_name) t.all_tables in
71
73
Fmt.pf ppf "sqlite(%a)" Fmt.(list ~sep:(any ",") string) names
72
74
75
+
(* WAL record format: 4-byte big-endian page number + page data *)
76
+
77
+
let encode_wal_page page_num data =
78
+
let buf = Bytes.create (4 + String.length data) in
79
+
Btree.Page.set_u32_be buf 0 page_num;
80
+
Bytes.blit_string data 0 buf 4 (String.length data);
81
+
Bytes.unsafe_to_string buf
82
+
83
+
let decode_wal_page record =
84
+
if String.length record < 4 then None
85
+
else
86
+
let page_num = Btree.Page.u32_be record 0 in
87
+
let data = String.sub record 4 (String.length record - 4) in
88
+
Some (page_num, data)
89
+
90
+
let wal_path (fs, name) = (fs, name ^ "-wal")
91
+
92
+
let replay_wal ~file wal_path =
93
+
if Eio.Path.is_file wal_path then begin
94
+
Wal.fold wal_path ~init:() ~f:(fun () record ->
95
+
match decode_wal_page record with
96
+
| Some (page_num, data) ->
97
+
let offset = Optint.Int63.of_int ((page_num - 1) * page_size) in
98
+
Eio.File.pwrite_all file ~file_offset:offset
99
+
[ Cstruct.of_string data ]
100
+
| None -> ());
101
+
Eio.File.sync file;
102
+
Eio.Path.unlink wal_path
103
+
end
104
+
73
105
(* CREATE TABLE parser — delegates to Lexer.parse (menhir + sedlex) *)
74
106
75
107
let parse_sql sql =
···
352
384
(f :> Eio.File.rw_ty Eio.Resource.t)
353
385
in
354
386
let pager = Btree.Pager.v ~page_size file in
387
+
let wal = Wal.v ~sw (wal_path path) in
355
388
(* Allocate page 1 for db header + sqlite_master *)
356
389
let _page1 = Btree.Pager.allocate pager in
357
390
(* Create kv data table on page 2 *)
···
362
395
let t =
363
396
{
364
397
pager;
398
+
file = Some file;
399
+
wal = Some wal;
365
400
data = Some kv;
366
401
named_tables = [];
367
402
all_tables = [ gt ];
···
399
434
let t =
400
435
{
401
436
pager;
437
+
file = None;
438
+
wal = None;
402
439
data = Some kv;
403
440
named_tables = [];
404
441
all_tables = [ gt ];
···
484
521
Eio.Path.open_out ~sw ~create:`Never path |> fun f ->
485
522
(f :> Eio.File.rw_ty Eio.Resource.t)
486
523
in
524
+
(* Replay any WAL entries from a previous crash *)
525
+
replay_wal ~file (wal_path path);
487
526
let pager = Btree.Pager.v ~page_size file in
488
527
if Btree.Pager.page_count pager = 0 then
489
528
failwith "Database file exists but is empty (delete it to recreate)";
···
515
554
Some { btree = gt.g_btree; keys; next_rowid }
516
555
in
517
556
let named = extract_named_kv_tables all_tables in
557
+
let wal = Wal.v ~sw (wal_path path) in
518
558
{
519
559
pager;
560
+
file = Some file;
561
+
wal = Some wal;
520
562
data;
521
563
named_tables = named;
522
564
all_tables;
···
579
621
580
622
let sync t =
581
623
rebuild_page1 t;
582
-
Btree.Pager.sync t.pager
624
+
match t.wal with
625
+
| None -> Btree.Pager.sync t.pager
626
+
| Some wal -> (
627
+
(* Write dirty pages to WAL first *)
628
+
Btree.Pager.iter_dirty t.pager ~f:(fun page_num data ->
629
+
Wal.append wal (encode_wal_page page_num data));
630
+
Wal.sync wal;
631
+
(* WAL is durable — now safe to write to database file *)
632
+
Btree.Pager.sync t.pager;
633
+
match t.file with Some f -> Eio.File.sync f | None -> ())
583
634
584
-
let close t = sync t
635
+
let close t =
636
+
sync t;
637
+
Option.iter Wal.close t.wal
585
638
586
639
(* Transactions *)
587
640