From 5d48210fc640f8fac8a47d7497329e356d0c1cbf Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Tue, 21 Aug 2018 18:54:08 -0500
Subject: [PATCH] unsafeReceiveResponse that does not consume body

This works when you know there is no body, no matter what the headers
say (HEAD requests, #114)

This also works when the handler consumes whatever part of the body you
actually want to use, and then you close the connection afterwards (no
reusing for pipelining!)  Sometimes this is a lot faster than using
pipelining if you can, for example, skip a many GB download (#113)
---
 lib/Network/Http/Client.hs     |  1 +
 lib/Network/Http/Connection.hs | 16 ++++++++++++++++
 2 files changed, 17 insertions(+)

diff --git a/lib/Network/Http/Client.hs b/lib/Network/Http/Client.hs
index 22ec799..5c2da79 100644
--- a/lib/Network/Http/Client.hs
+++ b/lib/Network/Http/Client.hs
@@ -133,6 +133,7 @@ module Network.Http.Client (
     -- * Processing HTTP response
     receiveResponse,
     receiveResponseRaw,
+    unsafeReceiveResponse,
     UnexpectedCompression,
     StatusCode,
     getStatusCode,
diff --git a/lib/Network/Http/Connection.hs b/lib/Network/Http/Connection.hs
index 243d5c2..8ae00e7 100644
--- a/lib/Network/Http/Connection.hs
+++ b/lib/Network/Http/Connection.hs
@@ -30,6 +30,7 @@ module Network.Http.Connection (
     sendRequest,
     receiveResponse,
     receiveResponseRaw,
+    unsafeReceiveResponse,
     UnexpectedCompression,
     emptyBody,
     fileBody,
@@ -490,6 +491,21 @@ receiveResponseRaw c handler = do
   where
     i = cIn c
 
+--
+-- | Handle the response coming back from the server. This function
+-- is the same as receiveResponse, but it does not consume the body for
+-- you after the handler is done.  This means that it can only be safely used
+-- if the handler will fully consume the body, there is no body, or when
+-- the connection is not being reused (no pipelining).
+--
+unsafeReceiveResponse :: Connection -> (Response -> InputStream ByteString -> IO β) -> IO β
+unsafeReceiveResponse c handler = do
+    p  <- readResponseHeader i
+    i' <- readResponseBody p i
+
+    handler p i'
+  where
+    i = cIn c
 
 --
 -- | Use this for the common case of the HTTP methods that only send