{-# 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 (LzmaRet -> LzmaRet -> Bool
(LzmaRet -> LzmaRet -> Bool)
-> (LzmaRet -> LzmaRet -> Bool) -> Eq LzmaRet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LzmaRet -> LzmaRet -> Bool
$c/= :: LzmaRet -> LzmaRet -> Bool
== :: LzmaRet -> LzmaRet -> Bool
$c== :: LzmaRet -> LzmaRet -> Bool
Eq,Eq LzmaRet
Eq LzmaRet
-> (LzmaRet -> LzmaRet -> Ordering)
-> (LzmaRet -> LzmaRet -> Bool)
-> (LzmaRet -> LzmaRet -> Bool)
-> (LzmaRet -> LzmaRet -> Bool)
-> (LzmaRet -> LzmaRet -> Bool)
-> (LzmaRet -> LzmaRet -> LzmaRet)
-> (LzmaRet -> LzmaRet -> LzmaRet)
-> Ord LzmaRet
LzmaRet -> LzmaRet -> Bool
LzmaRet -> LzmaRet -> Ordering
LzmaRet -> LzmaRet -> LzmaRet
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LzmaRet -> LzmaRet -> LzmaRet
$cmin :: LzmaRet -> LzmaRet -> LzmaRet
max :: LzmaRet -> LzmaRet -> LzmaRet
$cmax :: LzmaRet -> LzmaRet -> LzmaRet
>= :: LzmaRet -> LzmaRet -> Bool
$c>= :: LzmaRet -> LzmaRet -> Bool
> :: LzmaRet -> LzmaRet -> Bool
$c> :: LzmaRet -> LzmaRet -> Bool
<= :: LzmaRet -> LzmaRet -> Bool
$c<= :: LzmaRet -> LzmaRet -> Bool
< :: LzmaRet -> LzmaRet -> Bool
$c< :: LzmaRet -> LzmaRet -> Bool
compare :: LzmaRet -> LzmaRet -> Ordering
$ccompare :: LzmaRet -> LzmaRet -> Ordering
$cp1Ord :: Eq LzmaRet
Ord,ReadPrec [LzmaRet]
ReadPrec LzmaRet
Int -> ReadS LzmaRet
ReadS [LzmaRet]
(Int -> ReadS LzmaRet)
-> ReadS [LzmaRet]
-> ReadPrec LzmaRet
-> ReadPrec [LzmaRet]
-> Read LzmaRet
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LzmaRet]
$creadListPrec :: ReadPrec [LzmaRet]
readPrec :: ReadPrec LzmaRet
$creadPrec :: ReadPrec LzmaRet
readList :: ReadS [LzmaRet]
$creadList :: ReadS [LzmaRet]
readsPrec :: Int -> ReadS LzmaRet
$creadsPrec :: Int -> ReadS LzmaRet
Read,Int -> LzmaRet -> ShowS
[LzmaRet] -> ShowS
LzmaRet -> String
(Int -> LzmaRet -> ShowS)
-> (LzmaRet -> String) -> ([LzmaRet] -> ShowS) -> Show LzmaRet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LzmaRet] -> ShowS
$cshowList :: [LzmaRet] -> ShowS
show :: LzmaRet -> String
$cshow :: LzmaRet -> String
showsPrec :: Int -> LzmaRet -> ShowS
$cshowsPrec :: Int -> LzmaRet -> ShowS
Show,Typeable)

instance Exception LzmaRet

