{-# LANGUAGE MultiWayIf #-}
module Codec.Compression.Zlib(
DecompressionError(..)
, ZlibDecoder(NeedMore, Chunk, Done, DecompError)
, decompress
, decompressIncremental
)
where
import Codec.Compression.Zlib.Deflate(inflate)
import Codec.Compression.Zlib.Monad(ZlibDecoder(..), DeflateM,
DecompressionError(..),
runDeflateM, raise, nextByte)
import Control.Monad(unless, when, replicateM_)
import Data.Bits((.|.), (.&.), shiftL, shiftR, testBit)
import Data.ByteString.Builder(lazyByteString,toLazyByteString)
import qualified Data.ByteString.Lazy as L
import Data.Semigroup ((<>))
import Data.Word(Word16)
import Prelude()
import Prelude.Compat
decompressIncremental :: ZlibDecoder
decompressIncremental = runDeflateM inflateWithHeaders
decompress :: L.ByteString -> Either DecompressionError L.ByteString
decompress ifile = run decompressIncremental (L.toChunks ifile) mempty
where
run (NeedMore _) [] _ =
Left (DecompressionError "Ran out of data mid-decompression 2.")
run (NeedMore f) (first:rest) acc =
run (f first) rest acc
run (Chunk c m) ls acc =
run m ls (acc <> lazyByteString c)
run Done [] acc =
Right (toLazyByteString acc)
run Done (_:_) _ =
Left (DecompressionError "Finished with data remaining.")
run (DecompError e) _ _ =
Left e
inflateWithHeaders :: DeflateM ()
inflateWithHeaders =
do cmf <- nextByte
flg <- nextByte
let both = fromIntegral cmf `shiftL` 8 .|. fromIntegral flg
cm = cmf .&. 0x0f
cinfo = cmf `shiftR` 4
fdict = testBit flg 5
unless ((both :: Word16) `mod` 31 == 0) $
raise (HeaderError "Header checksum failed")
unless (cm == 8) $
raise (HeaderError ("Bad compression method: " ++ show cm))
unless (cinfo <= 7) $
raise (HeaderError ("Window size too big: " ++ show cinfo))
when fdict $ replicateM_ 4 nextByte
inflate