module Package.C.Unpack ( unpackResponse
                        , Compression (..)
                        , TarCompress (..)
                        ) where

import qualified Codec.Archive               as Archive
import           Codec.Archive.Zip           (ZipOption (..), extractFilesFromArchive, toArchive)
import qualified Codec.Compression.BZip      as Bzip
import qualified Codec.Compression.GZip      as Gzip
import qualified Codec.Compression.Lzma      as Lzma
import qualified Codec.Compression.Zstd.Lazy as Zstd
import qualified Codec.Lzip                  as Lzip
import           Control.Exception           (throw)
import qualified Data.ByteString.Lazy        as BSL
import           System.Directory

data TarCompress = Gz
                 | Xz
                 | Bz2
                 | Lz
                 | Zstd
                 | None

data Compression = Tar TarCompress
                 | Cpio TarCompress
                 | Zip


getCompressor :: TarCompress -> BSL.ByteString -> BSL.ByteString
getCompressor :: TarCompress -> ByteString -> ByteString
getCompressor TarCompress
Gz   = ByteString -> ByteString
Gzip.decompress
getCompressor TarCompress
None = ByteString -> ByteString
forall a. a -> a
id
getCompressor TarCompress
Xz   = ByteString -> ByteString
Lzma.decompress
getCompressor TarCompress
Bz2  = ByteString -> ByteString
Bzip.decompress
getCompressor TarCompress
Lz   = ByteString -> ByteString
Lzip.decompress
getCompressor TarCompress
Zstd = ByteString -> ByteString
Zstd.decompress

archiveResponse :: TarCompress -> FilePath -> BSL.ByteString -> IO ()
archiveResponse :: TarCompress -> FilePath -> ByteString -> IO ()
archiveResponse TarCompress
compressScheme FilePath
dirName =
    ArchiveM () -> IO ()
forall a. ArchiveM a -> IO a
Archive.throwArchiveM (ArchiveM () -> IO ())
-> (ByteString -> ArchiveM ()) -> ByteString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ByteString -> ArchiveM ()
Archive.unpackToDirLazy FilePath
dirName (ByteString -> ArchiveM ())
-> (ByteString -> ByteString) -> ByteString -> ArchiveM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TarCompress -> ByteString -> ByteString
getCompressor TarCompress
compressScheme

zipResponse :: FilePath -> BSL.ByteString -> IO ()
zipResponse :: FilePath -> ByteString -> IO ()
zipResponse FilePath
dirName ByteString
response = FilePath -> IO () -> IO ()
forall a. FilePath -> IO a -> IO a
withCurrentDirectory FilePath
dirName (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    let options :: ZipOption
options = FilePath -> ZipOption
OptDestination FilePath
dirName
    [ZipOption] -> Archive -> IO ()
extractFilesFromArchive [ZipOption
options] (ByteString -> Archive
toArchive ByteString
response)

unpackResponse :: Compression -> FilePath -> BSL.ByteString -> IO ()
unpackResponse :: Compression -> FilePath -> ByteString -> IO ()
unpackResponse (Tar TarCompress
tarCmp) FilePath
fp ByteString
response  = TarCompress -> FilePath -> ByteString -> IO ()
archiveResponse TarCompress
tarCmp FilePath
fp ByteString
response
unpackResponse (Cpio TarCompress
tarCmp) FilePath
fp ByteString
response = TarCompress -> FilePath -> ByteString -> IO ()
archiveResponse TarCompress
tarCmp FilePath
fp ByteString
response
unpackResponse Compression
Zip FilePath
fp ByteString
response           = FilePath -> ByteString -> IO ()
zipResponse FilePath
fp ByteString
response