cabal-install/src/Distribution/Client/GZipUtils.hs

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