haskell/minio-hs
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix: ignore body of responses to head requests as per spec

Browse Source
This commit is contained in:
Gregor Kleen 2024-03-31 00:28:22 +01:00
parent fafc203e1b
commit cb25dd23c4
1 changed files with 5 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/Network/Minio/Utils.hs
View File

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