Allow customizing the logger middleware source

src/dream.mli

@@ -1793,10 +1793,36 @@ val sql : request -> (Caqti_lwt.connection -> 'a promise) -> 'a promise
     OWASP {i Logging Cheat Sheet}} for a survey of security topics related to
     logging. *)
 
-val logger : middleware
+type ('a, 'b) conditional_log =
+  ((?request:request ->
+   ('a, Format.formatter, unit, 'b) format4 -> 'a) -> 'b) ->
+    unit
+(** Loggers. This type is difficult to read — instead, see {!Dream.val-error} for
+    usage. *)
+
+type log_level = [
+  | `Error
+  | `Warning
+  | `Info
+  | `Debug
+]
+(** Log levels, in order from most urgent to least. *)
+
+type sub_log = {
+  error   : 'a. ('a, unit) conditional_log;
+  warning : 'a. ('a, unit) conditional_log;
+  info    : 'a. ('a, unit) conditional_log;
+  debug   : 'a. ('a, unit) conditional_log;
+}
+(** Sub-logs. See {!Dream.val-sub_log} below. *)
+
+val logger : ?log:sub_log -> middleware
 (** Logs and times requests. Time spent logging is included. See example
     {{:https://github.com/camlworks/dream/tree/master/example/2-middleware#folders-and-files}
-    [2-middleware]}. *)
+    [2-middleware]}.
+
+    [~log] can be used to choose the sub-log used by this middleware. By
+    default, request logs use the ["dream.logger"] source. *)
 
 val log : ('a, Format.formatter, unit, unit) format4 -> 'a
 (** Formats a message and logs it. Disregard the obfuscated type: the first
@@ -1812,21 +1838,6 @@ val log : ('a, Format.formatter, unit, unit) format4 -> 'a
       Dream.log "Client: %s" (Dream.client request);
     ]} *)
 
