(** Tests for {!Hito_app.Sqlite_repo} — the durable store. Proves that state
    survives reconnecting to the same file, and that trainees stay isolated. *)

open Hito_app
module S = Service.Make (Sqlite_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 at s = Recovery.timestamp_of_unix_seconds s
let day n = at (n * 86_400)
let ideal = Repository.routine_id "ideal"

let single id load reps =
  Stimulus.make
    (Stimulus.Single
       (Stimulus.Effort.make ~exercise:(get id) ~load ~reps
          ~outcome:Stimulus.Positive_failure))

(* A unique temp database file per test; SQLite is a plain file. *)
let temp_uri () =
  let path = Filename.temp_file "hito-test-" ".sqlite" in
  Sys.remove path;
  (path, "sqlite3:" ^ path)

let connect uri = ok (run (Sqlite_repo.connect uri))

let cleanup path =
  List.iter
    (fun suffix -> try Sys.remove (path ^ suffix) with Sys_error _ -> ())
    [ ""; "-wal"; "-shm" ]

let durability_tests =
  [
    ( "a finished workout survives a reconnect to the same file",
      `Quick,
      fun () ->
        let path, uri = temp_uri () in
        Fun.protect
          ~finally:(fun () -> cleanup path)
          (fun () ->
            let trainee_id =
              let repo = connect uri in
              let s = S.make ~repo in
              let trainee =
                ok (run (S.register s ~username:"alice" ~password:"heavyduty1"))
              in
              let id = trainee.Trainee.id in
              let _ =
                ok (run (S.begin_workout s id ~routine:ideal ~now:(day 1) ()))
              in
              let _ = ok (run (S.log s id (single "laterals" 12. 8))) in
              let _ = run (S.finish s id ~ended_at:(day 1)) in
              id
            in
            (* Reconnect with a fresh repo value to the same file. *)
            let repo = connect uri in
            let s = S.make ~repo in
            let found =
              run (S.authenticate s ~username:"alice" ~password:"heavyduty1")
            in
            Alcotest.(check bool)
              "account persisted" true (Option.is_some found);
            Alcotest.(check string)
              "same trainee id"
              (Trainee.id_to_string trainee_id)
              (Trainee.id_to_string (Option.get found).Trainee.id);
            Alcotest.(check int)
              "history persisted" 1
              (List.length (run (S.history s trainee_id)))) );
    ( "a new trainee gets a fresh identity after reconnect",
      `Quick,
      fun () ->
        let path, uri = temp_uri () in
        Fun.protect
          ~finally:(fun () -> cleanup path)
          (fun () ->
            let first_id =
              let repo = connect uri in
              let s = S.make ~repo in
              let trainee =
                ok (run (S.register s ~username:"alice" ~password:"first"))
              in
              Trainee.id_to_string trainee.Trainee.id
            in
            let repo = connect uri in
            let s = S.make ~repo in
            let second =
              ok (run (S.register s ~username:"bobby" ~password:"second"))
            in
            let second_id = Trainee.id_to_string second.Trainee.id in
            Alcotest.(check bool)
              "identity is not reused" false
              (String.equal first_id second_id);
            Alcotest.(check string) "sequence continues" "t2" second_id) );
    ( "the workout in progress is durable and per-trainee",
      `Quick,
      fun () ->
        let path, uri = temp_uri () in
        Fun.protect
          ~finally:(fun () -> cleanup path)
          (fun () ->
            let repo = connect uri in
            let s = S.make ~repo 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
            (* Reconnect and confirm a's slot survives while b's stays empty. *)
            let repo = connect uri in
            let s = S.make ~repo in
            Alcotest.(check bool)
              "a has a workout in progress" true
              (Option.is_some (run (S.in_progress s a)));
            Alcotest.(check bool)
              "b does not" true
              (Option.is_none (run (S.in_progress s b)))) );
    ( "a saved record can be completed later and stays complete",
      `Quick,
      fun () ->
        let path, uri = temp_uri () in
        Fun.protect
          ~finally:(fun () -> cleanup path)
          (fun () ->
            let repo = connect uri in
            let s = S.make ~repo in
            let t =
              (ok (run (S.register s ~username:"alice" ~password:"heavyduty1")))
                .Trainee.id
            in
            let _ =
              ok (run (S.begin_workout s t ~routine:ideal ~now:(day 1) ()))
            in
            let record = Option.get (run (S.finish s t ~ended_at:(at 120))) in
            let record =
              ok
                (run
                   (S.add_to_record s t record.Repository.id
                      (single "laterals" 12. 8)))
            in
            (* Reconnect and read it back. *)
            let repo = connect uri in
            let s = S.make ~repo in
            let reread =
              Option.get (run (S.find_record s t record.Repository.id))
            in
            Alcotest.(check int)
              "one stimulus survived" 1
              (List.length (Workout.stimuli reread.Repository.workout))) );
    ( "a corrected slot survives a reconnect without adding volume",
      `Quick,
      fun () ->
        let path, uri = temp_uri () in
        Fun.protect
          ~finally:(fun () -> cleanup path)
          (fun () ->
            let repo = connect uri in
            let s = S.make ~repo in
            let t =
              (ok (run (S.register s ~username:"alice" ~password:"heavyduty1")))
                .Trainee.id
            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 record = Option.get (run (S.finish s t ~ended_at:(at 120))) in
            let _ =
              ok
                (run
                   (S.replace_in_record s t record.Repository.id ~slot:1
                      (single "laterals" 15. 6)))
            in
            let repo = connect uri in
            let s = S.make ~repo in
            let reread =
              Option.get (run (S.find_record s t record.Repository.id))
            in
            Alcotest.(check int)
              "still one stimulus" 1
              (List.length (Workout.stimuli reread.Repository.workout));
            Alcotest.(check (float 0.001))
              "corrected load persisted" 15.
              (Stimulus.Effort.load
                 (List.hd
                    (Stimulus.efforts
                       (List.hd (Workout.stimuli reread.Repository.workout))))))
    );
    ( "a short password persists and authenticates after a reconnect",
      `Quick,
      fun () ->
        let path, uri = temp_uri () in
        Fun.protect
          ~finally:(fun () -> cleanup path)
          (fun () ->
            let repo = connect uri in
            let s = S.make ~repo in
            (* No password policy: a one-character password is stored and later
               verifies against its persisted hash. *)
            let _ = ok (run (S.register s ~username:"alice" ~password:"x")) in
            let repo = connect uri in
            let s = S.make ~repo in
            Alcotest.(check bool)
              "short password authenticates after reconnect" true
              (Option.is_some
                 (run (S.authenticate s ~username:"alice" ~password:"x")))) );
  ]

let migration_tests =
  [
    ( "applying migrations twice to one file is idempotent",
      `Quick,
      fun () ->
        let path, uri = temp_uri () in
        Fun.protect
          ~finally:(fun () -> cleanup path)
          (fun () ->
            (* First connect creates and records the schema. *)
            let _ = connect uri in
            (* A second connect on the same file must not fail re-applying an
               already-recorded migration. *)
            let repo = connect uri in
            let s = S.make ~repo in
            let trainee =
              ok (run (S.register s ~username:"alice" ~password:"heavyduty1"))
            in
            Alcotest.(check bool)
              "usable after reconnect" true
              (Option.is_some
                 (run
                    (S.authenticate s ~username:"alice" ~password:"heavyduty1")));
            ignore trainee) );
    ( "finishing is atomic: the record is saved and the slot cleared",
      `Quick,
      fun () ->
        let path, uri = temp_uri () in
        Fun.protect
          ~finally:(fun () -> cleanup path)
          (fun () ->
            let repo = connect uri in
            let s = S.make ~repo in
            let t =
              (ok (run (S.register s ~username:"alice" ~password:"heavyduty1")))
                .Trainee.id
            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
            (* After a reconnect both effects of finish are visible together:
               the workout is in history and no slot remains in progress. *)
            let repo = connect uri in
            let s = S.make ~repo in
            Alcotest.(check int)
              "one workout in history" 1
              (List.length (run (S.history s t)));
            Alcotest.(check bool)
              "slot cleared" true
              (Option.is_none (run (S.in_progress s t)))) );
    ( "subjective feedback survives a reconnect",
      `Quick,
      fun () ->
        let path, uri = temp_uri () in
        Fun.protect
          ~finally:(fun () -> cleanup path)
          (fun () ->
            let t =
              let repo = connect uri in
              let s = S.make ~repo in
              let id =
                (ok
                   (run (S.register s ~username:"alice" ~password:"heavyduty1")))
                  .Trainee.id
              in
              let _ =
                ok
                  (run
                     (S.record_feedback s id ~reported_at:(day 1)
                        [
                          Evidence.Feedback.Sleep Evidence.Feedback.Poor;
                          Evidence.Feedback.Pain;
                        ]))
              in
              id
            in
            (* Reconnect: the feedback report is still there, with its
               signals. *)
            let repo = connect uri in
            let s = S.make ~repo in
            let reports = run (S.feedback s t) in
            Alcotest.(check int) "one feedback report" 1 (List.length reports);
            let signals = Evidence.Feedback.signals (List.hd reports) in
            Alcotest.(check int) "two signals" 2 (List.length signals);
            Alcotest.(check bool)
              "sleep signal preserved" true
              (List.mem (Evidence.Feedback.Sleep Evidence.Feedback.Poor) signals);
            Alcotest.(check bool)
              "pain signal preserved" true
              (List.mem Evidence.Feedback.Pain signals)) );
    ( "application feedback survives a reconnect",
      `Quick,
      fun () ->
        let path, uri = temp_uri () in
        Fun.protect
          ~finally:(fun () -> cleanup path)
          (fun () ->
            let id =
              let repo = connect uri in
              let s = S.make ~repo in
              let id =
                (ok
                   (run (S.register s ~username:"alice" ~password:"heavyduty1")))
                  .Trainee.id
              in
              let _ =
                ok
                  (run
                     (S.record_app_feedback s id ~submitted_at:(day 2)
                        ~message:"The app feels clear."))
              in
              id
            in
            let repo = connect uri in
            let s = S.make ~repo in
            match run (S.app_feedback s id) with
            | [ report ] ->
                Alcotest.(check string)
                  "message persisted" "The app feels clear."
                  report.Repository.message;
                Alcotest.(check int)
                  "timestamp persisted" (2 * 86_400)
                  (Recovery.timestamp_to_unix_seconds report.submitted_at)
            | reports ->
                Alcotest.failf "expected one report, got %d"
                  (List.length reports)) );
    ( "application feedback ranking and votes survive a reconnect",
      `Quick,
      fun () ->
        let path, uri = temp_uri () in
        Fun.protect
          ~finally:(fun () -> cleanup path)
          (fun () ->
            let bob_feedback_id =
              let repo = connect uri in
              let s = S.make ~repo in
              let alice =
                (ok
                   (run (S.register s ~username:"alice" ~password:"heavyduty1")))
                  .Trainee.id
              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:"From Alice"))
              in
              let bob_report =
                ok
                  (run
                     (S.record_app_feedback s bob ~submitted_at:(day 2)
                        ~message:"From Bob"))
              in
              Alcotest.(check bool)
                "vote is accepted" true
                (run
                   (S.upvote_app_feedback s alice
                      bob_report.Repository.feedback_id));
              bob_report.Repository.feedback_id
            in
            let repo = connect uri in
            let s = S.make ~repo in
            let alice =
              Option.get
                (run
                   (S.authenticate s ~username:"alice" ~password:"heavyduty1"))
            in
            let bob =
              Option.get
                (run
                   (S.authenticate s ~username:"bobby" ~password:"heavyduty1"))
            in
            let reports = run (S.app_feedback s alice.Trainee.id) in
            let bob_report =
              List.find
                (fun report -> String.equal report.Repository.author "bobby")
                reports
            in
            Alcotest.(check string)
              "feedback identity"
              (Repository.app_feedback_id_to_string bob_feedback_id)
              (Repository.app_feedback_id_to_string
                 bob_report.Repository.feedback_id);
            Alcotest.(check int)
              "vote persisted" 1 bob_report.Repository.upvotes;
            Alcotest.(check bool)
              "viewer vote persisted" true bob_report.Repository.viewer_upvoted;
            let own_view =
              List.find
                (fun report -> String.equal report.Repository.author "bobby")
                (run (S.app_feedback s bob.Trainee.id))
            in
            Alcotest.(check bool)
              "owner does not see a self vote" false
              own_view.Repository.viewer_upvoted) );
    ( "application feedback CRUD survives and enforces ownership",
      `Quick,
      fun () ->
        let path, uri = temp_uri () in
        Fun.protect
          ~finally:(fun () -> cleanup path)
          (fun () ->
            let report_id =
              let repo = connect uri in
              let s = S.make ~repo in
              let alice =
                (ok
                   (run (S.register s ~username:"alice" ~password:"heavyduty1")))
                  .Trainee.id
              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");
              report.Repository.feedback_id
            in
            let repo = connect uri in
            let s = S.make ~repo in
            let alice =
              Option.get
                (run
                   (S.authenticate s ~username:"alice" ~password:"heavyduty1"))
            in
            let edited =
              List.find
                (fun report ->
                  String.equal
                    (Repository.app_feedback_id_to_string
                       report.Repository.feedback_id)
                    (Repository.app_feedback_id_to_string report_id))
                (run (S.app_feedback s alice.Trainee.id))
            in
            Alcotest.(check string)
              "edited message persists" "Edited" edited.Repository.message;
            Alcotest.(check bool)
              "owner remove succeeds" true
              (run (S.remove_app_feedback s alice.Trainee.id report_id));
            Alcotest.(check int)
              "removed report is absent" 0
              (List.length (run (S.app_feedback s alice.Trainee.id)))) );
    ( "a username and password change survive a reconnect",
      `Quick,
      fun () ->
        let path, uri = temp_uri () in
        Fun.protect
          ~finally:(fun () -> cleanup path)
          (fun () ->
            let id =
              let repo = connect uri in
              let s = S.make ~repo in
              let id =
                (ok
                   (run (S.register s ~username:"alice" ~password:"heavyduty1")))
                  .Trainee.id
              in
              let _ = ok (run (S.change_username s id ~username:"alicia")) in
              let _ =
                ok
                  (run
                     (S.change_password s id ~current:"heavyduty1"
                        ~next:"newsecret1"))
              in
              id
            in
            (* Reconnect: the new name and password must be the ones stored. *)
            let repo = connect uri in
            let s = S.make ~repo in
            (match run (S.find_trainee s id) with
            | Some found ->
                Alcotest.(check string)
                  "renamed account persisted" "alicia"
                  (Trainee.username_to_string found.Trainee.username)
            | None -> Alcotest.fail "account vanished");
            Alcotest.(check bool)
              "the old password no longer authenticates" true
              (Option.is_none
                 (run
                    (S.authenticate s ~username:"alicia" ~password:"heavyduty1")));
            Alcotest.(check bool)
              "the new password authenticates" true
              (Option.is_some
                 (run
                    (S.authenticate s ~username:"alicia" ~password:"newsecret1"))))
    );
  ]

let suite =
  [
    ("sqlite_repo", durability_tests);
    ("sqlite_repo.migrations", migration_tests);
  ]