From f5705fe7991adcc12908b06f55bdb786e93291fe Mon Sep 17 00:00:00 2001
From: mefyl <mefyl@gruntech.org>
Date: Wed, 19 Jul 2023 12:43:07 +0200
Subject: [PATCH] cohttp-lwt: Don't leak asynchronous `Retry` exceptions.

---
 CHANGES.md                         | 4 ++++
 cohttp-lwt/src/connection_cache.ml | 7 +++++--
 2 files changed, 9 insertions(+), 2 deletions(-)

diff --git a/CHANGES.md b/CHANGES.md
index c535dd4101..b334223f37 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -1,3 +1,7 @@
+## Unreleased
+
+- cohttp-lwt: Do not leak `Retry` exceptions to `Lwt.async_exception_hook`. (mefyl #992)
+
 ## v6.0.0~alpha2 (2023-07-1)
 - http.header: introduce "iter_ord" to guarantee iteration following the order of the entries in the headers (mseri #986)
 - http.header: fix "move_to_fist" and "first" ro follow Header's semantics (mseri #986)
diff --git a/cohttp-lwt/src/connection_cache.ml b/cohttp-lwt/src/connection_cache.ml
index 898e87b662..e61ef87d35 100644
--- a/cohttp-lwt/src/connection_cache.ml
+++ b/cohttp-lwt/src/connection_cache.ml
@@ -25,14 +25,17 @@ end = struct
     >>= fun connection ->
     let res = Connection.call connection ?headers ?body meth uri in
     (* this can be simplified when https://github.com/mirage/ocaml-conduit/pull/319 is released. *)
-    Lwt.async (fun () ->
+    Lwt.dont_wait (fun () ->
         res >>= fun (_, body) ->
         (match body with
         | `Empty | `String _ | `Strings _ -> Lwt.return_unit
         | `Stream stream -> Lwt_stream.closed stream)
         >>= fun () ->
         Connection.close connection;
-        Lwt.return_unit);
+        Lwt.return_unit)
+      (function
+       | Retry -> ()
+       | e -> raise e);
     res
 end