open Hito_app
open Support

let suite =
  [
    ( "web.auth",
      [
        ( "an unauthenticated visit to the overview redirects to sign-in",
          `Quick,
          fun () ->
            let c = client () in
            let response = get c "/" in
            Alcotest.(check int) "redirect" 303 (status response);
            Alcotest.(check string) "to /login" "/login" (location response) );
        ( "the sign-in page is served",
          `Quick,
          fun () ->
            let c = client () in
            Alcotest.(check int) "GET /login" 200 (status (get c "/login")) );
        ( "every response carries the browser hardening headers",
          `Quick,
          fun () ->
            let c = client () in
            let response = get c "/login" in
            let header name = Dream.header response name in
            Alcotest.(check bool)
              "a same-origin CSP that refuses framing" true
              (match header "Content-Security-Policy" with
              | Some csp ->
                  Option.is_some (index_from ~needle:"default-src 'self'" csp 0)
                  && Option.is_some
                       (index_from ~needle:"frame-ancestors 'none'" csp 0)
              | None -> false);
            Alcotest.(check (option string))
              "framing denied" (Some "DENY") (header "X-Frame-Options");
            Alcotest.(check (option string))
              "no type sniffing" (Some "nosniff")
              (header "X-Content-Type-Options");
            Alcotest.(check (option string))
              "strict referrer" (Some "strict-origin-when-cross-origin")
              (header "Referrer-Policy") );
        ( "signing in rotates the session identifier",
          `Quick,
          fun () ->
            (* A session identifier that existed before authentication must not
               survive into the authenticated session. Otherwise an attacker
               who planted the identifier would inherit the login (session
               fixation). Read the pre-login cookie, sign in, and confirm the
               cookie the server now sets is different. *)
            let session_cookie c =
              List.find_opt
                (fun cookie ->
                  String.length cookie >= 13
                  && String.sub cookie 0 13 = "dream.session")
                c.jar
            in
            let c = client () in
            let _ = register c ~username:"lifter" ~password:"heavyduty1" in
            (* Sign out, then obtain a fresh anonymous session cookie. *)
            let token = Option.get (csrf_token (body (get c "/"))) in
            let _ = post c "/logout" [ ("dream.csrf", token) ] in
            let _ = get c "/login" in
            let before = session_cookie c in
            Alcotest.(check bool)
              "an anonymous session cookie exists before sign-in" true
              (Option.is_some before);
            let token = Option.get (csrf_token (body (get c "/login"))) in
            let _ =
              post c "/login"
                [
                  ("dream.csrf", token);
                  ("username", "lifter");
                  ("password", "heavyduty1");
                ]
            in
            let after = session_cookie c in
            Alcotest.(check bool)
              "a session cookie exists after sign-in" true
              (Option.is_some after);
            Alcotest.(check bool)
              "the session identifier changed on sign-in" true (before <> after)
        );
        ( "repeated sign-in attempts from one client are throttled",
          `Quick,
          fun () ->
            (* Online password guessing is bounded per client: ten attempts a
               minute. The eleventh is refused with 429 before any credential
               check, and a wrong password never becomes a right one by
               repetition. *)
            let c = client () in
            let _ = register c ~username:"lifter" ~password:"heavyduty1" in
            let token = Option.get (csrf_token (body (get c "/"))) in
            let _ = post c "/logout" [ ("dream.csrf", token) ] in
            let attempt () =
              let token = Option.get (csrf_token (body (get c "/login"))) in
              post c "/login"
                [
                  ("dream.csrf", token);
                  ("username", "lifter");
                  ("password", "wrong");
                ]
            in
            for _ = 1 to 10 do
              Alcotest.(check int)
                "a wrong password is refused" 401
                (status (attempt ()))
            done;
            Alcotest.(check int)
              "the eleventh attempt is throttled" 429
              (status (attempt ()));
            (* Even the right password is refused while throttled. *)
            let token = Option.get (csrf_token (body (get c "/login"))) in
            let right =
              post c "/login"
                [
                  ("dream.csrf", token);
                  ("username", "lifter");
                  ("password", "heavyduty1");
                ]
            in
            Alcotest.(check int)
              "a correct password is also refused while throttled" 429
              (status right) );
        ( "registration creates the account, signs in, and reaches the overview",
          `Quick,
          fun () ->
            let c, repo = client_with_repo () in
            let registered =
              register c ~username:"lifter" ~password:"heavyduty1"
            in
            Alcotest.(check int)
              "registered, redirected" 303 (status registered);
            (* The account now exists: the flow orchestrated a real create. *)
            let trainee = the_trainee repo ~username:"lifter" in
            Alcotest.(check string)
              "stored under the normalized username" "lifter"
              (Trainee.username_to_string trainee.Trainee.username);
            (* The session authenticates the follow-up request. *)
            Alcotest.(check int)
              "authenticated overview" 200
              (status (get c "/")) );
        ( "an authenticated trainee reaches the overview",
          `Quick,
          fun () ->
            let c = client () in
            let _ = sign_in_new c in
            Alcotest.(check int) "home" 200 (status (get c "/")) );
        ( "sign-out clears the session",
          `Quick,
          fun () ->
            let c = client () in
            let _ = sign_in_new c in
            let token = Option.get (csrf_token (body (get c "/"))) in
            let out = post c "/logout" [ ("dream.csrf", token) ] in
            Alcotest.(check int) "logout redirects" 303 (status out);
            (* The session is gone: the overview again bounces to sign-in. *)
            let after = get c "/" in
            Alcotest.(check int) "overview now redirects" 303 (status after);
            Alcotest.(check string) "to /login" "/login" (location after) );
        ( "a form post without a CSRF token is refused and changes nothing",
          `Quick,
          fun () ->
            let c, repo = client_with_repo () in
            let _ = register c ~username:"lifter" ~password:"heavyduty1" in
            let response =
              post c "/routines/ideal/select" [ (* no dream.csrf *) ]
            in
            Alcotest.(check int)
              "redirects after the refused post" 303 (status response);
            (* No routine was selected: the refused post had no domain effect. *)
            let trainee = the_trainee repo ~username:"lifter" in
            Alcotest.(check bool)
              "no active routine" true
              (Option.is_none
                 (Lwt_main.run
                    (Test_repo.active_routine repo trainee.Trainee.id))) );
        ( "a too-short username is refused",
          `Quick,
          fun () ->
            let c, repo = client_with_repo () in
            let response = register c ~username:"abc" ~password:"heavyduty1" in
            Alcotest.(check int) "rejected" 400 (status response);
            Alcotest.(check (option string))
              "no account created" None
              (Lwt_main.run
                 (match Trainee.username "abc" with
                 | Ok u -> Test_repo.find_trainee_by_username repo u
                 | Error _ -> Lwt.return None)
              |> Option.map (fun t -> Trainee.id_to_string t.Trainee.id)) );
        ( "a too-long username is refused",
          `Quick,
          fun () ->
            let c = client () in
            let response =
              register c ~username:"abcdefghijklmnopqrstu"
                ~password:"heavyduty1"
            in
            Alcotest.(check int) "rejected" 400 (status response) );
        ( "a short password is accepted (passwords carry no policy)",
          `Quick,
          fun () ->
            let c = client () in
            let response = register c ~username:"lifter" ~password:"x" in
            Alcotest.(check int) "registered, redirected" 303 (status response);
            Alcotest.(check int)
              "authenticated overview" 200
              (status (get c "/")) );
        ( "with registration closed the register routes are absent",
          `Quick,
          fun () ->
            (* The production default: [registration_open] unset. *)
            let handlers = Handlers.make ~repo:(Test_repo.create ()) () in
            let app =
              Dream.memory_sessions @@ Dream.router (Handlers.routes handlers)
              |> fun h -> Dream.set_secret "test-secret-value" h
            in
            let c = { app; jar = [] } in
            Alcotest.(check int)
              "GET /register is not found" 404
              (status (get c "/register"));
            Alcotest.(check int)
              "GET /login is served" 200
              (status (get c "/login")) );
        ( "a returning trainee signs in with their credentials",
          `Quick,
          fun () ->
            (* Register, then sign out, then sign back in through the credential
             form. This exercises [POST /login], which registration's
             auto-sign-in never touches. *)
            let c = client () in
            let _ = sign_in_new c in
            let token = Option.get (csrf_token (body (get c "/"))) in
            let _ = post c "/logout" [ ("dream.csrf", token) ] in
            Alcotest.(check int)
              "signed out, overview redirects" 303
              (status (get c "/"));
            let signed_in =
              sign_in c ~username:"lifter" ~password:"heavyduty1"
            in
            Alcotest.(check int) "sign-in redirects" 303 (status signed_in);
            Alcotest.(check bool)
              "sign-in lands on Home" true
              (List.mem "/" (Dream.headers signed_in "Location"));
            Alcotest.(check int)
              "authenticated overview" 200
              (status (get c "/")) );
        ( "a wrong password is refused and establishes no session",
          `Quick,
          fun () ->
            let c = client () in
            let _ = sign_in_new c in
            let token = Option.get (csrf_token (body (get c "/"))) in
            let _ = post c "/logout" [ ("dream.csrf", token) ] in
            let refused =
              sign_in c ~username:"lifter" ~password:"not-the-password"
            in
            Alcotest.(check int) "rejected" 401 (status refused);
            (* The rejected attempt establishes no session. *)
            Alcotest.(check int)
              "still unauthenticated" 303
              (status (get c "/")) );
        ( "an unknown username is refused like a wrong password",
          `Quick,
          fun () ->
            let c = client () in
            let refused = sign_in c ~username:"nobody" ~password:"heavyduty1" in
            Alcotest.(check int) "rejected" 401 (status refused);
            Alcotest.(check int)
              "no session established" 303
              (status (get c "/")) );
        ( "an already-authenticated visit to the sign-in page redirects Home",
          `Quick,
          fun () ->
            let c = client () in
            let _ = sign_in_new c in
            let response = get c "/login" in
            Alcotest.(check int) "redirects" 303 (status response);
            Alcotest.(check bool)
              "sends an authenticated visitor Home" true
              (List.mem "/" (Dream.headers response "Location")) );
        ( "an already-authenticated visit to the register page redirects Home",
          `Quick,
          fun () ->
            let c = client () in
            let _ = sign_in_new c in
            let response = get c "/register" in
            Alcotest.(check int) "redirects" 303 (status response);
            Alcotest.(check bool)
              "sends an authenticated visitor Home" true
              (List.mem "/" (Dream.headers response "Location")) );
        ( "signing out returns the trainee to the sign-in page",
          `Quick,
          fun () ->
            let c = client () in
            let _ = sign_in_new c in
            let page = body (get c "/") in
            let token = Option.get (csrf_token page) in
            let out = post c "/logout" [ ("dream.csrf", token) ] in
            Alcotest.(check int) "logout redirect" 303 (status out);
            let after = get c "/" in
            Alcotest.(check int) "overview now redirects" 303 (status after);
            Alcotest.(check string) "to /login" "/login" (location after) );
      ] );
  ]