feat: add ?head_middlewares to create

src/Tiny_httpd.ml

@@ -30,7 +30,8 @@ end
 let create ?enable_logging ?(masksigpipe = not Sys.win32) ?max_connections
     ?(timeout = 0.0) ?buf_size ?(get_time_s = Unix.gettimeofday)
     ?(new_thread = fun f -> ignore (Thread.create f () : Thread.t))
-    ?(addr = "127.0.0.1") ?(port = 8080) ?sock ?middlewares () : t =
+    ?(addr = "127.0.0.1") ?(port = 8080) ?sock ?head_middlewares ?middlewares ()
+    : t =
   let max_connections = get_max_connection_ ?max_connections () in
   let server =
     {
@@ -65,4 +66,5 @@ let create ?enable_logging ?(masksigpipe = not Sys.win32) ?max_connections
     let tcp_server () = tcp_server_builder
   end in
   let backend = (module B : IO_BACKEND) in
-  Server.create_from ?enable_logging ?buf_size ?middlewares ~backend ()
+  Server.create_from ?enable_logging ?buf_size ?head_middlewares ?middlewares
+    ~backend ()

src/Tiny_httpd.mli

@@ -135,6 +135,7 @@ val create :
   ?addr:string ->
   ?port:int ->
   ?sock:Unix.file_descr ->
+  ?head_middlewares:Head_middleware.t list ->
   ?middlewares:([ `Encoding | `Stage of int ] * Middleware.t) list ->
   unit ->
   t

src/core/server.ml

@@ -88,6 +88,7 @@ type t = {
   mutable tcp_server: IO.TCP_server.t option;
   mutable handler: IO.Input.t Request.t -> Response.t;
       (** toplevel handler, if any *)
+  mutable head_middlewares: Head_middleware.t list;
   mutable middlewares: (int * Middleware.t) list;  (** Global middlewares *)
   mutable middlewares_sorted: (int * Middleware.t) list lazy_t;
       (** sorted version of {!middlewares} *)
@@ -128,6 +129,9 @@ let add_middleware ~stage self m =
   self.middlewares <- (stage, m) :: self.middlewares;
   self.middlewares_sorted <- lazy (sort_middlewares_ self.middlewares)
 
+let add_head_middleware (self : t) m : unit =
+  self.head_middlewares <- m :: self.head_middlewares
+
 let add_decode_request_cb self f =
   (* turn it into a middleware *)
   let m h req ~resp =
@@ -258,6 +262,7 @@ let add_route_server_sent_handler ?accept ?(middlewares = []) self route f =
 let add_upgrade_handler ?(accept = fun _ -> Ok ()) ?(middlewares = [])
     (self : t) route f : unit =
   let ph req : handler_result option =
+    let middlewares = List.rev_append self.head_middlewares middlewares in
     if req.Request.meth <> `GET then
       None
     else (
@@ -274,7 +279,7 @@ let add_upgrade_handler ?(accept = fun _ -> Ok ()) ?(middlewares = [])
 let clear_bytes_ bs = Bytes.fill bs 0 (Bytes.length bs) '\x00'
 
 let create_from ?(enable_logging = not Log.dummy) ?(buf_size = 16 * 1_024)
-    ?(middlewares = []) ~backend () : t =
+    ?(head_middlewares = []) ?(middlewares = []) ~backend () : t =
   let handler _req = Response.fail ~code:404 "no top handler" in
   let self =
     {
@@ -283,6 +288,7 @@ let create_from ?(enable_logging = not Log.dummy) ?(buf_size = 16 * 1_024)
       tcp_server = None;
       handler;
       path_handlers = [];
+      head_middlewares;
       middlewares = [];
       middlewares_sorted = lazy [];
       bytes_pool =

src/core/server.mli

@@ -83,6 +83,7 @@ end
 val create_from :
   ?enable_logging:bool ->
   ?buf_size:int ->
+  ?head_middlewares:Head_middleware.t list ->
   ?middlewares:([ `Encoding | `Stage of int ] * Middleware.t) list ->
   backend:(module IO_BACKEND) ->
   unit ->
@@ -94,6 +95,7 @@ val create_from :
     {!set_top_handler} to specify how to handle incoming requests.
 
     @param buf_size size for buffers (since 0.11)
+    @param head_middlewares see {!add_head_middleware} for details (since NEXT_RELEASE)
     @param middlewares see {!add_middleware} for more details.
     @param enable_logging if true and [Logs] is installed,
       emit logs via Logs (since NEXT_RELEASE).
@@ -152,6 +154,12 @@ val add_middleware :
     @since 0.11
 *)
 
+val add_head_middleware : t -> Head_middleware.t -> unit
+(** Add a request-header only {!Head_middleware.t}.
+    This is called on requests, to modify them, and returns a new request
+    immediately.
+    @since NEXT_RELEASE *)
+
 (** {2 Request handlers} *)
 
 val set_top_handler : t -> (IO.Input.t Request.t -> Response.t) -> unit