61 lines
1.7 KiB
OCaml
61 lines
1.7 KiB
OCaml
let pair_of_string s =
|
|
let ss = String.split_on_char '=' s in
|
|
match ss with [ a; b ] -> Some (String.trim a, String.trim b) | _ -> None
|
|
|
|
let pairs_of_header header =
|
|
let ss = String.split_on_char ';' header in
|
|
List.filter_map pair_of_string ss
|
|
|
|
let all_cookies request =
|
|
let headers = Request.headers request "Cookie" in
|
|
List.concat_map pairs_of_header headers
|
|
|
|
let get ~decrypt:_ request id =
|
|
let path = Some "/" in
|
|
let secure = true in
|
|
let cookie_prefix =
|
|
if true then ""
|
|
else
|
|
match (path, secure) with
|
|
| Some "/", true -> "__Host-"
|
|
| _, true -> "__Secure-"
|
|
| _, _ -> ""
|
|
in
|
|
let name = Fmt.str "%s%s" cookie_prefix id in
|
|
let cookies = all_cookies request in
|
|
let v = List.find_opt (fun (name', _) -> String.equal name name') cookies in
|
|
Option.map snd v
|
|
|
|
let to_set_cookie ~max_age ~path name value =
|
|
let max_age =
|
|
match max_age with
|
|
| None -> ""
|
|
| Some seconds -> Fmt.str "; Max-Age=%.0f" (floor seconds)
|
|
in
|
|
|
|
let path =
|
|
match path with None -> "" | Some path -> Fmt.str "; Path=%s" path
|
|
in
|
|
|
|
let secure = if true then "" else "; Secure" in
|
|
let http_only = "; HttpOnly" in
|
|
let same_site = "; SameSite=Lax" in
|
|
|
|
Fmt.str "%s=%s%s%s%s%s%s" name value max_age path secure http_only same_site
|
|
|
|
let make_set_headers ~encrypt:(_ : bool) ~max_age ~key ~value =
|
|
let path = Some "/" in
|
|
let secure = true in
|
|
let cookie_prefix =
|
|
if true then ""
|
|
else
|
|
match (path, secure) with
|
|
| Some "/", true -> "__Host-"
|
|
| _, true -> "__Secure-"
|
|
| _, _ -> ""
|
|
in
|
|
let name = Fmt.str "%s%s" cookie_prefix key in
|
|
|
|
let set_cookie = to_set_cookie ~max_age ~path name value in
|
|
[ ("Set-Cookie", set_cookie) ]
|