1{-# LANGUAGE ScopedTypeVariables #-} 2{-# LANGUAGE CPP #-} 3 4----------------------------------------------------------------------------- 5-- | 6-- Module : Distribution.Client.GZipUtils 7-- Copyright : (c) Dmitry Astapov 2010 8-- License : BSD-like 9-- 10-- Maintainer : cabal-devel@gmail.com 11-- Stability : provisional 12-- Portability : portable 13-- 14-- Provides a convenience functions for working with files that may or may not 15-- be zipped. 16----------------------------------------------------------------------------- 17module Distribution.Client.GZipUtils ( 18 maybeDecompress, 19 ) where 20 21import Prelude () 22import Distribution.Client.Compat.Prelude 23 24import Codec.Compression.Zlib.Internal 25import Data.ByteString.Lazy.Internal as BS (ByteString(Empty, Chunk)) 26 27#ifndef MIN_VERSION_zlib 28#define MIN_VERSION_zlib(x,y,z) 1 29#endif 30 31#if MIN_VERSION_zlib(0,6,0) 32import Control.Exception (throw) 33import Control.Monad.ST.Lazy (ST, runST) 34import qualified Data.ByteString as Strict 35#endif 36 37-- | Attempts to decompress the `bytes' under the assumption that 38-- "data format" error at the very beginning of the stream means 39-- that it is already decompressed. Caller should make sanity checks 40-- to verify that it is not, in fact, garbage. 41-- 42-- This is to deal with http proxies that lie to us and transparently 43-- decompress without removing the content-encoding header. See: 44-- <https://github.com/haskell/cabal/issues/678> 45-- 46maybeDecompress :: ByteString -> ByteString 47#if MIN_VERSION_zlib(0,6,0) 48maybeDecompress bytes = runST (go bytes decompressor) 49 where 50 decompressor :: DecompressStream (ST s) 51 decompressor = decompressST gzipOrZlibFormat defaultDecompressParams 52 53 -- DataError at the beginning of the stream probably means that stream is 54 -- not compressed, so we return it as-is. 55 -- TODO: alternatively, we might consider looking for the two magic bytes 56 -- at the beginning of the gzip header. (not an option for zlib, though.) 57 go :: Monad m => ByteString -> DecompressStream m -> m ByteString 58 go cs (DecompressOutputAvailable bs k) = liftM (Chunk bs) $ go' cs =<< k 59 go _ (DecompressStreamEnd _bs ) = return Empty 60 go _ (DecompressStreamError _err ) = return bytes 61 go cs (DecompressInputRequired k) = go cs' =<< k c 62 where 63 (c, cs') = uncons cs 64 65 -- Once we have received any output though we regard errors as actual errors 66 -- and we throw them (as pure exceptions). 67 -- TODO: We could (and should) avoid these pure exceptions. 68 go' :: Monad m => ByteString -> DecompressStream m -> m ByteString 69 go' cs (DecompressOutputAvailable bs k) = liftM (Chunk bs) $ go' cs =<< k 70 go' _ (DecompressStreamEnd _bs ) = return Empty 71 go' _ (DecompressStreamError err ) = throw err 72 go' cs (DecompressInputRequired k) = go' cs' =<< k c 73 where 74 (c, cs') = uncons cs 75 76 uncons :: ByteString -> (Strict.ByteString, ByteString) 77 uncons Empty = (Strict.empty, Empty) 78 uncons (Chunk c cs) = (c, cs) 79#else 80maybeDecompress bytes = foldStream $ decompressWithErrors gzipOrZlibFormat defaultDecompressParams bytes 81 where 82 -- DataError at the beginning of the stream probably means that stream is not compressed. 83 -- Returning it as-is. 84 -- TODO: alternatively, we might consider looking for the two magic bytes 85 -- at the beginning of the gzip header. 86 foldStream (StreamError _ _) = bytes 87 foldStream somethingElse = doFold somethingElse 88 89 doFold StreamEnd = BS.Empty 90 doFold (StreamChunk bs stream) = BS.Chunk bs (doFold stream) 91 doFold (StreamError _ msg) = error $ "Codec.Compression.Zlib: " ++ msg 92#endif 93