Require an initialization call for "Dream.memory_sessions"

example/b-session/README.md

@@ -8,7 +8,7 @@ Adding [sessions](https://aantron.github.io/dream/#sessions) is straightforward:
 let () =
   Dream.run
   @@ Dream.logger
-  @@ Dream.memory_sessions
+  @@ Dream.memory_sessions ()
   @@ fun request ->
 
     match Dream.session_field request "user" with
@@ -61,7 +61,8 @@ There are two other session back ends, which are persistent:
 - [`Dream.cookie_sessions`](https://aantron.github.io/dream/#val-cookie_sessions)
   stores session data in encrypted cookies. That is, session data is stored on
   clients, rather than on the server. You can replace `Dream.memory_sessions`
-  with `Dream.cookie_sessions` and it will work right away. However, if you
+  with `Dream.cookie_sessions` and it will work right away (except that
+  `Dream.cookie_sessions` don't require a call with `unit`). However, if you
   want to be able to decrypt sessions set by previous runs of the server, use
   the [`Dream.set_secret`](https://aantron.github.io/dream/#val-set_secret)
   middleware before `Dream.cookie_sessions`. If you don't, the server will be

example/b-session/session.ml

@@ -1,7 +1,7 @@
 let () =
   Dream.run
   @@ Dream.logger
-  @@ Dream.memory_sessions
+  @@ Dream.memory_sessions ()
   @@ fun request ->
 
     match Dream.session_field request "user" with

example/d-form/README.md

@@ -27,7 +27,7 @@ let show_form ?message request =
 let () =
   Dream.run
   @@ Dream.logger
-  @@ Dream.memory_sessions
+  @@ Dream.memory_sessions ()
   @@ Dream.router [
 
     Dream.get  "/"
@@ -113,4 +113,3 @@ the data is not sensitive, so we took a shortcut. See
 <br>
 
 [Up to the tutorial index](../#readme)
-

example/d-form/form.eml.ml

@@ -19,7 +19,7 @@ let show_form ?message request =
 let () =
   Dream.run
   @@ Dream.logger
-  @@ Dream.memory_sessions
+  @@ Dream.memory_sessions ()
   @@ Dream.router [
 
     Dream.get  "/"

example/g-upload/README.md

@@ -36,7 +36,7 @@ let report files =
 let () =
   Dream.run
   @@ Dream.logger
-  @@ Dream.memory_sessions
+  @@ Dream.memory_sessions ()
   @@ Dream.router [
 
     Dream.get  "/" (fun request ->

example/g-upload/upload.eml.ml

@@ -26,7 +26,7 @@ let report files =
 let () =
   Dream.run
   @@ Dream.logger
-  @@ Dream.memory_sessions
+  @@ Dream.memory_sessions ()
   @@ Dream.router [
 
     Dream.get  "/" (fun request ->

example/w-flash/README.md

@@ -53,7 +53,7 @@ let () =
   Dream.set_log_level "dream.flash" `Debug;
   Dream.run
   @@ Dream.logger
-  @@ Dream.memory_sessions
+  @@ Dream.memory_sessions ()
   @@ Dream.flash
   @@ Dream.router [
 

example/w-flash/flash.eml.ml

@@ -22,7 +22,7 @@ let () =
   Dream.set_log_level "dream.flash" `Debug;
   Dream.run
   @@ Dream.logger
-  @@ Dream.memory_sessions
+  @@ Dream.memory_sessions ()
   @@ Dream.flash
   @@ Dream.router [
 

example/w-multipart-dump/multipart_dump.eml.ml

@@ -13,7 +13,7 @@ let home request =
 let () =
   Dream.run
   @@ Dream.logger
-  @@ Dream.memory_sessions
+  @@ Dream.memory_sessions ()
   @@ Dream.router [
 
     Dream.get  "/" (fun request ->

example/w-upload-stream/README.md

@@ -36,7 +36,7 @@ let report files =
 let () =
   Dream.run
   @@ Dream.logger
-  @@ Dream.memory_sessions
+  @@ Dream.memory_sessions ()
   @@ Dream.router [
 
     Dream.get  "/" (fun request ->

example/w-upload-stream/upload_stream.eml.ml

@@ -26,7 +26,7 @@ let report files =
 let () =
   Dream.run
   @@ Dream.logger
-  @@ Dream.memory_sessions
+  @@ Dream.memory_sessions ()
   @@ Dream.router [
 
     Dream.get  "/" (fun request ->

src/dream.mli

@@ -78,7 +78,7 @@ and route
 
     {[
       Dream.router [
-        Dream.scope "/admin" [Dream.memory_sessions] [
+        Dream.scope "/admin" [Dream.memory_sessions ()] [
           Dream.get "/" admin_handler;
           Dream.get "/logout" admin_logout_handler;
         ];
@@ -1585,9 +1585,10 @@ val invalidate_session : request -> unit promise
 
 (** {2 Back ends} *)
 
-val memory_sessions : ?lifetime:float -> middleware
-(** Stores sessions in server memory. Passes session IDs to clients in cookies.
-    Session data is lost when the server process exits. *)
+val memory_sessions : ?lifetime:float -> unit -> middleware
+(** Stores sessions in server memory and requires initialization before
+    usage. Passes session IDs to clients in cookies. Session data is lost when
+    the server process exits. *)
 
 val cookie_sessions : ?lifetime:float -> middleware
 (** Stores sessions in encrypted cookies. Use {!Dream.set_secret} to be able to

src/mirage/mirage.mli

@@ -87,7 +87,7 @@ module Make
 
       {[
         Dream.router [
-          Dream.scope "/admin" [Dream.memory_sessions] [
+          Dream.scope "/admin" [Dream.memory_sessions ()] [
             Dream.get "/" admin_handler;
             Dream.get "/logout" admin_logout_handler;
           ];
@@ -1475,9 +1475,10 @@ module Make
 
   (** {2 Back ends} *)
 
-  val memory_sessions : ?lifetime:float -> middleware
-  (** Stores sessions in server memory. Passes session IDs to clients in cookies.
-      Session data is lost when the server process exits. *)
+  val memory_sessions : ?lifetime:float -> unit -> middleware
+  (** Stores sessions in server memory and requires initialization before
+      usage. Passes session IDs to clients in cookies. Session data is lost when
+      the server process exits. *)
 
   val cookie_sessions : ?lifetime:float -> middleware
   (** Stores sessions in encrypted cookies. Pass {!Dream.run} [~secret] to be able

src/server/session.ml

@@ -342,7 +342,12 @@ module Make (Pclock : Mirage_clock.PCLOCK) = struct
   let now () = Ptime.to_float_s (Ptime.v (Pclock.now_d_ps ()))
 
   let memory_sessions ?(lifetime = two_weeks) =
-    middleware (Memory.back_end ~now lifetime)
+    (* "Memory.back_end" returns a record that has a state (a hash table). If we
+       don't provide a way to initialize it before returning the middleware, the
+       state won't be shared among routes in "Dream.scope". *)
+    let back_end = (Memory.back_end ~now lifetime)
+    in
+    fun () -> middleware back_end
 
   let cookie_sessions ?(lifetime = two_weeks) =
     middleware (Cookie.back_end ~now lifetime)

test/expect/server/router.ml

@@ -88,29 +88,79 @@ let%expect_test _ =
     Path wildcard must be just '**'
     Path wildcard must be just '**' |}]
 
+(* Transfer a Dream session cookie from a response to a request. This function
+   helps testing Dream sessions.*)
+let forward_session_cookie (response: Dream.response) (request: Dream.request) =
+  match Dream.header response "Set-Cookie" with
+  | None -> ()
+  | Some payload ->
+     ignore @@ Str.search_forward
+                 (Str.regexp {|\(dream.session=.+\)?;|}) payload 0;
+     let session_cookie = Str.matched_group 1 payload
+     in
+     Dream.set_header request "Cookie" session_cookie
+
+let%expect_test _ =
+  let print_headers message =
+    Dream.all_headers message
+    |> List.iter (fun (k, v) -> Printf.printf "%s %s\n" k v)
+  in
+  let resp = Dream.response "testing"
+  in
+  Dream.set_cookie
+    ~encrypt:false resp (Dream.request "first req") "dream.session" "abc";
+  print_headers resp;
+  let req = Dream.request "second req"
+  in
+  forward_session_cookie resp req;
+  print_headers req;
+  match Dream.cookie ~decrypt:false req "dream.session" with
+  | None -> Printf.printf "Failed\n"
+  | Some x -> Printf.printf "%s\n" x;
+  [%expect {|
+    Set-Cookie dream.session=abc; Path=/; HttpOnly; SameSite=Lax
+    Cookie dream.session=abc; Path=/; HttpOnly
+    abc |}]
 
-
-let show ?(prefix = "/") ?(method_ = `GET) target router =
+(* Simulate a request to a given target, execute the router, print info about
+   the response and return it. If a Dream response is also given, the simulated
+   request should contain the same Dream session cookie. *)
+let show_response
+      ?(prefix = "/") ?(method_ = `GET) ?(response = None) target router =
   try
-    Dream.request ~method_ ~target ""
+    let request = Dream.request ~method_ ~target ""
+    in
+    (match response with
+     | None -> ()
+     | Some r -> forward_session_cookie r request);
+    request
     |> Dream.test ~prefix router
     |> fun response ->
-      let body =
-        Dream.client_stream response
-        |> Obj.magic (* TODO Needs to be replaced by exposing read_until_close
-                             as a function on abstract streams. *)
-        |> Dream_pure.Stream.read_until_close
-        |> Lwt_main.run
-      in
-      let status = Dream.status response in
-      Printf.printf "Response: %i %s\n"
-        (Dream.status_to_int status) (Dream.status_to_string status);
-      if body <> "" then
-        Printf.printf "%s\n" body
-      else
-        ()
+       let body =
+         Dream.client_stream response
+         |> Obj.magic (* TODO Needs to be replaced by exposing read_until_close
+                         as a function on abstract streams. *)
+         |> Dream_pure.Stream.read_until_close
+         |> Lwt_main.run
+       in
+       let status = Dream.status response in
+       Printf.printf "Response: %i %s\n"
+         (Dream.status_to_int status) (Dream.status_to_string status);
+       (if body <> "" then
+          Printf.printf "%s\n" body
+        else
+          ());
+       response
   with Failure message ->
-    print_endline message
+    print_endline message;
+    raise (Failure message)
+
+(* Simulate a request to a given target, execute the router, print info about
+   the response and return it. This is a simpler version of "show_response". *)
+let show ?(prefix = "/") ?(method_ = `GET) target router =
+  try
+    ignore @@ show_response ~prefix:prefix ~method_:method_ target router
+  with _ -> ()
 
 (* Basic router tests. *)
 
@@ -523,6 +573,47 @@ let%expect_test _ =
   [%expect {|
     Response: 404 Not Found |}]
 
+(* We want to check if different session backends are working properly with
+   "Dream.scope". *)
+let%expect_test _ =
+  let session_field = "testfield"
+  in
+  let app session_backend session_value =
+    Dream.router [
+        Dream.scope "/" [session_backend] [
+            Dream.get "/abc"
+              (fun req ->
+                let%lwt () =
+                  Dream.set_session_field req session_field session_value
+                in
+                Dream.respond "baz");
+            Dream.get "/def"
+              (fun req ->
+                Dream.respond
+                  (match Dream.session_field req session_field with
+                   | None -> "No value in the session"
+                   | Some x -> x))
+          ]
+      ]
+  in
+  let simulate_and_check app_with_session =
+    let resp_abc = show_response "/abc" app_with_session in
+    ignore @@ show_response ~response:(Some resp_abc) "/def" app_with_session
+  in
+  simulate_and_check (app Dream.cookie_sessions "100");
+  [%expect {|
+            Response: 200 OK
+            baz
+            Response: 200 OK
+            100 |}];
+  simulate_and_check (app (Dream.memory_sessions ()) "999");
+  [%expect {|
+            Response: 200 OK
+            baz
+            Response: 200 OK
+            999 |}]
+
+
 (* Router sequence works. *)
 
 (* let%expect_test _ =