wip: bugfixes

.github/workflows/format.yml

@@ -0,0 +1,27 @@
+name: format
+
+on:
+  pull_request:
+  push:
+    branches:
+      - main
+
+  format:
+    name: format
+    strategy:
+      matrix:
+        ocaml-compiler:
+            - '5.3'
+    runs-on: 'ubuntu-latest'
+    steps:
+      - uses: actions/checkout@main
+      - name: Use OCaml ${{ matrix.ocaml-compiler }}
+        uses: ocaml/setup-ocaml@v3
+        with:
+          ocaml-compiler: ${{ matrix.ocaml-compiler }}
+          dune-cache: true
+          allow-prerelease-opam: true
+
+      - run: opam install ocamlformat.0.27.0
+      - run: opam exec -- make format-check
+

.github/workflows/main.yml

@@ -16,7 +16,7 @@ jobs:
             #- macos-latest
             #- windows-latest
         ocaml-compiler:
-          - 4.08.x
+          - 4.13.x
           - 4.14.x
           - 5.03.x
 

.gitignore

@@ -3,3 +3,5 @@ _build
 _opam
 *.install
 .merlin
+todo.md
+*.tmp

dune-project

@@ -23,7 +23,7 @@
     result
     hmap
     (iostream (>= 0.2))
-    (ocaml (>= 4.08))
+    (ocaml (>= 4.13))
     (odoc :with-doc)
     (logs :with-test)
     (conf-libcurl :with-test)

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

@@ -142,12 +142,14 @@ let () =
          "-p", Arg.Set_int port_, " set port";
          "--debug", Arg.Unit setup_logging, " enable debug";
          "-j", Arg.Set_int j, " maximum number of connections";
-        "--addr", Arg.Set_string addr, " binding address";
+         "--addr", Arg.Set_string addr, " binding address";
        ])
     (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

examples/echo_ws.ml

@@ -6,9 +6,9 @@ let setup_logging ~debug () =
   Logs.set_level ~all:true
   @@ Some
        (if debug then
-         Logs.Debug
-       else
-         Logs.Info)
+          Logs.Debug
+        else
+          Logs.Info)
 
 let handle_ws (req : unit Request.t) ic oc =
   Log.info (fun k ->

examples/sse_server.ml

@@ -36,9 +36,9 @@ let () =
         EV.send_event
           ~event:
             (if !tick then
-              "tick"
-            else
-              "tock")
+               "tick"
+             else
+               "tock")
           ~data:(Ptime.to_rfc3339 now) ();
         tick := not !tick;
 

src/Tiny_httpd.mli

