From 6ea6d55054c68e71185b176b875864c4bd00837c Mon Sep 17 00:00:00 2001 From: Josef Erben Date: Sat, 20 Feb 2021 11:52:10 +0100 Subject: [PATCH] Implement cookie-based session --- CHANGES.md | 2 + .../middlewares/middleware_cookie_session.ml | 167 ++++++++++++++ .../middlewares/middleware_cookie_session.mli | 5 + opium/src/opium.ml | 8 + opium/src/opium.mli | 28 +++ opium/test/dune | 2 +- opium/test/middleware_cookie_session.ml | 218 ++++++++++++++++++ 7 files changed, 429 insertions(+), 1 deletion(-) create mode 100644 opium/src/middlewares/middleware_cookie_session.ml create mode 100644 opium/src/middlewares/middleware_cookie_session.mli create mode 100644 opium/test/middleware_cookie_session.ml diff --git a/CHANGES.md b/CHANGES.md index 214f4ad4..166a0b19 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -2,6 +2,8 @@ ## Added +- New `Session` module to fetch and set session values +- New `cookie_session` middleware that persists session data in cookie - New `Auth` module to work with `Authorization` header (#238) - New `basic_auth` middleware to protect handlers with a `Basic` authentication method (#238) diff --git a/opium/src/middlewares/middleware_cookie_session.ml b/opium/src/middlewares/middleware_cookie_session.ml new file mode 100644 index 00000000..d7275b36 --- /dev/null +++ b/opium/src/middlewares/middleware_cookie_session.ml @@ -0,0 +1,167 @@ +let log_src = Logs.Src.create ~doc:"middleware for cookie-based sessions" "opium.session" + +module Logs = (val Logs.src_log log_src : Logs.LOG) +module Map = Map.Make (String) + +module Session = struct + type t = + { data : string Map.t + ; should_set_cookie : bool + } + + let create should_set_cookie = { data = Map.empty; should_set_cookie } + + let of_yojson yojson = + let open Yojson.Safe.Util in + let session_list = + try Some (yojson |> to_assoc |> List.map (fun (k, v) -> k, to_string v)) with + | _ -> None + in + session_list + |> Option.map List.to_seq + |> Option.map Map.of_seq + |> Option.map (fun data -> { data; should_set_cookie = false }) + ;; + + let to_yojson { data = session; _ } = + `Assoc (session |> Map.to_seq |> List.of_seq |> List.map (fun (k, v) -> k, `String v)) + ;; + + let of_json json = + try of_yojson (Yojson.Safe.from_string json) with + | _ -> None + ;; + + let to_json session = session |> to_yojson |> Yojson.Safe.to_string + + let to_sexp session = + let open Sexplib0.Sexp_conv in + let open Sexplib0.Sexp in + let data = + session.data + |> Map.to_seq + |> List.of_seq + |> sexp_of_list (sexp_of_pair sexp_of_string sexp_of_string) + in + List + [ List [ Atom "data"; data ] + ; List [ Atom "should_set_cookie"; sexp_of_bool session.should_set_cookie ] + ] + ;; +end + +module SessionChange = struct + type t = string option Map.t + + let empty = Map.empty + + let merge Session.{ data = session; should_set_cookie } t = + let data = + Map.merge + (fun _ session change -> + match session, change with + | _, Some (Some change) -> Some change + | _, Some None -> None + | Some session, None -> Some session + | None, None -> None) + session + t + in + Session.{ data; should_set_cookie } + ;; + + let to_sexp t = + t + |> Map.to_seq + |> List.of_seq + |> Sexplib0.Sexp_conv.( + sexp_of_list (sexp_of_pair sexp_of_string (sexp_of_option sexp_of_string))) + ;; +end + +module Env = struct + let key : Session.t Context.key = Context.Key.create ("session", Session.to_sexp) + + let key_session_change : SessionChange.t Context.key = + Context.Key.create ("session change", SessionChange.to_sexp) + ;; +end + +exception Session_not_found + +let find key req = + let session = + try Context.find_exn Env.key req.Request.env with + | _ -> + Logs.err (fun m -> m "No session found"); + Logs.info (fun m -> m "Have you applied the session middleware?"); + raise @@ Session_not_found + in + Map.find_opt key session.data +;; + +let set (key, value) resp = + let change = + match Context.find Env.key_session_change resp.Response.env with + | Some change -> Map.add key value change + | None -> SessionChange.empty |> Map.add key value + in + let env = resp.Response.env in + let env = Context.add Env.key_session_change change env in + { resp with env } +;; + +let decode_session cookie_key signed_with req = + match Request.cookie ~signed_with cookie_key req with + | None -> Session.create true + | Some cookie_value -> + (match Session.of_json cookie_value with + | None -> + Logs.err (fun m -> + m + "Failed to parse value found in session cookie '%s': '%s'" + cookie_key + cookie_value); + Logs.info (fun m -> + m + "Maybe the cookie key '%s' collides with a cookie issued by someone else. \ + Try to change the cookie key." + cookie_key); + Session.create true + | Some session -> session) +;; + +let persist_session current_session signed_with cookie_key resp = + let session_change = Context.find Env.key_session_change resp.Response.env in + let cookie = + match current_session.Session.should_set_cookie, session_change with + | true, Some session_change -> + let session = SessionChange.merge current_session session_change in + let cookie_value = Session.to_json session in + Some (cookie_key, cookie_value) + | true, None -> + let cookie_value = Session.to_json (Session.create true) in + Some (cookie_key, cookie_value) + | false, Some session_change -> + let session = SessionChange.merge current_session session_change in + let cookie_value = Session.to_json session in + Some (cookie_key, cookie_value) + | false, None -> None + in + match cookie with + | None -> resp + | Some cookie -> Response.add_cookie_or_replace ~sign_with:signed_with cookie resp +;; + +let m ?(cookie_key = "_session") signed_with = + let open Lwt.Syntax in + let filter handler req = + let session = decode_session cookie_key signed_with req in + let env = req.Request.env in + let env = Context.add Env.key session env in + let req = { req with env } in + let* resp = handler req in + Lwt.return @@ persist_session session signed_with cookie_key resp + in + Rock.Middleware.create ~name:"session" ~filter +;; diff --git a/opium/src/middlewares/middleware_cookie_session.mli b/opium/src/middlewares/middleware_cookie_session.mli new file mode 100644 index 00000000..7919129a --- /dev/null +++ b/opium/src/middlewares/middleware_cookie_session.mli @@ -0,0 +1,5 @@ +exception Session_not_found + +val find : string -> Request.t -> string option +val set : string * string option -> Response.t -> Response.t +val m : ?cookie_key:string -> Cookie.Signer.t -> Rock.Middleware.t diff --git a/opium/src/opium.ml b/opium/src/opium.ml index 60032dd2..7c13bd8d 100644 --- a/opium/src/opium.ml +++ b/opium/src/opium.ml @@ -12,6 +12,13 @@ module Route = Route module Auth = Auth module Router = Middleware_router +module Session = struct + exception Session_not_found = Middleware_cookie_session.Session_not_found + + let find = Middleware_cookie_session.find + let set = Middleware_cookie_session.set +end + module Handler = struct let serve = Handler_serve.h end @@ -29,4 +36,5 @@ module Middleware = struct let method_required = Middleware_method_required.m let head = Middleware_head.m let basic_auth = Middleware_basic_auth.m + let cookie_session = Middleware_cookie_session.m end diff --git a/opium/src/opium.mli b/opium/src/opium.mli index 4b12acc6..0a9d91fd 100644 --- a/opium/src/opium.mli +++ b/opium/src/opium.mli @@ -20,6 +20,19 @@ module Router : sig val splat : Request.t -> string list end +module Session : sig + exception Session_not_found + + (** [find key req] returns the session value associated with the key [key] in the + current session. *) + val find : string -> Request.t -> string option + + (** [set session resp] returns a response [resp] that has a session value [session] + associated to it. Session is a tuple [(key, value)] where the value is optional. Use + [None] for the value to remove session values. *) + val set : string * string option -> Response.t -> Response.t +end + (** Collection of handlers commonly used to build Opium applications *) module Handler : sig (** [serve ?mime_type ?etag ?headers read] returns a handler that will serve the result @@ -240,4 +253,19 @@ module Middleware : sig -> auth_callback:(username:string -> password:string -> 'a option Lwt.t) -> unit -> Rock.Middleware.t + + (** {3 [cookie_session]} *) + + (** [cookie_session ?cookie_key signed_with] creates a middleware for handling sessions + where the actual session is stored in a signed cookie where the [cookie_key] is set + to "_session" by default. You have to provide cookie signer as [signed_with] + argument that is used by the middleware to sign and verify cookies. + + The session data is stored in the session cookie. The cookie is only signed, + therefore the data is readable by the client. + + The data size is very limited (up to 4 KB). In order to associate more data with a + session, store a reference in the cookie with this middleware and take care of + persisting the actual data with a cache or persistence service. *) + val cookie_session : ?cookie_key:string -> Cookie.Signer.t -> Rock.Middleware.t end diff --git a/opium/test/dune b/opium/test/dune index 7da069aa..f31de678 100644 --- a/opium/test/dune +++ b/opium/test/dune @@ -1,4 +1,4 @@ (tests - (names middleware_allow_cors request response route) + (names middleware_allow_cors middleware_cookie_session request response route) (libraries alcotest alcotest-lwt lwt opium) (package opium)) diff --git a/opium/test/middleware_cookie_session.ml b/opium/test/middleware_cookie_session.ml new file mode 100644 index 00000000..c4088e4d --- /dev/null +++ b/opium/test/middleware_cookie_session.ml @@ -0,0 +1,218 @@ +open Alcotest_lwt +open Lwt.Syntax + +let signer = Opium.Cookie.Signer.make "secret" + +let unsigned_session_cookie _ () = + let middleware = Opium.Middleware.cookie_session signer in + let req = + Opium.Request.get "" + (* default empty session with default test secret *) + |> Opium.Request.add_cookie ("_session", "{}") + in + let handler _ = + (* We don't set any session values *) + Lwt.return @@ Opium.Response.of_plain_text "" + in + let* response = Rock.Middleware.apply middleware handler req in + let cookie = Opium.Response.cookies response |> List.hd in + let cookie_value = cookie.Opium.Cookie.value in + (* Unsigned cookie fails silently, new session is started *) + Alcotest.( + check + (pair string string) + "responds with empty cookie" + ("_session", "{}.byiLJwVqMzg39fb251SaoN+19fo=") + cookie_value); + Lwt.return () +;; + +let invalid_session_cookie_signature _ () = + let middleware = Opium.Middleware.cookie_session signer in + let req = + Opium.Request.get "" + (* default empty session with default test secret *) + |> Opium.Request.add_cookie ("_session", "{}.ayiLJwVqMzg39fb251SaoN+19fo=") + in + let handler _ = + (* We don't set any session values *) + Lwt.return @@ Opium.Response.of_plain_text "" + in + let* response = Rock.Middleware.apply middleware handler req in + let cookie = Opium.Response.cookies response |> List.hd in + let cookie_value = cookie.Opium.Cookie.value in + (* Invalid signature fails silently, new session is started *) + Alcotest.( + check + (pair string string) + "responds with empty cookie" + ("_session", "{}.byiLJwVqMzg39fb251SaoN+19fo=") + cookie_value); + Lwt.return () +;; + +let invalid_session_cookie_value _ () = + let middleware = Opium.Middleware.cookie_session signer in + let req = + Opium.Request.get "" + (* default empty session with default test secret *) + |> Opium.Request.add_cookie + ("_session", "invalid content.byiLJwVqMzg39fb251SaoN+19fo=") + in + let handler _ = + (* We don't set any session values *) + Lwt.return @@ Opium.Response.of_plain_text "" + in + let* response = Rock.Middleware.apply middleware handler req in + let cookie = Opium.Response.cookies response |> List.hd in + let cookie_value = cookie.Opium.Cookie.value in + (* Invalid cookie value fails silently, new session is started *) + Alcotest.( + check + (pair string string) + "responds with empty cookie" + ("_session", "{}.byiLJwVqMzg39fb251SaoN+19fo=") + cookie_value); + Lwt.return () +;; + +let no_empty_cookie_set_if_already_present _ () = + let middleware = Opium.Middleware.cookie_session signer in + let req = + Opium.Request.get "" + (* default empty session with default test secret *) + |> Opium.Request.add_cookie ("_session", "{}.byiLJwVqMzg39fb251SaoN+19fo=") + in + let handler _ = + (* We don't set any session values *) + Lwt.return @@ Opium.Response.of_plain_text "" + in + let* response = Rock.Middleware.apply middleware handler req in + let cookies = Opium.Response.cookies response in + Alcotest.(check int "responds without cookie" 0 (List.length cookies)); + Lwt.return () +;; + +let empty_cookie_set _ () = + let middleware = Opium.Middleware.cookie_session signer in + let req = Opium.Request.get "" in + let handler _ = + (* We don't set any session values *) + Lwt.return @@ Opium.Response.of_plain_text "" + in + let* response = Rock.Middleware.apply middleware handler req in + let cookies = Opium.Response.cookies response in + Alcotest.(check int "responds with one cookie" 1 (List.length cookies)); + let cookie = Opium.Response.cookie "_session" response |> Option.get in + Alcotest.( + check + (pair string string) + "has empty content" + (* default empty session with default test secret *) + ("_session", "{}.byiLJwVqMzg39fb251SaoN+19fo=") + cookie.Opium.Cookie.value); + Lwt.return () +;; + +let cookie_set _ () = + let middleware = Opium.Middleware.cookie_session signer in + let req = Opium.Request.get "" in + let handler _ = + let resp = Opium.Response.of_plain_text "" in + Lwt.return @@ Opium.Session.set ("foo", Some "bar") resp + in + let* response = Rock.Middleware.apply middleware handler req in + let cookie = Opium.Response.cookies response |> List.hd in + let cookie_value = cookie.Opium.Cookie.value in + Alcotest.( + check + (pair string string) + "persists session values" + ("_session", {|{"foo":"bar"}.jE75kXj9sbZp6tP7oJLhrp9c/+w=|}) + cookie_value); + Lwt.return () +;; + +let session_persisted_across_requests _ () = + let middleware = Opium.Middleware.cookie_session signer in + let req = Opium.Request.get "" in + let handler _ = + let resp = Opium.Response.of_plain_text "" in + Lwt.return @@ Opium.Session.set ("foo", Some "bar") resp + in + let* response = Rock.Middleware.apply middleware handler req in + let cookies = Opium.Response.cookies response in + Alcotest.(check int "responds with exactly one cookie" 1 (List.length cookies)); + let cookie = Opium.Response.cookie "_session" response |> Option.get in + let cookie_value = cookie.Opium.Cookie.value in + Alcotest.( + check + (pair string string) + "persists session values" + ("_session", {|{"foo":"bar"}.jE75kXj9sbZp6tP7oJLhrp9c/+w=|}) + cookie_value); + let req = Opium.Request.get "" |> Opium.Request.add_cookie cookie.Opium.Cookie.value in + let handler req = + let session_value = Opium.Session.find "foo" req in + Alcotest.(check (option string) "has session value" (Some "bar") session_value); + let resp = + Opium.Response.of_plain_text "" + |> Opium.Session.set ("foo", None) + |> Opium.Session.set ("fooz", Some "other") + in + Lwt.return resp + in + let* response = Rock.Middleware.apply middleware handler req in + let cookies = Opium.Response.cookies response in + Alcotest.(check int "responds with exactly one cookie" 1 (List.length cookies)); + let cookie = Opium.Response.cookie "_session" response |> Option.get in + let cookie_value = cookie.Opium.Cookie.value in + Alcotest.( + check + (pair string string) + "persists session values" + ("_session", {|{"fooz":"other"}.VRJU0/vmwzPLrDU0zulQ7MojZUU=|}) + cookie_value); + let req = Opium.Request.get "" |> Opium.Request.add_cookie cookie.Opium.Cookie.value in + let handler req = + Alcotest.( + check + (option string) + "has deleted session value" + None + (Opium.Session.find "foo" req)); + Alcotest.( + check + (option string) + "has set session value" + (Some "other") + (Opium.Session.find "fooz" req)); + Lwt.return @@ Opium.Response.of_plain_text "" + in + let* _ = Rock.Middleware.apply middleware handler req in + Lwt.return () +;; + +let suite = + [ ( "session" + , [ test_case "unsigned session cookie" `Quick unsigned_session_cookie + ; test_case + "invalid session cookie signature" + `Quick + invalid_session_cookie_signature + ; test_case "invalid session cookie value" `Quick invalid_session_cookie_value + ; test_case + "no empty cookie set if already present" + `Quick + no_empty_cookie_set_if_already_present + ; test_case "empty cookie set" `Quick empty_cookie_set + ; test_case "cookie set" `Quick cookie_set + ; test_case + "session persisted across requests" + `Quick + session_persisted_across_requests + ] ) + ] +;; + +let () = Lwt_main.run (Alcotest_lwt.run "session" suite)