toLzmaRet :: Int -> Maybe LzmaRet
toLzmaRet :: Int -> Maybe LzmaRet
toLzmaRet Int
i = case Int
i of
    (Int
0) -> LzmaRet -> Maybe LzmaRet
forall a. a -> Maybe a
Just LzmaRet
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 (IntegrityCheck -> IntegrityCheck -> Bool
(IntegrityCheck -> IntegrityCheck -> Bool)
-> (IntegrityCheck -> IntegrityCheck -> Bool) -> Eq IntegrityCheck
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IntegrityCheck -> IntegrityCheck -> Bool
$c/= :: IntegrityCheck -> IntegrityCheck -> Bool
== :: IntegrityCheck -> IntegrityCheck -> Bool
$c== :: IntegrityCheck -> IntegrityCheck -> Bool
Eq,Eq IntegrityCheck
Eq IntegrityCheck
-> (IntegrityCheck -> IntegrityCheck -> Ordering)
-> (IntegrityCheck -> IntegrityCheck -> Bool)
-> (IntegrityCheck -> IntegrityCheck -> Bool)
-> (IntegrityCheck -> IntegrityCheck -> Bool)
-> (IntegrityCheck -> IntegrityCheck -> Bool)
-> (IntegrityCheck -> IntegrityCheck -> IntegrityCheck)
-> (IntegrityCheck -> IntegrityCheck -> IntegrityCheck)
-> Ord IntegrityCheck
IntegrityCheck -> IntegrityCheck -> Bool
IntegrityCheck -> IntegrityCheck -> Ordering
IntegrityCheck -> IntegrityCheck -> IntegrityCheck
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IntegrityCheck -> IntegrityCheck -> IntegrityCheck
$cmin :: IntegrityCheck -> IntegrityCheck -> IntegrityCheck
max :: IntegrityCheck -> IntegrityCheck -> IntegrityCheck
$cmax :: IntegrityCheck -> IntegrityCheck -> IntegrityCheck
>= :: IntegrityCheck -> IntegrityCheck -> Bool
$c>= :: IntegrityCheck -> IntegrityCheck -> Bool
> :: IntegrityCheck -> IntegrityCheck -> Bool
$c> :: IntegrityCheck -> IntegrityCheck -> Bool
<= :: IntegrityCheck -> IntegrityCheck -> Bool
$c<= :: IntegrityCheck -> IntegrityCheck -> Bool
< :: IntegrityCheck -> IntegrityCheck -> Bool
$c< :: IntegrityCheck -> IntegrityCheck -> Bool
compare :: IntegrityCheck -> IntegrityCheck -> Ordering
$ccompare :: IntegrityCheck -> IntegrityCheck -> Ordering
$cp1Ord :: Eq IntegrityCheck
Ord,ReadPrec [IntegrityCheck]
ReadPrec IntegrityCheck
Int -> ReadS IntegrityCheck
ReadS [IntegrityCheck]
(Int -> ReadS IntegrityCheck)
-> ReadS [IntegrityCheck]
-> ReadPrec IntegrityCheck
-> ReadPrec [IntegrityCheck]
-> Read IntegrityCheck
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IntegrityCheck]
$creadListPrec :: ReadPrec [IntegrityCheck]
readPrec :: ReadPrec IntegrityCheck
$creadPrec :: ReadPrec IntegrityCheck
readList :: ReadS [IntegrityCheck]
$creadList :: ReadS [IntegrityCheck]
readsPrec :: Int -> ReadS IntegrityCheck
$creadsPrec :: Int -> ReadS IntegrityCheck
Read,Int -> IntegrityCheck -> ShowS
[IntegrityCheck] -> ShowS
IntegrityCheck -> String
(Int -> IntegrityCheck -> ShowS)
-> (IntegrityCheck -> String)
-> ([IntegrityCheck] -> ShowS)
-> Show IntegrityCheck
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IntegrityCheck] -> ShowS
$cshowList :: [IntegrityCheck] -> ShowS
show :: IntegrityCheck -> String
$cshow :: IntegrityCheck -> String
showsPrec :: Int -> IntegrityCheck -> ShowS
$cshowsPrec :: Int -> IntegrityCheck -> ShowS
Show,Typeable)

fromIntegrityCheck :: IntegrityCheck -> Int
fromIntegrityCheck :: IntegrityCheck -> Int
fromIntegrityCheck IntegrityCheck
lc = case IntegrityCheck
lc of
    IntegrityCheck
