Merge pull request #994 from mseri/v5-backports

cohttp-async 5: backport compat to async/base v0.16

.github/workflows/workflow.yml

@@ -16,11 +16,7 @@ jobs:
           - macos-latest
           - ubuntu-latest
         ocaml-compiler:
-          - 4.08.x
-          - 4.09.x
-          - 4.10.x
-          - 4.11.x
-          - 4.12.x
+          - 4.14.x
 
     runs-on: ${{ matrix.os }}
 

CHANGES.md

@@ -1,3 +1,7 @@
+## v5.3.0 (2023-07-21)
+
+- cohttp-async: support for base/async v0.16
+
 ## v5.2.0 (2023-07-07)
 
 - cohttp-lwt server: call conn_closed before drainig the body of response on error (pirbo)

cohttp-async.opam

@@ -23,14 +23,14 @@ homepage: "https://github.com/mirage/ocaml-cohttp"
 doc: "https://mirage.github.io/ocaml-cohttp/"
 bug-reports: "https://github.com/mirage/ocaml-cohttp/issues"
 depends: [
-  "ocaml" {>= "4.08"}
+  "ocaml" {>= "4.14"}
   "dune" {>= "2.0"}
-  "async_kernel" {>= "v0.14.0"}
-  "async_unix" {>= "v0.14.0"}
-  "async" {>= "v0.14.0" & < "v0.16.0"}
-  "base" {>= "v0.11.0"}
-  "core" {with-test & < "v0.15.0"}
-  "core_unix" {>= "v0.14.0"}
+  "async_kernel" {>= "v0.16.0"}
+  "async_unix" {>= "v0.16.0"}
+  "async" {>= "v0.16.0"}
+  "base" {>= "v0.16.0"}
+  "core" {with-test}
+  "core_unix" {>= "v0.16.0"}
   "cohttp" {= version}
   "conduit-async" {>= "1.2.0"}
   "magic-mime"

cohttp-async/bin/cohttp_server_async.ml

@@ -50,7 +50,7 @@ let serve ~info ~docroot ~index uri path =
             | `No | `Unknown ->
                 (* Do a directory listing *)
                 Sys.ls_dir file_name
-                >>= Deferred.List.map ~f:(fun f ->
+                >>= Deferred.List.map ~how:`Parallel ~f:(fun f ->
                         let file_name = file_name / f in
                         try_with (fun () ->
                             Unix.stat file_name >>| fun stat ->

cohttp-async/src/body_raw.ml

@@ -67,7 +67,7 @@ let write_body write_body (body : t) writer =
   match body with
   | `Empty -> return ()
   | `String s -> write_body writer s
-  | `Strings sl -> Deferred.List.iter sl ~f:(write_body writer)
+  | `Strings sl -> Deferred.List.iter ~how:`Sequential sl ~f:(write_body writer)
   | `Pipe p -> Pipe.iter p ~f:(write_body writer)
 
 let pipe_of_body read_chunk ic =

cohttp-async/src/client.ml

@@ -123,7 +123,7 @@ let callv ?interrupt ?ssl_config uri reqs =
   Connection.connect ?interrupt ?ssl_config uri >>| fun connection ->
   let responses =
     Pipe.map' ~max_queue_length:1 reqs ~f:(fun reqs ->
-        Deferred.Queue.map reqs ~f:(fun (req, body) ->
+        Deferred.Queue.map ~how:`Sequential reqs ~f:(fun (req, body) ->
             Connection.request ~body connection req))
   in
   Pipe.closed responses

cohttp-async/src/io.ml

@@ -18,7 +18,7 @@ open Base
 open Async_kernel
 module Writer = Async_unix.Writer
 module Reader = Async_unix.Reader
-module Format = Caml.Format
+module Format = Stdlib.Format
 
 let log_src_name = "cohttp.async.io"
 let src = Logs.Src.create log_src_name ~doc:"Cohttp Async IO module"
@@ -42,7 +42,7 @@ let default_reporter () =
       k ()
     in
     msgf @@ fun ?header:_ ?tags:_ fmt ->
-    Format.kfprintf k fmtr Caml.("@[" ^^ fmt ^^ "@]@.")
+    Format.kfprintf k fmtr Stdlib.("@[" ^^ fmt ^^ "@]@.")
   in
   { Logs.report }
 
@@ -56,11 +56,11 @@ let set_log =
      Logs.set_reporter (default_reporter ()))
 
 let check_debug norm_fn debug_fn =
-  match Caml.Sys.getenv "COHTTP_DEBUG" with
+  match Stdlib.Sys.getenv "COHTTP_DEBUG" with
   | _ ->
       Lazy.force set_log;
       debug_fn
