From 7c390ec1a3f0f5065883211e93eb89adeac12b49 Mon Sep 17 00:00:00 2001 From: Andre Kuhlenschmidt Date: Fri, 29 Mar 2024 15:47:26 -0700 Subject: [PATCH] make Cohttp_lwt_unix.default_ctx lazy --- cohttp-lwt-unix/src/net.ml | 9 +++++---- cohttp-lwt-unix/src/server.ml | 2 +- cohttp-lwt-unix/test/test_client.ml | 9 ++++++--- cohttp-lwt-unix/test/test_sanity.ml | 2 +- cohttp-lwt-unix/test/test_sanity_noisy.ml | 2 +- cohttp-lwt/src/client.ml | 2 +- cohttp-lwt/src/connection.ml | 2 +- cohttp-lwt/src/connection_cache.ml | 6 +++--- cohttp-lwt/src/s.ml | 2 +- 9 files changed, 20 insertions(+), 16 deletions(-) diff --git a/cohttp-lwt-unix/src/net.ml b/cohttp-lwt-unix/src/net.ml index 3f5001d599..cd0edefab2 100644 --- a/cohttp-lwt-unix/src/net.ml +++ b/cohttp-lwt-unix/src/net.ml @@ -28,10 +28,11 @@ let init ?(ctx = Lazy.force Conduit_lwt_unix.default_ctx) { ctx; resolver } let default_ctx = - { - resolver = Resolver_lwt_unix.system; - ctx = Lazy.force Conduit_lwt_unix.default_ctx; - } + lazy + { + resolver = Resolver_lwt_unix.system; + ctx = Lazy.force Conduit_lwt_unix.default_ctx; + } type endp = Conduit.endp diff --git a/cohttp-lwt-unix/src/server.ml b/cohttp-lwt-unix/src/server.ml index fc29ae42ed..b3830a99dc 100644 --- a/cohttp-lwt-unix/src/server.ml +++ b/cohttp-lwt-unix/src/server.ml @@ -65,7 +65,7 @@ let log_on_exn = function | exn -> Log.err (fun m -> m "Unhandled exception: %a" Fmt.exn exn) let create ?timeout ?backlog ?stop ?(on_exn = log_on_exn) - ?(ctx = Net.default_ctx) ?(mode = `TCP (`Port 8080)) spec = + ?(ctx = Lazy.force Net.default_ctx) ?(mode = `TCP (`Port 8080)) spec = Conduit_lwt_unix.serve ?backlog ?timeout ?stop ~on_exn ~ctx:ctx.Net.ctx ~mode (fun flow ic oc -> let ic = Input_channel.create ic in diff --git a/cohttp-lwt-unix/test/test_client.ml b/cohttp-lwt-unix/test/test_client.ml index c29484b924..6ce34644a1 100644 --- a/cohttp-lwt-unix/test/test_client.ml +++ b/cohttp-lwt-unix/test/test_client.ml @@ -127,7 +127,8 @@ let test_client uri = (* Simple case: The server is known to support pipelining and won't close the * connection unexpectantly (timeout or number of requests may be limited). *) let test_persistent uri = - Connection.Net.resolve ~ctx:Connection.Net.default_ctx + Connection.Net.resolve + ~ctx:(Lazy.force Connection.Net.default_ctx) uri (* resolve hostname. *) >>= Connection.connect ~persistent:true >>= fun connection -> @@ -140,7 +141,8 @@ let test_persistent uri = * This might result in a massive amount of parallel connections. *) let test_non_persistent uri = (* the resolved endpoint may be buffered to avoid stressing the resolver: *) - Connection.Net.resolve ~ctx:Connection.Net.default_ctx uri >>= fun endp -> + Connection.Net.resolve ~ctx:(Lazy.force Connection.Net.default_ctx) uri + >>= fun endp -> let handler ?headers ?body meth uri = Connection.connect ~persistent:false endp >>= fun connection -> Connection.call connection ?headers ?body meth uri @@ -151,7 +153,8 @@ let test_non_persistent uri = * not be supported or the server may close the connection unexpectedly. * In such a case the pending requests will fail with Connection.Retry. *) let test_unknown uri = - Connection.Net.resolve ~ctx:Connection.Net.default_ctx uri >>= fun endp -> + Connection.Net.resolve ~ctx:(Lazy.force Connection.Net.default_ctx) uri + >>= fun endp -> (* buffer resolved endp *) Connection.connect ~persistent:false endp >>= fun c -> let connection = ref c in diff --git a/cohttp-lwt-unix/test/test_sanity.ml b/cohttp-lwt-unix/test/test_sanity.ml index 2af5b875ba..90adbdfc86 100644 --- a/cohttp-lwt-unix/test/test_sanity.ml +++ b/cohttp-lwt-unix/test/test_sanity.ml @@ -78,7 +78,7 @@ let check_logs test () = let ts = Cohttp_lwt_unix_test.test_server_s server (fun uri -> - let ctx = Cohttp_lwt_unix.Net.default_ctx in + let ctx = Lazy.force Cohttp_lwt_unix.Net.default_ctx in let t () = Client.get ~ctx uri >>= fun (_, body) -> body |> Body.to_string >|= fun body -> assert_equal body message diff --git a/cohttp-lwt-unix/test/test_sanity_noisy.ml b/cohttp-lwt-unix/test/test_sanity_noisy.ml index 4504a3cd05..0e07bc5105 100644 --- a/cohttp-lwt-unix/test/test_sanity_noisy.ml +++ b/cohttp-lwt-unix/test/test_sanity_noisy.ml @@ -35,7 +35,7 @@ let server_noisy = let ts_noisy = Cohttp_lwt_unix_test.test_server_s ~port:10193 server_noisy (fun uri -> - let ctx = Cohttp_lwt_unix.Net.default_ctx in + let ctx = Lazy.force Cohttp_lwt_unix.Net.default_ctx in let empty_chunk () = Client.get ~ctx uri >>= fun (_, body) -> body |> Body.to_string >|= fun body -> diff --git a/cohttp-lwt/src/client.ml b/cohttp-lwt/src/client.ml index f105d4fafb..406e364eef 100644 --- a/cohttp-lwt/src/client.ml +++ b/cohttp-lwt/src/client.ml @@ -51,7 +51,7 @@ module Make (Connection : S.Connection) = struct let body = Body.of_string (Uri.encoded_of_query params) in post ?ctx ~chunked:false ~headers ~body uri - let callv ?(ctx = Net.default_ctx) uri reqs = + let callv ?(ctx = Lazy.force Net.default_ctx) uri reqs = let mutex = Lwt_mutex.create () in Net.resolve ~ctx uri >>= Connection.connect ~ctx >>= fun connection -> Lwt.return diff --git a/cohttp-lwt/src/connection.ml b/cohttp-lwt/src/connection.ml index 488225e005..f54b47fc92 100644 --- a/cohttp-lwt/src/connection.ml +++ b/cohttp-lwt/src/connection.ml @@ -264,7 +264,7 @@ module Make (Net : S.Net) : S.Connection with module Net = Net = struct | Connecting _ -> assert false let create ?(finalise = fun _ -> Lwt.return_unit) ?persistent - ?(ctx = Net.default_ctx) endp = + ?(ctx = Lazy.force Net.default_ctx) endp = let persistent = match persistent with | None -> `Unknown diff --git a/cohttp-lwt/src/connection_cache.ml b/cohttp-lwt/src/connection_cache.ml index 81fe596cfd..f8c80b4d35 100644 --- a/cohttp-lwt/src/connection_cache.ml +++ b/cohttp-lwt/src/connection_cache.ml @@ -18,7 +18,7 @@ end = struct let call = Fun.id - let create ?(ctx = Net.default_ctx) () ?headers ?body meth uri = + let create ?(ctx = Lazy.force Net.default_ctx) () ?headers ?body meth uri = Net.resolve ~ctx uri (* TODO: Support chunked encoding without ~persistent:true ? *) >>= Connection.connect ~ctx ~persistent:true @@ -85,8 +85,8 @@ end = struct depth : int; } - let create ?(ctx = Net.default_ctx) ?(keep = 60_000_000_000L) ?(retry = 2) - ?(parallel = 4) ?(depth = 100) () = + let create ?(ctx = Lazy.force Net.default_ctx) ?(keep = 60_000_000_000L) + ?(retry = 2) ?(parallel = 4) ?(depth = 100) () = { cache = Hashtbl.create ~random:true 10; ctx; diff --git a/cohttp-lwt/src/s.ml b/cohttp-lwt/src/s.ml index 1cbe255b19..ac15ae2c82 100644 --- a/cohttp-lwt/src/s.ml +++ b/cohttp-lwt/src/s.ml @@ -34,7 +34,7 @@ module type Net = sig installed on the system, [cohttp]/[conduit] tries the usual ([*:80]) or the specified port by the user in a non-secured way. *) - val default_ctx : ctx + val default_ctx : ctx Lazy.t val resolve : ctx:ctx -> Uri.t -> endp IO.t (** [resolve ~ctx uri] resolves [uri] into an endpoint description. This is