format code

examples/dune

@@ -12,7 +12,11 @@
  (name echo)
  (flags :standard -warn-error -a+8)
  (modules echo vfs)
- (libraries tiny_httpd logs tiny_httpd_camlzip tiny_httpd.multipart-form-data))
+ (libraries
+  tiny_httpd
+  logs
+  tiny_httpd_camlzip
+  tiny_httpd.multipart-form-data))
 
 (executable
  (name writer)

examples/echo.ml

@@ -147,7 +147,9 @@ let () =
     (fun _ -> raise (Arg.Bad ""))
     "echo [option]*";
 
-  let server = Tiny_httpd.create ~addr:!addr ~port:!port_ ~max_connections:!j () in
+  let server =
+    Tiny_httpd.create ~addr:!addr ~port:!port_ ~max_connections:!j ()
+  in
 
   Tiny_httpd_camlzip.setup ~compress_above:1024 ~buf_size:(16 * 1024) server;
   let m_stats, get_stats = middleware_stat () in

src/Tiny_httpd.mli

@@ -1,8 +1,8 @@
 (** Tiny Http Server
 
     This library implements a very simple, basic HTTP/1.1 server using blocking
-    IOs and threads. Basic routing based is provided for convenience,
+    IOs and threads. Basic routing based is provided for convenience, so that
-    so that several handlers can be registered.
+    several handlers can be registered.
 
     It is possible to use a thread pool, see {!create}'s argument [new_thread].
 
@@ -18,12 +18,14 @@ let () =
         (* say hello *)
         S.add_route_handler ~meth:`GET server
           S.Route.(exact "hello" @/ string @/ return)
-    (fun name _req -> S.Response.make_string (Ok ("hello " ^name ^"!\n")));
+          (fun name _req ->
+            S.Response.make_string (Ok ("hello " ^ name ^ "!\n")));
 
         (* echo request *)
         S.add_route_handler server
           S.Route.(exact "echo" @/ return)
-    (fun req -> S.Response.make_string
+          (fun req ->
+            S.Response.make_string
               (Ok (Format.asprintf "echo:@ %a@." S.Request.pp req)));
 
         (* file upload *)
@@ -37,11 +39,11 @@ let () =
               S.Response.make_string (Ok "uploaded file")
             with e ->
               S.Response.fail ~code:500 "couldn't upload file: %s"
-            (Printexc.to_string e)
+                (Printexc.to_string e));
-      );
 
         (* run the server *)
-  Printf.printf "listening on http://%s:%d\n%!" (S.addr server) (S.port server);
+        Printf.printf "listening on http://%s:%d\n%!" (S.addr server)
+          (S.port server);
         match S.run server with
         | Ok () -> ()
         | Error e -> raise e
@@ -67,17 +69,12 @@ echo:
                Content-Length: 10
                Content-Type: application/x-www-form-urlencoded;
        path="/echo"; body="howdy y'all"}
-
+    ]} *)
-
-    ]}
-
-*)
 
 (** {2 Tiny buffer implementation}
 
     These buffers are used to avoid allocating too many byte arrays when
-    processing streams and parsing requests.
+    processing streams and parsing requests. *)
-*)
 
 module Buf = Buf
 
@@ -141,37 +138,42 @@ val create :
   t
 (** Create a new webserver using UNIX abstractions.
 
-    The server will not do anything until {!run} is called on it.
+    The server will not do anything until {!run} is called on it. Before
-    Before starting the server, one can use {!add_path_handler} and
+    starting the server, one can use {!add_path_handler} and {!set_top_handler}
-    {!set_top_handler} to specify how to handle incoming requests.
+    to specify how to handle incoming requests.
 
-    @param masksigpipe if true, block the signal {!Sys.sigpipe} which otherwise
+    @param masksigpipe
-    tends to kill client threads when they try to write on broken sockets.
+      if true, block the signal {!Sys.sigpipe} which otherwise tends to kill
-    Default: [true] except when on Windows, which defaults to [false].
+      client threads when they try to write on broken sockets. Default: [true]
+      except when on Windows, which defaults to [false].
 
     @param buf_size size for buffers (since 0.11)
 
-    @param new_thread a function used to spawn a new thread to handle a
+    @param new_thread
-    new client connection. By default it is {!Thread.create} but one
+      a function used to spawn a new thread to handle a new client connection.
-    could use a thread pool instead.
+      By default it is {!Thread.create} but one could use a thread pool instead.
-    See for example {{: https://github.com/c-cube/tiny-httpd-moonpool-bench/blob/0dcbbffb4fe34ea4ad79d46343ad0cebb69ca69f/examples/t1.ml#L31}
+      See for example
+      {{:https://github.com/c-cube/tiny-httpd-moonpool-bench/blob/0dcbbffb4fe34ea4ad79d46343ad0cebb69ca69f/examples/t1.ml#L31}
        this use of moonpool}.
 
     @param middlewares see {!add_middleware} for more details.
 
     @param max_connections maximum number of simultaneous connections.
-    @param timeout connection is closed if the socket does not do read or
+    @param timeout
-      write for the amount of second. Default: 0.0 which means no timeout.
+      connection is closed if the socket does not do read or write for the
-      timeout is not recommended when using proxy.
+      amount of second. Default: 0.0 which means no timeout. timeout is not
+      recommended when using proxy.
     @param addr address (IPv4 or IPv6) to listen on. Default ["127.0.0.1"].
     @param port to listen on. Default [8080].
-    @param sock an existing socket given to the server to listen on, e.g. by
+    @param sock
-      systemd on Linux (or launchd on macOS). If passed in, this socket will be
+      an existing socket given to the server to listen on, e.g. by systemd on
-      used instead of the [addr] and [port]. If not passed in, those will be
+      Linux (or launchd on macOS). If passed in, this socket will be used
-      used. This parameter exists since 0.10.
+      instead of the [addr] and [port]. If not passed in, those will be used.
-    @param enable_logging if true and [Logs] is installed, log requests. Default true.
+      This parameter exists since 0.10.
-      This parameter exists since 0.18. Does not affect debug-level logs.
+    @param enable_logging
+      if true and [Logs] is installed, log requests. Default true. This
+      parameter exists since 0.18. Does not affect debug-level logs.
 
-    @param get_time_s obtain the current timestamp in seconds.
+    @param get_time_s
-      This parameter exists since 0.11.
+      obtain the current timestamp in seconds. This parameter exists since 0.11.
 *)

src/bin/curly.ml

@@ -1,8 +1,8 @@
 module Result = struct
   include Result
 
-  let ( >>= ) :
+  let ( >>= ) : type a b e.
-      type a b e. (a, e) result -> (a -> (b, e) result) -> (b, e) result =
+      (a, e) result -> (a -> (b, e) result) -> (b, e) result =
    fun r f ->
     match r with
     | Ok x -> f x

src/camlzip/Tiny_httpd_camlzip.mli

@@ -1,22 +1,22 @@
 (** Middleware for compression.
 
-    This uses camlzip to provide deflate compression/decompression.
+    This uses camlzip to provide deflate compression/decompression. If
-    If installed, the middleware will compress responses' bodies
+    installed, the middleware will compress responses' bodies when they are
-    when they are streams or fixed-size above a given limit
+    streams or fixed-size above a given limit (but it will not compress small,
-    (but it will not compress small, fixed-size bodies).
+    fixed-size bodies). *)
-  *)
 
 val middleware :
   ?compress_above:int -> ?buf_size:int -> unit -> Server.Middleware.t
 (** Middleware responsible for deflate compression/decompression.
-    @param compress_above threshold, in bytes, above which a response body
+    @param compress_above
-      that has a known content-length is compressed. Stream bodies
+      threshold, in bytes, above which a response body that has a known
-      are always compressed.
+      content-length is compressed. Stream bodies are always compressed.
     @param buf_size size of the underlying buffer for compression/decompression
     @since 0.11 *)
 
 val setup : ?compress_above:int -> ?buf_size:int -> Server.t -> unit
-(** Install middleware for tiny_httpd to be able to encode/decode
+(** Install middleware for tiny_httpd to be able to encode/decode compressed
-    compressed streams
+    streams
     @param compress_above threshold above with string responses are compressed
-    @param buf_size size of the underlying buffer for compression/decompression *)
+    @param buf_size size of the underlying buffer for compression/decompression
+*)

src/core/IO.ml

@@ -1,12 +1,11 @@
 (** IO abstraction.
 
-    We abstract IO so we can support classic unix blocking IOs
+    We abstract IO so we can support classic unix blocking IOs with threads, and
-    with threads, and modern async IO with Eio.
+    modern async IO with Eio.
 
     {b NOTE}: experimental.
 
-    @since 0.14
+    @since 0.14 *)
-*)
 
 open Common_
 module Buf = Buf
@@ -17,7 +16,8 @@ module Output = struct
   include Iostream.Out_buf
 
   class of_unix_fd ?(close_noerr = false) ~closed ~(buf : Slice.t)
-    (fd : Unix.file_descr) : t =
+    (fd : Unix.file_descr) :
+    t =
     object
       inherit t_from_output ~bytes:buf.bytes ()
 
@@ -62,9 +62,9 @@ module Output = struct
   (** [chunk_encoding oc] makes a new channel that outputs its content into [oc]
       in chunk encoding form.
       @param close_rec if true, closing the result will also close [oc]
-      @param buf a buffer used to accumulate data into chunks.
+      @param buf
-        Chunks are emitted when [buf]'s size gets over a certain threshold,
+        a buffer used to accumulate data into chunks. Chunks are emitted when
-        or when [flush] is called.
+        [buf]'s size gets over a certain threshold, or when [flush] is called.
   *)
   let chunk_encoding ?(buf = Buf.create ()) ~close_rec (oc : #t) : t =
     (* write content of [buf] as a chunk if it's big enough.
@@ -305,9 +305,9 @@ module Input = struct
   let limit_size_to ~close_rec ~max_size ~bytes (arg : t) : t =
     reading_exactly_ ~size:max_size ~skip_on_close:false ~bytes ~close_rec arg
 
-  (** New stream that consumes exactly [size] bytes from the input.
+  (** New stream that consumes exactly [size] bytes from the input. If fewer
-        If fewer bytes are read before [close] is called, we read and discard
+      bytes are read before [close] is called, we read and discard the remaining
-        the remaining quota of bytes before [close] returns.
+      quota of bytes before [close] returns.
       @param close_rec if true, closing this will also close the input stream *)
   let reading_exactly ~close_rec ~size ~bytes (arg : t) : t =
     reading_exactly_ ~size ~close_rec ~skip_on_close:true ~bytes arg
@@ -394,16 +394,15 @@ module Writer = struct
   type t = { write: Output.t -> unit } [@@unboxed]
   (** Writer.
 
-    A writer is a push-based stream of bytes.
+      A writer is a push-based stream of bytes. Give it an output channel and it
-    Give it an output channel and it will write the bytes in it.
+      will write the bytes in it.
 
-    This is useful for responses: an http endpoint can return a writer
+      This is useful for responses: an http endpoint can return a writer as its
-    as its response's body; the writer is given access to the connection
+      response's body; the writer is given access to the connection to the
-    to the client and can write into it as if it were a regular
+      client and can write into it as if it were a regular [out_channel],
-    [out_channel], including controlling calls to [flush].
+      including controlling calls to [flush]. Tiny_httpd will convert these
-    Tiny_httpd will convert these writes into valid HTTP chunks.
+      writes into valid HTTP chunks.
-    @since 0.14
+      @since 0.14 *)
-    *)
 
   let[@inline] make ~write () : t = { write }
 
@@ -432,13 +431,14 @@ module TCP_server = struct
 
   type t = {
     endpoint: unit -> string * int;
-        (** Endpoint we listen on. This can only be called from within [serve]. *)
+        (** Endpoint we listen on. This can only be called from within [serve].
+        *)
     active_connections: unit -> int;
         (** Number of connections currently active *)
     running: unit -> bool;  (** Is the server currently running? *)
     stop: unit -> unit;
-        (** Ask the server to stop. This might not take effect immediately,
+        (** Ask the server to stop. This might not take effect immediately, and
-      and is idempotent. After this [server.running()] must return [false]. *)
+            is idempotent. After this [server.running()] must return [false]. *)
   }
   (** A running TCP server.
 
@@ -451,13 +451,12 @@ module TCP_server = struct
         (** Blocking call to listen for incoming connections and handle them.
             Uses the connection handler [handle] to handle individual client
             connections in individual threads/fibers/tasks.
-            @param after_init is called once with the server after the server
+            @param after_init
-            has started. *)
+              is called once with the server after the server has started. *)
   }
   (** A TCP server builder implementation.
 
       Calling [builder.serve ~after_init ~handle ()] starts a new TCP server on
-      an unspecified endpoint
+      an unspecified endpoint (most likely coming from the function returning
-      (most likely coming from the function returning this builder)
+      this builder) and returns the running server. *)
-      and returns the running server. *)
 end

src/core/buf.mli

@@ -3,8 +3,7 @@
     These buffers are used to avoid allocating too many byte arrays when
     processing streams and parsing requests.
 
-    @since 0.12
+    @since 0.12 *)
-*)
 
 type t
 

src/core/headers.mli

@@ -5,8 +5,8 @@
 type t = (string * string) list
 (** The header files of a request or response.
 
-      Neither the key nor the value can contain ['\r'] or ['\n'].
+    Neither the key nor the value can contain ['\r'] or ['\n']. See
-      See https://tools.ietf.org/html/rfc7230#section-3.2 *)
+    https://tools.ietf.org/html/rfc7230#section-3.2 *)
 
 val empty : t
 (** Empty list of headers.
@@ -20,8 +20,8 @@ val get_exn : ?f:(string -> string) -> string -> t -> string
 (** @raise Not_found *)
 
 val set : string -> string -> t -> t
-(** [set k v headers] sets the key [k] to value [v].
+(** [set k v headers] sets the key [k] to value [v]. It erases any previous
-      It erases any previous entry for [k] *)
+    entry for [k] *)
 
 val remove : string -> t -> t
 (** Remove the key from the headers, if present. *)

src/core/log.mli

@@ -5,13 +5,13 @@ val debug : ((('a, Format.formatter, unit, unit) format4 -> 'a) -> unit) -> unit
 val error : ((('a, Format.formatter, unit, unit) format4 -> 'a) -> unit) -> unit
 
 val setup : debug:bool -> unit -> unit
-(** Setup and enable logging. This should only ever be used in executables,
+(** Setup and enable logging. This should only ever be used in executables, not
-    not libraries.
+    libraries.
     @param debug if true, set logging to debug (otherwise info) *)
 
 val dummy : bool
 
 val fully_disable : unit -> unit
-(** Totally silence logs for tiny_httpd. With [Logs] installed this means setting
+(** Totally silence logs for tiny_httpd. With [Logs] installed this means
-    the level of the tiny_httpd source to [None]. 
+    setting the level of the tiny_httpd source to [None].
     @since 0.18 *)

src/core/meth.mli

@@ -1,8 +1,7 @@
 (** HTTP Methods *)
 
 type t = [ `GET | `PUT | `POST | `HEAD | `DELETE | `OPTIONS ]
-(** A HTTP method.
+(** A HTTP method. For now we only handle a subset of these.
-      For now we only handle a subset of these.
 
     See https://tools.ietf.org/html/rfc7231#section-4 *)
 

src/core/pool.mli

@@ -1,9 +1,9 @@
 (** Resource pool.
 
-    This pool is used for buffers. It can be used for other resources
+    This pool is used for buffers. It can be used for other resources but do
-    but do note that it assumes resources are still reasonably
+    note that it assumes resources are still reasonably cheap to produce and
-    cheap to produce and discard, and will never block waiting for
+    discard, and will never block waiting for a resource — it's not a good pool
-    a resource — it's not a good pool for DB connections.
+    for DB connections.
 
     @since 0.14. *)
 
@@ -14,19 +14,17 @@ val create :
   ?clear:('a -> unit) -> mk_item:(unit -> 'a) -> ?max_size:int -> unit -> 'a t
 (** Create a new pool.
     @param mk_item produce a new item in case the pool is empty
-    @param max_size maximum number of item in the pool before we start
+    @param max_size
-      dropping resources on the floor. This controls resource consumption.
+      maximum number of item in the pool before we start dropping resources on
-    @param clear a function called on items before recycling them.
+      the floor. This controls resource consumption.
- *)
+    @param clear a function called on items before recycling them. *)
 
 val with_resource : 'a t -> ('a -> 'b) -> 'b
-(** [with_resource pool f] runs [f x] with [x] a resource;
+(** [with_resource pool f] runs [f x] with [x] a resource; when [f] fails or
-    when [f] fails or returns, [x] is returned to the pool for
+    returns, [x] is returned to the pool for future reuse. *)
-    future reuse. *)
 
-(** Low level control over the pool.
+(** Low level control over the pool. This is easier to get wrong (e.g. releasing
-    This is easier to get wrong (e.g. releasing the same resource twice)
+    the same resource twice) so use with caution.
-    so use with caution.
     @since 0.18 *)
 module Raw : sig
   val acquire : 'a t -> 'a

src/core/request.mli

@@ -1,7 +1,7 @@
 (** Requests
 
-    Requests are sent by a client, e.g. a web browser or cURL.
+    Requests are sent by a client, e.g. a web browser or cURL. From the point of
-    From the point of view of the server, they're inputs. *)
+    view of the server, they're inputs. *)
 
 open Common_
 
@@ -25,16 +25,15 @@ type 'body t = private {
 }
 (** A request with method, path, host, headers, and a body, sent by a client.
 
-      The body is polymorphic because the request goes through
+    The body is polymorphic because the request goes through several
-      several transformations. First it has no body, as only the request
+    transformations. First it has no body, as only the request and headers are
-      and headers are read; then it has a stream body; then the body might be
+    read; then it has a stream body; then the body might be entirely read as a
-      entirely read as a string via {!read_body_full}.
+    string via {!read_body_full}.
 
     @since 0.6 The field [query] was added and contains the query parameters in ["?foo=bar,x=y"]
     @since 0.6 The field [path_components] is the part of the path that precedes [query] and is split on ["/"].
     @since 0.11 the type is a private alias
-      @since 0.11 the field [start_time] was added
+    @since 0.11 the field [start_time] was added *)
-  *)
 
 val add_meta : _ t -> 'a Hmap.key -> 'a -> unit
 (** Add metadata
@@ -71,8 +70,8 @@ val pp_with :
       which works even for stream bodies) *)
 
 val pp : Format.formatter -> string t -> unit
-(** Pretty print the request and its body. The exact format of this printing
+(** Pretty print the request and its body. The exact format of this printing is
-      is not specified. *)
+    not specified. *)
 
 val pp_ : Format.formatter -> _ t -> unit
 (** Pretty print the request without its body. The exact format of this printing
@@ -83,8 +82,8 @@ val headers : _ t -> Headers.t
 
 val get_header : ?f:(string -> string) -> _ t -> string -> string option
 (** [get_header req h] looks up header [h] in [req]. It returns [None] if the
-      header is not present. This is case insensitive and should be used
+    header is not present. This is case insensitive and should be used rather
-      rather than looking up [h] verbatim in [headers]. *)
+    than looking up [h] verbatim in [headers]. *)
 
 val get_header_int : _ t -> string -> int option
 (** Same as {!get_header} but also performs a string to integer conversion. *)
@@ -125,22 +124,20 @@ val body : 'b t -> 'b
 (** Request body, possibly empty. *)
 
 val start_time : _ t -> float
-(** time stamp (from {!Unix.gettimeofday}) after parsing the first line of the request
+(** time stamp (from {!Unix.gettimeofday}) after parsing the first line of the
+    request
     @since 0.11 *)
 
 val limit_body_size :
   max_size:int -> bytes:bytes -> IO.Input.t t -> IO.Input.t t
-(** Limit the body size to [max_size] bytes, or return
+(** Limit the body size to [max_size] bytes, or return a [413] error.
-      a [413] error.
+    @since 0.3 *)
-      @since 0.3
-  *)
 
 val read_body_full : ?bytes:bytes -> ?buf_size:int -> IO.Input.t t -> string t
 (** Read the whole body into a string. Potentially blocking.
 
     @param buf_size initial size of underlying buffer (since 0.11)
-    @param bytes the initial buffer (since 0.14)
+    @param bytes the initial buffer (since 0.14) *)
-    *)
 
 (**/**)
 

src/core/response.mli

@@ -1,25 +1,26 @@
 (** Responses
 
-    Responses are what a http server, such as {!Tiny_httpd}, send back to
+    Responses are what a http server, such as {!Tiny_httpd}, send back to the
-    the client to answer a {!Request.t}*)
+    client to answer a {!Request.t}*)
 
 type body =
   [ `String of string | `Stream of IO.Input.t | `Writer of IO.Writer.t | `Void ]
-(** Body of a response, either as a simple string,
+(** Body of a response, either as a simple string, or a stream of bytes, or
-      or a stream of bytes, or nothing (for server-sent events notably).
+    nothing (for server-sent events notably).
 
-      - [`String str] replies with a body set to this string, and a known content-length.
+    - [`String str] replies with a body set to this string, and a known
-      - [`Stream str] replies with a body made from this string, using chunked encoding.
+      content-length.
+    - [`Stream str] replies with a body made from this string, using chunked
+      encoding.
     - [`Void] replies with no body.
-      - [`Writer w] replies with a body created by the writer [w], using
+    - [`Writer w] replies with a body created by the writer [w], using a chunked
-          a chunked encoding.
+      encoding. It is available since 0.14. *)
-        It is available since 0.14.
-  *)
 
 type t = private {
   code: Response_code.t;  (** HTTP response code. See {!Response_code}. *)
   headers: Headers.t;
-      (** Headers of the reply. Some will be set by [Tiny_httpd] automatically. *)
+      (** Headers of the reply. Some will be set by [Tiny_httpd] automatically.
+      *)
   body: body;  (** Body of the response. Can be empty. *)
 }
 (** A response to send back to a client. *)
