(** Tests for {!Hito_app.Service} — the whole HD flow with no web tier, now
    scoped to a trainee and driven over Lwt against the in-memory repository. *)

open Hito_app
module S = Service.Make (Memory_repo)
module Stimulus = Evidence.Stimulus
module Workout = Evidence.Workout

let run = Lwt_main.run
let ok = function Ok v -> v | Error _ -> Alcotest.fail "expected Ok"

let get id =
  match Exercise.find_id id with
  | Some e -> e
  | None -> Alcotest.failf "catalog is missing %S" id

let load n = n
let reps n = n
let at s = Recovery.timestamp_of_unix_seconds s
let day n = at (n * 86_400)
let ideal = Repository.routine_id "ideal"

(* A fresh service and a registered trainee to own everything. *)
let fixture () =
  let s = S.make ~repo:(Memory_repo.create ()) in
  let trainee =
    ok (run (S.register s ~username:"lifter" ~password:"heavyduty1"))
  in
  (s, trainee.Trainee.id)

let move id load_kg rep_count =
  Stimulus.Effort.make ~exercise:(get id) ~load:(load load_kg)
    ~reps:(reps rep_count) ~outcome:Stimulus.Positive_failure

let single id load r = Stimulus.make (Stimulus.Single (move id load r))
let pair ~first ~second = Stimulus.make (Stimulus.Pair { first; second })

