{-# LANGUAGE DeriveFunctor #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Distribution.Client.Tar (
createTarGzFile,
extractTarGzFile,
buildTreeRefTypeCode,
buildTreeSnapshotTypeCode,
isBuildTreeRefTypeCode,
filterEntries,
filterEntriesM,
entriesToList,
) where
import Distribution.Client.Compat.Prelude
import Prelude ()
import qualified Data.ByteString.Lazy as BS
import qualified Codec.Archive.Tar as Tar
import qualified Codec.Archive.Tar.Entry as Tar
import qualified Codec.Archive.Tar.Check as Tar
import qualified Codec.Compression.GZip as GZip
import qualified Distribution.Client.GZipUtils as GZipUtils
import Control.Exception (throw)
createTarGzFile :: FilePath
-> FilePath
-> FilePath
-> IO ()
createTarGzFile :: FilePath -> FilePath -> FilePath -> IO ()
createTarGzFile FilePath
tar FilePath
base FilePath
dir =
FilePath -> ByteString -> IO ()
BS.writeFile FilePath
tar forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
GZip.compress forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Entry] -> ByteString
Tar.write forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> [FilePath] -> IO [Entry]
Tar.pack FilePath
base [FilePath
dir]
extractTarGzFile :: FilePath
-> FilePath
-> FilePath
-> IO ()
FilePath
dir FilePath
expected FilePath
tar =
forall e. Exception e => FilePath -> Entries e -> IO ()
Tar.unpack FilePath
dir forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. FilePath -> Entries e -> Entries (Either e TarBombError)
Tar.checkTarbomb FilePath
expected forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Entries FormatError
Tar.read
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
GZipUtils.maybeDecompress forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO ByteString
BS.readFile FilePath
tar
instance (Exception a, Exception b) => Exception (Either a b) where
toException :: Either a b -> SomeException
toException (Left a
e) = forall e. Exception e => e -> SomeException
toException a
e
toException (Right b
e) = forall e. Exception e => e -> SomeException
toException b
e
fromException :: SomeException -> Maybe (Either a b)
fromException SomeException
e =
case forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
Just a
e' -> forall a. a -> Maybe a
Just (forall a b. a -> Either a b
Left a
e')
Maybe a
Nothing -> case forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
Just b
e' -> forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right b
e')
Maybe b
Nothing -> forall a. Maybe a
Nothing
buildTreeRefTypeCode :: Tar.TypeCode
buildTreeRefTypeCode :: TypeCode
buildTreeRefTypeCode = TypeCode
'C'
buildTreeSnapshotTypeCode :: Tar.TypeCode
buildTreeSnapshotTypeCode :: TypeCode
buildTreeSnapshotTypeCode = TypeCode
'S'
isBuildTreeRefTypeCode :: Tar.TypeCode -> Bool
isBuildTreeRefTypeCode :: TypeCode -> Bool
isBuildTreeRefTypeCode TypeCode
typeCode
| (TypeCode
typeCode forall a. Eq a => a -> a -> Bool
== TypeCode
buildTreeRefTypeCode
Bool -> Bool -> Bool
|| TypeCode
typeCode forall a. Eq a => a -> a -> Bool
== TypeCode
buildTreeSnapshotTypeCode) = Bool
True
| Bool
otherwise = Bool
False
filterEntries :: (Tar.Entry -> Bool) -> Tar.Entries e -> Tar.Entries e
filterEntries :: forall e. (Entry -> Bool) -> Entries e -> Entries e
filterEntries Entry -> Bool
p =
forall a e. (Entry -> a -> a) -> a -> (e -> a) -> Entries e -> a
Tar.foldEntries
(\Entry
e Entries e
es -> if Entry -> Bool
p Entry
e then forall e. Entry -> Entries e -> Entries e
Tar.Next Entry
e Entries e
es else Entries e
es)
forall e. Entries e
Tar.Done
forall e. e -> Entries e
Tar.Fail
filterEntriesM :: Monad m => (Tar.Entry -> m Bool)
-> Tar.Entries e -> m (Tar.Entries e)
filterEntriesM :: forall (m :: * -> *) e.
Monad m =>
(Entry -> m Bool) -> Entries e -> m (Entries e)
filterEntriesM Entry -> m Bool
p =
forall a e. (Entry -> a -> a) -> a -> (e -> a) -> Entries e -> a
Tar.foldEntries
(\Entry
entry m (Entries e)
rest -> do
Bool
keep <- Entry -> m Bool
p Entry
entry
Entries e
xs <- m (Entries e)
rest
if Bool
keep
then forall (m :: * -> *) a. Monad m => a -> m a
return (forall e. Entry -> Entries e -> Entries e
Tar.Next Entry
entry Entries e
xs)
else forall (m :: * -> *) a. Monad m => a -> m a
return Entries e
xs)
(forall (m :: * -> *) a. Monad m => a -> m a
return forall e. Entries e
Tar.Done)
(forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. e -> Entries e
Tar.Fail)
entriesToList :: Exception e => Tar.Entries e -> [Tar.Entry]
entriesToList :: forall e. Exception e => Entries e -> [Entry]
entriesToList = forall a e. (Entry -> a -> a) -> a -> (e -> a) -> Entries e -> a
Tar.foldEntries (:) [] forall a e. Exception e => e -> a
throw