open Hito_app open Support let suite = [ ( "web.workout", [ ( "a signed-in trainee selects a routine and begins a workout", `Quick, fun () -> let c, now, repo = clocked_client () in now := day 10; let _ = register c ~username:"lifter" ~password:"heavyduty1" in let trainee = the_trainee repo ~username:"lifter" in let token = Option.get (csrf_token (body (get c "/"))) in let selection = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in Alcotest.(check int) "routine selected" 303 (status selection); let token = Option.get (csrf_token (body (get c "/"))) in let started = post c "/workout" [ ("dream.csrf", token); ("override", "false") ] in Alcotest.(check int) "workout started" 303 (status started); (* The workout is now in progress in the domain, and its view is served. *) Alcotest.(check bool) "a workout is in progress" true (Option.is_some (Lwt_main.run (Test_repo.in_progress repo trainee.Trainee.id))); Alcotest.(check int) "the workout view is served" 200 (status (get c "/workout")); let workout_page = body (get c "/workout") in Alcotest.(check bool) "the workout date is shown" true (Option.is_some (index_from ~needle:"11th January 1970" workout_page 0)); (* The static workout client asset is served. *) let asset = get c "/assets/workout-client.js" in Alcotest.(check int) "serves the workout client" 200 (status asset) ); ( "self-hosted fonts are served as woff2, and an unknown name is 404", `Quick, fun () -> (* The fonts are embedded and served from the app's own origin, so a visitor never reaches a third party. Each known face returns 200 with the woff2 media type. An unknown or crafted name returns a plain 404 rather than reaching the filesystem. No sign-in is needed: fonts are public assets. *) let c = client () in let faces = [ "work-sans-latin-var.woff2"; "courier-prime-400-latin.woff2"; "courier-prime-700-latin.woff2"; ] in List.iter (fun face -> let response = get c ("/assets/fonts/" ^ face) in Alcotest.(check int) (Printf.sprintf "%s is served" face) 200 (status response); Alcotest.(check (option string)) (Printf.sprintf "%s is woff2" face) (Some "font/woff2") (Dream.header response "Content-Type"); (* The body is the real font: a non-empty payload whose first four bytes are the WOFF2 signature. *) let bytes = body response in Alcotest.(check bool) (Printf.sprintf "%s has a woff2 signature" face) true (String.length bytes >= 4 && String.sub bytes 0 4 = "wOF2")) faces; let missing = get c "/assets/fonts/does-not-exist.woff2" in Alcotest.(check int) "an unknown font is not found" 404 (status missing) ); ( "the favicon is served as an SVG", `Quick, fun () -> let c = client () in let response = get c "/assets/favicon.svg" in Alcotest.(check int) "serves the favicon" 200 (status response); Alcotest.(check (option string)) "declares SVG content" (Some "image/svg+xml; charset=utf-8") (Dream.header response "Content-Type") ); ( "beginning before recovery is refused without an override", `Quick, fun () -> let c, repo = client_with_repo () in let _ = register c ~username:"lifter" ~password:"heavyduty1" in let trainee = the_trainee repo ~username:"lifter" in let token = Option.get (csrf_token (body (get c "/"))) in let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in let token = Option.get (csrf_token (body (get c "/"))) in let _ = post c "/workout" [ ("dream.csrf", token); ("override", "false") ] in let token = Option.get (csrf_token (body (get c "/workout"))) in let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in (* Recovery has not elapsed. Beginning the next workout without an override is bounced back to Home and starts nothing. *) let token = Option.get (csrf_token (body (get c "/"))) in let refused = post c "/workout" [ ("dream.csrf", token); ("override", "false") ] in Alcotest.(check int) "early begin bounced" 303 (status refused); Alcotest.(check bool) "returns Home, not the workout" true (List.mem "/" (Dream.headers refused "Location")); Alcotest.(check bool) "no new workout in progress" true (Option.is_none (Lwt_main.run (Test_repo.in_progress repo trainee.Trainee.id))) ); ( "overriding recovery begins the next workout on an override basis", `Quick, fun () -> let c, repo = client_with_repo () in let _ = register c ~username:"lifter" ~password:"heavyduty1" in let trainee = the_trainee repo ~username:"lifter" in let token = Option.get (csrf_token (body (get c "/"))) in let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in let token = Option.get (csrf_token (body (get c "/"))) in let _ = post c "/workout" [ ("dream.csrf", token); ("override", "false") ] in let token = Option.get (csrf_token (body (get c "/workout"))) in let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in (* Recovery has not elapsed, so the next workout is begun under an explicit override. The deviation is recorded on the workout's clearance basis, never silent. *) let token = Option.get (csrf_token (body (get c "/"))) in let began = post c "/workout" [ ("dream.csrf", token); ("override", "true") ] in Alcotest.(check int) "override begin succeeds" 303 (status began); let basis = match Lwt_main.run (Test_repo.in_progress repo trainee.Trainee.id) with | Some w -> Recovery.basis (Evidence.Workout.clearance w) | None -> Alcotest.failf "expected a workout in progress" in Alcotest.(check bool) "the workout carries an override basis" true (match basis with Recovery.Overridden _ -> true | _ -> false) ); ( "recording a slot advances the count of filled slots", `Quick, fun () -> let c, repo = client_with_repo () in let _ = register c ~username:"lifter" ~password:"heavyduty1" in let trainee = the_trainee repo ~username:"lifter" in let token = Option.get (csrf_token (body (get c "/"))) in let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in let token = Option.get (csrf_token (body (get c "/"))) in let _ = post c "/workout" [ ("dream.csrf", token); ("override", "false") ] in let filled () = match Lwt_main.run (Test_repo.in_progress repo trainee.Trainee.id) with | Some w -> Evidence.Workout.filled_slots w | None -> Alcotest.failf "expected a workout in progress" in Alcotest.(check int) "nothing recorded yet" 0 (filled ()); let token = Option.get (csrf_token (body (get c "/workout"))) in let recorded = post c "/workout/slots/0" [ ("dream.csrf", token); ("iso_load", "10"); ("iso_reps", "8"); ("comp_load", "40"); ("comp_reps", "6"); ("extension", ""); ] in Alcotest.(check int) "recorded slot 0" 303 (status recorded); Alcotest.(check int) "one slot filled" 1 (filled ()) ); ( "a recorded slot can be corrected, replacing it rather than adding \ volume", `Quick, fun () -> let c, repo = client_with_repo () in let _ = register c ~username:"lifter" ~password:"heavyduty1" in let trainee = the_trainee repo ~username:"lifter" in let token = Option.get (csrf_token (body (get c "/"))) in let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in let token = Option.get (csrf_token (body (get c "/"))) in let _ = post c "/workout" [ ("dream.csrf", token); ("override", "false") ] in (* Slot 1 is the single Laterals set. Record it, then correct it — one slot at a time, addressed by [?slot=]. *) let token = Option.get (csrf_token (body (get c "/workout?slot=1"))) in let recorded = post c "/workout/slots/1" [ ("dream.csrf", token); ("load", "12"); ("reps", "8"); ("extension", ""); ] in Alcotest.(check int) "recorded" 303 (status recorded); let filled_after_record () = match Lwt_main.run (Test_repo.in_progress repo trainee.Trainee.id) with | Some w -> Evidence.Workout.filled_slots w | None -> Alcotest.failf "expected a workout in progress" in let slot1_effort () = match Lwt_main.run (Test_repo.in_progress repo trainee.Trainee.id) with | Some w -> ( match List.assoc_opt 1 (Evidence.Workout.performed w) with | Some s -> List.hd (Evidence.Stimulus.efforts s) | None -> Alcotest.failf "expected slot 1 to be filled") | None -> Alcotest.failf "expected a workout in progress" in Alcotest.(check int) "one filled slot" 1 (filled_after_record ()); let edit_page = body (get c "/workout?slot=1") in let before_edit = slot1_effort () in Alcotest.(check (float 0.001)) "opening correction keeps the saved load" 12. (Evidence.Stimulus.Effort.load before_edit); Alcotest.(check int) "opening correction keeps the saved reps" 8 (Evidence.Stimulus.Effort.reps before_edit); let token = Option.get (csrf_token edit_page) in let corrected = post c "/workout/slots/1/edit" [ ("dream.csrf", token); ("load", "16"); ("reps", "6"); ("extension", ""); ] in Alcotest.(check int) "corrected" 303 (status corrected); (* A correction replaces the slot; it does not add volume. *) Alcotest.(check int) "still one filled slot, not two" 1 (filled_after_record ()); (* The stored slot now holds the corrected values, not the originals. *) let effort = slot1_effort () in Alcotest.(check (float 0.001)) "load updated to the corrected value" 16. (Evidence.Stimulus.Effort.load effort); Alcotest.(check int) "reps updated to the corrected value" 6 (Evidence.Stimulus.Effort.reps effort) ); ( "an invalid workout field is rejected and records nothing", `Quick, fun () -> let c, repo = client_with_repo () in let _ = register c ~username:"lifter" ~password:"heavyduty1" in let trainee = the_trainee repo ~username:"lifter" in let token = Option.get (csrf_token (body (get c "/"))) in let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in let token = Option.get (csrf_token (body (get c "/"))) in let _ = post c "/workout" [ ("dream.csrf", token); ("override", "false") ] in let token = Option.get (csrf_token (body (get c "/workout"))) in let invalid = post c "/workout/slots/0" [ ("dream.csrf", token); ("iso_load", "not-a-number"); ("iso_reps", "8"); ("comp_load", "40"); ("comp_reps", "6"); ("extension", ""); ] in Alcotest.(check int) "invalid field redirects" 303 (status invalid); (* The bad input recorded no slot. *) Alcotest.(check int) "no slot was filled" 0 (match Lwt_main.run (Test_repo.in_progress repo trainee.Trainee.id) with | Some w -> Evidence.Workout.filled_slots w | None -> Alcotest.failf "expected a workout in progress") ); ( "posting to a slot beyond the workout is not found", `Quick, fun () -> (* Day 1 has four slots (0..3). Slot 9 does not exist, so the log handler answers 404 rather than recording phantom volume. *) let c, repo = client_with_repo () in let _ = register c ~username:"lifter" ~password:"heavyduty1" in let trainee = the_trainee repo ~username:"lifter" in let _ = start_day_one c in let token = Option.get (csrf_token (body (get c "/workout"))) in let response = post c "/workout/slots/9" [ ("dream.csrf", token); ("load", "10"); ("reps", "8"); ("extension", ""); ] in Alcotest.(check int) "out-of-range slot is not found" 404 (status response); (* No phantom volume was recorded. *) Alcotest.(check int) "nothing recorded" 0 (match Lwt_main.run (Test_repo.in_progress repo trainee.Trainee.id) with | Some w -> Evidence.Workout.filled_slots w | None -> Alcotest.failf "expected a workout in progress") ); ( "editing a slot beyond the workout is not found", `Quick, fun () -> let c = client () in let _ = sign_in_new c in let _ = start_day_one c in let token = Option.get (csrf_token (body (get c "/workout"))) in let response = post c "/workout/slots/9/edit" [ ("dream.csrf", token); ("load", "10"); ("reps", "8"); ("extension", ""); ] in Alcotest.(check int) "out-of-range edit is not found" 404 (status response) ); ( "logging with no workout in progress is not found", `Quick, fun () -> let c = client () in let _ = sign_in_new c in (* No routine selected, no workout begun: the CSRF token comes from Home, but the slot route has no workout to record against. *) let token = Option.get (csrf_token (body (get c "/"))) in let response = post c "/workout/slots/0" [ ("dream.csrf", token); ("load", "10"); ("reps", "8"); ("extension", ""); ] in Alcotest.(check int) "no workout is not found" 404 (status response) ); ( "cancelling a workout without a CSRF token leaves it in progress", `Quick, fun () -> let c, repo = client_with_repo () in let _ = register c ~username:"lifter" ~password:"heavyduty1" in let trainee = the_trainee repo ~username:"lifter" in let token = Option.get (csrf_token (body (get c "/"))) in let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in let token = Option.get (csrf_token (body (get c "/"))) in let _ = post c "/workout" [ ("dream.csrf", token); ("override", "false") ] in let response = post c "/workout/cancel" [ (* no dream.csrf *) ] in (* Cancelling always navigates away to Home. A forged or missing token skips the discard, so the workout remains in progress. *) Alcotest.(check int) "navigates away without an error page" 303 (status response); Alcotest.(check bool) "returns Home" true (List.mem "/" (Dream.headers response "Location")); Alcotest.(check bool) "workout still in progress" true (Option.is_some (Lwt_main.run (Test_repo.in_progress repo trainee.Trainee.id))) ); ( "cancelling after recording a set discards the workout entirely", `Quick, fun () -> let c, repo = client_with_repo () in let _ = register c ~username:"lifter" ~password:"heavyduty1" in let trainee = the_trainee repo ~username:"lifter" in let token = Option.get (csrf_token (body (get c "/"))) in let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in let token = Option.get (csrf_token (body (get c "/"))) in let _ = post c "/workout" [ ("dream.csrf", token); ("override", "false") ] in let token = Option.get (csrf_token (body (get c "/workout?slot=1"))) in let recorded = post c "/workout/slots/1" [ ("dream.csrf", token); ("load", "12"); ("reps", "8"); ("extension", ""); ] in Alcotest.(check int) "recorded a set" 303 (status recorded); let token = Option.get (csrf_token (body (get c "/workout"))) in let cancelled = post c "/workout/cancel" [ ("dream.csrf", token) ] in Alcotest.(check int) "cancel returns Home" 303 (status cancelled); Alcotest.(check bool) "returns Home, not the logbook" true (List.mem "/" (Dream.headers cancelled "Location")); (* No current workout, and no record: an abandoned session is not evidence. *) Alcotest.(check bool) "no workout in progress" true (Option.is_none (Lwt_main.run (Test_repo.in_progress repo trainee.Trainee.id))); Alcotest.(check int) "history is empty" 0 (List.length (Lwt_main.run (Test_repo.history repo trainee.Trainee.id))); Alcotest.(check int) "the discarded workout has no record" 404 (status (get c "/logbook/t1:w1")) ); ( "finishing a workout redirects to the logbook feedback prompt", `Quick, fun () -> let c, repo = client_with_repo () in let _ = register c ~username:"lifter" ~password:"heavyduty1" in let trainee = the_trainee repo ~username:"lifter" in let token = Option.get (csrf_token (body (get c "/"))) in let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in let token = Option.get (csrf_token (body (get c "/"))) in let _ = post c "/workout" [ ("dream.csrf", token); ("override", "false") ] in let token = Option.get (csrf_token (body (get c "/workout"))) in let finished = post c "/workout/finish" [ ("dream.csrf", token) ] in Alcotest.(check int) "finish redirects" 303 (status finished); Alcotest.(check bool) "redirects to the logbook with a feedback prompt" true (List.mem "/logbook?prompt=feedback" (Dream.headers finished "Location")); (* The workout is now in history and no longer in progress. *) Alcotest.(check int) "one workout in history" 1 (List.length (Lwt_main.run (Test_repo.history repo trainee.Trainee.id))); Alcotest.(check bool) "nothing in progress" true (Option.is_none (Lwt_main.run (Test_repo.in_progress repo trainee.Trainee.id))) ); ( "a full cycle: begin Day 1, record every slot, finish, and see it \ saved complete", `Quick, fun () -> (* A deep end-to-end pass over the primary flow with a driven clock. Begin Day 1, record all four slots, finish, and confirm the logbook persists a complete Day 1 with four stimuli. The clocked client and repo share a store, so the flow's domain effect is read straight from history. *) let c, now, repo = clocked_client () in now := day 10; let _ = register c ~username:"lifter" ~password:"heavyduty1" in let trainee = the_trainee repo ~username:"lifter" in let _ = start_day_one c in let in_progress_filled () = match Lwt_main.run (Test_repo.in_progress repo trainee.Trainee.id) with | Some w -> Evidence.Workout.filled_slots w | None -> Alcotest.failf "expected a workout in progress" in Alcotest.(check int) "opens with no slots recorded" 0 (in_progress_filled ()); record_all_day_one_slots c; Alcotest.(check int) "all four slots recorded" 4 (in_progress_filled ()); let token = Option.get (csrf_token (body (get c "/workout"))) in let finished = post c "/workout/finish" [ ("dream.csrf", token) ] in Alcotest.(check int) "finish redirects" 303 (status finished); Alcotest.(check bool) "sends the trainee to the logbook feedback prompt" true (List.mem "/logbook?prompt=feedback" (Dream.headers finished "Location")); (* History holds one complete Day 1 with four stimuli. *) let history = Lwt_main.run (Test_repo.history repo trainee.Trainee.id) in Alcotest.(check int) "one workout in history" 1 (List.length history); let saved = (List.hd history).Repository.workout in Alcotest.(check string) "the saved workout is Day 1" "Day 1" (Prescription.Workout.name (Evidence.Workout.prescription saved)); Alcotest.(check int) "records four stimuli" 4 (List.length (Evidence.Workout.stimuli saved)); Alcotest.(check bool) "the saved workout is complete" true (Evidence.Workout.completeness saved = Evidence.Workout.Complete); (* The saved workout is durable and reachable at its own URL. *) Alcotest.(check int) "the saved workout is reachable" 200 (status (get c "/logbook/t1:w1")) ); ( "the recovery gate blocks the next workout until enough rest, then \ Day 2 begins", `Quick, fun () -> (* The deepest flow: after finishing Day 1, the next workout is gated until 48 hours of recovery pass. The web tier drives the clock, so this proves the gate over HTTP, not just in the service. Beginning too early is refused; resting past the interval clears the gate and advances the cycle to Day 2. *) let c, now, repo = clocked_client () in now := day 10; let _ = register c ~username:"lifter" ~password:"heavyduty1" in let trainee = the_trainee repo ~username:"lifter" in let _ = start_day_one c in record_all_day_one_slots c; let token = Option.get (csrf_token (body (get c "/workout"))) in let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in (* One hour later: recovery is far from complete. Beginning without an override is refused and starts nothing. *) now := day 10 + 3600; let token = Option.get (csrf_token (body (get c "/"))) in let refused = post c "/workout" [ ("dream.csrf", token); ("override", "false") ] in Alcotest.(check int) "an early begin is bounced back" 303 (status refused); Alcotest.(check bool) "the early begin returns Home, not the workout" true (List.mem "/" (Dream.headers refused "Location")); Alcotest.(check bool) "no workout was started" true (Option.is_none (Lwt_main.run (Test_repo.in_progress repo trainee.Trainee.id))); (* Rest two full days: past the 48-hour training interval. The gate clears and the next begin succeeds. *) now := day 13; let token = Option.get (csrf_token (body (get c "/"))) in let began = post c "/workout" [ ("dream.csrf", token); ("override", "false") ] in Alcotest.(check int) "the rested begin succeeds" 303 (status began); Alcotest.(check bool) "the rested begin reaches the workout" true (List.mem "/workout" (Dream.headers began "Location")); (* The cycle has advanced to Day 2, cleared on recovery, not an override. *) let workout = match Lwt_main.run (Test_repo.in_progress repo trainee.Trainee.id) with | Some w -> w | None -> Alcotest.failf "expected a workout in progress" in Alcotest.(check string) "the cycle advanced to Day 2" "Day 2" (Prescription.Workout.name (Evidence.Workout.prescription workout)); Alcotest.(check bool) "cleared on recovery, not an override" true (match Recovery.basis (Evidence.Workout.clearance workout) with | Recovery.Recovered -> true | Recovery.Overridden _ -> false) ); ( "completed workouts remain available when the routine cycle returns", `Quick, fun () -> let c, now, repo = clocked_client () in now := day 10; let _ = register c ~username:"lifter" ~password:"heavyduty1" in let trainee = the_trainee repo ~username:"lifter" in let _ = start_day_one c in record_all_day_one_slots c; let token = Option.get (csrf_token (body (get c "/workout"))) in let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in let rec reach_day_one attempts d = if attempts = 0 then Alcotest.failf "Day 1 did not recur" else begin now := day d; let token = Option.get (csrf_token (body (get c "/"))) in let _ = post c "/workout" [ ("dream.csrf", token); ("override", "false") ] in match Lwt_main.run (Test_repo.in_progress repo trainee.Trainee.id) with | Some workout when String.equal (Prescription.Workout.name (Evidence.Workout.prescription workout)) "Day 1" -> () | Some _ -> record_all_day_one_slots c; let token = Option.get (csrf_token (body (get c "/workout"))) in let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in reach_day_one (attempts - 1) (d + 3) | None -> Alcotest.failf "expected a workout in progress" end in reach_day_one 6 13; Alcotest.(check bool) "the original completed workout remains in history" true (List.length (Lwt_main.run (Test_repo.history repo trainee.Trainee.id)) >= 1) ); ] ); ]