{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

{- FOURMOLU_DISABLE -}
module Distribution.Client.Compat.Tar
  ( extractTarGzFile
#if MIN_VERSION_tar(0,6,0)
  , Tar.Entry
  , Tar.Entries
  , Tar.GenEntries (..)
  , Tar.GenEntryContent (..)
  , Tar.entryContent
#else
  , Tar.Entries (..)
  , Tar.Entry (..)
  , Tar.EntryContent (..)
#endif
  ) where
{- FOURMOLU_ENABLE -}

import Distribution.Client.Compat.Prelude
import Prelude ()

import qualified Codec.Archive.Tar as Tar
import qualified Codec.Archive.Tar.Check as Tar
#if MIN_VERSION_tar(0,6,0)
#else
import qualified Codec.Archive.Tar.Entry as Tar
#endif
import qualified Data.ByteString.Lazy as BS
import qualified Distribution.Client.GZipUtils as GZipUtils

instance (Exception a, Exception b) => Exception (Either a b) where
  toException :: Either a b -> SomeException
toException (Left a
e) = a -> SomeException
forall e. Exception e => e -> SomeException
toException a
e
  toException (Right b
e) = b -> SomeException
forall e. Exception e => e -> SomeException
toException b
e

  fromException :: SomeException -> Maybe (Either a b)
fromException SomeException
e =
    case SomeException -> Maybe a
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
      Just a
e' -> Either a b -> Maybe (Either a b)
forall a. a -> Maybe a
Just (a -> Either a b
forall a b. a -> Either a b
Left a
e')
      Maybe a
Nothing -> case SomeException -> Maybe b
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
        Just b
e' -> Either a b -> Maybe (Either a b)
forall a. a -> Maybe a
Just (b -> Either a b
forall a b. b -> Either a b
Right b
e')
        Maybe b
Nothing -> Maybe (Either a b)
forall a. Maybe a
Nothing

{- FOURMOLU_DISABLE -}
extractTarGzFile
  :: FilePath
  -- ^ Destination directory
  -> FilePath
  -- ^ Expected subdir (to check for tarbombs)
  -> FilePath
  -- ^ Tarball
  -> IO ()
extractTarGzFile :: String -> String -> String -> IO ()
extractTarGzFile String
dir String
expected String
tar =
#if MIN_VERSION_tar(0,6,0)
  (GenEntry String String -> Maybe SomeException)
-> String -> Entries FormatError -> IO ()
forall e.
Exception e =>
(GenEntry String String -> Maybe SomeException)
-> String -> Entries e -> IO ()
Tar.unpackAndCheck
    ( \GenEntry String String
x ->
        TarBombError -> SomeException
forall e. Exception e => e -> SomeException
SomeException (TarBombError -> SomeException)
-> Maybe TarBombError -> Maybe SomeException
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> GenEntry String String -> Maybe TarBombError
forall linkTarget.
String -> GenEntry String linkTarget -> Maybe TarBombError
Tar.checkEntryTarbomb String
expected GenEntry String String
x
          Maybe SomeException -> Maybe SomeException -> Maybe SomeException
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FileNameError -> SomeException
forall e. Exception e => e -> SomeException
SomeException (FileNameError -> SomeException)
-> Maybe FileNameError -> Maybe SomeException
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenEntry String String -> Maybe FileNameError
Tar.checkEntrySecurity GenEntry String String
x
    )
    String
dir
#else
  Tar.unpack dir
    . Tar.checkTarbomb expected
#endif
  (Entries FormatError -> IO ())
-> (ByteString -> Entries FormatError) -> ByteString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Entries FormatError
Tar.read
  (ByteString -> Entries FormatError)
-> (ByteString -> ByteString) -> ByteString -> Entries FormatError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
GZipUtils.maybeDecompress
  (ByteString -> IO ()) -> IO ByteString -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO ByteString
BS.readFile String
tar
{- FOURMOLU_ENABLE -}