cohttp-lwt: Don't leak asynchronous Retry exceptions.

mirage · Jul 19, 2023 · f5705fe · f5705fe
1 parent de39002
commit f5705fe
Show file tree

Hide file tree

Showing 2 changed files with 9 additions and 2 deletions.
diff --git 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
@@ -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