[OCaml] High Intensity Training Online
test Regroup web suites to mirror the controllers
The thirteen suites cut from test_web.ml were organised by history, not by feature: web.flow held nineteen tests across four controllers, and six small suites each held one topic. Regroup by the handler each test exercises, using the route each one posts to as the criterion. auth absorbs sign_in and the sign-out test. overview takes routine selection and the routine page. workout takes begin, record, correct, cancel, finish, and the recovery gate, absorbing slot_bounds and lifecycle. logbook takes the logbook page, saved-record edits, and the feedback flow, absorbing saved_record_add and duplicate_feedback. errors and isolation stay cross-cutting. Sixty-six test blocks move, none change. The same 327 tests pass.
Changed files
ARCHITECTURE.org
@@ -582,10 +582,15 @@
582
582
583
583
* Verification
584
584
585
Removed:
One Alcotest suite per module, =test/test_<module>.ml=, each exposing
586
Removed:
=suite=, registered in =test/test_hito.ml=. The architecture guard runs first,
587
Removed:
then the suites in layer order: vocabulary, plan, record, judgment, service,
588
Removed:
serialization, storage, decoding, web.
585
Added:
One Alcotest executable, one suite per module, each exposing =suite=, registered
586
Added:
in =test/test_hito.ml=. Library modules are tested at =test/test_<module>.ml=.
587
Added:
The web tier is tested under =test/web/=, which =(include_subdirs qualified)=
588
Added:
makes a module namespace: =test/web/logbook.ml= is =Web.Logbook=. Its files
589
Added:
mirror the controllers — =auth=, =overview=, =workout=, =logbook=,
590
Added:
=app_feedback=, =profile=, =import= — plus two cross-cutting suites, =errors=
591
Added:
and =isolation=, and the shared client, cookie, and CSRF helpers in
592
Added:
=Web.Support=. The suites run in layer order: vocabulary, plan, record,
593
Added:
judgment, service, serialization, storage, decoding, web.
589
594
590
595
What the less obvious suites are for:
591
596
@@ -611,9 +616,9 @@
611
616
atomic across a reconnect, against a temporary database file.
612
617
- =test_decode= — the trust boundary: form values are validated before
613
618
the core sees them.
614
Removed:
- =test_web= — carries the session cookie and CSRF token between
615
Removed:
requests, so authentication, the recovery gate, corrections, and the
616
Removed:
no-JavaScript behaviour are exercised end to end.
619
Added:
- =Web.*= — carries the session cookie and CSRF token between requests, so
620
Added:
authentication, the recovery gate, corrections, and the no-JavaScript
621
Added:
behaviour are exercised end to end, one file per controller.
617
622
618
623
Done means, in order: =dune build @check= clean, =dune runtest=
619
624
passing, =dune fmt= applied with =dune build @fmt= clean, and
test/test_hito.ml
@@ -12,9 +12,7 @@
12
12
@ Test_workout_import.suite @ Test_import_service.suite @ Test_codec.suite
13
13
@ Test_import_codec.suite @ Test_import_repo.suite @ Test_import_sqlite.suite
14
14
@ Test_bcrypt_hash.suite @ Test_sqlite_repo.suite @ Test_decode.suite
15
Removed:
@ Test_hevy_csv.suite @ Web.Auth.suite @ Web.Flow.suite
16
Removed:
@ Web.App_feedback.suite @ Web.Profile.suite @ Web.Errors.suite
17
Removed:
@ Web.Sign_in.suite @ Web.Routine_selection.suite
18
Removed:
@ Web.Saved_record_add.suite @ Web.Slot_bounds.suite
19
Removed:
@ Web.Duplicate_feedback.suite @ Web.Lifecycle.suite @ Web.Isolation.suite
20
Removed:
@ Web.Import.suite)
15
Added:
@ Test_hevy_csv.suite @ Web.Auth.suite @ Web.Overview.suite
16
Added:
@ Web.Workout.suite @ Web.Logbook.suite @ Web.App_feedback.suite
17
Added:
@ Web.Profile.suite @ Web.Import.suite @ Web.Errors.suite
18
Added:
@ Web.Isolation.suite)
test/web/auth.ml
@@ -142,5 +142,84 @@
142
142
Alcotest.(check int)
143
143
"GET /login is served" 200
144
144
(status (get c "/login")) );
145
Added:
( "a returning trainee signs in with their credentials",
146
Added:
`Quick,
147
Added:
fun () ->
148
Added:
(* Register, then sign out, then sign back in through the credential
149
Added:
form. This exercises [POST /login], which registration's
150
Added:
auto-sign-in never touches. *)
151
Added:
let c = client () in
152
Added:
let _ = sign_in_new c in
153
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
154
Added:
let _ = post c "/logout" [ ("dream.csrf", token) ] in
155
Added:
Alcotest.(check int)
156
Added:
"signed out, overview redirects" 303
157
Added:
(status (get c "/"));
158
Added:
let signed_in =
159
Added:
sign_in c ~username:"lifter" ~password:"heavyduty1"
160
Added:
in
161
Added:
Alcotest.(check int) "sign-in redirects" 303 (status signed_in);
162
Added:
Alcotest.(check bool)
163
Added:
"sign-in lands on Home" true
164
Added:
(List.mem "/" (Dream.headers signed_in "Location"));
165
Added:
Alcotest.(check int)
166
Added:
"authenticated overview" 200
167
Added:
(status (get c "/")) );
168
Added:
( "a wrong password is refused and establishes no session",
169
Added:
`Quick,
170
Added:
fun () ->
171
Added:
let c = client () in
172
Added:
let _ = sign_in_new c in
173
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
174
Added:
let _ = post c "/logout" [ ("dream.csrf", token) ] in
175
Added:
let refused =
176
Added:
sign_in c ~username:"lifter" ~password:"not-the-password"
177
Added:
in
178
Added:
Alcotest.(check int) "rejected" 401 (status refused);
179
Added:
(* The rejected attempt establishes no session. *)
180
Added:
Alcotest.(check int)
181
Added:
"still unauthenticated" 303
182
Added:
(status (get c "/")) );
183
Added:
( "an unknown username is refused like a wrong password",
184
Added:
`Quick,
185
Added:
fun () ->
186
Added:
let c = client () in
187
Added:
let refused = sign_in c ~username:"nobody" ~password:"heavyduty1" in
188
Added:
Alcotest.(check int) "rejected" 401 (status refused);
189
Added:
Alcotest.(check int)
190
Added:
"no session established" 303
191
Added:
(status (get c "/")) );
192
Added:
( "an already-authenticated visit to the sign-in page redirects Home",
193
Added:
`Quick,
194
Added:
fun () ->
195
Added:
let c = client () in
196
Added:
let _ = sign_in_new c in
197
Added:
let response = get c "/login" in
198
Added:
Alcotest.(check int) "redirects" 303 (status response);
199
Added:
Alcotest.(check bool)
200
Added:
"sends an authenticated visitor Home" true
201
Added:
(List.mem "/" (Dream.headers response "Location")) );
202
Added:
( "an already-authenticated visit to the register page redirects Home",
203
Added:
`Quick,
204
Added:
fun () ->
205
Added:
let c = client () in
206
Added:
let _ = sign_in_new c in
207
Added:
let response = get c "/register" in
208
Added:
Alcotest.(check int) "redirects" 303 (status response);
209
Added:
Alcotest.(check bool)
210
Added:
"sends an authenticated visitor Home" true
211
Added:
(List.mem "/" (Dream.headers response "Location")) );
212
Added:
( "signing out returns the trainee to the sign-in page",
213
Added:
`Quick,
214
Added:
fun () ->
215
Added:
let c = client () in
216
Added:
let _ = sign_in_new c in
217
Added:
let page = body (get c "/") in
218
Added:
let token = Option.get (csrf_token page) in
219
Added:
let out = post c "/logout" [ ("dream.csrf", token) ] in
220
Added:
Alcotest.(check int) "logout redirect" 303 (status out);
221
Added:
let after = get c "/" in
222
Added:
Alcotest.(check int) "overview now redirects" 303 (status after);
223
Added:
Alcotest.(check string) "to /login" "/login" (location after) );
145
224
] );
146
225
]
test/web/duplicate_feedback.ml
@@ -1,89 +0,0 @@
1
Removed:
open Hito_app
2
Removed:
open Support
3
Removed:
4
Removed:
let suite =
5
Removed:
[
6
Removed:
( "web.duplicate_feedback",
7
Removed:
[
8
Removed:
( "a step out of sync with the session records nothing",
9
Removed:
`Quick,
10
Removed:
fun () ->
11
Removed:
(* The flow advances one factor at a time and stores its position in
12
Removed:
the session. A post whose [step] disagrees with that position —
13
Removed:
a stale form, a double submit, or a crafted body — is refused as
14
Removed:
an invalid form rather than recording a factor twice. This is the
15
Removed:
web tier's guard against a duplicate signal ever reaching the
16
Removed:
domain. *)
17
Removed:
let c, repo = client_with_repo () in
18
Removed:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
19
Removed:
let trainee = the_trainee repo ~username:"lifter" in
20
Removed:
let start = body (get c "/logbook?feedback=start") in
21
Removed:
let token = Option.get (csrf_token start) in
22
Removed:
(* The session is at step 0; post step 3 instead. *)
23
Removed:
let mismatched =
24
Removed:
post c "/feedback"
25
Removed:
[
26
Removed:
("dream.csrf", token);
27
Removed:
("step", "3");
28
Removed:
("action", "next");
29
Removed:
("choice", "1");
30
Removed:
]
31
Removed:
in
32
Removed:
Alcotest.(check int)
33
Removed:
"mismatched step redirects" 303 (status mismatched);
34
Removed:
Alcotest.(check string)
35
Removed:
"stale feedback returns to the logbook" "/logbook"
36
Removed:
(location mismatched);
37
Removed:
(* The mismatched post advanced nothing and stored no report. *)
38
Removed:
Alcotest.(check int)
39
Removed:
"no feedback stored" 0
40
Removed:
(List.length
41
Removed:
(Lwt_main.run (Memory_repo.feedback repo trainee.Trainee.id)))
42
Removed:
);
43
Removed:
( "answering every factor stores exactly one signal per category",
44
Removed:
`Quick,
45
Removed:
fun () ->
46
Removed:
(* The flow admits one answer per factor, so the stored report holds
47
Removed:
one signal per category and never a duplicate. *)
48
Removed:
let c, repo = client_with_repo () in
49
Removed:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
50
Removed:
let trainee = the_trainee repo ~username:"lifter" in
51
Removed:
let _ = get c "/logbook?feedback=start" in
52
Removed:
let rec advance step =
53
Removed:
if step < 2 then begin
54
Removed:
let token = Option.get (csrf_token (body (get c "/logbook"))) in
55
Removed:
let _ =
56
Removed:
post c "/feedback"
57
Removed:
[
58
Removed:
("dream.csrf", token);
59
Removed:
("step", string_of_int step);
60
Removed:
("action", "next");
61
Removed:
("choice", "worse");
62
Removed:
]
63
Removed:
in
64
Removed:
advance (step + 1)
65
Removed:
end
66
Removed:
in
67
Removed:
advance 0;
68
Removed:
let token = Option.get (csrf_token (body (get c "/logbook"))) in
69
Removed:
let saved =
70
Removed:
post c "/feedback"
71
Removed:
[ ("dream.csrf", token); ("step", "2"); ("action", "save") ]
72
Removed:
in
73
Removed:
Alcotest.(check int) "final save redirects" 303 (status saved);
74
Removed:
(* Exactly one report, with one signal per distinct factor. *)
75
Removed:
let reports =
76
Removed:
Lwt_main.run (Memory_repo.feedback repo trainee.Trainee.id)
77
Removed:
in
78
Removed:
Alcotest.(check int) "one report stored" 1 (List.length reports);
79
Removed:
let signals = Feedback.signals (List.hd reports) in
80
Removed:
let count p = List.length (List.filter p signals) in
81
Removed:
let open Feedback in
82
Removed:
Alcotest.(check int)
83
Removed:
"one motivation signal" 1
84
Removed:
(count (function Motivation _ -> true | _ -> false));
85
Removed:
Alcotest.(check int)
86
Removed:
"one difficulty signal" 1
87
Removed:
(count (function Difficulty _ -> true | _ -> false)) );
88
Removed:
] );
89
Removed:
]
test/web/flow.ml
@@ -1,572 +0,0 @@
1
Removed:
open Hito_app
2
Removed:
open Support
3
Removed:
4
Removed:
let suite =
5
Removed:
[
6
Removed:
( "web.flow",
7
Removed:
[
8
Removed:
( "the logbook shows the action button group and an empty table state",
9
Removed:
`Quick,
10
Removed:
fun () ->
11
Removed:
let c = client () in
12
Removed:
let _ = sign_in_new c in
13
Removed:
let page = body (get c "/logbook") in
14
Removed:
Alcotest.(check bool)
15
Removed:
"Log feedback action" true
16
Removed:
(Option.is_some (index_from ~needle:"Log feedback" page 0));
17
Removed:
Alcotest.(check bool)
18
Removed:
"Edit logbook action" true
19
Removed:
(Option.is_some (index_from ~needle:"Edit logbook" page 0));
20
Removed:
Alcotest.(check bool)
21
Removed:
"the button group is present" true
22
Removed:
(Option.is_some
23
Removed:
(index_from ~needle:"class=\"button-group\"" page 0));
24
Removed:
Alcotest.(check bool)
25
Removed:
"empty state when nothing is logged" true
26
Removed:
(Option.is_some (index_from ~needle:"Nothing logged yet." page 0))
27
Removed:
);
28
Removed:
( "a finished workout appears in the logbook table with a progress \
29
Removed:
column",
30
Removed:
`Quick,
31
Removed:
fun () ->
32
Removed:
let c = client () in
33
Removed:
let _ = sign_in_new c in
34
Removed:
let _ = start_day_one c in
35
Removed:
record_all_day_one_slots c;
36
Removed:
let token = Option.get (csrf_token (body (get c "/workout"))) in
37
Removed:
let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in
38
Removed:
let page = body (get c "/logbook") in
39
Removed:
Alcotest.(check bool)
40
Removed:
"the logbook table is present" true
41
Removed:
(Option.is_some
42
Removed:
(index_from ~needle:"class=\"logbook-table\"" page 0));
43
Removed:
Alcotest.(check bool)
44
Removed:
"the progressed-exercises column header" true
45
Removed:
(Option.is_some
46
Removed:
(index_from ~needle:"Exercises progressed" page 0)) );
47
Removed:
( "selecting a routine redirects and records the active routine",
48
Removed:
`Quick,
49
Removed:
fun () ->
50
Removed:
(* POST-redirect-GET: selecting a routine answers 303, and the
51
Removed:
redirected GET is served. The domain effect is what matters: the
52
Removed:
trainee now has an active routine. *)
53
Removed:
let c, repo = client_with_repo () in
54
Removed:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
55
Removed:
let trainee = the_trainee repo ~username:"lifter" in
56
Removed:
Alcotest.(check bool)
57
Removed:
"no active routine before selection" true
58
Removed:
(Option.is_none
59
Removed:
(Lwt_main.run
60
Removed:
(Memory_repo.active_routine repo trainee.Trainee.id)));
61
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
62
Removed:
let selection =
63
Removed:
post c "/routines/ideal/select" [ ("dream.csrf", token) ]
64
Removed:
in
65
Removed:
Alcotest.(check int) "selection redirects" 303 (status selection);
66
Removed:
Alcotest.(check bool)
67
Removed:
"a routine is now active" true
68
Removed:
(Option.is_some
69
Removed:
(Lwt_main.run
70
Removed:
(Memory_repo.active_routine repo trainee.Trainee.id)));
71
Removed:
(* The redirected GET is served. *)
72
Removed:
Alcotest.(check int)
73
Removed:
"the redirected GET is 200" 200
74
Removed:
(status (get c "/")) );
75
Removed:
( "a signed-in trainee selects a routine and begins a workout",
76
Removed:
`Quick,
77
Removed:
fun () ->
78
Removed:
let c, repo = client_with_repo () in
79
Removed:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
80
Removed:
let trainee = the_trainee repo ~username:"lifter" in
81
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
82
Removed:
let selection =
83
Removed:
post c "/routines/ideal/select" [ ("dream.csrf", token) ]
84
Removed:
in
85
Removed:
Alcotest.(check int) "routine selected" 303 (status selection);
86
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
87
Removed:
let started =
88
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
89
Removed:
in
90
Removed:
Alcotest.(check int) "workout started" 303 (status started);
91
Removed:
(* The workout is now in progress in the domain, and its view is
92
Removed:
served. *)
93
Removed:
Alcotest.(check bool)
94
Removed:
"a workout is in progress" true
95
Removed:
(Option.is_some
96
Removed:
(Lwt_main.run
97
Removed:
(Memory_repo.in_progress repo trainee.Trainee.id)));
98
Removed:
Alcotest.(check int)
99
Removed:
"the workout view is served" 200
100
Removed:
(status (get c "/workout"));
101
Removed:
(* The static workout client asset is served. *)
102
Removed:
let asset = get c "/assets/workout-client.js" in
103
Removed:
Alcotest.(check int) "serves the workout client" 200 (status asset)
104
Removed:
);
105
Removed:
( "the routine page is served once a routine is selected",
106
Removed:
`Quick,
107
Removed:
fun () ->
108
Removed:
let c = client () in
109
Removed:
let _ = sign_in_new c in
110
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
111
Removed:
let selection =
112
Removed:
post c "/routines/ideal/select" [ ("dream.csrf", token) ]
113
Removed:
in
114
Removed:
Alcotest.(check int) "routine selected" 303 (status selection);
115
Removed:
Alcotest.(check int)
116
Removed:
"routine page served" 200
117
Removed:
(status (get c "/routine")) );
118
Removed:
( "a recorded slot can be corrected, replacing it rather than adding \
119
Removed:
volume",
120
Removed:
`Quick,
121
Removed:
fun () ->
122
Removed:
let c, repo = client_with_repo () in
123
Removed:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
124
Removed:
let trainee = the_trainee repo ~username:"lifter" in
125
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
126
Removed:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
127
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
128
Removed:
let _ =
129
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
130
Removed:
in
131
Removed:
(* Slot 1 is the single Laterals set. Record it, then correct it —
132
Removed:
one slot at a time, addressed by [?slot=]. *)
133
Removed:
let token =
134
Removed:
Option.get (csrf_token (body (get c "/workout?slot=1")))
135
Removed:
in
136
Removed:
let recorded =
137
Removed:
post c "/workout/slots/1"
138
Removed:
[
139
Removed:
("dream.csrf", token);
140
Removed:
("load", "12");
141
Removed:
("reps", "8");
142
Removed:
("extension", "");
143
Removed:
]
144
Removed:
in
145
Removed:
Alcotest.(check int) "recorded" 303 (status recorded);
146
Removed:
let filled_after_record () =
147
Removed:
match
148
Removed:
Lwt_main.run (Memory_repo.in_progress repo trainee.Trainee.id)
149
Removed:
with
150
Removed:
| Some w -> Evidence.Workout.filled_slots w
151
Removed:
| None -> Alcotest.failf "expected a workout in progress"
152
Removed:
in
153
Removed:
Alcotest.(check int) "one filled slot" 1 (filled_after_record ());
154
Removed:
let token =
155
Removed:
Option.get (csrf_token (body (get c "/workout?slot=1")))
156
Removed:
in
157
Removed:
let corrected =
158
Removed:
post c "/workout/slots/1/edit"
159
Removed:
[
160
Removed:
("dream.csrf", token);
161
Removed:
("load", "16");
162
Removed:
("reps", "6");
163
Removed:
("extension", "");
164
Removed:
]
165
Removed:
in
166
Removed:
Alcotest.(check int) "corrected" 303 (status corrected);
167
Removed:
(* A correction replaces the slot; it does not add volume. *)
168
Removed:
Alcotest.(check int)
169
Removed:
"still one filled slot, not two" 1 (filled_after_record ()) );
170
Removed:
( "a saved workout's slot can be corrected from the logbook view",
171
Removed:
`Quick,
172
Removed:
fun () ->
173
Removed:
let c, repo = client_with_repo () in
174
Removed:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
175
Removed:
let trainee = the_trainee repo ~username:"lifter" in
176
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
177
Removed:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
178
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
179
Removed:
let _ =
180
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
181
Removed:
in
182
Removed:
let token =
183
Removed:
Option.get (csrf_token (body (get c "/workout?slot=1")))
184
Removed:
in
185
Removed:
let _ =
186
Removed:
post c "/workout/slots/1"
187
Removed:
[
188
Removed:
("dream.csrf", token);
189
Removed:
("load", "12");
190
Removed:
("reps", "8");
191
Removed:
("extension", "");
192
Removed:
]
193
Removed:
in
194
Removed:
let token = Option.get (csrf_token (body (get c "/workout"))) in
195
Removed:
let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in
196
Removed:
(* The one saved workout is w1 for this trainee. Correct its slot
197
Removed:
through the logbook path, then confirm the store still has one
198
Removed:
filled slot — a correction, not extra volume. *)
199
Removed:
let record_page = body (get c "/logbook/w1?slot=1") in
200
Removed:
let token = Option.get (csrf_token record_page) in
201
Removed:
let corrected =
202
Removed:
post c "/logbook/w1/slots/1/edit"
203
Removed:
[
204
Removed:
("dream.csrf", token);
205
Removed:
("load", "20");
206
Removed:
("reps", "7");
207
Removed:
("extension", "");
208
Removed:
]
209
Removed:
in
210
Removed:
Alcotest.(check int) "corrected" 303 (status corrected);
211
Removed:
let record =
212
Removed:
Lwt_main.run
213
Removed:
(Memory_repo.find repo trainee.Trainee.id
214
Removed:
(Repository.workout_id "w1"))
215
Removed:
in
216
Removed:
Alcotest.(check int)
217
Removed:
"still one filled slot" 1
218
Removed:
(match record with
219
Removed:
| Some r -> Evidence.Workout.filled_slots r.Repository.workout
220
Removed:
| None -> Alcotest.failf "expected the saved workout w1") );
221
Removed:
( "an invalid workout field is rejected and records nothing",
222
Removed:
`Quick,
223
Removed:
fun () ->
224
Removed:
let c, repo = client_with_repo () in
225
Removed:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
226
Removed:
let trainee = the_trainee repo ~username:"lifter" in
227
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
228
Removed:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
229
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
230
Removed:
let _ =
231
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
232
Removed:
in
233
Removed:
let token = Option.get (csrf_token (body (get c "/workout"))) in
234
Removed:
let invalid =
235
Removed:
post c "/workout/slots/0"
236
Removed:
[
237
Removed:
("dream.csrf", token);
238
Removed:
("iso_load", "not-a-number");
239
Removed:
("iso_reps", "8");
240
Removed:
("comp_load", "40");
241
Removed:
("comp_reps", "6");
242
Removed:
("extension", "");
243
Removed:
]
244
Removed:
in
245
Removed:
Alcotest.(check int) "invalid field redirects" 303 (status invalid);
246
Removed:
(* The bad input recorded no slot. *)
247
Removed:
Alcotest.(check int)
248
Removed:
"no slot was filled" 0
249
Removed:
(match
250
Removed:
Lwt_main.run (Memory_repo.in_progress repo trainee.Trainee.id)
251
Removed:
with
252
Removed:
| Some w -> Evidence.Workout.filled_slots w
253
Removed:
| None -> Alcotest.failf "expected a workout in progress") );
254
Removed:
( "recording a slot advances the count of filled slots",
255
Removed:
`Quick,
256
Removed:
fun () ->
257
Removed:
let c, repo = client_with_repo () in
258
Removed:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
259
Removed:
let trainee = the_trainee repo ~username:"lifter" in
260
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
261
Removed:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
262
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
263
Removed:
let _ =
264
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
265
Removed:
in
266
Removed:
let filled () =
267
Removed:
match
268
Removed:
Lwt_main.run (Memory_repo.in_progress repo trainee.Trainee.id)
269
Removed:
with
270
Removed:
| Some w -> Evidence.Workout.filled_slots w
271
Removed:
| None -> Alcotest.failf "expected a workout in progress"
272
Removed:
in
273
Removed:
Alcotest.(check int) "nothing recorded yet" 0 (filled ());
274
Removed:
let token = Option.get (csrf_token (body (get c "/workout"))) in
275
Removed:
let recorded =
276
Removed:
post c "/workout/slots/0"
277
Removed:
[
278
Removed:
("dream.csrf", token);
279
Removed:
("iso_load", "10");
280
Removed:
("iso_reps", "8");
281
Removed:
("comp_load", "40");
282
Removed:
("comp_reps", "6");
283
Removed:
("extension", "");
284
Removed:
]
285
Removed:
in
286
Removed:
Alcotest.(check int) "recorded slot 0" 303 (status recorded);
287
Removed:
Alcotest.(check int) "one slot filled" 1 (filled ()) );
288
Removed:
( "signing out returns the trainee to the sign-in page",
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:
let token = Option.get (csrf_token page) in
295
Removed:
let out = post c "/logout" [ ("dream.csrf", token) ] in
296
Removed:
Alcotest.(check int) "logout redirect" 303 (status out);
297
Removed:
let after = get c "/" in
298
Removed:
Alcotest.(check int) "overview now redirects" 303 (status after);
299
Removed:
Alcotest.(check string) "to /login" "/login" (location after) );
300
Removed:
( "cancelling a workout without a CSRF token leaves it in progress",
301
Removed:
`Quick,
302
Removed:
fun () ->
303
Removed:
let c, repo = client_with_repo () in
304
Removed:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
305
Removed:
let trainee = the_trainee repo ~username:"lifter" in
306
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
307
Removed:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
308
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
309
Removed:
let _ =
310
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
311
Removed:
in
312
Removed:
let response = post c "/workout/cancel" [ (* no dream.csrf *) ] in
313
Removed:
(* Cancelling always navigates away to Home. A forged or missing
314
Removed:
token skips the discard, so the workout remains in progress. *)
315
Removed:
Alcotest.(check int)
316
Removed:
"navigates away without an error page" 303 (status response);
317
Removed:
Alcotest.(check bool)
318
Removed:
"returns Home" true
319
Removed:
(List.mem "/" (Dream.headers response "Location"));
320
Removed:
Alcotest.(check bool)
321
Removed:
"workout still in progress" true
322
Removed:
(Option.is_some
323
Removed:
(Lwt_main.run
324
Removed:
(Memory_repo.in_progress repo trainee.Trainee.id))) );
325
Removed:
( "cancelling after recording a set discards the workout entirely",
326
Removed:
`Quick,
327
Removed:
fun () ->
328
Removed:
let c, repo = client_with_repo () in
329
Removed:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
330
Removed:
let trainee = the_trainee repo ~username:"lifter" in
331
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
332
Removed:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
333
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
334
Removed:
let _ =
335
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
336
Removed:
in
337
Removed:
let token =
338
Removed:
Option.get (csrf_token (body (get c "/workout?slot=1")))
339
Removed:
in
340
Removed:
let recorded =
341
Removed:
post c "/workout/slots/1"
342
Removed:
[
343
Removed:
("dream.csrf", token);
344
Removed:
("load", "12");
345
Removed:
("reps", "8");
346
Removed:
("extension", "");
347
Removed:
]
348
Removed:
in
349
Removed:
Alcotest.(check int) "recorded a set" 303 (status recorded);
350
Removed:
let token = Option.get (csrf_token (body (get c "/workout"))) in
351
Removed:
let cancelled =
352
Removed:
post c "/workout/cancel" [ ("dream.csrf", token) ]
353
Removed:
in
354
Removed:
Alcotest.(check int) "cancel returns Home" 303 (status cancelled);
355
Removed:
Alcotest.(check bool)
356
Removed:
"returns Home, not the logbook" true
357
Removed:
(List.mem "/" (Dream.headers cancelled "Location"));
358
Removed:
(* No current workout, and no record: an abandoned session is not
359
Removed:
evidence. *)
360
Removed:
Alcotest.(check bool)
361
Removed:
"no workout in progress" true
362
Removed:
(Option.is_none
363
Removed:
(Lwt_main.run
364
Removed:
(Memory_repo.in_progress repo trainee.Trainee.id)));
365
Removed:
Alcotest.(check int)
366
Removed:
"history is empty" 0
367
Removed:
(List.length
368
Removed:
(Lwt_main.run (Memory_repo.history repo trainee.Trainee.id)));
369
Removed:
Alcotest.(check int)
370
Removed:
"the discarded workout has no record" 404
371
Removed:
(status (get c "/logbook/w1")) );
372
Removed:
( "sequential feedback stores only answered factors, never skipped ones",
373
Removed:
`Quick,
374
Removed:
fun () ->
375
Removed:
let c, repo = client_with_repo () in
376
Removed:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
377
Removed:
let trainee = the_trainee repo ~username:"lifter" in
378
Removed:
let _ = get c "/logbook?feedback=start" in
379
Removed:
let step_action step action extra =
380
Removed:
let token = Option.get (csrf_token (body (get c "/logbook"))) in
381
Removed:
post c "/feedback"
382
Removed:
(("dream.csrf", token)
383
Removed:
:: ("step", string_of_int step)
384
Removed:
:: ("action", action) :: extra)
385
Removed:
in
386
Removed:
let first = step_action 0 "next" [ ("choice", "better") ] in
387
Removed:
Alcotest.(check int) "first factor redirects" 303 (status first);
388
Removed:
let _ = step_action 1 "skip" [] in
389
Removed:
let saved = step_action 2 "save" [] in
390
Removed:
Alcotest.(check int) "final feedback redirects" 303 (status saved);
391
Removed:
let reports =
392
Removed:
Lwt_main.run (Memory_repo.feedback repo trainee.Trainee.id)
393
Removed:
in
394
Removed:
Alcotest.(check int)
395
Removed:
"one feedback report stored" 1 (List.length reports);
396
Removed:
let signal_list = Feedback.signals (List.hd reports) in
397
Removed:
Alcotest.(check (list bool))
398
Removed:
"only motivation stored" [ true ]
399
Removed:
(List.map
400
Removed:
(function
401
Removed:
| Feedback.Motivation Feedback.Better_than_usual -> true
402
Removed:
| _ -> false)
403
Removed:
signal_list) );
404
Removed:
( "skipping the entire feedback flow records nothing",
405
Removed:
`Quick,
406
Removed:
fun () ->
407
Removed:
let c, repo = client_with_repo () in
408
Removed:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
409
Removed:
let trainee = the_trainee repo ~username:"lifter" in
410
Removed:
let start = body (get c "/logbook?feedback=start") in
411
Removed:
let token = Option.get (csrf_token start) in
412
Removed:
let skipped = post c "/feedback/cancel" [ ("dream.csrf", token) ] in
413
Removed:
Alcotest.(check int) "full-flow skip redirects" 303 (status skipped);
414
Removed:
Alcotest.(check int)
415
Removed:
"no feedback report was stored" 0
416
Removed:
(List.length
417
Removed:
(Lwt_main.run (Memory_repo.feedback repo trainee.Trainee.id)))
418
Removed:
);
419
Removed:
( "back keeps an earlier answer, which still persists on save",
420
Removed:
`Quick,
421
Removed:
fun () ->
422
Removed:
let c, repo = client_with_repo () in
423
Removed:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
424
Removed:
let trainee = the_trainee repo ~username:"lifter" in
425
Removed:
let _ = get c "/logbook?feedback=start" in
426
Removed:
let step_action step action extra =
427
Removed:
let token = Option.get (csrf_token (body (get c "/logbook"))) in
428
Removed:
post c "/feedback"
429
Removed:
(("dream.csrf", token)
430
Removed:
:: ("step", string_of_int step)
431
Removed:
:: ("action", action) :: extra)
432
Removed:
in
433
Removed:
(* Answer motivation, move to difficulty, return, then skip
434
Removed:
motivation and difficulty before saving. The earlier motivation
435
Removed:
answer remains in the flow. *)
436
Removed:
let _ = step_action 0 "next" [ ("choice", "better") ] in
437
Removed:
let back = step_action 1 "back" [] in
438
Removed:
Alcotest.(check int) "back redirects" 303 (status back);
439
Removed:
let _ = step_action 0 "skip" [] in
440
Removed:
let _ = step_action 1 "skip" [] in
441
Removed:
let _ = step_action 2 "save" [] in
442
Removed:
let reports =
443
Removed:
Lwt_main.run (Memory_repo.feedback repo trainee.Trainee.id)
444
Removed:
in
445
Removed:
Alcotest.(check int) "one report stored" 1 (List.length reports);
446
Removed:
let signals = Feedback.signals (List.hd reports) in
447
Removed:
Alcotest.(check bool)
448
Removed:
"the pre-back motivation answer persists" true
449
Removed:
(List.exists
450
Removed:
(function
451
Removed:
| Feedback.Motivation Feedback.Better_than_usual -> true
452
Removed:
| _ -> false)
453
Removed:
signals) );
454
Removed:
( "closing the feedback modal discards the flow",
455
Removed:
`Quick,
456
Removed:
fun () ->
457
Removed:
let c, repo = client_with_repo () in
458
Removed:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
459
Removed:
let trainee = the_trainee repo ~username:"lifter" in
460
Removed:
let start = body (get c "/logbook?feedback=start") in
461
Removed:
let token = Option.get (csrf_token start) in
462
Removed:
let _ =
463
Removed:
post c "/feedback"
464
Removed:
[
465
Removed:
("dream.csrf", token);
466
Removed:
("step", "0");
467
Removed:
("action", "next");
468
Removed:
("choice", "better");
469
Removed:
]
470
Removed:
in
471
Removed:
let appetite = body (get c "/logbook") in
472
Removed:
let token = Option.get (csrf_token appetite) in
473
Removed:
let closed = post c "/feedback/cancel" [ ("dream.csrf", token) ] in
474
Removed:
Alcotest.(check int) "close redirects" 303 (status closed);
475
Removed:
(* A discarded flow stores nothing. *)
476
Removed:
Alcotest.(check int)
477
Removed:
"no feedback report stored" 0
478
Removed:
(List.length
479
Removed:
(Lwt_main.run (Memory_repo.feedback repo trainee.Trainee.id)))
480
Removed:
);
481
Removed:
( "finishing a workout redirects to the logbook feedback prompt",
482
Removed:
`Quick,
483
Removed:
fun () ->
484
Removed:
let c, repo = client_with_repo () in
485
Removed:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
486
Removed:
let trainee = the_trainee repo ~username:"lifter" in
487
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
488
Removed:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
489
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
490
Removed:
let _ =
491
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
492
Removed:
in
493
Removed:
let token = Option.get (csrf_token (body (get c "/workout"))) in
494
Removed:
let finished = post c "/workout/finish" [ ("dream.csrf", token) ] in
495
Removed:
Alcotest.(check int) "finish redirects" 303 (status finished);
496
Removed:
Alcotest.(check bool)
497
Removed:
"redirects to the logbook with a feedback prompt" true
498
Removed:
(List.mem "/logbook?prompt=feedback"
499
Removed:
(Dream.headers finished "Location"));
500
Removed:
(* The workout is now in history and no longer in progress. *)
501
Removed:
Alcotest.(check int)
502
Removed:
"one workout in history" 1
503
Removed:
(List.length
504
Removed:
(Lwt_main.run (Memory_repo.history repo trainee.Trainee.id)));
505
Removed:
Alcotest.(check bool)
506
Removed:
"nothing in progress" true
507
Removed:
(Option.is_none
508
Removed:
(Lwt_main.run
509
Removed:
(Memory_repo.in_progress repo trainee.Trainee.id))) );
510
Removed:
( "beginning before recovery is refused without an override",
511
Removed:
`Quick,
512
Removed:
fun () ->
513
Removed:
let c, repo = client_with_repo () in
514
Removed:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
515
Removed:
let trainee = the_trainee repo ~username:"lifter" in
516
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
517
Removed:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
518
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
519
Removed:
let _ =
520
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
521
Removed:
in
522
Removed:
let token = Option.get (csrf_token (body (get c "/workout"))) in
523
Removed:
let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in
524
Removed:
(* Recovery has not elapsed. Beginning the next workout without an
525
Removed:
override is bounced back to Home and starts nothing. *)
526
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
527
Removed:
let refused =
528
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
529
Removed:
in
530
Removed:
Alcotest.(check int) "early begin bounced" 303 (status refused);
531
Removed:
Alcotest.(check bool)
532
Removed:
"returns Home, not the workout" true
533
Removed:
(List.mem "/" (Dream.headers refused "Location"));
534
Removed:
Alcotest.(check bool)
535
Removed:
"no new workout in progress" true
536
Removed:
(Option.is_none
537
Removed:
(Lwt_main.run
538
Removed:
(Memory_repo.in_progress repo trainee.Trainee.id))) );
539
Removed:
( "overriding recovery begins the next workout on an override basis",
540
Removed:
`Quick,
541
Removed:
fun () ->
542
Removed:
let c, repo = client_with_repo () in
543
Removed:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
544
Removed:
let trainee = the_trainee repo ~username:"lifter" in
545
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
546
Removed:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
547
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
548
Removed:
let _ =
549
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
550
Removed:
in
551
Removed:
let token = Option.get (csrf_token (body (get c "/workout"))) in
552
Removed:
let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in
553
Removed:
(* Recovery has not elapsed, so the next workout is begun under an
554
Removed:
explicit override. The deviation is recorded on the workout's
555
Removed:
clearance basis, never silent. *)
556
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
557
Removed:
let began =
558
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "true") ]
559
Removed:
in
560
Removed:
Alcotest.(check int) "override begin succeeds" 303 (status began);
561
Removed:
let basis =
562
Removed:
match
563
Removed:
Lwt_main.run (Memory_repo.in_progress repo trainee.Trainee.id)
564
Removed:
with
565
Removed:
| Some w -> Recovery.basis (Evidence.Workout.clearance w)
566
Removed:
| None -> Alcotest.failf "expected a workout in progress"
567
Removed:
in
568
Removed:
Alcotest.(check bool)
569
Removed:
"the workout carries an override basis" true
570
Removed:
(match basis with Recovery.Overridden _ -> true | _ -> false) );
571
Removed:
] );
572
Removed:
]
test/web/lifecycle.ml
@@ -1,125 +0,0 @@
1
Removed:
open Hito_app
2
Removed:
open Support
3
Removed:
4
Removed:
let suite =
5
Removed:
[
6
Removed:
( "web.lifecycle",
7
Removed:
[
8
Removed:
( "a full cycle: begin Day 1, record every slot, finish, and see it \
9
Removed:
saved complete",
10
Removed:
`Quick,
11
Removed:
fun () ->
12
Removed:
(* A deep end-to-end pass over the primary flow with a driven clock.
13
Removed:
Begin Day 1, record all four slots, finish, and confirm the
14
Removed:
logbook persists a complete Day 1 with four stimuli. The clocked
15
Removed:
client and repo share a store, so the flow's domain effect is
16
Removed:
read straight from history. *)
17
Removed:
let c, now, repo = clocked_client () in
18
Removed:
now := day 10;
19
Removed:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
20
Removed:
let trainee = the_trainee repo ~username:"lifter" in
21
Removed:
let _ = start_day_one c in
22
Removed:
let in_progress_filled () =
23
Removed:
match
24
Removed:
Lwt_main.run (Memory_repo.in_progress repo trainee.Trainee.id)
25
Removed:
with
26
Removed:
| Some w -> Evidence.Workout.filled_slots w
27
Removed:
| None -> Alcotest.failf "expected a workout in progress"
28
Removed:
in
29
Removed:
Alcotest.(check int)
30
Removed:
"opens with no slots recorded" 0 (in_progress_filled ());
31
Removed:
record_all_day_one_slots c;
32
Removed:
Alcotest.(check int)
33
Removed:
"all four slots recorded" 4 (in_progress_filled ());
34
Removed:
let token = Option.get (csrf_token (body (get c "/workout"))) in
35
Removed:
let finished = post c "/workout/finish" [ ("dream.csrf", token) ] in
36
Removed:
Alcotest.(check int) "finish redirects" 303 (status finished);
37
Removed:
Alcotest.(check bool)
38
Removed:
"sends the trainee to the logbook feedback prompt" true
39
Removed:
(List.mem "/logbook?prompt=feedback"
40
Removed:
(Dream.headers finished "Location"));
41
Removed:
(* History holds one complete Day 1 with four stimuli. *)
42
Removed:
let history =
43
Removed:
Lwt_main.run (Memory_repo.history repo trainee.Trainee.id)
44
Removed:
in
45
Removed:
Alcotest.(check int)
46
Removed:
"one workout in history" 1 (List.length history);
47
Removed:
let saved = (List.hd history).Repository.workout in
48
Removed:
Alcotest.(check string)
49
Removed:
"the saved workout is Day 1" "Day 1"
50
Removed:
(Prescription.Workout.name (Evidence.Workout.prescription saved));
51
Removed:
Alcotest.(check int)
52
Removed:
"records four stimuli" 4
53
Removed:
(List.length (Evidence.Workout.stimuli saved));
54
Removed:
Alcotest.(check bool)
55
Removed:
"the saved workout is complete" true
56
Removed:
(Evidence.Workout.completeness saved = Evidence.Workout.Complete);
57
Removed:
(* The saved workout is durable and reachable at its own URL. *)
58
Removed:
Alcotest.(check int)
59
Removed:
"the saved workout is reachable" 200
60
Removed:
(status (get c "/logbook/w1")) );
61
Removed:
( "the recovery gate blocks the next workout until enough rest, then \
62
Removed:
Day 2 begins",
63
Removed:
`Quick,
64
Removed:
fun () ->
65
Removed:
(* The deepest flow: after finishing Day 1, the next workout is
66
Removed:
gated until 48 hours of recovery pass. The web tier drives the
67
Removed:
clock, so this proves the gate over HTTP, not just in the
68
Removed:
service. Beginning too early is refused; resting past the
69
Removed:
interval clears the gate and advances the cycle to Day 2. *)
70
Removed:
let c, now, repo = clocked_client () in
71
Removed:
now := day 10;
72
Removed:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
73
Removed:
let trainee = the_trainee repo ~username:"lifter" in
74
Removed:
let _ = start_day_one c in
75
Removed:
record_all_day_one_slots c;
76
Removed:
let token = Option.get (csrf_token (body (get c "/workout"))) in
77
Removed:
let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in
78
Removed:
(* One hour later: recovery is far from complete. Beginning without
79
Removed:
an override is refused and starts nothing. *)
80
Removed:
now := day 10 + 3600;
81
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
82
Removed:
let refused =
83
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
84
Removed:
in
85
Removed:
Alcotest.(check int)
86
Removed:
"an early begin is bounced back" 303 (status refused);
87
Removed:
Alcotest.(check bool)
88
Removed:
"the early begin returns Home, not the workout" true
89
Removed:
(List.mem "/" (Dream.headers refused "Location"));
90
Removed:
Alcotest.(check bool)
91
Removed:
"no workout was started" true
92
Removed:
(Option.is_none
93
Removed:
(Lwt_main.run
94
Removed:
(Memory_repo.in_progress repo trainee.Trainee.id)));
95
Removed:
(* Rest two full days: past the 48-hour training interval. The gate
96
Removed:
clears and the next begin succeeds. *)
97
Removed:
now := day 13;
98
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
99
Removed:
let began =
100
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
101
Removed:
in
102
Removed:
Alcotest.(check int) "the rested begin succeeds" 303 (status began);
103
Removed:
Alcotest.(check bool)
104
Removed:
"the rested begin reaches the workout" true
105
Removed:
(List.mem "/workout" (Dream.headers began "Location"));
106
Removed:
(* The cycle has advanced to Day 2, cleared on recovery, not an
107
Removed:
override. *)
108
Removed:
let workout =
109
Removed:
match
110
Removed:
Lwt_main.run (Memory_repo.in_progress repo trainee.Trainee.id)
111
Removed:
with
112
Removed:
| Some w -> w
113
Removed:
| None -> Alcotest.failf "expected a workout in progress"
114
Removed:
in
115
Removed:
Alcotest.(check string)
116
Removed:
"the cycle advanced to Day 2" "Day 2"
117
Removed:
(Prescription.Workout.name
118
Removed:
(Evidence.Workout.prescription workout));
119
Removed:
Alcotest.(check bool)
120
Removed:
"cleared on recovery, not an override" true
121
Removed:
(match Recovery.basis (Evidence.Workout.clearance workout) with
122
Removed:
| Recovery.Recovered -> true
123
Removed:
| Recovery.Overridden _ -> false) );
124
Removed:
] );
125
Removed:
]
test/web/logbook.ml
@@ -0,0 +1,401 @@
1
Added:
open Hito_app
2
Added:
open Support
3
Added:
4
Added:
let suite =
5
Added:
[
6
Added:
( "web.logbook",
7
Added:
[
8
Added:
( "the logbook shows the action button group and an empty table state",
9
Added:
`Quick,
10
Added:
fun () ->
11
Added:
let c = client () in
12
Added:
let _ = sign_in_new c in
13
Added:
let page = body (get c "/logbook") in
14
Added:
Alcotest.(check bool)
15
Added:
"Log feedback action" true
16
Added:
(Option.is_some (index_from ~needle:"Log feedback" page 0));
17
Added:
Alcotest.(check bool)
18
Added:
"Edit logbook action" true
19
Added:
(Option.is_some (index_from ~needle:"Edit logbook" page 0));
20
Added:
Alcotest.(check bool)
21
Added:
"the button group is present" true
22
Added:
(Option.is_some
23
Added:
(index_from ~needle:"class=\"button-group\"" page 0));
24
Added:
Alcotest.(check bool)
25
Added:
"empty state when nothing is logged" true
26
Added:
(Option.is_some (index_from ~needle:"Nothing logged yet." page 0))
27
Added:
);
28
Added:
( "a finished workout appears in the logbook table with a progress \
29
Added:
column",
30
Added:
`Quick,
31
Added:
fun () ->
32
Added:
let c = client () in
33
Added:
let _ = sign_in_new c in
34
Added:
let _ = start_day_one c in
35
Added:
record_all_day_one_slots c;
36
Added:
let token = Option.get (csrf_token (body (get c "/workout"))) in
37
Added:
let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in
38
Added:
let page = body (get c "/logbook") in
39
Added:
Alcotest.(check bool)
40
Added:
"the logbook table is present" true
41
Added:
(Option.is_some
42
Added:
(index_from ~needle:"class=\"logbook-table\"" page 0));
43
Added:
Alcotest.(check bool)
44
Added:
"the progressed-exercises column header" true
45
Added:
(Option.is_some
46
Added:
(index_from ~needle:"Exercises progressed" page 0)) );
47
Added:
( "a saved workout's slot can be corrected from the logbook view",
48
Added:
`Quick,
49
Added:
fun () ->
50
Added:
let c, repo = client_with_repo () in
51
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
52
Added:
let trainee = the_trainee repo ~username:"lifter" in
53
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
54
Added:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
55
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
56
Added:
let _ =
57
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
58
Added:
in
59
Added:
let token =
60
Added:
Option.get (csrf_token (body (get c "/workout?slot=1")))
61
Added:
in
62
Added:
let _ =
63
Added:
post c "/workout/slots/1"
64
Added:
[
65
Added:
("dream.csrf", token);
66
Added:
("load", "12");
67
Added:
("reps", "8");
68
Added:
("extension", "");
69
Added:
]
70
Added:
in
71
Added:
let token = Option.get (csrf_token (body (get c "/workout"))) in
72
Added:
let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in
73
Added:
(* The one saved workout is w1 for this trainee. Correct its slot
74
Added:
through the logbook path, then confirm the store still has one
75
Added:
filled slot — a correction, not extra volume. *)
76
Added:
let record_page = body (get c "/logbook/w1?slot=1") in
77
Added:
let token = Option.get (csrf_token record_page) in
78
Added:
let corrected =
79
Added:
post c "/logbook/w1/slots/1/edit"
80
Added:
[
81
Added:
("dream.csrf", token);
82
Added:
("load", "20");
83
Added:
("reps", "7");
84
Added:
("extension", "");
85
Added:
]
86
Added:
in
87
Added:
Alcotest.(check int) "corrected" 303 (status corrected);
88
Added:
let record =
89
Added:
Lwt_main.run
90
Added:
(Memory_repo.find repo trainee.Trainee.id
91
Added:
(Repository.workout_id "w1"))
92
Added:
in
93
Added:
Alcotest.(check int)
94
Added:
"still one filled slot" 1
95
Added:
(match record with
96
Added:
| Some r -> Evidence.Workout.filled_slots r.Repository.workout
97
Added:
| None -> Alcotest.failf "expected the saved workout w1") );
98
Added:
( "an outstanding slot of a saved workout can be recorded, not only \
99
Added:
corrected",
100
Added:
`Quick,
101
Added:
fun () ->
102
Added:
(* Finish a workout with a single slot recorded, so the saved record
103
Added:
still has outstanding slots. Then record one of those through the
104
Added:
plain add path [POST /logbook/:id/slots/:d], which the edit tests
105
Added:
never exercise. *)
106
Added:
let c, repo = client_with_repo () in
107
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
108
Added:
let trainee = the_trainee repo ~username:"lifter" in
109
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
110
Added:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
111
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
112
Added:
let _ =
113
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
114
Added:
in
115
Added:
(* Record only slot 1, then finish. Slots 0, 2, 3 stay outstanding. *)
116
Added:
let token =
117
Added:
Option.get (csrf_token (body (get c "/workout?slot=1")))
118
Added:
in
119
Added:
let _ =
120
Added:
post c "/workout/slots/1"
121
Added:
[
122
Added:
("dream.csrf", token);
123
Added:
("load", "12");
124
Added:
("reps", "8");
125
Added:
("extension", "");
126
Added:
]
127
Added:
in
128
Added:
let token = Option.get (csrf_token (body (get c "/workout"))) in
129
Added:
let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in
130
Added:
let filled_of_w1 () =
131
Added:
match
132
Added:
Lwt_main.run
133
Added:
(Memory_repo.find repo trainee.Trainee.id
134
Added:
(Repository.workout_id "w1"))
135
Added:
with
136
Added:
| Some r -> Evidence.Workout.filled_slots r.Repository.workout
137
Added:
| None -> Alcotest.failf "expected the saved workout w1"
138
Added:
in
139
Added:
Alcotest.(check int)
140
Added:
"saved workout starts with one slot" 1 (filled_of_w1 ());
141
Added:
(* Add slot 2 through the non-edit path. *)
142
Added:
let token =
143
Added:
Option.get (csrf_token (body (get c "/logbook/w1?slot=2")))
144
Added:
in
145
Added:
let added =
146
Added:
post c "/logbook/w1/slots/2"
147
Added:
[
148
Added:
("dream.csrf", token);
149
Added:
("load", "10");
150
Added:
("reps", "9");
151
Added:
("extension", "");
152
Added:
]
153
Added:
in
154
Added:
Alcotest.(check int)
155
Added:
"recorded a saved-workout slot" 303 (status added);
156
Added:
Alcotest.(check int) "now two filled slots" 2 (filled_of_w1 ()) );
157
Added:
( "recording an already-filled slot through the add path is refused",
158
Added:
`Quick,
159
Added:
fun () ->
160
Added:
(* The add path lists only outstanding slots. A filled slot is not
161
Added:
awaiting a record, so posting to it is a 404, not a silent second
162
Added:
entry that would add volume. *)
163
Added:
let c, repo = client_with_repo () in
164
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
165
Added:
let trainee = the_trainee repo ~username:"lifter" in
166
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
167
Added:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
168
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
169
Added:
let _ =
170
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
171
Added:
in
172
Added:
let token =
173
Added:
Option.get (csrf_token (body (get c "/workout?slot=1")))
174
Added:
in
175
Added:
let _ =
176
Added:
post c "/workout/slots/1"
177
Added:
[
178
Added:
("dream.csrf", token);
179
Added:
("load", "12");
180
Added:
("reps", "8");
181
Added:
("extension", "");
182
Added:
]
183
Added:
in
184
Added:
let token = Option.get (csrf_token (body (get c "/workout"))) in
185
Added:
let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in
186
Added:
(* Slot 1 is filled. Re-posting to its add path is refused. *)
187
Added:
let token =
188
Added:
Option.get (csrf_token (body (get c "/logbook/w1?slot=2")))
189
Added:
in
190
Added:
let refused =
191
Added:
post c "/logbook/w1/slots/1"
192
Added:
[
193
Added:
("dream.csrf", token);
194
Added:
("load", "20");
195
Added:
("reps", "6");
196
Added:
("extension", "");
197
Added:
]
198
Added:
in
199
Added:
Alcotest.(check int)
200
Added:
"filled slot is not awaiting" 404 (status refused);
201
Added:
(* The refused post added no volume: still one filled slot. *)
202
Added:
Alcotest.(check int)
203
Added:
"still one filled slot" 1
204
Added:
(match
205
Added:
Lwt_main.run
206
Added:
(Memory_repo.find repo trainee.Trainee.id
207
Added:
(Repository.workout_id "w1"))
208
Added:
with
209
Added:
| Some r -> Evidence.Workout.filled_slots r.Repository.workout
210
Added:
| None -> Alcotest.failf "expected the saved workout w1") );
211
Added:
( "sequential feedback stores only answered factors, never skipped ones",
212
Added:
`Quick,
213
Added:
fun () ->
214
Added:
let c, repo = client_with_repo () in
215
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
216
Added:
let trainee = the_trainee repo ~username:"lifter" in
217
Added:
let _ = get c "/logbook?feedback=start" in
218
Added:
let step_action step action extra =
219
Added:
let token = Option.get (csrf_token (body (get c "/logbook"))) in
220
Added:
post c "/feedback"
221
Added:
(("dream.csrf", token)
222
Added:
:: ("step", string_of_int step)
223
Added:
:: ("action", action) :: extra)
224
Added:
in
225
Added:
let first = step_action 0 "next" [ ("choice", "better") ] in
226
Added:
Alcotest.(check int) "first factor redirects" 303 (status first);
227
Added:
let _ = step_action 1 "skip" [] in
228
Added:
let saved = step_action 2 "save" [] in
229
Added:
Alcotest.(check int) "final feedback redirects" 303 (status saved);
230
Added:
let reports =
231
Added:
Lwt_main.run (Memory_repo.feedback repo trainee.Trainee.id)
232
Added:
in
233
Added:
Alcotest.(check int)
234
Added:
"one feedback report stored" 1 (List.length reports);
235
Added:
let signal_list = Feedback.signals (List.hd reports) in
236
Added:
Alcotest.(check (list bool))
237
Added:
"only motivation stored" [ true ]
238
Added:
(List.map
239
Added:
(function
240
Added:
| Feedback.Motivation Feedback.Better_than_usual -> true
241
Added:
| _ -> false)
242
Added:
signal_list) );
243
Added:
( "skipping the entire feedback flow records nothing",
244
Added:
`Quick,
245
Added:
fun () ->
246
Added:
let c, repo = client_with_repo () in
247
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
248
Added:
let trainee = the_trainee repo ~username:"lifter" in
249
Added:
let start = body (get c "/logbook?feedback=start") in
250
Added:
let token = Option.get (csrf_token start) in
251
Added:
let skipped = post c "/feedback/cancel" [ ("dream.csrf", token) ] in
252
Added:
Alcotest.(check int) "full-flow skip redirects" 303 (status skipped);
253
Added:
Alcotest.(check int)
254
Added:
"no feedback report was stored" 0
255
Added:
(List.length
256
Added:
(Lwt_main.run (Memory_repo.feedback repo trainee.Trainee.id)))
257
Added:
);
258
Added:
( "back keeps an earlier answer, which still persists on save",
259
Added:
`Quick,
260
Added:
fun () ->
261
Added:
let c, repo = client_with_repo () in
262
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
263
Added:
let trainee = the_trainee repo ~username:"lifter" in
264
Added:
let _ = get c "/logbook?feedback=start" in
265
Added:
let step_action step action extra =
266
Added:
let token = Option.get (csrf_token (body (get c "/logbook"))) in
267
Added:
post c "/feedback"
268
Added:
(("dream.csrf", token)
269
Added:
:: ("step", string_of_int step)
270
Added:
:: ("action", action) :: extra)
271
Added:
in
272
Added:
(* Answer motivation, move to difficulty, return, then skip
273
Added:
motivation and difficulty before saving. The earlier motivation
274
Added:
answer remains in the flow. *)
275
Added:
let _ = step_action 0 "next" [ ("choice", "better") ] in
276
Added:
let back = step_action 1 "back" [] in
277
Added:
Alcotest.(check int) "back redirects" 303 (status back);
278
Added:
let _ = step_action 0 "skip" [] in
279
Added:
let _ = step_action 1 "skip" [] in
280
Added:
let _ = step_action 2 "save" [] in
281
Added:
let reports =
282
Added:
Lwt_main.run (Memory_repo.feedback repo trainee.Trainee.id)
283
Added:
in
284
Added:
Alcotest.(check int) "one report stored" 1 (List.length reports);
285
Added:
let signals = Feedback.signals (List.hd reports) in
286
Added:
Alcotest.(check bool)
287
Added:
"the pre-back motivation answer persists" true
288
Added:
(List.exists
289
Added:
(function
290
Added:
| Feedback.Motivation Feedback.Better_than_usual -> true
291
Added:
| _ -> false)
292
Added:
signals) );
293
Added:
( "closing the feedback modal discards the flow",
294
Added:
`Quick,
295
Added:
fun () ->
296
Added:
let c, repo = client_with_repo () in
297
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
298
Added:
let trainee = the_trainee repo ~username:"lifter" in
299
Added:
let start = body (get c "/logbook?feedback=start") in
300
Added:
let token = Option.get (csrf_token start) in
301
Added:
let _ =
302
Added:
post c "/feedback"
303
Added:
[
304
Added:
("dream.csrf", token);
305
Added:
("step", "0");
306
Added:
("action", "next");
307
Added:
("choice", "better");
308
Added:
]
309
Added:
in
310
Added:
let appetite = body (get c "/logbook") in
311
Added:
let token = Option.get (csrf_token appetite) in
312
Added:
let closed = post c "/feedback/cancel" [ ("dream.csrf", token) ] in
313
Added:
Alcotest.(check int) "close redirects" 303 (status closed);
314
Added:
(* A discarded flow stores nothing. *)
315
Added:
Alcotest.(check int)
316
Added:
"no feedback report stored" 0
317
Added:
(List.length
318
Added:
(Lwt_main.run (Memory_repo.feedback repo trainee.Trainee.id)))
319
Added:
);
320
Added:
( "a step out of sync with the session records nothing",
321
Added:
`Quick,
322
Added:
fun () ->
323
Added:
(* The flow advances one factor at a time and stores its position in
324
Added:
the session. A post whose [step] disagrees with that position —
325
Added:
a stale form, a double submit, or a crafted body — is refused as
326
Added:
an invalid form rather than recording a factor twice. This is the
327
Added:
web tier's guard against a duplicate signal ever reaching the
328
Added:
domain. *)
329
Added:
let c, repo = client_with_repo () in
330
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
331
Added:
let trainee = the_trainee repo ~username:"lifter" in
332
Added:
let start = body (get c "/logbook?feedback=start") in
333
Added:
let token = Option.get (csrf_token start) in
334
Added:
(* The session is at step 0; post step 3 instead. *)
335
Added:
let mismatched =
336
Added:
post c "/feedback"
337
Added:
[
338
Added:
("dream.csrf", token);
339
Added:
("step", "3");
340
Added:
("action", "next");
341
Added:
("choice", "1");
342
Added:
]
343
Added:
in
344
Added:
Alcotest.(check int)
345
Added:
"mismatched step redirects" 303 (status mismatched);
346
Added:
Alcotest.(check string)
347
Added:
"stale feedback returns to the logbook" "/logbook"
348
Added:
(location mismatched);
349
Added:
(* The mismatched post advanced nothing and stored no report. *)
350
Added:
Alcotest.(check int)
351
Added:
"no feedback stored" 0
352
Added:
(List.length
353
Added:
(Lwt_main.run (Memory_repo.feedback repo trainee.Trainee.id)))
354
Added:
);
355
Added:
( "answering every factor stores exactly one signal per category",
356
Added:
`Quick,
357
Added:
fun () ->
358
Added:
(* The flow admits one answer per factor, so the stored report holds
359
Added:
one signal per category and never a duplicate. *)
360
Added:
let c, repo = client_with_repo () in
361
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
362
Added:
let trainee = the_trainee repo ~username:"lifter" in
363
Added:
let _ = get c "/logbook?feedback=start" in
364
Added:
let rec advance step =
365
Added:
if step < 2 then begin
366
Added:
let token = Option.get (csrf_token (body (get c "/logbook"))) in
367
Added:
let _ =
368
Added:
post c "/feedback"
369
Added:
[
370
Added:
("dream.csrf", token);
371
Added:
("step", string_of_int step);
372
Added:
("action", "next");
373
Added:
("choice", "worse");
374
Added:
]
375
Added:
in
376
Added:
advance (step + 1)
377
Added:
end
378
Added:
in
379
Added:
advance 0;
380
Added:
let token = Option.get (csrf_token (body (get c "/logbook"))) in
381
Added:
let saved =
382
Added:
post c "/feedback"
383
Added:
[ ("dream.csrf", token); ("step", "2"); ("action", "save") ]
384
Added:
in
385
Added:
Alcotest.(check int) "final save redirects" 303 (status saved);
386
Added:
(* Exactly one report, with one signal per distinct factor. *)
387
Added:
let reports =
388
Added:
Lwt_main.run (Memory_repo.feedback repo trainee.Trainee.id)
389
Added:
in
390
Added:
Alcotest.(check int) "one report stored" 1 (List.length reports);
391
Added:
let signals = Feedback.signals (List.hd reports) in
392
Added:
let count p = List.length (List.filter p signals) in
393
Added:
let open Feedback in
394
Added:
Alcotest.(check int)
395
Added:
"one motivation signal" 1
396
Added:
(count (function Motivation _ -> true | _ -> false));
397
Added:
Alcotest.(check int)
398
Added:
"one difficulty signal" 1
399
Added:
(count (function Difficulty _ -> true | _ -> false)) );
400
Added:
] );
401
Added:
]
test/web/overview.ml
@@ -0,0 +1,68 @@
1
Added:
open Hito_app
2
Added:
open Support
3
Added:
4
Added:
let suite =
5
Added:
[
6
Added:
( "web.overview",
7
Added:
[
8
Added:
( "selecting a routine redirects and records the active routine",
9
Added:
`Quick,
10
Added:
fun () ->
11
Added:
(* POST-redirect-GET: selecting a routine answers 303, and the
12
Added:
redirected GET is served. The domain effect is what matters: the
13
Added:
trainee now has an active routine. *)
14
Added:
let c, repo = client_with_repo () in
15
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
16
Added:
let trainee = the_trainee repo ~username:"lifter" in
17
Added:
Alcotest.(check bool)
18
Added:
"no active routine before selection" true
19
Added:
(Option.is_none
20
Added:
(Lwt_main.run
21
Added:
(Memory_repo.active_routine repo trainee.Trainee.id)));
22
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
23
Added:
let selection =
24
Added:
post c "/routines/ideal/select" [ ("dream.csrf", token) ]
25
Added:
in
26
Added:
Alcotest.(check int) "selection redirects" 303 (status selection);
27
Added:
Alcotest.(check bool)
28
Added:
"a routine is now active" true
29
Added:
(Option.is_some
30
Added:
(Lwt_main.run
31
Added:
(Memory_repo.active_routine repo trainee.Trainee.id)));
32
Added:
(* The redirected GET is served. *)
33
Added:
Alcotest.(check int)
34
Added:
"the redirected GET is 200" 200
35
Added:
(status (get c "/")) );
36
Added:
( "the routine page is served once a routine is selected",
37
Added:
`Quick,
38
Added:
fun () ->
39
Added:
let c = client () in
40
Added:
let _ = sign_in_new c in
41
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
42
Added:
let selection =
43
Added:
post c "/routines/ideal/select" [ ("dream.csrf", token) ]
44
Added:
in
45
Added:
Alcotest.(check int) "routine selected" 303 (status selection);
46
Added:
Alcotest.(check int)
47
Added:
"routine page served" 200
48
Added:
(status (get c "/routine")) );
49
Added:
( "selecting an unknown routine is not found and selects nothing",
50
Added:
`Quick,
51
Added:
fun () ->
52
Added:
let c, repo = client_with_repo () in
53
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
54
Added:
let trainee = the_trainee repo ~username:"lifter" in
55
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
56
Added:
let response =
57
Added:
post c "/routines/no-such-routine/select"
58
Added:
[ ("dream.csrf", token) ]
59
Added:
in
60
Added:
Alcotest.(check int) "responds 404" 404 (status response);
61
Added:
(* A missing routine leaves the trainee with no active routine. *)
62
Added:
Alcotest.(check bool)
63
Added:
"no routine was selected" true
64
Added:
(Option.is_none
65
Added:
(Lwt_main.run
66
Added:
(Memory_repo.active_routine repo trainee.Trainee.id))) );
67
Added:
] );
68
Added:
]
test/web/routine_selection.ml
@@ -1,27 +0,0 @@
1
Removed:
open Hito_app
2
Removed:
open Support
3
Removed:
4
Removed:
let suite =
5
Removed:
[
6
Removed:
( "web.routine_selection",
7
Removed:
[
8
Removed:
( "selecting an unknown routine is not found and selects nothing",
9
Removed:
`Quick,
10
Removed:
fun () ->
11
Removed:
let c, repo = client_with_repo () in
12
Removed:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
13
Removed:
let trainee = the_trainee repo ~username:"lifter" in
14
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
15
Removed:
let response =
16
Removed:
post c "/routines/no-such-routine/select"
17
Removed:
[ ("dream.csrf", token) ]
18
Removed:
in
19
Removed:
Alcotest.(check int) "responds 404" 404 (status response);
20
Removed:
(* A missing routine leaves the trainee with no active routine. *)
21
Removed:
Alcotest.(check bool)
22
Removed:
"no routine was selected" true
23
Removed:
(Option.is_none
24
Removed:
(Lwt_main.run
25
Removed:
(Memory_repo.active_routine repo trainee.Trainee.id))) );
26
Removed:
] );
27
Removed:
]
test/web/saved_record_add.ml
@@ -1,122 +0,0 @@
1
Removed:
open Hito_app
2
Removed:
open Support
3
Removed:
4
Removed:
let suite =
5
Removed:
[
6
Removed:
( "web.saved_record_add",
7
Removed:
[
8
Removed:
( "an outstanding slot of a saved workout can be recorded, not only \
9
Removed:
corrected",
10
Removed:
`Quick,
11
Removed:
fun () ->
12
Removed:
(* Finish a workout with a single slot recorded, so the saved record
13
Removed:
still has outstanding slots. Then record one of those through the
14
Removed:
plain add path [POST /logbook/:id/slots/:d], which the edit tests
15
Removed:
never exercise. *)
16
Removed:
let c, repo = client_with_repo () in
17
Removed:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
18
Removed:
let trainee = the_trainee repo ~username:"lifter" in
19
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
20
Removed:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
21
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
22
Removed:
let _ =
23
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
24
Removed:
in
25
Removed:
(* Record only slot 1, then finish. Slots 0, 2, 3 stay outstanding. *)
26
Removed:
let token =
27
Removed:
Option.get (csrf_token (body (get c "/workout?slot=1")))
28
Removed:
in
29
Removed:
let _ =
30
Removed:
post c "/workout/slots/1"
31
Removed:
[
32
Removed:
("dream.csrf", token);
33
Removed:
("load", "12");
34
Removed:
("reps", "8");
35
Removed:
("extension", "");
36
Removed:
]
37
Removed:
in
38
Removed:
let token = Option.get (csrf_token (body (get c "/workout"))) in
39
Removed:
let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in
40
Removed:
let filled_of_w1 () =
41
Removed:
match
42
Removed:
Lwt_main.run
43
Removed:
(Memory_repo.find repo trainee.Trainee.id
44
Removed:
(Repository.workout_id "w1"))
45
Removed:
with
46
Removed:
| Some r -> Evidence.Workout.filled_slots r.Repository.workout
47
Removed:
| None -> Alcotest.failf "expected the saved workout w1"
48
Removed:
in
49
Removed:
Alcotest.(check int)
50
Removed:
"saved workout starts with one slot" 1 (filled_of_w1 ());
51
Removed:
(* Add slot 2 through the non-edit path. *)
52
Removed:
let token =
53
Removed:
Option.get (csrf_token (body (get c "/logbook/w1?slot=2")))
54
Removed:
in
55
Removed:
let added =
56
Removed:
post c "/logbook/w1/slots/2"
57
Removed:
[
58
Removed:
("dream.csrf", token);
59
Removed:
("load", "10");
60
Removed:
("reps", "9");
61
Removed:
("extension", "");
62
Removed:
]
63
Removed:
in
64
Removed:
Alcotest.(check int)
65
Removed:
"recorded a saved-workout slot" 303 (status added);
66
Removed:
Alcotest.(check int) "now two filled slots" 2 (filled_of_w1 ()) );
67
Removed:
( "recording an already-filled slot through the add path is refused",
68
Removed:
`Quick,
69
Removed:
fun () ->
70
Removed:
(* The add path lists only outstanding slots. A filled slot is not
71
Removed:
awaiting a record, so posting to it is a 404, not a silent second
72
Removed:
entry that would add volume. *)
73
Removed:
let c, repo = client_with_repo () in
74
Removed:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
75
Removed:
let trainee = the_trainee repo ~username:"lifter" in
76
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
77
Removed:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
78
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
79
Removed:
let _ =
80
Removed:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
81
Removed:
in
82
Removed:
let token =
83
Removed:
Option.get (csrf_token (body (get c "/workout?slot=1")))
84
Removed:
in
85
Removed:
let _ =
86
Removed:
post c "/workout/slots/1"
87
Removed:
[
88
Removed:
("dream.csrf", token);
89
Removed:
("load", "12");
90
Removed:
("reps", "8");
91
Removed:
("extension", "");
92
Removed:
]
93
Removed:
in
94
Removed:
let token = Option.get (csrf_token (body (get c "/workout"))) in
95
Removed:
let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in
96
Removed:
(* Slot 1 is filled. Re-posting to its add path is refused. *)
97
Removed:
let token =
98
Removed:
Option.get (csrf_token (body (get c "/logbook/w1?slot=2")))
99
Removed:
in
100
Removed:
let refused =
101
Removed:
post c "/logbook/w1/slots/1"
102
Removed:
[
103
Removed:
("dream.csrf", token);
104
Removed:
("load", "20");
105
Removed:
("reps", "6");
106
Removed:
("extension", "");
107
Removed:
]
108
Removed:
in
109
Removed:
Alcotest.(check int)
110
Removed:
"filled slot is not awaiting" 404 (status refused);
111
Removed:
(* The refused post added no volume: still one filled slot. *)
112
Removed:
Alcotest.(check int)
113
Removed:
"still one filled slot" 1
114
Removed:
(match
115
Removed:
Lwt_main.run
116
Removed:
(Memory_repo.find repo trainee.Trainee.id
117
Removed:
(Repository.workout_id "w1"))
118
Removed:
with
119
Removed:
| Some r -> Evidence.Workout.filled_slots r.Repository.workout
120
Removed:
| None -> Alcotest.failf "expected the saved workout w1") );
121
Removed:
] );
122
Removed:
]
test/web/sign_in.ml
@@ -1,75 +0,0 @@
1
Removed:
open Support
2
Removed:
3
Removed:
let suite =
4
Removed:
[
5
Removed:
( "web.sign_in",
6
Removed:
[
7
Removed:
( "a returning trainee signs in with their credentials",
8
Removed:
`Quick,
9
Removed:
fun () ->
10
Removed:
(* Register, then sign out, then sign back in through the credential
11
Removed:
form. This exercises [POST /login], which registration's
12
Removed:
auto-sign-in never touches. *)
13
Removed:
let c = client () in
14
Removed:
let _ = sign_in_new c in
15
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
16
Removed:
let _ = post c "/logout" [ ("dream.csrf", token) ] in
17
Removed:
Alcotest.(check int)
18
Removed:
"signed out, overview redirects" 303
19
Removed:
(status (get c "/"));
20
Removed:
let signed_in =
21
Removed:
sign_in c ~username:"lifter" ~password:"heavyduty1"
22
Removed:
in
23
Removed:
Alcotest.(check int) "sign-in redirects" 303 (status signed_in);
24
Removed:
Alcotest.(check bool)
25
Removed:
"sign-in lands on Home" true
26
Removed:
(List.mem "/" (Dream.headers signed_in "Location"));
27
Removed:
Alcotest.(check int)
28
Removed:
"authenticated overview" 200
29
Removed:
(status (get c "/")) );
30
Removed:
( "a wrong password is refused and establishes no session",
31
Removed:
`Quick,
32
Removed:
fun () ->
33
Removed:
let c = client () in
34
Removed:
let _ = sign_in_new c in
35
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
36
Removed:
let _ = post c "/logout" [ ("dream.csrf", token) ] in
37
Removed:
let refused =
38
Removed:
sign_in c ~username:"lifter" ~password:"not-the-password"
39
Removed:
in
40
Removed:
Alcotest.(check int) "rejected" 401 (status refused);
41
Removed:
(* The rejected attempt establishes no session. *)
42
Removed:
Alcotest.(check int)
43
Removed:
"still unauthenticated" 303
44
Removed:
(status (get c "/")) );
45
Removed:
( "an unknown username is refused like a wrong password",
46
Removed:
`Quick,
47
Removed:
fun () ->
48
Removed:
let c = client () in
49
Removed:
let refused = sign_in c ~username:"nobody" ~password:"heavyduty1" in
50
Removed:
Alcotest.(check int) "rejected" 401 (status refused);
51
Removed:
Alcotest.(check int)
52
Removed:
"no session established" 303
53
Removed:
(status (get c "/")) );
54
Removed:
( "an already-authenticated visit to the sign-in page redirects Home",
55
Removed:
`Quick,
56
Removed:
fun () ->
57
Removed:
let c = client () in
58
Removed:
let _ = sign_in_new c in
59
Removed:
let response = get c "/login" in
60
Removed:
Alcotest.(check int) "redirects" 303 (status response);
61
Removed:
Alcotest.(check bool)
62
Removed:
"sends an authenticated visitor Home" true
63
Removed:
(List.mem "/" (Dream.headers response "Location")) );
64
Removed:
( "an already-authenticated visit to the register page redirects Home",
65
Removed:
`Quick,
66
Removed:
fun () ->
67
Removed:
let c = client () in
68
Removed:
let _ = sign_in_new c in
69
Removed:
let response = get c "/register" in
70
Removed:
Alcotest.(check int) "redirects" 303 (status response);
71
Removed:
Alcotest.(check bool)
72
Removed:
"sends an authenticated visitor Home" true
73
Removed:
(List.mem "/" (Dream.headers response "Location")) );
74
Removed:
] );
75
Removed:
]
test/web/slot_bounds.ml
@@ -1,75 +0,0 @@
1
Removed:
open Hito_app
2
Removed:
open Support
3
Removed:
4
Removed:
let suite =
5
Removed:
[
6
Removed:
( "web.slot_bounds",
7
Removed:
[
8
Removed:
( "posting to a slot beyond the workout is not found",
9
Removed:
`Quick,
10
Removed:
fun () ->
11
Removed:
(* Day 1 has four slots (0..3). Slot 9 does not exist, so the log
12
Removed:
handler answers 404 rather than recording phantom volume. *)
13
Removed:
let c, repo = client_with_repo () in
14
Removed:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
15
Removed:
let trainee = the_trainee repo ~username:"lifter" in
16
Removed:
let _ = start_day_one c in
17
Removed:
let token = Option.get (csrf_token (body (get c "/workout"))) in
18
Removed:
let response =
19
Removed:
post c "/workout/slots/9"
20
Removed:
[
21
Removed:
("dream.csrf", token);
22
Removed:
("load", "10");
23
Removed:
("reps", "8");
24
Removed:
("extension", "");
25
Removed:
]
26
Removed:
in
27
Removed:
Alcotest.(check int)
28
Removed:
"out-of-range slot is not found" 404 (status response);
29
Removed:
(* No phantom volume was recorded. *)
30
Removed:
Alcotest.(check int)
31
Removed:
"nothing recorded" 0
32
Removed:
(match
33
Removed:
Lwt_main.run (Memory_repo.in_progress repo trainee.Trainee.id)
34
Removed:
with
35
Removed:
| Some w -> Evidence.Workout.filled_slots w
36
Removed:
| None -> Alcotest.failf "expected a workout in progress") );
37
Removed:
( "editing a slot beyond the workout is not found",
38
Removed:
`Quick,
39
Removed:
fun () ->
40
Removed:
let c = client () in
41
Removed:
let _ = sign_in_new c in
42
Removed:
let _ = start_day_one c in
43
Removed:
let token = Option.get (csrf_token (body (get c "/workout"))) in
44
Removed:
let response =
45
Removed:
post c "/workout/slots/9/edit"
46
Removed:
[
47
Removed:
("dream.csrf", token);
48
Removed:
("load", "10");
49
Removed:
("reps", "8");
50
Removed:
("extension", "");
51
Removed:
]
52
Removed:
in
53
Removed:
Alcotest.(check int)
54
Removed:
"out-of-range edit is not found" 404 (status response) );
55
Removed:
( "logging with no workout in progress is not found",
56
Removed:
`Quick,
57
Removed:
fun () ->
58
Removed:
let c = client () in
59
Removed:
let _ = sign_in_new c in
60
Removed:
(* No routine selected, no workout begun: the CSRF token comes from
61
Removed:
Home, but the slot route has no workout to record against. *)
62
Removed:
let token = Option.get (csrf_token (body (get c "/"))) in
63
Removed:
let response =
64
Removed:
post c "/workout/slots/0"
65
Removed:
[
66
Removed:
("dream.csrf", token);
67
Removed:
("load", "10");
68
Removed:
("reps", "8");
69
Removed:
("extension", "");
70
Removed:
]
71
Removed:
in
72
Removed:
Alcotest.(check int) "no workout is not found" 404 (status response)
73
Removed:
);
74
Removed:
] );
75
Removed:
]
test/web/workout.ml
@@ -0,0 +1,502 @@
1
Added:
open Hito_app
2
Added:
open Support
3
Added:
4
Added:
let suite =
5
Added:
[
6
Added:
( "web.workout",
7
Added:
[
8
Added:
( "a signed-in trainee selects a routine and begins a workout",
9
Added:
`Quick,
10
Added:
fun () ->
11
Added:
let c, repo = client_with_repo () in
12
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
13
Added:
let trainee = the_trainee repo ~username:"lifter" in
14
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
15
Added:
let selection =
16
Added:
post c "/routines/ideal/select" [ ("dream.csrf", token) ]
17
Added:
in
18
Added:
Alcotest.(check int) "routine selected" 303 (status selection);
19
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
20
Added:
let started =
21
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
22
Added:
in
23
Added:
Alcotest.(check int) "workout started" 303 (status started);
24
Added:
(* The workout is now in progress in the domain, and its view is
25
Added:
served. *)
26
Added:
Alcotest.(check bool)
27
Added:
"a workout is in progress" true
28
Added:
(Option.is_some
29
Added:
(Lwt_main.run
30
Added:
(Memory_repo.in_progress repo trainee.Trainee.id)));
31
Added:
Alcotest.(check int)
32
Added:
"the workout view is served" 200
33
Added:
(status (get c "/workout"));
34
Added:
(* The static workout client asset is served. *)
35
Added:
let asset = get c "/assets/workout-client.js" in
36
Added:
Alcotest.(check int) "serves the workout client" 200 (status asset)
37
Added:
);
38
Added:
( "beginning before recovery is refused without an override",
39
Added:
`Quick,
40
Added:
fun () ->
41
Added:
let c, repo = client_with_repo () in
42
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
43
Added:
let trainee = the_trainee repo ~username:"lifter" in
44
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
45
Added:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
46
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
47
Added:
let _ =
48
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
49
Added:
in
50
Added:
let token = Option.get (csrf_token (body (get c "/workout"))) in
51
Added:
let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in
52
Added:
(* Recovery has not elapsed. Beginning the next workout without an
53
Added:
override is bounced back to Home and starts nothing. *)
54
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
55
Added:
let refused =
56
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
57
Added:
in
58
Added:
Alcotest.(check int) "early begin bounced" 303 (status refused);
59
Added:
Alcotest.(check bool)
60
Added:
"returns Home, not the workout" true
61
Added:
(List.mem "/" (Dream.headers refused "Location"));
62
Added:
Alcotest.(check bool)
63
Added:
"no new workout in progress" true
64
Added:
(Option.is_none
65
Added:
(Lwt_main.run
66
Added:
(Memory_repo.in_progress repo trainee.Trainee.id))) );
67
Added:
( "overriding recovery begins the next workout on an override basis",
68
Added:
`Quick,
69
Added:
fun () ->
70
Added:
let c, repo = client_with_repo () in
71
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
72
Added:
let trainee = the_trainee repo ~username:"lifter" in
73
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
74
Added:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
75
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
76
Added:
let _ =
77
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
78
Added:
in
79
Added:
let token = Option.get (csrf_token (body (get c "/workout"))) in
80
Added:
let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in
81
Added:
(* Recovery has not elapsed, so the next workout is begun under an
82
Added:
explicit override. The deviation is recorded on the workout's
83
Added:
clearance basis, never silent. *)
84
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
85
Added:
let began =
86
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "true") ]
87
Added:
in
88
Added:
Alcotest.(check int) "override begin succeeds" 303 (status began);
89
Added:
let basis =
90
Added:
match
91
Added:
Lwt_main.run (Memory_repo.in_progress repo trainee.Trainee.id)
92
Added:
with
93
Added:
| Some w -> Recovery.basis (Evidence.Workout.clearance w)
94
Added:
| None -> Alcotest.failf "expected a workout in progress"
95
Added:
in
96
Added:
Alcotest.(check bool)
97
Added:
"the workout carries an override basis" true
98
Added:
(match basis with Recovery.Overridden _ -> true | _ -> false) );
99
Added:
( "recording a slot advances the count of filled slots",
100
Added:
`Quick,
101
Added:
fun () ->
102
Added:
let c, repo = client_with_repo () in
103
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
104
Added:
let trainee = the_trainee repo ~username:"lifter" in
105
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
106
Added:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
107
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
108
Added:
let _ =
109
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
110
Added:
in
111
Added:
let filled () =
112
Added:
match
113
Added:
Lwt_main.run (Memory_repo.in_progress repo trainee.Trainee.id)
114
Added:
with
115
Added:
| Some w -> Evidence.Workout.filled_slots w
116
Added:
| None -> Alcotest.failf "expected a workout in progress"
117
Added:
in
118
Added:
Alcotest.(check int) "nothing recorded yet" 0 (filled ());
119
Added:
let token = Option.get (csrf_token (body (get c "/workout"))) in
120
Added:
let recorded =
121
Added:
post c "/workout/slots/0"
122
Added:
[
123
Added:
("dream.csrf", token);
124
Added:
("iso_load", "10");
125
Added:
("iso_reps", "8");
126
Added:
("comp_load", "40");
127
Added:
("comp_reps", "6");
128
Added:
("extension", "");
129
Added:
]
130
Added:
in
131
Added:
Alcotest.(check int) "recorded slot 0" 303 (status recorded);
132
Added:
Alcotest.(check int) "one slot filled" 1 (filled ()) );
133
Added:
( "a recorded slot can be corrected, replacing it rather than adding \
134
Added:
volume",
135
Added:
`Quick,
136
Added:
fun () ->
137
Added:
let c, repo = client_with_repo () in
138
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
139
Added:
let trainee = the_trainee repo ~username:"lifter" in
140
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
141
Added:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
142
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
143
Added:
let _ =
144
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
145
Added:
in
146
Added:
(* Slot 1 is the single Laterals set. Record it, then correct it —
147
Added:
one slot at a time, addressed by [?slot=]. *)
148
Added:
let token =
149
Added:
Option.get (csrf_token (body (get c "/workout?slot=1")))
150
Added:
in
151
Added:
let recorded =
152
Added:
post c "/workout/slots/1"
153
Added:
[
154
Added:
("dream.csrf", token);
155
Added:
("load", "12");
156
Added:
("reps", "8");
157
Added:
("extension", "");
158
Added:
]
159
Added:
in
160
Added:
Alcotest.(check int) "recorded" 303 (status recorded);
161
Added:
let filled_after_record () =
162
Added:
match
163
Added:
Lwt_main.run (Memory_repo.in_progress repo trainee.Trainee.id)
164
Added:
with
165
Added:
| Some w -> Evidence.Workout.filled_slots w
166
Added:
| None -> Alcotest.failf "expected a workout in progress"
167
Added:
in
168
Added:
Alcotest.(check int) "one filled slot" 1 (filled_after_record ());
169
Added:
let token =
170
Added:
Option.get (csrf_token (body (get c "/workout?slot=1")))
171
Added:
in
172
Added:
let corrected =
173
Added:
post c "/workout/slots/1/edit"
174
Added:
[
175
Added:
("dream.csrf", token);
176
Added:
("load", "16");
177
Added:
("reps", "6");
178
Added:
("extension", "");
179
Added:
]
180
Added:
in
181
Added:
Alcotest.(check int) "corrected" 303 (status corrected);
182
Added:
(* A correction replaces the slot; it does not add volume. *)
183
Added:
Alcotest.(check int)
184
Added:
"still one filled slot, not two" 1 (filled_after_record ()) );
185
Added:
( "an invalid workout field is rejected and records nothing",
186
Added:
`Quick,
187
Added:
fun () ->
188
Added:
let c, repo = client_with_repo () in
189
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
190
Added:
let trainee = the_trainee repo ~username:"lifter" in
191
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
192
Added:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
193
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
194
Added:
let _ =
195
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
196
Added:
in
197
Added:
let token = Option.get (csrf_token (body (get c "/workout"))) in
198
Added:
let invalid =
199
Added:
post c "/workout/slots/0"
200
Added:
[
201
Added:
("dream.csrf", token);
202
Added:
("iso_load", "not-a-number");
203
Added:
("iso_reps", "8");
204
Added:
("comp_load", "40");
205
Added:
("comp_reps", "6");
206
Added:
("extension", "");
207
Added:
]
208
Added:
in
209
Added:
Alcotest.(check int) "invalid field redirects" 303 (status invalid);
210
Added:
(* The bad input recorded no slot. *)
211
Added:
Alcotest.(check int)
212
Added:
"no slot was filled" 0
213
Added:
(match
214
Added:
Lwt_main.run (Memory_repo.in_progress repo trainee.Trainee.id)
215
Added:
with
216
Added:
| Some w -> Evidence.Workout.filled_slots w
217
Added:
| None -> Alcotest.failf "expected a workout in progress") );
218
Added:
( "posting to a slot beyond the workout is not found",
219
Added:
`Quick,
220
Added:
fun () ->
221
Added:
(* Day 1 has four slots (0..3). Slot 9 does not exist, so the log
222
Added:
handler answers 404 rather than recording phantom volume. *)
223
Added:
let c, repo = client_with_repo () in
224
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
225
Added:
let trainee = the_trainee repo ~username:"lifter" in
226
Added:
let _ = start_day_one c in
227
Added:
let token = Option.get (csrf_token (body (get c "/workout"))) in
228
Added:
let response =
229
Added:
post c "/workout/slots/9"
230
Added:
[
231
Added:
("dream.csrf", token);
232
Added:
("load", "10");
233
Added:
("reps", "8");
234
Added:
("extension", "");
235
Added:
]
236
Added:
in
237
Added:
Alcotest.(check int)
238
Added:
"out-of-range slot is not found" 404 (status response);
239
Added:
(* No phantom volume was recorded. *)
240
Added:
Alcotest.(check int)
241
Added:
"nothing recorded" 0
242
Added:
(match
243
Added:
Lwt_main.run (Memory_repo.in_progress repo trainee.Trainee.id)
244
Added:
with
245
Added:
| Some w -> Evidence.Workout.filled_slots w
246
Added:
| None -> Alcotest.failf "expected a workout in progress") );
247
Added:
( "editing a slot beyond the workout is not found",
248
Added:
`Quick,
249
Added:
fun () ->
250
Added:
let c = client () in
251
Added:
let _ = sign_in_new c in
252
Added:
let _ = start_day_one c in
253
Added:
let token = Option.get (csrf_token (body (get c "/workout"))) in
254
Added:
let response =
255
Added:
post c "/workout/slots/9/edit"
256
Added:
[
257
Added:
("dream.csrf", token);
258
Added:
("load", "10");
259
Added:
("reps", "8");
260
Added:
("extension", "");
261
Added:
]
262
Added:
in
263
Added:
Alcotest.(check int)
264
Added:
"out-of-range edit is not found" 404 (status response) );
265
Added:
( "logging with no workout in progress is not found",
266
Added:
`Quick,
267
Added:
fun () ->
268
Added:
let c = client () in
269
Added:
let _ = sign_in_new c in
270
Added:
(* No routine selected, no workout begun: the CSRF token comes from
271
Added:
Home, but the slot route has no workout to record against. *)
272
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
273
Added:
let response =
274
Added:
post c "/workout/slots/0"
275
Added:
[
276
Added:
("dream.csrf", token);
277
Added:
("load", "10");
278
Added:
("reps", "8");
279
Added:
("extension", "");
280
Added:
]
281
Added:
in
282
Added:
Alcotest.(check int) "no workout is not found" 404 (status response)
283
Added:
);
284
Added:
( "cancelling a workout without a CSRF token leaves it in progress",
285
Added:
`Quick,
286
Added:
fun () ->
287
Added:
let c, repo = client_with_repo () in
288
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
289
Added:
let trainee = the_trainee repo ~username:"lifter" in
290
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
291
Added:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
292
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
293
Added:
let _ =
294
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
295
Added:
in
296
Added:
let response = post c "/workout/cancel" [ (* no dream.csrf *) ] in
297
Added:
(* Cancelling always navigates away to Home. A forged or missing
298
Added:
token skips the discard, so the workout remains in progress. *)
299
Added:
Alcotest.(check int)
300
Added:
"navigates away without an error page" 303 (status response);
301
Added:
Alcotest.(check bool)
302
Added:
"returns Home" true
303
Added:
(List.mem "/" (Dream.headers response "Location"));
304
Added:
Alcotest.(check bool)
305
Added:
"workout still in progress" true
306
Added:
(Option.is_some
307
Added:
(Lwt_main.run
308
Added:
(Memory_repo.in_progress repo trainee.Trainee.id))) );
309
Added:
( "cancelling after recording a set discards the workout entirely",
310
Added:
`Quick,
311
Added:
fun () ->
312
Added:
let c, repo = client_with_repo () in
313
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
314
Added:
let trainee = the_trainee repo ~username:"lifter" in
315
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
316
Added:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
317
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
318
Added:
let _ =
319
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
320
Added:
in
321
Added:
let token =
322
Added:
Option.get (csrf_token (body (get c "/workout?slot=1")))
323
Added:
in
324
Added:
let recorded =
325
Added:
post c "/workout/slots/1"
326
Added:
[
327
Added:
("dream.csrf", token);
328
Added:
("load", "12");
329
Added:
("reps", "8");
330
Added:
("extension", "");
331
Added:
]
332
Added:
in
333
Added:
Alcotest.(check int) "recorded a set" 303 (status recorded);
334
Added:
let token = Option.get (csrf_token (body (get c "/workout"))) in
335
Added:
let cancelled =
336
Added:
post c "/workout/cancel" [ ("dream.csrf", token) ]
337
Added:
in
338
Added:
Alcotest.(check int) "cancel returns Home" 303 (status cancelled);
339
Added:
Alcotest.(check bool)
340
Added:
"returns Home, not the logbook" true
341
Added:
(List.mem "/" (Dream.headers cancelled "Location"));
342
Added:
(* No current workout, and no record: an abandoned session is not
343
Added:
evidence. *)
344
Added:
Alcotest.(check bool)
345
Added:
"no workout in progress" true
346
Added:
(Option.is_none
347
Added:
(Lwt_main.run
348
Added:
(Memory_repo.in_progress repo trainee.Trainee.id)));
349
Added:
Alcotest.(check int)
350
Added:
"history is empty" 0
351
Added:
(List.length
352
Added:
(Lwt_main.run (Memory_repo.history repo trainee.Trainee.id)));
353
Added:
Alcotest.(check int)
354
Added:
"the discarded workout has no record" 404
355
Added:
(status (get c "/logbook/w1")) );
356
Added:
( "finishing a workout redirects to the logbook feedback prompt",
357
Added:
`Quick,
358
Added:
fun () ->
359
Added:
let c, repo = client_with_repo () in
360
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
361
Added:
let trainee = the_trainee repo ~username:"lifter" in
362
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
363
Added:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
364
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
365
Added:
let _ =
366
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
367
Added:
in
368
Added:
let token = Option.get (csrf_token (body (get c "/workout"))) in
369
Added:
let finished = post c "/workout/finish" [ ("dream.csrf", token) ] in
370
Added:
Alcotest.(check int) "finish redirects" 303 (status finished);
371
Added:
Alcotest.(check bool)
372
Added:
"redirects to the logbook with a feedback prompt" true
373
Added:
(List.mem "/logbook?prompt=feedback"
374
Added:
(Dream.headers finished "Location"));
375
Added:
(* The workout is now in history and no longer in progress. *)
376
Added:
Alcotest.(check int)
377
Added:
"one workout in history" 1
378
Added:
(List.length
379
Added:
(Lwt_main.run (Memory_repo.history repo trainee.Trainee.id)));
380
Added:
Alcotest.(check bool)
381
Added:
"nothing in progress" true
382
Added:
(Option.is_none
383
Added:
(Lwt_main.run
384
Added:
(Memory_repo.in_progress repo trainee.Trainee.id))) );
385
Added:
( "a full cycle: begin Day 1, record every slot, finish, and see it \
386
Added:
saved complete",
387
Added:
`Quick,
388
Added:
fun () ->
389
Added:
(* A deep end-to-end pass over the primary flow with a driven clock.
390
Added:
Begin Day 1, record all four slots, finish, and confirm the
391
Added:
logbook persists a complete Day 1 with four stimuli. The clocked
392
Added:
client and repo share a store, so the flow's domain effect is
393
Added:
read straight from history. *)
394
Added:
let c, now, repo = clocked_client () in
395
Added:
now := day 10;
396
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
397
Added:
let trainee = the_trainee repo ~username:"lifter" in
398
Added:
let _ = start_day_one c in
399
Added:
let in_progress_filled () =
400
Added:
match
401
Added:
Lwt_main.run (Memory_repo.in_progress repo trainee.Trainee.id)
402
Added:
with
403
Added:
| Some w -> Evidence.Workout.filled_slots w
404
Added:
| None -> Alcotest.failf "expected a workout in progress"
405
Added:
in
406
Added:
Alcotest.(check int)
407
Added:
"opens with no slots recorded" 0 (in_progress_filled ());
408
Added:
record_all_day_one_slots c;
409
Added:
Alcotest.(check int)
410
Added:
"all four slots recorded" 4 (in_progress_filled ());
411
Added:
let token = Option.get (csrf_token (body (get c "/workout"))) in
412
Added:
let finished = post c "/workout/finish" [ ("dream.csrf", token) ] in
413
Added:
Alcotest.(check int) "finish redirects" 303 (status finished);
414
Added:
Alcotest.(check bool)
415
Added:
"sends the trainee to the logbook feedback prompt" true
416
Added:
(List.mem "/logbook?prompt=feedback"
417
Added:
(Dream.headers finished "Location"));
418
Added:
(* History holds one complete Day 1 with four stimuli. *)
419
Added:
let history =
420
Added:
Lwt_main.run (Memory_repo.history repo trainee.Trainee.id)
421
Added:
in
422
Added:
Alcotest.(check int)
423
Added:
"one workout in history" 1 (List.length history);
424
Added:
let saved = (List.hd history).Repository.workout in
425
Added:
Alcotest.(check string)
426
Added:
"the saved workout is Day 1" "Day 1"
427
Added:
(Prescription.Workout.name (Evidence.Workout.prescription saved));
428
Added:
Alcotest.(check int)
429
Added:
"records four stimuli" 4
430
Added:
(List.length (Evidence.Workout.stimuli saved));
431
Added:
Alcotest.(check bool)
432
Added:
"the saved workout is complete" true
433
Added:
(Evidence.Workout.completeness saved = Evidence.Workout.Complete);
434
Added:
(* The saved workout is durable and reachable at its own URL. *)
435
Added:
Alcotest.(check int)
436
Added:
"the saved workout is reachable" 200
437
Added:
(status (get c "/logbook/w1")) );
438
Added:
( "the recovery gate blocks the next workout until enough rest, then \
439
Added:
Day 2 begins",
440
Added:
`Quick,
441
Added:
fun () ->
442
Added:
(* The deepest flow: after finishing Day 1, the next workout is
443
Added:
gated until 48 hours of recovery pass. The web tier drives the
444
Added:
clock, so this proves the gate over HTTP, not just in the
445
Added:
service. Beginning too early is refused; resting past the
446
Added:
interval clears the gate and advances the cycle to Day 2. *)
447
Added:
let c, now, repo = clocked_client () in
448
Added:
now := day 10;
449
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
450
Added:
let trainee = the_trainee repo ~username:"lifter" in
451
Added:
let _ = start_day_one c in
452
Added:
record_all_day_one_slots c;
453
Added:
let token = Option.get (csrf_token (body (get c "/workout"))) in
454
Added:
let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in
455
Added:
(* One hour later: recovery is far from complete. Beginning without
456
Added:
an override is refused and starts nothing. *)
457
Added:
now := day 10 + 3600;
458
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
459
Added:
let refused =
460
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
461
Added:
in
462
Added:
Alcotest.(check int)
463
Added:
"an early begin is bounced back" 303 (status refused);
464
Added:
Alcotest.(check bool)
465
Added:
"the early begin returns Home, not the workout" true
466
Added:
(List.mem "/" (Dream.headers refused "Location"));
467
Added:
Alcotest.(check bool)
468
Added:
"no workout was started" true
469
Added:
(Option.is_none
470
Added:
(Lwt_main.run
471
Added:
(Memory_repo.in_progress repo trainee.Trainee.id)));
472
Added:
(* Rest two full days: past the 48-hour training interval. The gate
473
Added:
clears and the next begin succeeds. *)
474
Added:
now := day 13;
475
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
476
Added:
let began =
477
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
478
Added:
in
479
Added:
Alcotest.(check int) "the rested begin succeeds" 303 (status began);
480
Added:
Alcotest.(check bool)
481
Added:
"the rested begin reaches the workout" true
482
Added:
(List.mem "/workout" (Dream.headers began "Location"));
483
Added:
(* The cycle has advanced to Day 2, cleared on recovery, not an
484
Added:
override. *)
485
Added:
let workout =
486
Added:
match
487
Added:
Lwt_main.run (Memory_repo.in_progress repo trainee.Trainee.id)
488
Added:
with
489
Added:
| Some w -> w
490
Added:
| None -> Alcotest.failf "expected a workout in progress"
491
Added:
in
492
Added:
Alcotest.(check string)
493
Added:
"the cycle advanced to Day 2" "Day 2"
494
Added:
(Prescription.Workout.name
495
Added:
(Evidence.Workout.prescription workout));
496
Added:
Alcotest.(check bool)
497
Added:
"cleared on recovery, not an override" true
498
Added:
(match Recovery.basis (Evidence.Workout.clearance workout) with
499
Added:
| Recovery.Recovered -> true
500
Added:
| Recovery.Overridden _ -> false) );
501
Added:
] );
502
Added:
]