.ocamlformat

@@ -1,4 +1,4 @@
-version=0.23.0
+version=0.26.2
 profile=conventional
 break-struct=natural
 break-infix=fit-or-vertical

src/http_mirage_client.ml

@@ -6,6 +6,7 @@ let tls_config = Mimic.make ~name:"tls-config"
 open Lwt.Infix
 
 let src = Logs.Src.create "http_mirage_client" ~doc:"HTTP client"
+
 module Log = (val Logs.src_log src : Logs.LOG)
 
 type t = {
@@ -184,9 +185,7 @@ let single_http_1_1_request
       let str = Bigstringaf.substring ~off ~len ba in
       (* XXX(dinosaure): the copy must be done **before** any [>>=].
          The given [ba] is re-used by the [Httpaf] scheduler then. *)
-      let acc =
+      let acc = acc >>= fun acc -> f response acc str in
-        acc >>= fun acc -> f response acc str
-      in
       Httpaf.Body.schedule_read body ~on_read:(on_read on_eof acc)
         ~on_eof:(on_eof response acc) in
     let f_init = Lwt.return f_init in
@@ -215,27 +214,27 @@ let prepare_h2_headers headers host user_pass body_length =
      specially *)
   (* also note that "host" is no longer a thing, but :authority is -- so if
      we find a host header, we'll rephrase that as authority. *)
-  let headers = List.rev_map (fun (k, v) -> (String.lowercase_ascii k, v)) headers in
+  let headers =
+    List.rev_map (fun (k, v) -> String.lowercase_ascii k, v) headers in
   let headers = H2.Headers.of_rev_list headers in
   let headers, authority =
     match
-      H2.Headers.get headers "host",
+      H2.Headers.get headers "host", H2.Headers.get headers ":authority"
-      H2.Headers.get headers ":authority"
     with
     | None, None -> headers, host
     | Some h, None ->
-      Log.debug (fun m -> m "removing host header (inserting authority instead)");
+      Log.debug (fun m ->
-      H2.Headers.remove headers "host", h
+          m "removing host header (inserting authority instead)")
-    | None, Some a ->
+      ; H2.Headers.remove headers "host", h
-      H2.Headers.remove headers ":authority", a
+    | None, Some a -> H2.Headers.remove headers ":authority", a
     | Some h, Some a ->
       if String.equal h a then
         H2.Headers.remove (H2.Headers.remove headers ":authority") "host", h
       else begin
-        Log.warn (fun m -> m "authority header %s mismatches host %s (keeping both)" a h);
+        Log.warn (fun m ->
-        H2.Headers.remove headers ":authority", a
+            m "authority header %s mismatches host %s (keeping both)" a h)
-      end
+        ; H2.Headers.remove headers ":authority", a
-  in
+      end in
   let add hdr = H2.Headers.add_unless_exists hdr ?sensitive:None in
   let hdr = add H2.Headers.empty ":authority" authority in
   let hdr = H2.Headers.add_list hdr (H2.Headers.to_rev_list headers) in
@@ -269,9 +268,7 @@ let single_h2_request
       let str = Bigstringaf.substring ~off ~len ba in
       (* XXX(dinosaure): the copy must be done **before** any [>>=].
          The given [ba] is re-used by the [H2] scheduler then. *)
-      let acc =
+      let acc = acc >>= fun acc -> f response acc str in
-        acc >>= fun acc -> f response acc str
-      in
       H2.Body.Reader.schedule_read response_body ~on_read:(on_read on_eof acc)
         ~on_eof:(on_eof response acc) in
     let f_init = Lwt.return f_init in
@@ -290,7 +287,8 @@ let single_h2_request
       | `Exn e -> Error (`Msg ("Exception here: " ^ Printexc.to_string e)) in
     wakeup err in
   let conn =
-    H2.Client_connection.create ?config ?push_handler:None ~error_handler () in
+    H2.Client_connection.create ?config ?push_handler:None ~error_handler ()
+  in
   let request_body =
     H2.Client_connection.request conn req ~error_handler ~response_handler in
   Lwt.async (fun () -> Paf.run (module H2.Client_connection) conn flow)
@@ -386,7 +384,7 @@ let tls_config ?tls_config ?config authenticator user's_authenticator =
     (let ( let* ) = Result.bind in
      match tls_config with
      | Some cfg -> Ok (`Custom cfg)
-    | None -> (
+     | None ->
        let alpn_protocols =
          match config with
          | None -> ["h2"; "http/1.1"]
@@ -396,10 +394,9 @@ let tls_config ?tls_config ?config authenticator user's_authenticator =
          match authenticator, user's_authenticator with
          | Ok authenticator, None -> Ok authenticator
          | _, Some authenticator -> Ok authenticator
-        | (Error _ as err), None -> err
+         | (Error _ as err), None -> err in
-      in
        let* cfg = Tls.Config.client ~alpn_protocols ~authenticator () in
-      Ok (`Default cfg)))
+       Ok (`Default cfg))
 
 let resolve_location ~uri ~location =
   match String.split_on_char '/' location with

test/test.ml

@@ -1,8 +1,6 @@
 let reporter ppf =
   let report src level ~over k msgf =
-    let k _ =
+    let k _ = over () ; k () in
-      over () ;
-      k () in
     let with_metadata header _tags k ppf fmt =
       Format.kfprintf k ppf
         ("%a[%a]: " ^^ fmt ^^ "\n%!")
@@ -23,7 +21,8 @@ module Happy_eyeballs =
 
 module DNS_client =
   Dns_client_mirage.Make (Mirage_crypto_rng) (Time) (Mclock) (Pclock)
-    (Tcpip_stack_socket.V4V6) (Happy_eyeballs)
+    (Tcpip_stack_socket.V4V6)
+    (Happy_eyeballs)
 
 module Mimic_happy_eyeballs =
   Mimic_happy_eyeballs.Make (Tcpip_stack_socket.V4V6) (Happy_eyeballs)
@@ -135,11 +134,9 @@ let stack () =
   let ip = Ipaddr.V4.(Prefix.make 8 localhost) in
   let ipv4_only = true and ipv6_only = false in
   let* tcpv4v6 =
-    Tcpip_stack_socket.V4V6.TCP.connect ~ipv4_only ~ipv6_only ip None
+    Tcpip_stack_socket.V4V6.TCP.connect ~ipv4_only ~ipv6_only ip None in
-  in
   let* udpv4v6 =
-    Tcpip_stack_socket.V4V6.UDP.connect ~ipv4_only ~ipv6_only ip None
+    Tcpip_stack_socket.V4V6.UDP.connect ~ipv4_only ~ipv6_only ip None in
-  in
   Tcpip_stack_socket.V4V6.connect udpv4v6 tcpv4v6
 
 let test01 =