@@ -49,13 +50,13 @@ val set_code : Response_code.t -> t -> t
     @since 0.11 *)
 
 val make_raw : ?headers:Headers.t -> code:Response_code.t -> string -> t
-(** Make a response from its raw components, with a string body.
+(** Make a response from its raw components, with a string body. Use [""] to not
-      Use [""] to not send a body at all. *)
+    send a body at all. *)
 
 val make_raw_stream :
   ?headers:Headers.t -> code:Response_code.t -> IO.Input.t -> t
-(** Same as {!make_raw} but with a stream body. The body will be sent with
+(** Same as {!make_raw} but with a stream body. The body will be sent with the
-      the chunked transfer-encoding. *)
+    chunked transfer-encoding. *)
 
 val make_void : ?headers:Headers.t -> code:int -> unit -> t
 (** Return a response without a body at all.
@@ -69,9 +70,8 @@ val make :
 (** [make r] turns a result into a response.
 
     - [make (Ok body)] replies with [200] and the body.
-      - [make (Error (code,msg))] replies with the given error code
+    - [make (Error (code,msg))] replies with the given error code and message as
-        and message as body.
+      body. *)
-  *)
 
 val make_string :
   ?headers:Headers.t ->
@@ -95,19 +95,17 @@ val make_stream :
 (** Same as {!make} but with a stream body. *)
 
 val fail : ?headers:Headers.t -> code:int -> ('a, unit, string, t) format4 -> 'a
-(** Make the current request fail with the given code and message.
+(** Make the current request fail with the given code and message. Example:
-      Example: [fail ~code:404 "oh noes, %s not found" "waldo"].
+    [fail ~code:404 "oh noes, %s not found" "waldo"]. *)
-  *)
 
 exception Bad_req of int * string
 (** Exception raised by {!fail_raise} with the HTTP code and body *)
 
 val fail_raise : code:int -> ('a, unit, string, 'b) format4 -> 'a
 (** Similar to {!fail} but raises an exception that exits the current handler.
-    This should not be used outside of a (path) handler.
+    This should not be used outside of a (path) handler. Example:
-    Example: [fail_raise ~code:404 "oh noes, %s not found" "waldo"; never_executed()]
+    [fail_raise ~code:404 "oh noes, %s not found" "waldo"; never_executed()]
-    @raise Bad_req always
+    @raise Bad_req always *)
-  *)
 
 val pp_with :
   ?mask_header:(string -> bool) ->
