webauthn/flash_message/flash_message.ml

53 lines
1.4 KiB
OCaml
Raw Normal View History

2021-09-28 11:30:14 +00:00
open Lwt.Syntax
let five_minutes = 5. *. 60.
let storage = Dream.new_field ~name:"dream.flash_message" ()
2021-09-28 11:30:14 +00:00
let flash_cookie = "dream.flash_message"
let flash_messages inner_handler request =
let outbox = ref [] in
Dream.set_field request storage outbox;
2021-09-28 11:30:14 +00:00
let* response = inner_handler request in
Lwt.return(
let entries = List.rev !outbox in
let content = List.fold_right (fun (x,y) a -> `String x :: `String y :: a) entries [] in
let value = `List content |> Yojson.Basic.to_string in
Dream.set_cookie response request flash_cookie value ~max_age:five_minutes;
response
2021-09-28 11:30:14 +00:00
)
let (|>?) =
Option.bind
let get_flash request =
let rec group x = match x with
| x1::x2::rest -> (x1, x2) :: group rest
| _ -> []
in
let unpack u = match u with
| `String x -> x
| _ -> failwith "Bad flash message content" in
let x = Dream.cookie request flash_cookie
2021-09-28 11:30:14 +00:00
|>? fun value ->
match Yojson.Basic.from_string value with
| `List y -> Some (group @@ List.map unpack y)
| _ -> None
in Option.value x ~default:[]
let put_flash category message request =
let outbox = match Dream.field request storage with
2021-09-28 11:30:14 +00:00
| Some outbox -> outbox
| None ->
let message = "Missing flash message middleware" in
Logs.err (fun log -> log "%s" message);
failwith message in
outbox := (category, message) :: !outbox