-type ('a, 'b) conditional_log =
-  ((?request:request ->
-   ('a, Format.formatter, unit, 'b) format4 -> 'a) -> 'b) ->
-    unit
-(** Loggers. This type is difficult to read — instead, see {!Dream.val-error} for
-    usage. *)
-
-type log_level = [
-  | `Error
-  | `Warning
-  | `Info
-  | `Debug
-]
-(** Log levels, in order from most urgent to least. *)
-
 val error     : ('a, unit) conditional_log
 (** Formats a message and writes it to the log at level [`Error]. The inner
     formatting function is called only if the {{!initialize_log} current log
@@ -1849,14 +1860,6 @@ val debug     : ('a, unit) conditional_log
 (** Like {!Dream.val-error}, but for each of the other {{!log_level} log
     levels}. *)
 
-type sub_log = {
-  error   : 'a. ('a, unit) conditional_log;
-  warning : 'a. ('a, unit) conditional_log;
-  info    : 'a. ('a, unit) conditional_log;
-  debug   : 'a. ('a, unit) conditional_log;
-}
-(** Sub-logs. See {!Dream.val-sub_log} right below. *)
-
 val sub_log : ?level:[< log_level] -> string -> sub_log
 (** Creates a new sub-log with the given name. For example,
 

src/mirage/mirage.mli

@@ -1524,10 +1524,34 @@ module Make
       OWASP {i Logging Cheat Sheet}} for a survey of security topics related to
       logging. *)
 
-  val logger : middleware
+  type ('a, 'b) conditional_log =
+    ((?request:request -> ('a, Format.formatter, unit, 'b) format4 -> 'a) -> 'b) ->
+    unit
+  (** Loggers. This type is difficult to read — instead, see {!Dream.val-error} for
+      usage. *)
+
+  type log_level =
+    [ `Error
+    | `Warning
+    | `Info
+    | `Debug ]
+  (** Log levels, in order from most urgent to least. *)
+
+  type sub_log = {
+    error : 'a. ('a, unit) conditional_log;
+    warning : 'a. ('a, unit) conditional_log;
+    info : 'a. ('a, unit) conditional_log;
+    debug : 'a. ('a, unit) conditional_log;
+  }
+  (** Sub-logs. See {!Dream.val-sub_log} below. *)
+
+  val logger : ?log:sub_log -> middleware
   (** Logs and times requests. Time spent logging is included. See example
       {{:https://github.com/camlworks/dream/tree/master/example/2-middleware#folders-and-files}
-      [2-middleware]} \[{{:http://dream.as/2-middleware} playground}\]. *)
+      [2-middleware]} \[{{:http://dream.as/2-middleware} playground}\].
+
+      [~log] can be used to choose the sub-log used by this middleware. By
+      default, request logs use the ["dream.logger"] source. *)
 
   val log : ('a, Format.formatter, unit, unit) format4 -> 'a
   (** Formats a message and logs it. Disregard the obfuscated type: the first
@@ -1543,19 +1567,6 @@ module Make
         Dream.log "Client: %s" (Dream.client request);
       ]} *)
 
-  type ('a, 'b) conditional_log =
-    ((?request:request -> ('a, Format.formatter, unit, 'b) format4 -> 'a) -> 'b) ->
-    unit
-  (** Loggers. This type is difficult to read — instead, see {!Dream.val-error} for
-      usage. *)
-
-  type log_level =
-    [ `Error
-    | `Warning
-    | `Info
-    | `Debug ]
-  (** Log levels, in order from most urgent to least. *)
-
   val error : ('a, unit) conditional_log
   (** Formats a message and writes it to the log at level [`Error]. The inner
       formatting function is called only if the {{!initialize_log} current log
@@ -1579,14 +1590,6 @@ module Make
   (** Like {!Dream.val-error}, but for each of the other {{!log_level} log
       levels}. *)
 
-  type sub_log = {
-    error : 'a. ('a, unit) conditional_log;
-    warning : 'a. ('a, unit) conditional_log;
-    info : 'a. ('a, unit) conditional_log;
-    debug : 'a. ('a, unit) conditional_log;
-  }
-  (** Sub-logs. See {!Dream.val-sub_log} right below. *)
-
   val sub_log : ?level:[< log_level] -> string -> sub_log
   (** Creates a new sub-log with the given name. For example,
 

src/server/log.ml

@@ -462,7 +462,7 @@ let fd_field : int Message.field =
     end
 
   (* The request logging middleware. *)
-  let logger next_handler request =
+  let logger ?(log = log) next_handler request =
 
     let start = now () in
 

test/unit/logger.ml

@@ -0,0 +1,76 @@
+(* This file is part of Dream, released under the MIT license. See LICENSE.md
+   for details, or visit https://github.com/camlworks/dream.
+
+   Copyright 2026 funwithcthulhu *)
+
+
+
+let (-:) name f = Alcotest.test_case name `Quick f
+
+
+
+type counts = {
+  error : int;
+  warning : int;
+  info : int;
+  debug : int;
+}
+
+let counting_log () =
+  let error = ref 0
+  and warning = ref 0
+  and info = ref 0
+  and debug = ref 0 in
+
+  let log = {
+    Dream.error = (fun _ -> incr error);
+    warning = (fun _ -> incr warning);
+    info = (fun _ -> incr info);
+    debug = (fun _ -> incr debug);
+  } in
+
+  let counts () = {
+    error = !error;
+    warning = !warning;
+    info = !info;
+    debug = !debug;
+  } in
+
+  log, counts
+
+let run_logger ?(status = `OK) () =
+  let log, counts = counting_log () in
+  let handler _request = Dream.respond ~status "" in
+  Dream.request ""
+  |> Dream.logger ~log handler
+  |> Lwt_main.run
+  |> ignore;
+  counts ()
+
+
+
+let counts =
+  let pp ppf counts =
+    Format.fprintf ppf
+      "{ error = %i; warning = %i; info = %i; debug = %i }"
+      counts.error counts.warning counts.info counts.debug
+  in
+  Alcotest.testable pp (=)
+
+
+
+let tests = "logger", [
+
+  "custom log records success" -: begin fun () ->
+    run_logger ()
+    |> Alcotest.(check counts) "counts"
+      { error = 0; warning = 0; info = 2; debug = 0 }
+  end;
+
+  "custom log records server error" -: begin fun () ->
+    run_logger ~status:`Internal_Server_Error ()
+    |> Alcotest.(check counts) "counts"
+      { error = 1; warning = 0; info = 1; debug = 0 }
+  end;
+
+]

test/unit/unit.ml

@@ -9,4 +9,5 @@ let () =
   Alcotest.run "Dream" [
     Request.tests;
     Headers.tests;
+    Logger.tests;
   ]