Apply ocamlformat on our tests

test/test.ml

@@ -1,83 +1,126 @@
 (* Functoria *)
 
-module DNS_client = Dns_client_mirage.Make (Mirage_random_stdlib) (Time) (Mclock) (Pclock) (Tcpip_stack_socket.V4V6)
+module DNS_client =
-module Happy_eyeballs = Happy_eyeballs_mirage.Make (Time) (Mclock) (Tcpip_stack_socket.V4V6) (DNS_client)
+  Dns_client_mirage.Make (Mirage_random_stdlib) (Time) (Mclock) (Pclock)
-module Mimic_happy_eyeballs = Mimic_happy_eyeballs.Make (Tcpip_stack_socket.V4V6) (DNS_client) (Happy_eyeballs)
+    (Tcpip_stack_socket.V4V6)
+
+module Happy_eyeballs =
+  Happy_eyeballs_mirage.Make (Time) (Mclock) (Tcpip_stack_socket.V4V6)
+    (DNS_client)
+
+module Mimic_happy_eyeballs =
+  Mimic_happy_eyeballs.Make (Tcpip_stack_socket.V4V6) (DNS_client)
+    (Happy_eyeballs)
+
 module HTTP_server = Paf_mirage.Make (Tcpip_stack_socket.V4V6.TCP)
-module HTTP_client = Http_mirage_client.Make (Pclock) (Tcpip_stack_socket.V4V6.TCP) (Mimic_happy_eyeballs)
+
+module HTTP_client =
+  Http_mirage_client.Make (Pclock) (Tcpip_stack_socket.V4V6.TCP)
+    (Mimic_happy_eyeballs)
 
 let http_1_1_error_handler ?notify (ipaddr, port) ?request:_ error respond =
-  let contents = match error with
+  let contents =
+    match error with
     | `Bad_gateway -> Fmt.str "Bad gateway (%a:%d)" Ipaddr.pp ipaddr port
     | `Bad_request -> Fmt.str "Bad request (%a:%d)" Ipaddr.pp ipaddr port
-    | `Exn exn -> Fmt.str "Exception %S (%a:%d)" (Printexc.to_string exn) Ipaddr.pp ipaddr port
+    | `Exn exn ->
-    | `Internal_server_error -> Fmt.str "Internal server error (%a:%d)" Ipaddr.pp ipaddr port in
+      Fmt.str "Exception %S (%a:%d)" (Printexc.to_string exn) Ipaddr.pp ipaddr
+        port
+    | `Internal_server_error ->
+      Fmt.str "Internal server error (%a:%d)" Ipaddr.pp ipaddr port in
   let open Httpaf in
-  Option.iter (fun push -> push (Some ((ipaddr, port), error))) notify ;
+  Option.iter (fun push -> push (Some ((ipaddr, port), error))) notify
-  let headers = Headers.of_list
+  ; let headers =
-    [ "content-type", "text/plain"
+      Headers.of_list
-    ; "content-length", string_of_int (String.length contents)
+        [
-    ; "connection", "close" ] in
+          "content-type", "text/plain"
-  let body = respond headers in
+        ; "content-length", string_of_int (String.length contents)
-  Body.write_string body contents ;
+        ; "connection", "close"
-  Body.close_writer body
+        ] in
+    let body = respond headers in
+    Body.write_string body contents
+    ; Body.close_writer body
 
-let alpn_error_handler
+let alpn_error_handler :
-  : type reqd headers request response ro wo.
+    type reqd headers request response ro wo.
-    ?notify:(((Ipaddr.t * int) * Alpn.server_error) option -> unit) ->
+       ?notify:(((Ipaddr.t * int) * Alpn.server_error) option -> unit)
-    (Ipaddr.t * int) -> (reqd, headers, request, response, ro, wo) Alpn.protocol ->
+    -> Ipaddr.t * int
-    ?request:request -> Alpn.server_error -> (headers -> wo) -> unit
+    -> (reqd, headers, request, response, ro, wo) Alpn.protocol
-  = fun ?notify (ipaddr, port) protocol ?request:_ error respond ->
+    -> ?request:request
-    let contents = match error with
+    -> Alpn.server_error
-      | `Bad_gateway -> Fmt.str "Bad gateway (%a:%d)" Ipaddr.pp ipaddr port
+    -> (headers -> wo)
-      | `Bad_request -> Fmt.str "Bad request (%a:%d)" Ipaddr.pp ipaddr port
+    -> unit =
-      | `Exn exn -> Fmt.str "Exception %S (%a:%d)" (Printexc.to_string exn) Ipaddr.pp ipaddr port
+ fun ?notify (ipaddr, port) protocol ?request:_ error respond ->
-      | `Internal_server_error -> Fmt.str "Internal server error (%a:%d)" Ipaddr.pp ipaddr port in
+  let contents =
-    Option.iter (fun push -> push (Some ((ipaddr, port), error))) notify ;
+    match error with
-    let headers =
+    | `Bad_gateway -> Fmt.str "Bad gateway (%a:%d)" Ipaddr.pp ipaddr port
-      [ "content-type", "text/plain"
+    | `Bad_request -> Fmt.str "Bad request (%a:%d)" Ipaddr.pp ipaddr port
-      ; "content-length", string_of_int (String.length contents) ] in
+    | `Exn exn ->
+      Fmt.str "Exception %S (%a:%d)" (Printexc.to_string exn) Ipaddr.pp ipaddr
+        port
+    | `Internal_server_error ->
+      Fmt.str "Internal server error (%a:%d)" Ipaddr.pp ipaddr port in
+  Option.iter (fun push -> push (Some ((ipaddr, port), error))) notify
+  ; let headers =
+      [
+        "content-type", "text/plain"
+      ; "content-length", string_of_int (String.length contents)
+      ] in
     match protocol with
     | Alpn.HTTP_1_1 _ ->
       let open Httpaf in
       let headers = Headers.of_list (("connection", "close") :: headers) in
       let body = respond headers in