(* HD1's Day 1 as performed. *)
let day_one_stimuli =
  [
    pair
      ~first:(move "dumbbell-flyes" 20. 9)
      ~second:(move "incline-press" 60. 7);
    single "laterals" 12. 8;
    single "bent-over-laterals" 10. 9;
    pair ~first:(move "lying-french-press" 30. 8) ~second:(move "dips" 0. 6);
  ]

let account_tests =
  [
    ( "registration then authentication with the same password",
      `Quick,
      fun () ->
        let s = S.make ~repo:(Memory_repo.create ()) in
        let trainee =
          ok (run (S.register s ~username:"alice" ~password:"heavyduty1"))
        in
        match
          run (S.authenticate s ~username:"alice" ~password:"heavyduty1")
        with
        | Some found ->
            Alcotest.(check string)
              "same id"
              (Trainee.id_to_string trainee.Trainee.id)
              (Trainee.id_to_string found.Trainee.id)
        | None -> Alcotest.fail "expected authentication to succeed" );
    ( "the wrong password does not authenticate",
      `Quick,
      fun () ->
        let s = S.make ~repo:(Memory_repo.create ()) in
        let _ =
          ok (run (S.register s ~username:"alice" ~password:"heavyduty1"))
        in
        Alcotest.(check bool)
          "rejected" true
          (Option.is_none
             (run (S.authenticate s ~username:"alice" ~password:"wrong"))) );
    ( "a duplicate username is refused after normalization",
      `Quick,
      fun () ->
        let s = S.make ~repo:(Memory_repo.create ()) in
        let _ =
          ok (run (S.register s ~username:"alice" ~password:"heavyduty1"))
        in
        (* Trimming and lowercasing make "  ALICE  " the same username. *)
        match
          run (S.register s ~username:"  ALICE  " ~password:"another11")
        with
        | Error `Username_taken -> ()
        | _ -> Alcotest.fail "expected Username_taken" );
    ( "a normalized username authenticates regardless of case or spacing",
      `Quick,
      fun () ->
        let s = S.make ~repo:(Memory_repo.create ()) in
        let _ =
          ok (run (S.register s ~username:"alice" ~password:"heavyduty1"))
        in
        Alcotest.(check bool)
          "case- and space-insensitive login" true
          (Option.is_some
             (run
                (S.authenticate s ~username:"  Alice " ~password:"heavyduty1")))
    );
    ( "a username under four characters is refused",
      `Quick,
      fun () ->
        let s = S.make ~repo:(Memory_repo.create ()) in
        match run (S.register s ~username:"abc" ~password:"heavyduty1") with
        | Error (`Username Trainee.Too_short) -> ()
        | _ -> Alcotest.fail "expected Too_short" );
    ( "a four-character username is accepted",
      `Quick,
      fun () ->
        let s = S.make ~repo:(Memory_repo.create ()) in
        match run (S.register s ~username:"abcd" ~password:"heavyduty1") with
        | Ok _ -> ()
        | Error _ ->
            Alcotest.fail "expected the boundary username to be accepted" );
    ( "a twenty-character username is accepted",
      `Quick,
      fun () ->
        let s = S.make ~repo:(Memory_repo.create ()) in
        match
          run (S.register s ~username:"abcdefghijklmnopqrst" ~password:"pw")
        with
        | Ok _ -> ()
        | Error _ ->
            Alcotest.fail "expected the boundary username to be accepted" );
    ( "a username over twenty characters is refused",
      `Quick,
      fun () ->
        let s = S.make ~repo:(Memory_repo.create ()) in
        match
          run (S.register s ~username:"abcdefghijklmnopqrstu" ~password:"pw")
        with
        | Error (`Username Trainee.Too_long) -> ()
        | _ -> Alcotest.fail "expected Too_long" );
    ( "surrounding whitespace does not count toward the length bounds",
      `Quick,
      fun () ->
        let s = S.make ~repo:(Memory_repo.create ()) in
        (* "  abcd  " normalizes to the four-character "abcd". *)
        match run (S.register s ~username:"  abcd  " ~password:"pw") with
        | Ok trainee ->
            Alcotest.(check string)
              "trimmed and lowercased" "abcd"
              (Trainee.username_to_string trainee.Trainee.username)
        | Error _ ->
            Alcotest.fail "expected the trimmed username to be accepted" );
    ( "a short password is accepted",
      `Quick,
      fun () ->
        let s = S.make ~repo:(Memory_repo.create ()) in
        match run (S.register s ~username:"alice" ~password:"x") with
        | Ok _ -> ()
        | Error _ -> Alcotest.fail "expected a short password to be accepted" );
    ( "an empty password is accepted",
      `Quick,
      fun () ->
        let s = S.make ~repo:(Memory_repo.create ()) in
        match run (S.register s ~username:"bobby" ~password:"") with
        | Ok _ -> ()
        | Error _ -> Alcotest.fail "expected an empty password to be accepted"
    );
    ( "a short password still authenticates",
      `Quick,
      fun () ->
        let s = S.make ~repo:(Memory_repo.create ()) in
        let _ = ok (run (S.register s ~username:"carol" ~password:"x")) in
        Alcotest.(check bool)
          "signs in" true
          (Option.is_some
             (run (S.authenticate s ~username:"carol" ~password:"x"))) );
    ( "two trainees keep separate logs",
      `Quick,
      fun () ->
        let s = S.make ~repo:(Memory_repo.create ()) in
        let a =
          (ok (run (S.register s ~username:"alice" ~password:"heavyduty1")))
            .Trainee.id
        in
        let b =
          (ok (run (S.register s ~username:"bobby" ~password:"heavyduty1")))
            .Trainee.id
        in
        let _ = ok (run (S.begin_workout s a ~routine:ideal ~now:(day 1) ())) in
        let _ = run (S.finish s a ~ended_at:(day 1)) in
        Alcotest.(check int) "a has one" 1 (List.length (run (S.history s a)));
        Alcotest.(check int) "b has none" 0 (List.length (run (S.history s b)))
    );
    ( "changing the username renames the account",
      `Quick,
      fun () ->
        let s = S.make ~repo:(Memory_repo.create ()) in
        let id =
          (ok (run (S.register s ~username:"alice" ~password:"heavyduty1")))
            .Trainee.id
        in
        (match run (S.change_username s id ~username:"alicia") with
        | Ok updated ->
            Alcotest.(check string)
              "renamed" "alicia"
              (Trainee.username_to_string updated.Trainee.username)
        | Error _ -> Alcotest.fail "expected the rename to succeed");
        (* The old name is free; the new name resolves the same account. *)
        match run (S.find_trainee s id) with
        | Some found ->
            Alcotest.(check string)
              "persisted new name" "alicia"
              (Trainee.username_to_string found.Trainee.username)
        | None -> Alcotest.fail "account vanished" );
    ( "renaming to the account's own name is a no-op success",
      `Quick,
      fun () ->
        let s = S.make ~repo:(Memory_repo.create ()) in
        let id =
          (ok (run (S.register s ~username:"alice" ~password:"heavyduty1")))
            .Trainee.id
        in
        match run (S.change_username s id ~username:"  ALICE ") with
        | Ok updated ->
            Alcotest.(check string)
              "kept the normalized name" "alice"
              (Trainee.username_to_string updated.Trainee.username)
        | Error _ -> Alcotest.fail "expected a no-op rename to succeed" );
    ( "renaming to another trainee's name is refused",
      `Quick,
      fun () ->
        let s = S.make ~repo:(Memory_repo.create ()) in
        let a =
          (ok (run (S.register s ~username:"alice" ~password:"heavyduty1")))
            .Trainee.id
        in
        let _ =
          ok (run (S.register s ~username:"bobby" ~password:"heavyduty1"))
        in
        match run (S.change_username s a ~username:"bobby") with
        | Error `Username_taken -> ()
        | _ -> Alcotest.fail "expected Username_taken" );
    ( "an invalid new username is refused",
      `Quick,
      fun () ->
        let s = S.make ~repo:(Memory_repo.create ()) in
        let id =
          (ok (run (S.register s ~username:"alice" ~password:"heavyduty1")))
            .Trainee.id
        in
        match run (S.change_username s id ~username:"ab") with
        | Error (`Username Trainee.Too_short) -> ()
        | _ -> Alcotest.fail "expected Too_short" );
    ( "changing the password requires the current one",
      `Quick,
      fun () ->
        let s = S.make ~repo:(Memory_repo.create ()) in
        let id =
          (ok (run (S.register s ~username:"alice" ~password:"heavyduty1")))
            .Trainee.id
        in
        (match
           run (S.change_password s id ~current:"wrong" ~next:"newsecret1")
         with
        | Error `Incorrect_password -> ()
        | _ -> Alcotest.fail "expected Incorrect_password");
        (* The old password still works after a refused change. *)
        Alcotest.(check bool)
          "old password still valid" true
          (Option.is_some
             (run (S.authenticate s ~username:"alice" ~password:"heavyduty1")))
    );
    ( "a correct current password changes the password",
      `Quick,
      fun () ->
        let s = S.make ~repo:(Memory_repo.create ()) in
        let id =
          (ok (run (S.register s ~username:"alice" ~password:"heavyduty1")))
            .Trainee.id
        in
        (match
           run (S.change_password s id ~current:"heavyduty1" ~next:"newsecret1")
         with
        | Ok _ -> ()
        | Error _ -> Alcotest.fail "expected the change to succeed");
        Alcotest.(check bool)
          "the old password no longer works" true
          (Option.is_none
             (run (S.authenticate s ~username:"alice" ~password:"heavyduty1")));
        Alcotest.(check bool)
          "the new password works" true
          (Option.is_some
             (run (S.authenticate s ~username:"alice" ~password:"newsecret1")))
    );
  ]

let routine_tests =
  [
    ( "the seeded repository offers HD1's Ideal Routine",
      `Quick,
      fun () ->
        let s, _ = fixture () in
        match S.list_routines s with
        | [ (_, r) ] ->
            Alcotest.(check string)
              "name" "Ideal Routine"
              (Prescription.Routine.name r)
        | rs -> Alcotest.failf "expected one routine, got %d" (List.length rs)
    );
    ( "an unknown routine is refused",
      `Quick,
      fun () ->
        let s, t = fixture () in
        match
          run (S.next_workout s t ~routine:(Repository.routine_id "nope"))
        with
        | Error S.Unknown_routine -> ()
        | _ -> Alcotest.fail "expected Unknown_routine" );
    ( "with nothing logged the cycle starts at Day 1",
      `Quick,
      fun () ->
        let s, t = fixture () in
        let w = ok (run (S.next_workout s t ~routine:ideal)) in
        Alcotest.(check string) "Day 1" "Day 1" (Prescription.Workout.name w) );
  ]

let clearance_tests =
  [
    ( "a first workout needs no recovery: nothing has been done yet",
      `Quick,
      fun () ->
        let s, t = fixture () in
        Alcotest.(check bool)
          "ready" true
          (Recovery.is_ready
             (ok (run (S.readiness s t ~routine:ideal ~now:(day 1)))));
        Alcotest.(check bool)
          "starts" true
          (Result.is_ok
             (run (S.begin_workout s t ~routine:ideal ~now:(day 1) ()))) );
    ( "training too soon after a workout is refused",
      `Quick,
      fun () ->
        let s, t = fixture () in
        let _ = ok (run (S.begin_workout s t ~routine:ideal ~now:(day 1) ())) in
        let _ = run (S.finish s t ~ended_at:(day 1)) in
        match run (S.begin_workout s t ~routine:ideal ~now:(day 2) ()) with
        | Error (S.Not_recovered readiness) ->
            Alcotest.(check bool)
              "and says so" false
              (Recovery.is_ready readiness)
        | _ -> Alcotest.fail "expected Not_recovered" );
    ( "once rested, the next workout starts and the cycle has advanced",
      `Quick,
      fun () ->
        let s, t = fixture () in
        let _ = ok (run (S.begin_workout s t ~routine:ideal ~now:(day 1) ())) in
        let _ = run (S.finish s t ~ended_at:(day 1)) in
        let w = ok (run (S.begin_workout s t ~routine:ideal ~now:(day 3) ())) in
        Alcotest.(check string)
          "Day 2" "Day 2"
          (Prescription.Workout.name (Workout.prescription w)) );
    ( "an override is accepted and recorded",
      `Quick,
      fun () ->
        let s, t = fixture () in
        let _ = ok (run (S.begin_workout s t ~routine:ideal ~now:(day 1) ())) in
        let _ = run (S.finish s t ~ended_at:(day 1)) in
        let w =
          ok
            (run
               (S.begin_workout s t ~routine:ideal ~now:(day 2) ~override:() ()))
        in
        match Recovery.basis (Workout.clearance w) with
        | Recovery.Overridden _ -> ()
        | Recovery.Recovered -> Alcotest.fail "expected Overridden" );
    ( "an override while genuinely rested is not recorded as one",
      `Quick,
      fun () ->
        let s, t = fixture () in
        let w =
          ok
            (run
               (S.begin_workout s t ~routine:ideal ~now:(day 1) ~override:() ()))
        in
        match Recovery.basis (Workout.clearance w) with
        | Recovery.Recovered -> ()
        | Recovery.Overridden _ ->
            Alcotest.fail "nothing was outstanding to override" );
  ]

let logging_tests =
  [
    ( "logging without a workout in progress is refused",
      `Quick,
      fun () ->
        let s, t = fixture () in
        match run (S.log s t (single "laterals" 12. 8)) with
        | Error S.No_workout_in_progress -> ()
        | _ -> Alcotest.fail "expected No_workout_in_progress" );
    ( "a stimulus the prescription does not call for is refused",
      `Quick,
      fun () ->
        let s, t = fixture () in
        let _ = ok (run (S.begin_workout s t ~routine:ideal ~now:(day 1) ())) in
        match run (S.log s t (single "shrugs" 80. 10)) with
        | Error (S.Rejected (Workout.Not_prescribed _)) -> ()
        | _ -> Alcotest.fail "expected Rejected Not_prescribed" );
    ( "Day 1 can be logged in full and finished",
      `Quick,
      fun () ->
        let s, t = fixture () in
        let _ = ok (run (S.begin_workout s t ~routine:ideal ~now:(day 1) ())) in
        List.iter (fun st -> ignore (ok (run (S.log s t st)))) day_one_stimuli;
        let w = Option.get (run (S.in_progress s t)) in
        Alcotest.(check int) "four stimuli" 4 (List.length (Workout.stimuli w));
        Alcotest.(check int)
          "nothing outstanding" 0
          (List.length (Workout.unperformed w));
        let record = Option.get (run (S.finish s t ~ended_at:(at 3600))) in
        Alcotest.(check bool)
          "persisted as finished" true
          (Workout.is_finished record.Repository.workout);
        Alcotest.(check bool)
          "slot cleared" true
          (Option.is_none (run (S.in_progress s t))) );
    ( "history returns the finished workout",
      `Quick,
      fun () ->
        let s, t = fixture () in
        let _ = ok (run (S.begin_workout s t ~routine:ideal ~now:(day 1) ())) in
        let _ = ok (run (S.log s t (single "laterals" 12. 8))) in
        let _ = run (S.finish s t ~ended_at:(at 3600)) in
        Alcotest.(check int) "one workout" 1 (List.length (run (S.history s t)))
    );
    ( "cancelling after recording a set discards it and saves no history",
      `Quick,
      fun () ->
        let s, t = fixture () in
        let _ = ok (run (S.begin_workout s t ~routine:ideal ~now:(day 1) ())) in
        let _ = ok (run (S.log s t (single "laterals" 12. 8))) in
        Alcotest.(check bool)
          "a workout was discarded" true
          (run (S.cancel s t));
        Alcotest.(check bool)
          "no workout in progress" true
          (Option.is_none (run (S.in_progress s t)));
        Alcotest.(check int)
          "no history record" 0
          (List.length (run (S.history s t))) );
    ( "cancelling preserves saved history",
      `Quick,
      fun () ->
        let s, t = fixture () in
        (* Finish one workout so history is non-empty. *)
        let _ = ok (run (S.begin_workout s t ~routine:ideal ~now:(day 1) ())) in
        let _ = run (S.finish s t ~ended_at:(day 1)) in
        (* Begin and cancel a second. The saved first workout must remain. *)
        let _ = ok (run (S.begin_workout s t ~routine:ideal ~now:(day 3) ())) in
        Alcotest.(check bool) "discarded" true (run (S.cancel s t));
        Alcotest.(check int)
          "saved history kept" 1
          (List.length (run (S.history s t)));
        Alcotest.(check bool)
          "no workout in progress" true
          (Option.is_none (run (S.in_progress s t))) );
    ( "cancelling with nothing in progress is a no-op",
      `Quick,
      fun () ->
        let s, t = fixture () in
        Alcotest.(check bool) "nothing to discard" false (run (S.cancel s t)) );
  ]

let active_and_edit_tests =
  [
    ( "routine selection is explicit and rejects unknown IDs",
      `Quick,
      fun () ->
        let s, t = fixture () in
        Alcotest.(check bool)
          "no initial selection" true
          (Option.is_none (run (S.active_routine s t)));
        ignore (ok (run (S.select_routine s t ideal)));
        Alcotest.(check string)
          "selected ideal" "Ideal Routine"
          (Prescription.Routine.name
             (snd (Option.get (run (S.active_routine s t)))));
        match run (S.select_routine s t (Repository.routine_id "missing")) with
        | Error S.Unknown_routine -> ()
        | _ -> Alcotest.fail "expected Unknown_routine" );
    ( "a finished record can be completed later without changing its end",
      `Quick,
      fun () ->
        let s, t = fixture () in
        ignore (ok (run (S.begin_workout s t ~routine:ideal ~now:(day 1) ())));
        let record = Option.get (run (S.finish s t ~ended_at:(at 120))) in
        let record =
          List.fold_left
            (fun record stimulus ->
              ok (run (S.add_to_record s t record.Repository.id stimulus)))
            record day_one_stimuli
        in
        Alcotest.(check bool)
          "complete" true
          (match Workout.completeness record.Repository.workout with
          | Workout.Complete -> true
          | Incomplete -> false);
        Alcotest.(check int)
          "original end" 120
          (Recovery.timestamp_to_unix_seconds
             (Option.get (Workout.ended_at record.Repository.workout))) );
    ( "replace_current corrects a recorded slot without adding volume",
      `Quick,
      fun () ->
        let s, t = fixture () in
        ignore (ok (run (S.begin_workout s t ~routine:ideal ~now:(day 1) ())));
        ignore (ok (run (S.log s t (single "laterals" 12. 8))));
        let w =
          ok (run (S.replace_current s t ~slot:1 (single "laterals" 14. 7)))
        in
        Alcotest.(check int)
          "still one stimulus" 1
          (List.length (Workout.stimuli w));
        Alcotest.(check int) "one filled slot" 1 (Workout.filled_slots w);
        Alcotest.(check (float 0.001))
          "corrected load" 14.
          (Stimulus.Effort.load
             (List.hd (Stimulus.efforts (List.hd (Workout.stimuli w))))) );
    ( "replace_current rejects a stimulus the slot does not call for",
      `Quick,
      fun () ->
        let s, t = fixture () in
        ignore (ok (run (S.begin_workout s t ~routine:ideal ~now:(day 1) ())));
        match run (S.replace_current s t ~slot:1 (single "shrugs" 80. 10)) with
        | Error (S.Rejected _) -> ()
        | _ -> Alcotest.fail "expected Rejected" );
    ( "replace_in_record corrects a saved slot without adding volume",
      `Quick,
      fun () ->
        let s, t = fixture () in
        ignore (ok (run (S.begin_workout s t ~routine:ideal ~now:(day 1) ())));
        ignore (ok (run (S.log s t (single "laterals" 12. 8))));
        let record = Option.get (run (S.finish s t ~ended_at:(at 120))) in
        let record =
          ok
            (run
               (S.replace_in_record s t record.Repository.id ~slot:1
                  (single "laterals" 16. 6)))
        in
        Alcotest.(check int)
          "still one stimulus" 1
          (List.length (Workout.stimuli record.Repository.workout));
        Alcotest.(check (float 0.001))
          "corrected load" 16.
          (Stimulus.Effort.load
             (List.hd
                (Stimulus.efforts
                   (List.hd (Workout.stimuli record.Repository.workout))))) );
    ( "replace_in_record rejects an unknown slot",
      `Quick,
      fun () ->
        let s, t = fixture () in
        ignore (ok (run (S.begin_workout s t ~routine:ideal ~now:(day 1) ())));
        let record = Option.get (run (S.finish s t ~ended_at:(at 120))) in
        match
          run
            (S.replace_in_record s t record.Repository.id ~slot:99
               (single "laterals" 12. 8))
        with
        | Error (S.Rejected_edit (Workout.No_such_slot 99)) -> ()
        | _ -> Alcotest.fail "expected Rejected_edit No_such_slot" );
  ]

let assessment_tests =
  [
    ( "evidence accumulates across cycles and feeds progression",
      `Quick,
      fun () ->
        let s, t = fixture () in
        let run_workout ~on ~load =
          let w =
            ok
              (run (S.begin_workout s t ~routine:ideal ~now:on ~override:() ()))
          in
          if
            String.equal "Day 1"
              (Prescription.Workout.name (Workout.prescription w))
          then ignore (ok (run (S.log s t (single "laterals" load 8))));
          ignore (run (S.finish s t ~ended_at:on))
        in
        List.iter
          (fun on -> run_workout ~on ~load:12.)
          [ day 1; day 3; day 5; day 8; day 10; day 12; day 16 ];
        Alcotest.(check int)
          "seven workouts logged" 7
          (List.length (run (S.history s t)));
        Alcotest.(check bool)
          "stalled" true
          (run (S.progress s t (get "laterals")) = Ok Progression.Stalled) );
    ( "training on overrides shows up as a diagnostic",
      `Quick,
      fun () ->
        let s, t = fixture () in
        let _ = ok (run (S.begin_workout s t ~routine:ideal ~now:(day 1) ())) in
        let _ = run (S.finish s t ~ended_at:(day 1)) in
        let _ =
          ok
            (run
               (S.begin_workout s t ~routine:ideal ~now:(day 2) ~override:() ()))
        in
        let _ = run (S.finish s t ~ended_at:(day 2)) in
        match
          List.filter
            (function
              | Progression.Trained_under_recovered _ -> true | _ -> false)
            (run (S.diagnostics s t))
        with
        | [ Progression.Trained_under_recovered n ] ->
            Alcotest.(check int) "one such workout" 1 n
        | _ -> Alcotest.fail "expected the under-recovery diagnostic" );
  ]

let app_feedback_tests =
  [
    ( "app feedback rejects a blank message",
      `Quick,
      fun () ->
        let s, t = fixture () in
        match
          run
            (S.record_app_feedback s t ~submitted_at:(day 1) ~message:"  \n  ")
        with
        | Error `Empty_message -> ()
        | Error `Unknown_feedback ->
            Alcotest.fail "unexpected unknown feedback error"
        | Ok _ -> Alcotest.fail "expected a blank message to be refused" );
    ( "app feedback is stored newest first and visible globally",
      `Quick,
      fun () ->
        let s, alice = fixture () in
        let bob =
          (ok (run (S.register s ~username:"bobby" ~password:"heavyduty1")))
            .Trainee.id
        in
        let _ =
          ok
            (run
               (S.record_app_feedback s alice ~submitted_at:(day 1)
                  ~message:"First"))
        in
        let _ =
          ok
            (run
               (S.record_app_feedback s alice ~submitted_at:(day 2)
                  ~message:"Second"))
        in
        let alice_reports = run (S.app_feedback s alice) in
        Alcotest.(check int) "two reports" 2 (List.length alice_reports);
        Alcotest.(check string)
          "newest first" "Second" (List.hd alice_reports).Repository.message;
        Alcotest.(check int)
          "bob sees the same reports" 2
          (List.length (run (S.app_feedback s bob))) );
    ( "application feedback ownership survives an author rename",
      `Quick,
      fun () ->
        let s, alice = fixture () in
        let _ =
          ok
            (run
               (S.record_app_feedback s alice ~submitted_at:(day 1)
                  ~message:"Before rename"))
        in
        let _ = ok (run (S.change_username s alice ~username:"athlete")) in
        match run (S.app_feedback s alice) with
        | [ report ] ->
            Alcotest.(check string)
              "current author name" "athlete" report.author;
            Alcotest.(check bool)
              "viewer still owns report" true report.viewer_owns
        | reports ->
            Alcotest.failf "expected one report, got %d" (List.length reports)
    );
    ( "application feedback is ranked and supports cross-user votes",
      `Quick,
      fun () ->
        let s, alice = fixture () in
        let bob =
          (ok (run (S.register s ~username:"bobby" ~password:"heavyduty1")))
            .Trainee.id
        in
        let _ =
          ok
            (run
               (S.record_app_feedback s alice ~submitted_at:(day 1)
                  ~message:"First"))
        in
        let _ =
          ok
            (run
               (S.record_app_feedback s alice ~submitted_at:(day 2)
                  ~message:"Second"))
        in
        let _ =
          ok
            (run
               (S.record_app_feedback s bob ~submitted_at:(day 3)
                  ~message:"From Bob"))
        in
        let before_vote = run (S.app_feedback s alice) in
        let alice_report =
          List.find
            (fun report -> String.equal report.Repository.author "lifter")
            before_vote
        in
        let bob_report =
          List.find
            (fun report -> String.equal report.Repository.author "bobby")
            before_vote
        in
        Alcotest.(check int)
          "alice contribution count" 2 alice_report.Repository.contributions;
        Alcotest.(check int)
          "bob contribution count" 1 bob_report.Repository.contributions;
        Alcotest.(check bool)
          "newest report starts first" true
          (String.equal (List.hd before_vote).Repository.message "From Bob");
        Alcotest.(check bool)
          "cross-user vote is added" true
          (run
             (S.upvote_app_feedback s alice bob_report.Repository.feedback_id));
        Alcotest.(check bool)
          "own vote is refused" false
          (run (S.upvote_app_feedback s bob bob_report.Repository.feedback_id));
        let after_vote = run (S.app_feedback s alice) in
        let voted_bob =
          List.find
            (fun report -> String.equal report.Repository.author "bobby")
            after_vote
        in
        Alcotest.(check int) "upvote count" 1 voted_bob.Repository.upvotes;
        Alcotest.(check bool)
          "viewer vote state" true voted_bob.Repository.viewer_upvoted );
    ( "editing application feedback to a blank message is refused",
      `Quick,
      fun () ->
        let s, alice = fixture () in
        let report =
          ok
            (run
               (S.record_app_feedback s alice ~submitted_at:(day 1)
                  ~message:"Original"))
        in
        match
          run
            (S.edit_app_feedback s alice report.Repository.feedback_id
               ~message:"   ")
        with
        | Error `Empty_message -> ()
        | Error `Unknown_feedback -> Alcotest.fail "feedback must still exist"
        | Ok () -> Alcotest.fail "expected a blank edit to be refused" );
    ( "removed application feedback identities are not reused",
      `Quick,
      fun () ->
        let s, alice = fixture () in
        let first =
          ok
            (run
               (S.record_app_feedback s alice ~submitted_at:(day 1)
                  ~message:"First"))
        in
        let second =
          ok
            (run
               (S.record_app_feedback s alice ~submitted_at:(day 2)
                  ~message:"Second"))
        in
        Alcotest.(check bool)
          "first removal succeeds" true
          (run (S.remove_app_feedback s alice first.Repository.feedback_id));
        let third =
          ok
            (run
               (S.record_app_feedback s alice ~submitted_at:(day 3)
                  ~message:"Third"))
        in
        Alcotest.(check bool)
          "new identity differs from the surviving identity" false
          (String.equal
             (Repository.app_feedback_id_to_string second.feedback_id)
             (Repository.app_feedback_id_to_string third.feedback_id));
        Alcotest.(check string)
          "sequence does not rewind" "t1:3"
          (Repository.app_feedback_id_to_string third.feedback_id) );
    ( "application feedback CRUD is owner-scoped",
      `Quick,
      fun () ->
        let s, alice = fixture () in
        let bob =
          (ok (run (S.register s ~username:"bobby" ~password:"heavyduty1")))
            .Trainee.id
        in
        let report =
          ok
            (run
               (S.record_app_feedback s alice ~submitted_at:(day 1)
                  ~message:"Original"))
        in
        (match
           run
             (S.edit_app_feedback s bob report.Repository.feedback_id
                ~message:"Not yours")
         with
        | Error `Unknown_feedback -> ()
        | _ -> Alcotest.fail "another trainee edited the report");
        (match
           run
             (S.edit_app_feedback s alice report.Repository.feedback_id
                ~message:"Edited")
         with
        | Ok () -> ()
        | _ -> Alcotest.fail "owner edit failed");
        let edited =
          List.find
            (fun current ->
              String.equal
                (Repository.app_feedback_id_to_string
                   current.Repository.feedback_id)
                (Repository.app_feedback_id_to_string
                   report.Repository.feedback_id))
            (run (S.app_feedback s bob))
        in
        Alcotest.(check string) "edited message" "Edited" edited.message;
        Alcotest.(check bool)
          "owner remove succeeds" true
          (run (S.remove_app_feedback s alice report.Repository.feedback_id));
        Alcotest.(check int)
          "removed from the list" 0
          (List.length (run (S.app_feedback s bob))) );
  ]

let suite =
  [
    ("service.accounts", account_tests);
    ("service.routines", routine_tests);
    ("service.clearance", clearance_tests);
    ("service.logging", logging_tests);
    ("service.app_feedback", app_feedback_tests);
    ("service.active_and_edit", active_and_edit_tests);
    ("service.assessment", assessment_tests);
  ]