http-conduit：使用gzip傳輸數據

Question

我打算使用http-conduit通過HTTP / HTTPS提取大量數據。 為了有效地做到這一點，我想使用Accept-Encoding: deflate,gzip標頭來允許服務器（如果支持）以壓縮方式傳輸數據。

但是，某些我想從中獲取的服務器似乎在Content-Encoding: gzip標頭中錯誤地響應，而未返回gzip數據。

因此，我需要處理以下情況：

• 服務器不支持壓縮->返回普通響應主體
• 服務器返回壓縮/壓縮的內容->返回解壓縮的響應主體
• 服務器說（在響應標頭中，它返回壓縮的內容，但gzip解碼失敗->返回普通響應主體

在第三種情況下，可以安全地假定（在這種情況下）純文本，未壓縮的數據看起來不像gzip數據，因此Response標頭說它是gzip壓縮&& un-gzip失敗完全等同於數據不是壓縮的 。

如何使用http-conduit做到這一點？

注意：此問題有意不顯示研究成果，因為它已經以Q＆A方式立即得到回答。

Answer 1

為了使這個答案更簡潔，我們將使用我以前的一些文章中的代碼和概念：

• 從這里的 simpleHttpWithManager
• 從這里可以容忍gzip / deflate解碼

為了避免冗余，我將首先解釋基本步驟，然后提供完整的示例。

首先，我們將處理發送標頭。 請注意， http-types包含hContentEncoding ， hAcceptEncoding沒有預定義。 除此之外，這是一項瑣碎的任務。

發送請求后，我們需要檢查是否存在Content-Encoding 。 如果沒有，則假定未壓縮的純文本，否則我們需要檢查它是gzip還是deflate 。 在這種情況下，確切地說是哪一個無關緊要，因為[ zlib ]支持按標頭自動檢測。

對於這個相當簡單的示例，我們僅假設如果服務器返回的Content-Encoding值既不存在，也不是gzip或deflate ，則響應不會被壓縮。 由於我們不允許（通過Accept-Encoding ）其他壓縮方式（如sdch ，因此服務器將通過這種方式違反HTTP標准。

如果我們檢測到壓縮編碼，則嘗試解壓縮並將其返回。 如果失敗或根本沒有壓縮數據，則返回純響應主體。

例子如下：

{-# LANGUAGE OverloadedStrings #-}
import Network.HTTP.Conduit
import Network.Connection
import Codec.Compression.Zlib.Internal
import Data.Maybe
import Data.Either
import Network.HTTP.Types
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Lazy.Char8 as LB

myurl :: String
myurl = "http://stackoverflow.com"

hAcceptEncoding :: HeaderName
hAcceptEncoding = "Accept-Encoding"

-- | The Accept-Encoding HTTP header value for allowing gzip or deflated responses
gzipDeflateEncoding :: ByteString
gzipDeflateEncoding = "gzip,deflate"

-- HTTP header list that allows gzipped/deflated response
compressionEnabledHeaders :: RequestHeaders
compressionEnabledHeaders = [(hAcceptEncoding, gzipDeflateEncoding)]

-- | Give an encoding string and a HTTP response object,
--   Checks if the Content-Encoding header value of the response object
--   is equal to the given encoding. Returns false if no ContentEncoding
--   header exists in the given response, or if the value does not match
--   the encoding parameter.
hasResponseEncoding :: ByteString -> Response b -> Bool
hasResponseEncoding encoding response =
    let responseEncoding = lookup hContentEncoding headers
        headers = responseHeaders response
    in maybe False (== encoding) responseEncoding

-- | Convert the custom error format from zlib to a Either
decompressStreamToEither :: DecompressStream -> Either String LB.ByteString
decompressStreamToEither (StreamError _ errmsg) = Left errmsg
decompressStreamToEither stream@(StreamChunk _ _) = Right $ fromDecompressStream stream
decompressStreamToEither StreamEnd = Right $ ""

-- | Decompress with explicit error handling
safeDecompress :: LB.ByteString -> Either String LB.ByteString
safeDecompress bstr = decompressStreamToEither $ decompressWithErrors gzipOrZlibFormat defaultDecompressParams bstr

-- | Decompress gzip, if it fails, return uncompressed String
decompressIfPossible :: LB.ByteString -> LB.ByteString
decompressIfPossible bstr =
    let conv (Left a) = bstr
        conv (Right a) = a
    in (conv . safeDecompress) bstr

-- | Tolerantly decompress response body. As some HTTP servers set the header incorrectly,
--   just return the plain response text if the compression fails
decompressResponseBody :: Response LB.ByteString -> LB.ByteString
decompressResponseBody res
    | hasResponseEncoding "gzip" res = decompressIfPossible $ responseBody res
    | hasResponseEncoding "deflate" res = decompressIfPossible $ responseBody res
    | otherwise = responseBody res

-- | Download like with simpleHttp, but using an existing manager for the task
--   and automatically requesting & handling gzipped data
simpleHttpWithAutoGzip :: Manager -> String -> IO LB.ByteString
simpleHttpWithAutoGzip manager url = do req <- parseUrl url
                                        let req' = req {requestHeaders = compressionEnabledHeaders}
                                        fmap decompressResponseBody $ httpLbs req' manager

-- Example usage
main :: IO ()
main = do manager <- newManager conduitManagerSettings -- Create a simple manager
          content <- simpleHttpWithAutoGzip manager "http://stackoverflow.com"
          -- Print the uncompressed content
          print $ content