1 open Hito_app 2 open Support 3 4 let suite = 5 [ 6 ( "web.workout", 7 [ 8 ( "a signed-in trainee selects a routine and begins a workout", 9 `Quick, 10 fun () -> 11 let c, now, repo = clocked_client () in 12 now := day 10; 13 let _ = register c ~username:"lifter" ~password:"heavyduty1" in 14 let trainee = the_trainee repo ~username:"lifter" in 15 let token = Option.get (csrf_token (body (get c "/"))) in 16 let selection = 17 post c "/routines/ideal/select" [ ("dream.csrf", token) ] 18 in 19 Alcotest.(check int) "routine selected" 303 (status selection); 20 let token = Option.get (csrf_token (body (get c "/"))) in 21 let started = 22 post c "/workout" [ ("dream.csrf", token); ("override", "false") ] 23 in 24 Alcotest.(check int) "workout started" 303 (status started); 25 (* The workout is now in progress in the domain, and its view is 26 served. *) 27 Alcotest.(check bool) 28 "a workout is in progress" true 29 (Option.is_some 30 (Lwt_main.run (Test_repo.in_progress repo trainee.Trainee.id))); 31 Alcotest.(check int) 32 "the workout view is served" 200 33 (status (get c "/workout")); 34 let workout_page = body (get c "/workout") in 35 Alcotest.(check bool) 36 "the workout date is shown" true 37 (Option.is_some 38 (index_from ~needle:"11th January 1970" workout_page 0)); 39 (* The static workout client asset is served. *) 40 let asset = get c "/assets/workout-client.js" in 41 Alcotest.(check int) "serves the workout client" 200 (status asset) 42 ); 43 ( "self-hosted fonts are served as woff2, and an unknown name is 404", 44 `Quick, 45 fun () -> 46 (* The fonts are embedded and served from the app's own origin, so a 47 visitor never reaches a third party. Each known face returns 200 48 with the woff2 media type. An unknown or crafted name returns a 49 plain 404 rather than reaching the filesystem. No sign-in is 50 needed: fonts are public assets. *) 51 let c = client () in 52 let faces = 53 [ 54 "work-sans-latin-var.woff2"; 55 "courier-prime-400-latin.woff2"; 56 "courier-prime-700-latin.woff2"; 57 ] 58 in 59 List.iter 60 (fun face -> 61 let response = get c ("/assets/fonts/" ^ face) in 62 Alcotest.(check int) 63 (Printf.sprintf "%s is served" face) 64 200 (status response); 65 Alcotest.(check (option string)) 66 (Printf.sprintf "%s is woff2" face) 67 (Some "font/woff2") 68 (Dream.header response "Content-Type"); 69 (* The body is the real font: a non-empty payload whose first 70 four bytes are the WOFF2 signature. *) 71 let bytes = body response in 72 Alcotest.(check bool) 73 (Printf.sprintf "%s has a woff2 signature" face) 74 true 75 (String.length bytes >= 4 && String.sub bytes 0 4 = "wOF2")) 76 faces; 77 let missing = get c "/assets/fonts/does-not-exist.woff2" in 78 Alcotest.(check int) 79 "an unknown font is not found" 404 (status missing) ); 80 ( "the favicon is served as an SVG", 81 `Quick, 82 fun () -> 83 let c = client () in 84 let response = get c "/assets/favicon.svg" in 85 Alcotest.(check int) "serves the favicon" 200 (status response); 86 Alcotest.(check (option string)) 87 "declares SVG content" (Some "image/svg+xml; charset=utf-8") 88 (Dream.header response "Content-Type") ); 89 ( "beginning before recovery is refused without an override", 90 `Quick, 91 fun () -> 92 let c, repo = client_with_repo () in 93 let _ = register c ~username:"lifter" ~password:"heavyduty1" in 94 let trainee = the_trainee repo ~username:"lifter" in 95 let token = Option.get (csrf_token (body (get c "/"))) in 96 let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in 97 let token = Option.get (csrf_token (body (get c "/"))) in 98 let _ = 99 post c "/workout" [ ("dream.csrf", token); ("override", "false") ] 100 in 101 let token = Option.get (csrf_token (body (get c "/workout"))) in 102 let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in 103 (* Recovery has not elapsed. Beginning the next workout without an 104 override is bounced back to Home and starts nothing. *) 105 let token = Option.get (csrf_token (body (get c "/"))) in 106 let refused = 107 post c "/workout" [ ("dream.csrf", token); ("override", "false") ] 108 in 109 Alcotest.(check int) "early begin bounced" 303 (status refused); 110 Alcotest.(check bool) 111 "returns Home, not the workout" true 112 (List.mem "/" (Dream.headers refused "Location")); 113 Alcotest.(check bool) 114 "no new workout in progress" true 115 (Option.is_none 116 (Lwt_main.run (Test_repo.in_progress repo trainee.Trainee.id))) 117 ); 118 ( "overriding recovery begins the next workout on an override basis", 119 `Quick, 120 fun () -> 121 let c, repo = client_with_repo () in 122 let _ = register c ~username:"lifter" ~password:"heavyduty1" in 123 let trainee = the_trainee repo ~username:"lifter" in 124 let token = Option.get (csrf_token (body (get c "/"))) in 125 let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in 126 let token = Option.get (csrf_token (body (get c "/"))) in 127 let _ = 128 post c "/workout" [ ("dream.csrf", token); ("override", "false") ] 129 in 130 let token = Option.get (csrf_token (body (get c "/workout"))) in 131 let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in 132 (* Recovery has not elapsed, so the next workout is begun under an 133 explicit override. The deviation is recorded on the workout's 134 clearance basis, never silent. *) 135 let token = Option.get (csrf_token (body (get c "/"))) in 136 let began = 137 post c "/workout" [ ("dream.csrf", token); ("override", "true") ] 138 in 139 Alcotest.(check int) "override begin succeeds" 303 (status began); 140 let basis = 141 match 142 Lwt_main.run (Test_repo.in_progress repo trainee.Trainee.id) 143 with 144 | Some w -> Recovery.basis (Evidence.Workout.clearance w) 145 | None -> Alcotest.failf "expected a workout in progress" 146 in 147 Alcotest.(check bool) 148 "the workout carries an override basis" true 149 (match basis with Recovery.Overridden _ -> true | _ -> false) ); 150 ( "recording a slot advances the count of filled slots", 151 `Quick, 152 fun () -> 153 let c, repo = client_with_repo () in 154 let _ = register c ~username:"lifter" ~password:"heavyduty1" in 155 let trainee = the_trainee repo ~username:"lifter" in 156 let token = Option.get (csrf_token (body (get c "/"))) in 157 let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in 158 let token = Option.get (csrf_token (body (get c "/"))) in 159 let _ = 160 post c "/workout" [ ("dream.csrf", token); ("override", "false") ] 161 in 162 let filled () = 163 match 164 Lwt_main.run (Test_repo.in_progress repo trainee.Trainee.id) 165 with 166 | Some w -> Evidence.Workout.filled_slots w 167 | None -> Alcotest.failf "expected a workout in progress" 168 in 169 Alcotest.(check int) "nothing recorded yet" 0 (filled ()); 170 let token = Option.get (csrf_token (body (get c "/workout"))) in 171 let recorded = 172 post c "/workout/slots/0" 173 [ 174 ("dream.csrf", token); 175 ("iso_load", "10"); 176 ("iso_reps", "8"); 177 ("comp_load", "40"); 178 ("comp_reps", "6"); 179 ("extension", ""); 180 ] 181 in 182 Alcotest.(check int) "recorded slot 0" 303 (status recorded); 183 Alcotest.(check int) "one slot filled" 1 (filled ()) ); 184 ( "a recorded slot can be corrected, replacing it rather than adding \ 185 volume", 186 `Quick, 187 fun () -> 188 let c, repo = client_with_repo () in 189 let _ = register c ~username:"lifter" ~password:"heavyduty1" in 190 let trainee = the_trainee repo ~username:"lifter" in 191 let token = Option.get (csrf_token (body (get c "/"))) in 192 let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in 193 let token = Option.get (csrf_token (body (get c "/"))) in 194 let _ = 195 post c "/workout" [ ("dream.csrf", token); ("override", "false") ] 196 in 197 (* Slot 1 is the single Laterals set. Record it, then correct it — 198 one slot at a time, addressed by [?slot=]. *) 199 let token = 200 Option.get (csrf_token (body (get c "/workout?slot=1"))) 201 in 202 let recorded = 203 post c "/workout/slots/1" 204 [ 205 ("dream.csrf", token); 206 ("load", "12"); 207 ("reps", "8"); 208 ("extension", ""); 209 ] 210 in 211 Alcotest.(check int) "recorded" 303 (status recorded); 212 let filled_after_record () = 213 match 214 Lwt_main.run (Test_repo.in_progress repo trainee.Trainee.id) 215 with 216 | Some w -> Evidence.Workout.filled_slots w 217 | None -> Alcotest.failf "expected a workout in progress" 218 in 219 let slot1_effort () = 220 match 221 Lwt_main.run (Test_repo.in_progress repo trainee.Trainee.id) 222 with 223 | Some w -> ( 224 match List.assoc_opt 1 (Evidence.Workout.performed w) with 225 | Some s -> List.hd (Evidence.Stimulus.efforts s) 226 | None -> Alcotest.failf "expected slot 1 to be filled") 227 | None -> Alcotest.failf "expected a workout in progress" 228 in 229 Alcotest.(check int) "one filled slot" 1 (filled_after_record ()); 230 let edit_page = body (get c "/workout?slot=1") in 231 let before_edit = slot1_effort () in 232 Alcotest.(check (float 0.001)) 233 "opening correction keeps the saved load" 12. 234 (Evidence.Stimulus.Effort.load before_edit); 235 Alcotest.(check int) 236 "opening correction keeps the saved reps" 8 237 (Evidence.Stimulus.Effort.reps before_edit); 238 let token = Option.get (csrf_token edit_page) in 239 let corrected = 240 post c "/workout/slots/1/edit" 241 [ 242 ("dream.csrf", token); 243 ("load", "16"); 244 ("reps", "6"); 245 ("extension", ""); 246 ] 247 in 248 Alcotest.(check int) "corrected" 303 (status corrected); 249 (* A correction replaces the slot; it does not add volume. *) 250 Alcotest.(check int) 251 "still one filled slot, not two" 1 (filled_after_record ()); 252 (* The stored slot now holds the corrected values, not the originals. *) 253 let effort = slot1_effort () in 254 Alcotest.(check (float 0.001)) 255 "load updated to the corrected value" 16. 256 (Evidence.Stimulus.Effort.load effort); 257 Alcotest.(check int) 258 "reps updated to the corrected value" 6 259 (Evidence.Stimulus.Effort.reps effort) ); 260 ( "an invalid workout field is rejected and records nothing", 261 `Quick, 262 fun () -> 263 let c, repo = client_with_repo () in 264 let _ = register c ~username:"lifter" ~password:"heavyduty1" in 265 let trainee = the_trainee repo ~username:"lifter" in 266 let token = Option.get (csrf_token (body (get c "/"))) in 267 let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in 268 let token = Option.get (csrf_token (body (get c "/"))) in 269 let _ = 270 post c "/workout" [ ("dream.csrf", token); ("override", "false") ] 271 in 272 let token = Option.get (csrf_token (body (get c "/workout"))) in 273 let invalid = 274 post c "/workout/slots/0" 275 [ 276 ("dream.csrf", token); 277 ("iso_load", "not-a-number"); 278 ("iso_reps", "8"); 279 ("comp_load", "40"); 280 ("comp_reps", "6"); 281 ("extension", ""); 282 ] 283 in 284 Alcotest.(check int) "invalid field redirects" 303 (status invalid); 285 (* The bad input recorded no slot. *) 286 Alcotest.(check int) 287 "no slot was filled" 0 288 (match 289 Lwt_main.run (Test_repo.in_progress repo trainee.Trainee.id) 290 with 291 | Some w -> Evidence.Workout.filled_slots w 292 | None -> Alcotest.failf "expected a workout in progress") ); 293 ( "posting to a slot beyond the workout is not found", 294 `Quick, 295 fun () -> 296 (* Day 1 has four slots (0..3). Slot 9 does not exist, so the log 297 handler answers 404 rather than recording phantom volume. *) 298 let c, repo = client_with_repo () in 299 let _ = register c ~username:"lifter" ~password:"heavyduty1" in 300 let trainee = the_trainee repo ~username:"lifter" in 301 let _ = start_day_one c in 302 let token = Option.get (csrf_token (body (get c "/workout"))) in 303 let response = 304 post c "/workout/slots/9" 305 [ 306 ("dream.csrf", token); 307 ("load", "10"); 308 ("reps", "8"); 309 ("extension", ""); 310 ] 311 in 312 Alcotest.(check int) 313 "out-of-range slot is not found" 404 (status response); 314 (* No phantom volume was recorded. *) 315 Alcotest.(check int) 316 "nothing recorded" 0 317 (match 318 Lwt_main.run (Test_repo.in_progress repo trainee.Trainee.id) 319 with 320 | Some w -> Evidence.Workout.filled_slots w 321 | None -> Alcotest.failf "expected a workout in progress") ); 322 ( "editing a slot beyond the workout is not found", 323 `Quick, 324 fun () -> 325 let c = client () in 326 let _ = sign_in_new c in 327 let _ = start_day_one c in 328 let token = Option.get (csrf_token (body (get c "/workout"))) in 329 let response = 330 post c "/workout/slots/9/edit" 331 [ 332 ("dream.csrf", token); 333 ("load", "10"); 334 ("reps", "8"); 335 ("extension", ""); 336 ] 337 in 338 Alcotest.(check int) 339 "out-of-range edit is not found" 404 (status response) ); 340 ( "logging with no workout in progress is not found", 341 `Quick, 342 fun () -> 343 let c = client () in 344 let _ = sign_in_new c in 345 (* No routine selected, no workout begun: the CSRF token comes from 346 Home, but the slot route has no workout to record against. *) 347 let token = Option.get (csrf_token (body (get c "/"))) in 348 let response = 349 post c "/workout/slots/0" 350 [ 351 ("dream.csrf", token); 352 ("load", "10"); 353 ("reps", "8"); 354 ("extension", ""); 355 ] 356 in 357 Alcotest.(check int) "no workout is not found" 404 (status response) 358 ); 359 ( "cancelling a workout without a CSRF token leaves it in progress", 360 `Quick, 361 fun () -> 362 let c, repo = client_with_repo () in 363 let _ = register c ~username:"lifter" ~password:"heavyduty1" in 364 let trainee = the_trainee repo ~username:"lifter" in 365 let token = Option.get (csrf_token (body (get c "/"))) in 366 let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in 367 let token = Option.get (csrf_token (body (get c "/"))) in 368 let _ = 369 post c "/workout" [ ("dream.csrf", token); ("override", "false") ] 370 in 371 let response = post c "/workout/cancel" [ (* no dream.csrf *) ] in 372 (* Cancelling always navigates away to Home. A forged or missing 373 token skips the discard, so the workout remains in progress. *) 374 Alcotest.(check int) 375 "navigates away without an error page" 303 (status response); 376 Alcotest.(check bool) 377 "returns Home" true 378 (List.mem "/" (Dream.headers response "Location")); 379 Alcotest.(check bool) 380 "workout still in progress" true 381 (Option.is_some 382 (Lwt_main.run (Test_repo.in_progress repo trainee.Trainee.id))) 383 ); 384 ( "cancelling after recording a set discards the workout entirely", 385 `Quick, 386 fun () -> 387 let c, repo = client_with_repo () in 388 let _ = register c ~username:"lifter" ~password:"heavyduty1" in 389 let trainee = the_trainee repo ~username:"lifter" in 390 let token = Option.get (csrf_token (body (get c "/"))) in 391 let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in 392 let token = Option.get (csrf_token (body (get c "/"))) in 393 let _ = 394 post c "/workout" [ ("dream.csrf", token); ("override", "false") ] 395 in 396 let token = 397 Option.get (csrf_token (body (get c "/workout?slot=1"))) 398 in 399 let recorded = 400 post c "/workout/slots/1" 401 [ 402 ("dream.csrf", token); 403 ("load", "12"); 404 ("reps", "8"); 405 ("extension", ""); 406 ] 407 in 408 Alcotest.(check int) "recorded a set" 303 (status recorded); 409 let token = Option.get (csrf_token (body (get c "/workout"))) in 410 let cancelled = 411 post c "/workout/cancel" [ ("dream.csrf", token) ] 412 in 413 Alcotest.(check int) "cancel returns Home" 303 (status cancelled); 414 Alcotest.(check bool) 415 "returns Home, not the logbook" true 416 (List.mem "/" (Dream.headers cancelled "Location")); 417 (* No current workout, and no record: an abandoned session is not 418 evidence. *) 419 Alcotest.(check bool) 420 "no workout in progress" true 421 (Option.is_none 422 (Lwt_main.run (Test_repo.in_progress repo trainee.Trainee.id))); 423 Alcotest.(check int) 424 "history is empty" 0 425 (List.length 426 (Lwt_main.run (Test_repo.history repo trainee.Trainee.id))); 427 Alcotest.(check int) 428 "the discarded workout has no record" 404 429 (status (get c "/logbook/t1:w1")) ); 430 ( "finishing a workout redirects to the logbook feedback prompt", 431 `Quick, 432 fun () -> 433 let c, repo = client_with_repo () in 434 let _ = register c ~username:"lifter" ~password:"heavyduty1" in 435 let trainee = the_trainee repo ~username:"lifter" in 436 let token = Option.get (csrf_token (body (get c "/"))) in 437 let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in 438 let token = Option.get (csrf_token (body (get c "/"))) in 439 let _ = 440 post c "/workout" [ ("dream.csrf", token); ("override", "false") ] 441 in 442 let token = Option.get (csrf_token (body (get c "/workout"))) in 443 let finished = post c "/workout/finish" [ ("dream.csrf", token) ] in 444 Alcotest.(check int) "finish redirects" 303 (status finished); 445 Alcotest.(check bool) 446 "redirects to the logbook with a feedback prompt" true 447 (List.mem "/logbook?prompt=feedback" 448 (Dream.headers finished "Location")); 449 (* The workout is now in history and no longer in progress. *) 450 Alcotest.(check int) 451 "one workout in history" 1 452 (List.length 453 (Lwt_main.run (Test_repo.history repo trainee.Trainee.id))); 454 Alcotest.(check bool) 455 "nothing in progress" true 456 (Option.is_none 457 (Lwt_main.run (Test_repo.in_progress repo trainee.Trainee.id))) 458 ); 459 ( "a full cycle: begin Day 1, record every slot, finish, and see it \ 460 saved complete", 461 `Quick, 462 fun () -> 463 (* A deep end-to-end pass over the primary flow with a driven clock. 464 Begin Day 1, record all four slots, finish, and confirm the 465 logbook persists a complete Day 1 with four stimuli. The clocked 466 client and repo share a store, so the flow's domain effect is 467 read straight from history. *) 468 let c, now, repo = clocked_client () in 469 now := day 10; 470 let _ = register c ~username:"lifter" ~password:"heavyduty1" in 471 let trainee = the_trainee repo ~username:"lifter" in 472 let _ = start_day_one c in 473 let in_progress_filled () = 474 match 475 Lwt_main.run (Test_repo.in_progress repo trainee.Trainee.id) 476 with 477 | Some w -> Evidence.Workout.filled_slots w 478 | None -> Alcotest.failf "expected a workout in progress" 479 in 480 Alcotest.(check int) 481 "opens with no slots recorded" 0 (in_progress_filled ()); 482 record_all_day_one_slots c; 483 Alcotest.(check int) 484 "all four slots recorded" 4 (in_progress_filled ()); 485 let token = Option.get (csrf_token (body (get c "/workout"))) in 486 let finished = post c "/workout/finish" [ ("dream.csrf", token) ] in 487 Alcotest.(check int) "finish redirects" 303 (status finished); 488 Alcotest.(check bool) 489 "sends the trainee to the logbook feedback prompt" true 490 (List.mem "/logbook?prompt=feedback" 491 (Dream.headers finished "Location")); 492 (* History holds one complete Day 1 with four stimuli. *) 493 let history = 494 Lwt_main.run (Test_repo.history repo trainee.Trainee.id) 495 in 496 Alcotest.(check int) 497 "one workout in history" 1 (List.length history); 498 let saved = (List.hd history).Repository.workout in 499 Alcotest.(check string) 500 "the saved workout is Day 1" "Day 1" 501 (Prescription.Workout.name (Evidence.Workout.prescription saved)); 502 Alcotest.(check int) 503 "records four stimuli" 4 504 (List.length (Evidence.Workout.stimuli saved)); 505 Alcotest.(check bool) 506 "the saved workout is complete" true 507 (Evidence.Workout.completeness saved = Evidence.Workout.Complete); 508 (* The saved workout is durable and reachable at its own URL. *) 509 Alcotest.(check int) 510 "the saved workout is reachable" 200 511 (status (get c "/logbook/t1:w1")) ); 512 ( "the recovery gate blocks the next workout until enough rest, then \ 513 Day 2 begins", 514 `Quick, 515 fun () -> 516 (* The deepest flow: after finishing Day 1, the next workout is 517 gated until 48 hours of recovery pass. The web tier drives the 518 clock, so this proves the gate over HTTP, not just in the 519 service. Beginning too early is refused; resting past the 520 interval clears the gate and advances the cycle to Day 2. *) 521 let c, now, repo = clocked_client () in 522 now := day 10; 523 let _ = register c ~username:"lifter" ~password:"heavyduty1" in 524 let trainee = the_trainee repo ~username:"lifter" in 525 let _ = start_day_one c in 526 record_all_day_one_slots c; 527 let token = Option.get (csrf_token (body (get c "/workout"))) in 528 let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in 529 (* One hour later: recovery is far from complete. Beginning without 530 an override is refused and starts nothing. *) 531 now := day 10 + 3600; 532 let token = Option.get (csrf_token (body (get c "/"))) in 533 let refused = 534 post c "/workout" [ ("dream.csrf", token); ("override", "false") ] 535 in 536 Alcotest.(check int) 537 "an early begin is bounced back" 303 (status refused); 538 Alcotest.(check bool) 539 "the early begin returns Home, not the workout" true 540 (List.mem "/" (Dream.headers refused "Location")); 541 Alcotest.(check bool) 542 "no workout was started" true 543 (Option.is_none 544 (Lwt_main.run (Test_repo.in_progress repo trainee.Trainee.id))); 545 (* Rest two full days: past the 48-hour training interval. The gate 546 clears and the next begin succeeds. *) 547 now := day 13; 548 let token = Option.get (csrf_token (body (get c "/"))) in 549 let began = 550 post c "/workout" [ ("dream.csrf", token); ("override", "false") ] 551 in 552 Alcotest.(check int) "the rested begin succeeds" 303 (status began); 553 Alcotest.(check bool) 554 "the rested begin reaches the workout" true 555 (List.mem "/workout" (Dream.headers began "Location")); 556 (* The cycle has advanced to Day 2, cleared on recovery, not an 557 override. *) 558 let workout = 559 match 560 Lwt_main.run (Test_repo.in_progress repo trainee.Trainee.id) 561 with 562 | Some w -> w 563 | None -> Alcotest.failf "expected a workout in progress" 564 in 565 Alcotest.(check string) 566 "the cycle advanced to Day 2" "Day 2" 567 (Prescription.Workout.name 568 (Evidence.Workout.prescription workout)); 569 Alcotest.(check bool) 570 "cleared on recovery, not an override" true 571 (match Recovery.basis (Evidence.Workout.clearance workout) with 572 | Recovery.Recovered -> true 573 | Recovery.Overridden _ -> false) ); 574 ( "completed workouts remain available when the routine cycle returns", 575 `Quick, 576 fun () -> 577 let c, now, repo = clocked_client () in 578 now := day 10; 579 let _ = register c ~username:"lifter" ~password:"heavyduty1" in 580 let trainee = the_trainee repo ~username:"lifter" in 581 let _ = start_day_one c in 582 record_all_day_one_slots c; 583 let token = Option.get (csrf_token (body (get c "/workout"))) in 584 let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in 585 let rec reach_day_one attempts d = 586 if attempts = 0 then Alcotest.failf "Day 1 did not recur" 587 else begin 588 now := day d; 589 let token = Option.get (csrf_token (body (get c "/"))) in 590 let _ = 591 post c "/workout" 592 [ ("dream.csrf", token); ("override", "false") ] 593 in 594 match 595 Lwt_main.run (Test_repo.in_progress repo trainee.Trainee.id) 596 with 597 | Some workout 598 when String.equal 599 (Prescription.Workout.name 600 (Evidence.Workout.prescription workout)) 601 "Day 1" -> 602 () 603 | Some _ -> 604 record_all_day_one_slots c; 605 let token = 606 Option.get (csrf_token (body (get c "/workout"))) 607 in 608 let _ = 609 post c "/workout/finish" [ ("dream.csrf", token) ] 610 in 611 reach_day_one (attempts - 1) (d + 3) 612 | None -> Alcotest.failf "expected a workout in progress" 613 end 614 in 615 reach_day_one 6 13; 616 Alcotest.(check bool) 617 "the original completed workout remains in history" true 618 (List.length 619 (Lwt_main.run (Test_repo.history repo trainee.Trainee.id)) 620 >= 1) ); 621 ] ); 622 ] 623