module Codec.Compression.Lzo.File ( decompressFile
                                  , compressFile
                                  ) where

import           Codec.Compression.Lzo.Block
import           Control.Monad               (unless, when)
import           Data.Binary.Get             (Get, getByteString, getWord16be, getWord32be, getWord8, lookAhead, runGetOrFail, skip)
import           Data.Binary.Put             (Put, putByteString, putLazyByteString, putWord16be, putWord32be, putWord8, runPut)
import           Data.Bits                   (Bits, (.&.), (.|.))
import qualified Data.ByteString             as BS
import qualified Data.ByteString.Lazy        as BSL
import           Data.Digest.Adler32         (adler32)
import           Data.Digest.CRC32           (crc32)
import           Data.Semigroup              ((<>))
import           Data.Word                   (Word32)

-- see: https://github.com/ir193/python-lzo/
-- see https://github.com/libarchive/libarchive/blob/3649ed23c6b4392d692580c03b10a611e3eaaa32/libarchive/archive_read_support_filter_lzop.c
lzopMagic :: BS.ByteString
lzopMagic :: ByteString
lzopMagic = [Word8] -> ByteString
BS.pack [Word8
0x89, Word8
0x4c, Word8
0x5a, Word8
0x4f, Word8
0x00, Word8
0x0d, Word8
0x0a, Word8
0x1a, Word8
0x0a]

hasFlag :: (Num a, Bits a) => a -> a -> Bool
hasFlag :: forall a. (Num a, Bits a) => a -> a -> Bool
hasFlag a
x a
flag = (a
x a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
flag) a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0

type LzoReadHeader = Word32

type LzoBlock = Maybe BS.ByteString

getMagic :: Get ()
getMagic :: Get ()
getMagic = do
    ByteString
inp <- Int -> Get ByteString
getByteString Int
9
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString
inp ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
lzopMagic) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
        String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid lzop magic bytes, perhaps it is not an lzop file?"

adler32cFlag :: Word32
adler32cFlag :: Word32
adler32cFlag = Word32
0x0002

adler32dFlag :: Word32
adler32dFlag :: Word32
adler32dFlag = Word32
0x0001

crc32dFlag :: Word32
crc32dFlag :: Word32
crc32dFlag = Word32
0x0100

crc32cFlag :: Word32
crc32cFlag :: Word32
crc32cFlag = Word32
0x0200

failChecksum :: Show a => a -> Word32 -> Get b
failChecksum :: forall a b. Show a => a -> Word32 -> Get b
failChecksum a
expected Word32
actual =
    String -> Get b
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Checksum does not match; expected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
expected String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", found " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
actual)

putLzoBlock :: LzoBlock -> Put
putLzoBlock :: LzoBlock -> Put
putLzoBlock LzoBlock
Nothing =
    Word32 -> Put
putWord32be Word32
0
putLzoBlock (Just ByteString
b) =
       Word32 -> Put
putWord32be Word32
dst
    Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> Word32 -> Put
putWord32be (Word32 -> Word32 -> Word32
forall a. Ord a => a -> a -> a
min Word32
src Word32
dst)
    Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> Word32 -> Put
putWord32be Word32
dAdler
    Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> ByteString -> Put
putByteString
        (if Word32
dst Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32
src then ByteString
b else ByteString
compressed)

    where compressed :: ByteString
compressed = ByteString -> ByteString
compress ByteString
b
          -- uncompressed length
          dst :: Word32
dst = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
b)
          src :: Word32
src = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
compressed)
          dAdler :: Word32
dAdler = ByteString -> Word32
forall a. Adler32 a => a -> Word32
adler32 ByteString
b

getLzoBlock :: Word32 -- ^ Flags
            -> Get LzoBlock
getLzoBlock :: Word32 -> Get LzoBlock
getLzoBlock Word32
ff = {-# SCC "getLzoBlock" #-} do
    -- uncompressed length
    Word32
dst <- Get Word32
getWord32be
    if Word32
dst Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0
        then LzoBlock -> Get LzoBlock
forall (f :: * -> *) a. Applicative f => a -> f a
pure LzoBlock
forall a. Maybe a
Nothing
        else ByteString -> LzoBlock
forall a. a -> Maybe a
Just (ByteString -> LzoBlock) -> Get ByteString -> Get LzoBlock
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
            Word32
src <- Get Word32
getWord32be
            Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word32
dst Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
64 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
1024 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
1024) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
                String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Uncompressed data longer than max block size"
            Maybe Word32
