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