From 5da49a65501a07673cd678498eda5ea6e5f71350 Mon Sep 17 00:00:00 2001
From: Gabriel Moise <gabriel.moise@trili.tech>
Date: Wed, 31 Jul 2024 09:51:59 +0100
Subject: [PATCH] RPC: FIX Cohttp closing client connection with
 call_with_closefn()

Co-authored-by: Diana Savvatina <diana.savvatina@trili.tech>

(Diana Savvatina was the main author of this, I merely rebased)

Exposing close_fn with a new function call_with_closefn.
Backporting the functionality from Cohttp 6.0.0.-beta2
---
 cohttp/cohttp-lwt/src/client.ml | 10 +++++++---
 cohttp/cohttp-lwt/src/s.ml      | 17 ++++++++++++++++-
 2 files changed, 23 insertions(+), 4 deletions(-)

diff --git a/cohttp/cohttp-lwt/src/client.ml b/cohttp/cohttp-lwt/src/client.ml
index cee09ecfa74b..c927460df09d 100644
--- a/cohttp/cohttp-lwt/src/client.ml
+++ b/cohttp/cohttp-lwt/src/client.ml
@@ -46,8 +46,8 @@ module Make (IO : S.IO) (Net : S.Net with module IO = IO) = struct
     | `DELETE -> false
     | _ -> true
 
-  let call ?(ctx = Net.default_ctx) ?headers ?(body = `Empty) ?chunked meth uri
-      =
+  let call_with_closefn ?(ctx = Net.default_ctx) ?headers ?(body = `Empty)
+      ?chunked meth uri =
     let headers = match headers with None -> Header.init () | Some h -> h in
     Net.connect_uri ~ctx uri >>= fun (_conn, ic, oc) ->
     let closefn () = Net.close ic oc in
@@ -90,7 +90,11 @@ module Make (IO : S.IO) (Net : S.Net with module IO = IO) = struct
     |> fun t ->
     Lwt.on_cancel t closefn ;
     Lwt.on_failure t (fun _exn -> closefn ()) ;
-    t
+    Lwt.return (t, closefn)
+
+  let call ?(ctx = Net.default_ctx) ?headers ?(body = `Empty) ?chunked meth uri
+      =
+    call_with_closefn ~ctx ?headers ~body ?chunked meth uri >>= fun (t, _) -> t
 
   (* The HEAD should not have a response body *)
   let head ?ctx ?headers uri = call ?ctx ?headers `HEAD uri >|= fst
diff --git a/cohttp/cohttp-lwt/src/s.ml b/cohttp/cohttp-lwt/src/s.ml
index 068c61d999b5..cb75f674cb87 100644
--- a/cohttp/cohttp-lwt/src/s.ml
+++ b/cohttp/cohttp-lwt/src/s.ml
@@ -84,7 +84,22 @@ module type Client = sig
       (using [ocaml-tls]) or SSL (using [ocaml-ssl]), on [*:443] or on the
       specified port by the user. If neitehr [ocaml-tls] or [ocaml-ssl] are
       installed on the system, [cohttp]/[conduit] tries the usual ([*:80]) or
-      the specified port by the user in a non-secured way. *)
+      the specified port by the user in a non-secured way.
+
+      The function returns response and body. *)
+
+  val call_with_closefn :
+    ?ctx:ctx ->
+    ?headers:Cohttp.Header.t ->
+    ?body:Body.t ->
+    ?chunked:bool ->
+    Cohttp.Code.meth ->
+    Uri.t ->
+    ((Cohttp.Response.t * Body.t) Lwt.t * (unit -> unit)) Lwt.t
+
+  (** [call_with_closefn ?ctx ?headers ?body ?chunked meth uri] is the same as
+    [call] but returns response, body and [close_fn] which force releases the
+    connection. *)
   val call :
     ?ctx:ctx ->
     ?headers:Cohttp.Header.t ->
-- 
GitLab