(** Shared support for the web tier tests. Sessions and CSRF are exercised end
    to end: a small client carries the session cookie between requests and pulls
    the CSRF token out of the rendered page, exactly as a browser would. The
    SQLite runs in an isolated in-memory database; session storage is Dream's
    in-memory back end. *)

open Hito_app

module Handlers =
  Hito_web.Handlers.Make (Test_repo) (Test_hash) (Hito_import.Hevy_csv)

(* A fresh, fully wired application: secret, in-memory sessions, routes.
   Registration is opened here so the auth-flow tests can create trainees via
   [/register]; production keeps it closed. *)
let app ?(import_open = true) () =
  let handlers =
    Handlers.make ~repo:(Test_repo.create ()) ~registration_open:true
      ~import_open ()
  in
  Dream.memory_sessions @@ Handlers.security_headers
  @@ Dream.router (Handlers.routes handlers)
  |> fun handler -> Dream.set_secret "test-secret-value" handler

let status response = Dream.status response |> Dream.status_to_int
let body response = Lwt_main.run (Dream.body response)

(* The redirect target of a 3xx response — the URL half of a URL-to-URL flow. *)
let location response =
  match Dream.header response "Location" with
  | Some target -> target
  | None -> Alcotest.failf "expected a Location header on a redirect"

(* --- a cookie-carrying client --- *)

(* Extract cookies (name=value) from all Set-Cookie response headers. *)
let cookies_of response =
  Dream.headers response "Set-Cookie"
  |> List.filter_map (fun sc ->
      match String.index_opt sc ';' with
      | Some i -> Some (String.sub sc 0 i)
      | None -> Some sc)

type client = { app : Dream.handler; mutable jar : string list }

let client ?(import_open = true) () = { app = app ~import_open (); jar = [] }

let cookie_header client =
  if client.jar = [] then [] else [ ("Cookie", String.concat "; " client.jar) ]

let remember client response =
  (* Replace cookies of the same name; keep the rest. *)
  List.iter
    (fun fresh ->
      let name =
        match String.index_opt fresh '=' with
        | Some i -> String.sub fresh 0 i
        | None -> fresh
      in
      client.jar <-
        fresh
        :: List.filter
             (fun old ->
               not
                 (String.length old >= String.length name
                 && String.sub old 0 (String.length name) = name
                 && (String.length old = String.length name
                    || old.[String.length name] = '=')))
             client.jar)
    (cookies_of response)

let get client target =
  let response =
    Dream.test client.app
      (Dream.request ~method_:`GET ~target ~headers:(cookie_header client) "")
  in
  remember client response;
  response

let post client target fields =
  let body =
    fields
    |> List.map (fun (k, v) ->
        Dream.to_percent_encoded k ^ "=" ^ Dream.to_percent_encoded v)
    |> String.concat "&"
  in
  let response =
    Dream.test client.app
      (Dream.request ~method_:`POST ~target
         ~headers:
           (("Content-Type", "application/x-www-form-urlencoded")
           :: cookie_header client)
         body)
  in
  remember client response;
  response

(* A multipart/form-data POST. [file] is [(field, filename, content)]; [fields]
   are plain text parts. The CSRF token rides as its own text part, exactly as
   [Dream.csrf_tag] renders it into a browser form, so [Dream.multipart ~csrf]
   verifies it. The boundary is fixed but improbable in the body. *)
