From 6aca487246790b70cb17a679a7001fa24026e920 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gregor.kleen@math.lmu.de>
Date: Sun, 31 Mar 2024 00:28:22 +0100
Subject: [PATCH] fix: ignore body of responses to head requests as per spec

---
 src/Network/Minio/Utils.hs | 8 +++++---
 1 file changed, 5 insertions(+), 3 deletions(-)

diff --git a/src/Network/Minio/Utils.hs b/src/Network/Minio/Utils.hs
index 1fcaa84..499b7fc 100644
--- a/src/Network/Minio/Utils.hs
+++ b/src/Network/Minio/Utils.hs
@@ -184,10 +184,10 @@ httpLbs req mgr = do
   resp <- either throwIO return respE
   unless (isSuccessStatus $ NC.responseStatus resp) $
     case contentTypeMay resp of
-      Just "application/xml" -> do
+      Just "application/xml" | expectBody -> do
         sErr <- parseErrResponse $ NC.responseBody resp
         throwIO sErr
-      Just "application/json" -> do
+      Just "application/json" | expectBody -> do
         sErr <- parseErrResponseJSON $ NC.responseBody resp
         throwIO sErr
       _ ->
@@ -204,6 +204,7 @@ httpLbs req mgr = do
     contentTypeMay resp =
       lookupHeader Hdr.hContentType $
         NC.responseHeaders resp
+    expectBody = NC.method req /= HT.methodHead
 
 http ::
   (MonadUnliftIO m, R.MonadResource m) =>
@@ -215,7 +216,7 @@ http req mgr = do
   resp <- either throwIO return respE
   unless (isSuccessStatus $ NC.responseStatus resp) $
     case contentTypeMay resp of
-      Just "application/xml" -> do
+      Just "application/xml" | expectBody -> do
         respBody <- C.connect (NC.responseBody resp) CB.sinkLbs
         sErr <- parseErrResponse respBody
         throwIO sErr
@@ -235,6 +236,7 @@ http req mgr = do
     contentTypeMay resp =
       lookupHeader Hdr.hContentType $
         NC.responseHeaders resp
+    expectBody = NC.method req /= HT.methodHead
 
 -- Similar to mapConcurrently but limits the number of threads that
 -- can run using a quantity semaphore.