Expose server_connection functions to user

app/main.ml

@@ -49,8 +49,11 @@ let unicast_censurfridns_dk =
 let () =
   Miou_unix.run @@ fun () ->
   let daemon, resolver = Happy_eyeballs_miou_unix.make () in
-  let dns = Dns_client_miou_unix.create ~nameservers:(`Udp, [ google ]) resolver in
-  Happy_eyeballs_miou_unix.inject_resolver ~getaddrinfo:(getaddrinfo dns) resolver;
+  let dns =
+    Dns_client_miou_unix.create ~nameservers:(`Udp, [ google ]) resolver
+  in
+  Happy_eyeballs_miou_unix.inject_resolver ~getaddrinfo:(getaddrinfo dns)
+    resolver;
   let f _resp buf str = Buffer.add_string buf str; buf in
   match
     Httpcats.request ~resolver ~f ~uri:Sys.argv.(1) (Buffer.create 0x100)

app/pars.ml

@@ -253,7 +253,8 @@ let () =
     (`Udp, [ `Plaintext (Ipaddr.of_string_exn "8.8.8.8", 53) ])
   in
   let dns = Dns_client_miou_unix.create ~nameservers resolver in
-  Happy_eyeballs_miou_unix.inject_resolver ~getaddrinfo:(getaddrinfo dns) resolver;
+  Happy_eyeballs_miou_unix.inject_resolver ~getaddrinfo:(getaddrinfo dns)
+    resolver;
   let t = make ~resolver ~filenames in
   let prm = Miou.call_cc (run t uris) in
   let result = Miou.await prm in

examples/server.ml

@@ -80,28 +80,26 @@ let rec cleanup orphans =
   | None | Some None -> ()
   | Some (Some prm) -> Miou.await_exn prm; cleanup orphans
 
-let handler = function
-  | `V2 _ -> assert false
-  | `V1 reqd -> (
-      let open Httpaf in
-      let request = Reqd.request reqd in
-      match request.Request.target with
-      | "" | "/" | "/index.html" ->
-          let headers =
-            Headers.of_list
-              [
-                ("content-type", "text/html; charset=utf-8")
-              ; ("content-length", string_of_int (String.length index_html))
-              ]
-          in
-          let resp = Response.create ~headers `OK in
-          let body = Reqd.request_body reqd in
-          Body.close_reader body;
-          Reqd.respond_with_string reqd resp index_html
-      | _ ->
-          let headers = Headers.of_list [ ("content-length", "0") ] in
-          let resp = Response.create ~headers `Not_found in
-          Reqd.respond_with_string reqd resp "")
+let handler reqd =
+  let open Httpaf in
+  let request = Reqd.request reqd in
+  match request.Request.target with
+  | "" | "/" | "/index.html" ->
+      let headers =
+        Headers.of_list
+          [
+            ("content-type", "text/html; charset=utf-8")
+          ; ("content-length", string_of_int (String.length index_html))
+          ]
+      in
+      let resp = Response.create ~headers `OK in
+      let body = Reqd.request_body reqd in
+      Body.close_reader body;
+      Reqd.respond_with_string reqd resp index_html
+  | _ ->
+      let headers = Headers.of_list [ ("content-length", "0") ] in
+      let resp = Response.create ~headers `Not_found in
+      Reqd.respond_with_string reqd resp ""
 
 let server sockaddr = Httpcats.Server.clear ~handler sockaddr
 let () = Sys.set_signal Sys.sigpipe Sys.Signal_ignore

httpcats.opam

