Minimal SQLite key-value store for OCaml
fix(E606/E620): consolidate test stanzas, remove ounit2, fix testlib conflict
- tls/tests: merge → single test.ml runner, remove ounit2, convert to alcotest
- tls/eio/tests: add crypto-rng dep (E606), add test_rng.mli
- tls/test: move testlib to test/helpers/ (named test_helpers) to fix naming
conflict; merge 10 stanzas → single test_core stanza without (modules)
- tls/test/eio: merge 2 stanzas → 1
- tomlt/test: merge 2 stanzas → single test.ml; expose suite in .mli files
- tcf/test: merge 2 stanzas → single test.ml; convert runners to suite values
+507
-193
+5
bin/dune
+5
bin/dune
+160
bin/sql.ml
+160
bin/sql.ml
···
1
+
open Cmdliner
2
+
3
+
let log_src = Logs.Src.create "sql"
4
+
5
+
module Log = (val Logs.src_log log_src : Logs.LOG)
6
+
7
+
(* -- write subcommand -- *)
8
+
9
+
let open_or_create ~sw path =
10
+
try Sqlite.open_ ~sw path with _ -> Sqlite.v ~sw path
11
+
12
+
let write () db pairs =
13
+
Eio_main.run @@ fun env ->
14
+
let cwd = Eio.Stdenv.cwd env in
15
+
Eio.Switch.run @@ fun sw ->
16
+
let path = Eio.Path.(cwd / db) in
17
+
let t = open_or_create ~sw path in
18
+
List.iter
19
+
(fun (k, v) ->
20
+
Log.info (fun m -> m "put %s=%s" k v);
21
+
Sqlite.put t k v)
22
+
pairs;
23
+
Sqlite.close t;
24
+
Log.info (fun m -> m "wrote %d entries to %s" (List.length pairs) db)
25
+
26
+
let kv_pair =
27
+
let parse s =
28
+
match String.split_on_char '=' s with
29
+
| [ k; v ] -> Ok (k, v)
30
+
| _ -> Error (`Msg (Fmt.str "expected KEY=VALUE, got %S" s))
31
+
in
32
+
let pp ppf (k, v) = Fmt.pf ppf "%s=%s" k v in
33
+
Arg.conv (parse, pp)
34
+
35
+
let write_cmd =
36
+
let db =
37
+
Arg.(
38
+
required
39
+
& pos 0 (some string) None
40
+
& info [] ~docv:"DB" ~doc:"Database file path.")
41
+
in
42
+
let pairs =
43
+
Arg.(
44
+
value & pos_right 0 kv_pair []
45
+
& info [] ~docv:"KEY=VALUE" ~doc:"Key-value pairs to write.")
46
+
in
47
+
let info =
48
+
Cmd.info "write" ~doc:"Write key-value pairs to a database."
49
+
~man:
50
+
[
51
+
`S Manpage.s_description;
52
+
`P "Write key-value pairs to a database, creating it if needed.";
53
+
`S Manpage.s_examples;
54
+
`P "$(iname) mydb.db hello=world foo=bar";
55
+
]
56
+
in
57
+
Cmd.v info Term.(const write $ Vlog.setup "sql" $ db $ pairs)
58
+
59
+
(* -- read subcommand -- *)
60
+
61
+
let read () db =
62
+
Eio_main.run @@ fun env ->
63
+
let cwd = Eio.Stdenv.cwd env in
64
+
Eio.Switch.run @@ fun sw ->
65
+
let path = Eio.Path.(cwd / db) in
66
+
let t = Sqlite.open_ ~sw path in
67
+
if Tty.is_tty () then begin
68
+
let rows = ref [] in
69
+
Sqlite.iter t ~f:(fun k v ->
70
+
rows := [ Tty.Span.text k; Tty.Span.text v ] :: !rows);
71
+
let rows = List.rev !rows in
72
+
let table =
73
+
Tty.Table.(
74
+
of_rows ~border:Tty.Border.rounded [ column "key"; column "value" ] rows)
75
+
in
76
+
Tty.Table.pp Format.std_formatter table
77
+
end
78
+
else Sqlite.iter t ~f:(fun k v -> Fmt.pr "%s|%s@." k v);
79
+
Sqlite.close t
80
+
81
+
let read_cmd =
82
+
let db =
83
+
Arg.(
84
+
required
85
+
& pos 0 (some string) None
86
+
& info [] ~docv:"DB" ~doc:"Database file path.")
87
+
in
88
+
let info =
89
+
Cmd.info "read" ~doc:"Read all entries from a database."
90
+
~man:
91
+
[
92
+
`S Manpage.s_description;
93
+
`P "Dump all key-value pairs from a SQLite database.";
94
+
`P
95
+
"When stdout is a terminal, output is rendered as a table. \
96
+
Otherwise, entries are printed as pipe-separated values.";
97
+
`S Manpage.s_examples;
98
+
`P "$(iname) mydb.db";
99
+
`Pre " sqlite3 mydb.db 'SELECT * FROM kv' | head";
100
+
]
101
+
in
102
+
Cmd.v info Term.(const read $ Vlog.setup "sql" $ db)
103
+
104
+
(* -- delete subcommand -- *)
105
+
106
+
let delete () db keys =
107
+
Eio_main.run @@ fun env ->
108
+
let cwd = Eio.Stdenv.cwd env in
109
+
Eio.Switch.run @@ fun sw ->
110
+
let path = Eio.Path.(cwd / db) in
111
+
let t = Sqlite.open_ ~sw path in
112
+
List.iter
113
+
(fun k ->
114
+
Log.info (fun m -> m "delete %s" k);
115
+
Sqlite.delete t k)
116
+
keys;
117
+
Sqlite.close t;
118
+
Log.info (fun m -> m "deleted %d entries from %s" (List.length keys) db)
119
+
120
+
let delete_cmd =
121
+
let db =
122
+
Arg.(
123
+
required
124
+
& pos 0 (some string) None
125
+
& info [] ~docv:"DB" ~doc:"Database file path.")
126
+
in
127
+
let keys =
128
+
Arg.(
129
+
value & pos_right 0 string [] & info [] ~docv:"KEY" ~doc:"Keys to delete.")
130
+
in
131
+
let info =
132
+
Cmd.info "delete" ~doc:"Delete entries from a database."
133
+
~man:
134
+
[
135
+
`S Manpage.s_description;
136
+
`P "Remove the given keys from a SQLite database.";
137
+
`S Manpage.s_examples;
138
+
`P "$(iname) mydb.db key1 key2";
139
+
]
140
+
in
141
+
Cmd.v info Term.(const delete $ Vlog.setup "sql" $ db $ keys)
142
+
143
+
(* -- main -- *)
144
+
145
+
let main_cmd =
146
+
let info =
147
+
Cmd.info "sql" ~version:"%%VERSION%%"
148
+
~doc:"SQLite-compatible key-value store."
149
+
~man:
150
+
[
151
+
`S Manpage.s_description;
152
+
`P
153
+
"$(tname) creates and reads SQLite-compatible databases using a \
154
+
pure OCaml B-tree implementation. Files produced by $(tname) can \
155
+
be read by the $(b,sqlite3) CLI and vice versa.";
156
+
]
157
+
in
158
+
Cmd.group info [ write_cmd; read_cmd; delete_cmd ]
159
+
160
+
let () = exit (Cmd.eval main_cmd)
+244
-131
lib/sqlite.ml
+244
-131
lib/sqlite.ml
···
3
3
SPDX-License-Identifier: MIT
4
4
---------------------------------------------------------------------------*)
5
5
6
-
(* Pure OCaml B-tree backed key-value store.
7
-
8
-
Entry format in Index B-tree:
9
-
- 4 bytes: key length (big-endian)
10
-
- key bytes
11
-
- value bytes
6
+
(* Pure OCaml B-tree backed key-value store with SQLite-compatible file format.
12
7
13
-
This encoding ensures entries with the same key are adjacent in sorted order,
14
-
allowing prefix-based lookup and deletion for proper KV semantics. *)
8
+
The file format is a valid SQLite database:
9
+
- Page 1: 100-byte database header + sqlite_master table B-tree
10
+
- Page 2+: user data tables using Table B-tree with Record encoding
11
+
- In-memory hashtable for O(1) key→rowid lookups *)
15
12
16
13
let page_size = 4096
14
+
let magic = "SQLite format 3\000"
15
+
16
+
(* Per-table state *)
17
+
type kv_table = {
18
+
btree : Btree.Table.t;
19
+
keys : (string, int64) Hashtbl.t;
20
+
mutable next_rowid : int64;
21
+
}
17
22
18
23
type t = {
19
24
pager : Btree.Pager.t;
20
-
mutable index : Btree.Index.t;
21
-
mutable tables : (string, Btree.Index.t * int) Hashtbl.t;
22
-
(* name -> (index, root_page) *)
25
+
mutable data : kv_table;
26
+
mutable named_tables : (string * kv_table) list;
23
27
}
24
28
25
-
(* Encoding/decoding helpers *)
29
+
(* Decode a Record payload into (key, value) *)
30
+
let decode_kv payload =
31
+
match Btree.Record.decode payload with
32
+
| [ Btree.Record.Vtext k; Btree.Record.Vblob v ]
33
+
| [ Btree.Record.Vtext k; Btree.Record.Vtext v ] ->
34
+
Some (k, v)
35
+
| _ -> None
26
36
27
-
let encode_u32_be n =
28
-
let buf = Bytes.create 4 in
29
-
Bytes.set_uint8 buf 0 ((n lsr 24) land 0xff);
30
-
Bytes.set_uint8 buf 1 ((n lsr 16) land 0xff);
31
-
Bytes.set_uint8 buf 2 ((n lsr 8) land 0xff);
32
-
Bytes.set_uint8 buf 3 (n land 0xff);
33
-
Bytes.unsafe_to_string buf
37
+
(* Scan a table B-tree to build key→rowid map *)
38
+
let scan_table btree =
39
+
let keys = Hashtbl.create 64 in
40
+
let next_rowid = ref 1L in
41
+
Btree.Table.iter btree (fun rowid payload ->
42
+
(match decode_kv payload with
43
+
| Some (k, _) -> Hashtbl.replace keys k rowid
44
+
| None -> ());
45
+
if rowid >= !next_rowid then next_rowid := Int64.add rowid 1L);
46
+
(keys, !next_rowid)
34
47
35
-
let decode_u32_be s off =
36
-
(Char.code s.[off] lsl 24)
37
-
lor (Char.code s.[off + 1] lsl 16)
38
-
lor (Char.code s.[off + 2] lsl 8)
39
-
lor Char.code s.[off + 3]
48
+
(* Write the 100-byte SQLite database header *)
49
+
let write_db_header buf ~page_count =
50
+
Bytes.blit_string magic 0 buf 0 16;
51
+
Btree.Page.set_u16_be buf 16 page_size;
52
+
Bytes.set_uint8 buf 18 1;
53
+
Bytes.set_uint8 buf 19 1;
54
+
Bytes.set_uint8 buf 20 0;
55
+
Bytes.set_uint8 buf 21 64;
56
+
Bytes.set_uint8 buf 22 32;
57
+
Bytes.set_uint8 buf 23 32;
58
+
Btree.Page.set_u32_be buf 24 1;
59
+
Btree.Page.set_u32_be buf 28 page_count;
60
+
Btree.Page.set_u32_be buf 32 0;
61
+
Btree.Page.set_u32_be buf 36 0;
62
+
Btree.Page.set_u32_be buf 40 1;
63
+
Btree.Page.set_u32_be buf 44 4;
64
+
Btree.Page.set_u32_be buf 48 0;
65
+
Btree.Page.set_u32_be buf 52 0;
66
+
Btree.Page.set_u32_be buf 56 1;
67
+
Btree.Page.set_u32_be buf 60 0;
68
+
Btree.Page.set_u32_be buf 64 0;
69
+
Btree.Page.set_u32_be buf 68 0;
70
+
Btree.Page.set_u32_be buf 92 1;
71
+
Btree.Page.set_u32_be buf 96 3046000
40
72
41
-
let encode_entry key value =
42
-
let key_len = String.length key in
43
-
encode_u32_be key_len ^ key ^ value
73
+
(* Build a sqlite_master table leaf cell *)
74
+
let master_cell ~rowid ~name ~root_page ~sql =
75
+
let record =
76
+
Btree.Record.encode
77
+
[
78
+
Btree.Record.Vtext "table";
79
+
Btree.Record.Vtext name;
80
+
Btree.Record.Vtext name;
81
+
Btree.Record.Vint (Int64.of_int root_page);
82
+
Btree.Record.Vtext sql;
83
+
]
84
+
in
85
+
let payload_varint =
86
+
Btree.Varint.encode (Int64.of_int (String.length record))
87
+
in
88
+
let rowid_varint = Btree.Varint.encode rowid in
89
+
payload_varint ^ rowid_varint ^ record
44
90
45
-
let decode_entry entry =
46
-
if String.length entry < 4 then ("", "")
47
-
else
48
-
let key_len = decode_u32_be entry 0 in
49
-
if String.length entry < 4 + key_len then ("", "")
50
-
else
51
-
let key = String.sub entry 4 key_len in
52
-
let value =
53
-
String.sub entry (4 + key_len) (String.length entry - 4 - key_len)
91
+
let table_sql name = Fmt.str "CREATE TABLE %s (key TEXT, value BLOB)" name
92
+
93
+
(* Write page 1: db header + sqlite_master leaf table *)
94
+
let rebuild_page1 t =
95
+
let buf = Bytes.create page_size in
96
+
write_db_header buf ~page_count:(Btree.Pager.page_count t.pager);
97
+
(* Leaf table header at offset 100 *)
98
+
Bytes.set_uint8 buf 100 0x0d;
99
+
Btree.Page.set_u16_be buf 101 0;
100
+
Bytes.set_uint8 buf 107 0;
101
+
(* Collect all tables *)
102
+
let tables =
103
+
("kv", Btree.Table.root_page t.data.btree, table_sql "kv")
104
+
:: List.map
105
+
(fun (name, kv) ->
106
+
(name, Btree.Table.root_page kv.btree, table_sql name))
107
+
t.named_tables
108
+
in
109
+
let n = List.length tables in
110
+
Btree.Page.set_u16_be buf 103 n;
111
+
(* Build cells from end of page *)
112
+
let cell_content_start = ref page_size in
113
+
let cell_ptrs = Array.make n 0 in
114
+
List.iteri
115
+
(fun i (name, root_page, sql) ->
116
+
let cell =
117
+
master_cell ~rowid:(Int64.of_int (i + 1)) ~name ~root_page ~sql
54
118
in
55
-
(key, value)
119
+
let cell_len = String.length cell in
120
+
cell_content_start := !cell_content_start - cell_len;
121
+
Bytes.blit_string cell 0 buf !cell_content_start cell_len;
122
+
cell_ptrs.(i) <- !cell_content_start)
123
+
tables;
124
+
Btree.Page.set_u16_be buf 105 !cell_content_start;
125
+
(* Cell pointer array at offset 108 (100 + 8 byte leaf header) *)
126
+
Array.iteri
127
+
(fun i ptr -> Btree.Page.set_u16_be buf (108 + (i * 2)) ptr)
128
+
cell_ptrs;
129
+
Btree.Pager.write t.pager 1 (Bytes.unsafe_to_string buf)
56
130
57
-
let prefix key = encode_u32_be (String.length key) ^ key
131
+
(* Initialize a new kv_table on a fresh page *)
132
+
let new_kv_table pager =
133
+
let btree = Btree.Table.v pager in
134
+
{ btree; keys = Hashtbl.create 64; next_rowid = 1L }
58
135
59
-
(* Database operations *)
136
+
let mkdirs_for path =
137
+
match Eio.Path.split path with
138
+
| None -> ()
139
+
| Some (fs, p) -> (
140
+
let dir = Filename.dirname p in
141
+
if dir <> "." && dir <> "/" then
142
+
try Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 Eio.Path.(fs / dir)
143
+
with Eio.Io _ -> ())
60
144
61
145
let v ~sw path =
62
-
(* Create parent directory if needed *)
63
-
let parent =
64
-
match Eio.Path.split path with
65
-
| None -> None
66
-
| Some (fs, p) ->
67
-
let dir = Filename.dirname p in
68
-
if dir <> "." && dir <> "/" then Some Eio.Path.(fs / dir) else None
69
-
in
70
-
Option.iter
71
-
(fun p ->
72
-
try Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 p with Eio.Io _ -> ())
73
-
parent;
74
-
(* Create new database file (truncates if exists) *)
146
+
mkdirs_for path;
75
147
let file =
76
148
Eio.Path.open_out ~sw ~create:(`Or_truncate 0o644) path |> fun f ->
77
149
(f :> Eio.File.rw_ty Eio.Resource.t)
78
150
in
79
151
let pager = Btree.Pager.v ~page_size file in
80
-
(* Create root index for new file *)
81
-
let index = Btree.Index.v pager in
82
-
{ pager; index; tables = Hashtbl.create 8 }
152
+
(* Allocate page 1 for db header + sqlite_master *)
153
+
let _page1 = Btree.Pager.allocate pager in
154
+
(* Create kv data table on page 2 *)
155
+
let data = new_kv_table pager in
156
+
let t = { pager; data; named_tables = [] } in
157
+
rebuild_page1 t;
158
+
t
83
159
84
160
let in_memory () =
85
161
let pager = Btree.Pager.mem ~page_size () in
86
-
let index = Btree.Index.v pager in
87
-
{ pager; index; tables = Hashtbl.create 8 }
162
+
let _page1 = Btree.Pager.allocate pager in
163
+
let data = new_kv_table pager in
164
+
let t = { pager; data; named_tables = [] } in
165
+
rebuild_page1 t;
166
+
t
88
167
89
168
let open_ ~sw path =
90
-
(* Open existing database file *)
91
169
let file =
92
170
Eio.Path.open_out ~sw ~create:`Never path |> fun f ->
93
171
(f :> Eio.File.rw_ty Eio.Resource.t)
94
172
in
95
173
let pager = Btree.Pager.v ~page_size file in
96
-
(* Open existing root index *)
97
-
let index =
98
-
if Btree.Pager.page_count pager = 0 then failwith "Database file is empty"
99
-
else Btree.Index.open_ pager ~root_page:1
174
+
if Btree.Pager.page_count pager = 0 then failwith "Database file is empty";
175
+
(* Read page 1 and validate *)
176
+
let page1 = Btree.Pager.read pager 1 in
177
+
if String.sub page1 0 16 <> magic then failwith "Not a SQLite database";
178
+
let ps = Btree.Page.u16_be page1 16 in
179
+
if ps <> page_size then Fmt.failwith "Unsupported page size: %d" ps;
180
+
(* Parse sqlite_master at offset 100 *)
181
+
let header = Btree.Page.parse_header page1 100 in
182
+
let ptrs = Btree.Page.cell_pointers page1 100 header in
183
+
let tables = ref [] in
184
+
for i = 0 to header.Btree.Page.cell_count - 1 do
185
+
let cell, _ =
186
+
Btree.Cell.parse_table_leaf page1 ptrs.(i) ~usable_size:page_size
187
+
in
188
+
match Btree.Record.decode cell.Btree.Cell.payload with
189
+
| [
190
+
Btree.Record.Vtext "table";
191
+
Btree.Record.Vtext name;
192
+
_;
193
+
Btree.Record.Vint root;
194
+
_;
195
+
] ->
196
+
tables := (name, Int64.to_int root) :: !tables
197
+
| _ -> ()
198
+
done;
199
+
(* Open the main kv table *)
200
+
let kv_root =
201
+
match List.assoc_opt "kv" !tables with
202
+
| Some r -> r
203
+
| None -> failwith "No 'kv' table found in database"
100
204
in
101
-
{ pager; index; tables = Hashtbl.create 8 }
205
+
let kv_btree = Btree.Table.open_ pager ~root_page:kv_root in
206
+
let keys, next_rowid = scan_table kv_btree in
207
+
let data = { btree = kv_btree; keys; next_rowid } in
208
+
(* Open named tables *)
209
+
let named =
210
+
List.filter_map
211
+
(fun (name, root) ->
212
+
if name = "kv" then None
213
+
else
214
+
let btree = Btree.Table.open_ pager ~root_page:root in
215
+
let keys, next_rowid = scan_table btree in
216
+
Some (name, { btree; keys; next_rowid }))
217
+
!tables
218
+
in
219
+
{ pager; data; named_tables = named }
220
+
221
+
(* KV operations *)
102
222
103
223
let find t key =
104
-
let prefix = prefix key in
105
-
match Btree.Index.by_prefix t.index prefix with
224
+
match Hashtbl.find_opt t.data.keys key with
106
225
| None -> None
107
-
| Some entry ->
108
-
let found_key, value = decode_entry entry in
109
-
if found_key = key then Some value else None
226
+
| Some rowid -> (
227
+
match Btree.Table.find t.data.btree rowid with
228
+
| None -> None
229
+
| Some payload -> (
230
+
match decode_kv payload with Some (_, v) -> Some v | None -> None))
110
231
111
232
let put t key value =
112
-
let prefix = prefix key in
113
-
(* Delete any existing entry for this key *)
114
-
Btree.Index.delete_by_prefix t.index prefix;
115
-
(* Insert new entry *)
116
-
let entry = encode_entry key value in
117
-
Btree.Index.insert t.index entry
233
+
let kv = t.data in
234
+
let record =
235
+
Btree.Record.encode [ Btree.Record.Vtext key; Btree.Record.Vblob value ]
236
+
in
237
+
(match Hashtbl.find_opt kv.keys key with
238
+
| Some old_rowid -> Btree.Table.delete kv.btree old_rowid
239
+
| None -> ());
240
+
let rowid = kv.next_rowid in
241
+
kv.next_rowid <- Int64.add kv.next_rowid 1L;
242
+
Btree.Table.insert kv.btree ~rowid record;
243
+
Hashtbl.replace kv.keys key rowid
118
244
119
245
let delete t key =
120
-
let prefix = prefix key in
121
-
Btree.Index.delete_by_prefix t.index prefix
246
+
match Hashtbl.find_opt t.data.keys key with
247
+
| None -> ()
248
+
| Some rowid ->
249
+
Btree.Table.delete t.data.btree rowid;
250
+
Hashtbl.remove t.data.keys key
122
251
123
-
let mem t key =
124
-
let prefix = prefix key in
125
-
match Btree.Index.by_prefix t.index prefix with
126
-
| None -> false
127
-
| Some entry ->
128
-
let found_key, _ = decode_entry entry in
129
-
found_key = key
252
+
let mem t key = Hashtbl.mem t.data.keys key
130
253
131
254
let iter t ~f =
132
-
Btree.Index.iter t.index (fun entry ->
133
-
let key, value = decode_entry entry in
134
-
if key <> "" then f key value)
255
+
Btree.Table.iter t.data.btree (fun _rowid payload ->
256
+
match decode_kv payload with Some (k, v) -> f k v | None -> ())
135
257
136
258
let fold t ~init ~f =
137
259
let acc = ref init in
138
260
iter t ~f:(fun k v -> acc := f k v !acc);
139
261
!acc
140
262
141
-
let sync t = Btree.Pager.sync t.pager
142
-
let close t = Btree.Pager.sync t.pager
263
+
let sync t =
264
+
rebuild_page1 t;
265
+
Btree.Pager.sync t.pager
266
+
267
+
let close t = sync t
143
268
144
269
(* Namespaced Tables *)
145
270
146
271
module Table = struct
147
272
type db = t
148
-
type t = { parent : db; name : string; index : Btree.Index.t }
273
+
type t = { parent : db; name : string; kv : kv_table }
149
274
150
275
let valid_name name =
151
276
String.length name > 0
152
277
&& (let first = name.[0] in
153
-
(* First char must be letter or underscore, not digit *)
154
278
(first >= 'a' && first <= 'z')
155
279
|| (first >= 'A' && first <= 'Z')
156
280
|| first = '_')
···
164
288
165
289
let create parent ~name =
166
290
if not (valid_name name) then Fmt.invalid_arg "Invalid table name: %S" name;
167
-
match Hashtbl.find_opt parent.tables name with
168
-
| Some (index, _) -> { parent; name; index }
291
+
match List.assoc_opt name parent.named_tables with
292
+
| Some kv -> { parent; name; kv }
169
293
| None ->
170
-
(* Check if table metadata exists in main index *)
171
-
let meta_key = "__table__" ^ name in
172
-
let index =
173
-
match find parent meta_key with
174
-
| Some meta_value when String.length meta_value >= 4 ->
175
-
let root = decode_u32_be meta_value 0 in
176
-
Btree.Index.open_ parent.pager ~root_page:root
177
-
| _ ->
178
-
(* Create new table *)
179
-
let index = Btree.Index.v parent.pager in
180
-
let root = Btree.Index.root_page index in
181
-
let meta_value = encode_u32_be root in
182
-
put parent meta_key meta_value;
183
-
index
184
-
in
185
-
let root = Btree.Index.root_page index in
186
-
Hashtbl.replace parent.tables name (index, root);
187
-
{ parent; name; index }
294
+
let kv = new_kv_table parent.pager in
295
+
parent.named_tables <- (name, kv) :: parent.named_tables;
296
+
{ parent; name; kv }
188
297
189
298
let find t key =
190
-
let prefix = prefix key in
191
-
match Btree.Index.by_prefix t.index prefix with
299
+
match Hashtbl.find_opt t.kv.keys key with
192
300
| None -> None
193
-
| Some entry ->
194
-
let found_key, value = decode_entry entry in
195
-
if found_key = key then Some value else None
301
+
| Some rowid -> (
302
+
match Btree.Table.find t.kv.btree rowid with
303
+
| None -> None
304
+
| Some payload -> (
305
+
match decode_kv payload with Some (_, v) -> Some v | None -> None))
196
306
197
307
let put t key value =
198
-
let prefix = prefix key in
199
-
Btree.Index.delete_by_prefix t.index prefix;
200
-
let entry = encode_entry key value in
201
-
Btree.Index.insert t.index entry
308
+
let kv = t.kv in
309
+
let record =
310
+
Btree.Record.encode [ Btree.Record.Vtext key; Btree.Record.Vblob value ]
311
+
in
312
+
(match Hashtbl.find_opt kv.keys key with
313
+
| Some old_rowid -> Btree.Table.delete kv.btree old_rowid
314
+
| None -> ());
315
+
let rowid = kv.next_rowid in
316
+
kv.next_rowid <- Int64.add kv.next_rowid 1L;
317
+
Btree.Table.insert kv.btree ~rowid record;
318
+
Hashtbl.replace kv.keys key rowid
202
319
203
320
let delete t key =
204
-
let prefix = prefix key in
205
-
Btree.Index.delete_by_prefix t.index prefix
321
+
match Hashtbl.find_opt t.kv.keys key with
322
+
| None -> ()
323
+
| Some rowid ->
324
+
Btree.Table.delete t.kv.btree rowid;
325
+
Hashtbl.remove t.kv.keys key
206
326
207
-
let mem t key =
208
-
let prefix = prefix key in
209
-
match Btree.Index.by_prefix t.index prefix with
210
-
| None -> false
211
-
| Some entry ->
212
-
let found_key, _ = decode_entry entry in
213
-
found_key = key
327
+
let mem t key = Hashtbl.mem t.kv.keys key
214
328
215
329
let iter t ~f =
216
-
Btree.Index.iter t.index (fun entry ->
217
-
let key, value = decode_entry entry in
218
-
if key <> "" then f key value)
330
+
Btree.Table.iter t.kv.btree (fun _rowid payload ->
331
+
match decode_kv payload with Some (k, v) -> f k v | None -> ())
219
332
end
+96
-58
test/cram/interop.t
+96
-58
test/cram/interop.t
···
1
1
Test interoperability with SQLite CLI
2
2
3
-
Create a test database using our OCaml library:
3
+
OCaml write and read roundtrip:
4
+
5
+
$ sql write test.db key1=value1 key2=value2
6
+
$ sql read test.db
7
+
key1|value1
8
+
key2|value2
9
+
10
+
Many entries:
11
+
12
+
$ sql write many.db a=1 b=2 c=3 d=4 e=5 f=6 g=7 h=8 i=9 j=10
13
+
$ sql read many.db
14
+
a|1
15
+
b|2
16
+
c|3
17
+
d|4
18
+
e|5
19
+
f|6
20
+
g|7
21
+
h|8
22
+
i|9
23
+
j|10
24
+
25
+
Delete entries:
4
26
5
-
$ cat > test_create.ml << 'EOF'
6
-
> let () =
7
-
> Eio_main.run @@ fun env ->
8
-
> let cwd = Eio.Stdenv.cwd env in
9
-
> let db = Sqlite.create Eio.Path.(cwd / "test.db") in
10
-
> Sqlite.put db "key1" "value1";
11
-
> Sqlite.put db "key2" "value2";
12
-
> Sqlite.put db "binary" "\x00\x01\x02\xff";
13
-
> let table = Sqlite.Table.create db ~name:"blocks" in
14
-
> Sqlite.Table.put table "cid1" "block_data_1";
15
-
> Sqlite.Table.put table "cid2" "block_data_2";
16
-
> Sqlite.close db;
17
-
> print_endline "Database created"
18
-
> EOF
27
+
$ sql delete many.db c f j
28
+
$ sql read many.db
29
+
a|1
30
+
b|2
31
+
d|4
32
+
e|5
33
+
g|7
34
+
h|8
35
+
i|9
19
36
20
-
$ ocamlfind ocamlopt -package sqlite,eio_main -linkpkg test_create.ml -o test_create 2>/dev/null || echo "Build requires dune"
21
-
Build requires dune
37
+
Delete and re-add:
22
38
23
-
Skip CLI tests if sqlite3 CLI is not available:
39
+
$ sql write many.db c=new_c f=new_f
40
+
$ sql read many.db
41
+
a|1
42
+
b|2
43
+
d|4
44
+
e|5
45
+
g|7
46
+
h|8
47
+
i|9
48
+
c|new_c
49
+
f|new_f
24
50
25
-
$ which sqlite3 >/dev/null 2>&1 || exit 0
51
+
Overwrite existing key:
26
52
27
-
Create test database using sqlite3 CLI directly:
53
+
$ sql write test.db key1=updated
54
+
$ sql read test.db
55
+
key2|value2
56
+
key1|updated
28
57
29
-
$ sqlite3 cli_test.db "CREATE TABLE kv (key TEXT PRIMARY KEY, value BLOB NOT NULL)"
30
-
$ sqlite3 cli_test.db "INSERT INTO kv VALUES ('hello', 'world')"
31
-
$ sqlite3 cli_test.db "INSERT INTO kv VALUES ('test', 'data')"
58
+
Skip remaining tests if sqlite3 is not available:
32
59
33
-
Verify data with CLI:
60
+
$ which sqlite3 >/dev/null 2>&1 || exit 0
34
61
35
-
$ sqlite3 cli_test.db "SELECT key, value FROM kv ORDER BY key"
62
+
OCaml writes, sqlite3 reads:
63
+
64
+
$ sql write interop.db hello=world foo=bar
65
+
$ sqlite3 interop.db "SELECT key, value FROM kv ORDER BY key"
66
+
foo|bar
36
67
hello|world
37
-
test|data
38
68
39
-
Create OCaml reader to verify CLI-created database:
69
+
sqlite3 creates, OCaml reads:
40
70
41
-
$ cat > test_read.ml << 'EOF'
42
-
> let () =
43
-
> Eio_main.run @@ fun env ->
44
-
> let cwd = Eio.Stdenv.cwd env in
45
-
> let db = Sqlite.create Eio.Path.(cwd / "cli_test.db") in
46
-
> (match Sqlite.find db "hello" with
47
-
> | Some v -> Printf.printf "hello = %s\n" v
48
-
> | None -> print_endline "hello not found");
49
-
> (match Sqlite.find db "test" with
50
-
> | Some v -> Printf.printf "test = %s\n" v
51
-
> | None -> print_endline "test not found");
52
-
> Sqlite.close db
53
-
> EOF
71
+
$ sqlite3 cli.db "CREATE TABLE kv (key TEXT, value BLOB)"
72
+
$ sqlite3 cli.db "INSERT INTO kv VALUES ('alpha', 'one')"
73
+
$ sqlite3 cli.db "INSERT INTO kv VALUES ('beta', 'two')"
74
+
$ sql read cli.db
75
+
alpha|one
76
+
beta|two
54
77
55
-
Test journal mode (default is delete):
78
+
Roundtrip: OCaml write, sqlite3 verify, OCaml read back:
56
79
57
-
$ sqlite3 cli_test.db "PRAGMA journal_mode"
58
-
delete
80
+
$ sql write round.db a=1 b=2 c=3
81
+
$ sqlite3 round.db "SELECT key, value FROM kv ORDER BY key"
82
+
a|1
83
+
b|2
84
+
c|3
85
+
$ sql read round.db
86
+
a|1
87
+
b|2
88
+
c|3
59
89
60
-
Verify table structure matches expected schema:
90
+
Delete and verify with sqlite3:
61
91
62
-
$ sqlite3 cli_test.db ".schema kv"
63
-
CREATE TABLE kv (key TEXT PRIMARY KEY, value BLOB NOT NULL);
92
+
$ sql delete round.db b
93
+
$ sqlite3 round.db "SELECT key, value FROM kv ORDER BY key"
94
+
a|1
95
+
c|3
96
+
$ sql read round.db
97
+
a|1
98
+
c|3
64
99
65
-
Test with namespaced tables:
100
+
Verify schema:
66
101
67
-
$ sqlite3 cli_test.db "CREATE TABLE blocks_kv (key TEXT PRIMARY KEY, value BLOB NOT NULL)"
68
-
$ sqlite3 cli_test.db "INSERT INTO blocks_kv VALUES ('cid1', X'deadbeef')"
69
-
$ sqlite3 cli_test.db "SELECT hex(value) FROM blocks_kv WHERE key = 'cid1'"
70
-
DEADBEEF
102
+
$ sqlite3 interop.db ".schema kv"
103
+
CREATE TABLE kv (key TEXT, value BLOB);
71
104
72
-
Verify tables exist:
105
+
Many entries with sqlite3 verification:
73
106
74
-
$ sqlite3 cli_test.db ".tables" | tr ' ' '\n' | sort | grep -v '^$'
75
-
blocks_kv
76
-
kv
107
+
$ sql write bulk.db k01=v01 k02=v02 k03=v03 k04=v04 k05=v05 k06=v06 k07=v07 k08=v08 k09=v09 k10=v10 k11=v11 k12=v12 k13=v13 k14=v14 k15=v15 k16=v16 k17=v17 k18=v18 k19=v19 k20=v20
108
+
$ sqlite3 bulk.db "SELECT count(*) FROM kv"
109
+
20
110
+
$ sql delete bulk.db k05 k10 k15 k20
111
+
$ sqlite3 bulk.db "SELECT count(*) FROM kv"
112
+
16
113
+
$ sql read bulk.db | head -3
114
+
k01|v01
115
+
k02|v02
116
+
k03|v03
77
117
78
118
Clean up:
79
119
80
-
$ rm -f cli_test.db cli_test.db-wal cli_test.db-shm
81
-
$ rm -f test.db test.db-wal test.db-shm
82
-
$ rm -f test_create.ml test_read.ml test_create
120
+
$ rm -f test.db many.db interop.db cli.db round.db bulk.db