diff --git a/backend/src/common/session.ml b/backend/src/common/session.ml new file mode 100644 index 0000000..7c279f6 --- /dev/null +++ b/backend/src/common/session.ml @@ -0,0 +1,41 @@ +(* customize Sihl set cookie Session utility to include Max-Age, SameSite, Secure and HttpOnly *) + +(* from session.ml file: https://github.com/oxidizing/sihl/blob/master/sihl/src/session.ml *) + +module StrMap = Map.Make (String) + +let to_yojson session = + `Assoc ( + session + |> StrMap.to_seq + |> List.of_seq + |> List.map (fun (k, v) -> k, `String v)) + +let to_json session = session |> to_yojson |> Yojson.Safe.to_string + +(* from web_session.ml file: https://github.com/oxidizing/sihl/blob/master/sihl/src/web_session.ml *) + +let set_cookie + ?(cookie_key = "_session") + ?(secret = Sihl.Configuration.read_secret ()) + ?(max_age = 3600L) + ?(scope = "/") + ?(same_site = "strict") + ?(http_only = true) + session + resp + = + let signed_with = Opium.Cookie.Signer.make secret in + let session = session |> List.to_seq |> StrMap.of_seq in + let cookie_value = to_json session in + let cookie = cookie_key, cookie_value in + let same_site = match same_site with | "strict" -> `Strict | "lax" -> `Lax | _ -> `None in + Opium.Response.add_cookie_or_replace + ~sign_with:signed_with + ~expires:(`Max_age max_age) + ~scope:(Uri.of_string scope) + ~same_site:same_site + ~secure:true + ~http_only:http_only + cookie + resp diff --git a/backend/src/common/utils.ml b/backend/src/common/utils.ml index e49fbe5..26e682c 100644 --- a/backend/src/common/utils.ml +++ b/backend/src/common/utils.ml @@ -1,18 +1,9 @@ (* return expiration epoch (current epoch + 1h) *) -let expiration () = - Unix.time () +. 3600. +let expiration ?(seconds = 3600) () = + Unix.time () +. float_of_int seconds |> int_of_float |> Printf.sprintf "%d" -(* return current date in format "YYYY-MM-DD" *) -let current_date () = - let time = Unix.time () in - let tm = Unix.localtime time in - Printf.sprintf "%04d-%02d-%02d" - (1900 + tm.Unix.tm_year) - (1 + tm.Unix.tm_mon) - tm.Unix.tm_mday - (* send an HTTP response with ~status and ~json payload *) let return (status : int) (json : (string * string) list) = Opium.Response.of_json @@ -35,11 +26,11 @@ let return_json_list (status : int) (json : Yojson.Safe.t list) = |> Lwt.return (* same as return, but also sets ~session *) -let session_return (status : int) (json : (string * string) list) (session : (string * string) list) = +let session_return ?(max_age = 86400L) (status : int) (json : (string * string) list) (session : (string * string) list) = Opium.Response.of_json ?status: (Some (Opium.Status.of_code status)) (`Assoc (json |> List.map (fun (k, v) -> (k, `String v)))) - |> Sihl.Web.Session.set session + |> Session.set_cookie ~max_age:max_age ~scope:"/" ~same_site:"strict" ~http_only:true session |> Lwt.return (* same as return but with fixed json payload fiels "error" and "message" *) diff --git a/backend/src/handlers/login.ml b/backend/src/handlers/login.ml index 92de9d6..50a00d0 100644 --- a/backend/src/handlers/login.ml +++ b/backend/src/handlers/login.ml @@ -38,7 +38,7 @@ let login req = ] [ ("id", user_id); ("username", json.username); - ("expiration", expiration ()); + ("expiration", expiration ~seconds:86400 ()); ] in try%lwt logic @@ -47,6 +47,6 @@ let login req = |> V.validate_json req with _ -> error 400 "invalid request" "generic error, please report this" -let logout _ = session_return 200 [("message", "logout successful")] [] +let logout _ = session_return ~max_age:0L 200 [("message", "logout successful")] [] let verify _ = return 200 [("message", "valid login")] diff --git a/backend/src/handlers/users.ml b/backend/src/handlers/users.ml index c4d49e3..14c785e 100644 --- a/backend/src/handlers/users.ml +++ b/backend/src/handlers/users.ml @@ -82,7 +82,7 @@ let create req = ] [ ("id", user_id); ("username", json.username); - ("expiration", expiration ()); + ("expiration", expiration ~seconds:86400 ()); ] | _ -> error 400 "invalid username" "username already taken" in try%lwt