feat: add login handling and tests

lib/backend/Routes/Api/Login.ml

@@ -26,7 +26,25 @@ let handler request =
         Dream.error (fun log -> log "Failed with %s" @@ Caqti_error.show e);
         Dream.respond ~code:422 @@ string_of_login_error_content `CouldNotLogIn
   in
-  let handle_auth _ _ = assert false in
+  let handle_auth submitted_username submitted_auth_token =
+    let submitted_auth_token = Cipher.double_hmac submitted_auth_token in
+    match%lwt get_user request submitted_username with
+    | Ok (Some user)
+      when String.equal submitted_username user.username
+           && String.equal submitted_auth_token user.auth_token ->
+        let id = Printf.sprintf "%li" user.id in
+        let public_id = user.public_id in
+        Dream.info (fun log -> log "User exists, creating session.");
+        Dream.set_session_field request "id" id;%lwt
+        Dream.set_session_field request "public_id" public_id;%lwt
+        Dream.empty `No_Content
+    | Ok (Some _) | Ok None ->
+        Dream.error (fun log -> log "Invalid credentials, serving error.");
+        Dream.respond ~code:422 @@ string_of_login_error_content `CouldNotLogIn
+    | Error (#Caqti_error.t as e) ->
+        Dream.error (fun log -> log "Failed with %s" @@ Caqti_error.show e);
+        Dream.respond ~code:422 @@ string_of_login_error_content `CouldNotLogIn
+  in
   let inner ({ username; auth_token } : login_payload) =
     match ValidationUsername.validate username with
     | Validated Success -> (

test/backend/Backend_test.ml

@@ -16,7 +16,11 @@ let () =
            List.map
              (fun f -> f "login")
              Login_Api_test.
-               [ login_returns_client_salt; login_returns_server_salt ] );
+               [
+                 login_returns_client_salt;
+                 login_returns_server_salt;
+                 login_creates_session;
+               ] );
          ( "/api/register",
            List.map
              (fun f -> f "register")

test/backend/Login_Api_test.ml

@@ -64,3 +64,37 @@ let login_returns_server_salt prefix =
     Lwt.return ()
   in
   make_test_case prefix "it returns server salt" inner
+
+let login_creates_session prefix =
+  let inner () =
+    default_register ();%lwt
+
+    let%lwt cookie_headers = get_cookie_headers () in
+    let original_session_cookie =
+      Cookie.Cookie_hdr.extract cookie_headers |> List.assoc "dream.session"
+    in
+
+    let%lwt response, body =
+      let json =
+        string_of_login_payload { username; auth_token = Some auth_token }
+      in
+      post_json cookie_headers json "http://localhost:8080/api/login"
+    in
+    Cohttp_lwt.Body.drain_body body;%lwt
+
+    let code = Response.status response |> Code.code_of_status in
+    let fresh_session_cookie =
+      Response.headers response |> Cookie.Set_cookie_hdr.extract
+      |> List.assoc "dream.session" |> Cookie.Set_cookie_hdr.value
+    in
+
+    let _ =
+      Alcotest.(check int) "status code is 204" 204 code;
+      Alcotest.(check bool)
+        "fresh session cookie is sent" true
+        (not @@ String.equal original_session_cookie fresh_session_cookie)
+    in
+
+    Lwt.return ()
+  in
+  make_test_case prefix "it creates a session" inner