issue#348. Fixed CSRF tokens not sessioned when using scope and memory_sessions

src/dream.ml

@@ -260,9 +260,9 @@ let drop_session_field = Session.drop_session_field
 let all_session_values = Session.all_session_values
 let all_session_fields = all_session_values
 let invalidate_session = Session.invalidate_session
-let memory_sessions = Session.memory_sessions
-let cookie_sessions = Session.cookie_sessions
-let sql_sessions = Sql_session.sql_sessions
+let memory_sessions = Session.memory_sessions ()
+let cookie_sessions = Session.cookie_sessions ()
+let sql_sessions = Sql_session.sql_sessions ()
 let session_id = Session.session_id
 let session_label = Session.session_label
 let session_expires_at = Session.session_expires_at

src/dream.mli

@@ -1583,15 +1583,15 @@ val invalidate_session : request -> unit promise
 
 (** {2 Back ends} *)
 
-val memory_sessions : ?lifetime:float -> middleware
+val memory_sessions : middleware
 (** Stores sessions in server memory. Passes session IDs to clients in cookies.
     Session data is lost when the server process exits. *)
 
-val cookie_sessions : ?lifetime:float -> middleware
+val cookie_sessions : middleware
 (** Stores sessions in encrypted cookies. Use {!Dream.set_secret} to be able to
     decrypt cookies from previous server runs. *)
 
-val sql_sessions : ?lifetime:float -> middleware
+val sql_sessions : middleware
 (** Stores sessions in an SQL database. Passes session IDs to clients in
     cookies. Must be used under {!Dream.sql_pool}. Expects a table
 

src/server/router.ml

@@ -26,6 +26,9 @@ type token =
   | Param of string
   | Wildcard of string
 
+let log =
+  Log.sub_log "dream.router"
+
 let rec validate route = function
   | (Param "")::_ ->
     Printf.ksprintf failwith "Empty path parameter name in '%s'" route
@@ -141,28 +144,24 @@ let any pattern handler =
 let no_route =
   []
 
-let rec apply middlewares routes =
-  let rec compose handler = function
-    | [] -> handler
-    | middleware::more -> middleware @@ compose handler more
-  in
+let rec apply pipeline routes =
   routes
   |> List.flatten
   |> List.map (fun (pattern, node) ->
     let node =
       match node with
       | Handler (method_, handler) ->
-        Handler (method_, compose handler middlewares)
-      | Scope route -> Scope (apply middlewares [route])
+        Handler (method_, pipeline handler)
+      | Scope route -> Scope (apply pipeline [route])
     in
     pattern, node)
 
 let under prefix routes =
   [strip_empty_trailing_token (parse prefix), Scope (List.flatten routes)]
 
 let scope prefix middlewares routes =
-  under prefix [apply middlewares routes]
-
+  let pipeline = Message.pipeline middlewares in
+  under prefix [apply pipeline routes]
 
 
 let path_field : string list Message.field =
@@ -213,10 +212,6 @@ let params_field : (string * string) list Message.field =
     ()
 
 
-
-let log =
-  Log.sub_log "dream.router"
-
 let missing_param request name =
   let message = Printf.sprintf "Dream.param: missing path parameter %S" name in
   log.error (fun log -> log ~request "%s" message);

src/server/session.ml

@@ -341,10 +341,10 @@ let two_weeks =
 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) =
+  let memory_sessions ?(lifetime = two_weeks) () =
     middleware (Memory.back_end ~now lifetime)
 
-  let cookie_sessions ?(lifetime = two_weeks) =
+  let cookie_sessions ?(lifetime = two_weeks) () =
     middleware (Cookie.back_end ~now lifetime)
 end
 

src/sql/session.ml

@@ -211,5 +211,5 @@ let back_end lifetime = {
   send;
 }
 
-let sql_sessions ?(lifetime = Session.two_weeks) =
+let sql_sessions ?(lifetime = Session.two_weeks) () =
   Session.middleware (back_end lifetime)