-  | exception Caml.Not_found -> norm_fn
+  | exception Stdlib.Not_found -> norm_fn
 
 type 'a t = 'a Deferred.t
 

cohttp-async/test/test_async_integration.ml

@@ -79,7 +79,7 @@ let ts =
         reqs |> Pipe.of_list |> Client.callv uri >>= fun responses ->
         responses |> Pipe.to_list >>= fun resps ->
         resps
-        |> Deferred.List.iter ~f:(fun (_resp, body) ->
+        |> Deferred.List.iter ~how:`Sequential ~f:(fun (_resp, body) ->
                let expected_body = body_q |> Queue.dequeue_exn in
                body |> Body.to_string >>| fun body ->
                assert_equal ~printer expected_body body)
@@ -111,7 +111,7 @@ let ts =
             ("Pipe with empty strings", Pipe.of_list [ ""; ""; "" ], true);
           ]
         in
-        Deferred.List.iter tests ~f:(fun (msg, pipe, expected) ->
+        Deferred.List.iter ~how:`Sequential tests ~f:(fun (msg, pipe, expected) ->
             is_empty (`Pipe pipe) >>| fun real ->
             assert_equal ~msg expected real)
         >>= fun () ->

cohttp/scripts/generate.ml

@@ -94,7 +94,7 @@ let output t =
   Buffer.contents buf
 
 let parse_error fmt =
-  Printf.kprintf
+  Printf.ksprintf
     (fun msg ->
       Printf.eprintf "parse error: %s\n" msg;
       exit 1)

examples/async/dune

@@ -1,6 +1,6 @@
 (executables
- (names hello_world receive_post)
- (libraries mirage-crypto cohttp-async base async_kernel))
+ (names hello_world receive_post s3_cp)
+ (libraries mirage-crypto cohttp-async base async_kernel core_unix.command_unix))
 
 (alias
  (name runtest)

examples/async/hello_world.ml

@@ -19,8 +19,8 @@ let handler ~body:_ _sock req =
   | _ -> Server.respond_string ~status:`Not_found "Route not found"
 
 let start_server port () =
-  Caml.Printf.eprintf "Listening for HTTP on port %d\n" port;
-  Caml.Printf.eprintf "Try 'curl http://localhost:%d/test?hello=xyz'\n%!" port;
+  Stdlib.Printf.eprintf "Listening for HTTP on port %d\n" port;
+  Stdlib.Printf.eprintf "Try 'curl http://localhost:%d/test?hello=xyz'\n%!" port;
   Cohttp_async.Server.create ~on_handler_error:`Raise
     (Async.Tcp.Where_to_listen.of_port port)
     handler
@@ -35,4 +35,4 @@ let () =
            (optional_with_default 8080 int)
            ~doc:"int Source port to listen on")
     start_server
-  |> Command.run
+  |> Command_unix.run

examples/async/receive_post.ml

@@ -6,15 +6,15 @@ open Cohttp_async
 (* compile with: $ corebuild receive_post.native -pkg cohttp.async *)
 
 let start_server port () =
-  Caml.Printf.eprintf "Listening for HTTP on port %d\n" port;
-  Caml.Printf.eprintf "Try 'curl -X POST -d 'foo bar' http://localhost:%d\n"
+  Stdlib.Printf.eprintf "Listening for HTTP on port %d\n" port;
+  Stdlib.Printf.eprintf "Try 'curl -X POST -d 'foo bar' http://localhost:%d\n"
     port;
   Cohttp_async.Server.create ~on_handler_error:`Raise
     (Async.Tcp.Where_to_listen.of_port port) (fun ~body _ req ->
       match req |> Cohttp.Request.meth with
       | `POST ->
           Body.to_string body >>= fun body ->
-          Caml.Printf.eprintf "Body: %s" body;
+          Stdlib.Printf.eprintf "Body: %s" body;
           Server.respond `OK
       | _ -> Server.respond `Method_not_allowed)
   >>= fun _ -> Deferred.never ()
@@ -28,4 +28,4 @@ let () =
            (optional_with_default 8080 int)
            ~doc:"int Source port to listen on")
     start_server
-  |> Command.run
+  |> Command_unix.run

examples/async/s3_cp.ml

@@ -45,6 +45,8 @@ open Async
 open Cohttp
 open Cohttp_async
 
+module Time = Time_float
+
 let ksrt (k, _) (k', _) = String.compare k k'
 
 module Compat = struct
@@ -400,4 +402,4 @@ let () =
       +> anon ("src" %: string)
       +> anon ("dst" %: string))
     main
-  |> run
+  |> Command_unix.run