let post_multipart client target ~file ~fields =
  let boundary = "----hitotestboundary7Xk2p" in
  let buf = Buffer.create 1024 in
  let part_field (name, value) =
    Buffer.add_string buf ("--" ^ boundary ^ "\r\n");
    Buffer.add_string buf
      (Printf.sprintf "Content-Disposition: form-data; name=%S\r\n\r\n" name);
    Buffer.add_string buf value;
    Buffer.add_string buf "\r\n"
  in
  List.iter part_field fields;
  (match file with
  | Some (name, filename, content) ->
      Buffer.add_string buf ("--" ^ boundary ^ "\r\n");
      Buffer.add_string buf
        (Printf.sprintf
           "Content-Disposition: form-data; name=%S; filename=%S\r\n" name
           filename);
      Buffer.add_string buf "Content-Type: text/csv\r\n\r\n";
      Buffer.add_string buf content;
      Buffer.add_string buf "\r\n"
  | None -> ());
  Buffer.add_string buf ("--" ^ boundary ^ "--\r\n");
  let response =
    Dream.test client.app
      (Dream.request ~method_:`POST ~target
         ~headers:
           (("Content-Type", "multipart/form-data; boundary=" ^ boundary)
           :: cookie_header client)
         (Buffer.contents buf))
  in
  remember client response;
  response

let index_from ~needle haystack start =
  let n = String.length needle and h = String.length haystack in
  let rec at i =
    if i + n > h then None
    else if String.sub haystack i n = needle then Some i
    else at (i + 1)
  in
  if start < 0 then None else at start

(* Extract the CSRF token from a rendered form. The test client needs this
   browser-facing value to submit the same protected requests as a user. *)
let csrf_token html =
  match index_from ~needle:"name=\"dream.csrf\"" html 0 with
  | None -> None
  | Some idx -> (
      match index_from ~needle:"value=\"" html idx with
      | None -> None
      | Some v ->
          let start = v + String.length "value=\"" in
          let stop = String.index_from html start '"' in
          Some (String.sub html start (stop - start)))

let register client ~username ~password =
  let page = body (get client "/register") in
  let token = Option.get (csrf_token page) in
  post client "/register"
    [ ("dream.csrf", token); ("username", username); ("password", password) ]

let sign_in_new client =
  register client ~username:"lifter" ~password:"heavyduty1"

(* Sign in through the credential form, as a returning trainee would. Unlike
   [register], this exercises the [POST /login] path. *)
let sign_in client ~username ~password =
  let page = body (get client "/login") in
  let token = Option.get (csrf_token page) in
  post client "/login"
    [ ("dream.csrf", token); ("username", username); ("password", password) ]

(* An application whose clock the test drives. A shared [Test_repo] and a
   mutable [now] cell let a deep test advance time across the recovery gate,
   which the wall-clock default cannot. Registration is open so the test can
   create the trainee it drives. Also hands back the repository, so a deep test
   can assert the domain state its flow produced. *)
let clocked_client () =
  let now = ref 0 in
  let repo = Test_repo.create () in
  let handlers =
    Handlers.make ~repo
      ~now:(fun () -> Recovery.timestamp_of_unix_seconds !now)
      ~registration_open:true ()
  in
  let app =
    Dream.memory_sessions @@ Dream.router (Handlers.routes handlers) |> fun h ->
    Dream.set_secret "test-secret-value" h
  in
  ({ app; jar = [] }, now, repo)

let day n = n * 86_400

(* A client that hands back its repository, so a test can assert the domain
   state the flow produced — the log, the stored feedback, the renamed account —
   rather than reading it back out of rendered HTML. *)
let client_with_repo ?(import_open = true) () =
  let repo = Test_repo.create () in
  let handlers = Handlers.make ~repo ~registration_open:true ~import_open () in
  let app =
    Dream.memory_sessions @@ Dream.router (Handlers.routes handlers) |> fun h ->
    Dream.set_secret "test-secret-value" h
  in
  ({ app; jar = [] }, repo)

(* Look up the sole seeded trainee by the name the flow helpers register. *)
let the_trainee repo ~username =
  match Trainee.username username with
  | Error _ -> Alcotest.failf "test username %S is invalid" username
  | Ok u -> (
      match Lwt_main.run (Test_repo.find_trainee_by_username repo u) with
      | Some trainee -> trainee
      | None -> Alcotest.failf "no trainee named %S" username)

(* Drive a trainee to the start of a fresh Day 1 workout: select the ideal
   routine and begin without an override. Returns the client. *)
let start_day_one c =
  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
  post c "/workout" [ ("dream.csrf", token); ("override", "false") ]

(* Record every slot of the in-progress Day 1 workout, one at a time, addressed
   by [?slot=]. Slot 0 is the flyes/incline-press pair; slot 3 is the
   french-press/dips pair; slots 1 and 2 are single lateral movements. *)
let record_all_day_one_slots c =
  let record_pair slot comp_load =
    let token =
      Option.get (csrf_token (body (get c ("/workout?slot=" ^ slot))))
    in
    post c ("/workout/slots/" ^ slot)
      [
        ("dream.csrf", token);
        ("iso_load", "20");
        ("iso_reps", "9");
        ("comp_load", comp_load);
        ("comp_reps", "7");
        ("extension", "");
      ]
  in
  let record_single slot load reps =
    let token =
      Option.get (csrf_token (body (get c ("/workout?slot=" ^ slot))))
    in
    post c ("/workout/slots/" ^ slot)
      [
        ("dream.csrf", token); ("load", load); ("reps", reps); ("extension", "");
      ]
  in
  let _ = record_pair "0" "60" in
  let _ = record_single "1" "12" "8" in
  let _ = record_single "2" "10" "9" in
  let _ = record_pair "3" "0" in
  ()