http-conduit：使用 gzip 传输数据

Question

我打算使用http-conduit 通过 HTTP/HTTPS 获取大量数据。为了有效地做到这一点，我想使用Accept-Encoding: deflate,gzip 标头来允许服务器（如果支持）以压缩方式传输数据。

但是，我想从中获取的一些服务器似乎错误地响应 Content-Encoding: gzip 标头而不返回 gzip 数据。

因此我需要处理这些情况：

• 服务器不支持压缩 --> 返回纯响应正文
• 服务器返回压缩/压缩的内容 --> 返回解压缩的响应正文
• 服务器说（在响应标头中它返回 gzip 压缩的内容，但 gzip 解码失败 --> 返回普通响应正文

在第三种情况下，可以（在这种特定情况下）安全地假设，明文、未压缩的数据看起来不像 gzip 数据，所以 响应标头说它是 gzip 压缩的 && un-gzip 失败 em> 完全等同于数据没有被压缩。

我怎样才能使用http-conduit 做到这一点？

注意：这个问题故意不显示研究成果，因为它已经以问答式的方式立即得到了回答。

Answer 1

为了使这个答案更简洁，我们将使用我以前的一些帖子中的代码和概念：

• simpleHttpWithManager 来自here
• 从here 容忍gzip/deflate 解码

为了避免冗余，我将首先解释基本步骤，然后提供一个完整的示例。

首先，我们将处理发送标头。请注意，wile http-types 包含 hContentEncoding，hAcceptEncoding 未预定义。除此之外，这是一项微不足道的任务。

发送请求后，我们需要检查是否有Content-Encoding。如果没有，我们假设未压缩的明文，否则我们需要检查它是gzip还是deflate。在这种情况下，究竟是哪一个并不重要，因为 [zlib] 支持按标头自动检测。

对于这个相当简单的例子，我们假设如果服务器返回一个既不缺席也不存在gzip 或deflate 的Content-Encoding 值，则响应没有被压缩。由于我们不允许（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