@@ -32,7 +32,7 @@ build: [
 
 synopsis: "A simple HTTP client using http/af, h2, and miou"
 pin-depends: [
-  [ "miou.dev" "git+https://git.robur.coop/robur/miou.git#ed5087b832797616df073bd8ec9baed2ec4e474c" ]
+  [ "miou.dev" "git+https://github.com/robur-coop/miou.git#ed5087b832797616df073bd8ec9baed2ec4e474c" ]
   [ "mirage-crypto.0.11.3" "git+https://github.com/dinosaure/mirage-crypto.git#c0e29117be2d081b50a5f1a789b16c77585324a3" ]
   [ "mirage-crypto-rng.0.11.3" "git+https://github.com/dinosaure/mirage-crypto.git#c0e29117be2d081b50a5f1a789b16c77585324a3" ]
   [ "alcotest.1.7.0" "git+https://github.com/dinosaure/alcotest.git#d591896a54ff4f652ac2d7d7194de1e0fb6e3aca" ]

src/dune

@@ -3,5 +3,5 @@
  (public_name httpcats)
  (modules httpcats http_miou_unix http_miou_client http_miou_server flow
    runtime)
- (libraries hxd.string hxd.core ca-certs happy-eyeballs-miou-unix dns-client-miou-unix
-   httpaf h2 tls-miou-unix))
+ (libraries hxd.string hxd.core ca-certs happy-eyeballs-miou-unix
+   dns-client-miou-unix httpaf h2 tls-miou-unix))

src/http_miou_server.ml

@@ -56,8 +56,8 @@ let request_from_h2 { H2.Request.meth; target; scheme; headers } =
 
 let default_error_handler ?request:_ _err _respond = ()
 
-let http_1_1_server_connection ~config ~user's_error_handler ~user's_handler
-    flow =
+let http_1_1_server_connection ?(config = Httpaf.Config.default)
+    ?(error_handler = default_error_handler) ~handler flow =
   let scheme = "http" in
   let read_buffer_size = config.Httpaf.Config.read_buffer_size in
   let error_handler ?request err respond =
@@ -71,21 +71,19 @@ let http_1_1_server_connection ~config ~user's_error_handler ~user's_handler
       let body = respond hdrs in
       `V1 body
     in
-    user's_error_handler ?request err respond;
+    error_handler ?request err respond;
     Runtime.terminate orphans
   in
   let request_handler reqd =
-    Runtime.flat_tasks @@ fun orphans ->
-    user's_handler (`V1 reqd);
-    Runtime.terminate orphans
+    Runtime.flat_tasks @@ fun orphans -> handler reqd; Runtime.terminate orphans
   in
   let conn =
     Httpaf.Server_connection.create ~config ~error_handler request_handler
   in
   Miou.await_exn (B.run conn ~read_buffer_size flow)
 
-let https_1_1_server_connection ~config ~user's_error_handler ~user's_handler
-    flow =
+let https_1_1_server_connection ?(config = Httpaf.Config.default)
+    ?(error_handler = default_error_handler) ~handler flow =
   let scheme = "https" in
   let read_buffer_size = config.Httpaf.Config.read_buffer_size in
   let error_handler ?request err respond =
@@ -99,20 +97,19 @@ let https_1_1_server_connection ~config ~user's_error_handler ~user's_handler
       let body = respond hdrs in
       `V1 body
     in
-    user's_error_handler ?request err respond;
+    error_handler ?request err respond;
     Runtime.terminate orphans
   in
   let request_handler reqd =
-    Runtime.flat_tasks @@ fun orphans ->
-    user's_handler (`V1 reqd);
-    Runtime.terminate orphans
+    Runtime.flat_tasks @@ fun orphans -> handler reqd; Runtime.terminate orphans
   in
   let conn =
     Httpaf.Server_connection.create ~config ~error_handler request_handler
   in
   Miou.await_exn (A.run conn ~read_buffer_size flow)
 
-let h2s_server_connection ~config ~user's_error_handler ~user's_handler flow =
+let h2s_server_connection ?(config = H2.Config.default)
+    ?(error_handler = default_error_handler) ~handler flow =
   let read_buffer_size = config.H2.Config.read_buffer_size in
   let error_handler ?request err respond =
     let request = Option.map request_from_h2 request in
@@ -121,13 +118,11 @@ let h2s_server_connection ~config ~user's_error_handler ~user's_handler flow =
     in
     Runtime.flat_tasks @@ fun orphans ->
     let respond hdrs = `V2 (respond hdrs) in
-    user's_error_handler ?request err respond;
+    error_handler ?request err respond;
     Runtime.terminate orphans
   in
   let request_handler reqd =
-    Runtime.flat_tasks @@ fun orphans ->
-    user's_handler (`V2 reqd);
-    Runtime.terminate orphans
+    Runtime.flat_tasks @@ fun orphans -> handler reqd; Runtime.terminate orphans
   in
   let conn =
     H2.Server_connection.create ~config ~error_handler request_handler
