[OCaml] High Intensity Training Online
fix mint trainee ids inside the insert transaction
Account creation computed the next id from a process-local counter and ran the username check, id choice, and insert as three separate statements. Two concurrent registrations could mint the same id, and a file edited outside this process drifted from the in-memory count. The id is now read from the table inside the same transaction as the check and the insert, so SQLite's write lock serialises the whole sequence and there is no counter to drift. The workout sequence already took this shape. The mutable field and its startup read are gone. The connection URI also gains a default busy_timeout of five seconds. SQLite admits one writer at a time; without a timeout a second writer fails at once with SQLITE_BUSY, with one it waits its turn, so overlapping transactions serialise instead of failing. A caller who sets their own busy_timeout keeps it.
Changed files
lib/persistence/sqlite_repo.ml
@@ -4,10 +4,7 @@
4
4
exception Corrupt of Codec.error
5
5
exception Import_corrupt of Import_codec.error
6
6
7
Removed:
type t = {
8
Removed:
pool : (Caqti_lwt.connection, Caqti_error.t) Caqti_lwt_unix.Pool.t;
9
Removed:
mutable next_trainee : int;
10
Removed:
}
7
Added:
type t = { pool : (Caqti_lwt.connection, Caqti_error.t) Caqti_lwt_unix.Pool.t }
11
8
12
9
(* --- request definitions --- *)
13
10
@@ -190,18 +187,27 @@
190
187
191
188
let run t f = Caqti_lwt_unix.Pool.use f t.pool >>= Caqti_lwt.or_fail
192
189
190
Added:
(* SQLite admits one writer at a time. Without a busy timeout a second writer
191
Added:
fails at once with SQLITE_BUSY; with one it waits its turn. The driver reads
192
Added:
[busy_timeout] (milliseconds) from the URI, so a caller who sets it keeps
193
Added:
their value and everyone else gets a five-second wait, which serialises
194
Added:
overlapping transactions instead of failing them. *)
195
Added:
let default_busy_timeout_ms = 5_000
196
Added:
197
Added:
let with_busy_timeout uri =
198
Added:
match Uri.get_query_param uri "busy_timeout" with
199
Added:
| Some _ -> uri
200
Added:
| None ->
201
Added:
Uri.add_query_param' uri
202
Added:
("busy_timeout", string_of_int default_busy_timeout_ms)
203
Added:
193
204
let connect uri =
194
Removed:
match Caqti_lwt_unix.connect_pool (Uri.of_string uri) with
205
Added:
match Caqti_lwt_unix.connect_pool (with_busy_timeout (Uri.of_string uri)) with
195
206
| Error e -> Lwt.return (Error (e :> Caqti_error.t))
196
207
| Ok pool ->
197
208
let open Lwt_result.Syntax in
198
209
let* () = Caqti_lwt_unix.Pool.use Migrations.apply pool in
199
Removed:
let* next_trainee =
200
Removed:
Caqti_lwt_unix.Pool.use
201
Removed:
(fun (module Db : Caqti_lwt.CONNECTION) -> Db.find Q.next_trainee ())
202
Removed:
pool
203
Removed:
in
204
Removed:
Lwt_result.return { pool; next_trainee }
210
Added:
Lwt_result.return { pool }
205
211
206
212
(* --- decoding stored workouts --- *)
207
213
@@ -231,19 +237,29 @@
231
237
232
238
(* --- accounts --- *)
233
239
240
Added:
(* Create the account in one transaction: check the name is free, take the next
241
Added:
id, and insert, all under SQLite's write lock. The id comes from the table
242
Added:
itself on every call, never from a process-local counter, so two concurrent
243
Added:
registrations cannot mint the same id and a file edited outside this process
244
Added:
cannot drift from an in-memory count. The UNIQUE constraint on username is
245
Added:
the final arbiter; the transaction makes the check-then-insert atomic. *)
234
246
let create_trainee t ~username ~credential =
235
247
let username_s = Trainee.username_to_string username in
236
248
let credential_s = Trainee.credential_to_hash credential in
237
249
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
238
Removed:
Db.find_opt Q.trainee_by_username username_s)
239
Removed:
>>= function
240
Removed:
| Some _ -> Lwt.return (Error `Username_taken)
241
Removed:
| None ->
242
Removed:
let id = Printf.sprintf "t%d" t.next_trainee in
243
Removed:
t.next_trainee <- t.next_trainee + 1;
244
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
245
Removed:
Db.exec Q.insert_trainee (id, username_s, credential_s))
246
Removed:
>|= fun () -> Ok { Trainee.id = Trainee.id id; username; credential }
250
Added:
let open Lwt_result.Syntax in
251
Added:
Db.with_transaction (fun () ->
252
Added:
let* existing = Db.find_opt Q.trainee_by_username username_s in
253
Added:
match existing with
254
Added:
| Some _ -> Lwt_result.return (Error `Username_taken)
255
Added:
| None ->
256
Added:
let* next = Db.find Q.next_trainee () in
257
Added:
let id = Printf.sprintf "t%d" next in
258
Added:
let* () =
259
Added:
Db.exec Q.insert_trainee (id, username_s, credential_s)
260
Added:
in
261
Added:
Lwt_result.return
262
Added:
(Ok { Trainee.id = Trainee.id id; username; credential })))
247
263
248
264
let trainee_of_row (id, username, credential) =
249
265
match Trainee.username username with
test/test_sqlite_repo.ml
@@ -41,6 +41,29 @@
41
41
42
42
let durability_tests =
43
43
[
44
Added:
( "concurrent registrations mint distinct identities",
45
Added:
`Quick,
46
Added:
fun () ->
47
Added:
(* Two accounts created at once must never share an id. The id is taken
48
Added:
inside the insert transaction, so SQLite's write lock serialises the
49
Added:
read-then-insert that a process-local counter used to race. *)
50
Added:
let path, uri = temp_uri () in
51
Added:
Fun.protect
52
Added:
~finally:(fun () -> cleanup path)
53
Added:
(fun () ->
54
Added:
let repo = connect uri in
55
Added:
let s = S.make ~repo in
56
Added:
let a, b =
57
Added:
run
58
Added:
(Lwt.both
59
Added:
(S.register s ~username:"alice" ~password:"heavyduty1")
60
Added:
(S.register s ~username:"bernard" ~password:"heavyduty1"))
61
Added:
in
62
Added:
let a = ok a and b = ok b in
63
Added:
Alcotest.(check bool)
64
Added:
"distinct ids" true
65
Added:
(Trainee.id_to_string a.Trainee.id
66
Added:
<> Trainee.id_to_string b.Trainee.id)) );
44
67
( "a corrupt history row is quarantined, not fatal",
45
68
`Quick,
46
69
fun () ->