dAdler <- Bool -> Get Word32 -> Get (Maybe Word32)
forall a. Bool -> Get a -> Get (Maybe a)
mGet
                (Word32 -> Word32 -> Bool
forall a. (Num a, Bits a) => a -> a -> Bool
hasFlag Word32
ff Word32
adler32dFlag)
                Get Word32
getWord32be
            Maybe Word32
dCrc <- Bool -> Get Word32 -> Get (Maybe Word32)
forall a. Bool -> Get a -> Get (Maybe a)
mGet
                (Word32 -> Word32 -> Bool
forall a. (Num a, Bits a) => a -> a -> Bool
hasFlag Word32
ff Word32
crc32dFlag)
                Get Word32
getWord32be
            Maybe Word32
cAdler <- if Word32 -> Word32 -> Bool
forall a. (Num a, Bits a) => a -> a -> Bool
hasFlag Word32
ff Word32
adler32cFlag
                then if Word32
src Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32
dst then Word32 -> Maybe Word32
forall a. a -> Maybe a
Just (Word32 -> Maybe Word32) -> Get Word32 -> Get (Maybe Word32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be else Maybe Word32 -> Get (Maybe Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Word32
dAdler
                else Maybe Word32 -> Get (Maybe Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Word32
forall a. Maybe a
Nothing
            Maybe Word32
cCrc <- if Word32 -> Word32 -> Bool
forall a. (Num a, Bits a) => a -> a -> Bool
hasFlag Word32
ff Word32
crc32cFlag
                then if Word32
src Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32
dst then Word32 -> Maybe Word32
forall a. a -> Maybe a
Just (Word32 -> Maybe Word32) -> Get Word32 -> Get (Maybe Word32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be else Maybe Word32 -> Get (Maybe Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Word32
dCrc
                else Maybe Word32 -> Get (Maybe Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Word32
forall a. Maybe a
Nothing
            ByteString
srcData <- Int -> Get ByteString
getByteString (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
src)
            Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word32 -> Word32 -> Bool
forall a. (Num a, Bits a) => a -> a -> Bool
hasFlag Word32
ff Word32
adler32cFlag) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ do
                let actual :: Word32
actual = ByteString -> Word32
forall a. Adler32 a => a -> Word32
adler32 ByteString
srcData
                Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word32 -> Maybe Word32
forall a. a -> Maybe a
Just Word32
actual Maybe Word32 -> Maybe Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Word32
cAdler) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
                    Maybe Word32 -> Word32 -> Get ()
forall a b. Show a => a -> Word32 -> Get b
failChecksum Maybe Word32
cAdler Word32
actual
            Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word32 -> Word32 -> Bool
forall a. (Num a, Bits a) => a -> a -> Bool
hasFlag Word32
ff Word32
crc32cFlag) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ do
                let actual :: Word32
actual = ByteString -> Word32
forall a. CRC32 a => a -> Word32
crc32 ByteString
srcData
                Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word32 -> Maybe Word32
forall a. a -> Maybe a
Just Word32
actual Maybe Word32 -> Maybe Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Word32
cCrc) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
                    Maybe Word32 -> Word32 -> Get ()
forall a b. Show a => a -> Word32 -> Get b
failChecksum Maybe Word32
cCrc Word32
actual
            let decData :: ByteString
decData = if Word32
src Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
dst
                then ByteString -> Int -> ByteString
decompress ByteString
srcData (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
dst)
                else ByteString
srcData
            Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word32 -> Word32 -> Bool
forall a. (Num a, Bits a) => a -> a -> Bool
hasFlag Word32
ff Word32
adler32dFlag) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ do
                let actual :: Word32
actual = {-# SCC "adler32d" #-} ByteString -> Word32
forall a. Adler32 a => a -> Word32
adler32 ByteString
decData
                Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word32 -> Maybe Word32
forall a. a -> Maybe a
Just Word32
actual Maybe Word32 -> Maybe Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Word32
dAdler) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
                    Maybe Word32 -> Word32 -> Get ()
forall a b. Show a => a -> Word32 -> Get b
failChecksum Maybe Word32
dAdler Word32
actual
            Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word32 -> Word32 -> Bool
forall a. (Num a, Bits a) => a -> a -> Bool
hasFlag Word32
ff Word32
crc32dFlag) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ do
                let actual :: Word32
