[OCaml] High Intensity Training Online
test Assert flows and domain state, not page content
Rewrite the web suite to test what matters: the user flow from URL to URL (status codes, redirect targets), CSRF and session enforcement, and the domain state each flow produces, read directly from the repository. Page markup is presentation and subject to change, so strict content assertions were overkill and brittle. Tests now drive forms through the CSRF helper and verify outcomes via a repo-holding client: active routine, in-progress workout and its filled slots, history, stored feedback signals, app-feedback message and ownership, and the renamed username proved through the sign-in flow. Business rules kept: recovery gate, per-trainee isolation, duplicate-feedback rejection, slot bounds, CSRF protection, and POST-redirect-GET. Presentation-only cases were deleted; every remaining assertion is behavioral.
test/test_web.ml
@@ -3,2377 +3,1779 @@
3
3
the rendered page, exactly as a browser would. The in-memory repository
4
4
stands in for SQLite; session storage is Dream's in-memory back end. *)
5
5
6
Removed:
open Hito_persistence
7
Removed:
module Handlers = Hito_web.Handlers.Make (Memory_repo) (Bcrypt_hash)
8
Removed:
9
Removed:
(* A fresh, fully wired application: secret, in-memory sessions, routes.
10
Removed:
Registration is opened here so the auth-flow tests can create trainees via
11
Removed:
[/register]; production keeps it closed. *)
12
Removed:
let app () =
13
Removed:
let handlers =
14
Removed:
Handlers.make ~repo:(Memory_repo.create ()) ~registration_open:true ()
15
Removed:
in
16
Removed:
Dream.memory_sessions @@ Dream.router (Handlers.routes handlers)
17
Removed:
|> fun handler -> Dream.set_secret "test-secret-value" handler
18
Removed:
19
Removed:
let status response = Dream.status response |> Dream.status_to_int
20
Removed:
let body response = Lwt_main.run (Dream.body response)
21
Removed:
22
Removed:
let contains ~substring string =
23
Removed:
let n = String.length substring in
24
Removed:
let rec at i =
25
Removed:
if i + n > String.length string then false
26
Removed:
else if String.sub string i n = substring then true
27
Removed:
else at (i + 1)
28
Removed:
in
29
Removed:
at 0
30
Removed:
31
Removed:
(* --- a cookie-carrying client --- *)
32
Removed:
33
Removed:
(* Extract cookies (name=value) from all Set-Cookie response headers. *)
34
Removed:
let cookies_of response =
35
Removed:
Dream.headers response "Set-Cookie"
36
Removed:
|> List.filter_map (fun sc ->
37
Removed:
match String.index_opt sc ';' with
38
Removed:
| Some i -> Some (String.sub sc 0 i)
39
Removed:
| None -> Some sc)
40
Removed:
41
Removed:
type client = { app : Dream.handler; mutable jar : string list }
42
Removed:
43
Removed:
let client () = { app = app (); jar = [] }
44
Removed:
45
Removed:
let cookie_header client =
46
Removed:
if client.jar = [] then [] else [ ("Cookie", String.concat "; " client.jar) ]
47
Removed:
48
Removed:
let remember client response =
49
Removed:
(* Replace cookies of the same name; keep the rest. *)
50
Removed:
List.iter
51
Removed:
(fun fresh ->
52
Removed:
let name =
53
Removed:
match String.index_opt fresh '=' with
54
Removed:
| Some i -> String.sub fresh 0 i
55
Removed:
| None -> fresh
56
Removed:
in
57
Removed:
client.jar <-
58
Removed:
fresh
59
Removed:
:: List.filter
60
Removed:
(fun old ->
61
Removed:
not
62
Removed:
(String.length old >= String.length name
63
Removed:
&& String.sub old 0 (String.length name) = name
64
Removed:
&& (String.length old = String.length name
65
Removed:
|| old.[String.length name] = '=')))
66
Removed:
client.jar)
67
Removed:
(cookies_of response)
68
Removed:
69
Removed:
let get client target =
70
Removed:
let response =
71
Removed:
Dream.test client.app
72
Removed:
(Dream.request ~method_:`GET ~target ~headers:(cookie_header client) "")
73
Removed:
in
74
Removed:
remember client response;
75
Removed:
response
76
Removed:
77
Removed:
let post client target fields =
78
Removed:
let body =
79
Removed:
fields
80
Removed:
|> List.map (fun (k, v) ->
81
Removed:
Dream.to_percent_encoded k ^ "=" ^ Dream.to_percent_encoded v)
82
Removed:
|> String.concat "&"
83
Removed:
in
84
Removed:
let response =
85
Removed:
Dream.test client.app
86
Removed:
(Dream.request ~method_:`POST ~target
87
Removed:
~headers:
88
Removed:
(("Content-Type", "application/x-www-form-urlencoded")
89
Removed:
:: cookie_header client)
90
Removed:
body)
91
Removed:
in
92
Removed:
remember client response;
93
Removed:
response
94
Removed:
95
Removed:
(* A tiny substring search, since Str is not a dependency here. *)
96
Removed:
let index_from ~needle haystack start =
97
Removed:
let n = String.length needle and h = String.length haystack in
98
Removed:
let rec at i =
99
Removed:
if i + n > h then None
100
Removed:
else if String.sub haystack i n = needle then Some i
101
Removed:
else at (i + 1)
102
Removed:
in
103
Removed:
if start < 0 then None else at start
104
Removed:
105
Removed:
(* Pull the CSRF token value out of a rendered form. *)
106
Removed:
let csrf_token html =
107
Removed:
match index_from ~needle:"name=\"dream.csrf\"" html 0 with
108
Removed:
| None -> None
109
Removed:
| Some idx -> (
110
Removed:
match index_from ~needle:"value=\"" html idx with
111
Removed:
| None -> None
112
Removed:
| Some v ->
113
Removed:
let start = v + String.length "value=\"" in
114
Removed:
let stop = String.index_from html start '"' in
115
Removed:
Some (String.sub html start (stop - start)))
116
Removed:
117
Removed:
let register client ~username ~password =
118
Removed:
let page = body (get client "/register") in
119
Removed:
let token = Option.get (csrf_token page) in
120
Removed:
post client "/register"
121
Removed:
[ ("dream.csrf", token); ("username", username); ("password", password) ]
122
Removed:
123
Removed:
let sign_in_new client =
124
Removed:
register client ~username:"lifter" ~password:"heavyduty1"
125
Removed:
126
Removed:
(* Sign in through the credential form, as a returning trainee would. Unlike
127
Removed:
[register], this exercises the [POST /login] path. *)
128
Removed:
let sign_in client ~username ~password =
129
Removed:
let page = body (get client "/login") in
130
Removed:
let token = Option.get (csrf_token page) in
131
Removed:
post client "/login"
132
Removed:
[ ("dream.csrf", token); ("username", username); ("password", password) ]
133
Removed:
134
Removed:
(* An application whose clock the test drives. A shared [Memory_repo] and a
135
Removed:
mutable [now] cell let a deep test advance time across the recovery gate,
136
Removed:
which the wall-clock default cannot. Registration is open so the test can
137
Removed:
create the trainee it drives. *)
138
Removed:
let clocked_client () =
139
Removed:
let now = ref 0 in
140
Removed:
let handlers =
141
Removed:
Handlers.make ~repo:(Memory_repo.create ())
142
Removed:
~now:(fun () -> Recovery.timestamp_of_unix_seconds !now)
143
Removed:
~registration_open:true ()
144
Removed:
in
145
Removed:
let app =
146
Removed:
Dream.memory_sessions @@ Dream.router (Handlers.routes handlers) |> fun h ->
147
Removed:
Dream.set_secret "test-secret-value" h
148
Removed:
in
149
Removed:
({ app; jar = [] }, now)
150
Removed:
151
Removed:
let day n = n * 86_400
152
Removed:
153
Removed:
(* Drive a trainee to the start of a fresh Day 1 workout: select the ideal
154
Removed:
routine and begin without an override. Returns the client. *)
155
Removed:
let start_day_one c =
156
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
157
Removed:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
158
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
159
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
160
Removed:
161
Removed:
(* Record every slot of the in-progress Day 1 workout, one at a time, addressed
162
Removed:
by [?slot=]. Slot 0 is the flyes/incline-press pair; slot 3 is the
163
Removed:
french-press/dips pair; slots 1 and 2 are single lateral movements. *)
164
Removed:
let record_all_day_one_slots c =
165
Removed:
let record_pair slot comp_load =
166
Removed:
let token =
167
Removed:
Option.get (csrf_token (body (get c ("/workout?slot=" ^ slot))))
168
Removed:
in
169
Removed:
post c ("/workout/slots/" ^ slot)
170
Removed:
[
171
Removed:
("dream.csrf", token);
172
Removed:
("iso_load", "20");
173
Removed:
("iso_reps", "9");
174
Removed:
("comp_load", comp_load);
175
Removed:
("comp_reps", "7");
176
Removed:
("extension", "");
177
Removed:
]
178
Removed:
in
179
Removed:
let record_single slot load reps =
180
Removed:
let token =
181
Removed:
Option.get (csrf_token (body (get c ("/workout?slot=" ^ slot))))
182
Removed:
in
183
Removed:
post c ("/workout/slots/" ^ slot)
184
Removed:
[
185
Removed:
("dream.csrf", token); ("load", load); ("reps", reps); ("extension", "");
186
Removed:
]
187
Removed:
in
188
Removed:
let _ = record_pair "0" "60" in
189
Removed:
let _ = record_single "1" "12" "8" in
190
Removed:
let _ = record_single "2" "10" "9" in
191
Removed:
let _ = record_pair "3" "0" in
192
Removed:
()
193
Removed:
194
Removed:
let route_tests =
195
Removed:
[
196
Removed:
( "web.layout",
197
Removed:
[
198
Removed:
( "the desktop main surface is narrower than the shell",
199
Removed:
`Quick,
200
Removed:
fun () ->
201
Removed:
let c = client () in
202
Removed:
let stylesheet = body (get c "/assets/hito.css") in
203
Removed:
Alcotest.(check bool)
204
Removed:
"desktop page surface cap" true
205
Removed:
(contains ~substring:"@media (min-width: 42.0625rem)" stylesheet
206
Removed:
&& contains ~substring:"max-width: 52rem" stylesheet
207
Removed:
&& contains ~substring:"margin-inline: auto" stylesheet) );
208
Removed:
] );
209
Removed:
( "web.auth",
210
Removed:
[
211
Removed:
( "an unauthenticated visit to the overview redirects to sign-in",
212
Removed:
`Quick,
213
Removed:
fun () ->
214
Removed:
let c = client () in
215
Removed:
let response = get c "/" in
216
Removed:
Alcotest.(check int) "redirect" 303 (status response) );
217
Removed:
( "the sign-in page renders a CSRF-protected form",
218
Removed:
`Quick,
219
Removed:
fun () ->
220
Removed:
let c = client () in
221
Removed:
let page = body (get c "/login") in
222
Removed:
Alcotest.(check bool)
223
Removed:
"has csrf field" true
224
Removed:
(contains ~substring:"dream.csrf" page);
225
Removed:
Alcotest.(check bool)
226
Removed:
"has a password field" true
227
Removed:
(contains ~substring:"type=\"password\"" page);
228
Removed:
Alcotest.(check bool)
229
Removed:
"starts the main content with a page-level heading" true
230
Removed:
(contains ~substring:"<h1>Sign in</h1>" page);
231
Removed:
Alcotest.(check bool)
232
Removed:
"loads the app client and marks the sign-in form" true
233
Removed:
(contains ~substring:"data-hito-app-shell" page
234
Removed:
&& contains ~substring:"data-hito-app-form" page
235
Removed:
&& contains ~substring:"/assets/workout-client.js" page);
236
Removed:
Alcotest.(check bool)
237
Removed:
"offers a skip link to the main landmark" true
238
Removed:
(contains ~substring:"skip-link" page
239
Removed:
&& contains ~substring:"href=\"#main-content\"" page
240
Removed:
&& contains ~substring:"id=\"main-content\"" page) );
241
Removed:
( "registration signs the trainee in and reaches the overview",
242
Removed:
`Quick,
243
Removed:
fun () ->
244
Removed:
let c = client () in
245
Removed:
let registered = sign_in_new c in
246
Removed:
Alcotest.(check int)
247
Removed:
"registered, redirected" 303 (status registered);
248
Removed:
let overview = get c "/" in
249
Removed:
Alcotest.(check int) "authenticated overview" 200 (status overview);
250
Removed:
Alcotest.(check bool)
251
Removed:
"shows the routine catalog" true
252
Removed:
(contains ~substring:"Routines" (body overview));
253
Removed:
Alcotest.(check bool)
254
Removed:
"starts the overview with a page-level heading" true
255
Removed:
(contains ~substring:"<h1>Routines</h1>" (body overview));
256
Removed:
Alcotest.(check bool)
257
Removed:
"labels the logbook tab Logbook" true
258
Removed:
(contains ~substring:">Logbook</a>" (body overview));
259
Removed:
Alcotest.(check bool)
260
Removed:
"shows the username on a profile drop-down control" true
261
Removed:
(contains ~substring:"class=\"profile-menu\"" (body overview)
262
Removed:
&& contains ~substring:"<summary class=\"profile\""
263
Removed:
(body overview)
264
Removed:
&& contains ~substring:">lifter</summary>" (body overview));
265
Removed:
Alcotest.(check bool)
266
Removed:
"the drop-down offers Profile and Settings, both to /profile" true
267
Removed:
(contains ~substring:">Profile</a>" (body overview)
268
Removed:
&& contains ~substring:">Settings</a>" (body overview)
269
Removed:
&& contains ~substring:"href=\"/profile\"" (body overview));
270
Removed:
Alcotest.(check bool)
271
Removed:
"the drop-down offers Sign out" true
272
Removed:
(contains ~substring:"value=\"Sign out\"" (body overview));
273
Removed:
Alcotest.(check bool)
274
Removed:
"omits the header username" false
275
Removed:
(contains ~substring:"account-username" (body overview));
276
Removed:
Alcotest.(check bool)
277
Removed:
"declares the document language" true
278
Removed:
(contains ~substring:"<html lang=\"en\">" (body overview));
279
Removed:
Alcotest.(check bool)
280
Removed:
"marks the overview as the current navigation destination" true
281
Removed:
(contains ~substring:"aria-current=\"page\"" (body overview));
282
Removed:
Alcotest.(check bool)
283
Removed:
"shows primary navigation" true
284
Removed:
(contains ~substring:"primary-nav" (body overview));
285
Removed:
Alcotest.(check bool)
286
Removed:
"shows bottom navigation" true
287
Removed:
(contains ~substring:"bottom-nav" (body overview)) );
288
Removed:
( "authenticated pages carry inline nav and a header sign-out",
289
Removed:
`Quick,
290
Removed:
fun () ->
291
Removed:
let c = client () in
292
Removed:
let _ = sign_in_new c in
293
Removed:
let page = body (get c "/") in
294
Removed:
(* Inline affordances: the primary nav exists in the markup, and the
295
Removed:
sign-out form lives inside the profile drop-down, ready for
296
Removed:
responsive CSS to reveal or hide them. *)
297
Removed:
Alcotest.(check bool)
298
Removed:
"keeps the inline primary navigation" true
299
Removed:
(contains ~substring:"class=\"primary-nav\"" page);
300
Removed:
Alcotest.(check bool)
301
Removed:
"keeps the sign-out inside the profile menu" true
302
Removed:
(contains ~substring:"class=\"profile-menu\"" page
303
Removed:
&& contains ~substring:"value=\"Sign out\"" page);
304
Removed:
(* No hamburger menu at any width: the disclosure and its classes
305
Removed:
are gone. *)
306
Removed:
Alcotest.(check bool)
307
Removed:
"renders no hamburger menu" false
308
Removed:
(contains ~substring:"class=\"menu\"" page);
309
Removed:
Alcotest.(check bool)
310
Removed:
"renders no menu toggle" false
311
Removed:
(contains ~substring:"menu-toggle" page);
312
Removed:
Alcotest.(check bool)
313
Removed:
"renders no menu panel" false
314
Removed:
(contains ~substring:"menu-panel" page) );
315
Removed:
( "the header sign-out is a CSRF-protected control",
316
Removed:
`Quick,
317
Removed:
fun () ->
318
Removed:
let c = client () in
319
Removed:
let _ = sign_in_new c in
320
Removed:
let page = body (get c "/") in
321
Removed:
(* Isolate the profile-menu panel so the assertions read the
322
Removed:
sign-out control rather than another form on the page. *)
323
Removed:
let account =
324
Removed:
let start =
325
Removed:
Option.get
326
Removed:
(index_from ~needle:"class=\"profile-menu-drawer\"" page 0)
327
Removed:
in
328
Removed:
let stop = Option.get (index_from ~needle:"</form>" page start) in
329
Removed:
String.sub page start (stop - start)
330
Removed:
in
331
Removed:
Alcotest.(check bool)
332
Removed:
"carries a sign-out form" true
333
Removed:
(contains ~substring:"action=\"/logout\"" account);
334
Removed:
Alcotest.(check bool)
335
Removed:
"the sign-out is CSRF-protected" true
336
Removed:
(contains ~substring:"dream.csrf" account);
337
Removed:
Alcotest.(check bool)
338
Removed:
"the sign-out is labelled" true
339
Removed:
(contains ~substring:"Sign out" account) );
340
Removed:
( "navigation offers three actions that toggle with logging",
341
Removed:
`Quick,
342
Removed:
fun () ->
343
Removed:
let c = client () in
344
Removed:
let _ = sign_in_new c in
345
Removed:
(* Not logging: the middle action is Routine, labelled "Routine",
346
Removed:
and no workout link is present. The three actions are Home,
347
Removed:
Routine, and the username history link. *)
348
Removed:
let idle = body (get c "/") in
349
Removed:
Alcotest.(check bool)
350
Removed:
"labels the home action" true
351
Removed:
(contains ~substring:">Home</a>" idle);
352
Removed:
Alcotest.(check bool)
353
Removed:
"offers the routine action when idle" true
354
Removed:
(contains ~substring:">Routine</a>" idle);
355
Removed:
Alcotest.(check bool)
356
Removed:
"hides the current workout action when idle" false
357
Removed:
(contains ~substring:">Current workout</a>" idle);
358
Removed:
(* Start a workout, then the middle action becomes Current workout,
359
Removed:
pointing at /workout, and the standalone Routine action is gone. *)
360
Removed:
let token = Option.get (csrf_token idle) in
361
Removed:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
362
Removed:
let home_page = body (get c "/") in
363
Removed:
let token = Option.get (csrf_token home_page) in
364
Removed:
let _ =
365
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
366
Removed:
in
367
Removed:
let logging = body (get c "/logbook") in
368
Removed:
Alcotest.(check bool)
369
Removed:
"swaps in the current workout action while logging" true
370
Removed:
(contains ~substring:">Current workout</a>" logging);
371
Removed:
Alcotest.(check bool)
372
Removed:
"drops the routine action while logging" false
373
Removed:
(contains ~substring:">Routine</a>" logging);
374
Removed:
(* Home shows an in-progress card that links to the current
375
Removed:
workout, rather than the recovery gate or the workout form. *)
376
Removed:
let home_logging = body (get c "/") in
377
Removed:
Alcotest.(check bool)
378
Removed:
"home shows the in-progress card while logging" true
379
Removed:
(contains ~substring:"in-progress-card" home_logging);
380
Removed:
Alcotest.(check bool)
381
Removed:
"the in-progress card links to the current workout" true
382
Removed:
(contains ~substring:"href=\"/workout\"" home_logging) );
383
Removed:
( "only the app shell carries the page class, so active state is single",
384
Removed:
`Quick,
385
Removed:
fun () ->
386
Removed:
(* Regression guard for the double-highlight bug: while a workout is
387
Removed:
in progress, the body must not carry a stale page- class. Only
388
Removed:
the app-shell div holds the page class, which the client replaces
389
Removed:
on navigation, so exactly one bottom-nav action can be active. *)
390
Removed:
let c = client () in
391
Removed:
let _ = sign_in_new c in
392
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
393
Removed:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
394
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
395
Removed:
let _ =
396
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
397
Removed:
in
398
Removed:
let logbook = body (get c "/logbook") in
399
Removed:
Alcotest.(check bool)
400
Removed:
"the body carries no page class" false
401
Removed:
(contains ~substring:"class=\"hito-app page-" logbook);
402
Removed:
Alcotest.(check bool)
403
Removed:
"the app shell marks the logbook page" true
404
Removed:
(contains ~substring:"app-shell page-logbook" logbook);
405
Removed:
Alcotest.(check bool)
406
Removed:
"the app shell does not also mark the workout page" false
407
Removed:
(contains ~substring:"app-shell page-workout" logbook) );
408
Removed:
( "auth pages omit the hamburger menu",
409
Removed:
`Quick,
410
Removed:
fun () ->
411
Removed:
let c = client () in
412
Removed:
let page = body (get c "/register") in
413
Removed:
Alcotest.(check bool)
414
Removed:
"no hamburger menu" false
415
Removed:
(contains ~substring:"class=\"menu\"" page) );
416
Removed:
( "the sign-in page renders a username field",
417
Removed:
`Quick,
418
Removed:
fun () ->
419
Removed:
let c = client () in
420
Removed:
let page = body (get c "/login") in
421
Removed:
Alcotest.(check bool)
422
Removed:
"has a username field" true
423
Removed:
(contains ~substring:"name=\"username\"" page) );
424
Removed:
( "auth pages omit navigation",
425
Removed:
`Quick,
426
Removed:
fun () ->
427
Removed:
let c = client () in
428
Removed:
let page = body (get c "/register") in
429
Removed:
Alcotest.(check bool)
430
Removed:
"no primary navigation" false
431
Removed:
(contains ~substring:"primary-nav" page);
432
Removed:
Alcotest.(check bool)
433
Removed:
"no bottom navigation" false
434
Removed:
(contains ~substring:"bottom-nav" page) );
435
Removed:
( "a form post without a CSRF token is refused",
436
Removed:
`Quick,
437
Removed:
fun () ->
438
Removed:
let c = client () in
439
Removed:
let _ = sign_in_new c in
440
Removed:
let response =
441
Removed:
post c "/routines/ideal/select" [ (* no dream.csrf *) ]
442
Removed:
in
443
Removed:
Alcotest.(check int)
444
Removed:
"redirects after the refused post" 303 (status response);
445
Removed:
let page = body (get c "/") in
446
Removed:
Alcotest.(check bool)
447
Removed:
"preserves the CSRF error as a toast" true
448
Removed:
(contains ~substring:"The submitted form is not valid." page) );
449
Removed:
( "registering a too-short username is refused with a message",
450
Removed:
`Quick,
451
Removed:
fun () ->
452
Removed:
let c = client () in
453
Removed:
let response = register c ~username:"abc" ~password:"heavyduty1" in
454
Removed:
Alcotest.(check int) "rejected" 400 (status response);
455
Removed:
Alcotest.(check bool)
456
Removed:
"explains the minimum length" true
457
Removed:
(contains ~substring:"at least 4 characters" (body response));
458
Removed:
Alcotest.(check bool)
459
Removed:
"announces the error" true
460
Removed:
(contains ~substring:"role=\"alert\"" (body response)) );
461
Removed:
( "registering a too-long username is refused with a message",
462
Removed:
`Quick,
463
Removed:
fun () ->
464
Removed:
let c = client () in
465
Removed:
let response =
466
Removed:
register c ~username:"abcdefghijklmnopqrstu"
467
Removed:
~password:"heavyduty1"
468
Removed:
in
469
Removed:
Alcotest.(check int) "rejected" 400 (status response);
470
Removed:
Alcotest.(check bool)
471
Removed:
"explains the maximum length" true
472
Removed:
(contains ~substring:"at most 20 characters" (body response)) );
473
Removed:
( "registering with a short password succeeds",
474
Removed:
`Quick,
475
Removed:
fun () ->
476
Removed:
let c = client () in
477
Removed:
let response = register c ~username:"lifter" ~password:"x" in
478
Removed:
Alcotest.(check int) "registered, redirected" 303 (status response);
479
Removed:
Alcotest.(check int)
480
Removed:
"authenticated overview" 200
481
Removed:
(status (get c "/")) );
482
Removed:
( "with registration closed the routes are gone and the link is hidden",
483
Removed:
`Quick,
484
Removed:
fun () ->
485
Removed:
(* The production default: [registration_open] unset. The
486
Removed:
[/register] routes are absent (404) and the sign-in page omits
487
Removed:
the Register link. *)
488
Removed:
let handlers = Handlers.make ~repo:(Memory_repo.create ()) () in
489
Removed:
let app =
490
Removed:
Dream.memory_sessions @@ Dream.router (Handlers.routes handlers)
491
Removed:
|> fun h -> Dream.set_secret "test-secret-value" h
492
Removed:
in
493
Removed:
let c = { app; jar = [] } in
494
Removed:
Alcotest.(check int)
495
Removed:
"GET /register is not found" 404
496
Removed:
(status (get c "/register"));
497
Removed:
let login = body (get c "/login") in
498
Removed:
Alcotest.(check bool)
499
Removed:
"no Register link on sign-in" false
500
Removed:
(contains ~substring:"href=\"/register\"" login) );
501
Removed:
] );
502
Removed:
( "web.flow",
503
Removed:
[
504
Removed:
( "a state-changing POST redirects and carries a flash to the GET",
505
Removed:
`Quick,
506
Removed:
fun () ->
507
Removed:
(* POST-redirect-GET: selecting a routine answers 303, and the
508
Removed:
success message rides a one-shot flash onto the redirected page
509
Removed:
rather than rendering inline on the POST response. *)
510
Removed:
let c = client () in
511
Removed:
let _ = sign_in_new c in
512
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
513
Removed:
let selection =
514
Removed:
post c "/routines/ideal/select" [ ("dream.csrf", token) ]
515
Removed:
in
516
Removed:
Alcotest.(check int) "selection redirects" 303 (status selection);
517
Removed:
Alcotest.(check bool)
518
Removed:
"the POST body renders no page" true
519
Removed:
(String.length (body selection) = 0
520
Removed:
|| not (contains ~substring:"<h1" (body selection)));
521
Removed:
let home_page = body (get c "/") in
522
Removed:
Alcotest.(check bool)
523
Removed:
"the redirected GET shows the flash toast" true
524
Removed:
(contains ~substring:"data-hito-toast" home_page
525
Removed:
&& contains ~substring:"Routine selected." home_page);
526
Removed:
let home_again = body (get c "/") in
527
Removed:
Alcotest.(check bool)
528
Removed:
"the flash is one-shot and gone on reload" false
529
Removed:
(contains ~substring:"Routine selected." home_again) );
530
Removed:
( "a signed-in trainee starts a workout and sees the exercise buttons",
531
Removed:
`Quick,
532
Removed:
fun () ->
533
Removed:
let c = client () in
534
Removed:
let _ = sign_in_new c in
535
Removed:
let select_page = body (get c "/") in
536
Removed:
Alcotest.(check bool)
537
Removed:
"enhances authenticated overview navigation" true
538
Removed:
(contains ~substring:"data-hito-app-link" select_page
539
Removed:
&& contains ~substring:"data-hito-app-content" select_page
540
Removed:
&& contains ~substring:"data-hito-page-title" select_page
541
Removed:
&& contains ~substring:"/assets/workout-client.js" select_page);
542
Removed:
Alcotest.(check bool)
543
Removed:
"marks routine selection for in-place submission" true
544
Removed:
(contains ~substring:"data-hito-app-form" select_page);
545
Removed:
let token = Option.get (csrf_token select_page) in
546
Removed:
let selection =
547
Removed:
post c "/routines/ideal/select" [ ("dream.csrf", token) ]
548
Removed:
in
549
Removed:
Alcotest.(check int) "routine selected" 303 (status selection);
550
Removed:
let home_page = body (get c "/") in
551
Removed:
let token = Option.get (csrf_token home_page) in
552
Removed:
let started =
553
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
554
Removed:
in
555
Removed:
Alcotest.(check int) "workout started" 303 (status started);
556
Removed:
let workout_page = body (get c "/workout") in
557
Removed:
Alcotest.(check bool)
558
Removed:
"renders Day 1 as the page heading" true
559
Removed:
(contains ~substring:"<h1>Day 1</h1>" workout_page);
560
Removed:
Alcotest.(check bool)
561
Removed:
"renders an exercise dropdown selector" true
562
Removed:
(contains ~substring:"exercise-select" workout_page);
563
Removed:
(* The exercise label stays for screen readers but is visually
564
Removed:
hidden, so the dropdown reads without a redundant caption. *)
565
Removed:
Alcotest.(check bool)
566
Removed:
"keeps the exercise label for the select" true
567
Removed:
(contains ~substring:"for=\"exercise-choice\"" workout_page);
568
Removed:
Alcotest.(check bool)
569
Removed:
"hides the exercise label visually with sr-only" true
570
Removed:
(contains ~substring:"sr-only" workout_page);
571
Removed:
Alcotest.(check bool)
572
Removed:
"does not use the old tab strip class" false
573
Removed:
(contains ~substring:"slot-tab" workout_page);
574
Removed:
Alcotest.(check bool)
575
Removed:
"does not use the old button group class" false
576
Removed:
(contains ~substring:"exercise-group" workout_page);
577
Removed:
Alcotest.(check bool)
578
Removed:
"marks the exercise select for enhancement" true
579
Removed:
(contains ~substring:"data-hito-exercise-select" workout_page);
580
Removed:
Alcotest.(check bool)
581
Removed:
"preselects the active slot option" true
582
Removed:
(contains ~substring:"selected" workout_page);
583
Removed:
Alcotest.(check bool)
584
Removed:
"offers a later slot as a select option" true
585
Removed:
(contains ~substring:"value=\"1\"" workout_page);
586
Removed:
Alcotest.(check bool)
587
Removed:
"opens on the first slot's record form" true
588
Removed:
(contains ~substring:"/workout/slots/0" workout_page);
589
Removed:
Alcotest.(check bool)
590
Removed:
"marks the logging fieldset without a boulder top border" true
591
Removed:
(contains ~substring:"logging-fieldset" workout_page);
592
Removed:
Alcotest.(check bool)
593
Removed:
"marks the current workout as progressively enhanced" true
594
Removed:
(contains ~substring:"data-hito-workout" workout_page);
595
Removed:
Alcotest.(check bool)
596
Removed:
"marks the replaceable workout content" true
597
Removed:
(contains ~substring:"data-hito-workout-content" workout_page);
598
Removed:
Alcotest.(check bool)
599
Removed:
"marks the exercise form for enhancement" true
600
Removed:
(contains ~substring:"data-hito-exercise-form" workout_page);
601
Removed:
Alcotest.(check bool)
602
Removed:
"marks record forms while retaining their CSRF field" true
603
Removed:
(contains ~substring:"data-hito-workout-form" workout_page
604
Removed:
&& contains ~substring:"dream.csrf" workout_page);
605
Removed:
Alcotest.(check bool)
606
Removed:
"loads only the workout client" true
607
Removed:
(contains ~substring:"/assets/workout-client.js" workout_page);
608
Removed:
let asset = get c "/assets/workout-client.js" in
609
Removed:
Alcotest.(check int) "serves the workout client" 200 (status asset);
610
Removed:
Alcotest.(check bool)
611
Removed:
"client has JavaScript content type" true
612
Removed:
(List.mem "application/javascript; charset=utf-8"
613
Removed:
(Dream.headers asset "Content-Type")) );
614
Removed:
( "the routine page lists workouts in a basic table",
615
Removed:
`Quick,
616
Removed:
fun () ->
617
Removed:
let c = client () in
618
Removed:
let _ = sign_in_new c in
619
Removed:
let selection_page = body (get c "/") in
620
Removed:
let token = Option.get (csrf_token selection_page) in
621
Removed:
let selection =
622
Removed:
post c "/routines/ideal/select" [ ("dream.csrf", token) ]
623
Removed:
in
624
Removed:
Alcotest.(check int) "routine selected" 303 (status selection);
625
Removed:
let page = body (get c "/routine") in
626
Removed:
(* The masthead profile menu is a <details>; scope the accordion
627
Removed:
check to the main content so it reads the routine, not the
628
Removed:
masthead. *)
629
Removed:
let content =
630
Removed:
match index_from ~needle:"id=\"main-content\"" page 0 with
631
Removed:
| Some start -> String.sub page start (String.length page - start)
632
Removed:
| None -> page
633
Removed:
in
634
Removed:
Alcotest.(check bool)
635
Removed:
"uses a table" true
636
Removed:
(contains ~substring:"<table" page);
637
Removed:
Alcotest.(check bool)
638
Removed:
"no longer uses details accordions" false
639
Removed:
(contains ~substring:"<details" content);
640
Removed:
Alcotest.(check bool)
641
Removed:
"heads the workout column" true
642
Removed:
(contains ~substring:"Workout" page);
643
Removed:
Alcotest.(check bool)
644
Removed:
"names Day 1 as a row" true
645
Removed:
(contains ~substring:"Day 1" page);
646
Removed:
Alcotest.(check bool)
647
Removed:
"includes prescription" true
648
Removed:
(contains ~substring:"Dumbbell Flyes into Incline Presses" page);
649
Removed:
Alcotest.(check bool)
650
Removed:
"heads an exercise column" true
651
Removed:
(contains ~substring:"Exercise" page);
652
Removed:
Alcotest.(check bool)
653
Removed:
"heads a reps column" true
654
Removed:
(contains ~substring:"Reps" page);
655
Removed:
Alcotest.(check bool)
656
Removed:
"gives each exercise its own sub-row" true
657
Removed:
(contains ~substring:"rowgroup" page);
658
Removed:
Alcotest.(check bool)
659
Removed:
"drops the stimuli count column" false
660
Removed:
(contains ~substring:"Stimuli" page);
661
Removed:
Alcotest.(check bool)
662
Removed:
"shows primary navigation" true
663
Removed:
(contains ~substring:"primary-nav" page);
664
Removed:
Alcotest.(check bool)
665
Removed:
"shows bottom navigation" true
666
Removed:
(contains ~substring:"bottom-nav" page) );
667
Removed:
( "effort forms lay the whole fieldset out in one responsive grid",
668
Removed:
`Quick,
669
Removed:
fun () ->
670
Removed:
let c = client () in
671
Removed:
let _ = sign_in_new c in
672
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
673
Removed:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
674
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
675
Removed:
let _ =
676
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
677
Removed:
in
678
Removed:
let page = body (get c "/workout") in
679
Removed:
Alcotest.(check bool)
680
Removed:
"wraps the fieldset in one shared grid" true
681
Removed:
(contains ~substring:"class=\"logging-grid\"" page);
682
Removed:
Alcotest.(check bool)
683
Removed:
"groups a movement's cells without a nested grid" true
684
Removed:
(contains ~substring:"class=\"movement\"" page);
685
Removed:
Alcotest.(check bool)
686
Removed:
"no longer uses a per-row exercise-fields grid" false
687
Removed:
(contains ~substring:"class=\"exercise-fields\"" page);
688
Removed:
Alcotest.(check bool)
689
Removed:
"still labels load" true
690
Removed:
(contains ~substring:"Load (kg)" page);
691
Removed:
Alcotest.(check bool)
692
Removed:
"hints the load field with its unit" true
693
Removed:
(contains ~substring:"placeholder=\"kg\"" page);
694
Removed:
Alcotest.(check bool)
695
Removed:
"hints the reps field" true
696
Removed:
(contains ~substring:"placeholder=\"reps\"" page);
697
Removed:
Alcotest.(check bool)
698
Removed:
"drops the redundant fieldset legend" false
699
Removed:
(contains ~substring:"<legend>" page) );
700
Removed:
( "a recorded slot can be corrected, replacing it rather than adding \
701
Removed:
volume",
702
Removed:
`Quick,
703
Removed:
fun () ->
704
Removed:
let c = client () in
705
Removed:
let _ = sign_in_new c in
706
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
707
Removed:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
708
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
709
Removed:
let _ =
710
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
711
Removed:
in
712
Removed:
(* Slot 1 is the single Laterals set. Open its tab, record it, then
713
Removed:
correct it — one slot at a time, addressed by [?slot=]. *)
714
Removed:
let page = body (get c "/workout?slot=1") in
715
Removed:
let token = Option.get (csrf_token page) in
716
Removed:
let recorded =
717
Removed:
post c "/workout/slots/1"
718
Removed:
[
719
Removed:
("dream.csrf", token);
720
Removed:
("load", "12");
721
Removed:
("reps", "8");
722
Removed:
("extension", "");
723
Removed:
]
724
Removed:
in
725
Removed:
Alcotest.(check int) "recorded" 303 (status recorded);
726
Removed:
(* The default view now opens on slot 0, not the recorded slot. *)
727
Removed:
let default_page = body (get c "/workout") in
728
Removed:
Alcotest.(check bool)
729
Removed:
"the default view does not show the recorded slot's edit form"
730
Removed:
false
731
Removed:
(contains ~substring:"/workout/slots/1/edit" default_page);
732
Removed:
Alcotest.(check bool)
733
Removed:
"counts one filled slot" true
734
Removed:
(contains ~substring:"1 of 4 recorded" default_page);
735
Removed:
(* The recorded slot's tab shows its correction form. *)
736
Removed:
let page = body (get c "/workout?slot=1") in
737
Removed:
Alcotest.(check bool)
738
Removed:
"shows a correction form for the slot" true
739
Removed:
(contains ~substring:"/workout/slots/1/edit" page);
740
Removed:
let token = Option.get (csrf_token page) in
741
Removed:
let corrected =
742
Removed:
post c "/workout/slots/1/edit"
743
Removed:
[
744
Removed:
("dream.csrf", token);
745
Removed:
("load", "16");
746
Removed:
("reps", "6");
747
Removed:
("extension", "");
748
Removed:
]
749
Removed:
in
750
Removed:
Alcotest.(check int) "corrected" 303 (status corrected);
751
Removed:
let page = body (get c "/workout?slot=1") in
752
Removed:
Alcotest.(check bool)
753
Removed:
"still one filled slot, not two" true
754
Removed:
(contains ~substring:"1 of 4 recorded" page);
755
Removed:
Alcotest.(check bool)
756
Removed:
"shows the corrected load" true
757
Removed:
(contains ~substring:"16" page) );
758
Removed:
( "a saved workout's slot can be corrected from the logbook view",
759
Removed:
`Quick,
760
Removed:
fun () ->
761
Removed:
let c = client () in
762
Removed:
let _ = sign_in_new c in
763
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
764
Removed:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
765
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
766
Removed:
let _ =
767
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
768
Removed:
in
769
Removed:
let token =
770
Removed:
Option.get (csrf_token (body (get c "/workout?slot=1")))
771
Removed:
in
772
Removed:
let _ =
773
Removed:
post c "/workout/slots/1"
774
Removed:
[
775
Removed:
("dream.csrf", token);
776
Removed:
("load", "12");
777
Removed:
("reps", "8");
778
Removed:
("extension", "");
779
Removed:
]
780
Removed:
in
781
Removed:
let token = Option.get (csrf_token (body (get c "/workout"))) in
782
Removed:
let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in
783
Removed:
(* The one saved workout is w1 for this trainee. Its recorded slot is
784
Removed:
reached through the same [?slot=] state. *)
785
Removed:
let record_page = body (get c "/logbook/w1?slot=1") in
786
Removed:
Alcotest.(check bool)
787
Removed:
"renders an exercise dropdown for the saved workout" true
788
Removed:
(contains ~substring:"exercise-select" record_page);
789
Removed:
Alcotest.(check bool)
790
Removed:
"does not use the old tab strip class" false
791
Removed:
(contains ~substring:"slot-tab" record_page);
792
Removed:
Alcotest.(check bool)
793
Removed:
"does not enhance the saved exercise selector" false
794
Removed:
(contains ~substring:"data-hito-exercise-form" record_page);
795
Removed:
Alcotest.(check bool)
796
Removed:
"does not mark saved history as replaceable workout content" false
797
Removed:
(contains ~substring:"data-hito-workout-content" record_page);
798
Removed:
Alcotest.(check bool)
799
Removed:
"marks saved history as generic app content" true
800
Removed:
(contains ~substring:"data-hito-app-content" record_page);
801
Removed:
Alcotest.(check bool)
802
Removed:
"loads the app client for saved history navigation" true
803
Removed:
(contains ~substring:"/assets/workout-client.js" record_page);
804
Removed:
Alcotest.(check bool)
805
Removed:
"enhances saved-slot corrections through the generic form path"
806
Removed:
true
807
Removed:
(contains ~substring:"data-hito-app-form" record_page);
808
Removed:
Alcotest.(check bool)
809
Removed:
"offers a saved-slot correction form" true
810
Removed:
(contains ~substring:"/logbook/w1/slots/1/edit" record_page);
811
Removed:
let token = Option.get (csrf_token record_page) in
812
Removed:
let corrected =
813
Removed:
post c "/logbook/w1/slots/1/edit"
814
Removed:
[
815
Removed:
("dream.csrf", token);
816
Removed:
("load", "20");
817
Removed:
("reps", "7");
818
Removed:
("extension", "");
819
Removed:
]
820
Removed:
in
821
Removed:
Alcotest.(check int) "corrected" 303 (status corrected);
822
Removed:
let record_page = body (get c "/logbook/w1?slot=1") in
823
Removed:
Alcotest.(check bool)
824
Removed:
"still one filled slot" true
825
Removed:
(contains ~substring:"1 of 4 recorded" record_page);
826
Removed:
Alcotest.(check bool)
827
Removed:
"shows the corrected load" true
828
Removed:
(contains ~substring:"20" record_page) );
829
Removed:
( "invalid workout fields identify and describe their errors",
830
Removed:
`Quick,
831
Removed:
fun () ->
832
Removed:
let c = client () in
833
Removed:
let _ = sign_in_new c in
834
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
835
Removed:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
836
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
837
Removed:
let _ =
838
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
839
Removed:
in
840
Removed:
let page = body (get c "/workout") in
841
Removed:
let token = Option.get (csrf_token page) in
842
Removed:
let invalid =
843
Removed:
post c "/workout/slots/0"
844
Removed:
[
845
Removed:
("dream.csrf", token);
846
Removed:
("iso_load", "not-a-number");
847
Removed:
("iso_reps", "8");
848
Removed:
("comp_load", "40");
849
Removed:
("comp_reps", "6");
850
Removed:
("extension", "");
851
Removed:
]
852
Removed:
in
853
Removed:
Alcotest.(check int) "invalid field redirects" 303 (status invalid);
854
Removed:
let invalid_page = body (get c "/workout") in
855
Removed:
Alcotest.(check bool)
856
Removed:
"preserves a useful invalid-input error as a toast" true
857
Removed:
(contains ~substring:"data-hito-toast" invalid_page
858
Removed:
&& contains ~substring:"role=\"status\"" invalid_page
859
Removed:
&& contains ~substring:"Enter a valid number." invalid_page
860
Removed:
&& not (contains ~substring:"error." invalid_page)) );
861
Removed:
( "the workout view shows one slot at a time and defaults to the first \
862
Removed:
incomplete slot",
863
Removed:
`Quick,
864
Removed:
fun () ->
865
Removed:
let c = client () in
866
Removed:
let _ = sign_in_new c in
867
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
868
Removed:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
869
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
870
Removed:
let _ =
871
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
872
Removed:
in
873
Removed:
(* Nothing recorded yet: the default view opens on slot 0 and shows
874
Removed:
only slot 0's record form, not slot 1's. *)
875
Removed:
let page = body (get c "/workout") in
876
Removed:
Alcotest.(check bool)
877
Removed:
"shows the first slot's form" true
878
Removed:
(contains ~substring:"action=\"/workout/slots/0\"" page);
879
Removed:
Alcotest.(check bool)
880
Removed:
"does not also show a later slot's form" false
881
Removed:
(contains ~substring:"action=\"/workout/slots/1\"" page);
882
Removed:
(* Record slot 0. The default now moves to the next incomplete slot,
883
Removed:
slot 1. *)
884
Removed:
let token = Option.get (csrf_token page) in
885
Removed:
let recorded =
886
Removed:
post c "/workout/slots/0"
887
Removed:
[
888
Removed:
("dream.csrf", token);
889
Removed:
("iso_load", "10");
890
Removed:
("iso_reps", "8");
891
Removed:
("comp_load", "40");
892
Removed:
("comp_reps", "6");
893
Removed:
("extension", "");
894
Removed:
]
895
Removed:
in
896
Removed:
Alcotest.(check int) "recorded slot 0" 303 (status recorded);
897
Removed:
let page = body (get c "/workout") in
898
Removed:
Alcotest.(check bool)
899
Removed:
"default now opens on slot 1's record form" true
900
Removed:
(contains ~substring:"action=\"/workout/slots/1\"" page) );
901
Removed:
( "signing out returns the trainee to the sign-in page",
902
Removed:
`Quick,
903
Removed:
fun () ->
904
Removed:
let c = client () in
905
Removed:
let _ = sign_in_new c in
906
Removed:
let page = body (get c "/") in
907
Removed:
let token = Option.get (csrf_token page) in
908
Removed:
let out = post c "/logout" [ ("dream.csrf", token) ] in
909
Removed:
Alcotest.(check int) "logout redirect" 303 (status out);
910
Removed:
let after = get c "/" in
911
Removed:
Alcotest.(check int) "overview now redirects" 303 (status after) );
912
Removed:
( "the current workout offers a CSRF-protected cancel control",
913
Removed:
`Quick,
914
Removed:
fun () ->
915
Removed:
let c = client () in
916
Removed:
let _ = sign_in_new c in
917
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
918
Removed:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
919
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
920
Removed:
let _ =
921
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
922
Removed:
in
923
Removed:
let page = body (get c "/workout") in
924
Removed:
Alcotest.(check bool)
925
Removed:
"posts to the cancel route" true
926
Removed:
(contains ~substring:"action=\"/workout/cancel\"" page);
927
Removed:
Alcotest.(check bool)
928
Removed:
"labels the control Cancel logging" true
929
Removed:
(contains ~substring:"Cancel logging" page);
930
Removed:
Alcotest.(check bool)
931
Removed:
"renders it as a secondary submit" true
932
Removed:
(contains ~substring:"class=\"secondary\"" page);
933
Removed:
Alcotest.(check bool)
934
Removed:
"carries a confirmation modal for cancellation" true
935
Removed:
(contains ~substring:"data-hito-confirm-modal" page);
936
Removed:
Alcotest.(check bool)
937
Removed:
"marks the cancel form for confirmation" true
938
Removed:
(contains ~substring:"data-hito-confirm-form" page);
939
Removed:
Alcotest.(check bool)
940
Removed:
"uses native navigation after confirmation" true
941
Removed:
(contains ~substring:"data-hito-cancel-form" page);
942
Removed:
(* The modal copy must match the discard semantics: cancelling
943
Removed:
leaves no record. It must not promise a saved, editable entry,
944
Removed:
which would tell the user the workout was not really cancelled. *)
945
Removed:
Alcotest.(check bool)
946
Removed:
"warns that the workout is discarded" true
947
Removed:
(contains ~substring:"discarded and leaves no record" page);
948
Removed:
Alcotest.(check bool)
949
Removed:
"does not promise a saved editable entry" false
950
Removed:
(contains ~substring:"saved as a partial logbook entry" page) );
951
Removed:
( "the current workout shows a sticky timer bar",
952
Removed:
`Quick,
953
Removed:
fun () ->
954
Removed:
let c = client () in
955
Removed:
let _ = sign_in_new c in
956
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
957
Removed:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
958
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
959
Removed:
let _ =
960
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
961
Removed:
in
962
Removed:
let page = body (get c "/workout") in
963
Removed:
Alcotest.(check bool)
964
Removed:
"renders the timer bar while logging" true
965
Removed:
(contains ~substring:"data-hito-workout-timer" page);
966
Removed:
Alcotest.(check bool)
967
Removed:
"carries the workout start epoch" true
968
Removed:
(contains ~substring:"data-started=" page);
969
Removed:
let client_script = body (get c "/assets/workout-client.js") in
970
Removed:
Alcotest.(check bool)
971
Removed:
"serves the DOM-ready timer startup hook" true
972
Removed:
(contains ~substring:"DOMContentLoaded" client_script) );
973
Removed:
( "cancelling a workout without a CSRF token leaves the view cleanly",
974
Removed:
`Quick,
975
Removed:
fun () ->
976
Removed:
let c = client () in
977
Removed:
let _ = sign_in_new c in
978
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
979
Removed:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
980
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
981
Removed:
let _ =
982
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
983
Removed:
in
984
Removed:
let response = post c "/workout/cancel" [ (* no dream.csrf *) ] in
985
Removed:
(* No invalid-form response: cancelling always navigates away to
986
Removed:
Home. A forged or missing token skips the discard, so the
987
Removed:
workout remains in progress. *)
988
Removed:
Alcotest.(check int)
989
Removed:
"navigates away without an error page" 303 (status response);
990
Removed:
Alcotest.(check bool)
991
Removed:
"returns Home" true
992
Removed:
(List.mem "/" (Dream.headers response "Location"));
993
Removed:
Alcotest.(check int)
994
Removed:
"workout still in progress" 200
995
Removed:
(status (get c "/workout")) );
996
Removed:
( "cancelling after recording a set discards the workout",
997
Removed:
`Quick,
998
Removed:
fun () ->
999
Removed:
let c = client () in
1000
Removed:
let _ = sign_in_new c in
1001
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
1002
Removed:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
1003
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
1004
Removed:
let _ =
1005
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
1006
Removed:
in
1007
Removed:
(* Record the single Laterals set at slot 1. *)
1008
Removed:
let token =
1009
Removed:
Option.get (csrf_token (body (get c "/workout?slot=1")))
1010
Removed:
in
1011
Removed:
let recorded =
1012
Removed:
post c "/workout/slots/1"
1013
Removed:
[
1014
Removed:
("dream.csrf", token);
1015
Removed:
("load", "12");
1016
Removed:
("reps", "8");
1017
Removed:
("extension", "");
1018
Removed:
]
1019
Removed:
in
1020
Removed:
Alcotest.(check int) "recorded a set" 303 (status recorded);
1021
Removed:
(* Cancel with a valid token. It discards the in-progress workout
1022
Removed:
and returns Home. *)
1023
Removed:
let token = Option.get (csrf_token (body (get c "/workout"))) in
1024
Removed:
let cancelled =
1025
Removed:
post c "/workout/cancel" [ ("dream.csrf", token) ]
1026
Removed:
in
1027
Removed:
Alcotest.(check int) "cancel returns Home" 303 (status cancelled);
1028
Removed:
Alcotest.(check bool)
1029
Removed:
"returns Home, not the logbook" true
1030
Removed:
(List.mem "/" (Dream.headers cancelled "Location"));
1031
Removed:
(* No current workout: the workout view redirects away. *)
1032
Removed:
Alcotest.(check int)
1033
Removed:
"no workout in progress" 303
1034
Removed:
(status (get c "/workout"));
1035
Removed:
(* The workout left no record: an abandoned session is not
1036
Removed:
evidence, so the logbook holds nothing and no record opens. *)
1037
Removed:
let logbook_page = body (get c "/logbook") in
1038
Removed:
Alcotest.(check bool)
1039
Removed:
"logbook shows no saved workout" false
1040
Removed:
(contains ~substring:"/logbook/w1" logbook_page);
1041
Removed:
Alcotest.(check int)
1042
Removed:
"the discarded workout has no record" 404
1043
Removed:
(status (get c "/logbook/w1")) );
1044
Removed:
( "cancellation returns Home after discarding the workout",
1045
Removed:
`Quick,
1046
Removed:
fun () ->
1047
Removed:
let c = client () in
1048
Removed:
let _ = sign_in_new c in
1049
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
1050
Removed:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
1051
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
1052
Removed:
let _ =
1053
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
1054
Removed:
in
1055
Removed:
let token = Option.get (csrf_token (body (get c "/workout"))) in
1056
Removed:
let cancelled =
1057
Removed:
post c "/workout/cancel" [ ("dream.csrf", token) ]
1058
Removed:
in
1059
Removed:
Alcotest.(check bool)
1060
Removed:
"cancel redirects to Home" true
1061
Removed:
(List.mem "/" (Dream.headers cancelled "Location"));
1062
Removed:
let home_page = body (get c "/") in
1063
Removed:
Alcotest.(check bool)
1064
Removed:
"Home has no current workout card" false
1065
Removed:
(contains ~substring:"Workout in progress" home_page) );
1066
Removed:
( "the saved logbook view does not offer a cancel control",
1067
Removed:
`Quick,
1068
Removed:
fun () ->
1069
Removed:
let c = client () in
1070
Removed:
let _ = sign_in_new c in
1071
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
1072
Removed:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
1073
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
1074
Removed:
let _ =
1075
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
1076
Removed:
in
1077
Removed:
let token = Option.get (csrf_token (body (get c "/workout"))) in
1078
Removed:
let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in
1079
Removed:
let record_page = body (get c "/logbook/w1") in
1080
Removed:
Alcotest.(check bool)
1081
Removed:
"the saved view has no cancel route" false
1082
Removed:
(contains ~substring:"/workout/cancel" record_page);
1083
Removed:
Alcotest.(check bool)
1084
Removed:
"the saved view has no cancel label" false
1085
Removed:
(contains ~substring:"Cancel logging" record_page);
1086
Removed:
Alcotest.(check bool)
1087
Removed:
"shows primary navigation" true
1088
Removed:
(contains ~substring:"primary-nav" record_page);
1089
Removed:
Alcotest.(check bool)
1090
Removed:
"shows bottom navigation" true
1091
Removed:
(contains ~substring:"bottom-nav" record_page) );
1092
Removed:
( "the logbook opens sequential feedback in a modal",
1093
Removed:
`Quick,
1094
Removed:
fun () ->
1095
Removed:
let c = client () in
1096
Removed:
let _ = sign_in_new c in
1097
Removed:
let logbook_page = body (get c "/logbook") in
1098
Removed:
Alcotest.(check bool)
1099
Removed:
"still renders the feedback form" true
1100
Removed:
(contains ~substring:"feedback-form" logbook_page);
1101
Removed:
Alcotest.(check bool)
1102
Removed:
"offers a feedback modal trigger" true
1103
Removed:
(contains ~substring:"data-hito-feedback-open" logbook_page
1104
Removed:
&& contains ~substring:"Record feedback" logbook_page);
1105
Removed:
Alcotest.(check bool)
1106
Removed:
"renders a native feedback modal" true
1107
Removed:
(contains ~substring:"data-hito-feedback-modal" logbook_page);
1108
Removed:
Alcotest.(check bool)
1109
Removed:
"renders only the first factor initially" true
1110
Removed:
(contains ~substring:">Sleep</h3>" logbook_page
1111
Removed:
&& contains ~substring:"1 — very poor</span>" logbook_page
1112
Removed:
&& not (contains ~substring:">Appetite</h3>" logbook_page));
1113
Removed:
Alcotest.(check bool)
1114
Removed:
"renders a progress bar and factor skip" true
1115
Removed:
(contains ~substring:"<progress" logbook_page
1116
Removed:
&& contains ~substring:"1 of 5 factors" logbook_page
1117
Removed:
&& contains ~substring:"Skip this factor" logbook_page
1118
Removed:
&& contains ~substring:"Skip all feedback" logbook_page);
1119
Removed:
Alcotest.(check bool)
1120
Removed:
"does not render subjective selects" false
1121
Removed:
(contains ~substring:"<select" logbook_page) );
1122
Removed:
( "sequential feedback preserves answers and skips factors",
1123
Removed:
`Quick,
1124
Removed:
fun () ->
1125
Removed:
let c = client () in
1126
Removed:
let _ = sign_in_new c in
1127
Removed:
let start = body (get c "/logbook?feedback=start") in
1128
Removed:
Alcotest.(check bool)
1129
Removed:
"start opens the modal" true
1130
Removed:
(contains ~substring:"feedback-modal" start
1131
Removed:
&& contains ~substring:">Sleep</h3>" start);
1132
Removed:
let token = Option.get (csrf_token start) in
1133
Removed:
let next =
1134
Removed:
post c "/feedback"
1135
Removed:
[
1136
Removed:
("dream.csrf", token);
1137
Removed:
("step", "0");
1138
Removed:
("action", "next");
1139
Removed:
("choice", "1");
1140
Removed:
]
1141
Removed:
in
1142
Removed:
Alcotest.(check int) "first factor redirects" 303 (status next);
1143
Removed:
let appetite = body (get c "/logbook") in
1144
Removed:
Alcotest.(check bool)
1145
Removed:
"moves to appetite with progress" true
1146
Removed:
(contains ~substring:">Appetite</h3>" appetite
1147
Removed:
&& contains ~substring:"2 of 5 factors" appetite);
1148
Removed:
let token = Option.get (csrf_token appetite) in
1149
Removed:
let skipped =
1150
Removed:
post c "/feedback"
1151
Removed:
[ ("dream.csrf", token); ("step", "1"); ("action", "skip") ]
1152
Removed:
in
1153
Removed:
Alcotest.(check int) "factor skip redirects" 303 (status skipped);
1154
Removed:
let readiness = body (get c "/logbook") in
1155
Removed:
Alcotest.(check bool)
1156
Removed:
"skipping moves to the next factor" true
1157
Removed:
(contains ~substring:">Readiness</h3>" readiness
1158
Removed:
&& contains ~substring:"3 of 5 factors" readiness);
1159
Removed:
let token = Option.get (csrf_token readiness) in
1160
Removed:
ignore
1161
Removed:
(post c "/feedback"
1162
Removed:
[
1163
Removed:
("dream.csrf", token);
1164
Removed:
("step", "2");
1165
Removed:
("action", "next");
1166
Removed:
("choice", "3");
1167
Removed:
]);
1168
Removed:
let motivation = body (get c "/logbook") in
1169
Removed:
let token = Option.get (csrf_token motivation) in
1170
Removed:
ignore
1171
Removed:
(post c "/feedback"
1172
Removed:
[
1173
Removed:
("dream.csrf", token);
1174
Removed:
("step", "3");
1175
Removed:
("action", "next");
1176
Removed:
("choice", "5");
1177
Removed:
]);
1178
Removed:
let difficulty = body (get c "/logbook") in
1179
Removed:
let token = Option.get (csrf_token difficulty) in
1180
Removed:
let notes =
1181
Removed:
post c "/feedback"
1182
Removed:
[ ("dream.csrf", token); ("step", "4"); ("action", "skip") ]
1183
Removed:
in
1184
Removed:
Alcotest.(check int) "last factor skip redirects" 303 (status notes);
1185
Removed:
let notes_page = body (get c "/logbook") in
1186
Removed:
Alcotest.(check bool)
1187
Removed:
"shows optional observations after factors" true
1188
Removed:
(contains ~substring:">Anything else?</h3>" notes_page
1189
Removed:
&& contains ~substring:"5 of 5 factors" notes_page);
1190
Removed:
let token = Option.get (csrf_token notes_page) in
1191
Removed:
let saved =
1192
Removed:
post c "/feedback"
1193
Removed:
[
1194
Removed:
("dream.csrf", token);
1195
Removed:
("step", "5");
1196
Removed:
("action", "save");
1197
Removed:
("pain", "true");
1198
Removed:
]
1199
Removed:
in
1200
Removed:
Alcotest.(check int) "final feedback redirects" 303 (status saved);
1201
Removed:
let logbook_page = body (get c "/logbook") in
1202
Removed:
Alcotest.(check bool)
1203
Removed:
"stores answered factors and final observations" true
1204
Removed:
(contains ~substring:"Sleep 1 (very poor)" logbook_page
1205
Removed:
&& contains ~substring:"Readiness 3" logbook_page
1206
Removed:
&& contains ~substring:"Motivation 5 (very good)" logbook_page
1207
Removed:
&& contains ~substring:"Pain" logbook_page);
1208
Removed:
Alcotest.(check bool)
1209
Removed:
"does not store skipped factors" true
1210
Removed:
((not (contains ~substring:"Appetite" logbook_page))
1211
Removed:
&& not (contains ~substring:"Difficulty" logbook_page)) );
1212
Removed:
( "skipping the entire feedback flow records nothing",
1213
Removed:
`Quick,
1214
Removed:
fun () ->
1215
Removed:
let c = client () in
1216
Removed:
let _ = sign_in_new c in
1217
Removed:
let start = body (get c "/logbook?feedback=start") in
1218
Removed:
let token = Option.get (csrf_token start) in
1219
Removed:
let skipped = post c "/feedback/cancel" [ ("dream.csrf", token) ] in
1220
Removed:
Alcotest.(check int) "full-flow skip redirects" 303 (status skipped);
1221
Removed:
let logbook_page = body (get c "/logbook") in
1222
Removed:
Alcotest.(check bool)
1223
Removed:
"shows the skip notice" true
1224
Removed:
(contains ~substring:"Feedback skipped." logbook_page);
1225
Removed:
Alcotest.(check bool)
1226
Removed:
"does not add an empty report" false
1227
Removed:
(contains ~substring:"No signals" logbook_page) );
1228
Removed:
( "back returns to the previous factor and keeps answers",
1229
Removed:
`Quick,
1230
Removed:
fun () ->
1231
Removed:
let c = client () in
1232
Removed:
let _ = sign_in_new c in
1233
Removed:
let start = body (get c "/logbook?feedback=start") in
1234
Removed:
Alcotest.(check bool)
1235
Removed:
"the first factor offers no back control" false
1236
Removed:
(contains ~substring:"value=\"back\"" start);
1237
Removed:
let token = Option.get (csrf_token start) in
1238
Removed:
let _ =
1239
Removed:
post c "/feedback"
1240
Removed:
[
1241
Removed:
("dream.csrf", token);
1242
Removed:
("step", "0");
1243
Removed:
("action", "next");
1244
Removed:
("choice", "5");
1245
Removed:
]
1246
Removed:
in
1247
Removed:
let appetite = body (get c "/logbook") in
1248
Removed:
Alcotest.(check bool)
1249
Removed:
"the second factor offers a back control" true
1250
Removed:
(contains ~substring:">Appetite</h3>" appetite
1251
Removed:
&& contains ~substring:"value=\"back\"" appetite);
1252
Removed:
let token = Option.get (csrf_token appetite) in
1253
Removed:
let back =
1254
Removed:
post c "/feedback"
1255
Removed:
[ ("dream.csrf", token); ("step", "1"); ("action", "back") ]
1256
Removed:
in
1257
Removed:
Alcotest.(check int) "back redirects" 303 (status back);
1258
Removed:
let sleep_again = body (get c "/logbook") in
1259
Removed:
Alcotest.(check bool)
1260
Removed:
"back returns to the first factor" true
1261
Removed:
(contains ~substring:">Sleep</h3>" sleep_again
1262
Removed:
&& contains ~substring:"1 of 5 factors" sleep_again);
1263
Removed:
(* The earlier answer survives Back. Skipping forward from here
1264
Removed:
never touches it, so saving still stores the sleep signal. *)
1265
Removed:
let rec skip_to_notes page =
1266
Removed:
let token = Option.get (csrf_token page) in
1267
Removed:
let step_of =
1268
Removed:
if contains ~substring:">Sleep</h3>" page then 0
1269
Removed:
else if contains ~substring:">Appetite</h3>" page then 1
1270
Removed:
else if contains ~substring:">Readiness</h3>" page then 2
1271
Removed:
else if contains ~substring:">Motivation</h3>" page then 3
1272
Removed:
else if contains ~substring:">Perceived difficulty</h3>" page
1273
Removed:
then 4
1274
Removed:
else -1
1275
Removed:
in
1276
Removed:
if step_of < 0 then page
1277
Removed:
else begin
1278
Removed:
let _ =
1279
Removed:
post c "/feedback"
1280
Removed:
[
1281
Removed:
("dream.csrf", token);
1282
Removed:
("step", string_of_int step_of);
1283
Removed:
("action", "skip");
1284
Removed:
]
1285
Removed:
in
1286
Removed:
skip_to_notes (body (get c "/logbook"))
1287
Removed:
end
1288
Removed:
in
1289
Removed:
let notes = skip_to_notes sleep_again in
1290
Removed:
let token = Option.get (csrf_token notes) in
1291
Removed:
let _ =
1292
Removed:
post c "/feedback"
1293
Removed:
[ ("dream.csrf", token); ("step", "5"); ("action", "save") ]
1294
Removed:
in
1295
Removed:
let logbook_page = body (get c "/logbook") in
1296
Removed:
Alcotest.(check bool)
1297
Removed:
"the pre-back answer persists" true
1298
Removed:
(contains ~substring:"Sleep 5 (very good)" logbook_page) );
1299
Removed:
( "closing the feedback modal cancels the flow",
1300
Removed:
`Quick,
1301
Removed:
fun () ->
1302
Removed:
let c = client () in
1303
Removed:
let _ = sign_in_new c in
1304
Removed:
let start = body (get c "/logbook?feedback=start") in
1305
Removed:
(* Answer the first factor, then close: the flow is discarded and
1306
Removed:
reopening starts fresh at the first factor. *)
1307
Removed:
let token = Option.get (csrf_token start) in
1308
Removed:
let _ =
1309
Removed:
post c "/feedback"
1310
Removed:
[
1311
Removed:
("dream.csrf", token);
1312
Removed:
("step", "0");
1313
Removed:
("action", "next");
1314
Removed:
("choice", "5");
1315
Removed:
]
1316
Removed:
in
1317
Removed:
let appetite = body (get c "/logbook") in
1318
Removed:
let token = Option.get (csrf_token appetite) in
1319
Removed:
(* The close control posts to the cancel route. *)
1320
Removed:
let closed = post c "/feedback/cancel" [ ("dream.csrf", token) ] in
1321
Removed:
Alcotest.(check int) "close redirects" 303 (status closed);
1322
Removed:
let reopened = body (get c "/logbook?feedback=start") in
1323
Removed:
Alcotest.(check bool)
1324
Removed:
"reopening starts fresh at the first factor" true
1325
Removed:
(contains ~substring:">Sleep</h3>" reopened
1326
Removed:
&& contains ~substring:"1 of 5 factors" reopened) );
1327
Removed:
( "submitting feedback stores it and it appears on the logbook",
1328
Removed:
`Quick,
1329
Removed:
fun () ->
1330
Removed:
let c = client () in
1331
Removed:
let _ = sign_in_new c in
1332
Removed:
let start = body (get c "/logbook?feedback=start") in
1333
Removed:
let rec advance step page =
1334
Removed:
if step = 5 then page
1335
Removed:
else
1336
Removed:
let token = Option.get (csrf_token page) in
1337
Removed:
ignore
1338
Removed:
(post c "/feedback"
1339
Removed:
[
1340
Removed:
("dream.csrf", token);
1341
Removed:
("step", string_of_int step);
1342
Removed:
("action", "next");
1343
Removed:
("choice", if step = 0 then "1" else "skip");
1344
Removed:
]);
1345
Removed:
advance (step + 1) (body (get c "/logbook"))
1346
Removed:
in
1347
Removed:
let notes = advance 0 start in
1348
Removed:
let token = Option.get (csrf_token notes) in
1349
Removed:
let stored =
1350
Removed:
post c "/feedback"
1351
Removed:
[
1352
Removed:
("dream.csrf", token);
1353
Removed:
("step", "5");
1354
Removed:
("action", "save");
1355
Removed:
("pain", "true");
1356
Removed:
]
1357
Removed:
in
1358
Removed:
Alcotest.(check int) "feedback stored" 303 (status stored);
1359
Removed:
let logbook_page = body (get c "/logbook") in
1360
Removed:
Alcotest.(check bool)
1361
Removed:
"shows the reported sleep signal" true
1362
Removed:
(contains ~substring:"Sleep 1 (very poor)" logbook_page);
1363
Removed:
Alcotest.(check bool)
1364
Removed:
"shows the reported pain signal" true
1365
Removed:
(contains ~substring:"Pain" logbook_page) );
1366
Removed:
( "the logbook graphs leveled feedback once two reports exist",
1367
Removed:
`Quick,
1368
Removed:
fun () ->
1369
Removed:
let c = client () in
1370
Removed:
let _ = sign_in_new c in
1371
Removed:
(* Record one full feedback report: answer sleep, skip the rest. *)
1372
Removed:
let record_sleep score =
1373
Removed:
let start = body (get c "/logbook?feedback=start") in
1374
Removed:
let token = Option.get (csrf_token start) in
1375
Removed:
let _ =
1376
Removed:
post c "/feedback"
1377
Removed:
[
1378
Removed:
("dream.csrf", token);
1379
Removed:
("step", "0");
1380
Removed:
("action", "next");
1381
Removed:
("choice", score);
1382
Removed:
]
1383
Removed:
in
1384
Removed:
let rec skip step =
1385
Removed:
if step < 5 then begin
1386
Removed:
let token =
1387
Removed:
Option.get (csrf_token (body (get c "/logbook")))
1388
Removed:
in
1389
Removed:
let _ =
1390
Removed:
post c "/feedback"
1391
Removed:
[
1392
Removed:
("dream.csrf", token);
1393
Removed:
("step", string_of_int step);
1394
Removed:
("action", "skip");
1395
Removed:
]
1396
Removed:
in
1397
Removed:
skip (step + 1)
1398
Removed:
end
1399
Removed:
in
1400
Removed:
skip 1;
1401
Removed:
let token = Option.get (csrf_token (body (get c "/logbook"))) in
1402
Removed:
ignore
1403
Removed:
(post c "/feedback"
1404
Removed:
[ ("dream.csrf", token); ("step", "5"); ("action", "save") ])
1405
Removed:
in
1406
Removed:
(* One report: no graph yet, a single point is not a trend. *)
1407
Removed:
record_sleep "2";
1408
Removed:
let one = body (get c "/logbook") in
1409
Removed:
Alcotest.(check bool)
1410
Removed:
"no graph for a single report" false
1411
Removed:
(contains ~substring:"feedback-graph" one);
1412
Removed:
(* A second report: the graph appears with an SVG polyline. *)
1413
Removed:
record_sleep "4";
1414
Removed:
let two = body (get c "/logbook") in
1415
Removed:
Alcotest.(check bool)
1416
Removed:
"graphs feedback over time" true
1417
Removed:
(contains ~substring:"feedback-graph" two
1418
Removed:
&& contains ~substring:"<svg" two
1419
Removed:
&& contains ~substring:"<polyline" two
1420
Removed:
&& contains ~substring:"Feedback over time" two) );
1421
Removed:
( "finishing a workout suggests feedback on the logbook",
1422
Removed:
`Quick,
1423
Removed:
fun () ->
1424
Removed:
let c = client () in
1425
Removed:
let _ = sign_in_new c in
1426
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
1427
Removed:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
1428
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
1429
Removed:
let _ =
1430
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
1431
Removed:
in
1432
Removed:
let token = Option.get (csrf_token (body (get c "/workout"))) in
1433
Removed:
let finished = post c "/workout/finish" [ ("dream.csrf", token) ] in
1434
Removed:
Alcotest.(check int) "finish redirects" 303 (status finished);
1435
Removed:
Alcotest.(check bool)
1436
Removed:
"redirects to the logbook with a feedback prompt" true
1437
Removed:
(List.mem "/logbook?prompt=feedback"
1438
Removed:
(Dream.headers finished "Location"));
1439
Removed:
let prompted = body (get c "/logbook?prompt=feedback") in
1440
Removed:
Alcotest.(check bool)
1441
Removed:
"shows the feedback suggestion" true
1442
Removed:
(contains ~substring:"add feedback while it is fresh" prompted);
1443
Removed:
(* The gated form opens on a suggestion, so the prompt lands on a
1444
Removed:
visible form rather than a collapsed disclosure. *)
1445
Removed:
Alcotest.(check bool)
1446
Removed:
"opens the feedback modal on a suggestion" true
1447
Removed:
(contains ~substring:"data-hito-feedback-modal" prompted
1448
Removed:
&& contains ~substring:" open" prompted) );
1449
Removed:
( "beginning under override is gated behind a confirmation modal",
1450
Removed:
`Quick,
1451
Removed:
fun () ->
1452
Removed:
let c = client () in
1453
Removed:
let _ = sign_in_new c in
1454
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
1455
Removed:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
1456
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
1457
Removed:
let _ =
1458
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
1459
Removed:
in
1460
Removed:
let token = Option.get (csrf_token (body (get c "/workout"))) in
1461
Removed:
let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in
1462
Removed:
(* Recovery has not elapsed, so Home shows the override gate. The
1463
Removed:
begin form carries the shared confirm attributes and a matching
1464
Removed:
dialog, so the deviation is possible but never silent. *)
1465
Removed:
let home = body (get c "/") in
1466
Removed:
Alcotest.(check bool)
1467
Removed:
"still requires recovery" true
1468
Removed:
(contains ~substring:"requires recovery" home);
1469
Removed:
Alcotest.(check bool)
1470
Removed:
"gates the override submit behind the confirm machinery" true
1471
Removed:
(contains ~substring:"data-hito-confirm-cancel" home);
1472
Removed:
Alcotest.(check bool)
1473
Removed:
"posts the override through a confirm form" true
1474
Removed:
(contains ~substring:"data-hito-confirm-form" home);
1475
Removed:
Alcotest.(check bool)
1476
Removed:
"carries the confirmation modal" true
1477
Removed:
(contains ~substring:"data-hito-confirm-modal" home);
1478
Removed:
Alcotest.(check bool)
1479
Removed:
"still submits the override without script" true
1480
Removed:
(contains ~substring:"value=\"true\"" home) );
1481
Removed:
( "an overridden workout shows the early notice as a toast",
1482
Removed:
`Quick,
1483
Removed:
fun () ->
1484
Removed:
let c = client () in
1485
Removed:
let _ = sign_in_new c in
1486
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
1487
Removed:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
1488
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
1489
Removed:
let _ =
1490
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
1491
Removed:
in
1492
Removed:
let token = Option.get (csrf_token (body (get c "/workout"))) in
1493
Removed:
let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in
1494
Removed:
(* Recovery has not elapsed, so the next workout must be started
1495
Removed:
under override. *)
1496
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
1497
Removed:
let _ =
1498
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "true") ]
1499
Removed:
in
1500
Removed:
let workout = body (get c "/workout") in
1501
Removed:
Alcotest.(check bool)
1502
Removed:
"renders the notice as a toast" true
1503
Removed:
(contains ~substring:"data-hito-toast" workout);
1504
Removed:
Alcotest.(check bool)
1505
Removed:
"announces the toast politely" true
1506
Removed:
(contains ~substring:"role=\"status\"" workout);
1507
Removed:
Alcotest.(check bool)
1508
Removed:
"keeps the early-workout wording" true
1509
Removed:
(contains ~substring:"Begun before recovery finished." workout);
1510
Removed:
Alcotest.(check bool)
1511
Removed:
"no longer renders the notice as a plain warn block" false
1512
Removed:
(contains ~substring:"<div class=\"warn\">Begun before recovery"
1513
Removed:
workout) );
1514
Removed:
] );
1515
Removed:
( "web.app_feedback",
1516
Removed:
[
1517
Removed:
( "the header offers an app feedback button beside the profile control",
1518
Removed:
`Quick,
1519
Removed:
fun () ->
1520
Removed:
let c = client () in
1521
Removed:
let _ = sign_in_new c in
1522
Removed:
let page = body (get c "/") in
1523
Removed:
Alcotest.(check bool)
1524
Removed:
"renders the app feedback button" true
1525
Removed:
(contains ~substring:"class=\"app-feedback-button\"" page);
1526
Removed:
Alcotest.(check bool)
1527
Removed:
"links to the app feedback screen" true
1528
Removed:
(contains ~substring:"href=\"/app-feedback\"" page);
1529
Removed:
Alcotest.(check bool)
1530
Removed:
"labels the button Feedback" true
1531
Removed:
(contains ~substring:">Feedback</a>" page) );
1532
Removed:
( "the app feedback screen has write and submitted tabs",
1533
Removed:
`Quick,
1534
Removed:
fun () ->
1535
Removed:
let c = client () in
1536
Removed:
let _ = sign_in_new c in
1537
Removed:
let write_page = body (get c "/app-feedback") in
1538
Removed:
Alcotest.(check bool)
1539
Removed:
"starts with an app feedback heading" true
1540
Removed:
(contains ~substring:"<h1>App feedback</h1>" write_page);
1541
Removed:
Alcotest.(check bool)
1542
Removed:
"offers the write tab" true
1543
Removed:
(contains ~substring:"Write feedback" write_page);
1544
Removed:
Alcotest.(check bool)
1545
Removed:
"offers the submitted tab" true
1546
Removed:
(contains ~substring:"Submitted feedback" write_page);
1547
Removed:
Alcotest.(check bool)
1548
Removed:
"renders a freeform textarea" true
1549
Removed:
(contains ~substring:"id=\"app-feedback-message\"" write_page
1550
Removed:
&& contains ~substring:"<textarea" write_page);
1551
Removed:
Alcotest.(check bool)
1552
Removed:
"renders one primary submit action" true
1553
Removed:
(contains ~substring:"value=\"Submit feedback\"" write_page);
1554
Removed:
let submitted_page = body (get c "/app-feedback?tab=submitted") in
1555
Removed:
Alcotest.(check bool)
1556
Removed:
"submitted tab is selected" true
1557
Removed:
(contains ~substring:"href=\"/app-feedback?tab=submitted\""
1558
Removed:
submitted_page
1559
Removed:
&& contains ~substring:"You have not submitted" submitted_page) );
1560
Removed:
( "blank app feedback is refused and a submitted message is listed",
1561
Removed:
`Quick,
1562
Removed:
fun () ->
1563
Removed:
let c = client () in
1564
Removed:
let _ = sign_in_new c in
1565
Removed:
let page = body (get c "/app-feedback") in
1566
Removed:
let token = Option.get (csrf_token page) in
1567
Removed:
let blank =
1568
Removed:
post c "/app-feedback/submit"
1569
Removed:
[ ("dream.csrf", token); ("message", " ") ]
1570
Removed:
in
1571
Removed:
Alcotest.(check int) "blank message redirects" 303 (status blank);
1572
Removed:
Alcotest.(check bool)
1573
Removed:
"redirects to the write tab" true
1574
Removed:
(List.mem "/app-feedback?tab=write"
1575
Removed:
(Dream.headers blank "Location"));
1576
Removed:
let blank_page = body (get c "/app-feedback?tab=write") in
1577
Removed:
Alcotest.(check bool)
1578
Removed:
"preserves the validation error as a toast" true
1579
Removed:
(contains ~substring:"Enter feedback before submitting" blank_page);
1580
Removed:
let token =
1581
Removed:
Option.get (csrf_token (body (get c "/app-feedback")))
1582
Removed:
in
1583
Removed:
let submitted =
1584
Removed:
post c "/app-feedback/submit"
1585
Removed:
[
1586
Removed:
("dream.csrf", token);
1587
Removed:
("message", "The app is clear.\nThank you!");
1588
Removed:
]
1589
Removed:
in
1590
Removed:
Alcotest.(check int) "message is accepted" 303 (status submitted);
1591
Removed:
Alcotest.(check bool)
1592
Removed:
"redirects to submitted feedback" true
1593
Removed:
(List.mem "/app-feedback?tab=submitted"
1594
Removed:
(Dream.headers submitted "Location"));
1595
Removed:
let list_page = body (get c "/app-feedback?tab=submitted") in
1596
Removed:
Alcotest.(check bool)
1597
Removed:
"shows the success toast" true
1598
Removed:
(contains ~substring:"Feedback submitted." list_page);
1599
Removed:
Alcotest.(check bool)
1600
Removed:
"lists the submitted message" true
1601
Removed:
(contains ~substring:"The app is clear.\nThank you!" list_page);
1602
Removed:
Alcotest.(check bool)
1603
Removed:
"shows its timestamp" true
1604
Removed:
(contains ~substring:"app-feedback-time" list_page) );
1605
Removed:
( "feedback lists authors and accepts another user's vote",
1606
Removed:
`Quick,
1607
Removed:
fun () ->
1608
Removed:
let alice = client () in
1609
Removed:
let _ = sign_in_new alice in
1610
Removed:
let bob = { alice with jar = [] } in
1611
Removed:
let _ = register bob ~username:"bobby" ~password:"heavyduty1" in
1612
Removed:
let submit client message =
1613
Removed:
let page = body (get client "/app-feedback") in
1614
Removed:
let token = Option.get (csrf_token page) in
1615
Removed:
post client "/app-feedback/submit"
1616
Removed:
[ ("dream.csrf", token); ("message", message) ]
1617
Removed:
in
1618
Removed:
Alcotest.(check int)
1619
Removed:
"alice feedback accepted" 303
1620
Removed:
(status (submit alice "Alice report"));
1621
Removed:
Alcotest.(check int)
1622
Removed:
"bob feedback accepted" 303
1623
Removed:
(status (submit bob "Bob report"));
1624
Removed:
let list_page = body (get alice "/app-feedback?tab=submitted") in
1625
Removed:
Alcotest.(check bool)
1626
Removed:
"shows the author" true
1627
Removed:
(contains ~substring:"bobby — 1 contributions" list_page);
1628
Removed:
Alcotest.(check bool)
1629
Removed:
"shows the ranked vote control" true
1630
Removed:
(contains ~substring:"action=\"/app-feedback/t2:1/upvote\""
1631
Removed:
list_page);
1632
Removed:
let token = Option.get (csrf_token list_page) in
1633
Removed:
let voted =
1634
Removed:
post alice "/app-feedback/t2:1/upvote" [ ("dream.csrf", token) ]
1635
Removed:
in
1636
Removed:
Alcotest.(check int) "upvote redirects" 303 (status voted);
1637
Removed:
let ranked = body (get alice "/app-feedback?tab=submitted") in
1638
Removed:
Alcotest.(check bool)
1639
Removed:
"shows the vote count" true
1640
Removed:
(contains ~substring:"Upvotes: 1" ranked);
1641
Removed:
Alcotest.(check bool)
1642
Removed:
"marks the viewer's vote" true
1643
Removed:
(contains ~substring:"value=\"Upvoted\"" ranked);
1644
Removed:
let bob_page = body (get bob "/app-feedback?tab=submitted") in
1645
Removed:
Alcotest.(check bool)
1646
Removed:
"shows owner actions" true
1647
Removed:
(contains ~substring:"action=\"/app-feedback/t2:1/edit\"" bob_page
1648
Removed:
&& contains ~substring:"action=\"/app-feedback/t2:1/remove\""
1649
Removed:
bob_page);
1650
Removed:
Alcotest.(check bool)
1651
Removed:
"enhances owner actions through the app form path" true
1652
Removed:
(contains ~substring:"app-feedback-edit-form" bob_page
1653
Removed:
&& contains ~substring:"app-feedback-remove-form" bob_page
1654
Removed:
&& contains ~substring:"data-hito-app-form" bob_page);
1655
Removed:
let edit_token = Option.get (csrf_token bob_page) in
1656
Removed:
let blank =
1657
Removed:
post bob "/app-feedback/t2:1/edit"
1658
Removed:
[ ("dream.csrf", edit_token); ("message", " ") ]
1659
Removed:
in
1660
Removed:
Alcotest.(check int) "blank edit redirects" 303 (status blank);
1661
Removed:
let blank_page = body (get bob "/app-feedback?tab=submitted") in
1662
Removed:
Alcotest.(check bool)
1663
Removed:
"blank edit is refused" true
1664
Removed:
(contains ~substring:"Enter feedback before submitting."
1665
Removed:
blank_page
1666
Removed:
&& contains ~substring:"Bob report" blank_page);
1667
Removed:
let edit_token = Option.get (csrf_token blank_page) in
1668
Removed:
let edited =
1669
Removed:
post bob "/app-feedback/t2:1/edit"
1670
Removed:
[ ("dream.csrf", edit_token); ("message", "Edited report") ]
1671
Removed:
in
1672
Removed:
Alcotest.(check int) "edit redirects" 303 (status edited);
1673
Removed:
let edited_page = body (get bob "/app-feedback?tab=submitted") in
1674
Removed:
Alcotest.(check bool)
1675
Removed:
"shows edited feedback" true
1676
Removed:
(contains ~substring:"Edited report" edited_page);
1677
Removed:
let remove_token = Option.get (csrf_token edited_page) in
1678
Removed:
let removed =
1679
Removed:
post bob "/app-feedback/t2:1/remove"
1680
Removed:
[ ("dream.csrf", remove_token) ]
1681
Removed:
in
1682
Removed:
Alcotest.(check int) "remove redirects" 303 (status removed);
1683
Removed:
let after_remove = body (get bob "/app-feedback?tab=submitted") in
1684
Removed:
Alcotest.(check bool)
1685
Removed:
"removes the owner's feedback" false
1686
Removed:
(contains ~substring:"Edited report" after_remove) );
1687
Removed:
( "another trainee cannot edit or remove app feedback",
1688
Removed:
`Quick,
1689
Removed:
fun () ->
1690
Removed:
let alice = client () in
1691
Removed:
let _ = register alice ~username:"alice" ~password:"heavyduty1" in
1692
Removed:
let bob = { alice with jar = [] } in
1693
Removed:
let _ = register bob ~username:"bobby" ~password:"heavyduty1" in
1694
Removed:
let bob_page = body (get bob "/app-feedback") in
1695
Removed:
let token = Option.get (csrf_token bob_page) in
1696
Removed:
let _ =
1697
Removed:
post bob "/app-feedback/submit"
1698
Removed:
[ ("dream.csrf", token); ("message", "Bob owns this") ]
1699
Removed:
in
1700
Removed:
let alice_page = body (get alice "/app-feedback?tab=submitted") in
1701
Removed:
let token = Option.get (csrf_token alice_page) in
1702
Removed:
let edited =
1703
Removed:
post alice "/app-feedback/t2:1/edit"
1704
Removed:
[ ("dream.csrf", token); ("message", "Taken over") ]
1705
Removed:
in
1706
Removed:
Alcotest.(check int) "cross-user edit redirects" 303 (status edited);
1707
Removed:
let after_edit = body (get alice "/app-feedback?tab=submitted") in
1708
Removed:
Alcotest.(check bool)
1709
Removed:
"cross-user edit changes nothing" true
1710
Removed:
(contains ~substring:"Bob owns this" after_edit
1711
Removed:
&& not (contains ~substring:"Taken over" after_edit));
1712
Removed:
let token = Option.get (csrf_token after_edit) in
1713
Removed:
let removed =
1714
Removed:
post alice "/app-feedback/t2:1/remove" [ ("dream.csrf", token) ]
1715
Removed:
in
1716
Removed:
Alcotest.(check int)
1717
Removed:
"cross-user remove redirects" 303 (status removed);
1718
Removed:
let after_remove = body (get alice "/app-feedback?tab=submitted") in
1719
Removed:
Alcotest.(check bool)
1720
Removed:
"cross-user remove changes nothing" true
1721
Removed:
(contains ~substring:"Bob owns this" after_remove) );
1722
Removed:
] );
1723
Removed:
( "web.profile",
1724
Removed:
[
1725
Removed:
( "the profile page offers username and password forms",
1726
Removed:
`Quick,
1727
Removed:
fun () ->
1728
Removed:
let c = client () in
1729
Removed:
let _ = sign_in_new c in
1730
Removed:
let page = body (get c "/profile") in
1731
Removed:
Alcotest.(check bool)
1732
Removed:
"starts with a page heading" true
1733
Removed:
(contains ~substring:"<h1>Profile</h1>" page);
1734
Removed:
Alcotest.(check bool)
1735
Removed:
"posts a username change to its route" true
1736
Removed:
(contains ~substring:"action=\"/profile/username\"" page);
1737
Removed:
Alcotest.(check bool)
1738
Removed:
"posts a password change to its route" true
1739
Removed:
(contains ~substring:"action=\"/profile/password\"" page);
1740
Removed:
Alcotest.(check bool)
1741
Removed:
"prefills the current username" true
1742
Removed:
(contains ~substring:"value=\"lifter\"" page);
1743
Removed:
Alcotest.(check bool)
1744
Removed:
"asks for the current password" true
1745
Removed:
(contains ~substring:"name=\"current\"" page);
1746
Removed:
Alcotest.(check bool)
1747
Removed:
"shows the username value, not a bare field" true
1748
Removed:
(contains ~substring:"profile-value-text" page);
1749
Removed:
Alcotest.(check bool)
1750
Removed:
"offers a change-username button that opens a dialog" true
1751
Removed:
(contains ~substring:"data-hito-dialog-open=\"username-dialog\""
1752
Removed:
page);
1753
Removed:
Alcotest.(check bool)
1754
Removed:
"offers a change-password button that opens a dialog" true
1755
Removed:
(contains ~substring:"data-hito-dialog-open=\"password-dialog\""
1756
Removed:
page);
1757
Removed:
Alcotest.(check bool)
1758
Removed:
"wraps each edit form in a dialog" true
1759
Removed:
(contains ~substring:"<dialog id=\"username-dialog\"" page
1760
Removed:
&& contains ~substring:"<dialog id=\"password-dialog\"" page) );
1761
Removed:
( "changing the username updates the profile and the navigation",
1762
Removed:
`Quick,
1763
Removed:
fun () ->
1764
Removed:
let c = client () in
1765
Removed:
let _ = sign_in_new c in
1766
Removed:
let token = Option.get (csrf_token (body (get c "/profile"))) in
1767
Removed:
let changed =
1768
Removed:
post c "/profile/username"
1769
Removed:
[ ("dream.csrf", token); ("username", "athlete") ]
1770
Removed:
in
1771
Removed:
Alcotest.(check int)
1772
Removed:
"redirects after the change" 303 (status changed);
1773
Removed:
Alcotest.(check bool)
1774
Removed:
"redirects back to the profile with a notice" true
1775
Removed:
(List.mem "/profile?changed=username"
1776
Removed:
(Dream.headers changed "Location"));
1777
Removed:
let page = body (get c "/profile?changed=username") in
1778
Removed:
Alcotest.(check bool)
1779
Removed:
"confirms the change" true
1780
Removed:
(contains ~substring:"Username changed" page);
1781
Removed:
Alcotest.(check bool)
1782
Removed:
"shows the new name in the profile control" true
1783
Removed:
(contains ~substring:">athlete</summary>" page) );
1784
Removed:
( "a taken username is refused with an inline error",
1785
Removed:
`Quick,
1786
Removed:
fun () ->
1787
Removed:
let c = client () in
1788
Removed:
let _ = sign_in_new c in
1789
Removed:
(* Register a second account in the same store, via a client that
1790
Removed:
shares the app but keeps its own cookie jar. *)
1791
Removed:
let other = { c with jar = [] } in
1792
Removed:
let _ = register other ~username:"taken" ~password:"heavyduty1" in
1793
Removed:
let token = Option.get (csrf_token (body (get c "/profile"))) in
1794
Removed:
let refused =
1795
Removed:
post c "/profile/username"
1796
Removed:
[ ("dream.csrf", token); ("username", "taken") ]
1797
Removed:
in
1798
Removed:
Alcotest.(check int)
1799
Removed:
"renders an invalid response" 400 (status refused);
1800
Removed:
Alcotest.(check bool)
1801
Removed:
"explains the name is taken" true
1802
Removed:
(contains ~substring:"already registered" (body refused));
1803
Removed:
Alcotest.(check bool)
1804
Removed:
"opens the username dialog to show the error" true
1805
Removed:
(contains ~substring:"class=\"profile-dialog\" open"
1806
Removed:
(body refused)) );
1807
Removed:
( "changing the password requires the current one",
1808
Removed:
`Quick,
1809
Removed:
fun () ->
1810
Removed:
let c = client () in
1811
Removed:
let _ = sign_in_new c in
1812
Removed:
let token = Option.get (csrf_token (body (get c "/profile"))) in
1813
Removed:
let refused =
1814
Removed:
post c "/profile/password"
1815
Removed:
[
1816
Removed:
("dream.csrf", token);
1817
Removed:
("current", "wrongpass");
1818
Removed:
("next", "newsecret1");
1819
Removed:
]
1820
Removed:
in
1821
Removed:
Alcotest.(check int)
1822
Removed:
"renders an invalid response" 400 (status refused);
1823
Removed:
Alcotest.(check bool)
1824
Removed:
"explains the current password is wrong" true
1825
Removed:
(contains ~substring:"current password is not correct"
1826
Removed:
(body refused));
1827
Removed:
(* Now change it with the correct current password. *)
1828
Removed:
let token = Option.get (csrf_token (body (get c "/profile"))) in
1829
Removed:
let changed =
1830
Removed:
post c "/profile/password"
1831
Removed:
[
1832
Removed:
("dream.csrf", token);
1833
Removed:
("current", "heavyduty1");
1834
Removed:
("next", "newsecret1");
1835
Removed:
]
1836
Removed:
in
1837
Removed:
Alcotest.(check int)
1838
Removed:
"redirects after the change" 303 (status changed);
1839
Removed:
Alcotest.(check bool)
1840
Removed:
"redirects back to the profile with a notice" true
1841
Removed:
(List.mem "/profile?changed=password"
1842
Removed:
(Dream.headers changed "Location")) );
1843
Removed:
] );
1844
Removed:
( "web.errors",
1845
Removed:
[
1846
Removed:
( "an unknown path renders a branded 404 with navigation",
1847
Removed:
`Quick,
1848
Removed:
fun () ->
1849
Removed:
let c = client () in
1850
Removed:
let response = get c "/no-such-page" in
1851
Removed:
Alcotest.(check int) "responds 404" 404 (status response);
1852
Removed:
let page = body response in
1853
Removed:
Alcotest.(check bool)
1854
Removed:
"names the failure without leaking server detail" true
1855
Removed:
(contains ~substring:"Page not found" page);
1856
Removed:
Alcotest.(check bool)
1857
Removed:
"keeps the desktop top navigation" true
1858
Removed:
(contains ~substring:"primary-nav" page);
1859
Removed:
Alcotest.(check bool)
1860
Removed:
"keeps the mobile bottom navigation" true
1861
Removed:
(contains ~substring:"bottom-nav" page);
1862
Removed:
Alcotest.(check bool)
1863
Removed:
"offers a route back Home" true
1864
Removed:
(contains ~substring:"href=\"/\"" page) );
1865
Removed:
( "the 404 page never depends on a session",
1866
Removed:
`Quick,
1867
Removed:
fun () ->
1868
Removed:
(* No sign-in: an unauthenticated visitor still gets the branded
1869
Removed:
page and its navigation, not an empty body. *)
1870
Removed:
let c = client () in
1871
Removed:
let page = body (get c "/deep/unknown/path") in
1872
Removed:
Alcotest.(check bool)
1873
Removed:
"renders the branded page" true
1874
Removed:
(contains ~substring:"Page not found" page);
1875
Removed:
Alcotest.(check bool)
1876
Removed:
"shows navigation actions" true
1877
Removed:
(contains ~substring:"Logbook" page) );
1878
Removed:
] );
1879
Removed:
( "web.sign_in",
1880
Removed:
[
1881
Removed:
( "a returning trainee signs in with their credentials",
1882
Removed:
`Quick,
1883
Removed:
fun () ->
1884
Removed:
(* Register, then sign out, then sign back in through the credential
1885
Removed:
form. This exercises [POST /login], which registration's
1886
Removed:
auto-sign-in never touches. *)
1887
Removed:
let c = client () in
1888
Removed:
let _ = sign_in_new c in
1889
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
1890
Removed:
let _ = post c "/logout" [ ("dream.csrf", token) ] in
1891
Removed:
Alcotest.(check int)
1892
Removed:
"signed out, overview redirects" 303
1893
Removed:
(status (get c "/"));
1894
Removed:
let signed_in =
1895
Removed:
sign_in c ~username:"lifter" ~password:"heavyduty1"
1896
Removed:
in
1897
Removed:
Alcotest.(check int) "sign-in redirects" 303 (status signed_in);
1898
Removed:
Alcotest.(check bool)
1899
Removed:
"sign-in lands on Home" true
1900
Removed:
(List.mem "/" (Dream.headers signed_in "Location"));
1901
Removed:
Alcotest.(check int)
1902
Removed:
"authenticated overview" 200
1903
Removed:
(status (get c "/")) );
1904
Removed:
( "a wrong password is refused with an unauthorized message",
1905
Removed:
`Quick,
1906
Removed:
fun () ->
1907
Removed:
let c = client () in
1908
Removed:
let _ = sign_in_new c in
1909
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
1910
Removed:
let _ = post c "/logout" [ ("dream.csrf", token) ] in
1911
Removed:
let refused =
1912
Removed:
sign_in c ~username:"lifter" ~password:"not-the-password"
1913
Removed:
in
1914
Removed:
Alcotest.(check int) "rejected" 401 (status refused);
1915
Removed:
Alcotest.(check bool)
1916
Removed:
"explains the mismatch without leaking which field failed" true
1917
Removed:
(contains ~substring:"do not match" (body refused));
1918
Removed:
(* The rejected attempt establishes no session. *)
1919
Removed:
Alcotest.(check int)
1920
Removed:
"still unauthenticated" 303
1921
Removed:
(status (get c "/")) );
1922
Removed:
( "an unknown username is refused like a wrong password",
1923
Removed:
`Quick,
1924
Removed:
fun () ->
1925
Removed:
let c = client () in
1926
Removed:
let refused = sign_in c ~username:"nobody" ~password:"heavyduty1" in
1927
Removed:
Alcotest.(check int) "rejected" 401 (status refused);
1928
Removed:
Alcotest.(check bool)
1929
Removed:
"gives the same generic message" true
1930
Removed:
(contains ~substring:"do not match" (body refused)) );
1931
Removed:
( "an already-authenticated visit to the sign-in page redirects Home",
1932
Removed:
`Quick,
1933
Removed:
fun () ->
1934
Removed:
let c = client () in
1935
Removed:
let _ = sign_in_new c in
1936
Removed:
let response = get c "/login" in
1937
Removed:
Alcotest.(check int) "redirects" 303 (status response);
1938
Removed:
Alcotest.(check bool)
1939
Removed:
"sends an authenticated visitor Home" true
1940
Removed:
(List.mem "/" (Dream.headers response "Location")) );
1941
Removed:
( "an already-authenticated visit to the register page redirects Home",
1942
Removed:
`Quick,
1943
Removed:
fun () ->
1944
Removed:
let c = client () in
1945
Removed:
let _ = sign_in_new c in
1946
Removed:
let response = get c "/register" in
1947
Removed:
Alcotest.(check int) "redirects" 303 (status response);
1948
Removed:
Alcotest.(check bool)
1949
Removed:
"sends an authenticated visitor Home" true
1950
Removed:
(List.mem "/" (Dream.headers response "Location")) );
1951
Removed:
] );
1952
Removed:
( "web.routine_selection",
1953
Removed:
[
1954
Removed:
( "selecting an unknown routine is not found",
1955
Removed:
`Quick,
1956
Removed:
fun () ->
1957
Removed:
let c = client () in
1958
Removed:
let _ = sign_in_new c in
1959
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
1960
Removed:
let response =
1961
Removed:
post c "/routines/no-such-routine/select"
1962
Removed:
[ ("dream.csrf", token) ]
1963
Removed:
in
1964
Removed:
Alcotest.(check int) "responds 404" 404 (status response);
1965
Removed:
Alcotest.(check bool)
1966
Removed:
"names the missing routine" true
1967
Removed:
(contains ~substring:"not in the catalogue" (body response)) );
1968
Removed:
] );
1969
Removed:
( "web.saved_record_add",
1970
Removed:
[
1971
Removed:
( "an outstanding slot of a saved workout can be recorded, not only \
1972
Removed:
corrected",
1973
Removed:
`Quick,
1974
Removed:
fun () ->
1975
Removed:
(* Finish a workout with a single slot recorded, so the saved record
1976
Removed:
still has outstanding slots. Then record one of those through the
1977
Removed:
plain add path [POST /logbook/:id/slots/:d], which the edit tests
1978
Removed:
never exercise. *)
1979
Removed:
let c = client () in
1980
Removed:
let _ = sign_in_new c in
1981
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
1982
Removed:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
1983
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
1984
Removed:
let _ =
1985
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
1986
Removed:
in
1987
Removed:
(* Record only slot 1, then finish. Slots 0, 2, 3 stay outstanding. *)
1988
Removed:
let token =
1989
Removed:
Option.get (csrf_token (body (get c "/workout?slot=1")))
1990
Removed:
in
1991
Removed:
let _ =
1992
Removed:
post c "/workout/slots/1"
1993
Removed:
[
1994
Removed:
("dream.csrf", token);
1995
Removed:
("load", "12");
1996
Removed:
("reps", "8");
1997
Removed:
("extension", "");
1998
Removed:
]
1999
Removed:
in
2000
Removed:
let token = Option.get (csrf_token (body (get c "/workout"))) in
2001
Removed:
let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in
2002
Removed:
(* The saved workout is w1, still incomplete. Its slot 2 awaits a
2003
Removed:
record; add it through the non-edit path. *)
2004
Removed:
let record_page = body (get c "/logbook/w1?slot=2") in
2005
Removed:
Alcotest.(check bool)
2006
Removed:
"the add form posts to the plain slot route" true
2007
Removed:
(contains ~substring:"/logbook/w1/slots/2\"" record_page);
2008
Removed:
let token = Option.get (csrf_token record_page) in
2009
Removed:
let added =
2010
Removed:
post c "/logbook/w1/slots/2"
2011
Removed:
[
2012
Removed:
("dream.csrf", token);
2013
Removed:
("load", "10");
2014
Removed:
("reps", "9");
2015
Removed:
("extension", "");
2016
Removed:
]
2017
Removed:
in
2018
Removed:
Alcotest.(check int)
2019
Removed:
"recorded a saved-workout slot" 303 (status added);
2020
Removed:
let after = body (get c "/logbook/w1?slot=2") in
2021
Removed:
Alcotest.(check bool)
2022
Removed:
"now counts two filled slots" true
2023
Removed:
(contains ~substring:"2 of 4 recorded" after);
2024
Removed:
Alcotest.(check bool)
2025
Removed:
"shows the newly recorded load" true
2026
Removed:
(contains ~substring:"10" after) );
2027
Removed:
( "recording an already-filled slot through the add path is refused",
2028
Removed:
`Quick,
2029
Removed:
fun () ->
2030
Removed:
(* The add path lists only outstanding slots. A filled slot is not
2031
Removed:
awaiting a record, so posting to it is a 404, not a silent second
2032
Removed:
entry that would add volume. *)
2033
Removed:
let c = client () in
2034
Removed:
let _ = sign_in_new c in
2035
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
2036
Removed:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
2037
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
2038
Removed:
let _ =
2039
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
2040
Removed:
in
2041
Removed:
let token =
2042
Removed:
Option.get (csrf_token (body (get c "/workout?slot=1")))
2043
Removed:
in
2044
Removed:
let _ =
2045
Removed:
post c "/workout/slots/1"
2046
Removed:
[
2047
Removed:
("dream.csrf", token);
2048
Removed:
("load", "12");
2049
Removed:
("reps", "8");
2050
Removed:
("extension", "");
2051
Removed:
]
2052
Removed:
in
2053
Removed:
let token = Option.get (csrf_token (body (get c "/workout"))) in
2054
Removed:
let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in
2055
Removed:
(* Slot 1 is filled. Re-posting to its add path is refused. *)
2056
Removed:
let token =
2057
Removed:
Option.get (csrf_token (body (get c "/logbook/w1?slot=2")))
2058
Removed:
in
2059
Removed:
let refused =
2060
Removed:
post c "/logbook/w1/slots/1"
2061
Removed:
[
2062
Removed:
("dream.csrf", token);
2063
Removed:
("load", "20");
2064
Removed:
("reps", "6");
2065
Removed:
("extension", "");
2066
Removed:
]
2067
Removed:
in
2068
Removed:
Alcotest.(check int)
2069
Removed:
"filled slot is not awaiting" 404 (status refused);
2070
Removed:
Alcotest.(check bool)
2071
Removed:
"names the slot as not awaiting" true
2072
Removed:
(contains ~substring:"not awaiting a record" (body refused)) );
2073
Removed:
] );
2074
Removed:
( "web.slot_bounds",
2075
Removed:
[
2076
Removed:
( "posting to a slot beyond the workout is not found",
2077
Removed:
`Quick,
2078
Removed:
fun () ->
2079
Removed:
(* Day 1 has four slots (0..3). Slot 9 does not exist, so the log
2080
Removed:
handler answers 404 rather than recording phantom volume. *)
2081
Removed:
let c = client () in
2082
Removed:
let _ = sign_in_new c in
2083
Removed:
let _ = start_day_one c in
2084
Removed:
let token = Option.get (csrf_token (body (get c "/workout"))) in
2085
Removed:
let response =
2086
Removed:
post c "/workout/slots/9"
2087
Removed:
[
2088
Removed:
("dream.csrf", token);
2089
Removed:
("load", "10");
2090
Removed:
("reps", "8");
2091
Removed:
("extension", "");
2092
Removed:
]
2093
Removed:
in
2094
Removed:
Alcotest.(check int)
2095
Removed:
"out-of-range slot is not found" 404 (status response);
2096
Removed:
Alcotest.(check bool)
2097
Removed:
"names the slot as not awaiting" true
2098
Removed:
(contains ~substring:"not awaiting a record" (body response)) );
2099
Removed:
( "editing a slot beyond the workout is not found",
2100
Removed:
`Quick,
2101
Removed:
fun () ->
2102
Removed:
let c = client () in
2103
Removed:
let _ = sign_in_new c in
2104
Removed:
let _ = start_day_one c in
2105
Removed:
let token = Option.get (csrf_token (body (get c "/workout"))) in
2106
Removed:
let response =
2107
Removed:
post c "/workout/slots/9/edit"
2108
Removed:
[
2109
Removed:
("dream.csrf", token);
2110
Removed:
("load", "10");
2111
Removed:
("reps", "8");
2112
Removed:
("extension", "");
2113
Removed:
]
2114
Removed:
in
2115
Removed:
Alcotest.(check int)
2116
Removed:
"out-of-range edit is not found" 404 (status response) );
2117
Removed:
( "logging with no workout in progress is not found",
2118
Removed:
`Quick,
2119
Removed:
fun () ->
2120
Removed:
let c = client () in
2121
Removed:
let _ = sign_in_new c in
2122
Removed:
(* No routine selected, no workout begun: the CSRF token comes from
2123
Removed:
Home, but the slot route has no workout to record against. *)
2124
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
2125
Removed:
let response =
2126
Removed:
post c "/workout/slots/0"
2127
Removed:
[
2128
Removed:
("dream.csrf", token);
2129
Removed:
("load", "10");
2130
Removed:
("reps", "8");
2131
Removed:
("extension", "");
2132
Removed:
]
2133
Removed:
in
2134
Removed:
Alcotest.(check int) "no workout is not found" 404 (status response);
2135
Removed:
Alcotest.(check bool)
2136
Removed:
"names the absent workout" true
2137
Removed:
(contains ~substring:"No workout is in progress" (body response))
2138
Removed:
);
2139
Removed:
] );
2140
Removed:
( "web.duplicate_feedback",
2141
Removed:
[
2142
Removed:
( "the flow rejects a step that does not match the session's position",
2143
Removed:
`Quick,
2144
Removed:
fun () ->
2145
Removed:
(* The flow advances one factor at a time and stores its position in
2146
Removed:
the session. A post whose [step] disagrees with that position —
2147
Removed:
a stale form, a double submit, or a crafted body — is refused as
2148
Removed:
an invalid form rather than recording a factor twice. This is the
2149
Removed:
web tier's guard against a duplicate signal ever reaching the
2150
Removed:
domain. *)
2151
Removed:
let c = client () in
2152
Removed:
let _ = sign_in_new c in
2153
Removed:
let start = body (get c "/logbook?feedback=start") in
2154
Removed:
let token = Option.get (csrf_token start) in
2155
Removed:
(* The session is at step 0; post step 3 instead. *)
2156
Removed:
let mismatched =
2157
Removed:
post c "/feedback"
2158
Removed:
[
2159
Removed:
("dream.csrf", token);
2160
Removed:
("step", "3");
2161
Removed:
("action", "next");
2162
Removed:
("choice", "1");
2163
Removed:
]
2164
Removed:
in
2165
Removed:
Alcotest.(check int)
2166
Removed:
"mismatched step redirects" 303 (status mismatched);
2167
Removed:
let logbook_page = body (get c "/logbook") in
2168
Removed:
Alcotest.(check bool)
2169
Removed:
"reports the mismatch as an invalid form" true
2170
Removed:
(contains ~substring:"The submitted form is not valid."
2171
Removed:
logbook_page);
2172
Removed:
(* The flow did not advance: it still shows the first factor. *)
2173
Removed:
Alcotest.(check bool)
2174
Removed:
"the flow stays on the first factor" true
2175
Removed:
(contains ~substring:">Sleep</h3>" logbook_page
2176
Removed:
&& contains ~substring:"1 of 5 factors" logbook_page) );
2177
Removed:
( "answering every factor stores exactly one signal per category",
2178
Removed:
`Quick,
2179
Removed:
fun () ->
2180
Removed:
(* The flow admits one answer per factor, so the stored report holds
2181
Removed:
one signal per category and never a duplicate. Walking all five
2182
Removed:
factors and saving proves the whole set persists without a
2183
Removed:
duplicate-signal rejection. *)
2184
Removed:
let c = client () in
2185
Removed:
let _ = sign_in_new c in
2186
Removed:
let _ = get c "/logbook?feedback=start" in
2187
Removed:
let rec advance step =
2188
Removed:
if step < 5 then begin
2189
Removed:
let token = Option.get (csrf_token (body (get c "/logbook"))) in
2190
Removed:
let _ =
2191
Removed:
post c "/feedback"
2192
Removed:
[
2193
Removed:
("dream.csrf", token);
2194
Removed:
("step", string_of_int step);
2195
Removed:
("action", "next");
2196
Removed:
("choice", "1");
2197
Removed:
]
2198
Removed:
in
2199
Removed:
advance (step + 1)
2200
Removed:
end
2201
Removed:
in
2202
Removed:
advance 0;
2203
Removed:
let token = Option.get (csrf_token (body (get c "/logbook"))) in
2204
Removed:
let saved =
2205
Removed:
post c "/feedback"
2206
Removed:
[ ("dream.csrf", token); ("step", "5"); ("action", "save") ]
2207
Removed:
in
2208
Removed:
Alcotest.(check int) "final save redirects" 303 (status saved);
2209
Removed:
let logbook_page = body (get c "/logbook") in
2210
Removed:
Alcotest.(check bool)
2211
Removed:
"stores one signal per distinct factor" true
2212
Removed:
(contains ~substring:"Sleep 1 (very poor)" logbook_page
2213
Removed:
&& contains ~substring:"Appetite 1 (very poor)" logbook_page
2214
Removed:
&& contains ~substring:"Readiness 1 (very poor)" logbook_page
2215
Removed:
&& contains ~substring:"Motivation 1 (very poor)" logbook_page
2216
Removed:
&& contains ~substring:"Difficulty 1 (very poor)" logbook_page) );
2217
Removed:
] );
2218
Removed:
( "web.lifecycle",
2219
Removed:
[
2220
Removed:
( "a full cycle: begin Day 1, record every slot, finish, and see it \
2221
Removed:
saved complete",
2222
Removed:
`Quick,
2223
Removed:
fun () ->
2224
Removed:
(* A deep end-to-end pass over the primary flow with a driven clock.
2225
Removed:
Begin Day 1, record all four slots, finish, and confirm the
2226
Removed:
logbook persists a complete Day 1 with four stimuli. *)
2227
Removed:
let c, now = clocked_client () in
2228
Removed:
now := day 10;
2229
Removed:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
2230
Removed:
let _ = start_day_one c in
2231
Removed:
(* Fresh workout: nothing recorded yet. *)
2232
Removed:
Alcotest.(check bool)
2233
Removed:
"opens with no slots recorded" true
2234
Removed:
(contains ~substring:"0 of 4 recorded" (body (get c "/workout")));
2235
Removed:
record_all_day_one_slots c;
2236
Removed:
Alcotest.(check bool)
2237
Removed:
"counts all four slots recorded" true
2238
Removed:
(contains ~substring:"4 of 4 recorded" (body (get c "/workout")));
2239
Removed:
let token = Option.get (csrf_token (body (get c "/workout"))) in
2240
Removed:
let finished = post c "/workout/finish" [ ("dream.csrf", token) ] in
2241
Removed:
Alcotest.(check int) "finish redirects" 303 (status finished);
2242
Removed:
Alcotest.(check bool)
2243
Removed:
"sends the trainee to the logbook feedback prompt" true
2244
Removed:
(List.mem "/logbook?prompt=feedback"
2245
Removed:
(Dream.headers finished "Location"));
2246
Removed:
let logbook_page = body (get c "/logbook") in
2247
Removed:
Alcotest.(check bool)
2248
Removed:
"the logbook lists the saved Day 1 with all its stimuli" true
2249
Removed:
(contains ~substring:"Day 1 — 4 stimuli" logbook_page);
2250
Removed:
Alcotest.(check bool)
2251
Removed:
"marks the saved workout complete" true
2252
Removed:
(contains ~substring:"complete" logbook_page);
2253
Removed:
(* The saved workout is durable and reachable at its own URL. *)
2254
Removed:
let record_page = body (get c "/logbook/w1") in
2255
Removed:
Alcotest.(check bool)
2256
Removed:
"the saved workout persists all four slots" true
2257
Removed:
(contains ~substring:"4 of 4 recorded" record_page) );
2258
Removed:
( "the recovery gate blocks the next workout until enough rest, then \
2259
Removed:
Day 2 begins",
2260
Removed:
`Quick,
2261
Removed:
fun () ->
2262
Removed:
(* The deepest flow: after finishing Day 1, the next workout is
2263
Removed:
gated until 48 hours of recovery pass. The web tier drives the
2264
Removed:
clock, so this proves the gate over HTTP, not just in the
2265
Removed:
service. Beginning too early is refused; resting past the
2266
Removed:
interval clears the gate and advances the cycle to Day 2. *)
2267
Removed:
let c, now = clocked_client () in
2268
Removed:
now := day 10;
2269
Removed:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
2270
Removed:
let _ = start_day_one c in
2271
Removed:
record_all_day_one_slots c;
2272
Removed:
let token = Option.get (csrf_token (body (get c "/workout"))) in
2273
Removed:
let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in
2274
Removed:
(* One hour later: recovery is far from complete. Home shows the
2275
Removed:
gate and beginning without an override is refused. *)
2276
Removed:
now := day 10 + 3600;
2277
Removed:
let home = body (get c "/") in
2278
Removed:
Alcotest.(check bool)
2279
Removed:
"Home shows the recovery gate" true
2280
Removed:
(contains ~substring:"requires recovery" home);
2281
Removed:
let token = Option.get (csrf_token home) in
2282
Removed:
let refused =
2283
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
2284
Removed:
in
2285
Removed:
Alcotest.(check int)
2286
Removed:
"an early begin is bounced back" 303 (status refused);
2287
Removed:
Alcotest.(check bool)
2288
Removed:
"the early begin returns Home, not the workout" true
2289
Removed:
(List.mem "/" (Dream.headers refused "Location"));
2290
Removed:
Alcotest.(check int)
2291
Removed:
"no workout was started" 303
2292
Removed:
(status (get c "/workout"));
2293
Removed:
(* Rest two full days: past the 48-hour training interval. The gate
2294
Removed:
clears and the next begin succeeds. *)
2295
Removed:
now := day 13;
2296
Removed:
let home = body (get c "/") in
2297
Removed:
Alcotest.(check bool)
2298
Removed:
"Home no longer requires recovery" false
2299
Removed:
(contains ~substring:"requires recovery" home);
2300
Removed:
let token = Option.get (csrf_token home) in
2301
Removed:
let began =
2302
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
2303
Removed:
in
2304
Removed:
Alcotest.(check int) "the rested begin succeeds" 303 (status began);
2305
Removed:
Alcotest.(check bool)
2306
Removed:
"the rested begin reaches the workout" true
2307
Removed:
(List.mem "/workout" (Dream.headers began "Location"));
2308
Removed:
let workout = body (get c "/workout") in
2309
Removed:
Alcotest.(check bool)
2310
Removed:
"the cycle has advanced to Day 2" true
2311
Removed:
(contains ~substring:"<h1>Day 2</h1>" workout);
2312
Removed:
Alcotest.(check bool)
2313
Removed:
"the rested workout shows no early-training notice" false
2314
Removed:
(contains ~substring:"Begun before recovery finished." workout) );
2315
Removed:
] );
2316
Removed:
( "web.isolation",
2317
Removed:
[
2318
Removed:
( "two trainees never share workout or logbook state",
2319
Removed:
`Quick,
2320
Removed:
fun () ->
2321
Removed:
(* Two trainees on the same store, each with their own cookie jar.
2322
Removed:
One begins and finishes a workout; the other must see none of it:
2323
Removed:
not the in-progress workout, not the saved record. This proves
2324
Removed:
the per-trainee scoping the service promises, over HTTP. *)
2325
Removed:
let alice = client () in
2326
Removed:
let _ = register alice ~username:"alice" ~password:"heavyduty1" in
2327
Removed:
let bob = { alice with jar = [] } in
2328
Removed:
let _ = register bob ~username:"bobby" ~password:"heavyduty1" in
2329
Removed:
(* Alice selects and begins a workout, records a slot. *)
2330
Removed:
let token = Option.get (csrf_token (body (get alice "/"))) in
2331
Removed:
let _ =
2332
Removed:
post alice "/routines/ideal/select" [ ("dream.csrf", token) ]
2333
Removed:
in
2334
Removed:
let token = Option.get (csrf_token (body (get alice "/"))) in
2335
Removed:
let _ =
2336
Removed:
post alice "/workout"
2337
Removed:
[ ("dream.csrf", token); ("override", "false") ]
2338
Removed:
in
2339
Removed:
let token =
2340
Removed:
Option.get (csrf_token (body (get alice "/workout?slot=1")))
2341
Removed:
in
2342
Removed:
let _ =
2343
Removed:
post alice "/workout/slots/1"
2344
Removed:
[
2345
Removed:
("dream.csrf", token);
2346
Removed:
("load", "12");
2347
Removed:
("reps", "8");
2348
Removed:
("extension", "");
2349
Removed:
]
2350
Removed:
in
2351
Removed:
(* Bob has no workout in progress: his workout view redirects. *)
2352
Removed:
Alcotest.(check int)
2353
Removed:
"Bob has no workout in progress" 303
2354
Removed:
(status (get bob "/workout"));
2355
Removed:
(* Bob's Home does not show Alice's in-progress card. *)
2356
Removed:
let bob_home = body (get bob "/") in
2357
Removed:
Alcotest.(check bool)
2358
Removed:
"Bob's Home has no in-progress card" false
2359
Removed:
(contains ~substring:"in-progress-card" bob_home);
2360
Removed:
(* Alice finishes; her record becomes w1 for her. *)
2361
Removed:
let token = Option.get (csrf_token (body (get alice "/workout"))) in
2362
Removed:
let _ = post alice "/workout/finish" [ ("dream.csrf", token) ] in
2363
Removed:
let alice_logbook = body (get alice "/logbook") in
2364
Removed:
Alcotest.(check bool)
2365
Removed:
"Alice sees her saved workout" true
2366
Removed:
(contains ~substring:"/logbook/w1" alice_logbook);
2367
Removed:
(* Bob's logbook is empty and Alice's record is not reachable from
2368
Removed:
Bob's session. Ids are per-trainee, so Bob's own w1 does not
2369
Removed:
exist yet. *)
2370
Removed:
let bob_logbook = body (get bob "/logbook") in
2371
Removed:
Alcotest.(check bool)
2372
Removed:
"Bob's logbook shows nothing logged" true
2373
Removed:
(contains ~substring:"Nothing logged yet." bob_logbook);
2374
Removed:
Alcotest.(check bool)
2375
Removed:
"Bob's logbook does not list Alice's record" false
2376
Removed:
(contains ~substring:"Day 1 — " bob_logbook);
6
Added:
open Hito_app
7
Added:
open Hito_persistence
8
Added:
module Handlers = Hito_web.Handlers.Make (Memory_repo) (Bcrypt_hash)
9
Added:
10
Added:
(* A fresh, fully wired application: secret, in-memory sessions, routes.
11
Added:
Registration is opened here so the auth-flow tests can create trainees via
12
Added:
[/register]; production keeps it closed. *)
13
Added:
let app () =
14
Added:
let handlers =
15
Added:
Handlers.make ~repo:(Memory_repo.create ()) ~registration_open:true ()
16
Added:
in
17
Added:
Dream.memory_sessions @@ Dream.router (Handlers.routes handlers)
18
Added:
|> fun handler -> Dream.set_secret "test-secret-value" handler
19
Added:
20
Added:
let status response = Dream.status response |> Dream.status_to_int
21
Added:
let body response = Lwt_main.run (Dream.body response)
22
Added:
23
Added:
(* The redirect target of a 3xx response — the URL half of a URL-to-URL flow. *)
24
Added:
let location response =
25
Added:
match Dream.header response "Location" with
26
Added:
| Some target -> target
27
Added:
| None -> Alcotest.failf "expected a Location header on a redirect"
28
Added:
29
Added:
(* --- a cookie-carrying client --- *)
30
Added:
31
Added:
(* Extract cookies (name=value) from all Set-Cookie response headers. *)
32
Added:
let cookies_of response =
33
Added:
Dream.headers response "Set-Cookie"
34
Added:
|> List.filter_map (fun sc ->
35
Added:
match String.index_opt sc ';' with
36
Added:
| Some i -> Some (String.sub sc 0 i)
37
Added:
| None -> Some sc)
38
Added:
39
Added:
type client = { app : Dream.handler; mutable jar : string list }
40
Added:
41
Added:
let client () = { app = app (); jar = [] }
42
Added:
43
Added:
let cookie_header client =
44
Added:
if client.jar = [] then [] else [ ("Cookie", String.concat "; " client.jar) ]
45
Added:
46
Added:
let remember client response =
47
Added:
(* Replace cookies of the same name; keep the rest. *)
48
Added:
List.iter
49
Added:
(fun fresh ->
50
Added:
let name =
51
Added:
match String.index_opt fresh '=' with
52
Added:
| Some i -> String.sub fresh 0 i
53
Added:
| None -> fresh
54
Added:
in
55
Added:
client.jar <-
56
Added:
fresh
57
Added:
:: List.filter
58
Added:
(fun old ->
59
Added:
not
60
Added:
(String.length old >= String.length name
61
Added:
&& String.sub old 0 (String.length name) = name
62
Added:
&& (String.length old = String.length name
63
Added:
|| old.[String.length name] = '=')))
64
Added:
client.jar)
65
Added:
(cookies_of response)
66
Added:
67
Added:
let get client target =
68
Added:
let response =
69
Added:
Dream.test client.app
70
Added:
(Dream.request ~method_:`GET ~target ~headers:(cookie_header client) "")
71
Added:
in
72
Added:
remember client response;
73
Added:
response
74
Added:
75
Added:
let post client target fields =
76
Added:
let body =
77
Added:
fields
78
Added:
|> List.map (fun (k, v) ->
79
Added:
Dream.to_percent_encoded k ^ "=" ^ Dream.to_percent_encoded v)
80
Added:
|> String.concat "&"
81
Added:
in
82
Added:
let response =
83
Added:
Dream.test client.app
84
Added:
(Dream.request ~method_:`POST ~target
85
Added:
~headers:
86
Added:
(("Content-Type", "application/x-www-form-urlencoded")
87
Added:
:: cookie_header client)
88
Added:
body)
89
Added:
in
90
Added:
remember client response;
91
Added:
response
92
Added:
93
Added:
(* A tiny substring search, since Str is not a dependency here. *)
94
Added:
let index_from ~needle haystack start =
95
Added:
let n = String.length needle and h = String.length haystack in
96
Added:
let rec at i =
97
Added:
if i + n > h then None
98
Added:
else if String.sub haystack i n = needle then Some i
99
Added:
else at (i + 1)
100
Added:
in
101
Added:
if start < 0 then None else at start
102
Added:
103
Added:
(* Pull the CSRF token value out of a rendered form. *)
104
Added:
let csrf_token html =
105
Added:
match index_from ~needle:"name=\"dream.csrf\"" html 0 with
106
Added:
| None -> None
107
Added:
| Some idx -> (
108
Added:
match index_from ~needle:"value=\"" html idx with
109
Added:
| None -> None
110
Added:
| Some v ->
111
Added:
let start = v + String.length "value=\"" in
112
Added:
let stop = String.index_from html start '"' in
113
Added:
Some (String.sub html start (stop - start)))
114
Added:
115
Added:
let register client ~username ~password =
116
Added:
let page = body (get client "/register") in
117
Added:
let token = Option.get (csrf_token page) in
118
Added:
post client "/register"
119
Added:
[ ("dream.csrf", token); ("username", username); ("password", password) ]
120
Added:
121
Added:
let sign_in_new client =
122
Added:
register client ~username:"lifter" ~password:"heavyduty1"
123
Added:
124
Added:
(* Sign in through the credential form, as a returning trainee would. Unlike
125
Added:
[register], this exercises the [POST /login] path. *)
126
Added:
let sign_in client ~username ~password =
127
Added:
let page = body (get client "/login") in
128
Added:
let token = Option.get (csrf_token page) in
129
Added:
post client "/login"
130
Added:
[ ("dream.csrf", token); ("username", username); ("password", password) ]
131
Added:
132
Added:
(* An application whose clock the test drives. A shared [Memory_repo] and a
133
Added:
mutable [now] cell let a deep test advance time across the recovery gate,
134
Added:
which the wall-clock default cannot. Registration is open so the test can
135
Added:
create the trainee it drives. Also hands back the repository, so a deep test
136
Added:
can assert the domain state its flow produced. *)
137
Added:
let clocked_client () =
138
Added:
let now = ref 0 in
139
Added:
let repo = Memory_repo.create () in
140
Added:
let handlers =
141
Added:
Handlers.make ~repo
142
Added:
~now:(fun () -> Recovery.timestamp_of_unix_seconds !now)
143
Added:
~registration_open:true ()
144
Added:
in
145
Added:
let app =
146
Added:
Dream.memory_sessions @@ Dream.router (Handlers.routes handlers) |> fun h ->
147
Added:
Dream.set_secret "test-secret-value" h
148
Added:
in
149
Added:
({ app; jar = [] }, now, repo)
150
Added:
151
Added:
let day n = n * 86_400
152
Added:
153
Added:
(* A client that hands back its repository, so a test can assert the domain
154
Added:
state the flow produced — the log, the stored feedback, the renamed account —
155
Added:
rather than reading it back out of rendered HTML. *)
156
Added:
let client_with_repo () =
157
Added:
let repo = Memory_repo.create () in
158
Added:
let handlers = Handlers.make ~repo ~registration_open:true () in
159
Added:
let app =
160
Added:
Dream.memory_sessions @@ Dream.router (Handlers.routes handlers) |> fun h ->
161
Added:
Dream.set_secret "test-secret-value" h
162
Added:
in
163
Added:
({ app; jar = [] }, repo)
164
Added:
165
Added:
(* Look up the sole seeded trainee by the name the flow helpers register. *)
166
Added:
let the_trainee repo ~username =
167
Added:
match Trainee.username username with
168
Added:
| Error _ -> Alcotest.failf "test username %S is invalid" username
169
Added:
| Ok u -> (
170
Added:
match Lwt_main.run (Memory_repo.find_trainee_by_username repo u) with
171
Added:
| Some trainee -> trainee
172
Added:
| None -> Alcotest.failf "no trainee named %S" username)
173
Added:
174
Added:
(* Drive a trainee to the start of a fresh Day 1 workout: select the ideal
175
Added:
routine and begin without an override. Returns the client. *)
176
Added:
let start_day_one c =
177
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
178
Added:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
179
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
180
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
181
Added:
182
Added:
(* Record every slot of the in-progress Day 1 workout, one at a time, addressed
183
Added:
by [?slot=]. Slot 0 is the flyes/incline-press pair; slot 3 is the
184
Added:
french-press/dips pair; slots 1 and 2 are single lateral movements. *)
185
Added:
let record_all_day_one_slots c =
186
Added:
let record_pair slot comp_load =
187
Added:
let token =
188
Added:
Option.get (csrf_token (body (get c ("/workout?slot=" ^ slot))))
189
Added:
in
190
Added:
post c ("/workout/slots/" ^ slot)
191
Added:
[
192
Added:
("dream.csrf", token);
193
Added:
("iso_load", "20");
194
Added:
("iso_reps", "9");
195
Added:
("comp_load", comp_load);
196
Added:
("comp_reps", "7");
197
Added:
("extension", "");
198
Added:
]
199
Added:
in
200
Added:
let record_single slot load reps =
201
Added:
let token =
202
Added:
Option.get (csrf_token (body (get c ("/workout?slot=" ^ slot))))
203
Added:
in
204
Added:
post c ("/workout/slots/" ^ slot)
205
Added:
[
206
Added:
("dream.csrf", token); ("load", load); ("reps", reps); ("extension", "");
207
Added:
]
208
Added:
in
209
Added:
let _ = record_pair "0" "60" in
210
Added:
let _ = record_single "1" "12" "8" in
211
Added:
let _ = record_single "2" "10" "9" in
212
Added:
let _ = record_pair "3" "0" in
213
Added:
()
214
Added:
215
Added:
let route_tests =
216
Added:
[
217
Added:
( "web.auth",
218
Added:
[
219
Added:
( "an unauthenticated visit to the overview redirects to sign-in",
220
Added:
`Quick,
221
Added:
fun () ->
222
Added:
let c = client () in
223
Added:
let response = get c "/" in
224
Added:
Alcotest.(check int) "redirect" 303 (status response);
225
Added:
Alcotest.(check string) "to /login" "/login" (location response) );
226
Added:
( "the sign-in page is served",
227
Added:
`Quick,
228
Added:
fun () ->
229
Added:
let c = client () in
230
Added:
Alcotest.(check int) "GET /login" 200 (status (get c "/login")) );
231
Added:
( "registration creates the account, signs in, and reaches the overview",
232
Added:
`Quick,
233
Added:
fun () ->
234
Added:
let c, repo = client_with_repo () in
235
Added:
let registered =
236
Added:
register c ~username:"lifter" ~password:"heavyduty1"
237
Added:
in
238
Added:
Alcotest.(check int)
239
Added:
"registered, redirected" 303 (status registered);
240
Added:
(* The account now exists: the flow orchestrated a real create. *)
241
Added:
let trainee = the_trainee repo ~username:"lifter" in
242
Added:
Alcotest.(check string)
243
Added:
"stored under the normalized username" "lifter"
244
Added:
(Trainee.username_to_string trainee.Trainee.username);
245
Added:
(* The session authenticates the follow-up request. *)
246
Added:
Alcotest.(check int)
247
Added:
"authenticated overview" 200
248
Added:
(status (get c "/")) );
249
Added:
( "an authenticated trainee reaches the overview",
250
Added:
`Quick,
251
Added:
fun () ->
252
Added:
let c = client () in
253
Added:
let _ = sign_in_new c in
254
Added:
Alcotest.(check int) "home" 200 (status (get c "/")) );
255
Added:
( "sign-out clears the session",
256
Added:
`Quick,
257
Added:
fun () ->
258
Added:
let c = client () in
259
Added:
let _ = sign_in_new c in
260
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
261
Added:
let out = post c "/logout" [ ("dream.csrf", token) ] in
262
Added:
Alcotest.(check int) "logout redirects" 303 (status out);
263
Added:
(* The session is gone: the overview again bounces to sign-in. *)
264
Added:
let after = get c "/" in
265
Added:
Alcotest.(check int) "overview now redirects" 303 (status after);
266
Added:
Alcotest.(check string) "to /login" "/login" (location after) );
267
Added:
( "a form post without a CSRF token is refused and changes nothing",
268
Added:
`Quick,
269
Added:
fun () ->
270
Added:
let c, repo = client_with_repo () in
271
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
272
Added:
let response =
273
Added:
post c "/routines/ideal/select" [ (* no dream.csrf *) ]
274
Added:
in
275
Added:
Alcotest.(check int)
276
Added:
"redirects after the refused post" 303 (status response);
277
Added:
(* No routine was selected: the refused post had no domain effect. *)
278
Added:
let trainee = the_trainee repo ~username:"lifter" in
279
Added:
Alcotest.(check bool)
280
Added:
"no active routine" true
281
Added:
(Option.is_none
282
Added:
(Lwt_main.run
283
Added:
(Memory_repo.active_routine repo trainee.Trainee.id))) );
284
Added:
( "a too-short username is refused",
285
Added:
`Quick,
286
Added:
fun () ->
287
Added:
let c, repo = client_with_repo () in
288
Added:
let response = register c ~username:"abc" ~password:"heavyduty1" in
289
Added:
Alcotest.(check int) "rejected" 400 (status response);
290
Added:
Alcotest.(check (option string))
291
Added:
"no account created" None
292
Added:
(Lwt_main.run
293
Added:
(match Trainee.username "abc" with
294
Added:
| Ok u -> Memory_repo.find_trainee_by_username repo u
295
Added:
| Error _ -> Lwt.return None)
296
Added:
|> Option.map (fun t -> Trainee.id_to_string t.Trainee.id)) );
297
Added:
( "a too-long username is refused",
298
Added:
`Quick,
299
Added:
fun () ->
300
Added:
let c = client () in
301
Added:
let response =
302
Added:
register c ~username:"abcdefghijklmnopqrstu"
303
Added:
~password:"heavyduty1"
304
Added:
in
305
Added:
Alcotest.(check int) "rejected" 400 (status response) );
306
Added:
( "a short password is accepted (passwords carry no policy)",
307
Added:
`Quick,
308
Added:
fun () ->
309
Added:
let c = client () in
310
Added:
let response = register c ~username:"lifter" ~password:"x" in
311
Added:
Alcotest.(check int) "registered, redirected" 303 (status response);
312
Added:
Alcotest.(check int)
313
Added:
"authenticated overview" 200
314
Added:
(status (get c "/")) );
315
Added:
( "with registration closed the register routes are absent",
316
Added:
`Quick,
317
Added:
fun () ->
318
Added:
(* The production default: [registration_open] unset. *)
319
Added:
let handlers = Handlers.make ~repo:(Memory_repo.create ()) () in
320
Added:
let app =
321
Added:
Dream.memory_sessions @@ Dream.router (Handlers.routes handlers)
322
Added:
|> fun h -> Dream.set_secret "test-secret-value" h
323
Added:
in
324
Added:
let c = { app; jar = [] } in
325
Added:
Alcotest.(check int)
326
Added:
"GET /register is not found" 404
327
Added:
(status (get c "/register"));
328
Added:
Alcotest.(check int)
329
Added:
"GET /login is served" 200
330
Added:
(status (get c "/login")) );
331
Added:
] );
332
Added:
( "web.flow",
333
Added:
[
334
Added:
( "selecting a routine redirects and records the active routine",
335
Added:
`Quick,
336
Added:
fun () ->
337
Added:
(* POST-redirect-GET: selecting a routine answers 303, and the
338
Added:
redirected GET is served. The domain effect is what matters: the
339
Added:
trainee now has an active routine. *)
340
Added:
let c, repo = client_with_repo () in
341
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
342
Added:
let trainee = the_trainee repo ~username:"lifter" in
343
Added:
Alcotest.(check bool)
344
Added:
"no active routine before selection" true
345
Added:
(Option.is_none
346
Added:
(Lwt_main.run
347
Added:
(Memory_repo.active_routine repo trainee.Trainee.id)));
348
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
349
Added:
let selection =
350
Added:
post c "/routines/ideal/select" [ ("dream.csrf", token) ]
351
Added:
in
352
Added:
Alcotest.(check int) "selection redirects" 303 (status selection);
353
Added:
Alcotest.(check bool)
354
Added:
"a routine is now active" true
355
Added:
(Option.is_some
356
Added:
(Lwt_main.run
357
Added:
(Memory_repo.active_routine repo trainee.Trainee.id)));
358
Added:
(* The redirected GET is served. *)
359
Added:
Alcotest.(check int)
360
Added:
"the redirected GET is 200" 200
361
Added:
(status (get c "/")) );
362
Added:
( "a signed-in trainee selects a routine and begins a workout",
363
Added:
`Quick,
364
Added:
fun () ->
365
Added:
let c, repo = client_with_repo () in
366
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
367
Added:
let trainee = the_trainee repo ~username:"lifter" in
368
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
369
Added:
let selection =
370
Added:
post c "/routines/ideal/select" [ ("dream.csrf", token) ]
371
Added:
in
372
Added:
Alcotest.(check int) "routine selected" 303 (status selection);
373
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
374
Added:
let started =
375
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
376
Added:
in
377
Added:
Alcotest.(check int) "workout started" 303 (status started);
378
Added:
(* The workout is now in progress in the domain, and its view is
379
Added:
served. *)
380
Added:
Alcotest.(check bool)
381
Added:
"a workout is in progress" true
382
Added:
(Option.is_some
383
Added:
(Lwt_main.run
384
Added:
(Memory_repo.in_progress repo trainee.Trainee.id)));
385
Added:
Alcotest.(check int)
386
Added:
"the workout view is served" 200
387
Added:
(status (get c "/workout"));
388
Added:
(* The static workout client asset is served. *)
389
Added:
let asset = get c "/assets/workout-client.js" in
390
Added:
Alcotest.(check int) "serves the workout client" 200 (status asset)
391
Added:
);
392
Added:
( "the routine page is served once a routine is selected",
393
Added:
`Quick,
394
Added:
fun () ->
395
Added:
let c = client () in
396
Added:
let _ = sign_in_new c in
397
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
398
Added:
let selection =
399
Added:
post c "/routines/ideal/select" [ ("dream.csrf", token) ]
400
Added:
in
401
Added:
Alcotest.(check int) "routine selected" 303 (status selection);
402
Added:
Alcotest.(check int)
403
Added:
"routine page served" 200
404
Added:
(status (get c "/routine")) );
405
Added:
( "a recorded slot can be corrected, replacing it rather than adding \
406
Added:
volume",
407
Added:
`Quick,
408
Added:
fun () ->
409
Added:
let c, repo = client_with_repo () in
410
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
411
Added:
let trainee = the_trainee repo ~username:"lifter" in
412
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
413
Added:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
414
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
415
Added:
let _ =
416
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
417
Added:
in
418
Added:
(* Slot 1 is the single Laterals set. Record it, then correct it —
419
Added:
one slot at a time, addressed by [?slot=]. *)
420
Added:
let token =
421
Added:
Option.get (csrf_token (body (get c "/workout?slot=1")))
422
Added:
in
423
Added:
let recorded =
424
Added:
post c "/workout/slots/1"
425
Added:
[
426
Added:
("dream.csrf", token);
427
Added:
("load", "12");
428
Added:
("reps", "8");
429
Added:
("extension", "");
430
Added:
]
431
Added:
in
432
Added:
Alcotest.(check int) "recorded" 303 (status recorded);
433
Added:
let filled_after_record () =
434
Added:
match
435
Added:
Lwt_main.run (Memory_repo.in_progress repo trainee.Trainee.id)
436
Added:
with
437
Added:
| Some w -> Evidence.Workout.filled_slots w
438
Added:
| None -> Alcotest.failf "expected a workout in progress"
439
Added:
in
440
Added:
Alcotest.(check int) "one filled slot" 1 (filled_after_record ());
441
Added:
let token =
442
Added:
Option.get (csrf_token (body (get c "/workout?slot=1")))
443
Added:
in
444
Added:
let corrected =
445
Added:
post c "/workout/slots/1/edit"
446
Added:
[
447
Added:
("dream.csrf", token);
448
Added:
("load", "16");
449
Added:
("reps", "6");
450
Added:
("extension", "");
451
Added:
]
452
Added:
in
453
Added:
Alcotest.(check int) "corrected" 303 (status corrected);
454
Added:
(* A correction replaces the slot; it does not add volume. *)
455
Added:
Alcotest.(check int)
456
Added:
"still one filled slot, not two" 1 (filled_after_record ()) );
457
Added:
( "a saved workout's slot can be corrected from the logbook view",
458
Added:
`Quick,
459
Added:
fun () ->
460
Added:
let c, repo = client_with_repo () in
461
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
462
Added:
let trainee = the_trainee repo ~username:"lifter" in
463
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
464
Added:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
465
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
466
Added:
let _ =
467
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
468
Added:
in
469
Added:
let token =
470
Added:
Option.get (csrf_token (body (get c "/workout?slot=1")))
471
Added:
in
472
Added:
let _ =
473
Added:
post c "/workout/slots/1"
474
Added:
[
475
Added:
("dream.csrf", token);
476
Added:
("load", "12");
477
Added:
("reps", "8");
478
Added:
("extension", "");
479
Added:
]
480
Added:
in
481
Added:
let token = Option.get (csrf_token (body (get c "/workout"))) in
482
Added:
let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in
483
Added:
(* The one saved workout is w1 for this trainee. Correct its slot
484
Added:
through the logbook path, then confirm the store still has one
485
Added:
filled slot — a correction, not extra volume. *)
486
Added:
let record_page = body (get c "/logbook/w1?slot=1") in
487
Added:
let token = Option.get (csrf_token record_page) in
488
Added:
let corrected =
489
Added:
post c "/logbook/w1/slots/1/edit"
490
Added:
[
491
Added:
("dream.csrf", token);
492
Added:
("load", "20");
493
Added:
("reps", "7");
494
Added:
("extension", "");
495
Added:
]
496
Added:
in
497
Added:
Alcotest.(check int) "corrected" 303 (status corrected);
498
Added:
let record =
499
Added:
Lwt_main.run
500
Added:
(Memory_repo.find repo trainee.Trainee.id
501
Added:
(Repository.workout_id "w1"))
502
Added:
in
503
Added:
Alcotest.(check int)
504
Added:
"still one filled slot" 1
505
Added:
(match record with
506
Added:
| Some r -> Evidence.Workout.filled_slots r.Repository.workout
507
Added:
| None -> Alcotest.failf "expected the saved workout w1") );
508
Added:
( "an invalid workout field is rejected and records nothing",
509
Added:
`Quick,
510
Added:
fun () ->
511
Added:
let c, repo = client_with_repo () in
512
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
513
Added:
let trainee = the_trainee repo ~username:"lifter" in
514
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
515
Added:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
516
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
517
Added:
let _ =
518
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
519
Added:
in
520
Added:
let token = Option.get (csrf_token (body (get c "/workout"))) in
521
Added:
let invalid =
522
Added:
post c "/workout/slots/0"
523
Added:
[
524
Added:
("dream.csrf", token);
525
Added:
("iso_load", "not-a-number");
526
Added:
("iso_reps", "8");
527
Added:
("comp_load", "40");
528
Added:
("comp_reps", "6");
529
Added:
("extension", "");
530
Added:
]
531
Added:
in
532
Added:
Alcotest.(check int) "invalid field redirects" 303 (status invalid);
533
Added:
(* The bad input recorded no slot. *)
534
Added:
Alcotest.(check int)
535
Added:
"no slot was filled" 0
536
Added:
(match
537
Added:
Lwt_main.run (Memory_repo.in_progress repo trainee.Trainee.id)
538
Added:
with
539
Added:
| Some w -> Evidence.Workout.filled_slots w
540
Added:
| None -> Alcotest.failf "expected a workout in progress") );
541
Added:
( "recording a slot advances the count of filled slots",
542
Added:
`Quick,
543
Added:
fun () ->
544
Added:
let c, repo = client_with_repo () in
545
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
546
Added:
let trainee = the_trainee repo ~username:"lifter" in
547
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
548
Added:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
549
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
550
Added:
let _ =
551
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
552
Added:
in
553
Added:
let filled () =
554
Added:
match
555
Added:
Lwt_main.run (Memory_repo.in_progress repo trainee.Trainee.id)
556
Added:
with
557
Added:
| Some w -> Evidence.Workout.filled_slots w
558
Added:
| None -> Alcotest.failf "expected a workout in progress"
559
Added:
in
560
Added:
Alcotest.(check int) "nothing recorded yet" 0 (filled ());
561
Added:
let token = Option.get (csrf_token (body (get c "/workout"))) in
562
Added:
let recorded =
563
Added:
post c "/workout/slots/0"
564
Added:
[
565
Added:
("dream.csrf", token);
566
Added:
("iso_load", "10");
567
Added:
("iso_reps", "8");
568
Added:
("comp_load", "40");
569
Added:
("comp_reps", "6");
570
Added:
("extension", "");
571
Added:
]
572
Added:
in
573
Added:
Alcotest.(check int) "recorded slot 0" 303 (status recorded);
574
Added:
Alcotest.(check int) "one slot filled" 1 (filled ()) );
575
Added:
( "signing out returns the trainee to the sign-in page",
576
Added:
`Quick,
577
Added:
fun () ->
578
Added:
let c = client () in
579
Added:
let _ = sign_in_new c in
580
Added:
let page = body (get c "/") in
581
Added:
let token = Option.get (csrf_token page) in
582
Added:
let out = post c "/logout" [ ("dream.csrf", token) ] in
583
Added:
Alcotest.(check int) "logout redirect" 303 (status out);
584
Added:
let after = get c "/" in
585
Added:
Alcotest.(check int) "overview now redirects" 303 (status after);
586
Added:
Alcotest.(check string) "to /login" "/login" (location after) );
587
Added:
( "cancelling a workout without a CSRF token leaves it in progress",
588
Added:
`Quick,
589
Added:
fun () ->
590
Added:
let c, repo = client_with_repo () in
591
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
592
Added:
let trainee = the_trainee repo ~username:"lifter" in
593
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
594
Added:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
595
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
596
Added:
let _ =
597
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
598
Added:
in
599
Added:
let response = post c "/workout/cancel" [ (* no dream.csrf *) ] in
600
Added:
(* Cancelling always navigates away to Home. A forged or missing
601
Added:
token skips the discard, so the workout remains in progress. *)
602
Added:
Alcotest.(check int)
603
Added:
"navigates away without an error page" 303 (status response);
604
Added:
Alcotest.(check bool)
605
Added:
"returns Home" true
606
Added:
(List.mem "/" (Dream.headers response "Location"));
607
Added:
Alcotest.(check bool)
608
Added:
"workout still in progress" true
609
Added:
(Option.is_some
610
Added:
(Lwt_main.run
611
Added:
(Memory_repo.in_progress repo trainee.Trainee.id))) );
612
Added:
( "cancelling after recording a set discards the workout entirely",
613
Added:
`Quick,
614
Added:
fun () ->
615
Added:
let c, repo = client_with_repo () in
616
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
617
Added:
let trainee = the_trainee repo ~username:"lifter" in
618
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
619
Added:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
620
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
621
Added:
let _ =
622
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
623
Added:
in
624
Added:
let token =
625
Added:
Option.get (csrf_token (body (get c "/workout?slot=1")))
626
Added:
in
627
Added:
let recorded =
628
Added:
post c "/workout/slots/1"
629
Added:
[
630
Added:
("dream.csrf", token);
631
Added:
("load", "12");
632
Added:
("reps", "8");
633
Added:
("extension", "");
634
Added:
]
635
Added:
in
636
Added:
Alcotest.(check int) "recorded a set" 303 (status recorded);
637
Added:
let token = Option.get (csrf_token (body (get c "/workout"))) in
638
Added:
let cancelled =
639
Added:
post c "/workout/cancel" [ ("dream.csrf", token) ]
640
Added:
in
641
Added:
Alcotest.(check int) "cancel returns Home" 303 (status cancelled);
642
Added:
Alcotest.(check bool)
643
Added:
"returns Home, not the logbook" true
644
Added:
(List.mem "/" (Dream.headers cancelled "Location"));
645
Added:
(* No current workout, and no record: an abandoned session is not
646
Added:
evidence. *)
647
Added:
Alcotest.(check bool)
648
Added:
"no workout in progress" true
649
Added:
(Option.is_none
650
Added:
(Lwt_main.run
651
Added:
(Memory_repo.in_progress repo trainee.Trainee.id)));
652
Added:
Alcotest.(check int)
653
Added:
"history is empty" 0
654
Added:
(List.length
655
Added:
(Lwt_main.run (Memory_repo.history repo trainee.Trainee.id)));
656
Added:
Alcotest.(check int)
657
Added:
"the discarded workout has no record" 404
658
Added:
(status (get c "/logbook/w1")) );
659
Added:
( "sequential feedback stores only answered factors, never skipped ones",
660
Added:
`Quick,
661
Added:
fun () ->
662
Added:
let c, repo = client_with_repo () in
663
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
664
Added:
let trainee = the_trainee repo ~username:"lifter" in
665
Added:
let _ = get c "/logbook?feedback=start" in
666
Added:
(* Answer sleep (1), skip appetite, answer readiness (3), answer
667
Added:
motivation (5), skip difficulty. *)
668
Added:
let step_action step action extra =
669
Added:
let token = Option.get (csrf_token (body (get c "/logbook"))) in
670
Added:
post c "/feedback"
671
Added:
(("dream.csrf", token)
672
Added:
:: ("step", string_of_int step)
673
Added:
:: ("action", action) :: extra)
674
Added:
in
675
Added:
let s0 = step_action 0 "next" [ ("choice", "1") ] in
676
Added:
Alcotest.(check int) "first factor redirects" 303 (status s0);
677
Added:
let _ = step_action 1 "skip" [] in
678
Added:
let _ = step_action 2 "next" [ ("choice", "3") ] in
679
Added:
let _ = step_action 3 "next" [ ("choice", "5") ] in
680
Added:
let _ = step_action 4 "skip" [] in
681
Added:
let saved = step_action 5 "save" [ ("pain", "true") ] in
682
Added:
Alcotest.(check int) "final feedback redirects" 303 (status saved);
683
Added:
(* Exactly one report is stored, holding only the answered signals
684
Added:
plus pain, and none of the skipped factors. *)
685
Added:
let reports =
686
Added:
Lwt_main.run (Memory_repo.feedback repo trainee.Trainee.id)
687
Added:
in
688
Added:
Alcotest.(check int)
689
Added:
"one feedback report stored" 1 (List.length reports);
690
Added:
let signals = Evidence.Feedback.signals (List.hd reports) in
691
Added:
let has p = List.exists p signals in
692
Added:
let open Evidence.Feedback in
693
Added:
Alcotest.(check bool)
694
Added:
"stored sleep" true
695
Added:
(has (function Sleep _ -> true | _ -> false));
696
Added:
Alcotest.(check bool)
697
Added:
"stored readiness" true
698
Added:
(has (function Readiness _ -> true | _ -> false));
699
Added:
Alcotest.(check bool)
700
Added:
"stored motivation" true
701
Added:
(has (function Motivation _ -> true | _ -> false));
702
Added:
Alcotest.(check bool)
703
Added:
"stored pain" true
704
Added:
(has (function Pain -> true | _ -> false));
705
Added:
Alcotest.(check bool)
706
Added:
"did not store skipped appetite" false
707
Added:
(has (function Appetite _ -> true | _ -> false));
708
Added:
Alcotest.(check bool)
709
Added:
"did not store skipped difficulty" false
710
Added:
(has (function Difficulty _ -> true | _ -> false)) );
711
Added:
( "skipping the entire feedback flow records nothing",
712
Added:
`Quick,
713
Added:
fun () ->
714
Added:
let c, repo = client_with_repo () in
715
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
716
Added:
let trainee = the_trainee repo ~username:"lifter" in
717
Added:
let start = body (get c "/logbook?feedback=start") in
718
Added:
let token = Option.get (csrf_token start) in
719
Added:
let skipped = post c "/feedback/cancel" [ ("dream.csrf", token) ] in
720
Added:
Alcotest.(check int) "full-flow skip redirects" 303 (status skipped);
721
Added:
Alcotest.(check int)
722
Added:
"no feedback report was stored" 0
723
Added:
(List.length
724
Added:
(Lwt_main.run (Memory_repo.feedback repo trainee.Trainee.id)))
725
Added:
);
726
Added:
( "back keeps an earlier answer, which still persists on save",
727
Added:
`Quick,
728
Added:
fun () ->
729
Added:
let c, repo = client_with_repo () in
730
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
731
Added:
let trainee = the_trainee repo ~username:"lifter" in
732
Added:
let _ = get c "/logbook?feedback=start" in
733
Added:
let step_action step action extra =
734
Added:
let token = Option.get (csrf_token (body (get c "/logbook"))) in
735
Added:
post c "/feedback"
736
Added:
(("dream.csrf", token)
737
Added:
:: ("step", string_of_int step)
738
Added:
:: ("action", action) :: extra)
739
Added:
in
740
Added:
(* Answer sleep (5), move to appetite, go back, then skip forward to
741
Added:
notes and save. The pre-back sleep answer must survive. *)
742
Added:
let _ = step_action 0 "next" [ ("choice", "5") ] in
743
Added:
let back = step_action 1 "back" [] in
744
Added:
Alcotest.(check int) "back redirects" 303 (status back);
745
Added:
let _ = step_action 0 "skip" [] in
746
Added:
let _ = step_action 1 "skip" [] in
747
Added:
let _ = step_action 2 "skip" [] in
748
Added:
let _ = step_action 3 "skip" [] in
749
Added:
let _ = step_action 4 "skip" [] in
750
Added:
let _ = step_action 5 "save" [] in
751
Added:
let reports =
752
Added:
Lwt_main.run (Memory_repo.feedback repo trainee.Trainee.id)
753
Added:
in
754
Added:
Alcotest.(check int) "one report stored" 1 (List.length reports);
755
Added:
let signals = Evidence.Feedback.signals (List.hd reports) in
756
Added:
Alcotest.(check bool)
757
Added:
"the pre-back sleep answer persists" true
758
Added:
(List.exists
759
Added:
(function
760
Added:
| Evidence.Feedback.Sleep Evidence.Feedback.Very_good -> true
761
Added:
| _ -> false)
762
Added:
signals) );
763
Added:
( "closing the feedback modal discards the flow",
764
Added:
`Quick,
765
Added:
fun () ->
766
Added:
let c, repo = client_with_repo () in
767
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
768
Added:
let trainee = the_trainee repo ~username:"lifter" in
769
Added:
let start = body (get c "/logbook?feedback=start") in
770
Added:
let token = Option.get (csrf_token start) in
771
Added:
let _ =
772
Added:
post c "/feedback"
773
Added:
[
774
Added:
("dream.csrf", token);
775
Added:
("step", "0");
776
Added:
("action", "next");
777
Added:
("choice", "5");
778
Added:
]
779
Added:
in
780
Added:
let appetite = body (get c "/logbook") in
781
Added:
let token = Option.get (csrf_token appetite) in
782
Added:
let closed = post c "/feedback/cancel" [ ("dream.csrf", token) ] in
783
Added:
Alcotest.(check int) "close redirects" 303 (status closed);
784
Added:
(* A discarded flow stores nothing. *)
785
Added:
Alcotest.(check int)
786
Added:
"no feedback report stored" 0
787
Added:
(List.length
788
Added:
(Lwt_main.run (Memory_repo.feedback repo trainee.Trainee.id)))
789
Added:
);
790
Added:
( "finishing a workout redirects to the logbook feedback prompt",
791
Added:
`Quick,
792
Added:
fun () ->
793
Added:
let c, repo = client_with_repo () in
794
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
795
Added:
let trainee = the_trainee repo ~username:"lifter" in
796
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
797
Added:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
798
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
799
Added:
let _ =
800
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
801
Added:
in
802
Added:
let token = Option.get (csrf_token (body (get c "/workout"))) in
803
Added:
let finished = post c "/workout/finish" [ ("dream.csrf", token) ] in
804
Added:
Alcotest.(check int) "finish redirects" 303 (status finished);
805
Added:
Alcotest.(check bool)
806
Added:
"redirects to the logbook with a feedback prompt" true
807
Added:
(List.mem "/logbook?prompt=feedback"
808
Added:
(Dream.headers finished "Location"));
809
Added:
(* The workout is now in history and no longer in progress. *)
810
Added:
Alcotest.(check int)
811
Added:
"one workout in history" 1
812
Added:
(List.length
813
Added:
(Lwt_main.run (Memory_repo.history repo trainee.Trainee.id)));
814
Added:
Alcotest.(check bool)
815
Added:
"nothing in progress" true
816
Added:
(Option.is_none
817
Added:
(Lwt_main.run
818
Added:
(Memory_repo.in_progress repo trainee.Trainee.id))) );
819
Added:
( "beginning before recovery is refused without an override",
820
Added:
`Quick,
821
Added:
fun () ->
822
Added:
let c, repo = client_with_repo () in
823
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
824
Added:
let trainee = the_trainee repo ~username:"lifter" in
825
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
826
Added:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
827
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
828
Added:
let _ =
829
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
830
Added:
in
831
Added:
let token = Option.get (csrf_token (body (get c "/workout"))) in
832
Added:
let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in
833
Added:
(* Recovery has not elapsed. Beginning the next workout without an
834
Added:
override is bounced back to Home and starts nothing. *)
835
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
836
Added:
let refused =
837
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
838
Added:
in
839
Added:
Alcotest.(check int) "early begin bounced" 303 (status refused);
840
Added:
Alcotest.(check bool)
841
Added:
"returns Home, not the workout" true
842
Added:
(List.mem "/" (Dream.headers refused "Location"));
843
Added:
Alcotest.(check bool)
844
Added:
"no new workout in progress" true
845
Added:
(Option.is_none
846
Added:
(Lwt_main.run
847
Added:
(Memory_repo.in_progress repo trainee.Trainee.id))) );
848
Added:
( "overriding recovery begins the next workout on an override basis",
849
Added:
`Quick,
850
Added:
fun () ->
851
Added:
let c, repo = client_with_repo () in
852
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
853
Added:
let trainee = the_trainee repo ~username:"lifter" in
854
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
855
Added:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
856
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
857
Added:
let _ =
858
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
859
Added:
in
860
Added:
let token = Option.get (csrf_token (body (get c "/workout"))) in
861
Added:
let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in
862
Added:
(* Recovery has not elapsed, so the next workout is begun under an
863
Added:
explicit override. The deviation is recorded on the workout's
864
Added:
clearance basis, never silent. *)
865
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
866
Added:
let began =
867
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "true") ]
868
Added:
in
869
Added:
Alcotest.(check int) "override begin succeeds" 303 (status began);
870
Added:
let basis =
871
Added:
match
872
Added:
Lwt_main.run (Memory_repo.in_progress repo trainee.Trainee.id)
873
Added:
with
874
Added:
| Some w -> Recovery.basis (Evidence.Workout.clearance w)
875
Added:
| None -> Alcotest.failf "expected a workout in progress"
876
Added:
in
877
Added:
Alcotest.(check bool)
878
Added:
"the workout carries an override basis" true
879
Added:
(match basis with Recovery.Overridden _ -> true | _ -> false) );
880
Added:
] );
881
Added:
( "web.app_feedback",
882
Added:
[
883
Added:
( "the app feedback screen and its tabs are served",
884
Added:
`Quick,
885
Added:
fun () ->
886
Added:
let c = client () in
887
Added:
let _ = sign_in_new c in
888
Added:
Alcotest.(check int)
889
Added:
"write tab served" 200
890
Added:
(status (get c "/app-feedback"));
891
Added:
Alcotest.(check int)
892
Added:
"submitted tab served" 200
893
Added:
(status (get c "/app-feedback?tab=submitted")) );
894
Added:
( "blank app feedback is refused; a real message is stored",
895
Added:
`Quick,
896
Added:
fun () ->
897
Added:
let c, repo = client_with_repo () in
898
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
899
Added:
let trainee = the_trainee repo ~username:"lifter" in
900
Added:
let stored_count () =
901
Added:
List.length
902
Added:
(Lwt_main.run
903
Added:
(Memory_repo.app_feedback repo ~viewer:trainee.Trainee.id))
904
Added:
in
905
Added:
let token =
906
Added:
Option.get (csrf_token (body (get c "/app-feedback")))
907
Added:
in
908
Added:
let blank =
909
Added:
post c "/app-feedback/submit"
910
Added:
[ ("dream.csrf", token); ("message", " ") ]
911
Added:
in
912
Added:
Alcotest.(check int) "blank message redirects" 303 (status blank);
913
Added:
Alcotest.(check bool)
914
Added:
"redirects to the write tab" true
915
Added:
(List.mem "/app-feedback?tab=write"
916
Added:
(Dream.headers blank "Location"));
917
Added:
(* Blank input stored nothing. *)
918
Added:
Alcotest.(check int)
919
Added:
"no report stored for blank input" 0 (stored_count ());
920
Added:
let token =
921
Added:
Option.get (csrf_token (body (get c "/app-feedback")))
922
Added:
in
923
Added:
let submitted =
924
Added:
post c "/app-feedback/submit"
925
Added:
[
926
Added:
("dream.csrf", token);
927
Added:
("message", "The app is clear.\nThank you!");
928
Added:
]
929
Added:
in
930
Added:
Alcotest.(check int) "message is accepted" 303 (status submitted);
931
Added:
Alcotest.(check bool)
932
Added:
"redirects to submitted feedback" true
933
Added:
(List.mem "/app-feedback?tab=submitted"
934
Added:
(Dream.headers submitted "Location"));
935
Added:
(* The report now exists with the exact message. *)
936
Added:
let reports =
937
Added:
Lwt_main.run
938
Added:
(Memory_repo.app_feedback repo ~viewer:trainee.Trainee.id)
939
Added:
in
940
Added:
Alcotest.(check int) "one report stored" 1 (List.length reports);
941
Added:
Alcotest.(check string)
942
Added:
"stores the exact message" "The app is clear.\nThank you!"
943
Added:
(List.hd reports).Repository.message );
944
Added:
( "feedback records its author and accepts another trainee's vote",
945
Added:
`Quick,
946
Added:
fun () ->
947
Added:
let alice = client () in
948
Added:
let _ = register alice ~username:"alice" ~password:"heavyduty1" in
949
Added:
let bob = { alice with jar = [] } in
950
Added:
let _ = register bob ~username:"bobby" ~password:"heavyduty1" in
951
Added:
let submit client message =
952
Added:
let token =
953
Added:
Option.get (csrf_token (body (get client "/app-feedback")))
954
Added:
in
955
Added:
post client "/app-feedback/submit"
956
Added:
[ ("dream.csrf", token); ("message", message) ]
957
Added:
in
958
Added:
Alcotest.(check int)
959
Added:
"alice feedback accepted" 303
960
Added:
(status (submit alice "Alice report"));
961
Added:
Alcotest.(check int)
962
Added:
"bob feedback accepted" 303
963
Added:
(status (submit bob "Bob report"));
964
Added:
(* Bob's report is t2:1 — the vote control on Alice's view posts
965
Added:
there. Alice upvotes it. *)
966
Added:
let list_page = body (get alice "/app-feedback?tab=submitted") in
967
Added:
let token = Option.get (csrf_token list_page) in
968
Added:
let voted =
969
Added:
post alice "/app-feedback/t2:1/upvote" [ ("dream.csrf", token) ]
970
Added:
in
971
Added:
Alcotest.(check int) "upvote redirects" 303 (status voted) );
972
Added:
( "an owner can edit and remove their feedback",
973
Added:
`Quick,
974
Added:
fun () ->
975
Added:
let c, repo = client_with_repo () in
976
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
977
Added:
let trainee = the_trainee repo ~username:"lifter" in
978
Added:
let token =
979
Added:
Option.get (csrf_token (body (get c "/app-feedback")))
980
Added:
in
981
Added:
let _ =
982
Added:
post c "/app-feedback/submit"
983
Added:
[ ("dream.csrf", token); ("message", "First report") ]
984
Added:
in
985
Added:
let feedback_id () =
986
Added:
(List.hd
987
Added:
(Lwt_main.run
988
Added:
(Memory_repo.app_feedback repo ~viewer:trainee.Trainee.id)))
989
Added:
.Repository.feedback_id |> Repository.app_feedback_id_to_string
990
Added:
in
991
Added:
let id = feedback_id () in
992
Added:
(* A blank edit is refused and changes nothing. *)
993
Added:
let token =
994
Added:
Option.get
995
Added:
(csrf_token (body (get c "/app-feedback?tab=submitted")))
996
Added:
in
997
Added:
let blank =
998
Added:
post c
999
Added:
("/app-feedback/" ^ id ^ "/edit")
1000
Added:
[ ("dream.csrf", token); ("message", " ") ]
1001
Added:
in
1002
Added:
Alcotest.(check int) "blank edit redirects" 303 (status blank);
1003
Added:
Alcotest.(check string)
1004
Added:
"message unchanged by blank edit" "First report"
1005
Added:
(List.hd
1006
Added:
(Lwt_main.run
1007
Added:
(Memory_repo.app_feedback repo ~viewer:trainee.Trainee.id)))
1008
Added:
.Repository.message;
1009
Added:
(* A real edit changes the stored message. *)
1010
Added:
let token =
1011
Added:
Option.get
1012
Added:
(csrf_token (body (get c "/app-feedback?tab=submitted")))
1013
Added:
in
1014
Added:
let edited =
1015
Added:
post c
1016
Added:
("/app-feedback/" ^ id ^ "/edit")
1017
Added:
[ ("dream.csrf", token); ("message", "Edited report") ]
1018
Added:
in
1019
Added:
Alcotest.(check int) "edit redirects" 303 (status edited);
1020
Added:
Alcotest.(check string)
1021
Added:
"message updated by edit" "Edited report"
1022
Added:
(List.hd
1023
Added:
(Lwt_main.run
1024
Added:
(Memory_repo.app_feedback repo ~viewer:trainee.Trainee.id)))
1025
Added:
.Repository.message;
1026
Added:
(* Removal deletes the report. *)
1027
Added:
let token =
1028
Added:
Option.get
1029
Added:
(csrf_token (body (get c "/app-feedback?tab=submitted")))
1030
Added:
in
1031
Added:
let removed =
1032
Added:
post c
1033
Added:
("/app-feedback/" ^ id ^ "/remove")
1034
Added:
[ ("dream.csrf", token) ]
1035
Added:
in
1036
Added:
Alcotest.(check int) "remove redirects" 303 (status removed);
1037
Added:
Alcotest.(check int)
1038
Added:
"report removed" 0
1039
Added:
(List.length
1040
Added:
(Lwt_main.run
1041
Added:
(Memory_repo.app_feedback repo ~viewer:trainee.Trainee.id)))
1042
Added:
);
1043
Added:
( "another trainee cannot edit or remove app feedback",
1044
Added:
`Quick,
1045
Added:
fun () ->
1046
Added:
let alice, repo = client_with_repo () in
1047
Added:
let _ = register alice ~username:"alice" ~password:"heavyduty1" in
1048
Added:
let bob = { alice with jar = [] } in
1049
Added:
let _ = register bob ~username:"bobby" ~password:"heavyduty1" in
1050
Added:
let bob_trainee = the_trainee repo ~username:"bobby" in
1051
Added:
(* Bob owns t2:1. Alice attempts to edit and remove it. Both are
1052
Added:
refused at the ownership check, so the report and its message
1053
Added:
survive. *)
1054
Added:
let token =
1055
Added:
Option.get (csrf_token (body (get bob "/app-feedback")))
1056
Added:
in
1057
Added:
let _ =
1058
Added:
post bob "/app-feedback/submit"
1059
Added:
[ ("dream.csrf", token); ("message", "Bob owns this") ]
1060
Added:
in
1061
Added:
let stored () =
1062
Added:
Lwt_main.run
1063
Added:
(Memory_repo.app_feedback repo ~viewer:bob_trainee.Trainee.id)
1064
Added:
in
1065
Added:
Alcotest.(check int)
1066
Added:
"one report before cross-user attempts" 1
1067
Added:
(List.length (stored ()));
1068
Added:
let token =
1069
Added:
Option.get
1070
Added:
(csrf_token (body (get alice "/app-feedback?tab=submitted")))
1071
Added:
in
1072
Added:
let edited =
1073
Added:
post alice "/app-feedback/t2:1/edit"
1074
Added:
[ ("dream.csrf", token); ("message", "Taken over") ]
1075
Added:
in
1076
Added:
Alcotest.(check int) "cross-user edit redirects" 303 (status edited);
1077
Added:
let token =
1078
Added:
Option.get
1079
Added:
(csrf_token (body (get alice "/app-feedback?tab=submitted")))
1080
Added:
in
1081
Added:
let removed =
1082
Added:
post alice "/app-feedback/t2:1/remove" [ ("dream.csrf", token) ]
1083
Added:
in
1084
Added:
Alcotest.(check int)
1085
Added:
"cross-user remove redirects" 303 (status removed);
1086
Added:
(* The report still exists with its original message: the cross-user
1087
Added:
attempts changed nothing. *)
1088
Added:
let after = stored () in
1089
Added:
Alcotest.(check int)
1090
Added:
"report survives cross-user attempts" 1 (List.length after);
1091
Added:
Alcotest.(check string)
1092
Added:
"message is unchanged" "Bob owns this"
1093
Added:
(List.hd after).Repository.message );
1094
Added:
] );
1095
Added:
( "web.profile",
1096
Added:
[
1097
Added:
( "the profile page is served for a signed-in trainee",
1098
Added:
`Quick,
1099
Added:
fun () ->
1100
Added:
let c = client () in
1101
Added:
let _ = sign_in_new c in
1102
Added:
Alcotest.(check int)
1103
Added:
"profile served" 200
1104
Added:
(status (get c "/profile")) );
1105
Added:
( "changing the username updates the stored account",
1106
Added:
`Quick,
1107
Added:
fun () ->
1108
Added:
let c, repo = client_with_repo () in
1109
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
1110
Added:
let trainee = the_trainee repo ~username:"lifter" in
1111
Added:
let token = Option.get (csrf_token (body (get c "/profile"))) in
1112
Added:
let changed =
1113
Added:
post c "/profile/username"
1114
Added:
[ ("dream.csrf", token); ("username", "athlete") ]
1115
Added:
in
1116
Added:
Alcotest.(check int)
1117
Added:
"redirects after the change" 303 (status changed);
1118
Added:
Alcotest.(check bool)
1119
Added:
"redirects back to the profile with a notice" true
1120
Added:
(List.mem "/profile?changed=username"
1121
Added:
(Dream.headers changed "Location"));
1122
Added:
(* The account now answers to the new name, and no longer to the
1123
Added:
old one. *)
1124
Added:
let renamed =
1125
Added:
Lwt_main.run (Memory_repo.find_trainee repo trainee.Trainee.id)
1126
Added:
in
1127
Added:
Alcotest.(check (option string))
1128
Added:
"stored under the new username" (Some "athlete")
1129
Added:
(Option.map
1130
Added:
(fun t -> Trainee.username_to_string t.Trainee.username)
1131
Added:
renamed);
1132
Added:
Alcotest.(check bool)
1133
Added:
"old name no longer resolves" true
1134
Added:
(Option.is_none
1135
Added:
(Lwt_main.run
1136
Added:
(match Trainee.username "lifter" with
1137
Added:
| Ok u -> Memory_repo.find_trainee_by_username repo u
1138
Added:
| Error _ -> Lwt.return None))) );
1139
Added:
( "a taken username is refused and the account keeps its name",
1140
Added:
`Quick,
1141
Added:
fun () ->
1142
Added:
let c, repo = client_with_repo () in
1143
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
1144
Added:
let trainee = the_trainee repo ~username:"lifter" in
1145
Added:
(* Register a second account in the same store. *)
1146
Added:
let other = { c with jar = [] } in
1147
Added:
let _ = register other ~username:"taken" ~password:"heavyduty1" in
1148
Added:
let token = Option.get (csrf_token (body (get c "/profile"))) in
1149
Added:
let refused =
1150
Added:
post c "/profile/username"
1151
Added:
[ ("dream.csrf", token); ("username", "taken") ]
1152
Added:
in
1153
Added:
Alcotest.(check int)
1154
Added:
"renders an invalid response" 400 (status refused);
1155
Added:
(* The account still holds its original name. *)
1156
Added:
Alcotest.(check (option string))
1157
Added:
"name unchanged after refusal" (Some "lifter")
1158
Added:
(Option.map
1159
Added:
(fun t -> Trainee.username_to_string t.Trainee.username)
1160
Added:
(Lwt_main.run
1161
Added:
(Memory_repo.find_trainee repo trainee.Trainee.id))) );
1162
Added:
( "changing the password requires the current one",
1163
Added:
`Quick,
1164
Added:
fun () ->
1165
Added:
let c = client () in
1166
Added:
let _ = sign_in_new c in
1167
Added:
let token = Option.get (csrf_token (body (get c "/profile"))) in
1168
Added:
let refused =
1169
Added:
post c "/profile/password"
1170
Added:
[
1171
Added:
("dream.csrf", token);
1172
Added:
("current", "wrongpass");
1173
Added:
("next", "newsecret1");
1174
Added:
]
1175
Added:
in
1176
Added:
Alcotest.(check int)
1177
Added:
"renders an invalid response" 400 (status refused);
1178
Added:
(* Now change it with the correct current password. *)
1179
Added:
let token = Option.get (csrf_token (body (get c "/profile"))) in
1180
Added:
let changed =
1181
Added:
post c "/profile/password"
1182
Added:
[
1183
Added:
("dream.csrf", token);
1184
Added:
("current", "heavyduty1");
1185
Added:
("next", "newsecret1");
1186
Added:
]
1187
Added:
in
1188
Added:
Alcotest.(check int)
1189
Added:
"redirects after the change" 303 (status changed);
1190
Added:
Alcotest.(check bool)
1191
Added:
"redirects back to the profile with a notice" true
1192
Added:
(List.mem "/profile?changed=password"
1193
Added:
(Dream.headers changed "Location"));
1194
Added:
(* The new password now authenticates and the old one no longer
1195
Added:
does. Sign out, then prove the change through the sign-in flow. *)
1196
Added:
let token = Option.get (csrf_token (body (get c "/profile"))) in
1197
Added:
let _ = post c "/logout" [ ("dream.csrf", token) ] in
1198
Added:
let old_pw = sign_in c ~username:"lifter" ~password:"heavyduty1" in
1199
Added:
Alcotest.(check int)
1200
Added:
"the old password no longer works" 401 (status old_pw);
1201
Added:
let new_pw = sign_in c ~username:"lifter" ~password:"newsecret1" in
1202
Added:
Alcotest.(check int)
1203
Added:
"the new password authenticates" 303 (status new_pw) );
1204
Added:
] );
1205
Added:
( "web.errors",
1206
Added:
[
1207
Added:
( "an unknown path responds 404",
1208
Added:
`Quick,
1209
Added:
fun () ->
1210
Added:
let c = client () in
1211
Added:
let _ = sign_in_new c in
1212
Added:
Alcotest.(check int)
1213
Added:
"responds 404" 404
1214
Added:
(status (get c "/no-such-page")) );
1215
Added:
( "the 404 response never depends on a session",
1216
Added:
`Quick,
1217
Added:
fun () ->
1218
Added:
(* No sign-in: an unauthenticated visitor still gets a 404, not a
1219
Added:
redirect to sign-in. The branded page is not routed through the
1220
Added:
session guard. *)
1221
Added:
let c = client () in
1222
Added:
Alcotest.(check int)
1223
Added:
"unauthenticated 404" 404
1224
Added:
(status (get c "/deep/unknown/path")) );
1225
Added:
] );
1226
Added:
( "web.sign_in",
1227
Added:
[
1228
Added:
( "a returning trainee signs in with their credentials",
1229
Added:
`Quick,
1230
Added:
fun () ->
1231
Added:
(* Register, then sign out, then sign back in through the credential
1232
Added:
form. This exercises [POST /login], which registration's
1233
Added:
auto-sign-in never touches. *)
1234
Added:
let c = client () in
1235
Added:
let _ = sign_in_new c in
1236
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
1237
Added:
let _ = post c "/logout" [ ("dream.csrf", token) ] in
1238
Added:
Alcotest.(check int)
1239
Added:
"signed out, overview redirects" 303
1240
Added:
(status (get c "/"));
1241
Added:
let signed_in =
1242
Added:
sign_in c ~username:"lifter" ~password:"heavyduty1"
1243
Added:
in
1244
Added:
Alcotest.(check int) "sign-in redirects" 303 (status signed_in);
1245
Added:
Alcotest.(check bool)
1246
Added:
"sign-in lands on Home" true
1247
Added:
(List.mem "/" (Dream.headers signed_in "Location"));
1248
Added:
Alcotest.(check int)
1249
Added:
"authenticated overview" 200
1250
Added:
(status (get c "/")) );
1251
Added:
( "a wrong password is refused and establishes no session",
1252
Added:
`Quick,
1253
Added:
fun () ->
1254
Added:
let c = client () in
1255
Added:
let _ = sign_in_new c in
1256
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
1257
Added:
let _ = post c "/logout" [ ("dream.csrf", token) ] in
1258
Added:
let refused =
1259
Added:
sign_in c ~username:"lifter" ~password:"not-the-password"
1260
Added:
in
1261
Added:
Alcotest.(check int) "rejected" 401 (status refused);
1262
Added:
(* The rejected attempt establishes no session. *)
1263
Added:
Alcotest.(check int)
1264
Added:
"still unauthenticated" 303
1265
Added:
(status (get c "/")) );
1266
Added:
( "an unknown username is refused like a wrong password",
1267
Added:
`Quick,
1268
Added:
fun () ->
1269
Added:
let c = client () in
1270
Added:
let refused = sign_in c ~username:"nobody" ~password:"heavyduty1" in
1271
Added:
Alcotest.(check int) "rejected" 401 (status refused);
1272
Added:
Alcotest.(check int)
1273
Added:
"no session established" 303
1274
Added:
(status (get c "/")) );
1275
Added:
( "an already-authenticated visit to the sign-in page redirects Home",
1276
Added:
`Quick,
1277
Added:
fun () ->
1278
Added:
let c = client () in
1279
Added:
let _ = sign_in_new c in
1280
Added:
let response = get c "/login" in
1281
Added:
Alcotest.(check int) "redirects" 303 (status response);
1282
Added:
Alcotest.(check bool)
1283
Added:
"sends an authenticated visitor Home" true
1284
Added:
(List.mem "/" (Dream.headers response "Location")) );
1285
Added:
( "an already-authenticated visit to the register page redirects Home",
1286
Added:
`Quick,
1287
Added:
fun () ->
1288
Added:
let c = client () in
1289
Added:
let _ = sign_in_new c in
1290
Added:
let response = get c "/register" in
1291
Added:
Alcotest.(check int) "redirects" 303 (status response);
1292
Added:
Alcotest.(check bool)
1293
Added:
"sends an authenticated visitor Home" true
1294
Added:
(List.mem "/" (Dream.headers response "Location")) );
1295
Added:
] );
1296
Added:
( "web.routine_selection",
1297
Added:
[
1298
Added:
( "selecting an unknown routine is not found and selects nothing",
1299
Added:
`Quick,
1300
Added:
fun () ->
1301
Added:
let c, repo = client_with_repo () in
1302
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
1303
Added:
let trainee = the_trainee repo ~username:"lifter" in
1304
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
1305
Added:
let response =
1306
Added:
post c "/routines/no-such-routine/select"
1307
Added:
[ ("dream.csrf", token) ]
1308
Added:
in
1309
Added:
Alcotest.(check int) "responds 404" 404 (status response);
1310
Added:
(* A missing routine leaves the trainee with no active routine. *)
1311
Added:
Alcotest.(check bool)
1312
Added:
"no routine was selected" true
1313
Added:
(Option.is_none
1314
Added:
(Lwt_main.run
1315
Added:
(Memory_repo.active_routine repo trainee.Trainee.id))) );
1316
Added:
] );
1317
Added:
( "web.saved_record_add",
1318
Added:
[
1319
Added:
( "an outstanding slot of a saved workout can be recorded, not only \
1320
Added:
corrected",
1321
Added:
`Quick,
1322
Added:
fun () ->
1323
Added:
(* Finish a workout with a single slot recorded, so the saved record
1324
Added:
still has outstanding slots. Then record one of those through the
1325
Added:
plain add path [POST /logbook/:id/slots/:d], which the edit tests
1326
Added:
never exercise. *)
1327
Added:
let c, repo = client_with_repo () in
1328
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
1329
Added:
let trainee = the_trainee repo ~username:"lifter" in
1330
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
1331
Added:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
1332
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
1333
Added:
let _ =
1334
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
1335
Added:
in
1336
Added:
(* Record only slot 1, then finish. Slots 0, 2, 3 stay outstanding. *)
1337
Added:
let token =
1338
Added:
Option.get (csrf_token (body (get c "/workout?slot=1")))
1339
Added:
in
1340
Added:
let _ =
1341
Added:
post c "/workout/slots/1"
1342
Added:
[
1343
Added:
("dream.csrf", token);
1344
Added:
("load", "12");
1345
Added:
("reps", "8");
1346
Added:
("extension", "");
1347
Added:
]
1348
Added:
in
1349
Added:
let token = Option.get (csrf_token (body (get c "/workout"))) in
1350
Added:
let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in
1351
Added:
let filled_of_w1 () =
1352
Added:
match
1353
Added:
Lwt_main.run
1354
Added:
(Memory_repo.find repo trainee.Trainee.id
1355
Added:
(Repository.workout_id "w1"))
1356
Added:
with
1357
Added:
| Some r -> Evidence.Workout.filled_slots r.Repository.workout
1358
Added:
| None -> Alcotest.failf "expected the saved workout w1"
1359
Added:
in
1360
Added:
Alcotest.(check int)
1361
Added:
"saved workout starts with one slot" 1 (filled_of_w1 ());
1362
Added:
(* Add slot 2 through the non-edit path. *)
1363
Added:
let token =
1364
Added:
Option.get (csrf_token (body (get c "/logbook/w1?slot=2")))
1365
Added:
in
1366
Added:
let added =
1367
Added:
post c "/logbook/w1/slots/2"
1368
Added:
[
1369
Added:
("dream.csrf", token);
1370
Added:
("load", "10");
1371
Added:
("reps", "9");
1372
Added:
("extension", "");
1373
Added:
]
1374
Added:
in
1375
Added:
Alcotest.(check int)
1376
Added:
"recorded a saved-workout slot" 303 (status added);
1377
Added:
Alcotest.(check int) "now two filled slots" 2 (filled_of_w1 ()) );
1378
Added:
( "recording an already-filled slot through the add path is refused",
1379
Added:
`Quick,
1380
Added:
fun () ->
1381
Added:
(* The add path lists only outstanding slots. A filled slot is not
1382
Added:
awaiting a record, so posting to it is a 404, not a silent second
1383
Added:
entry that would add volume. *)
1384
Added:
let c, repo = client_with_repo () in
1385
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
1386
Added:
let trainee = the_trainee repo ~username:"lifter" in
1387
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
1388
Added:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
1389
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
1390
Added:
let _ =
1391
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
1392
Added:
in
1393
Added:
let token =
1394
Added:
Option.get (csrf_token (body (get c "/workout?slot=1")))
1395
Added:
in
1396
Added:
let _ =
1397
Added:
post c "/workout/slots/1"
1398
Added:
[
1399
Added:
("dream.csrf", token);
1400
Added:
("load", "12");
1401
Added:
("reps", "8");
1402
Added:
("extension", "");
1403
Added:
]
1404
Added:
in
1405
Added:
let token = Option.get (csrf_token (body (get c "/workout"))) in
1406
Added:
let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in
1407
Added:
(* Slot 1 is filled. Re-posting to its add path is refused. *)
1408
Added:
let token =
1409
Added:
Option.get (csrf_token (body (get c "/logbook/w1?slot=2")))
1410
Added:
in
1411
Added:
let refused =
1412
Added:
post c "/logbook/w1/slots/1"
1413
Added:
[
1414
Added:
("dream.csrf", token);
1415
Added:
("load", "20");
1416
Added:
("reps", "6");
1417
Added:
("extension", "");
1418
Added:
]
1419
Added:
in
1420
Added:
Alcotest.(check int)
1421
Added:
"filled slot is not awaiting" 404 (status refused);
1422
Added:
(* The refused post added no volume: still one filled slot. *)
1423
Added:
Alcotest.(check int)
1424
Added:
"still one filled slot" 1
1425
Added:
(match
1426
Added:
Lwt_main.run
1427
Added:
(Memory_repo.find repo trainee.Trainee.id
1428
Added:
(Repository.workout_id "w1"))
1429
Added:
with
1430
Added:
| Some r -> Evidence.Workout.filled_slots r.Repository.workout
1431
Added:
| None -> Alcotest.failf "expected the saved workout w1") );
1432
Added:
] );
1433
Added:
( "web.slot_bounds",
1434
Added:
[
1435
Added:
( "posting to a slot beyond the workout is not found",
1436
Added:
`Quick,
1437
Added:
fun () ->
1438
Added:
(* Day 1 has four slots (0..3). Slot 9 does not exist, so the log
1439
Added:
handler answers 404 rather than recording phantom volume. *)
1440
Added:
let c, repo = client_with_repo () in
1441
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
1442
Added:
let trainee = the_trainee repo ~username:"lifter" in
1443
Added:
let _ = start_day_one c in
1444
Added:
let token = Option.get (csrf_token (body (get c "/workout"))) in
1445
Added:
let response =
1446
Added:
post c "/workout/slots/9"
1447
Added:
[
1448
Added:
("dream.csrf", token);
1449
Added:
("load", "10");
1450
Added:
("reps", "8");
1451
Added:
("extension", "");
1452
Added:
]
1453
Added:
in
1454
Added:
Alcotest.(check int)
1455
Added:
"out-of-range slot is not found" 404 (status response);
1456
Added:
(* No phantom volume was recorded. *)
1457
Added:
Alcotest.(check int)
1458
Added:
"nothing recorded" 0
1459
Added:
(match
1460
Added:
Lwt_main.run (Memory_repo.in_progress repo trainee.Trainee.id)
1461
Added:
with
1462
Added:
| Some w -> Evidence.Workout.filled_slots w
1463
Added:
| None -> Alcotest.failf "expected a workout in progress") );
1464
Added:
( "editing a slot beyond the workout is not found",
1465
Added:
`Quick,
1466
Added:
fun () ->
1467
Added:
let c = client () in
1468
Added:
let _ = sign_in_new c in
1469
Added:
let _ = start_day_one c in
1470
Added:
let token = Option.get (csrf_token (body (get c "/workout"))) in
1471
Added:
let response =
1472
Added:
post c "/workout/slots/9/edit"
1473
Added:
[
1474
Added:
("dream.csrf", token);
1475
Added:
("load", "10");
1476
Added:
("reps", "8");
1477
Added:
("extension", "");
1478
Added:
]
1479
Added:
in
1480
Added:
Alcotest.(check int)
1481
Added:
"out-of-range edit is not found" 404 (status response) );
1482
Added:
( "logging with no workout in progress is not found",
1483
Added:
`Quick,
1484
Added:
fun () ->
1485
Added:
let c = client () in
1486
Added:
let _ = sign_in_new c in
1487
Added:
(* No routine selected, no workout begun: the CSRF token comes from
1488
Added:
Home, but the slot route has no workout to record against. *)
1489
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
1490
Added:
let response =
1491
Added:
post c "/workout/slots/0"
1492
Added:
[
1493
Added:
("dream.csrf", token);
1494
Added:
("load", "10");
1495
Added:
("reps", "8");
1496
Added:
("extension", "");
1497
Added:
]
1498
Added:
in
1499
Added:
Alcotest.(check int) "no workout is not found" 404 (status response)
1500
Added:
);
1501
Added:
] );
1502
Added:
( "web.duplicate_feedback",
1503
Added:
[
1504
Added:
( "a step out of sync with the session records nothing",
1505
Added:
`Quick,
1506
Added:
fun () ->
1507
Added:
(* The flow advances one factor at a time and stores its position in
1508
Added:
the session. A post whose [step] disagrees with that position —
1509
Added:
a stale form, a double submit, or a crafted body — is refused as
1510
Added:
an invalid form rather than recording a factor twice. This is the
1511
Added:
web tier's guard against a duplicate signal ever reaching the
1512
Added:
domain. *)
1513
Added:
let c, repo = client_with_repo () in
1514
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
1515
Added:
let trainee = the_trainee repo ~username:"lifter" in
1516
Added:
let start = body (get c "/logbook?feedback=start") in
1517
Added:
let token = Option.get (csrf_token start) in
1518
Added:
(* The session is at step 0; post step 3 instead. *)
1519
Added:
let mismatched =
1520
Added:
post c "/feedback"
1521
Added:
[
1522
Added:
("dream.csrf", token);
1523
Added:
("step", "3");
1524
Added:
("action", "next");
1525
Added:
("choice", "1");
1526
Added:
]
1527
Added:
in
1528
Added:
Alcotest.(check int)
1529
Added:
"mismatched step redirects" 303 (status mismatched);
1530
Added:
(* The mismatched post advanced nothing and stored no report. *)
1531
Added:
Alcotest.(check int)
1532
Added:
"no feedback stored" 0
1533
Added:
(List.length
1534
Added:
(Lwt_main.run (Memory_repo.feedback repo trainee.Trainee.id)))
1535
Added:
);
1536
Added:
( "answering every factor stores exactly one signal per category",
1537
Added:
`Quick,
1538
Added:
fun () ->
1539
Added:
(* The flow admits one answer per factor, so the stored report holds
1540
Added:
one signal per category and never a duplicate. Walking all five
1541
Added:
factors and saving proves the whole set persists without a
1542
Added:
duplicate-signal rejection. *)
1543
Added:
let c, repo = client_with_repo () in
1544
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
1545
Added:
let trainee = the_trainee repo ~username:"lifter" in
1546
Added:
let _ = get c "/logbook?feedback=start" in
1547
Added:
let rec advance step =
1548
Added:
if step < 5 then begin
1549
Added:
let token = Option.get (csrf_token (body (get c "/logbook"))) in
1550
Added:
let _ =
1551
Added:
post c "/feedback"
1552
Added:
[
1553
Added:
("dream.csrf", token);
1554
Added:
("step", string_of_int step);
1555
Added:
("action", "next");
1556
Added:
("choice", "1");
1557
Added:
]
1558
Added:
in
1559
Added:
advance (step + 1)
1560
Added:
end
1561
Added:
in
1562
Added:
advance 0;
1563
Added:
let token = Option.get (csrf_token (body (get c "/logbook"))) in
1564
Added:
let saved =
1565
Added:
post c "/feedback"
1566
Added:
[ ("dream.csrf", token); ("step", "5"); ("action", "save") ]
1567
Added:
in
1568
Added:
Alcotest.(check int) "final save redirects" 303 (status saved);
1569
Added:
(* Exactly one report, with one signal per distinct factor. *)
1570
Added:
let reports =
1571
Added:
Lwt_main.run (Memory_repo.feedback repo trainee.Trainee.id)
1572
Added:
in
1573
Added:
Alcotest.(check int) "one report stored" 1 (List.length reports);
1574
Added:
let signals = Evidence.Feedback.signals (List.hd reports) in
1575
Added:
let count p = List.length (List.filter p signals) in
1576
Added:
let open Evidence.Feedback in
1577
Added:
Alcotest.(check int)
1578
Added:
"one sleep signal" 1
1579
Added:
(count (function Sleep _ -> true | _ -> false));
1580
Added:
Alcotest.(check int)
1581
Added:
"one appetite signal" 1
1582
Added:
(count (function Appetite _ -> true | _ -> false));
1583
Added:
Alcotest.(check int)
1584
Added:
"one readiness signal" 1
1585
Added:
(count (function Readiness _ -> true | _ -> false));
1586
Added:
Alcotest.(check int)
1587
Added:
"one motivation signal" 1
1588
Added:
(count (function Motivation _ -> true | _ -> false));
1589
Added:
Alcotest.(check int)
1590
Added:
"one difficulty signal" 1
1591
Added:
(count (function Difficulty _ -> true | _ -> false)) );
1592
Added:
] );
1593
Added:
( "web.lifecycle",
1594
Added:
[
1595
Added:
( "a full cycle: begin Day 1, record every slot, finish, and see it \
1596
Added:
saved complete",
1597
Added:
`Quick,
1598
Added:
fun () ->
1599
Added:
(* A deep end-to-end pass over the primary flow with a driven clock.
1600
Added:
Begin Day 1, record all four slots, finish, and confirm the
1601
Added:
logbook persists a complete Day 1 with four stimuli. The clocked
1602
Added:
client and repo share a store, so the flow's domain effect is
1603
Added:
read straight from history. *)
1604
Added:
let c, now, repo = clocked_client () in
1605
Added:
now := day 10;
1606
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
1607
Added:
let trainee = the_trainee repo ~username:"lifter" in
1608
Added:
let _ = start_day_one c in
1609
Added:
let in_progress_filled () =
1610
Added:
match
1611
Added:
Lwt_main.run (Memory_repo.in_progress repo trainee.Trainee.id)
1612
Added:
with
1613
Added:
| Some w -> Evidence.Workout.filled_slots w
1614
Added:
| None -> Alcotest.failf "expected a workout in progress"
1615
Added:
in
1616
Added:
Alcotest.(check int)
1617
Added:
"opens with no slots recorded" 0 (in_progress_filled ());
1618
Added:
record_all_day_one_slots c;
1619
Added:
Alcotest.(check int)
1620
Added:
"all four slots recorded" 4 (in_progress_filled ());
1621
Added:
let token = Option.get (csrf_token (body (get c "/workout"))) in
1622
Added:
let finished = post c "/workout/finish" [ ("dream.csrf", token) ] in
1623
Added:
Alcotest.(check int) "finish redirects" 303 (status finished);
1624
Added:
Alcotest.(check bool)
1625
Added:
"sends the trainee to the logbook feedback prompt" true
1626
Added:
(List.mem "/logbook?prompt=feedback"
1627
Added:
(Dream.headers finished "Location"));
1628
Added:
(* History holds one complete Day 1 with four stimuli. *)
1629
Added:
let history =
1630
Added:
Lwt_main.run (Memory_repo.history repo trainee.Trainee.id)
1631
Added:
in
1632
Added:
Alcotest.(check int)
1633
Added:
"one workout in history" 1 (List.length history);
1634
Added:
let saved = (List.hd history).Repository.workout in
1635
Added:
Alcotest.(check string)
1636
Added:
"the saved workout is Day 1" "Day 1"
1637
Added:
(Prescription.Workout.name (Evidence.Workout.prescription saved));
1638
Added:
Alcotest.(check int)
1639
Added:
"records four stimuli" 4
1640
Added:
(List.length (Evidence.Workout.stimuli saved));
1641
Added:
Alcotest.(check bool)
1642
Added:
"the saved workout is complete" true
1643
Added:
(Evidence.Workout.completeness saved = Evidence.Workout.Complete);
1644
Added:
(* The saved workout is durable and reachable at its own URL. *)
1645
Added:
Alcotest.(check int)
1646
Added:
"the saved workout is reachable" 200
1647
Added:
(status (get c "/logbook/w1")) );
1648
Added:
( "the recovery gate blocks the next workout until enough rest, then \
1649
Added:
Day 2 begins",
1650
Added:
`Quick,
1651
Added:
fun () ->
1652
Added:
(* The deepest flow: after finishing Day 1, the next workout is
1653
Added:
gated until 48 hours of recovery pass. The web tier drives the
1654
Added:
clock, so this proves the gate over HTTP, not just in the
1655
Added:
service. Beginning too early is refused; resting past the
1656
Added:
interval clears the gate and advances the cycle to Day 2. *)
1657
Added:
let c, now, repo = clocked_client () in
1658
Added:
now := day 10;
1659
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
1660
Added:
let trainee = the_trainee repo ~username:"lifter" in
1661
Added:
let _ = start_day_one c in
1662
Added:
record_all_day_one_slots c;
1663
Added:
let token = Option.get (csrf_token (body (get c "/workout"))) in
1664
Added:
let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in
1665
Added:
(* One hour later: recovery is far from complete. Beginning without
1666
Added:
an override is refused and starts nothing. *)
1667
Added:
now := day 10 + 3600;
1668
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
1669
Added:
let refused =
1670
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
1671
Added:
in
1672
Added:
Alcotest.(check int)
1673
Added:
"an early begin is bounced back" 303 (status refused);
1674
Added:
Alcotest.(check bool)
1675
Added:
"the early begin returns Home, not the workout" true
1676
Added:
(List.mem "/" (Dream.headers refused "Location"));
1677
Added:
Alcotest.(check bool)
1678
Added:
"no workout was started" true
1679
Added:
(Option.is_none
1680
Added:
(Lwt_main.run
1681
Added:
(Memory_repo.in_progress repo trainee.Trainee.id)));
1682
Added:
(* Rest two full days: past the 48-hour training interval. The gate
1683
Added:
clears and the next begin succeeds. *)
1684
Added:
now := day 13;
1685
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
1686
Added:
let began =
1687
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
1688
Added:
in
1689
Added:
Alcotest.(check int) "the rested begin succeeds" 303 (status began);
1690
Added:
Alcotest.(check bool)
1691
Added:
"the rested begin reaches the workout" true
1692
Added:
(List.mem "/workout" (Dream.headers began "Location"));
1693
Added:
(* The cycle has advanced to Day 2, cleared on recovery, not an
1694
Added:
override. *)
1695
Added:
let workout =
1696
Added:
match
1697
Added:
Lwt_main.run (Memory_repo.in_progress repo trainee.Trainee.id)
1698
Added:
with
1699
Added:
| Some w -> w
1700
Added:
| None -> Alcotest.failf "expected a workout in progress"
1701
Added:
in
1702
Added:
Alcotest.(check string)
1703
Added:
"the cycle advanced to Day 2" "Day 2"
1704
Added:
(Prescription.Workout.name
1705
Added:
(Evidence.Workout.prescription workout));
1706
Added:
Alcotest.(check bool)
1707
Added:
"cleared on recovery, not an override" true
1708
Added:
(match Recovery.basis (Evidence.Workout.clearance workout) with
1709
Added:
| Recovery.Recovered -> true
1710
Added:
| Recovery.Overridden _ -> false) );
1711
Added:
] );
1712
Added:
( "web.isolation",
1713
Added:
[
1714
Added:
( "two trainees never share workout or logbook state",
1715
Added:
`Quick,
1716
Added:
fun () ->
1717
Added:
(* Two trainees on the same store, each with their own cookie jar.
1718
Added:
One begins and finishes a workout; the other must see none of it:
1719
Added:
not the in-progress workout, not the saved record. This proves
1720
Added:
the per-trainee scoping the service promises, over HTTP. *)
1721
Added:
let alice, repo = client_with_repo () in
1722
Added:
let _ = register alice ~username:"alice" ~password:"heavyduty1" in
1723
Added:
let bob = { alice with jar = [] } in
1724
Added:
let _ = register bob ~username:"bobby" ~password:"heavyduty1" in
1725
Added:
let alice_t = the_trainee repo ~username:"alice" in
1726
Added:
let bob_t = the_trainee repo ~username:"bobby" in
1727
Added:
(* Alice selects and begins a workout, records a slot. *)
1728
Added:
let token = Option.get (csrf_token (body (get alice "/"))) in
1729
Added:
let _ =
1730
Added:
post alice "/routines/ideal/select" [ ("dream.csrf", token) ]
1731
Added:
in
1732
Added:
let token = Option.get (csrf_token (body (get alice "/"))) in
1733
Added:
let _ =
1734
Added:
post alice "/workout"
1735
Added:
[ ("dream.csrf", token); ("override", "false") ]
1736
Added:
in
1737
Added:
let token =
1738
Added:
Option.get (csrf_token (body (get alice "/workout?slot=1")))
1739
Added:
in
1740
Added:
let _ =
1741
Added:
post alice "/workout/slots/1"
1742
Added:
[
1743
Added:
("dream.csrf", token);
1744
Added:
("load", "12");
1745
Added:
("reps", "8");
1746
Added:
("extension", "");
1747
Added:
]
1748
Added:
in
1749
Added:
(* Alice has a workout in progress; Bob does not. *)
1750
Added:
Alcotest.(check bool)
1751
Added:
"Alice has a workout in progress" true
1752
Added:
(Option.is_some
1753
Added:
(Lwt_main.run
1754
Added:
(Memory_repo.in_progress repo alice_t.Trainee.id)));
1755
Added:
Alcotest.(check bool)
1756
Added:
"Bob has no workout in progress" true
1757
Added:
(Option.is_none
1758
Added:
(Lwt_main.run (Memory_repo.in_progress repo bob_t.Trainee.id)));
1759
Added:
Alcotest.(check int)
1760
Added:
"Bob's workout view redirects" 303
1761
Added:
(status (get bob "/workout"));
1762
Added:
(* Alice finishes; her record becomes w1 for her. *)
1763
Added:
let token = Option.get (csrf_token (body (get alice "/workout"))) in
1764
Added:
let _ = post alice "/workout/finish" [ ("dream.csrf", token) ] in
1765
Added:
Alcotest.(check int)
1766
Added:
"Alice has one saved workout" 1
1767
Added:
(List.length
1768
Added:
(Lwt_main.run (Memory_repo.history repo alice_t.Trainee.id)));
1769
Added:
Alcotest.(check int)
1770
Added:
"Alice sees her saved workout" 200
1771
Added:
(status (get alice "/logbook/w1"));
1772
Added:
(* Bob's history is empty, and Alice's record is unreachable from
1773
Added:
Bob's session. Ids are per-trainee, so Bob's own w1 does not
1774
Added:
exist. *)
1775
Added:
Alcotest.(check int)
1776
Added:
"Bob's history is empty" 0
1777
Added:
(List.length
1778
Added:
(Lwt_main.run (Memory_repo.history repo bob_t.Trainee.id)));
2377
1779
Alcotest.(check int)
2378
1780
"Bob cannot open a record he does not own" 404
2379
1781
(status (get bob "/logbook/w1")) );