    {-# 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 ())