IntegrityCheckNone   -> Int
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 (CompressionLevel -> CompressionLevel -> Bool
(CompressionLevel -> CompressionLevel -> Bool)
-> (CompressionLevel -> CompressionLevel -> Bool)
-> Eq CompressionLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompressionLevel -> CompressionLevel -> Bool
$c/= :: CompressionLevel -> CompressionLevel -> Bool
== :: CompressionLevel -> CompressionLevel -> Bool
$c== :: CompressionLevel -> CompressionLevel -> Bool
Eq,Eq CompressionLevel
Eq CompressionLevel
-> (CompressionLevel -> CompressionLevel -> Ordering)
-> (CompressionLevel -> CompressionLevel -> Bool)
-> (CompressionLevel -> CompressionLevel -> Bool)
-> (CompressionLevel -> CompressionLevel -> Bool)
-> (CompressionLevel -> CompressionLevel -> Bool)
-> (CompressionLevel -> CompressionLevel -> CompressionLevel)
-> (CompressionLevel -> CompressionLevel -> CompressionLevel)
-> Ord CompressionLevel
CompressionLevel -> CompressionLevel -> Bool
CompressionLevel -> CompressionLevel -> Ordering
CompressionLevel -> CompressionLevel -> CompressionLevel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CompressionLevel -> CompressionLevel -> CompressionLevel
$cmin :: CompressionLevel -> CompressionLevel -> CompressionLevel
max :: CompressionLevel -> CompressionLevel -> CompressionLevel
$cmax :: CompressionLevel -> CompressionLevel -> CompressionLevel
>= :: CompressionLevel -> CompressionLevel -> Bool
$c>= :: CompressionLevel -> CompressionLevel -> Bool
> :: CompressionLevel -> CompressionLevel -> Bool
$c> :: CompressionLevel -> CompressionLevel -> Bool
<= :: CompressionLevel -> CompressionLevel -> Bool
$c<= :: CompressionLevel -> CompressionLevel -> Bool
< :: CompressionLevel -> CompressionLevel -> Bool
$c< :: CompressionLevel -> CompressionLevel -> Bool
compare :: CompressionLevel -> CompressionLevel -> Ordering
$ccompare :: CompressionLevel -> CompressionLevel -> Ordering
$cp1Ord :: Eq CompressionLevel
Ord,ReadPrec [CompressionLevel]
ReadPrec CompressionLevel
Int -> ReadS CompressionLevel
ReadS [CompressionLevel]
(Int -> ReadS CompressionLevel)
-> ReadS [CompressionLevel]
-> ReadPrec CompressionLevel
-> ReadPrec [CompressionLevel]
-> Read CompressionLevel
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CompressionLevel]
$creadListPrec :: ReadPrec [CompressionLevel]
readPrec :: ReadPrec CompressionLevel
$creadPrec :: ReadPrec CompressionLevel
readList :: ReadS [CompressionLevel]
$creadList :: ReadS [CompressionLevel]
readsPrec :: Int -> ReadS CompressionLevel
$creadsPrec :: Int -> ReadS CompressionLevel
Read,Int -> CompressionLevel -> ShowS
[CompressionLevel] -> ShowS
CompressionLevel -> String
(Int -> CompressionLevel -> ShowS)
-> (CompressionLevel -> String)
-> ([CompressionLevel] -> ShowS)
-> Show CompressionLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompressionLevel] -> ShowS
$cshowList :: [CompressionLevel] -> ShowS
show :: CompressionLevel -> String
$cshow :: CompressionLevel -> String
showsPrec :: Int -> CompressionLevel -> ShowS
$cshowsPrec :: Int -> CompressionLevel -> ShowS
Show,Int -> CompressionLevel
CompressionLevel -> Int
CompressionLevel -> [CompressionLevel]
CompressionLevel -> CompressionLevel
CompressionLevel -> CompressionLevel -> [CompressionLevel]
CompressionLevel
-> CompressionLevel -> CompressionLevel -> [CompressionLevel]
(CompressionLevel -> CompressionLevel)
-> (CompressionLevel -> CompressionLevel)
-> (Int -> CompressionLevel)
-> (CompressionLevel -> Int)
-> (CompressionLevel -> [CompressionLevel])
-> (CompressionLevel -> CompressionLevel -> [CompressionLevel])
-> (CompressionLevel -> CompressionLevel -> [CompressionLevel])
-> (CompressionLevel
    -> CompressionLevel -> CompressionLevel -> [CompressionLevel])
