{-# LINE 1 "src/LibLzma.hsc" #-}
{-# LANGUAGE RecordWildCards, DeriveDataTypeable #-}

-- Copyright (c) 2014, Herbert Valerio Riedel <hvr@gnu.org>
--
-- This code is BSD3 licensed, see ../LICENSE file for details
--

-- | Internal low-level bindings to liblzma
--
-- See @<lzma.h>@ header file for documentation about primitives not
-- documented here
module LibLzma
    ( LzmaStream
    , LzmaRet(..)
    , IntegrityCheck(..)
    , CompressionLevel(..)

    , newDecodeLzmaStream
    , DecompressParams(..)
    , defaultDecompressParams

    , newEncodeLzmaStream
    , CompressParams(..)
    , defaultCompressParams

    , runLzmaStream
    , endLzmaStream
    , LzmaAction(..)
    ) where

import           Control.Applicative
import           Control.Exception
import           Control.Monad
import           Control.Monad.ST.Strict (ST)
import           Control.Monad.ST.Unsafe (unsafeIOToST)
import           Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BS
import qualified Data.ByteString.Unsafe as BS
import           Data.Typeable
import           Foreign
import           Prelude



newtype LzmaStream = LS (ForeignPtr LzmaStream)

data LzmaRet = LzmaRetOK
             | LzmaRetStreamEnd
             | LzmaRetUnsupportedCheck
             | LzmaRetGetCheck
             | LzmaRetMemError
             | LzmaRetMemlimitError
             | LzmaRetFormatError
             | LzmaRetOptionsError
             | LzmaRetDataError
             | LzmaRetBufError
             | LzmaRetProgError
             deriving (Eq,Ord,Read,Show,Typeable)

instance Exception LzmaRet

toLzmaRet :: Int -> Maybe LzmaRet
toLzmaRet i = case i of
    (0) -> Just LzmaRetOK
{-# LINE 66 "src/LibLzma.hsc" #-}
    (1) -> Just LzmaRetStreamEnd
{-# LINE 67 "src/LibLzma.hsc" #-}
    (3) -> Just LzmaRetUnsupportedCheck
{-# LINE 68 "src/LibLzma.hsc" #-}
    (4) -> Just LzmaRetGetCheck
{-# LINE 69 "src/LibLzma.hsc" #-}
    (5) -> Just LzmaRetMemError
{-# LINE 70 "src/LibLzma.hsc" #-}
    (6) -> Just LzmaRetMemlimitError
{-# LINE 71 "src/LibLzma.hsc" #-}
    (7) -> Just LzmaRetFormatError
{-# LINE 72 "src/LibLzma.hsc" #-}
    (8) -> Just LzmaRetOptionsError
{-# LINE 73 "src/LibLzma.hsc" #-}
    (9) -> Just LzmaRetDataError
{-# LINE 74 "src/LibLzma.hsc" #-}
    (10) -> Just LzmaRetBufError
{-# LINE 75 "src/LibLzma.hsc" #-}
    (11) -> Just LzmaRetProgError
{-# LINE 76 "src/LibLzma.hsc" #-}
    _                               -> Nothing

-- | Integrity check type (only supported when compressing @.xz@ files)
data IntegrityCheck = IntegrityCheckNone   -- ^ disable integrity check (not recommended)
                    | IntegrityCheckCrc32  -- ^ CRC32 using the polynomial from IEEE-802.3
                    | IntegrityCheckCrc64  -- ^ CRC64 using the polynomial from ECMA-182
                    | IntegrityCheckSha256 -- ^ SHA-256
                    deriving (Eq,Ord,Read,Show,Typeable)

fromIntegrityCheck :: IntegrityCheck -> Int
fromIntegrityCheck lc = case lc of
    IntegrityCheckNone   -> 0
{-# LINE 88 "src/LibLzma.hsc" #-}
    IntegrityCheckCrc32  -> 1
{-# LINE 89 "src/LibLzma.hsc" #-}
    IntegrityCheckCrc64  -> 4
{-# LINE 90 "src/LibLzma.hsc" #-}
    IntegrityCheckSha256 -> 10
{-# LINE 91 "src/LibLzma.hsc" #-}

-- | Compression level presets that define the tradeoff between
-- computational complexity and compression ratio
--
-- 'CompressionLevel0' has the lowest compression ratio as well as the
-- lowest memory requirements, whereas 'CompressionLevel9' has the
-- highest compression ratio and can require over 600MiB during
-- compression (and over 60MiB during decompression). The
-- <https://www.freebsd.org/cgi/man.cgi?query=xz&sektion=1&manpath=FreeBSD+10.2-stable&arch=default&format=html man-page for xz(1)>
-- contains more detailed information with tables describing the
-- properties of all compression level presets.
--
-- 'CompressionLevel6' is the default setting in
-- 'defaultCompressParams' as it provides a good trade-off and
-- matches the default of the @xz(1)@ tool.

data CompressionLevel = CompressionLevel0
                      | CompressionLevel1
                      | CompressionLevel2
                      | CompressionLevel3
                      | CompressionLevel4
                      | CompressionLevel5
                      | CompressionLevel6
                      | CompressionLevel7
                      | CompressionLevel8
                      | CompressionLevel9
                      deriving (Eq,Ord,Read,Show,Enum,Typeable)

-- | Set of parameters for decompression. The defaults are
-- 'defaultDecompressParams'.
data DecompressParams = DecompressParams
    { decompressTellNoCheck          :: !Bool -- ^ 'DecompressParams' field: If set, abort if decoded stream has no integrity check.
    , decompressTellUnsupportedCheck :: !Bool -- ^ 'DecompressParams' field: If set, abort (via 'LzmaRetGetCheck') if decoded stream integrity check is unsupported.
    , decompressTellAnyCheck         :: !Bool -- ^ 'DecompressParams' field: If set, abort (via 'LzmaRetGetCheck') as soon as the type of the integrity check has been detected.
    , decompressConcatenated         :: !Bool -- ^ 'DecompressParams' field: If set, concatenated files as decoded seamless.
    , decompressAutoDecoder          :: !Bool -- ^ 'DecompressParams' field: If set, legacy @.lzma@-encoded streams are allowed too.
    , decompressMemLimit             :: !Word64 -- ^ 'DecompressParams' field: decompressor memory limit. Set to 'maxBound' to disable memory limit.
    } deriving (Eq,Show)

-- | The default set of parameters for decompression. This is
-- typically used with the 'decompressWith' function with specific
-- parameters overridden.
defaultDecompressParams :: DecompressParams
defaultDecompressParams = DecompressParams {..}
  where
    decompressTellNoCheck          = False
    decompressTellUnsupportedCheck = False
    decompressTellAnyCheck         = False
    decompressConcatenated         = True
    decompressAutoDecoder          = False
    decompressMemLimit             = maxBound -- disables limit-check

-- | Set of parameters for compression. The defaults are 'defaultCompressParams'.
data CompressParams = CompressParams
    { compressIntegrityCheck :: !IntegrityCheck -- ^ 'CompressParams' field: Specify type of integrity check
    , compressLevel          :: !CompressionLevel -- ^ 'CompressParams' field: See documentation of 'CompressionLevel'
    , compressLevelExtreme   :: !Bool  -- ^ 'CompressParams' field: Enable slower variant of the
                                       -- 'lzmaCompLevel' preset, see @xz(1)@
                                       -- man-page for details.
    } deriving (Eq,Show)

-- | The default set of parameters for compression. This is typically
-- used with the 'compressWith' function with specific parameters
-- overridden.
defaultCompressParams :: CompressParams
defaultCompressParams = CompressParams {..}
  where
    compressIntegrityCheck = IntegrityCheckCrc64
    compressLevel          = CompressionLevel6
    compressLevelExtreme   = False

newDecodeLzmaStream :: DecompressParams -> ST s (Either LzmaRet LzmaStream)
newDecodeLzmaStream (DecompressParams {..}) = unsafeIOToST $ do
    fp <- mallocForeignPtrBytes ((136))
{-# LINE 165 "src/LibLzma.hsc" #-}
    addForeignPtrFinalizer c_hs_lzma_done_funptr fp
    rc <- withForeignPtr fp (\ptr -> c_hs_lzma_init_decoder ptr decompressAutoDecoder decompressMemLimit flags')
    rc' <- maybe (fail "newDecodeLzmaStream: invalid return code") pure $ toLzmaRet rc

    return $ case rc' of
        LzmaRetOK -> Right (LS fp)
        _         -> Left rc'
  where
    flags' =
        (if decompressTellNoCheck          then (1)          else 0) .|.
{-# LINE 175 "src/LibLzma.hsc" #-}
        (if decompressTellUnsupportedCheck then (2) else 0) .|.
{-# LINE 176 "src/LibLzma.hsc" #-}
        (if decompressTellAnyCheck         then (4)         else 0) .|.
{-# LINE 177 "src/LibLzma.hsc" #-}
        (if decompressConcatenated         then (8)           else 0)
{-# LINE 178 "src/LibLzma.hsc" #-}

newEncodeLzmaStream :: CompressParams -> ST s (Either LzmaRet LzmaStream)
newEncodeLzmaStream (CompressParams {..}) = unsafeIOToST $ do
    fp <- mallocForeignPtrBytes ((136))
{-# LINE 182 "src/LibLzma.hsc" #-}
    addForeignPtrFinalizer c_hs_lzma_done_funptr fp
    rc <- withForeignPtr fp (\ptr -> c_hs_lzma_init_encoder ptr preset check)
    rc' <- maybe (fail "newDecodeLzmaStream: invalid return code") pure $ toLzmaRet rc

    return $ case rc' of
        LzmaRetOK -> Right (LS fp)
        _         -> Left rc'

  where
    preset = fromIntegral (fromEnum compressLevel) .|.
             (if compressLevelExtreme then (2147483648) else 0)
{-# LINE 193 "src/LibLzma.hsc" #-}
    check = fromIntegrityCheck compressIntegrityCheck

data LzmaAction = LzmaRun
                | LzmaSyncFlush
                | LzmaFullFlush
                | LzmaFinish
                deriving (Eq,Show)

runLzmaStream :: LzmaStream -> ByteString -> LzmaAction -> Int -> ST s (LzmaRet,Int,ByteString)
runLzmaStream (LS ls) ibs action0 buflen
  | buflen <= 0 = return (LzmaRetOptionsError,0,BS.empty)
  | otherwise = unsafeIOToST $ withForeignPtr ls $ \lsptr ->
      BS.unsafeUseAsCStringLen ibs $ \(ibsptr, ibslen) -> do
          (obuf,rc) <- BS.createAndTrim' buflen $ \bufptr -> do
              rc' <- c_hs_lzma_run lsptr action (castPtr ibsptr) ibslen bufptr buflen
              rc'' <- maybe (fail "runLzmaStream: invalid return code") pure $ toLzmaRet rc'

              availOut <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) lsptr
{-# LINE 211 "src/LibLzma.hsc" #-}
              unless (buflen >= availOut && availOut >= 0) $
                  fail "runLzmaStream: invalid avail_out"
              let produced = buflen - availOut

              return (0, produced, rc'')

          availIn <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) lsptr
{-# LINE 218 "src/LibLzma.hsc" #-}
          unless (ibslen >= availIn && availIn >= 0) $
              fail "runLzmaStream: invalid avail_in"
          let consumed = ibslen - availIn
          -- print ("run", action0, BS.length ibs, buflen, rc, consumed, BS.length obuf)

          return (rc, fromIntegral consumed, obuf)
  where
    action = case action0 of
        LzmaRun       -> 0
{-# LINE 227 "src/LibLzma.hsc" #-}
        LzmaSyncFlush -> 1
{-# LINE 228 "src/LibLzma.hsc" #-}
        LzmaFullFlush -> 2
{-# LINE 229 "src/LibLzma.hsc" #-}
        LzmaFinish    -> 3
{-# LINE 230 "src/LibLzma.hsc" #-}


-- | Force immediate finalization of 'ForeignPtr' associated with
-- 'LzmaStream'.  This triggers a call to @lzma_end()@, therefore it's
-- a programming error to call 'runLzmaStream' afterwards.
endLzmaStream :: LzmaStream -> ST s ()
endLzmaStream (LS ls) = unsafeIOToST $ finalizeForeignPtr ls

----------------------------------------------------------------------------
-- trivial helper wrappers defined in ../cbits/lzma_wrapper.c

foreign import ccall "hs_lzma_init_decoder"
    c_hs_lzma_init_decoder :: Ptr LzmaStream -> Bool -> Word64 -> Word32 -> IO Int

foreign import ccall "hs_lzma_init_encoder"
    c_hs_lzma_init_encoder :: Ptr LzmaStream -> Word32 -> Int -> IO Int

foreign import ccall "hs_lzma_run"
    c_hs_lzma_run :: Ptr LzmaStream -> Int -> Ptr Word8 -> Int -> Ptr Word8 -> Int -> IO Int

foreign import ccall "&hs_lzma_done"
    c_hs_lzma_done_funptr :: FunPtr (Ptr LzmaStream -> IO ())