package sihl
Source file middleware_session.ml
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36open Lwt.Syntax module Make (SessionService : Session.Sig.SERVICE) = struct let m ?( = "session_key") () = let filter handler ctx = match Http.Req.cookie_data ctx ~key:cookie_key with | Some session_key -> (* A session cookie was found *) let* session = SessionService.find_opt ctx ~key:session_key in (match session with | Some session -> let* session = if Session.is_expired (Ptime_clock.now ()) session then ( Logs.debug (fun m -> m "SESSION: Session expired, creating new one"); let* session = SessionService.create ctx [] in Lwt.return session) else Lwt.return session in let ctx = SessionService.add_to_ctx session ctx in handler ctx | None -> let* session = SessionService.create ctx [] in let ctx = SessionService.add_to_ctx session ctx in let* res = handler ctx in res |> Http.Res.set_cookie ~key:cookie_key ~data:session.key |> Lwt.return) | None -> (* No session cookie found *) let* session = SessionService.create ctx [] in let ctx = SessionService.add_to_ctx session ctx in let* res = handler ctx in res |> Http.Res.set_cookie ~key:cookie_key ~data:session.key |> Lwt.return in Middleware_core.create ~name:"session" filter ;; end