[OCaml] High Intensity Training Online
refactor use closed variants for every service error
The service mixed two error styles: closed variants for routine and logging errors, polymorphic variants for accounts, application feedback, and imports. The steering prefers closed variants, which keep every match exhaustive and give each failure a home in one type. Every service error is now a closed variant, and the repository port's name-collision error is one too. The rename error also drops the "unknown account" case that nothing ever produced, so the type no longer promises a failure the code cannot raise.
Changed files
- bin/seed.ml
- lib/app/repository.ml
- lib/app/repository.mli
- lib/app/service.ml
- lib/app/service.mli
- lib/persistence/sqlite_repo.ml
- lib/web/handlers_app_feedback.ml
- lib/web/handlers_import.ml
- lib/web/handlers_kit.ml
- test/memory_repo.ml
- test/test_import_service.ml
- test/test_service.ml
- test/test_sqlite_repo.ml
bin/seed.ml
@@ -161,7 +161,7 @@
161
161
Repo.set_active_routine repo trainee.Hito_app.Trainee.id
162
162
(Hito_app.Repository.routine_id "ideal")
163
163
>>= fun () -> seed_history repo trainee.Hito_app.Trainee.id ~csv_path
164
Removed:
| Error `Username_taken -> (
164
Added:
| Error Service.Username_taken -> (
165
165
match Hito_app.Trainee.username "blendux" with
166
166
| Error _ -> Lwt.return_unit
167
167
| Ok username -> (
@@ -170,7 +170,7 @@
170
170
| None -> Lwt.return_unit
171
171
| Some trainee ->
172
172
seed_history repo trainee.Hito_app.Trainee.id ~csv_path))
173
Removed:
| Error (`Username e) ->
173
Added:
| Error (Service.Username_invalid e) ->
174
174
Format.eprintf "hito: cannot seed user: %a@."
175
175
Hito_app.Trainee.pp_username_error e;
176
176
exit 1
lib/app/repository.ml
@@ -4,6 +4,8 @@
4
4
let routine_id s = s
5
5
let workout_id s = s
6
6
7
Added:
type username_taken = Username_taken
8
Added:
7
9
(* Callers reach these fields through the module type, not from here. *)
8
10
type record = { id : workout_id; workout : Evidence.Workout.t }
9
11
[@@warning "-69"]
@@ -42,7 +44,7 @@
42
44
t ->
43
45
username:Trainee.username ->
44
46
credential:Trainee.credential ->
45
Removed:
(Trainee.t, [ `Username_taken ]) result Lwt.t
47
Added:
(Trainee.t, username_taken) result Lwt.t
46
48
47
49
val find_trainee_by_username : t -> Trainee.username -> Trainee.t option Lwt.t
48
50
val find_trainee : t -> Trainee.id -> Trainee.t option Lwt.t
@@ -51,7 +53,7 @@
51
53
t ->
52
54
Trainee.id ->
53
55
Trainee.username ->
54
Removed:
(Trainee.t, [ `Username_taken ]) result Lwt.t
56
Added:
(Trainee.t, username_taken) result Lwt.t
55
57
56
58
val update_credential :
57
59
t -> Trainee.id -> Trainee.credential -> Trainee.t option Lwt.t
lib/app/repository.mli
@@ -15,6 +15,11 @@
15
15
val routine_id : string -> routine_id
16
16
val workout_id : string -> workout_id
17
17
18
Added:
type username_taken =
19
Added:
| Username_taken
20
Added:
(** The one way creating or renaming an account fails at the store:
21
Added:
another account already holds the name. *)
22
Added:
18
23
type record = { id : workout_id; workout : Evidence.Workout.t }
19
24
(** A stored workout. It already knows its prescription, its timestamps, and the
20
25
basis on which it was begun. *)
@@ -62,7 +67,7 @@
62
67
t ->
63
68
username:Trainee.username ->
64
69
credential:Trainee.credential ->
65
Removed:
(Trainee.t, [ `Username_taken ]) result Lwt.t
70
Added:
(Trainee.t, username_taken) result Lwt.t
66
71
67
72
val find_trainee_by_username : t -> Trainee.username -> Trainee.t option Lwt.t
68
73
val find_trainee : t -> Trainee.id -> Trainee.t option Lwt.t
@@ -71,8 +76,8 @@
71
76
t ->
72
77
Trainee.id ->
73
78
Trainee.username ->
74
Removed:
(Trainee.t, [ `Username_taken ]) result Lwt.t
75
Removed:
(** Rename the account. [`Username_taken] if another account holds the name.
79
Added:
(Trainee.t, username_taken) result Lwt.t
80
Added:
(** Rename the account. [Username_taken] if another account holds the name.
76
81
The trainee's own current name is accepted as a no-op. Returns the updated
77
82
trainee on success. *)
78
83
lib/app/service.ml
@@ -15,12 +15,15 @@
15
15
use-case modules over the shared [t]. The end of the functor re-exports the
16
16
public names, so callers and {!Service.mli} see one flat service. *)
17
17
18
Removed:
type register_error = [ `Username of Trainee.username_error | `Username_taken ]
18
Added:
type register_error =
19
Added:
| Username_invalid of Trainee.username_error
20
Added:
| Username_taken
19
21
20
22
type change_username_error =
21
Removed:
[ `Username of Trainee.username_error | `Username_taken | `Unknown ]
23
Added:
| Rename_invalid of Trainee.username_error
24
Added:
| Rename_taken
22
25
23
Removed:
type change_password_error = [ `Incorrect_password | `Unknown ]
26
Added:
type change_password_error = Incorrect_password | Password_unknown_account
24
27
type error = Unknown_routine | Not_recovered of Recovery.readiness
25
28
26
29
let pp_error ppf = function
@@ -37,10 +40,12 @@
37
40
38
41
type edit_error = Unknown_workout | Rejected_edit of Evidence.Workout.error
39
42
type delete_record_error = Record_not_found
40
Removed:
type app_feedback_error = [ `Empty_message | `Unknown_feedback ]
43
Added:
type app_feedback_error = Empty_message | Unknown_feedback
41
44
42
45
type import_error =
43
Removed:
[ `Unknown_batch | `Duplicate_source | `Import of Workout_import.error ]
46
Added:
| Unknown_batch
47
Added:
| Duplicate_source
48
Added:
| Import of Workout_import.error
44
49
45
50
(* Shared helpers over a routine and a log, used by more than one use case. *)
46
51
@@ -120,11 +125,13 @@
120
125
carries no policy, so hashing always succeeds. *)
121
126
let* username =
122
127
Lwt.return
123
Removed:
(Result.map_error (fun e -> `Username e) (Trainee.username username))
128
Added:
(Result.map_error
129
Added:
(fun e -> Username_invalid e)
130
Added:
(Trainee.username username))
124
131
in
125
132
let credential = Trainee.credential_of_hash (H.hash password) in
126
133
Lwt_result.map_error
127
Removed:
(fun `Username_taken -> `Username_taken)
134
Added:
(fun Repository.Username_taken -> Username_taken)
128
135
(R.create_trainee t.repo ~username ~credential)
129
136
130
137
(* Every refusal does the same hashing work. A malformed or unknown username
@@ -157,10 +164,12 @@
157
164
let open Lwt_result.Syntax in
158
165
let* username =
159
166
Lwt.return
160
Removed:
(Result.map_error (fun e -> `Username e) (Trainee.username username))
167
Added:
(Result.map_error
168
Added:
(fun e -> Rename_invalid e)
169
Added:
(Trainee.username username))
161
170
in
162
171
Lwt_result.map_error
163
Removed:
(fun `Username_taken -> `Username_taken)
172
Added:
(fun Repository.Username_taken -> Rename_taken)
164
173
(R.update_username t.repo id username)
165
174
166
175
(* Change the password. The current password must verify first, so a
@@ -168,18 +177,19 @@
168
177
any new password is accepted once the current one checks out. *)
169
178
let change_password t id ~current ~next =
170
179
R.find_trainee t.repo id >>= function
171
Removed:
| None -> Lwt.return (Error `Unknown)
180
Added:
| None -> Lwt.return (Error Password_unknown_account)
172
181
| Some trainee ->
173
182
if
174
183
not
175
184
(H.verify
176
185
~hash:(Trainee.credential_to_hash trainee.Trainee.credential)
177
186
current)
178
Removed:
then Lwt.return (Error `Incorrect_password)
187
Added:
then Lwt.return (Error Incorrect_password)
179
188
else
180
189
R.update_credential t.repo id
181
190
(Trainee.credential_of_hash (H.hash next))
182
Removed:
>|= fun updated -> Option.to_result ~none:`Unknown updated
191
Added:
>|= fun updated ->
192
Added:
Option.to_result ~none:Password_unknown_account updated
183
193
end
184
194
185
195
(* --- routines and selection --- *)
@@ -383,7 +393,7 @@
383
393
(* --- application feedback --- *)
384
394
module App_feedback = struct
385
395
let record t trainee ~submitted_at ~message =
386
Removed:
if String.trim message = "" then Lwt.return (Error `Empty_message)
396
Added:
if String.trim message = "" then Lwt.return (Error Empty_message)
387
397
else
388
398
R.save_app_feedback t.repo trainee ~submitted_at ~message
389
399
>|= fun report -> Ok report
@@ -392,11 +402,11 @@
392
402
let upvote t trainee id = R.upvote_app_feedback t.repo ~voter:trainee id
393
403
394
404
let edit t trainee id ~message =
395
Removed:
if String.trim message = "" then Lwt.return (Error `Empty_message)
405
Added:
if String.trim message = "" then Lwt.return (Error Empty_message)
396
406
else
397
407
R.update_app_feedback t.repo ~author:trainee id ~message >|= function
398
408
| true -> Ok ()
399
Removed:
| false -> Error `Unknown_feedback
409
Added:
| false -> Error Unknown_feedback
400
410
401
411
let remove t trainee id = R.delete_app_feedback t.repo ~author:trainee id
402
412
end
@@ -440,7 +450,7 @@
440
450
&& String.equal (WI.batch_fingerprint b) fingerprint)
441
451
existing
442
452
in
443
Removed:
if duplicate then Lwt.return (Error `Duplicate_source)
453
Added:
if duplicate then Lwt.return (Error Duplicate_source)
444
454
else R.save_import_batch t.repo trainee batch >|= fun () -> Ok ()
445
455
446
456
let import_batches t trainee = R.import_batches t.repo trainee
@@ -450,13 +460,13 @@
450
460
R.delete_import_batch t.repo trainee id
451
461
452
462
(* Load a batch, apply a pure cleaning step, and save the revised batch.
453
Removed:
An unknown batch is [`Unknown_batch]; a cleaning error is [`Import]. *)
463
Added:
An unknown batch is [Unknown_batch]; a cleaning error is [Import]. *)
454
464
let with_batch t trainee ~batch ~f =
455
465
R.find_import_batch t.repo trainee batch >>= function
456
Removed:
| None -> Lwt.return (Error `Unknown_batch)
466
Added:
| None -> Lwt.return (Error Unknown_batch)
457
467
| Some b -> (
458
468
match f b with
459
Removed:
| Error e -> Lwt.return (Error (`Import e))
469
Added:
| Error e -> Lwt.return (Error (Import e))
460
470
| Ok updated ->
461
471
R.save_import_batch t.repo trainee updated >|= fun () ->
462
472
Ok updated)
@@ -478,10 +488,10 @@
478
488
untouched; the batch is saved only when [promote_workout] revised it. *)
479
489
let promote_import_workout t trainee ~batch ~workout =
480
490
R.find_import_batch t.repo trainee batch >>= function
481
Removed:
| None -> Lwt.return (Error `Unknown_batch)
491
Added:
| None -> Lwt.return (Error Unknown_batch)
482
492
| Some b -> (
483
493
match WI.promote_workout b workout with
484
Removed:
| Error e -> Lwt.return (Error (`Import e))
494
Added:
| Error e -> Lwt.return (Error (Import e))
485
495
| Ok (updated, (WI.Promoted p as result)) ->
486
496
R.replace_imported_record t.repo trainee (record_of_promoted p)
487
497
>>= fun () ->
@@ -500,7 +510,7 @@
500
510
once, after all records, so its remembered promotions match the store. *)
501
511
let promote_import_batch t trainee ~batch =
502
512
R.find_import_batch t.repo trainee batch >>= function
503
Removed:
| None -> Lwt.return (Error `Unknown_batch)
513
Added:
| None -> Lwt.return (Error Unknown_batch)
504
514
| Some b ->
505
515
let updated, result = WI.promote_batch b in
506
516
Lwt_list.iter_s
lib/app/service.mli
@@ -21,9 +21,12 @@
21
21
22
22
(** {2 Accounts} *)
23
23
24
Removed:
type register_error = [ `Username of Trainee.username_error | `Username_taken ]
25
Removed:
(** Registration fails for a malformed username or a username already in use.
26
Removed:
Passwords carry no policy, so they never refuse registration. *)
24
Added:
type register_error =
25
Added:
| Username_invalid of Trainee.username_error
26
Added:
| Username_taken
27
Added:
(** Registration fails for a malformed username or a username already in
28
Added:
use. Passwords carry no policy, so they never refuse registration.
29
Added:
*)
27
30
28
31
val register :
29
32
t ->
@@ -38,9 +41,10 @@
38
41
val find_trainee : t -> Trainee.id -> Trainee.t option Lwt.t
39
42
40
43
type change_username_error =
41
Removed:
[ `Username of Trainee.username_error | `Username_taken | `Unknown ]
42
Removed:
(** A rename fails for a malformed name, a name already in use, or an unknown
43
Removed:
account. *)
44
Added:
| Rename_invalid of Trainee.username_error
45
Added:
| Rename_taken
46
Added:
(** A rename fails for a malformed name, a name already in use, or an
47
Added:
unknown account. *)
44
48
45
49
val change_username :
46
50
t ->
@@ -50,9 +54,11 @@
50
54
(** Rename the account. The trainee's own current name is accepted as a no-op.
51
55
Returns the updated trainee on success. *)
52
56
53
Removed:
type change_password_error = [ `Incorrect_password | `Unknown ]
54
Removed:
(** A password change fails when the current password did not verify, or when
55
Removed:
the account is unknown. *)
57
Added:
type change_password_error =
58
Added:
| Incorrect_password
59
Added:
| Password_unknown_account
60
Added:
(** A password change fails when the current password did not verify, or
61
Added:
when the account is unknown. *)
56
62
57
63
val change_password :
58
64
t ->
@@ -219,9 +225,11 @@
219
225
220
226
(** {2 Application feedback} *)
221
227
222
Removed:
type app_feedback_error = [ `Empty_message | `Unknown_feedback ]
223
Removed:
(** An application feedback operation fails for an empty message or an unknown
224
Removed:
feedback item. *)
228
Added:
type app_feedback_error =
229
Added:
| Empty_message
230
Added:
| Unknown_feedback
231
Added:
(** An application feedback operation fails for an empty message or an
232
Added:
unknown feedback item. *)
225
233
226
234
val record_app_feedback :
227
235
t ->
@@ -260,10 +268,12 @@
260
268
feeds progression. It never advances the routine cycle. *)
261
269
262
270
type import_error =
263
Removed:
[ `Unknown_batch | `Duplicate_source | `Import of Workout_import.error ]
264
Removed:
(** An import operation fails when no such stored batch exists, when another
265
Removed:
stored batch already carries the same source fingerprint, or when the
266
Removed:
cleaning or promotion step itself failed. *)
271
Added:
| Unknown_batch
272
Added:
| Duplicate_source
273
Added:
| Import of Workout_import.error
274
Added:
(** An import operation fails when no such stored batch exists, when
275
Added:
another stored batch already carries the same source fingerprint, or
276
Added:
when the cleaning or promotion step itself failed. *)
267
277
268
278
val store_import_batch :
269
279
t ->
lib/persistence/sqlite_repo.ml
@@ -251,7 +251,7 @@
251
251
Db.with_transaction (fun () ->
252
252
let* existing = Db.find_opt Q.trainee_by_username username_s in
253
253
match existing with
254
Removed:
| Some _ -> Lwt_result.return (Error `Username_taken)
254
Added:
| Some _ -> Lwt_result.return (Error Repository.Username_taken)
255
255
| None ->
256
256
let* next = Db.find Q.next_trainee () in
257
257
let id = Printf.sprintf "t%d" next in
@@ -299,14 +299,14 @@
299
299
let* holder = Db.find_opt Q.trainee_by_username username_s in
300
300
match holder with
301
301
| Some (holder_id, _, _) when not (String.equal holder_id trainee) ->
302
Removed:
Lwt_result.return (Error `Username_taken)
302
Added:
Lwt_result.return (Error Repository.Username_taken)
303
303
| _ ->
304
304
let* () = Db.exec Q.update_username (username_s, trainee) in
305
305
let* row = Db.find_opt Q.trainee_by_id trainee in
306
306
Lwt_result.return
307
307
(match Option.bind row trainee_of_row with
308
308
| Some updated -> Ok updated
309
Removed:
| None -> Error `Username_taken)))
309
Added:
| None -> Error Repository.Username_taken)))
310
310
311
311
let update_credential t id credential =
312
312
let trainee = Trainee.id_to_string id in
lib/web/handlers_app_feedback.ml
@@ -63,11 +63,11 @@
63
63
redirect_with_flash request
64
64
(Dream_html.string_attr "href" "/app-feedback?tab=submitted")
65
65
"Feedback submitted."
66
Removed:
| Error `Empty_message ->
66
Added:
| Error Service.Empty_message ->
67
67
redirect_with_flash request
68
68
(Dream_html.string_attr "href" "/app-feedback?tab=write")
69
69
Present.app_feedback_empty
70
Removed:
| Error `Unknown_feedback ->
70
Added:
| Error Service.Unknown_feedback ->
71
71
redirect_with_flash request
72
72
(Dream_html.string_attr "href" "/app-feedback?tab=submitted")
73
73
"That feedback is no longer available.")
@@ -101,11 +101,11 @@
101
101
redirect_with_flash request
102
102
(Dream_html.string_attr "href" "/app-feedback?tab=submitted")
103
103
"Feedback updated."
104
Removed:
| Error `Empty_message ->
104
Added:
| Error Service.Empty_message ->
105
105
redirect_with_flash request
106
106
(Dream_html.string_attr "href" "/app-feedback?tab=submitted")
107
107
Present.app_feedback_empty
108
Removed:
| Error `Unknown_feedback ->
108
Added:
| Error Service.Unknown_feedback ->
109
109
redirect_with_flash request
110
110
(Dream_html.string_attr "href" "/app-feedback?tab=submitted")
111
111
"That feedback is no longer available.")
lib/web/handlers_import.ml
@@ -144,7 +144,7 @@
144
144
Routes.import_review
145
145
(Workout_import.batch_id_to_string batch_id))
146
146
"Import stored. Review it below."
147
Removed:
| Error `Duplicate_source ->
147
Added:
| Error Service.Duplicate_source ->
148
148
redirect_with_flash request
149
149
(Dream_html.path_attr Dream_html.HTML.href Routes.profile)
150
150
"This export was already imported. Re-submit with the \
@@ -189,7 +189,7 @@
189
189
| Ok _ ->
190
190
redirect_with_flash request (review_url batch_id)
191
191
"Exercise mapped."
192
Removed:
| Error `Unknown_batch ->
192
Added:
| Error Service.Unknown_batch ->
193
193
not_found "That import batch no longer exists."
194
194
| Error _ ->
195
195
redirect_with_flash request (review_url batch_id)
@@ -213,9 +213,9 @@
213
213
| Ok _ ->
214
214
redirect_with_flash request (review_url batch_id)
215
215
"Normal sets confirmed."
216
Removed:
| Error `Unknown_batch ->
216
Added:
| Error Service.Unknown_batch ->
217
217
not_found "That import batch no longer exists."
218
Removed:
| Error (`Import Workout_import.Empty_acknowledgement) ->
218
Added:
| Error (Service.Import Workout_import.Empty_acknowledgement) ->
219
219
redirect_with_flash request (review_url batch_id)
220
220
"Enter an acknowledgement before confirming."
221
221
| Error _ ->
@@ -246,7 +246,7 @@
246
246
redirect_with_flash request (review_url batch_id)
247
247
(Printf.sprintf "Workout blocked: %s"
248
248
(String.concat " " (List.map blocker_string blockers)))
249
Removed:
| Error `Unknown_batch ->
249
Added:
| Error Service.Unknown_batch ->
250
250
not_found "That import batch no longer exists."
251
251
| Error _ ->
252
252
redirect_with_flash request (review_url batch_id)
@@ -267,7 +267,7 @@
267
267
redirect_with_flash request (review_url batch_id)
268
268
(Printf.sprintf "Promoted %d, already promoted %d, blocked %d."
269
269
promoted already blocked)
270
Removed:
| Error `Unknown_batch ->
270
Added:
| Error Service.Unknown_batch ->
271
271
not_found "That import batch no longer exists."
272
272
| Error _ ->
273
273
redirect_with_flash request (review_url batch_id)
lib/web/handlers_kit.ml
@@ -116,8 +116,8 @@
116
116
Trainee.username_max_length
117
117
118
118
let registration : Service.register_error -> string = function
119
Removed:
| `Username e -> username_error e
120
Removed:
| `Username_taken -> "That username is already registered."
119
Added:
| Service.Username_invalid e -> username_error e
120
Added:
| Service.Username_taken -> "That username is already registered."
121
121
122
122
let sign_in_failed = "That username and password do not match."
123
123
@@ -159,13 +159,12 @@
159
159
let slot_not_awaiting = "That slot is not awaiting a record."
160
160
161
161
let change_username : Service.change_username_error -> string = function
162
Removed:
| `Username e -> username_error e
163
Removed:
| `Username_taken -> "That username is already registered."
164
Removed:
| `Unknown -> "That account no longer exists."
162
Added:
| Service.Rename_invalid e -> username_error e
163
Added:
| Service.Rename_taken -> "That username is already registered."
165
164
166
165
let change_password : Service.change_password_error -> string = function
167
Removed:
| `Incorrect_password -> "The current password is not correct."
168
Removed:
| `Unknown -> "That account no longer exists."
166
Added:
| Service.Incorrect_password -> "The current password is not correct."
167
Added:
| Service.Password_unknown_account -> "That account no longer exists."
169
168
170
169
let feedback_level : Feedback.level -> string = function
171
170
| Feedback.Worse_than_usual -> "worse than usual"
test/memory_repo.ml
@@ -59,7 +59,7 @@
59
59
(Trainee.username_to_string username))
60
60
t.trainees
61
61
with
62
Removed:
| Some _ -> Lwt.return (Error `Username_taken)
62
Added:
| Some _ -> Lwt.return (Error Repository.Username_taken)
63
63
| None ->
64
64
let id = Trainee.id (Printf.sprintf "t%d" t.next_trainee) in
65
65
t.next_trainee <- t.next_trainee + 1;
@@ -102,7 +102,7 @@
102
102
String.equal (Trainee.id_to_string tr.id) (Trainee.id_to_string id))
103
103
t.trainees
104
104
with
105
Removed:
| None -> Lwt.return (Error `Username_taken)
105
Added:
| None -> Lwt.return (Error Repository.Username_taken)
106
106
| Some current ->
107
107
let taken =
108
108
List.exists
@@ -116,7 +116,7 @@
116
116
(Trainee.username_to_string username))
117
117
t.trainees
118
118
in
119
Removed:
if taken then Lwt.return (Error `Username_taken)
119
Added:
if taken then Lwt.return (Error Repository.Username_taken)
120
120
else begin
121
121
let updated = { current with Trainee.username } in
122
122
replace_trainee t updated;
test/test_import_service.ml
@@ -90,7 +90,7 @@
90
90
(S.store_import_batch s t
91
91
(batch ~id:"b2" ~fingerprint:"same" [ w "w2" ]))
92
92
with
93
Removed:
| Error `Duplicate_source -> ()
93
Added:
| Error S.Duplicate_source -> ()
94
94
| _ -> Alcotest.fail "expected Duplicate_source");
95
95
ok
96
96
(run
test/test_service.ml
@@ -88,7 +88,7 @@
88
88
match
89
89
run (S.register s ~username:" ALICE " ~password:"another11")
90
90
with
91
Removed:
| Error `Username_taken -> ()
91
Added:
| Error S.Username_taken -> ()
92
92
| _ -> Alcotest.fail "expected Username_taken" );
93
93
( "a normalized username authenticates regardless of case or spacing",
94
94
`Quick,
@@ -108,7 +108,7 @@
108
108
fun () ->
109
109
let s = S.make ~repo:(Memory_repo.create ()) in
110
110
match run (S.register s ~username:"abc" ~password:"heavyduty1") with
111
Removed:
| Error (`Username Trainee.Too_short) -> ()
111
Added:
| Error (S.Username_invalid Trainee.Too_short) -> ()
112
112
| _ -> Alcotest.fail "expected Too_short" );
113
113
( "a four-character username is accepted",
114
114
`Quick,
@@ -135,7 +135,7 @@
135
135
match
136
136
run (S.register s ~username:"abcdefghijklmnopqrstu" ~password:"pw")
137
137
with
138
Removed:
| Error (`Username Trainee.Too_long) -> ()
138
Added:
| Error (S.Username_invalid Trainee.Too_long) -> ()
139
139
| _ -> Alcotest.fail "expected Too_long" );
140
140
( "surrounding whitespace does not count toward the length bounds",
141
141
`Quick,
@@ -237,8 +237,8 @@
237
237
ok (run (S.register s ~username:"bobby" ~password:"heavyduty1"))
238
238
in
239
239
match run (S.change_username s a ~username:"bobby") with
240
Removed:
| Error `Username_taken -> ()
241
Removed:
| _ -> Alcotest.fail "expected Username_taken" );
240
Added:
| Error S.Rename_taken -> ()
241
Added:
| _ -> Alcotest.fail "expected Rename_taken" );
242
242
( "an invalid new username is refused",
243
243
`Quick,
244
244
fun () ->
@@ -248,7 +248,7 @@
248
248
.Trainee.id
249
249
in
250
250
match run (S.change_username s id ~username:"ab") with
251
Removed:
| Error (`Username Trainee.Too_short) -> ()
251
Added:
| Error (S.Rename_invalid Trainee.Too_short) -> ()
252
252
| _ -> Alcotest.fail "expected Too_short" );
253
253
( "changing the password requires the current one",
254
254
`Quick,
@@ -261,7 +261,7 @@
261
261
(match
262
262
run (S.change_password s id ~current:"wrong" ~next:"newsecret1")
263
263
with
264
Removed:
| Error `Incorrect_password -> ()
264
Added:
| Error S.Incorrect_password -> ()
265
265
| _ -> Alcotest.fail "expected Incorrect_password");
266
266
(* The old password still works after a refused change. *)
267
267
Alcotest.(check bool)
@@ -643,8 +643,8 @@
643
643
run
644
644
(S.record_app_feedback s t ~submitted_at:(day 1) ~message:" \n ")
645
645
with
646
Removed:
| Error `Empty_message -> ()
647
Removed:
| Error `Unknown_feedback ->
646
Added:
| Error S.Empty_message -> ()
647
Added:
| Error S.Unknown_feedback ->
648
648
Alcotest.fail "unexpected unknown feedback error"
649
649
| Ok _ -> Alcotest.fail "expected a blank message to be refused" );
650
650
( "app feedback is stored newest first and visible globally",
@@ -769,8 +769,8 @@
769
769
(S.edit_app_feedback s alice report.Repository.feedback_id
770
770
~message:" ")
771
771
with
772
Removed:
| Error `Empty_message -> ()
773
Removed:
| Error `Unknown_feedback -> Alcotest.fail "feedback must still exist"
772
Added:
| Error S.Empty_message -> ()
773
Added:
| Error S.Unknown_feedback -> Alcotest.fail "feedback must still exist"
774
774
| Ok () -> Alcotest.fail "expected a blank edit to be refused" );
775
775
( "removed application feedback identities are not reused",
776
776
`Quick,
@@ -824,7 +824,7 @@
824
824
(S.edit_app_feedback s bob report.Repository.feedback_id
825
825
~message:"Not yours")
826
826
with
827
Removed:
| Error `Unknown_feedback -> ()
827
Added:
| Error S.Unknown_feedback -> ()
828
828
| _ -> Alcotest.fail "another trainee edited the report");
829
829
(match
830
830
run
test/test_sqlite_repo.ml
@@ -533,7 +533,7 @@
533
533
(S.edit_app_feedback s bob report.Repository.feedback_id
534
534
~message:"Not yours")
535
535
with
536
Removed:
| Error `Unknown_feedback -> ()
536
Added:
| Error S.Unknown_feedback -> ()
537
537
| _ -> Alcotest.fail "another trainee edited the report");
538
538
(match
539
539
run