为了使这个答案更简洁,我们将使用我以前的一些帖子中的代码和概念:
simpleHttpWithManager
从这里
- 从这里容忍 gzip/deflate 解码
为了避免冗余,我将首先解释基本步骤,然后提供一个完整的示例。
首先,我们将处理发送标头。请注意, wile http-types
contains 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