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

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

-- | Internal low-level binding to liblzma
--
-- TODO: Polish, generalise, and factor out into streaming-API
--       agnostic package w/ minimal build-deps.
--       Something in the style of the incremental API in
--       "Codec.Compression.Zlib.Internal" would be nice
--
module LibLzma
    ( LzmaStream
    , LzmaRet(..)
    , LzmaCheck(..)
    , LzmaCompLevel(..)

    , newDecodeLzmaStream
    , DecodeLzmaFlags(..)
    , defaultDecodeLzmaFlags

    , newEncodeLzmaStream
    , EncodeLzmaFlags(..)
    , defaultEncodeLzmaFlags

    , runLzmaStream
    ) where

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


{-# LINE 43 "src/LibLzma.hsc" #-}

newtype LzmaStream = LS (ForeignPtr LzmaStream)

data LzmaRet = LZMA_OK
             | LZMA_STREAM_END
             | LZMA_UNSUPPORTED_CHECK
             | LZMA_GET_CHECK
             | LZMA_MEM_ERROR
             | LZMA_MEMLIMIT_ERROR
             | LZMA_FORMAT_ERROR
             | LZMA_OPTIONS_ERROR
             | LZMA_DATA_ERROR
             | LZMA_BUF_ERROR
             | LZMA_PROG_ERROR
             deriving (Eq,Ord,Show,Typeable)

instance Exception LzmaRet

toLzmaRet :: Int -> Maybe LzmaRet
toLzmaRet i = case i of
    (0) -> Just LZMA_OK
{-# LINE 64 "src/LibLzma.hsc" #-}
    (1) -> Just LZMA_STREAM_END
{-# LINE 65 "src/LibLzma.hsc" #-}
    (3) -> Just LZMA_UNSUPPORTED_CHECK
{-# LINE 66 "src/LibLzma.hsc" #-}
    (4) -> Just LZMA_GET_CHECK
{-# LINE 67 "src/LibLzma.hsc" #-}
    (5) -> Just LZMA_MEM_ERROR
{-# LINE 68 "src/LibLzma.hsc" #-}
    (6) -> Just LZMA_MEMLIMIT_ERROR
{-# LINE 69 "src/LibLzma.hsc" #-}
    (7) -> Just LZMA_FORMAT_ERROR
{-# LINE 70 "src/LibLzma.hsc" #-}
    (8) -> Just LZMA_OPTIONS_ERROR
{-# LINE 71 "src/LibLzma.hsc" #-}
    (9) -> Just LZMA_DATA_ERROR
{-# LINE 72 "src/LibLzma.hsc" #-}
    (10) -> Just LZMA_BUF_ERROR
{-# LINE 73 "src/LibLzma.hsc" #-}
    (11) -> Just LZMA_PROG_ERROR
{-# LINE 74 "src/LibLzma.hsc" #-}
    _                               -> Nothing



data LzmaCheck = LzmaCheckNone
               | LzmaCheckCrc32
               | LzmaCheckCrc64
               | LzmaCheckSha256
               deriving (Eq,Ord,Show)

data LzmaCompLevel = LzmaCompLevel0
                   | LzmaCompLevel1
                   | LzmaCompLevel2
                   | LzmaCompLevel3
                   | LzmaCompLevel4
                   | LzmaCompLevel5
                   | LzmaCompLevel6
                   | LzmaCompLevel7
                   | LzmaCompLevel8
                   | LzmaCompLevel9
                   deriving (Eq,Ord,Show,Enum)

fromLzmaCheck :: LzmaCheck -> Int
fromLzmaCheck lc = case lc of
    LzmaCheckNone   -> 0
{-# LINE 99 "src/LibLzma.hsc" #-}
    LzmaCheckCrc32  -> 1
{-# LINE 100 "src/LibLzma.hsc" #-}
    LzmaCheckCrc64  -> 4
{-# LINE 101 "src/LibLzma.hsc" #-}
    LzmaCheckSha256 -> 10
{-# LINE 102 "src/LibLzma.hsc" #-}

data DecodeLzmaFlags = DecodeLzmaFlags
    { lzmaTellNoCheck          :: !Bool
    , lzmaTellUnsupportedCheck :: !Bool
    , lzmaTellAnyCheck         :: !Bool
    , lzmaConcatenated         :: !Bool
    , lzmaAutoDecoder          :: !Bool
    , lzmaMemLimit             :: !Word64
    } deriving (Eq,Show)

defaultDecodeLzmaFlags :: DecodeLzmaFlags
defaultDecodeLzmaFlags = DecodeLzmaFlags {..}
  where
    lzmaTellNoCheck          = False
    lzmaTellUnsupportedCheck = False
    lzmaTellAnyCheck         = False
    lzmaConcatenated         = True
    lzmaAutoDecoder          = False
    lzmaMemLimit             = maxBound -- disables limit-check

data EncodeLzmaFlags = EncodeLzmaFlags
    { lzmaCheck     :: !LzmaCheck
    , lzmaCompLevel :: !LzmaCompLevel
    , lzmaExtreme   :: !Bool
    } deriving (Eq,Show)

defaultEncodeLzmaFlags :: EncodeLzmaFlags
defaultEncodeLzmaFlags = EncodeLzmaFlags LzmaCheckCrc32 LzmaCompLevel6 False

newDecodeLzmaStream :: DecodeLzmaFlags -> IO (Either LzmaRet LzmaStream)
newDecodeLzmaStream (DecodeLzmaFlags {..}) = do
    fp <- mallocForeignPtrBytes ((136))
{-# LINE 134 "src/LibLzma.hsc" #-}
    addForeignPtrFinalizer c_hs_lzma_done_funptr fp
    rc <- withForeignPtr fp (\ptr -> c_hs_lzma_init_decoder ptr lzmaAutoDecoder lzmaMemLimit flags')
    rc' <- maybe (fail "newDecodeLzmaStream: invalid return code") pure $ toLzmaRet rc

    return $ case rc' of
        LZMA_OK -> Right (LS fp)
        _       -> Left rc'
  where
    flags' =
        (if lzmaTellNoCheck          then (1)          else 0) .|.
{-# LINE 144 "src/LibLzma.hsc" #-}
        (if lzmaTellUnsupportedCheck then (2) else 0) .|.
{-# LINE 145 "src/LibLzma.hsc" #-}
        (if lzmaTellAnyCheck         then (4)         else 0) .|.
{-# LINE 146 "src/LibLzma.hsc" #-}
        (if lzmaConcatenated         then (8)           else 0)
{-# LINE 147 "src/LibLzma.hsc" #-}

newEncodeLzmaStream :: EncodeLzmaFlags -> IO (Either LzmaRet LzmaStream)
newEncodeLzmaStream (EncodeLzmaFlags {..}) = do
    fp <- mallocForeignPtrBytes ((136))
{-# LINE 151 "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
        LZMA_OK -> Right (LS fp)
        _       -> Left rc'

  where
    preset = fromIntegral (fromEnum lzmaCompLevel) .|.
             (if lzmaExtreme then (2147483648) else 0)
{-# LINE 162 "src/LibLzma.hsc" #-}
    check = fromLzmaCheck lzmaCheck

runLzmaStream :: LzmaStream -> ByteString -> Bool -> Int -> IO (LzmaRet,Int,ByteString)
runLzmaStream (LS ls) ibs finish buflen
  | buflen <= 0 = fail "runLzmaStream: invalid buflen argument"
  | otherwise = withForeignPtr ls $ \lsptr -> do
      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 174 "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 180 "src/LibLzma.hsc" #-}
          unless (ibslen >= availIn && availIn >= 0) (fail "runLzmaStream: invalid avail_in")
          let consumed = ibslen - availIn

          return (rc, fromIntegral consumed, obuf)
  where
    action = if finish then (3) else (0)
{-# LINE 186 "src/LibLzma.hsc" #-}

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