-> Enum CompressionLevel
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CompressionLevel
-> CompressionLevel -> CompressionLevel -> [CompressionLevel]
$cenumFromThenTo :: CompressionLevel
-> CompressionLevel -> CompressionLevel -> [CompressionLevel]
enumFromTo :: CompressionLevel -> CompressionLevel -> [CompressionLevel]
$cenumFromTo :: CompressionLevel -> CompressionLevel -> [CompressionLevel]
enumFromThen :: CompressionLevel -> CompressionLevel -> [CompressionLevel]
$cenumFromThen :: CompressionLevel -> CompressionLevel -> [CompressionLevel]
enumFrom :: CompressionLevel -> [CompressionLevel]
$cenumFrom :: CompressionLevel -> [CompressionLevel]
fromEnum :: CompressionLevel -> Int
$cfromEnum :: CompressionLevel -> Int
toEnum :: Int -> CompressionLevel
$ctoEnum :: Int -> CompressionLevel
pred :: CompressionLevel -> CompressionLevel
$cpred :: CompressionLevel -> CompressionLevel
succ :: CompressionLevel -> CompressionLevel
$csucc :: CompressionLevel -> CompressionLevel
Enum,Typeable)

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

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

-- | Set of parameters for compression. The defaults are 'defaultCompressParams'.
data CompressParams = CompressParams
    { CompressParams -> IntegrityCheck
compressIntegrityCheck :: !IntegrityCheck -- ^ 'CompressParams' field: Specify type of integrity check
    , CompressParams -> CompressionLevel
compressLevel          :: !CompressionLevel -- ^ 'CompressParams' field: See documentation of 'CompressionLevel'
    , CompressParams -> Bool
compressLevelExtreme   :: !Bool  -- ^ 'CompressParams' field: Enable slower variant of the
                                       -- 'lzmaCompLevel' preset, see @xz(1)@
                                       -- man-page for details.
    } deriving (CompressParams -> CompressParams -> Bool
(CompressParams -> CompressParams -> Bool)
-> (CompressParams -> CompressParams -> Bool) -> Eq CompressParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompressParams -> CompressParams -> Bool
$c/= :: CompressParams -> CompressParams -> Bool
== :: CompressParams -> CompressParams -> Bool
$c== :: CompressParams -> CompressParams -> Bool
Eq,Int -> CompressParams -> ShowS
[CompressParams] -> ShowS
CompressParams -> String
(Int -> CompressParams -> ShowS)
-> (CompressParams -> String)
-> ([CompressParams] -> ShowS)
-> Show CompressParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompressParams] -> ShowS
$cshowList :: [CompressParams] -> ShowS
show :: CompressParams -> String
$cshow :: CompressParams -> String
showsPrec :: Int -> CompressParams -> ShowS
$cshowsPrec :: Int -> CompressParams -> ShowS
Show)

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

newDecodeLzmaStream :: DecompressParams -> ST s (Either LzmaRet LzmaStream)
newDecodeLzmaStream :: DecompressParams -> ST s (Either LzmaRet LzmaStream)
newDecodeLzmaStream (DecompressParams {Bool
Word64
decompressMemLimit :: Word64
decompressAutoDecoder :: Bool
decompressConcatenated :: Bool
decompressTellAnyCheck :: Bool
decompressTellUnsupportedCheck :: Bool
decompressTellNoCheck :: Bool
decompressMemLimit :: DecompressParams -> Word64
decompressAutoDecoder :: DecompressParams -> Bool
decompressConcatenated :: DecompressParams -> Bool
decompressTellAnyCheck :: DecompressParams -> Bool
decompressTellUnsupportedCheck :: DecompressParams -> Bool
decompressTellNoCheck :: DecompressParams -> Bool
..}) = IO (Either LzmaRet LzmaStream) -> ST s (Either LzmaRet LzmaStream)
forall a s. IO a -> ST s a
unsafeIOToST (IO (Either LzmaRet LzmaStream)
 -> ST s (Either LzmaRet LzmaStream))
-> IO (Either LzmaRet LzmaStream)
-> ST s (Either LzmaRet LzmaStream)
forall a b. (a -> b) -> a -> b
$ do
    ForeignPtr LzmaStream