@@ -184,9 +179,7 @@ let pp_sockaddr ppf = function
   | Unix.ADDR_INET (inet_addr, port) ->
       Fmt.pf ppf "%s:%d" (Unix.string_of_inet_addr inet_addr) port
 
-let clear ?stop ?(config = Httpaf.Config.default) ?backlog
-    ?error_handler:(user's_error_handler = default_error_handler)
-    ~handler:user's_handler sockaddr =
+let clear ?stop ?config ?backlog ?error_handler ~handler sockaddr =
   let rec go orphans file_descr =
     match accept_or_stop ?stop file_descr with
     | None ->
@@ -199,8 +192,7 @@ let clear ?stop ?(config = Httpaf.Config.default) ?backlog
         clean_up orphans;
         let _ =
           Miou.call ~orphans @@ fun () ->
-          http_1_1_server_connection ~config ~user's_error_handler
-            ~user's_handler fd'
+          http_1_1_server_connection ?config ?error_handler ~handler fd'
         in
         go orphans file_descr
   in
@@ -225,8 +217,8 @@ let alpn tls =
   | None -> None
 
 let with_tls ?stop ?(config = `Both (Httpaf.Config.default, H2.Config.default))
-    ?backlog ?error_handler:(user's_error_handler = default_error_handler)
-    tls_config ~handler:user's_handler sockaddr =
+    ?backlog ?error_handler tls_config ~handler:(user's_handler : handler)
+    sockaddr =
   let rec go orphans file_descr =
     match accept_or_stop ?stop file_descr with
     | None -> Runtime.terminate orphans; Miou_unix.close file_descr
@@ -239,12 +231,14 @@ let with_tls ?stop ?(config = `Both (Httpaf.Config.default, H2.Config.default))
             begin
               match (config, alpn tls_flow) with
               | `Both (_, h2), Some "h2" | `H2 h2, (Some "h2" | None) ->
-                  h2s_server_connection ~config:h2 ~user's_error_handler
-                    ~user's_handler tls_flow
+                  let handler reqd = user's_handler (`V2 reqd) in
+                  h2s_server_connection ~config:h2 ?error_handler ~handler
+                    tls_flow
               | `Both (httpaf, _), Some "http/1.1"
               | `HTTP_1_1 httpaf, (Some "http/1.1" | None) ->
-                  https_1_1_server_connection ~config:httpaf
-                    ~user's_error_handler ~user's_handler tls_flow
+                  let handler reqd = user's_handler (`V1 reqd) in
+                  https_1_1_server_connection ~config:httpaf ?error_handler
+                    ~handler tls_flow
               | `Both _, None -> assert false
               | _, Some _protocol -> assert false
             end

src/http_miou_server.mli

@@ -24,15 +24,36 @@ type reqd = [ `V1 of Httpaf.Reqd.t | `V2 of H2.Reqd.t ]
 type error_handler = ?request:request -> error -> (Headers.t -> body) -> unit
 type handler = reqd -> unit
 
+val http_1_1_server_connection :
+     ?config:Httpaf.Config.t
+  -> ?error_handler:error_handler
+  -> handler:(Httpaf.Reqd.t -> unit)
+  -> Miou_unix.file_descr
+  -> unit
+
 val clear :
      ?stop:stop
   -> ?config:Httpaf.Config.t
   -> ?backlog:int
   -> ?error_handler:error_handler
-  -> handler:handler
+  -> handler:(Httpaf.Reqd.t -> unit)
   -> Unix.sockaddr
   -> unit
 
+val https_1_1_server_connection :
+     ?config:Httpaf.Config.t
+  -> ?error_handler:error_handler
+  -> handler:(Httpaf.Reqd.t -> unit)
+  -> Tls_miou_unix.t
+  -> unit
+
+val h2s_server_connection :
+     ?config:H2.Config.t
+  -> ?error_handler:error_handler
+  -> handler:(H2.Reqd.t -> unit)
+  -> Tls_miou_unix.t
+  -> unit
+
 val with_tls :
      ?stop:stop
   -> ?config:

test/test.ml

@@ -118,20 +118,18 @@ let secure_server ~seed ?(port = 8080) handler =
 let test00 =
   Alcotest.test_case "simple" `Quick @@ fun () ->
   Miou_unix.run ~domains @@ fun () ->
-  let handler = function
-    | `V2 _ -> assert false
-    | `V1 reqd ->
-        let open Httpaf in
-        let body = "Hello World!" in
-        let headers =
-          Headers.of_list
-            [
-              ("content-type", "text/plain")
-            ; ("content-length", string_of_int (String.length body))
-            ]
-        in
-        let resp = Response.create ~headers `OK in
-        Reqd.respond_with_string reqd resp body
+  let handler reqd =
+    let open Httpaf in
+    let body = "Hello World!" in
+    let headers =
+      Headers.of_list
+        [
+          ("content-type", "text/plain")
+        ; ("content-length", string_of_int (String.length body))
+        ]
+    in
+    let resp = Response.create ~headers `OK in
+    Reqd.respond_with_string reqd resp body
   in
   let stop, prm = server ~port:4000 handler in
   let daemon, resolver = Happy_eyeballs_miou_unix.make () in
@@ -166,29 +164,26 @@ let test01 =
   let g1 = Random.State.copy g0 in
   let max = 0x100000 in
   let chunk = 0x10 in
-  let handler = function
-    | `V2 _ -> assert false
-    | `V1 reqd ->
-        Logs.debug (fun m -> m "Got a request");
-        let open Httpaf in
-        let headers =
-          Headers.of_list
-            [
-              ("content-type", "text/plain")
-            ; ("content-length", string_of_int max)
-            ]
-        in
-        let resp = Response.create ~headers `OK in
-        let body = Reqd.respond_with_streaming reqd resp in
-        let rec go rest =
-          if rest <= 0 then Body.close_writer body
-          else
-            let len = min chunk rest in
-            let str = generate g0 len in
-            Body.write_string body str;
-            go (rest - len)
-        in
-        go max
+  let handler reqd =
+    Logs.debug (fun m -> m "Got a request");
+    let open Httpaf in
+    let headers =
+      Headers.of_list
+        [
+          ("content-type", "text/plain"); ("content-length", string_of_int max)
+        ]
+    in
+    let resp = Response.create ~headers `OK in
+    let body = Reqd.respond_with_streaming reqd resp in
+    let rec go rest =
+      if rest <= 0 then Body.close_writer body
+      else
+        let len = min chunk rest in
+        let str = generate g0 len in
+        Body.write_string body str;
+        go (rest - len)
+    in
+    go max
   in
   let stop, prm = server ~port:4000 handler in
   let daemon, resolver = Happy_eyeballs_miou_unix.make () in
@@ -244,24 +239,22 @@ let fold_h2 ~finally ~f acc body =
 let test02 =
   Alcotest.test_case "post" `Quick @@ fun () ->
   Miou_unix.run ~domains @@ fun () ->
-  let handler = function
-    | `V2 _ -> assert false
-    | `V1 reqd ->
-        let open Httpaf in
-        let f ctx str = Digestif.SHA1.feed_string ctx str in
-        let finally ctx =
-          let hash = Digestif.SHA1.(to_hex (get ctx)) in
-          let headers =
-            Headers.of_list
-              [
-                ("content-type", "text/plain")
-              ; ("content-length", string_of_int (String.length hash))
-              ]
-          in
-          let resp = Response.create ~headers `OK in
-          Reqd.respond_with_string reqd resp hash
-        in
-        fold_http_1_1 ~finally ~f Digestif.SHA1.empty (Reqd.request_body reqd)
+  let handler reqd =
+    let open Httpaf in
+    let f ctx str = Digestif.SHA1.feed_string ctx str in
+    let finally ctx =
+      let hash = Digestif.SHA1.(to_hex (get ctx)) in
+      let headers =
+        Headers.of_list
+          [
+            ("content-type", "text/plain")
+          ; ("content-length", string_of_int (String.length hash))
+          ]
+      in
+      let resp = Response.create ~headers `OK in
+      Reqd.respond_with_string reqd resp hash
+    in
+    fold_http_1_1 ~finally ~f Digestif.SHA1.empty (Reqd.request_body reqd)
   in
   let stop, prm = server ~port:4000 handler in
   let daemon, resolver = Happy_eyeballs_miou_unix.make () in