~~

unikernel/server.ml

@@ -1,3 +1,5 @@
+open Syntax
+
 let src = Logs.Src.create "server"
 
 module Log = (val Logs.src_log src : Logs.LOG)
@@ -200,16 +202,18 @@ let hash_of_seed : type response request.
 
 let transmit_over_http : to_close:_ -> Mimic.flow -> Mimic.flow -> unit Lwt.t =
  fun ~to_close src dst ->
-  let open Lwt.Infix in
   let closed = Lwt_mvar.create_empty () in
   let rec loop ~src ~dst () =
-    Lwt.pick
-      [
-        Lwt_result.Infix.(
-          Mimic.read src >|= fun v -> (v :> [ `Closed | _ Mirage_flow.or_eof ]));
-        (Lwt_mvar.take closed >|= fun v -> Ok v);
-      ]
-    >>= function
+    let* res =
+      Lwt.pick
+        [
+          (let+? v = Mimic.read src in
+           (v :> [ `Closed | _ Mirage_flow.or_eof ]));
+          (let+ v = Lwt_mvar.take closed in
+           Ok v);
+        ]
+    in
+    match res with
     | Error err ->
         Log.err (fun m ->
             m "Got an error while we reading the source (CONNECT): %a."
@@ -224,8 +228,11 @@ let transmit_over_http : to_close:_ -> Mimic.flow -> Mimic.flow -> unit Lwt.t =
         Log.debug (fun m -> m "Transfer over HTTP:");
         Log.debug (fun m ->
             m "@[<hov>%a@]." (Hxd_string.pp Hxd.default) (Cstruct.to_string cs));
-        Mimic.write dst cs >>= function
-        | Ok () -> Lwt.pause () >>= loop ~src ~dst
+        let* res = Mimic.write dst cs in
+        match res with
+        | Ok () ->
+            let* () = Lwt.pause () in
+            loop ~src ~dst ()
         | Error err ->
             Log.err (fun m ->
                 m
@@ -235,9 +242,9 @@ let transmit_over_http : to_close:_ -> Mimic.flow -> Mimic.flow -> unit Lwt.t =
             if Lwt_mvar.is_empty closed then Lwt_mvar.put closed `Closed
             else Lwt.return_unit)
   in
-  Lwt.join [ loop ~src ~dst (); loop ~src:dst ~dst:src () ] >>= fun () ->
+  let* () = Lwt.join [ loop ~src ~dst (); loop ~src:dst ~dst:src () ] in
   to_close src;
-  Lwt.join [ Mimic.close src; Mimic.close dst ] >>= fun () ->
+  let* () = Lwt.join [ Mimic.close src; Mimic.close dst ] in
   Log.debug (fun m -> m "Connection closed properly on both side.");
   Lwt.return_unit
 
@@ -278,9 +285,9 @@ let connect_http_1_1 ~ctx ~authenticator ~to_close flow reqd =
   match H1.Headers.get request.H1.Request.headers "host" with
   | Some uri ->
       let uri = "http://" ^ uri in
-      let open Lwt.Infix in
       Lwt.async (fun () ->
-          Connect.create_connection ~ctx ~authenticator uri >>= function
+          let* res = Connect.create_connection ~ctx ~authenticator uri in
+          match res with
           | Ok dst ->
               let headers = H1.Headers.of_list [ ("connection", "close") ] in
               let response =
@@ -449,9 +456,9 @@ let connect_http_2_0 ~ctx ~authenticator ~to_close flow reqd =
   match H2.Headers.get request.H2.Request.headers "host" with
   | Some uri ->
       let uri = "http://" ^ uri in
-      let open Lwt.Infix in
       Lwt.async (fun () ->
-          Connect.create_connection ~ctx ~authenticator uri >>= function
+          let* res = Connect.create_connection ~ctx ~authenticator uri in
+          match res with
           | Ok dst ->
               let response = H2.Response.create `OK in
               H2.Reqd.respond_with_string reqd response "";