@@ -117,15 +115,16 @@ val pp_with :
   Format.formatter ->
   t ->
   unit
-(** Pretty print the response. The exact format of this printing
+(** Pretty print the response. The exact format of this printing is not
-    is not specified.
+    specified.
-    @param mask_header function which is given each header name. If it
+    @param mask_header
-      returns [true], the header's value is masked. The presence of
+      function which is given each header name. If it returns [true], the
-      the header is still printed. Default [fun _ -> false].
+      header's value is masked. The presence of the header is still printed.
-    @param headers_to_mask a list of headers masked by default.
+      Default [fun _ -> false].
-      Default is ["set-cookie"].
+    @param headers_to_mask
-    @param pp_body body printer
+      a list of headers masked by default. Default is ["set-cookie"].
-      (default fully prints String bodies, but omits stream bodies)
+    @param pp_body
+      body printer (default fully prints String bodies, but omits stream bodies)
     @since 0.18 *)
 
 val pp : Format.formatter -> t -> unit

src/core/response_code.mli

@@ -12,8 +12,8 @@ val not_found : t
 (** The code [404] *)
 
 val descr : t -> string
-(** A description of some of the error codes.
+(** A description of some of the error codes. NOTE: this is not complete (yet).
-      NOTE: this is not complete (yet). *)
+*)
 
 val is_success : t -> bool
 (** [is_success code] is true iff [code] is in the [2xx] or [3xx] range.

src/core/route.mli

@@ -1,7 +1,7 @@
 (** Routing
 
-    Basic type-safe routing of handlers based on URL paths. This is optional,
+    Basic type-safe routing of handlers based on URL paths. This is optional, it
-    it is possible to only define the root handler with something like
+    is possible to only define the root handler with something like
     {{:https://github.com/anuragsoni/routes/} Routes}.
     @since 0.6 *)
 
@@ -27,18 +27,18 @@ val return : ('a, 'a) t
 (** Matches the empty path. *)
 
 val rest_of_path : (string -> 'a, 'a) t
-(** Matches a string, even containing ['/']. This will match
+(** Matches a string, even containing ['/']. This will match the entirety of the
-      the entirety of the remaining route.
+    remaining route.
     @since 0.7 *)
 
 val rest_of_path_urlencoded : (string -> 'a, 'a) t
-(** Matches a string, even containing ['/'], and URL-decode it (piecewise).
+(** Matches a string, even containing ['/'], and URL-decode it (piecewise). This
-      This will match the entirety of the remaining route.
+    will match the entirety of the remaining route.
     @since 0.7 *)
 
 val ( @/ ) : ('a, 'b) comp -> ('b, 'c) t -> ('a, 'c) t
-(** [comp / route] matches ["foo/bar/…"] iff [comp] matches ["foo"],
+(** [comp / route] matches ["foo/bar/…"] iff [comp] matches ["foo"], and [route]
-      and [route] matches ["bar/…"]. *)
+    matches ["bar/…"]. *)
 
 val exact_path : string -> ('a, 'b) t -> ('a, 'b) t
 (** [exact_path "foo/bar/..." r] is equivalent to

src/core/server.ml

@@ -50,8 +50,8 @@ module type UPGRADE_HANDLER = sig
     Unix.sockaddr ->
     unit Request.t ->
     (Headers.t * handshake_state, string) result
-  (** Perform the handshake and upgrade the connection. The returned
+  (** Perform the handshake and upgrade the connection. The returned code is
-      code is [101] alongside these headers. *)
+      [101] alongside these headers. *)
 
   val handle_connection : handshake_state -> IO.Input.t -> IO.Output.t -> unit
   (** Take control of the connection and take it from there *)

src/core/server.mli

@@ -5,33 +5,28 @@
 
     It is possible to use a thread pool, see {!create}'s argument [new_thread].
 
-    @since 0.13
+    @since 0.13 *)
-*)
 
 exception Bad_req of int * string
 (** Exception raised to exit request handlers with a code+error message *)
 
 (** {2 Middlewares}
 
-    A middleware can be inserted in a handler to modify or observe
+    A middleware can be inserted in a handler to modify or observe its behavior.
-    its behavior.
 
-    @since 0.11
+    @since 0.11 *)
-*)
 
 module Middleware : sig
   type handler = IO.Input.t Request.t -> resp:(Response.t -> unit) -> unit
-  (** Handlers are functions returning a response to a request.
+  (** Handlers are functions returning a response to a request. The response can
-      The response can be delayed, hence the use of a continuation
+      be delayed, hence the use of a continuation as the [resp] parameter. *)
-      as the [resp] parameter. *)
 
   type t = handler -> handler
   (** A middleware is a handler transformation.
 
-      It takes the existing handler [h],
+      It takes the existing handler [h], and returns a new one which, given a
-      and returns a new one which, given a query, modify it or log it
+      query, modify it or log it before passing it to [h], or fail. It can also
-      before passing it to [h], or fail. It can also log or modify or drop
+      log or modify or drop the response. *)
-      the response. *)
 
   val nil : t
   (** Trivial middleware that does nothing. *)
@@ -39,13 +34,13 @@ end
 
 (** A middleware that only considers the request's head+headers.
 
-    These middlewares are simpler than full {!Middleware.t} and
+    These middlewares are simpler than full {!Middleware.t} and work in more
-    work in more contexts.
+    contexts.
     @since 0.17 *)
 module Head_middleware : sig
   type t = { handle: 'a. 'a Request.t -> 'a Request.t }
-  (** A handler that takes the request, without its body,
+  (** A handler that takes the request, without its body, and possibly modifies
-    and possibly modifies it.
+      it.
       @since 0.17 *)
 
   val trivial : t
@@ -62,9 +57,9 @@ type t
 (** A backend that provides IO operations, network operations, etc.
 
     This is used to decouple tiny_httpd from the scheduler/IO library used to
-    actually open a TCP server and talk to clients. The classic way is
+    actually open a TCP server and talk to clients. The classic way is based on
-    based on {!Unix} and blocking IOs, but it's also possible to
+    {!Unix} and blocking IOs, but it's also possible to use an OCaml 5 library
-    use an OCaml 5 library using effects and non blocking IOs. *)
+    using effects and non blocking IOs. *)
 module type IO_BACKEND = sig
   val init_addr : unit -> string
   (** Initial TCP address *)
@@ -76,8 +71,8 @@ module type IO_BACKEND = sig
   (** Obtain the current timestamp in seconds. *)
 
   val tcp_server : unit -> IO.TCP_server.builder
-  (** TCP server builder, to create servers that can listen
+  (** TCP server builder, to create servers that can listen on a port and handle
-      on a port and handle clients. *)
+      clients. *)
 end
 
 val create_from :
@@ -90,31 +85,31 @@ val create_from :
   t
 (** Create a new webserver using provided backend.
 
-    The server will not do anything until {!run} is called on it.
+    The server will not do anything until {!run} is called on it. Before
-    Before starting the server, one can use {!add_path_handler} and
+    starting the server, one can use {!add_path_handler} and {!set_top_handler}
-    {!set_top_handler} to specify how to handle incoming requests.
+    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 0.18)
     @param middlewares see {!add_middleware} for more details.
-    @param enable_logging if true and [Logs] is installed,
+    @param enable_logging
-      emit logs via Logs (since 0.18).
+      if true and [Logs] is installed, emit logs via Logs (since 0.18). Default
-      Default [true].
+      [true].
 
-    @since 0.14
+    @since 0.14 *)
-*)
 
 val addr : t -> string
 (** Address on which the server listens. *)
 
 val is_ipv6 : t -> bool
-(** [is_ipv6 server] returns [true] iff the address of the server is an IPv6 address.
+(** [is_ipv6 server] returns [true] iff the address of the server is an IPv6
+    address.
     @since 0.3 *)
 
 val port : t -> int
-(** Port on which the server listens. Note that this might be different than
+(** Port on which the server listens. Note that this might be different than the
-    the port initially given if the port was [0] (meaning that the OS picks a
+    port initially given if the port was [0] (meaning that the OS picks a port
-    port for us). *)
+    for us). *)
 
 val active_connections : t -> int
 (** Number of currently active connections. *)
@@ -124,40 +119,35 @@ val add_decode_request_cb :
   (unit Request.t -> (unit Request.t * (IO.Input.t -> IO.Input.t)) option) ->
   unit
 [@@deprecated "use add_middleware"]
-(** Add a callback for every request.
+(** Add a callback for every request. The callback can provide a stream
-    The callback can provide a stream transformer and a new request (with
+    transformer and a new request (with modified headers, typically). A possible
-    modified headers, typically).
+    use is to handle decompression by looking for a [Transfer-Encoding] header
-    A possible use is to handle decompression by looking for a [Transfer-Encoding]
+    and returning a stream transformer that decompresses on the fly.
-    header and returning a stream transformer that decompresses on the fly.
 
-    @deprecated use {!add_middleware} instead
+    @deprecated use {!add_middleware} instead *)
-*)
 
 val add_encode_response_cb :
   t -> (unit Request.t -> Response.t -> Response.t option) -> unit
 [@@deprecated "use add_middleware"]
-(** Add a callback for every request/response pair.
+(** Add a callback for every request/response pair. Similarly to
-    Similarly to {!add_encode_response_cb} the callback can return a new
+    {!add_encode_response_cb} the callback can return a new response, for
-    response, for example to compress it.
+    example to compress it. The callback is given the query with only its
-    The callback is given the query with only its headers,
+    headers, as well as the current response.
-    as well as the current response.
 
-    @deprecated use {!add_middleware} instead
+    @deprecated use {!add_middleware} instead *)
-*)
 
 val add_middleware :
   stage:[ `Encoding | `Stage of int ] -> t -> Middleware.t -> unit
 (** Add a middleware to every request/response pair.
-    @param stage specify when middleware applies.
+    @param stage
-      Encoding comes first (outermost layer), then stages in increasing order.
+      specify when middleware applies. Encoding comes first (outermost layer),
+      then stages in increasing order.
     @raise Invalid_argument if stage is [`Stage n] where [n < 1]
-    @since 0.11
+    @since 0.11 *)
-*)
 
 val add_head_middleware : t -> Head_middleware.t -> unit
-(** Add a request-header only {!Head_middleware.t}.
+(** Add a request-header only {!Head_middleware.t}. This is called on requests,
-    This is called on requests, to modify them, and returns a new request
+    to modify them, and returns a new request immediately.
-    immediately.
     @since 0.18 *)
 
 (** {2 Request handlers} *)
@@ -166,13 +156,12 @@ val set_top_handler : t -> (IO.Input.t Request.t -> Response.t) -> unit
 (** Setup a handler called by default.
 
     This handler is called with any request not accepted by any handler
-    installed via {!add_path_handler}.
+    installed via {!add_path_handler}. If no top handler is installed, unhandled
-    If no top handler is installed, unhandled paths will return a [404] not found
+    paths will return a [404] not found
 
-    This used to take a [string Request.t] but it now takes a [byte_stream Request.t]
+    This used to take a [string Request.t] but it now takes a
-    since 0.14 . Use {!Request.read_body_full} to read the body into
+    [byte_stream Request.t] since 0.14 . Use {!Request.read_body_full} to read
-    a string if needed.
+    the body into a string if needed. *)
-*)
 
 val add_route_handler :
   ?accept:(unit Request.t -> (unit, Response_code.t * string) result) ->
@@ -183,23 +172,24 @@ val add_route_handler :
   'a ->
   unit
 (** [add_route_handler server Route.(exact "path" @/ string @/ int @/ return) f]
-    calls [f "foo" 42 request] when a [request] with path "path/foo/42/"
+    calls [f "foo" 42 request] when a [request] with path "path/foo/42/" is
-    is received.
+    received.
 
-    Note that the handlers are called in the reverse order of their addition,
+    Note that the handlers are called in the reverse order of their addition, so
-    so the last registered handler can override previously registered ones.
+    the last registered handler can override previously registered ones.
 
-    @param meth if provided, only accept requests with the given method.
+    @param meth
-    Typically one could react to [`GET] or [`PUT].
+      if provided, only accept requests with the given method. Typically one
-    @param accept should return [Ok()] if the given request (before its body
+      could react to [`GET] or [`PUT].
-    is read) should be accepted, [Error (code,message)] if it's to be rejected (e.g. because
+    @param accept
-    its content is too big, or for some permission error).
+      should return [Ok()] if the given request (before its body is read) should
-    See the {!http_of_dir} program for an example of how to use [accept] to
+      be accepted, [Error (code,message)] if it's to be rejected (e.g. because
-    filter uploads that are too large before the upload even starts.
+      its content is too big, or for some permission error). See the
-    The default always returns [Ok()], i.e. it accepts all requests.
+      {!http_of_dir} program for an example of how to use [accept] to filter
+      uploads that are too large before the upload even starts. The default
+      always returns [Ok()], i.e. it accepts all requests.
 
-    @since 0.6
+    @since 0.6 *)
-*)
 
 val add_route_handler_stream :
   ?accept:(unit Request.t -> (unit, Response_code.t * string) result) ->
@@ -209,10 +199,10 @@ val add_route_handler_stream :
   ('a, IO.Input.t Request.t -> Response.t) Route.t ->
   'a ->
   unit
-(** Similar to {!add_route_handler}, but where the body of the request
+(** Similar to {!add_route_handler}, but where the body of the request is a
-    is a stream of bytes that has not been read yet.
+    stream of bytes that has not been read yet. This is useful when one wants to
-    This is useful when one wants to stream the body directly into a parser,
+    stream the body directly into a parser, json decoder (such as [Jsonm]) or
-    json decoder (such as [Jsonm]) or into a file.
+    into a file.
     @since 0.6 *)
 
 (** {2 Server-sent events}
@@ -221,23 +211,23 @@ val add_route_handler_stream :
 
 (** A server-side function to generate of Server-sent events.
 
-    See {{: https://html.spec.whatwg.org/multipage/server-sent-events.html} the w3c page}
+    See
-    and {{: https://jvns.ca/blog/2021/01/12/day-36--server-sent-events-are-cool--and-a-fun-bug/}
+    {{:https://html.spec.whatwg.org/multipage/server-sent-events.html} the w3c
+     page} and
+    {{:https://jvns.ca/blog/2021/01/12/day-36--server-sent-events-are-cool--and-a-fun-bug/}
      this blog post}.
 
-    @since 0.9
+    @since 0.9 *)
-  *)
 module type SERVER_SENT_GENERATOR = sig
   val set_headers : Headers.t -> unit
-  (** Set headers of the response.
+  (** Set headers of the response. This is not mandatory but if used at all, it
-      This is not mandatory but if used at all, it must be called before
+      must be called before any call to {!send_event} (once events are sent the
-      any call to {!send_event} (once events are sent the response is
+      response is already sent too). *)
-      already sent too). *)
 
   val send_event :
     ?event:string -> ?id:string -> ?retry:string -> data:string -> unit -> unit
-  (** Send an event from the server.
+  (** Send an event from the server. If data is a multiline string, it will be
-      If data is a multiline string, it will be sent on separate "data:" lines. *)
+      sent on separate "data:" lines. *)
 
   val close : unit -> unit
   (** Close connection.
@@ -245,8 +235,8 @@ module type SERVER_SENT_GENERATOR = sig
 end
 
 type server_sent_generator = (module SERVER_SENT_GENERATOR)
-(** Server-sent event generator. This generates events that are forwarded to
+(** Server-sent event generator. This generates events that are forwarded to the
-    the client (e.g. the browser).
+    client (e.g. the browser).
     @since 0.9 *)
 
 val add_route_server_sent_handler :
@@ -258,12 +248,11 @@ val add_route_server_sent_handler :
   unit
 (** Add a handler on an endpoint, that serves server-sent events.
 
-    The callback is given a generator that can be used to send events
+    The callback is given a generator that can be used to send events as it
-    as it pleases. The connection is always closed by the client,
+    pleases. The connection is always closed by the client, and the accepted
-    and the accepted method is always [GET].
+    method is always [GET]. This will set the header "content-type" to
-    This will set the header "content-type" to "text/event-stream" automatically
+    "text/event-stream" automatically and reply with a 200 immediately. See
-    and reply with a 200 immediately.
+    {!server_sent_generator} for more details.
-    See {!server_sent_generator} for more details.
 
     This handler stays on the original thread (it is synchronous).
 
@@ -288,11 +277,11 @@ module type UPGRADE_HANDLER = sig
     unit Request.t ->
     (Headers.t * handshake_state, string) result
   (** Perform the handshake and upgrade the connection. This returns either
-      [Ok (resp_headers, state)] in case of success, in which case the
+      [Ok (resp_headers, state)] in case of success, in which case the server
-      server sends a [101] response with [resp_headers];
+      sends a [101] response with [resp_headers]; or it returns [Error log_msg]
-      or it returns [Error log_msg] if the the handshake fails, in which case
+      if the the handshake fails, in which case the connection is closed without
-      the connection is closed without further ado and [log_msg] is logged
+      further ado and [log_msg] is logged locally (but not returned to the
-      locally (but not returned to the client). *)
+      client). *)
 
   val handle_connection : handshake_state -> IO.Input.t -> IO.Output.t -> unit
   (** Take control of the connection and take it from ther.e *)
@@ -316,16 +305,16 @@ val running : t -> bool
     @since 0.14 *)
 
 val stop : t -> unit
-(** Ask the server to stop. This might not have an immediate effect
+(** Ask the server to stop. This might not have an immediate effect as {!run}
-    as {!run} might currently be waiting on IO. *)
+    might currently be waiting on IO. *)
 
 val run : ?after_init:(unit -> unit) -> t -> (unit, exn) result
-(** Run the main loop of the server, listening on a socket
+(** Run the main loop of the server, listening on a socket described at the
-    described at the server's creation time, using [new_thread] to
+    server's creation time, using [new_thread] to start a thread for each new
-    start a thread for each new client.
+    client.
 
-    This returns [Ok ()] if the server exits gracefully, or [Error e] if
+    This returns [Ok ()] if the server exits gracefully, or [Error e] if it
-    it exits with an error.
+    exits with an error.
 
     @param after_init is called after the server starts listening. since 0.13 .
 *)

src/core/util.mli

@@ -1,17 +1,16 @@
 (** {1 Some utils for writing web servers}
 
-    @since 0.2
+    @since 0.2 *)
-*)
 
 val percent_encode : ?skip:(char -> bool) -> string -> string
 (** Encode the string into a valid path following
     https://tools.ietf.org/html/rfc3986#section-2.1
-    @param skip if provided, allows to preserve some characters, e.g. '/' in a path.
+    @param skip
-*)
+      if provided, allows to preserve some characters, e.g. '/' in a path. *)
 
 val percent_decode : string -> string option
-(** Inverse operation of {!percent_encode}.
+(** Inverse operation of {!percent_encode}. Can fail since some strings are not
-    Can fail since some strings are not valid percent encodings. *)
+    valid percent encodings. *)
 
 val split_query : string -> string * string
 (** Split a path between the path and the query
@@ -30,10 +29,9 @@ val get_query : string -> string
     @since 0.4 *)
 
 val parse_query : string -> ((string * string) list, string) result
-(** Parse a query as a list of ['&'] or [';'] separated [key=value] pairs.
+(** Parse a query as a list of ['&'] or [';'] separated [key=value] pairs. The
-    The order might not be preserved.
+    order might not be preserved.
-    @since 0.3
+    @since 0.3 *)
-*)
 
 val show_sockaddr : Unix.sockaddr -> string
 (** Simple printer for socket addresses.

src/html/Tiny_httpd_html.ml

@@ -1,19 +1,18 @@
 (** HTML combinators.
 
-    This module provides combinators to produce html. It doesn't enforce
+    This module provides combinators to produce html. It doesn't enforce the
-    the well-formedness of the html, unlike Tyxml, but it's simple and should
+    well-formedness of the html, unlike Tyxml, but it's simple and should be
-    be reasonably efficient.
+    reasonably efficient.
-    @since 0.12
+    @since 0.12 *)
-*)
 
 include Html_
 (** @inline *)
 
 (** Write an HTML element to this output.
-    @param top if true, add DOCTYPE at the beginning. The top element should then
+    @param top
-    be a "html" tag.
+      if true, add DOCTYPE at the beginning. The top element should then be a
-    @since 0.14
+      "html" tag.
-    *)
+    @since 0.14 *)
 let to_output ?(top = false) (self : elt) (out : #IO.Output.t) : unit =
   let out = Out.create_of_out out in
   if top then Out.add_string out "<!DOCTYPE html>\n";
@@ -22,18 +21,18 @@ let to_output ?(top = false) (self : elt) (out : #IO.Output.t) : unit =
   Out.flush out
 
 (** Convert a HTML element to a string.
-    @param top if true, add DOCTYPE at the beginning. The top element should then
+    @param top
-    be a "html" tag. *)
+      if true, add DOCTYPE at the beginning. The top element should then be a
+      "html" tag. *)
 let to_string ?top (self : elt) : string =
   let buf = Buffer.create 64 in
   let out = IO.Output.of_buffer buf in
   to_output ?top self out;
   Buffer.contents buf
 
-(** Convert a list of HTML elements to a string.
+(** Convert a list of HTML elements to a string. This is designed for fragments
-    This is designed for fragments of HTML that are to be injected inside
+    of HTML that are to be injected inside a bigger context, as it's invalid to
-    a bigger context, as it's invalid to have multiple elements at the toplevel
+    have multiple elements at the toplevel of a HTML document. *)
-    of a HTML document. *)
 let to_string_l (l : elt list) =
   let buf = Buffer.create 64 in
   let out = Out.create_of_buffer buf in
@@ -57,7 +56,7 @@ let to_writer ?top (self : elt) : IO.Writer.t =
   let write (oc : #IO.Output.t) = to_output ?top self oc in
   IO.Writer.make ~write ()
 
-(** Convert a HTML element to a stream. This might just convert
+(** Convert a HTML element to a stream. This might just convert it to a string
-    it to a string first, do not assume it to be more efficient. *)
+    first, do not assume it to be more efficient. *)
 let[@inline] to_stream (self : elt) : IO.Input.t =
   IO.Input.of_string @@ to_string self

src/prometheus/tiny_httpd_prometheus.mli

@@ -1,11 +1,10 @@
 (** Expose metrics over HTTP in the prometheus format.
 
- This sub-library [tiny_httpd.prometheus] provides definitions
+    This sub-library [tiny_httpd.prometheus] provides definitions for counters,
- for counters, gauges, and histogram, and endpoints to expose
+    gauges, and histogram, and endpoints to expose them for
- them for {{: https://prometheus.io/} Prometheus} to scrape them.
+    {{:https://prometheus.io/} Prometheus} to scrape them.
 
- @since 0.16
+    @since 0.16 *)
- *)
 
 type tags = (string * string) list
 
@@ -17,13 +16,13 @@ module Registry : sig
   val create : unit -> t
 
   val on_will_emit : t -> (unit -> unit) -> unit
-  (** [on_will_emit registry f] calls [f()] every time
+  (** [on_will_emit registry f] calls [f()] every time [emit buf registry] is
-      [emit buf registry] is called (before the metrics start being emitted). This
+      called (before the metrics start being emitted). This is useful to update
-      is useful to update some metrics on demand. *)
+      some metrics on demand. *)
 
   val emit : Buffer.t -> t -> unit
-  (** Write metrics into the given buffer. The buffer will be
+  (** Write metrics into the given buffer. The buffer will be cleared first
-      cleared first thing. *)
+      thing. *)
 
   val emit_str : t -> string
 end
@@ -40,8 +39,8 @@ module Counter : sig
   val incr_by : t -> int -> unit
 
   val incr_to : t -> int -> unit
-  (** Increment to the given number. If it's lower than the current
+  (** Increment to the given number. If it's lower than the current value this
-      value this does nothing *)
+      does nothing *)
 end
 
 (** Gauges *)
@@ -88,7 +87,7 @@ module GC_metrics : sig
   val update : t -> unit
 
   val create_and_update_before_emit : Registry.t -> unit
-  (** [create_and_update_before_emit reg] creates new GC metrics,
+  (** [create_and_update_before_emit reg] creates new GC metrics, adds them to
-    adds them to the registry, and uses {!Registry.on_will_emit}
+      the registry, and uses {!Registry.on_will_emit} to {!update} the metrics
-    to {!update} the metrics every time the registry is polled. *)
+      every time the registry is polled. *)
 end

src/unix/dir.mli

@@ -1,29 +1,30 @@
 (** Serving static content from directories
 
-    This module provides the same functionality as the "http_of_dir" tool.
+    This module provides the same functionality as the "http_of_dir" tool. It
-    It exposes a directory (and its subdirectories), with the optional ability
+    exposes a directory (and its subdirectories), with the optional ability to
-    to delete or upload files.
+    delete or upload files.
 
     @since 0.11 *)
 
 (** behavior of static directory.
 
-    This controls what happens when the user requests the path to
+    This controls what happens when the user requests the path to a directory
-    a directory rather than a file. *)
+    rather than a file. *)
 type dir_behavior =
   | Index  (** Redirect to index.html if present, else fails. *)
   | Lists
       (** Lists content of directory. Be careful of security implications. *)
   | Index_or_lists
-      (** Redirect to index.html if present and lists content otherwise.
+      (** Redirect to index.html if present and lists content otherwise. This is
-      This is useful for tilde ("~") directories and other per-user behavior,
+          useful for tilde ("~") directories and other per-user behavior, but be
-      but be mindful of security implications *)
+          mindful of security implications *)
   | Forbidden
-      (** Forbid access to directory. This is suited for serving assets, for example. *)
+      (** Forbid access to directory. This is suited for serving assets, for
+          example. *)
 
 type hidden
-(** Type used to prevent users from building a config directly.
+(** Type used to prevent users from building a config directly. Use
-    Use {!default_config} or {!config} instead. *)
+    {!default_config} or {!config} instead. *)
 
 type config = {
   mutable download: bool;  (** Is downloading files allowed? *)
@@ -32,21 +33,17 @@ type config = {
   mutable delete: bool;  (** Is deleting a file allowed? (with method DELETE) *)
   mutable upload: bool;  (** Is uploading a file allowed? (with method PUT) *)
   mutable max_upload_size: int;
-      (** If {!upload} is true, this is the maximum size in bytes for
+      (** If {!upload} is true, this is the maximum size in bytes for uploaded
-      uploaded files. *)
+          files. *)
   _rest: hidden;  (** Just ignore this field. *)
 }
-(** configuration for static file handlers. This might get
+(** configuration for static file handlers. This might get more fields over
-    more fields over time. *)
+    time. *)
 
 val default_config : unit -> config
-(** default configuration: [
+(** default configuration:
-  { download=true
+    [ { download=true ; dir_behavior=Forbidden ; delete=false ; upload=false ;
-  ; dir_behavior=Forbidden
+     max_upload_size = 10 * 1024 * 1024 }] *)
-  ; delete=false
-  ; upload=false
-  ; max_upload_size = 10 * 1024 * 1024
-  }] *)
 
 val config :
   ?download:bool ->
@@ -61,16 +58,15 @@ val config :
 
 val add_dir_path :
   config:config -> dir:string -> prefix:string -> Server.t -> unit
-(** [add_dirpath ~config ~dir ~prefix server] adds route handle to the
+(** [add_dirpath ~config ~dir ~prefix server] adds route handle to the [server]
-    [server] to serve static files in [dir] when url starts with [prefix],
+    to serve static files in [dir] when url starts with [prefix], using the
-    using the given configuration [config]. *)
+    given configuration [config]. *)
 
 (** Virtual file system.
 
     This is used to emulate a file system from pure OCaml functions and data,
     e.g. for resources bundled inside the web server.
-    @since 0.12
+    @since 0.12 *)
-*)
 module type VFS = sig
   val descr : string
   (** Description of the VFS *)
@@ -78,12 +74,12 @@ module type VFS = sig
   val is_directory : string -> bool
 
   val contains : string -> bool
-  (** [file_exists vfs path] returns [true] if [path] points to a file
+  (** [file_exists vfs path] returns [true] if [path] points to a file or
-      or directory inside [vfs]. *)
+      directory inside [vfs]. *)
 
   val list_dir : string -> string array
-  (** List directory. This only returns basenames, the files need
+  (** List directory. This only returns basenames, the files need to be put in
-      to be put in the directory path using {!Filename.concat}. *)
+      the directory path using {!Filename.concat}. *)
 
   val delete : string -> unit
   (** Delete path *)
@@ -102,23 +98,19 @@ module type VFS = sig
 end
 
 val vfs_of_dir : string -> (module VFS)
-(** [vfs_of_dir dir] makes a virtual file system that reads from the
+(** [vfs_of_dir dir] makes a virtual file system that reads from the disk.
-    disk.
+    @since 0.12 *)
-    @since 0.12
-*)
 
 val add_vfs :
   config:config -> vfs:(module VFS) -> prefix:string -> Server.t -> unit
 (** Similar to {!add_dir_path} but using a virtual file system instead.
-    @since 0.12
+    @since 0.12 *)
-*)
 
-(** An embedded file system, as a list of files with (relative) paths.
+(** An embedded file system, as a list of files with (relative) paths. This is
-    This is useful in combination with the "tiny-httpd-mkfs" tool,
+    useful in combination with the "tiny-httpd-mkfs" tool, which embeds the
-    which embeds the files it's given into a OCaml module.
+    files it's given into a OCaml module.
 
-    @since 0.12
+    @since 0.12 *)
-*)
 module Embedded_fs : sig
   type t
   (** The pseudo-filesystem *)
@@ -127,8 +119,9 @@ module Embedded_fs : sig
 
   val add_file : ?mtime:float -> t -> path:string -> string -> unit
   (** Add file to the virtual file system.
-      @raise Invalid_argument if the path contains '..' or if it tries to
+      @raise Invalid_argument
-      make a directory out of an existing path that is a file. *)
+        if the path contains '..' or if it tries to make a directory out of an
+        existing path that is a file. *)
 
   val to_vfs : t -> (module VFS)
 end

src/ws/dune

@@ -1,27 +1,50 @@
 ; Set BUILD_TINY_HTTPD_OPTLEVEL to the -O<num> level.
 ; Defaults to 2, which means -O2 is the default C optimization flag.
 ; Use -1 to remove the -O<num> flag entirely.
+
 (rule
- (enabled_if (>= %{env:BUILD_TINY_HTTPD_OPTLEVEL=2} 0))
+ (enabled_if
+  (>= %{env:BUILD_TINY_HTTPD_OPTLEVEL=2} 0))
  (target optlevel.string)
- (deps (env_var BUILD_TINY_HTTPD_OPTLEVEL))
+ (deps
- (action (with-stdout-to %{target} (echo "-O%{env:BUILD_TINY_HTTPD_OPTLEVEL=2}"))))
+  (env_var BUILD_TINY_HTTPD_OPTLEVEL))
+ (action
+  (with-stdout-to
+   %{target}
+   (echo "-O%{env:BUILD_TINY_HTTPD_OPTLEVEL=2}"))))
+
 (rule
- (enabled_if (< %{env:BUILD_TINY_HTTPD_OPTLEVEL=2} 0))
+ (enabled_if
+  (< %{env:BUILD_TINY_HTTPD_OPTLEVEL=2} 0))
  (target optlevel.string)
- (deps (env_var BUILD_TINY_HTTPD_OPTLEVEL))
+ (deps
- (action (with-stdout-to %{target} (echo ""))))
+  (env_var BUILD_TINY_HTTPD_OPTLEVEL))
+ (action
+  (with-stdout-to
+   %{target}
+   (echo ""))))
 
 ; All compilers will include the optimization level.
 ; Non-MSVC compilers will include `-std=c99 -fPIC`.
+
 (rule
- (enabled_if (= %{ocaml-config:ccomp_type} msvc))
+ (enabled_if
+  (= %{ocaml-config:ccomp_type} msvc))
  (target cflags.sexp)
- (action (with-stdout-to %{target} (echo "(%{read:optlevel.string})"))))
+ (action
+  (with-stdout-to
+   %{target}
+   (echo "(%{read:optlevel.string})"))))
+
 (rule
- (enabled_if (not (= %{ocaml-config:ccomp_type} msvc)))
+ (enabled_if
+  (not
+   (= %{ocaml-config:ccomp_type} msvc)))
  (target cflags.sexp)
- (action (with-stdout-to %{target} (echo "(-std=c99 -fPIC %{read:optlevel.string})"))))
+ (action
+  (with-stdout-to
+   %{target}
+   (echo "(-std=c99 -fPIC %{read:optlevel.string})"))))
 
 (library
  (name tiny_httpd_ws)
@@ -32,7 +55,9 @@
  (foreign_stubs
   (language c)
   (names tiny_httpd_ws_stubs)
-  (flags :standard (:include cflags.sexp)))
+  (flags
+   :standard
+   (:include cflags.sexp)))
  (libraries
   (re_export tiny_httpd.core)
   threads))

src/ws/tiny_httpd_ws.ml

@@ -187,8 +187,8 @@ module Reader = struct
   type state =
     | Begin  (** At the beginning of a frame *)
     | Reading_frame of { mutable remaining_bytes: int; mutable num_read: int }
-        (** Currently reading the payload of a frame with [remaining_bytes]
+        (** Currently reading the payload of a frame with [remaining_bytes] left
-        left to read from the underlying [ic] *)
+            to read from the underlying [ic] *)
     | Close
 
   type t = {
@@ -414,7 +414,8 @@ let upgrade ic oc : _ * _ =
   in
   ws_ic, ws_oc
 
-(** Turn a regular connection handler (provided by the user) into a websocket upgrade handler *)
+(** Turn a regular connection handler (provided by the user) into a websocket
+    upgrade handler *)
 module Make_upgrade_handler (X : sig
   val accept_ws_protocol : string -> bool
   val handler : handler

src/ws/tiny_httpd_ws.mli

@@ -1,8 +1,7 @@
 (** Websockets for Tiny_httpd.
 
-    This sub-library ([tiny_httpd.ws]) exports a small implementation
+    This sub-library ([tiny_httpd.ws]) exports a small implementation for a
-    for a websocket server. It has no additional dependencies.
+    websocket server. It has no additional dependencies. *)
-    *)
 
 type handler = unit Request.t -> IO.Input.t -> IO.Output.t -> unit
 (** Websocket handler *)
@@ -11,8 +10,8 @@ val upgrade : IO.Input.t -> IO.Output.t -> IO.Input.t * IO.Output.t
 (** Upgrade a byte stream to the websocket framing protocol. *)
 
 exception Close_connection
-(** Exception that can be raised from IOs inside the handler,
+(** Exception that can be raised from IOs inside the handler, when the
-    when the connection is closed from underneath. *)
+    connection is closed from underneath. *)
 
 val add_route_handler :
   ?accept:(unit Request.t -> (unit, int * string) result) ->
@@ -23,8 +22,9 @@ val add_route_handler :
   handler ->
   unit
 (** Add a route handler for a websocket endpoint.
-    @param accept_ws_protocol decides whether this endpoint accepts the websocket protocol
+    @param accept_ws_protocol
-    sent by the client. Default accepts everything. *)
+      decides whether this endpoint accepts the websocket protocol sent by the
+      client. Default accepts everything. *)
 
 (**/**)