@@ -1,83 +1,80 @@
 (** 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,
-    so that several handlers can be registered.
+    IOs and threads. Basic routing based is provided for convenience, so that
+    several handlers can be registered.
 
     It is possible to use a thread pool, see {!create}'s argument [new_thread].
 
     The [echo] example (see [src/examples/echo.ml]) demonstrates some of the
     features by declaring a few endpoints, including one for uploading files:
 
     {[
-module S = Tiny_httpd
-
-let () =
-  let server = S.create () in
-
-  (* 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")));
-
-  (* echo request *)
-  S.add_route_handler server
-    S.Route.(exact "echo" @/ return)
-    (fun req -> S.Response.make_string
-        (Ok (Format.asprintf "echo:@ %a@." S.Request.pp req)));
-
-  (* file upload *)
-  S.add_route_handler ~meth:`PUT server
-    S.Route.(exact "upload" @/ string_urlencoded @/ return)
-    (fun path req ->
-        try
-          let oc = open_out @@ "/tmp/" ^ path in
-          output_string oc req.S.Request.body;
-          flush oc;
-          S.Response.make_string (Ok "uploaded file")
-        with e ->
-          S.Response.fail ~code:500 "couldn't upload file: %s"
-            (Printexc.to_string e)
-      );
-
-  (* run the 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
+      module S = Tiny_httpd
+
+      let () =
+        let server = S.create () in
+
+        (* 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")));
+
+        (* echo request *)
+        S.add_route_handler server
+          S.Route.(exact "echo" @/ return)
+          (fun req ->
+            S.Response.make_string
+              (Ok (Format.asprintf "echo:@ %a@." S.Request.pp req)));
+
+        (* file upload *)
+        S.add_route_handler ~meth:`PUT server
+          S.Route.(exact "upload" @/ string_urlencoded @/ return)
+          (fun path req ->
+            try
+              let oc = open_out @@ "/tmp/" ^ path in
+              output_string oc req.S.Request.body;
+              flush oc;
+              S.Response.make_string (Ok "uploaded file")
+            with e ->
+              S.Response.fail ~code:500 "couldn't upload file: %s"
+                (Printexc.to_string e));
+
+        (* run the 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
     ]}
 
     It is then possible to query it using curl:
 
     {[
-$ dune exec src/examples/echo.exe &
-listening on http://127.0.0.1:8080
-
-# the path "hello/name" greets you.
-$ curl -X GET http://localhost:8080/hello/quadrarotaphile
-hello quadrarotaphile!
-
-# the path "echo" just prints the request.
-$ curl -X GET http://localhost:8080/echo --data "howdy y'all"
-echo:
-{meth=GET;
- headers=Host: localhost:8080
-         User-Agent: curl/7.66.0
-         Accept: */*
-         Content-Length: 10
-         Content-Type: application/x-www-form-urlencoded;
- path="/echo"; body="howdy y'all"}
-
-
-    ]}
-
-*)
+      $ dune exec src/examples/echo.exe &
+      listening on http://127.0.0.1:8080
+
+      # the path "hello/name" greets you.
+      $ curl -X GET http://localhost:8080/hello/quadrarotaphile
+      hello quadrarotaphile!
+
+      # the path "echo" just prints the request.
+      $ curl -X GET http://localhost:8080/echo --data "howdy y'all"
+      echo:
+      {meth=GET;
+       headers=Host: localhost:8080
+               User-Agent: curl/7.66.0
+               Accept: */*
+               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.
-    Before starting the server, one can use {!add_path_handler} and
-    {!set_top_handler} to specify how to handle incoming requests.
+    The server will not do anything until {!run} is called on it. Before
+    starting the server, one can use {!add_path_handler} and {!set_top_handler}
+    to specify how to handle incoming requests.
 
-    @param masksigpipe if true, block the signal {!Sys.sigpipe} which otherwise
-    tends to kill client threads when they try to write on broken sockets.
-    Default: [true] except when on Windows, which defaults to [false].
+    @param masksigpipe
+      if true, block the signal {!Sys.sigpipe} which otherwise tends to kill
+      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
-    new client connection. 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}
-      this use of moonpool}.
+    @param new_thread
+      a function used to spawn a new thread to handle a new client connection.
+      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}
+       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
-      write for the amount of second. Default: 0.0 which means no timeout.
-      timeout is not recommended when using proxy.
+    @param timeout
+      connection is closed if the socket does not do read or write for the
+      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
-      systemd on Linux (or launchd on macOS). If passed in, this socket will be
-      used instead of the [addr] and [port]. If not passed in, those will be
-      used. This parameter exists since 0.10.
-    @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.
-      This parameter exists since 0.11.
+    @param sock
+      an existing socket given to the server to listen on, e.g. by systemd on
+      Linux (or launchd on macOS). If passed in, this socket will be used
+      instead of the [addr] and [port]. If not passed in, those will be used.
+      This parameter exists since 0.10.
+    @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. This parameter exists since 0.11.
 *)

src/bin/curly.ml

@@ -1,8 +1,8 @@
 module Result = struct
   include Result
 
-  let ( >>= ) :
-      type a b e. (a, e) result -> (a -> (b, e) result) -> (b, e) result =
+  let ( >>= ) : type a b e.
+      (a, e) result -> (a -> (b, e) result) -> (b, e) result =
    fun r f ->
     match r with
     | Ok x -> f x
@@ -121,9 +121,9 @@ module Request = struct
         Header.to_cmd t.headers;
         [ t.url ];
         (if has_body t then
-          [ "--data-binary"; "@-" ]
-        else
-          []);
+           [ "--data-binary"; "@-" ]
+         else
+           []);
       ]
 
   let pp fmt t =

src/camlzip/Tiny_httpd_camlzip.mli

@@ -1,22 +1,22 @@
 (** Middleware for compression.
 
-    This uses camlzip to provide deflate compression/decompression.
-    If installed, the middleware will compress responses' bodies
-    when they are streams or fixed-size above a given limit
-    (but it will not compress small, fixed-size bodies).
-  *)
+    This uses camlzip to provide deflate compression/decompression. If
+    installed, the middleware will compress responses' bodies when they are
+    streams or fixed-size above a given limit (but it will not compress small,
+    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
-      that has a known content-length is compressed. Stream bodies
-      are always compressed.
+    @param compress_above
+      threshold, in bytes, above which a response body that has a known
+      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
-    compressed streams
+(** Install middleware for tiny_httpd to be able to encode/decode compressed
+    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
+*)