Issue 90: Add additional instrumentation for flash messages.

example/w-flash/README.md

@@ -48,6 +48,7 @@ into cookies and reads them back out:
 
 ```ocaml
 let () =
+  Dream.set_log_level "dream.flash" `Debug;
   Dream.run
   @@ Dream.logger
   @@ Dream.memory_sessions
@@ -75,6 +76,16 @@ let () =
   @@ Dream.not_found
 ```
 
+The example configures a custom log level for flash messages using
+`Dream.set_log_level`. Setting this to "debug" means the server logs
+will display a log point summarizing the flash messages on every
+request, like this:
+
+```
+10.11.21 01:48:21.629       dream.log  INFO REQ 3 GET /result ::1:39808 Mozilla/5.0 (X11; Linux x86_64; rv:78.0) Gecko/20100101 Firefox/78.0
+10.11.21 01:48:21.629     dream.flash DEBUG REQ 3 Flash messages: Info: Some Message
+```
+
 <pre><code><b>$ cd example/w-flash</b>
 <b>$ npm install esy && npx esy</b>
 <b>$ npx esy start</b></code></pre>

example/w-flash/flash.eml.ml

@@ -18,6 +18,7 @@ let result request =
   </html>
 
 let () =
+  Dream.set_log_level "dream.flash" `Debug;
   Dream.run
   @@ Dream.logger
   @@ Dream.memory_sessions

src/middleware/flash.ml

@@ -19,33 +19,16 @@ let storage =
 let flash_cookie =
   "dream.flash"
 
-
-
-let flash_messages inner_handler request =
-  let outbox = ref [] in
-  let request = Dream.with_local storage outbox request in
-  let%lwt response = inner_handler request in
-  let entries = List.rev !outbox in
-  let existing = Dream.cookie flash_cookie request in
-  let response =
-    match existing, entries with
-    | None, [] -> response
-    | Some _, [] ->
-      Dream.set_cookie flash_cookie "" request response ~expires:0.
-    | _, _ ->
-      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 flash_cookie value request response ~max_age:five_minutes
-  in
-  Lwt.return response
-
-
+(* This is a soft limit. Encryption and base64 encoding increase the
+   original size of the cookie text by ~4/3.*)
+let content_byte_size_limit =
+  3072
 
 let (|>?) =
   Option.bind
 
+
+
 let flash request =
   let rec group x =
     match x with
@@ -76,3 +59,43 @@ let put_flash category message request =
       failwith message
   in
   outbox := (category, message)::!outbox
+
+
+
+let flash_messages inner_handler request =
+  log.debug (fun log ->
+    let current =
+      flash request
+      |> List.map (fun (p,q) -> p ^ ": " ^ q)
+      |> String.concat ", " in
+    if String.length current > 0 then
+      log ~request "Flash messages: %s" current
+    else
+      log ~request "%s" "No flash messages.");
+  let outbox = ref [] in
+  let request = Dream.with_local storage outbox request in
+  let existing = Dream.cookie flash_cookie request in
+  let%lwt response = inner_handler request in
+  let entries = List.rev !outbox in
+  let response =
+    match existing, entries with
+    | None, [] -> response
+    | Some _, [] ->
+      Dream.set_cookie flash_cookie "" request response ~expires:0.
+    | _, _ ->
+      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
+      let () =
+        if String.length value >= content_byte_size_limit then
+          log.warning (fun log ->
+            log ~request
+              "Flash messages exceed soft size limit (%d bytes)"
+              content_byte_size_limit)
+        else
+          ()
+      in
+      Dream.set_cookie flash_cookie value request response ~max_age:five_minutes
+  in
+  Lwt.return response

src/middleware/log.ml

@@ -369,6 +369,9 @@ let initialize_log
   ()
 
 let set_log_level name level =
+  (* If logging hasn't been initialized, trigger this so that
+     configuration of log levels can proceed. *)
+  let `Initialized = initialized () in
   let level = to_logs_level level in
   custom_log_levels :=
     (name, level)::(List.remove_assoc name !custom_log_levels);