fp <- Int -> IO (ForeignPtr LzmaStream)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes ((Int
136))
{-# LINE 165 "src/LibLzma.hsc" #-}
    addForeignPtrFinalizer c_hs_lzma_done_funptr fp
    Int
rc <- ForeignPtr LzmaStream -> (Ptr LzmaStream -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr LzmaStream
fp (\Ptr LzmaStream
ptr -> Ptr LzmaStream -> Bool -> Word64 -> Word32 -> IO Int
c_hs_lzma_init_decoder Ptr LzmaStream
ptr Bool
decompressAutoDecoder Word64
decompressMemLimit Word32
flags')
    LzmaRet
rc' <- IO LzmaRet
-> (LzmaRet -> IO LzmaRet) -> Maybe LzmaRet -> IO LzmaRet
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> IO LzmaRet
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"newDecodeLzmaStream: invalid return code") LzmaRet -> IO LzmaRet
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe LzmaRet -> IO LzmaRet) -> Maybe LzmaRet -> IO LzmaRet
forall a b. (a -> b) -> a -> b
$ Int -> Maybe LzmaRet
toLzmaRet Int
rc

    Either LzmaRet LzmaStream -> IO (Either LzmaRet LzmaStream)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either LzmaRet LzmaStream -> IO (Either LzmaRet LzmaStream))
-> Either LzmaRet LzmaStream -> IO (Either LzmaRet LzmaStream)
forall a b. (a -> b) -> a -> b
$ case LzmaRet
rc' of
        LzmaRet
LzmaRetOK -> LzmaStream -> Either LzmaRet LzmaStream
forall a b. b -> Either a b
Right (ForeignPtr LzmaStream -> LzmaStream
LS ForeignPtr LzmaStream
fp)
        LzmaRet
_         -> LzmaRet -> Either LzmaRet LzmaStream
forall a b. a -> Either a b
Left LzmaRet
rc'
  where
    flags' :: Word32
