-- |
-- Module      :  Distribution.Client.GZipUtils
-- Copyright   :  (c) Dmitry Astapov 2010
-- License     :  BSD-like
--
-- Maintainer  :  cabal-devel@gmail.com
-- Stability   :  provisional
-- Portability :  portable
--
-- Provides a convenience functions for working with files that may or may not
-- be zipped.
module Distribution.Client.GZipUtils
  ( maybeDecompress
  ) where

import Distribution.Client.Compat.Prelude
import Prelude ()

import Codec.Compression.Zlib.Internal
import Control.Exception (throw)
import Control.Monad.ST.Lazy (ST, runST)
import qualified Data.ByteString as Strict
import Data.ByteString.Lazy.Internal as BS (ByteString (Chunk, Empty))

-- | Attempts to decompress the `bytes' under the assumption that
-- "data format" error at the very beginning of the stream means
-- that it is already decompressed. Caller should make sanity checks
-- to verify that it is not, in fact, garbage.
--
-- This is to deal with http proxies that lie to us and transparently
-- decompress without removing the content-encoding header. See:
-- <https://github.com/haskell/cabal/issues/678>
maybeDecompress :: ByteString -> ByteString
maybeDecompress :: ByteString -> ByteString
maybeDecompress ByteString
bytes = (forall s. ST s ByteString) -> ByteString
forall a. (forall s. ST s a) -> a
runST (ByteString -> DecompressStream (ST s) -> ST s ByteString
forall (m :: * -> *).
Monad m =>
ByteString -> DecompressStream m -> m ByteString
go ByteString
bytes DecompressStream (ST s)
forall s. DecompressStream (ST s)
decompressor)
  where
    decompressor :: DecompressStream (ST s)
    decompressor :: forall s. DecompressStream (ST s)
decompressor = Format -> DecompressParams -> DecompressStream (ST s)
forall s. Format -> DecompressParams -> DecompressStream (ST s)
decompressST Format
gzipOrZlibFormat DecompressParams
defaultDecompressParams

    -- DataError at the beginning of the stream probably means that stream is
    -- not compressed, so we return it as-is.
    -- TODO: alternatively, we might consider looking for the two magic bytes 1F 8B
    -- (https://en.wikipedia.org/wiki/Gzip#File_structure)
    -- at the beginning of the gzip header.  (not an option for zlib, though.)
    go :: Monad m => ByteString -> DecompressStream m -> m ByteString
    go :: forall (m :: * -> *).
Monad m =>
ByteString -> DecompressStream m -> m ByteString
go ByteString
cs (DecompressOutputAvailable ByteString
bs m (DecompressStream m)
k) = ByteString -> ByteString -> ByteString
Chunk ByteString
bs (ByteString -> ByteString) -> m ByteString -> m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> DecompressStream m -> m ByteString
forall (m :: * -> *).
Monad m =>
ByteString -> DecompressStream m -> m ByteString
go' ByteString
cs (DecompressStream m -> m ByteString)
-> m (DecompressStream m) -> m ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (DecompressStream m)
k)
    go ByteString
_ (DecompressStreamEnd ByteString
_bs) = ByteString -> m ByteString
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
Empty
    go ByteString
_ (DecompressStreamError DecompressError
_err) = ByteString -> m ByteString
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bytes
    go ByteString
cs (DecompressInputRequired ByteString -> m (DecompressStream m)
k) = ByteString -> DecompressStream m -> m ByteString
forall (m :: * -> *).
Monad m =>
ByteString -> DecompressStream m -> m ByteString
go ByteString
cs' (DecompressStream m -> m ByteString)
-> m (DecompressStream m) -> m ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> m (DecompressStream m)
k ByteString
c
      where
        (ByteString
c, ByteString
cs') = ByteString -> (ByteString, ByteString)
uncons ByteString
cs

    -- Once we have received any output though we regard errors as actual errors
    -- and we throw them (as pure exceptions).
    -- TODO: We could (and should) avoid these pure exceptions.
    go' :: Monad m => ByteString -> DecompressStream m -> m ByteString
    go' :: forall (m :: * -> *).
Monad m =>
ByteString -> DecompressStream m -> m ByteString
go' ByteString
cs (DecompressOutputAvailable ByteString
bs m (DecompressStream m)
k) = ByteString -> ByteString -> ByteString
Chunk ByteString
bs (ByteString -> ByteString) -> m ByteString -> m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> DecompressStream m -> m ByteString
forall (m :: * -> *).
Monad m =>
ByteString -> DecompressStream m -> m ByteString
go' ByteString
cs (DecompressStream m -> m ByteString)
-> m (DecompressStream m) -> m ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (DecompressStream m)
k)
    go' ByteString
_ (DecompressStreamEnd ByteString
_bs) = ByteString -> m ByteString
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
Empty
    go' ByteString
_ (DecompressStreamError DecompressError
err) = DecompressError -> m ByteString
forall a e. (HasCallStack, Exception e) => e -> a
throw DecompressError
err
    go' ByteString
cs (DecompressInputRequired ByteString -> m (DecompressStream m)
k) = ByteString -> DecompressStream m -> m ByteString
forall (m :: * -> *).
Monad m =>
ByteString -> DecompressStream m -> m ByteString
go' ByteString
cs' (DecompressStream m -> m ByteString)
-> m (DecompressStream m) -> m ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> m (DecompressStream m)
k ByteString
c
      where
        (ByteString
c, ByteString
cs') = ByteString -> (ByteString, ByteString)
uncons ByteString
cs

    uncons :: ByteString -> (Strict.ByteString, ByteString)
    uncons :: ByteString -> (ByteString, ByteString)
uncons ByteString
Empty = (ByteString
Strict.empty, ByteString
Empty)
    uncons (Chunk ByteString
c ByteString
cs) = (ByteString
c, ByteString
cs)