never executed always true always false
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 -----------------------------------------------------------------------------
17 module Distribution.Client.GZipUtils (
18 maybeDecompress,
19 ) where
20
21 import Prelude ()
22 import Distribution.Client.Compat.Prelude
23
24 import Codec.Compression.Zlib.Internal
25 import 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)
32 import Control.Exception (throw)
33 import Control.Monad.ST.Lazy (ST, runST)
34 import 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 --
46 maybeDecompress :: ByteString -> ByteString
47 #if MIN_VERSION_zlib(0,6,0)
48 maybeDecompress 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
80 maybeDecompress 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