From 04e75bbe919b035ca1f8aa95522a9b933fbac7b0 Mon Sep 17 00:00:00 2001
From: Hannes Mehnert <hannes@mehnert.org>
Date: Wed, 2 Nov 2022 22:02:58 +0100
Subject: [PATCH] request: pass response in body_f, so that an unsuccessful
 response can be discarded or logged

---
 app/hurl.ml             |  2 +-
 src/http_lwt_client.ml  | 53 ++++++++++++++++++++---------------------
 src/http_lwt_client.mli |  2 +-
 3 files changed, 28 insertions(+), 29 deletions(-)

diff --git a/app/hurl.ml b/app/hurl.ml
index 4ce6167..c944a59 100644
--- a/app/hurl.ml
+++ b/app/hurl.ml
@@ -21,7 +21,7 @@ let jump () protocol uri meth headers input output no_follow =
         let fd = Unix.openfile fn [ Unix.O_WRONLY ] 0o644 in
         fd, fun () -> Unix.close fd
     in
-    let reply () data =
+    let reply _response () data =
       let bytes = Bytes.of_string data in
       let blen = String.length data in
       let written = Unix.write fd bytes 0 blen in
diff --git a/src/http_lwt_client.ml b/src/http_lwt_client.ml
index 29b14cf..fe4bbae 100644
--- a/src/http_lwt_client.ml
+++ b/src/http_lwt_client.ml
@@ -114,28 +114,28 @@ let single_http_1_1_request ?config fd user_pass host meth path headers body f f
       Lwt.wakeup_later notify_finished v;
     w := true
   in
-  let on_eof response data () =
-    let headers =
-      H2.Headers.of_list (Httpaf.Headers.to_list response.Httpaf.Response.headers)
-    in
-    let response : response = {
-      version = response.Httpaf.Response.version ;
-      status = (response.Httpaf.Response.status :> H2.Status.t) ;
-      reason = response.Httpaf.Response.reason ;
-      headers
-    } in
-    wakeup (Ok (response, data))
+  let on_eof response data () = wakeup (Ok (response, data))
   in
   let response_handler response response_body =
+    let response : response =
+      {
+        version = response.Httpaf.Response.version ;
+        status = (response.Httpaf.Response.status :> H2.Status.t) ;
+        reason = response.Httpaf.Response.reason ;
+        headers =
+          H2.Headers.of_list
+            (Httpaf.Headers.to_list response.Httpaf.Response.headers)
+      }
+    in
     let open Lwt.Infix in
-    let rec on_read on_eof data bs ~off ~len =
-      let data =
-        data >>= fun data ->
-        f data (Bigstringaf.substring ~off ~len bs)
+    let rec on_read on_eof acc bs ~off ~len =
+      let acc =
+        acc >>= fun acc ->
+        f response acc (Bigstringaf.substring ~off ~len bs)
       in
       Httpaf.Body.schedule_read response_body
-        ~on_read:(on_read on_eof data)
-        ~on_eof:(on_eof response data)
+        ~on_read:(on_read on_eof acc)
+        ~on_eof:(on_eof response acc)
     in
     let f_init = Lwt.return f_init in
     Httpaf.Body.schedule_read response_body
@@ -178,25 +178,24 @@ let single_h2_request ?config fd scheme user_pass host meth path headers body f
       Lwt.wakeup_later notify_finished v;
     w := true
   in
-  let on_eof response data () =
+  let on_eof response data () = wakeup (Ok (response, data))
+  in
+  let response_handler response response_body =
     let response : response = {
       version = { major = 2 ; minor = 0 } ;
       status = response.H2.Response.status ;
       reason = "" ;
       headers = response.H2.Response.headers ;
     } in
-    wakeup (Ok (response, data))
-  in
-  let response_handler response response_body =
     let open Lwt.Infix in
-    let rec on_read on_eof data bs ~off ~len =
-      let data =
-        data >>= fun data ->
-        f data (Bigstringaf.substring ~off ~len bs)
+    let rec on_read on_eof acc bs ~off ~len =
+      let acc =
+        acc >>= fun acc ->
+        f response acc (Bigstringaf.substring ~off ~len bs)
       in
       H2.Body.Reader.schedule_read response_body
-        ~on_read:(on_read on_eof data)
-        ~on_eof:(on_eof response data)
+        ~on_read:(on_read on_eof acc)
+        ~on_eof:(on_eof response acc)
     in
     let f_init = Lwt.return f_init in
     H2.Body.Reader.schedule_read response_body
diff --git a/src/http_lwt_client.mli b/src/http_lwt_client.mli
index f871509..367eee2 100644
--- a/src/http_lwt_client.mli
+++ b/src/http_lwt_client.mli
@@ -68,6 +68,6 @@ val request
   -> ?follow_redirect:bool
   -> ?happy_eyeballs:Happy_eyeballs_lwt.t
   -> string
-  -> ('a -> string -> 'a Lwt.t)
+  -> (response -> 'a -> string -> 'a Lwt.t)
   -> 'a
   -> (response * 'a, [> `Msg of string ]) Lwt_result.t