-      Body.write_string body contents ;
+      Body.write_string body contents
-      Body.close_writer body
+      ; Body.close_writer body
     | Alpn.H2 _ ->
       let open H2 in
       let headers = Headers.of_list headers in
       let body = respond headers in
-      H2.Body.Writer.write_string body contents ;
+      H2.Body.Writer.write_string body contents
-      H2.Body.Writer.close body
+      ; H2.Body.Writer.close body
 
-type alpn_handler =
+type alpn_handler = {
-   { handler : 'reqd 'headers 'request 'response 'ro 'wo.
+    handler:
-     'reqd -> ('reqd, 'headers, 'request, 'response, 'ro, 'wo) Alpn.protocol -> unit }
+      'reqd 'headers 'request 'response 'ro 'wo.
+         'reqd
+      -> ('reqd, 'headers, 'request, 'response, 'ro, 'wo) Alpn.protocol
+      -> unit
+}
 [@@unboxed]
 
 let server ?error ?stop stack = function
   | `HTTP_1_1 (port, handler) ->
     let open Lwt.Syntax in
     let+ http_server = HTTP_server.init ~port stack in
-    let http_service = HTTP_server.http_service ~error_handler:(http_1_1_error_handler ?notify:error)
+    let http_service =
-      (fun _flow (_ipaddr, _port) -> handler) in
+      HTTP_server.http_service
+        ~error_handler:(http_1_1_error_handler ?notify:error)
+        (fun _flow (_ipaddr, _port) -> handler) in
     HTTP_server.serve ?stop http_service http_server
   | `ALPN (tls, port, handler) ->
     let open Lwt.Syntax in
     let alpn_handler =
-      { Alpn.error= (fun edn protocol ?request v respond -> alpn_error_handler ?notify:error edn protocol ?request v respond)
+      {
-      ; Alpn.request= (fun _flow (_ipaddr, _port) reqd protocol -> handler.handler reqd protocol) } in
+        Alpn.error=
+          (fun edn protocol ?request v respond ->
+            alpn_error_handler ?notify:error edn protocol ?request v respond)
+      ; Alpn.request=
+          (fun _flow (_ipaddr, _port) reqd protocol ->
+            handler.handler reqd protocol)
+      } in
     let+ http_server = HTTP_server.init ~port stack in
     let alpn_service = HTTP_server.alpn_service ~tls alpn_handler in
     HTTP_server.serve ?stop alpn_service http_server
 
 let stack ipaddr =
   let open Lwt.Syntax in
-  let* tcpv4v6 = Tcpip_stack_socket.V4V6.TCP.connect ~ipv4_only:false ~ipv6_only:false
+  let* tcpv4v6 =
-    ipaddr None in
+    Tcpip_stack_socket.V4V6.TCP.connect ~ipv4_only:false ~ipv6_only:false ipaddr
-  let* udpv4v6 = Tcpip_stack_socket.V4V6.UDP.connect ~ipv4_only:false ~ipv6_only:false
+      None in
-    ipaddr None in
+  let* udpv4v6 =
+    Tcpip_stack_socket.V4V6.UDP.connect ~ipv4_only:false ~ipv6_only:false ipaddr
+      None in
   Tcpip_stack_socket.V4V6.connect udpv4v6 tcpv4v6
 
 let test01 =
@@ -87,21 +130,26 @@ let test01 =
   let handler reqd =
     let open Httpaf in
     let contents = "Hello World!" in
-    let headers = Headers.of_list
+    let headers =
-      [ "content-type", "text/plain"
+      Headers.of_list
-      ; "content-length", string_of_int (String.length contents)
+        [
-      ; "connection", "close" ] in
+          "content-type", "text/plain"
+        ; "content-length", string_of_int (String.length contents)
+        ; "connection", "close"
+        ] in
     let response = Response.create ~headers `OK in
     Reqd.respond_with_string reqd response contents in
   let* stack = stack Ipaddr.V4.Prefix.loopback in
   let happy_eyeballs = Happy_eyeballs.create stack in
   let* ctx = Mimic_happy_eyeballs.connect happy_eyeballs in
   let* t = HTTP_client.connect ctx in
-  let* `Initialized _thread = server ~stop (Tcpip_stack_socket.V4V6.tcp stack)
+  let* (`Initialized _thread) =
-    (`HTTP_1_1 (8080, handler)) in
+    server ~stop (Tcpip_stack_socket.V4V6.tcp stack) (`HTTP_1_1 (8080, handler))
-  let* result = Http_mirage_client.request t "http://localhost:8080/"
+  in
-    (fun _response buf str -> Buffer.add_string buf str ; Lwt.return buf)
+  let* result =
-    (Buffer.create 0x100) in
+    Http_mirage_client.request t "http://localhost:8080/"
+      (fun _response buf str -> Buffer.add_string buf str ; Lwt.return buf)
+      (Buffer.create 0x100) in
   match result with
   | Error err ->
     let* () = Lwt_switch.turn_off stop in
@@ -111,14 +159,15 @@ let test01 =
     let* () = Lwt_switch.turn_off stop in
     let* () = Tcpip_stack_socket.V4V6.disconnect stack in
     let body = Buffer.contents buf in
-    Alcotest.(check string) "body" "Hello World!" body ;
+    Alcotest.(check string) "body" "Hello World!" body
-    Lwt.return_unit
+    ; Lwt.return_unit
 
 let random_string ~len =
   let res = Bytes.create len in
   for i = 0 to len - 1 do
     Bytes.set res i (Char.chr (Random.bits () land 0xff))
-  done ; Bytes.unsafe_to_string res
+  done
+  ; Bytes.unsafe_to_string res
 
 let test02 =
   Alcotest_lwt.test_case "Repeat (POST)" `Quick @@ fun _sw () ->
@@ -126,30 +175,29 @@ let test02 =
   let stop = Lwt_switch.create () in
   let handler reqd =
     let open Httpaf in
-    let { Request.meth; _ } = Reqd.request reqd in
+    let {Request.meth; _} = Reqd.request reqd in
-    if meth <> `POST then invalid_arg "Invalid HTTP method" ;
+    if meth <> `POST then invalid_arg "Invalid HTTP method"
-    let headers = Headers.of_list
+    ; let headers = Headers.of_list ["content-type", "text/plain"] in
-      [ "content-type", "text/plain" ] in
+      let response = Response.create ~headers `OK in
-    let response = Response.create ~headers `OK in
+      let src = Reqd.request_body reqd in
-    let src = Reqd.request_body reqd in
+      let dst = Reqd.respond_with_streaming reqd response in
-    let dst = Reqd.respond_with_streaming reqd response in
+      let rec on_eof () = Body.close_reader src ; Body.close_writer dst
-    let rec on_eof () =
+      and on_read buf ~off ~len =
-      Body.close_reader src ;
+        Body.write_bigstring dst ~off ~len buf
-      Body.close_writer dst
+        ; Body.schedule_read src ~on_eof ~on_read in
-    and on_read buf ~off ~len =
-      Body.write_bigstring dst ~off ~len buf ;
       Body.schedule_read src ~on_eof ~on_read in
-    Body.schedule_read src ~on_eof ~on_read in
   let* stack = stack Ipaddr.V4.Prefix.loopback in
   let happy_eyeballs = Happy_eyeballs.create stack in
   let* ctx = Mimic_happy_eyeballs.connect happy_eyeballs in
   let* t = HTTP_client.connect ctx in
-  let* `Initialized _thread = server ~stop (Tcpip_stack_socket.V4V6.tcp stack)
+  let* (`Initialized _thread) =
-    (`HTTP_1_1 (8080, handler)) in
+    server ~stop (Tcpip_stack_socket.V4V6.tcp stack) (`HTTP_1_1 (8080, handler))
+  in
   let str = random_string ~len:0x1000 in
-  let* result = Http_mirage_client.request ~meth:`POST ~body:str t "http://localhost:8080/"
+  let* result =
-    (fun _response buf str -> Buffer.add_string buf str ; Lwt.return buf)
+    Http_mirage_client.request ~meth:`POST ~body:str t "http://localhost:8080/"
-    (Buffer.create 0x1000) in
+      (fun _response buf str -> Buffer.add_string buf str ; Lwt.return buf)
+      (Buffer.create 0x1000) in
   match result with
   | Error err ->
     let* () = Lwt_switch.turn_off stop in
@@ -159,9 +207,9 @@ let test02 =
     let* () = Lwt_switch.turn_off stop in
     let* () = Tcpip_stack_socket.V4V6.disconnect stack in
     let body = Buffer.contents buf in
-    Alcotest.(check string) "body" str body ;
+    Alcotest.(check string) "body" str body
-    Lwt.return_unit
+    ; Lwt.return_unit
 
- let () = Alcotest_lwt.run "http-mirage-client"
+let () =
-     [ "http/1.1", [ test01; test02 ] ]
+  Alcotest_lwt.run "http-mirage-client" ["http/1.1", [test01; test02]]
-   |> Lwt_main.run
+  |> Lwt_main.run