flags' =
        (if Bool
decompressTellNoCheck          then (Word32
1)          else Word32
0) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
{-# LINE 175 "src/LibLzma.hsc" #-}
        (if Bool
decompressTellUnsupportedCheck then (Word32
2) else Word32
0) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
{-# LINE 176 "src/LibLzma.hsc" #-}
        (if Bool
decompressTellAnyCheck         then (Word32
4)         else Word32
0) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
{-# LINE 177 "src/LibLzma.hsc" #-}
        (if Bool
decompressConcatenated         then (Word32
8)           else Word32
0)
{-# LINE 178 "src/LibLzma.hsc" #-}

newEncodeLzmaStream :: CompressParams -> ST s (Either LzmaRet LzmaStream)
newEncodeLzmaStream :: CompressParams -> ST s (Either LzmaRet LzmaStream)
newEncodeLzmaStream (CompressParams {Bool
CompressionLevel
IntegrityCheck
compressLevelExtreme :: Bool
compressLevel :: CompressionLevel
compressIntegrityCheck :: IntegrityCheck
compressLevelExtreme :: CompressParams -> Bool
compressLevel :: CompressParams -> CompressionLevel
compressIntegrityCheck :: CompressParams -> IntegrityCheck
..}) = IO (Either LzmaRet LzmaStream) -> ST s (Either LzmaRet LzmaStream)
forall a s. IO a -> ST s a
unsafeIOToST (IO (Either LzmaRet LzmaStream)
 -> ST s (Either LzmaRet LzmaStream))
-> IO (Either LzmaRet LzmaStream)
-> ST s (Either LzmaRet LzmaStream)
forall a b. (a -> b) -> a -> b
$ do
    ForeignPtr LzmaStream
fp <- Int -> IO (ForeignPtr LzmaStream)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes ((Int
136))
{-# LINE 182 "src/LibLzma.hsc" #-}
    addForeignPtrFinalizer c_hs_lzma_done_funptr fp
    Int
rc <- ForeignPtr LzmaStream -> (Ptr LzmaStream -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr LzmaStream
fp (\Ptr LzmaStream
ptr -> Ptr LzmaStream -> Word32 -> Int -> IO Int
c_hs_lzma_init_encoder Ptr LzmaStream
ptr Word32
preset Int
check)
    LzmaRet
rc' <- IO LzmaRet
-> (LzmaRet -> IO LzmaRet) -> Maybe LzmaRet -> IO LzmaRet
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> IO LzmaRet
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"newDecodeLzmaStream: invalid return code") LzmaRet -> IO LzmaRet
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe LzmaRet -> IO LzmaRet) -> Maybe LzmaRet -> IO LzmaRet
forall a b. (a -> b) -> a -> b
$ Int -> Maybe LzmaRet
toLzmaRet Int
rc

    Either LzmaRet LzmaStream -> IO (Either LzmaRet LzmaStream)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either LzmaRet LzmaStream -> IO (Either LzmaRet LzmaStream))
-> Either LzmaRet LzmaStream -> IO (Either LzmaRet LzmaStream)
forall a b. (a -> b) -> a -> b
$ case LzmaRet
rc' of
        LzmaRet
LzmaRetOK -> LzmaStream -> Either LzmaRet LzmaStream
forall a b. b -> Either a b
Right (ForeignPtr LzmaStream -> LzmaStream
LS ForeignPtr LzmaStream
fp)
        LzmaRet
_         -> LzmaRet -> Either LzmaRet LzmaStream
forall a b. a -> Either a b
Left LzmaRet
rc'

  where
    preset :: Word32
preset = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CompressionLevel -> Int
forall a. Enum a => a -> Int
fromEnum CompressionLevel
compressLevel) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
             (if Bool
compressLevelExtreme then (Word32
2147483648) else Word32
0)
{-# LINE 193 "src/LibLzma.hsc" #-}
    check = fromIntegrityCheck compressIntegrityCheck

data LzmaAction = LzmaRun
                | LzmaSyncFlush
                | LzmaFullFlush
                | LzmaFinish
                deriving (LzmaAction -> LzmaAction -> Bool
(LzmaAction -> LzmaAction -> Bool)
-> (LzmaAction -> LzmaAction -> Bool) -> Eq LzmaAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LzmaAction -> LzmaAction -> Bool
$c/= :: LzmaAction -> LzmaAction -> Bool
== :: LzmaAction -> LzmaAction -> Bool
$c== :: LzmaAction -> LzmaAction -> Bool
Eq,Int -> LzmaAction -> ShowS
[LzmaAction] -> ShowS
LzmaAction -> String
(Int -> LzmaAction -> ShowS)
-> (LzmaAction -> String)
-> ([LzmaAction] -> ShowS)
-> Show LzmaAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LzmaAction] -> ShowS
$cshowList :: [LzmaAction] -> ShowS
show :: LzmaAction -> String
$cshow :: LzmaAction -> String
showsPrec :: Int -> LzmaAction -> ShowS
$cshowsPrec :: Int -> LzmaAction -> ShowS
Show)

runLzmaStream :: LzmaStream -> ByteString -> LzmaAction -> Int -> ST s (LzmaRet,Int,ByteString)
runLzmaStream :: LzmaStream
-> ByteString
-> LzmaAction
-> Int
-> ST s (LzmaRet, Int, ByteString)
runLzmaStream (LS ForeignPtr LzmaStream
ls) ByteString
ibs LzmaAction
action0 Int
buflen
  | Int
buflen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = (LzmaRet, Int, ByteString) -> ST s (LzmaRet, Int, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (LzmaRet
LzmaRetOptionsError,Int
0,ByteString
BS.empty)
  | Bool
otherwise = IO (LzmaRet, Int, ByteString) -> ST s (LzmaRet, Int, ByteString)
forall a s. IO a -> ST s a
unsafeIOToST (IO (LzmaRet, Int, ByteString) -> ST s (LzmaRet, Int, ByteString))
-> IO (LzmaRet, Int, ByteString) -> ST s (LzmaRet, Int, ByteString)
forall a b. (a -> b) -> a -> b
$ ForeignPtr LzmaStream
-> (Ptr LzmaStream -> IO (LzmaRet, Int, ByteString))
-> IO (LzmaRet, Int, ByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr LzmaStream
ls ((Ptr LzmaStream -> IO (LzmaRet, Int, ByteString))
 -> IO (LzmaRet, Int, ByteString))
-> (Ptr LzmaStream -> IO (LzmaRet, Int, ByteString))
-> IO (LzmaRet, Int, ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr LzmaStream
lsptr ->
      ByteString
-> (CStringLen -> IO (LzmaRet, Int, ByteString))
-> IO (LzmaRet, Int, ByteString)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen ByteString
ibs ((CStringLen -> IO (LzmaRet, Int, ByteString))
 -> IO (LzmaRet, Int, ByteString))
-> (CStringLen -> IO (LzmaRet, Int, ByteString))
-> IO (LzmaRet, Int, ByteString)
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
ibsptr, Int
ibslen) -> do
          (ByteString
obuf,LzmaRet
rc) <- Int
-> (Ptr Word8 -> IO (Int, Int, LzmaRet))
-> IO (ByteString, LzmaRet)
forall a.
Int -> (Ptr Word8 -> IO (Int, Int, a)) -> IO (ByteString, a)
BS.createAndTrim' Int
buflen ((Ptr Word8 -> IO (Int, Int, LzmaRet)) -> IO (ByteString, LzmaRet))
-> (Ptr Word8 -> IO (Int, Int, LzmaRet))
-> IO (ByteString, LzmaRet)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
bufptr -> do
              Int
rc' <- Ptr LzmaStream
-> Int -> Ptr Word8 -> Int -> Ptr Word8 -> Int -> IO Int
c_hs_lzma_run Ptr LzmaStream
lsptr Int
action (Ptr CChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
ibsptr) Int
ibslen Ptr Word8
bufptr Int
buflen
              LzmaRet
rc'' <- IO LzmaRet
-> (LzmaRet -> IO LzmaRet) -> Maybe LzmaRet -> IO LzmaRet
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> IO LzmaRet
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"runLzmaStream: invalid return code") LzmaRet -> IO LzmaRet
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe LzmaRet -> IO LzmaRet) -> Maybe LzmaRet -> IO LzmaRet
forall a b. (a -> b) -> a -> b
$ Int -> Maybe LzmaRet
toLzmaRet Int
rc'

              Int
availOut <- ((\Ptr LzmaStream
hsc_ptr -> Ptr LzmaStream -> Int -> IO Int
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr LzmaStream
hsc_ptr Int
32)) Ptr LzmaStream
lsptr
{-# LINE 211 "src/LibLzma.hsc" #-}
              Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
buflen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
availOut Bool -> Bool -> Bool
&& Int
availOut Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                  String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"runLzmaStream: invalid avail_out"
              let produced :: Int
produced = Int
buflen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
availOut

              (Int, Int, LzmaRet) -> IO (Int, Int, LzmaRet)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
0, Int
produced, LzmaRet
rc'')

          Int
availIn <- ((\Ptr LzmaStream
hsc_ptr -> Ptr LzmaStream -> Int -> IO Int
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr LzmaStream
hsc_ptr Int
8)) Ptr LzmaStream
lsptr
{-# LINE 218 "src/LibLzma.hsc" #-}
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
ibslen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
availIn Bool -> Bool -> Bool
&& Int
availIn Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
              String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"runLzmaStream: invalid avail_in"
          let consumed :: Int
consumed = Int
ibslen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
availIn
          -- print ("run", action0, BS.length ibs, buflen, rc, consumed, BS.length obuf)

          (LzmaRet, Int, ByteString) -> IO (LzmaRet, Int, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (LzmaRet
rc, Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
consumed, ByteString
obuf)
  where
    action :: Int
action = case LzmaAction
action0 of
        LzmaAction
LzmaRun       -> Int
0
{-# LINE 227 "src/LibLzma.hsc" #-}
        LzmaAction
LzmaSyncFlush -> Int
1
{-# LINE 228 "src/LibLzma.hsc" #-}
        LzmaAction
LzmaFullFlush -> Int
2
{-# LINE 229 "src/LibLzma.hsc" #-}
        LzmaAction
LzmaFinish    -> Int
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 :: LzmaStream -> ST s ()
endLzmaStream (LS ForeignPtr LzmaStream
ls) = IO () -> ST s ()
forall a s. IO a -> ST s a
unsafeIOToST (IO () -> ST s ()) -> IO () -> ST s ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr LzmaStream -> IO ()
forall a. ForeignPtr a -> IO ()
finalizeForeignPtr ForeignPtr LzmaStream
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 ())