actual = ByteString -> Word32
forall a. CRC32 a => a -> Word32
crc32 ByteString
decData
                Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word32 -> Maybe Word32
forall a. a -> Maybe a
Just Word32
actual Maybe Word32 -> Maybe Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Word32
dCrc) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
                    Maybe Word32 -> Word32 -> Get ()
forall a b. Show a => a -> Word32 -> Get b
failChecksum Maybe Word32
dCrc Word32
actual
            ByteString -> Get ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
decData

mGet :: Bool -> Get a -> Get (Maybe a)
mGet :: forall a. Bool -> Get a -> Get (Maybe a)
mGet Bool
True Get a
dec = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Get a -> Get (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
dec
mGet Bool
False Get a
_  = Maybe a -> Get (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing

unixFlag :: Word32
unixFlag :: Word32
unixFlag = Word32
0x03000000

-- https://github.com/libarchive/libarchive/blob/3649ed23c6b4392d692580c03b10a611e3eaaa32/libarchive/archive_write_add_filter_lzop.c#L104
preLzoHeader :: Put
preLzoHeader :: Put
preLzoHeader =
       Word16 -> Put
putWord16be Word16
0x1030 -- lzop version
    Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> Word16 -> Put
putWord16be Word16
0x940 -- version
    Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> Word16 -> Put
putWord16be Word16
0x940 -- just for safety, min version
    Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> Word8 -> Put
putWord8 Word8
1 -- method
    Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> Word8 -> Put
putWord8 Word8
2 -- compression level
    Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> Word32 -> Put
putWord32be (Word32
unixFlag Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
adler32dFlag) -- flags
    Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> Word32 -> Put
putWord32be Word32
0x81a4 -- from here: https://github.com/libarchive/libarchive/blob/3649ed23c6b4392d692580c03b10a611e3eaaa32/libarchive/archive_write_add_filter_lzop.c#L123
    Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> Word32 -> Put
putWord32be Word32
0 -- mtime low (ignored)
    Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> Word32 -> Put
putWord32be Word32
0 -- mtime high (ignored)
    Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> Word8 -> Put
putWord8 Word8
0 -- filename length

putLzoHeader :: Put
putLzoHeader :: Put
putLzoHeader =
       ByteString -> Put
putByteString ByteString
lzopMagic
    Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> ByteString -> Put
putLazyByteString ByteString
headerBS
    Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> Word32 -> Put
putWord32be Word32
chk
    where headerBS :: ByteString
headerBS = Put -> ByteString
runPut Put
preLzoHeader
          chk :: Word32
chk = ByteString -> Word32
forall a. Adler32 a => a -> Word32
adler32 ByteString
headerBS

getLzoHeader :: Get LzoReadHeader
getLzoHeader :: Get Word32
getLzoHeader = do
    ByteString
headerBytes <- Get ByteString -> Get ByteString
forall a. Get a -> Get a
lookAhead (Int -> Get ByteString
getByteString Int
25)
    Word16
v <- Get Word16
getWord16be
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
        (Word16
v Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word16
0x940)
        (String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"lzo format version too low")
    Int -> Get ()
skip Int
4
    Word8
m <- Get Word8
getWord8
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word8
m Word8 -> [Word8] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Word8
1..Word8
3]) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
        String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unsupported or invalid method: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
m)
    Int -> Get ()
skip Int
1
    Word32
fl <- Get Word32
getWord32be
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
        (Word32 -> Word32 -> Bool
forall a. (Num a, Bits a) => a -> a -> Bool
hasFlag Word32
fl Word32
0x0800)
        (String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Filters not supported.")
    Int -> Get ()
skip Int
12
    Word8
filenameLength <- Get Word8
getWord8
    ByteString
fn <- Int -> Get ByteString
getByteString (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
filenameLength)
    Word32
chk <- Get Word32
getWord32be
    let actual :: Word32
actual = ByteString -> Word32
forall a. Adler32 a => a -> Word32
adler32 (ByteString -> Word32) -> ByteString -> Word32
forall a b. (a -> b) -> a -> b
$ ByteString
headerBytes ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
fn
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word32
chk Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
actual) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
        Word32 -> Word32 -> Get ()
