    {- arch-tag: GZip file support in Haskell
    Copyright (C) 2004 John Goerzen <jgoerzen@complete.org>

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
    -}

    {- |
       Module     : System.FileArchive.GZip
       Copyright  : Copyright (C) 2004 John Goerzen
       License    : GNU GPL, version 2 or above

       Maintainer : John Goerzen <jgoerzen@complete.org>
       Stability  : provisional
       Portability: portable

    GZip file decompression

    Copyright (c) 2004 John Goerzen, jgoerzen\@complete.org

    The GZip format is described in RFC1952.
    -}
    module System.FileArchive.GZip (
                                      -- * GZip Files
                                      -- $gzipfiles

                                      -- * Types
                                      Header(..), Section, GZipError(..),
                                      Footer(..),
                                      -- * Whole-File Processing
                                      decompress,
                                      hDecompress,
                                      read_sections,
                                      -- * Section Processing
                                      read_header,
                                      read_section
                                     )
        where

    import Data.Compression.Inflate (inflate_string_remainder)
    import Data.Hash.CRC32.GZip (update_crc)
    import Data.Bits ((.&.))
    import Control.Monad.Error -- (Error(), strMsg, throwError)
    import Data.Char (ord)
    import Data.Word (Word32())
    import Data.Bits.Utils (fromBytes)
    import System.IO (hGetContents, hPutStr, Handle())

    data GZipError = CRCError               -- ^ CRC-32 check failed
                   | NotGZIPFile            -- ^ Couldn't find a GZip header
                   | UnknownMethod          -- ^ Compressed with something other than method 8 (deflate)
                   | UnknownError String    -- ^ Other problem arose
                   deriving (Eq, Show)

    instance Error GZipError where
        noMsg = UnknownError ""
        strMsg = UnknownError

    -- | First two bytes of file
    magic :: String
    magic = "\x1f\x8b"

    -- | Flags
    fFHCRC, fFEXTRA, fFNAME, fFCOMMENT :: Int
    -- fFTEXT = 1 :: Int
    fFHCRC = 2
    fFEXTRA = 4
    fFNAME = 8
    fFCOMMENT = 16

    {- | The data structure representing the GZip header.  This occurs
    at the beginning of each 'Section' on disk. -}
    data Header = Header {
                          method :: Int,    -- ^ Compression method.  Only 8 is defined at present.
                          flags :: Int,
                          extra :: Maybe String,
                          filename :: Maybe String,
                          comment :: Maybe String,
                          mtime :: Word32,  -- ^ Modification time of the original file
                          xfl :: Int,       -- ^ Extra flags
                          os :: Int         -- ^ Creating operating system
                         } deriving (Eq, Show)

    {- | Stored on-disk at the end of each section. -}
    data Footer = Footer {
                          size :: Word32,   -- ^ The size of the original, decompressed data
                          crc32 :: Word32,  -- ^ The stored GZip CRC-32 of the original, decompressed data
                          crc32valid :: Bool -- ^ Whether or not the stored CRC-32 matches the calculated CRC-32 of the data
                         }

    {- | A section represents a compressed component in a GZip file.
    Every GZip file has at least one. -}
    type Section = (Header, String, Footer)

    split1 :: String -> (Char, String)
    split1 s = (head s, tail s)

    {- | Read a GZip file, decompressing all sections found.

    Writes the decompressed data stream to the given output handle.

    Returns Nothing if the action was successful, or Just GZipError if there
    was a problem.  If there was a problem, the data written to the output
    handle should be discarded.
    -}

    hDecompress :: Handle                   -- ^ Input handle
                -> Handle                   -- ^ Output handle
                -> IO (Maybe GZipError)
    hDecompress infd outfd =
        do inc <- hGetContents infd
           let (outstr, err) = decompress inc
           hPutStr outfd outstr
           return err

    {- | Read a GZip file, decompressing all sections that are found.

    Returns a decompresed data stream and Nothing, or an unreliable string
    and Just (error).  If you get anything other than Nothing, the String
    returned should be discarded.
    -}
    decompress :: String -> (String, Maybe GZipError)
    {-
    decompress s =
        do x <- read_header s
           let rem = snd x
           return $ inflate_string rem
    -}
    decompress s =
        let procs :: [Section] -> (String, Bool)
            procs [] = ([], True)
            procs ((_, content, foot):xs) =
                let (nexth, nextb) = procs xs in
                    (content ++ nexth, (crc32valid foot) && nextb)
            in case read_sections s of
               Left x -> ("", Just x)
               Right x -> let (decomp, iscrcok) = procs x
                              in (decomp, if iscrcok then Nothing else Just CRCError)

    {-
    decompress s = do x <- read_sections s
                      return $ concatMap (\(_, x, _) -> x) x
    -}

    -- | Read all sections.
    read_sections :: String -> Either GZipError [Section]
    read_sections [] = Right []
    read_sections s =
        do x <- read_section s
           case x of
               (sect, remain) ->
                   do next <- read_sections remain
                      return $ sect : next

    parseword :: String -> Word32
    parseword s = fromBytes $ map (fromIntegral . ord) $ reverse s

    -- | Read one section, returning (ThisSection, Remainder)
    read_section :: String -> Either GZipError (Section, String)
    read_section s =
            do x <- read_header s
               let headerrem = snd x
               let (decompressed, crc, remainder) = read_data headerrem
               let (crc32str, rm) = splitAt 4 remainder
               let (sizestr, rem2) = splitAt 4 rm
               let filecrc32 = parseword crc32str
               let filesize = parseword sizestr
               return ((fst x, decompressed,
                       Footer {size = filesize, crc32 = filecrc32,
                               crc32valid = filecrc32 == crc})
                       ,rem2)

    -- | Read the file's compressed data, returning
    -- (Decompressed, Calculated CRC32, Remainder)
    read_data :: String -> (String, Word32, String)
    read_data x =
        let (decompressed1, remainder) = inflate_string_remainder x
            (decompressed, crc32) = read_data_internal decompressed1 0
            in
              (decompressed, crc32, remainder)
        where
          read_data_internal [] ck = ([], ck)
          read_data_internal (y:ys) ck =
            let newcrc = update_crc ck y
                n = newcrc `seq` read_data_internal ys newcrc
                in
                (y : fst n, snd n)

    {- | Read the GZip header.  Return (Header, Remainder).
    -}
    read_header :: String -> Either GZipError (Header, String)
    read_header s =
        let ok = Right "ok" in
        do let (mag, rem) = splitAt 2 s
           if mag /= magic
              then throwError NotGZIPFile
              else ok
           let (method, rem2) = split1 rem
           if (ord(method) /= 8)
              then throwError UnknownMethod
              else ok
           let (flag_S, rem3) = split1 rem2
           let flag = ord flag_S
           let (mtimea, rem3a) = splitAt 4 rem3
           let mtime = parseword mtimea
           let (xfla, rem3b) = split1 rem3a
           let xfl = ord xfla
           let (osa, _) = split1 rem3b
           let os = ord osa
           -- skip modtime (4), extraflag (1), and os (1)
           let rem4 = drop 6 rem3

           let (extra, rem5) =
                   if (flag .&. fFEXTRA /= 0)
                   -- Skip past the extra field if we have it.
                      then let (xlen_S, _) = split1 rem4
                               (xlen2_S, rem4b) = split1 rem4
                               xlen = (ord xlen_S) + 256 * (ord xlen2_S)
                               (ex, rrem) = splitAt xlen rem4b
                               in (Just ex, rrem)
                      else (Nothing, rem4)

           let (filename, rem6) =
                   if (flag .&. fFNAME /= 0)
                   -- Skip past the null-terminated filename
                      then let fn = takeWhile (/= '\x00') rem5
                                    in (Just fn, drop ((length fn) + 1) rem5)
                      else (Nothing, rem5)

           let (comment, rem7) =
                   if (flag .&. fFCOMMENT /= 0)
                      -- Skip past the null-terminated comment
                      then let cm = takeWhile (/= '\x00') rem6
                               in (Just cm, drop ((length cm) + 1) rem6)
                      else (Nothing, rem6)

           rem8 <- if (flag .&. fFHCRC /= 0)
                      -- Skip past the header CRC
                      then return $ drop 2 rem7
                      else return rem7

           return (Header {method = ord method,
                          flags = flag,
                          extra = extra,
                          filename = filename,
                          comment = comment,
                          mtime = mtime,
                          xfl = xfl,
                          os = os}, rem8)

    ----------------------------------------------------------------------
    -- Documentation
    ----------------------------------------------------------------------

    {- $gzipfiles

    GZip files contain one or more 'Section's.  Each 'Section', on disk, begins
    with a GZip 'Header', then stores the compressed data itself, and finally
    stores a GZip 'Footer'.

    The 'Header' identifies the file as a GZip file, records the original
    modification date and time, and, in some cases, also records the original
    filename and comments.

    The 'Footer' contains a GZip CRC32 checksum over the decompressed data as
    well as a 32-bit length of the decompressed data.  The module
    'Data.Hash.CRC32.GZip' is used to validate stored CRC32 values.

    The vast majority of GZip files contain only one 'Section'.  Standard tools
    that work with GZip files create single-section files by default.

    Multi-section files can be created by simply concatenating two existing
    GZip files together.  The standard gunzip and zcat tools will simply
    concatenate the decompressed data when reading these files back.  The
    'decompress' function in this module will do the same.

    When reading data from this module, please use caution regarding how you access
    it.  For instance, if you are wanting to write the decompressed stream
    to disk and validate its CRC32 value, you could use the 'decompress'
    function.  However, you should process the entire stream before you check
    the value of the Bool it returns.  Otherwise, you will force Haskell to buffer
    the entire file in memory just so it can check the CRC32.
    -}