Custom session

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

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" *)

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")]

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