forall a b. Show a => a -> Word32 -> Get b
failChecksum Word32
chk Word32
actual
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word32 -> Word32 -> Bool
forall a. (Num a, Bits a) => a -> a -> Bool
hasFlag Word32
fl Word32
0x0040) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
        String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Extra data not supported."
    Word32 -> Get Word32
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
fl

putChunks :: [BS.ByteString] -> Put
putChunks :: [ByteString] -> Put
putChunks [ByteString]
bs =
       Put
putLzoHeader
    Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> (LzoBlock -> Put) -> [LzoBlock] -> Put
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap LzoBlock -> Put
putLzoBlock (ByteString -> LzoBlock
forall a. a -> Maybe a
Just (ByteString -> LzoBlock) -> [ByteString] -> [LzoBlock]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString]
bs)
    Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> LzoBlock -> Put
putLzoBlock LzoBlock
forall a. Maybe a
Nothing

compressFile :: BSL.ByteString -> BSL.ByteString
compressFile :: ByteString -> ByteString
compressFile = Put -> ByteString
runPut (Put -> ByteString)
-> (ByteString -> Put) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> Put
putChunks ([ByteString] -> Put)
-> (ByteString -> [ByteString]) -> ByteString -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BSL.toChunks

getFile :: BSL.ByteString -> [BS.ByteString]
getFile :: ByteString -> [ByteString]
getFile ByteString
bsl =
    let (ByteString
rest, ByteOffset
_, Word32
header) =
            Either
  (ByteString, ByteOffset, String) (ByteString, ByteOffset, Word32)
-> (ByteString, ByteOffset, Word32)
forall {c}. Either (ByteString, ByteOffset, String) c -> c
asE (Either
   (ByteString, ByteOffset, String) (ByteString, ByteOffset, Word32)
 -> (ByteString, ByteOffset, Word32))
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, Word32)
-> (ByteString, ByteOffset, Word32)
forall a b. (a -> b) -> a -> b
$ Get Word32
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, Word32)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
runGetOrFail (Get ()
getMagic Get () -> Get Word32 -> Get Word32
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get Word32
getLzoHeader) ByteString
bsl
                in Word32 -> ByteString -> [ByteString]
loop Word32
header ByteString
rest

    where loop :: Word32 -> ByteString -> [ByteString]
loop Word32
ff ByteString
bs =
            let (ByteString
rest, ByteOffset
_, LzoBlock
res) = Either
  (ByteString, ByteOffset, String) (ByteString, ByteOffset, LzoBlock)
-> (ByteString, ByteOffset, LzoBlock)
forall {c}. Either (ByteString, ByteOffset, String) c -> c
asE (Either
   (ByteString, ByteOffset, String) (ByteString, ByteOffset, LzoBlock)
 -> (ByteString, ByteOffset, LzoBlock))
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, LzoBlock)
-> (ByteString, ByteOffset, LzoBlock)
forall a b. (a -> b) -> a -> b
$ Get LzoBlock
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, LzoBlock)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
runGetOrFail (Word32 -> Get LzoBlock
getLzoBlock Word32
ff) ByteString
bs in
                case LzoBlock
res of
                    LzoBlock
Nothing -> []
                    Just ByteString
x  -> ByteString
x ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: Word32 -> ByteString -> [ByteString]
loop Word32
ff ByteString
rest

          asE :: Either (ByteString, ByteOffset, String) c -> c
asE = ((ByteString, ByteOffset, String) -> c)
-> (c -> c) -> Either (ByteString, ByteOffset, String) c -> c
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> c
forall a. HasCallStack => String -> a
error(String -> c)
-> ((ByteString, ByteOffset, String) -> String)
-> (ByteString, ByteOffset, String)
-> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ByteString, ByteOffset, String) -> String
forall a. Show a => a -> String
show) c -> c
forall a. a -> a
id


decompressFile :: BSL.ByteString -> BSL.ByteString
decompressFile :: ByteString -> ByteString
decompressFile = [ByteString] -> ByteString
BSL.fromChunks ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
getFile