    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE ViewPatterns #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE RankNTypes #-}

    {-# OPTIONS_HADDOCK hide #-}
    {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
    {-# HLINT ignore "Use for_" #-}
    {-# HLINT ignore "Avoid restricted function" #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Codec.Archive.Tar
    -- Copyright   :  (c) 2007 Bjorn Bringert,
    --                    2008 Andrea Vezzosi,
    --                    2008-2009, 2012, 2016 Duncan Coutts
    -- License     :  BSD3
    --
    -- Maintainer  :  duncan@community.haskell.org
    -- Portability :  portable
    --
    -----------------------------------------------------------------------------
    module Codec.Archive.Tar.Unpack (
      unpack,
      unpackAndCheck,
      ) where

    import Codec.Archive.Tar.Types
    import Codec.Archive.Tar.Check
    import Codec.Archive.Tar.LongNames
    import Codec.Archive.Tar.PackAscii (filePathToOsPath)

    import Data.Bits
             ( testBit )
    import Data.List (partition, nub)
    import Data.Maybe ( fromMaybe )
    import qualified Data.ByteString.Char8 as Char8
    import qualified Data.ByteString.Lazy as BS
    import Prelude hiding (writeFile)
    import System.File.OsPath
    import System.OsPath
             ( OsPath, (</>) )
    import qualified System.OsPath as FilePath.Native
             ( takeDirectory )
    import System.Directory.OsPath
        ( createDirectoryIfMissing,
          copyFile,
          setPermissions,
          listDirectory,
          doesDirectoryExist,
          createDirectoryLink,
          createFileLink,
          setModificationTime,
          emptyPermissions,
          setOwnerReadable,
          setOwnerWritable,
          setOwnerExecutable,
          setOwnerSearchable )
    import Control.Exception
             ( Exception, throwIO, handle )
    import System.IO ( stderr, hPutStr )
    import System.IO.Error ( ioeGetErrorType, isPermissionError )
    import GHC.IO (unsafeInterleaveIO)
    import Data.Foldable (traverse_)
    import GHC.IO.Exception (IOErrorType(InappropriateType, IllegalOperation, PermissionDenied, InvalidArgument))
    import Data.Time.Clock.POSIX
             ( posixSecondsToUTCTime )
    import Control.Exception as Exception
             ( catch, SomeException(..) )

    -- | Create local files and directories based on the entries of a tar archive.
    --
    -- This is a portable implementation of unpacking suitable for portable
    -- archives. It handles 'NormalFile' and 'Directory' entries and has simulated
    -- support for 'SymbolicLink' and 'HardLink' entries. Links are implemented by
    -- copying the target file. This therefore works on Windows as well as Unix.
    -- All other entry types are ignored, that is they are not unpacked and no
    -- exception is raised.
    --
    -- If the 'Entries' ends in an error then it is raised an an exception. Any
    -- files or directories that have been unpacked before the error was
    -- encountered will not be deleted. For this reason you may want to unpack
    -- into an empty directory so that you can easily clean up if unpacking fails
    -- part-way.
    --
    -- On its own, this function only checks for security (using 'checkEntrySecurity').
    -- Use 'unpackAndCheck' if you need more checks.
    --
    unpack
      :: Exception e
      => FilePath
      -- ^ Base directory
      -> Entries e
      -- ^ Entries to upack
      -> IO ()
    unpack :: forall e. Exception e => FilePath -> Entries e -> IO ()
    unpack = (GenEntry FilePath FilePath -> Maybe SomeException)
    -> FilePath -> Entries e -> IO ()
    forall e.
    Exception e =>
    (GenEntry FilePath FilePath -> Maybe SomeException)
    -> FilePath -> Entries e -> IO ()
    unpackAndCheck ((FileNameError -> SomeException)
    -> Maybe FileNameError -> Maybe SomeException
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap FileNameError -> SomeException
    forall e. (Exception e, HasExceptionContext) => e -> SomeException
    SomeException (Maybe FileNameError -> Maybe SomeException)
    -> (GenEntry FilePath FilePath -> Maybe FileNameError)
    -> GenEntry FilePath FilePath
    -> Maybe SomeException
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenEntry FilePath FilePath -> Maybe FileNameError
    checkEntrySecurity)

    -- | Like 'Codec.Archive.Tar.unpack', but run custom sanity/security checks instead of 'checkEntrySecurity'.
    -- For example,
    --
    -- > import Control.Exception (SomeException(..))
    -- > import Control.Applicative ((<|>))
    -- >
    -- > unpackAndCheck (\x -> SomeException <$> checkEntryPortability x
    -- >                   <|> SomeException <$> checkEntrySecurity x) dir entries
    --
    -- @since 0.6.0.0
    unpackAndCheck
      :: Exception e
      => (GenEntry FilePath FilePath -> Maybe SomeException)
      -- ^ Checks to run on each entry before unpacking
      -> FilePath
      -- ^ Base directory
      -> Entries e
      -- ^ Entries to upack
      -> IO ()
    unpackAndCheck :: forall e.
    Exception e =>
    (GenEntry FilePath FilePath -> Maybe SomeException)
    -> FilePath -> Entries e -> IO ()
    unpackAndCheck GenEntry FilePath FilePath -> Maybe SomeException
    secCB (FilePath -> OsPath
    filePathToOsPath -> OsPath
    baseDir) Entries e
    entries = do
      let resolvedEntries :: GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    resolvedEntries = Entries e
    -> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    forall e.
    Entries e
    -> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    decodeLongNames Entries e
    entries
      uEntries <- [(OsPath, OsPath, Bool)]
    -> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    -> IO [(OsPath, OsPath, Bool)]
    forall e.
    Exception e =>
    [(OsPath, OsPath, Bool)]
    -> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    -> IO [(OsPath, OsPath, Bool)]
    unpackEntries [] GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    resolvedEntries
      let (hardlinks, symlinks) = partition (\(OsPath
    _, OsPath
    _, Bool
    x) -> Bool
    x) uEntries
      -- handle hardlinks first, in case a symlink points to it
      handleHardLinks hardlinks
      handleSymlinks symlinks

      where
        -- We're relying here on 'secCB' to make sure we're not scribbling
        -- files all over the place.

        unpackEntries :: Exception e
                      => [(OsPath, OsPath, Bool)]
                      -- ^ links (path, link, isHardLink)
                      -> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
                      -- ^ entries
                      -> IO [(OsPath, OsPath, Bool)]
        unpackEntries :: forall e.
    Exception e =>
    [(OsPath, OsPath, Bool)]
    -> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    -> IO [(OsPath, OsPath, Bool)]
    unpackEntries [(OsPath, OsPath, Bool)]
    _     (Fail Either e DecodeLongNamesError
    err)      = (e -> IO [(OsPath, OsPath, Bool)])
    -> (DecodeLongNamesError -> IO [(OsPath, OsPath, Bool)])
    -> Either e DecodeLongNamesError
    -> IO [(OsPath, OsPath, Bool)]
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either e -> IO [(OsPath, OsPath, Bool)]
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO DecodeLongNamesError -> IO [(OsPath, OsPath, Bool)]
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO Either e DecodeLongNamesError
    err
        unpackEntries [(OsPath, OsPath, Bool)]
    links GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    Done            = [(OsPath, OsPath, Bool)] -> IO [(OsPath, OsPath, Bool)]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(OsPath, OsPath, Bool)]
    links
        unpackEntries [(OsPath, OsPath, Bool)]
    links (Next GenEntry FilePath FilePath
    entry GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    es) = do
          case GenEntry FilePath FilePath -> Maybe SomeException
    secCB GenEntry FilePath FilePath
    entry of
            Maybe SomeException
    Nothing -> () -> IO ()
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
            Just SomeException
    e -> SomeException -> IO ()
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO SomeException
    e

          case GenEntry FilePath FilePath -> GenEntryContent FilePath
    forall tarPath linkTarget.
    GenEntry tarPath linkTarget -> GenEntryContent linkTarget
    entryContent GenEntry FilePath FilePath
    entry of
            NormalFile ByteString
    file EpochTime
    _ -> do
              Permissions -> FilePath -> ByteString -> EpochTime -> IO ()
    extractFile (GenEntry FilePath FilePath -> Permissions
    forall tarPath linkTarget.
    GenEntry tarPath linkTarget -> Permissions
    entryPermissions GenEntry FilePath FilePath
    entry) (GenEntry FilePath FilePath -> FilePath
    forall tarPath linkTarget. GenEntry tarPath linkTarget -> tarPath
    entryTarPath GenEntry FilePath FilePath
    entry) ByteString
    file (GenEntry FilePath FilePath -> EpochTime
    forall tarPath linkTarget. GenEntry tarPath linkTarget -> EpochTime
    entryTime GenEntry FilePath FilePath
    entry)
              [(OsPath, OsPath, Bool)]
    -> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    -> IO [(OsPath, OsPath, Bool)]
    forall e.
    Exception e =>
    [(OsPath, OsPath, Bool)]
    -> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    -> IO [(OsPath, OsPath, Bool)]
    unpackEntries [(OsPath, OsPath, Bool)]
    links GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    es
            GenEntryContent FilePath
    Directory -> do
              FilePath -> EpochTime -> IO ()
    extractDir (GenEntry FilePath FilePath -> FilePath
    forall tarPath linkTarget. GenEntry tarPath linkTarget -> tarPath
    entryTarPath GenEntry FilePath FilePath
    entry) (GenEntry FilePath FilePath -> EpochTime
    forall tarPath linkTarget. GenEntry tarPath linkTarget -> EpochTime
    entryTime GenEntry FilePath FilePath
    entry)
              [(OsPath, OsPath, Bool)]
    -> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    -> IO [(OsPath, OsPath, Bool)]
    forall e.
    Exception e =>
    [(OsPath, OsPath, Bool)]
    -> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    -> IO [(OsPath, OsPath, Bool)]
    unpackEntries [(OsPath, OsPath, Bool)]
    links GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    es
            HardLink FilePath
    link -> do
              ([(OsPath, OsPath, Bool)]
    -> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    -> IO [(OsPath, OsPath, Bool)]
    forall e.
    Exception e =>
    [(OsPath, OsPath, Bool)]
    -> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    -> IO [(OsPath, OsPath, Bool)]
    unpackEntries ([(OsPath, OsPath, Bool)]
     -> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
     -> IO [(OsPath, OsPath, Bool)])
    -> [(OsPath, OsPath, Bool)]
    -> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    -> IO [(OsPath, OsPath, Bool)]
    forall a b. (a -> b) -> a -> b
    $! Bool
    -> FilePath
    -> FilePath
    -> [(OsPath, OsPath, Bool)]
    -> [(OsPath, OsPath, Bool)]
    forall t.
    t
    -> FilePath
    -> FilePath
    -> [(OsPath, OsPath, t)]
    -> [(OsPath, OsPath, t)]
    saveLink Bool
    True (GenEntry FilePath FilePath -> FilePath
    forall tarPath linkTarget. GenEntry tarPath linkTarget -> tarPath
    entryTarPath GenEntry FilePath FilePath
    entry) FilePath
    link [(OsPath, OsPath, Bool)]
    links) GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    es
            SymbolicLink FilePath
    link -> do
              ([(OsPath, OsPath, Bool)]
    -> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    -> IO [(OsPath, OsPath, Bool)]
    forall e.
    Exception e =>
    [(OsPath, OsPath, Bool)]
    -> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    -> IO [(OsPath, OsPath, Bool)]
    unpackEntries ([(OsPath, OsPath, Bool)]
     -> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
     -> IO [(OsPath, OsPath, Bool)])
    -> [(OsPath, OsPath, Bool)]
    -> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    -> IO [(OsPath, OsPath, Bool)]
    forall a b. (a -> b) -> a -> b
    $! Bool
    -> FilePath
    -> FilePath
    -> [(OsPath, OsPath, Bool)]
    -> [(OsPath, OsPath, Bool)]
    forall t.
    t
    -> FilePath
    -> FilePath
    -> [(OsPath, OsPath, t)]
    -> [(OsPath, OsPath, t)]
    saveLink Bool
    False (GenEntry FilePath FilePath -> FilePath
    forall tarPath linkTarget. GenEntry tarPath linkTarget -> tarPath
    entryTarPath GenEntry FilePath FilePath
    entry) FilePath
    link [(OsPath, OsPath, Bool)]
    links) GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    es
            OtherEntryType{} ->
              -- the spec demands that we attempt to extract as normal file on unknown typecode,
              -- but we just skip it
              [(OsPath, OsPath, Bool)]
    -> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    -> IO [(OsPath, OsPath, Bool)]
    forall e.
    Exception e =>
    [(OsPath, OsPath, Bool)]
    -> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    -> IO [(OsPath, OsPath, Bool)]
    unpackEntries [(OsPath, OsPath, Bool)]
    links GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    es
            CharacterDevice{} -> [(OsPath, OsPath, Bool)]
    -> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    -> IO [(OsPath, OsPath, Bool)]
    forall e.
    Exception e =>
    [(OsPath, OsPath, Bool)]
    -> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    -> IO [(OsPath, OsPath, Bool)]
    unpackEntries [(OsPath, OsPath, Bool)]
    links GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    es
            BlockDevice{} -> [(OsPath, OsPath, Bool)]
    -> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    -> IO [(OsPath, OsPath, Bool)]
    forall e.
    Exception e =>
    [(OsPath, OsPath, Bool)]
    -> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    -> IO [(OsPath, OsPath, Bool)]
    unpackEntries [(OsPath, OsPath, Bool)]
    links GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    es
            GenEntryContent FilePath
    NamedPipe -> [(OsPath, OsPath, Bool)]
    -> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    -> IO [(OsPath, OsPath, Bool)]
    forall e.
    Exception e =>
    [(OsPath, OsPath, Bool)]
    -> GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    -> IO [(OsPath, OsPath, Bool)]
    unpackEntries [(OsPath, OsPath, Bool)]
    links GenEntries FilePath FilePath (Either e DecodeLongNamesError)
    es

        extractFile :: Permissions -> FilePath -> BS.ByteString -> EpochTime -> IO ()
        extractFile :: Permissions -> FilePath -> ByteString -> EpochTime -> IO ()
    extractFile Permissions
    permissions (FilePath -> OsPath
    filePathToNativeOsPath -> OsPath
    path) ByteString
    content EpochTime
    mtime = do
          -- Note that tar archives do not make sure each directory is created
          -- before files they contain, indeed we may have to create several
          -- levels of directory.
          Bool -> OsPath -> IO ()
    createDirectoryIfMissing Bool
    True OsPath
    absDir
          OsPath -> ByteString -> IO ()
    writeFile OsPath
    absPath ByteString
    content
          OsPath -> Permissions -> IO ()
    setOwnerPermissions OsPath
    absPath Permissions
    permissions
          OsPath -> EpochTime -> IO ()
    setModTime OsPath
    absPath EpochTime
    mtime
          where
            absDir :: OsPath
    absDir  = OsPath
    baseDir OsPath -> OsPath -> OsPath
    </> OsPath -> OsPath
    FilePath.Native.takeDirectory OsPath
    path
            absPath :: OsPath
    absPath = OsPath
    baseDir OsPath -> OsPath -> OsPath
    </> OsPath
    path

        extractDir :: FilePath -> EpochTime -> IO ()
        extractDir :: FilePath -> EpochTime -> IO ()
    extractDir (FilePath -> OsPath
    filePathToNativeOsPath -> OsPath
    path) EpochTime
    mtime = do
          Bool -> OsPath -> IO ()
    createDirectoryIfMissing Bool
    True OsPath
    absPath
          OsPath -> EpochTime -> IO ()
    setModTime OsPath
    absPath EpochTime
    mtime
          where
            absPath :: OsPath
    absPath = OsPath
    baseDir OsPath -> OsPath -> OsPath
    </> OsPath
    path

        saveLink
          :: t
          -> FilePath
          -> FilePath
          -> [(OsPath, OsPath, t)]
          -> [(OsPath, OsPath, t)]
        saveLink :: forall t.
    t
    -> FilePath
    -> FilePath
    -> [(OsPath, OsPath, t)]
    -> [(OsPath, OsPath, t)]
    saveLink t
    isHardLink (FilePath -> OsPath
    filePathToNativeOsPath -> OsPath
    path) (FilePath -> OsPath
    filePathToNativeOsPath -> OsPath
    link) =
          OsPath
    path OsPath
    -> ([(OsPath, OsPath, t)] -> [(OsPath, OsPath, t)])
    -> [(OsPath, OsPath, t)]
    -> [(OsPath, OsPath, t)]
    forall a b. a -> b -> b
    `seq` OsPath
    link OsPath
    -> ([(OsPath, OsPath, t)] -> [(OsPath, OsPath, t)])
    -> [(OsPath, OsPath, t)]
    -> [(OsPath, OsPath, t)]
    forall a b. a -> b -> b
    `seq` ((OsPath
    path, OsPath
    link, t
    isHardLink) (OsPath, OsPath, t)
    -> [(OsPath, OsPath, t)] -> [(OsPath, OsPath, t)]
    forall a. a -> [a] -> [a]
    :)

        -- for hardlinks, we just copy
        handleHardLinks :: [(OsPath, OsPath, t)] -> IO ()
        handleHardLinks :: forall t. [(OsPath, OsPath, t)] -> IO ()
    handleHardLinks = ((OsPath, OsPath, t) -> IO ()) -> [(OsPath, OsPath, t)] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (((OsPath, OsPath, t) -> IO ()) -> [(OsPath, OsPath, t)] -> IO ())
    -> ((OsPath, OsPath, t) -> IO ()) -> [(OsPath, OsPath, t)] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \(OsPath
    relPath, OsPath
    relLinkTarget, t
    _) ->
          let absPath :: OsPath
    absPath   = OsPath
    baseDir OsPath -> OsPath -> OsPath
    </> OsPath
    relPath
              -- hard links link targets are always "absolute" paths in
              -- the context of the tar root
              absTarget :: OsPath
    absTarget = OsPath
    baseDir OsPath -> OsPath -> OsPath
    </> OsPath
    relLinkTarget
          -- we don't expect races here, since we should be the
          -- only process unpacking the tar archive and writing to
          -- the destination
          in OsPath -> IO Bool
    doesDirectoryExist OsPath
    absTarget IO Bool -> (Bool -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
              Bool
    True -> OsPath -> OsPath -> IO ()
    copyDirectoryRecursive OsPath
    absTarget OsPath
    absPath
              Bool
    False -> OsPath -> OsPath -> IO ()
    copyFile OsPath
    absTarget OsPath
    absPath

        -- For symlinks, we first try to recreate them and if that fails
        -- with 'IllegalOperation', 'PermissionDenied' or 'InvalidArgument',
        -- we fall back to copying.
        -- This error handling isn't too fine grained and maybe should be
        -- platform specific, but this way it might catch erros on unix even on
        -- FAT32 fuse mounted volumes.
        handleSymlinks :: [(OsPath, OsPath, c)] -> IO ()
        handleSymlinks :: forall t. [(OsPath, OsPath, t)] -> IO ()
    handleSymlinks = ((OsPath, OsPath, c) -> IO ()) -> [(OsPath, OsPath, c)] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (((OsPath, OsPath, c) -> IO ()) -> [(OsPath, OsPath, c)] -> IO ())
    -> ((OsPath, OsPath, c) -> IO ()) -> [(OsPath, OsPath, c)] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \(OsPath
    relPath, OsPath
    relLinkTarget, c
    _) ->
          let absPath :: OsPath
    absPath   = OsPath
    baseDir OsPath -> OsPath -> OsPath
    </> OsPath
    relPath
              -- hard links link targets are always "absolute" paths in
              -- the context of the tar root
              absTarget :: OsPath
    absTarget = OsPath -> OsPath
    FilePath.Native.takeDirectory OsPath
    absPath OsPath -> OsPath -> OsPath
    </> OsPath
    relLinkTarget
          -- we don't expect races here, since we should be the
          -- only process unpacking the tar archive and writing to
          -- the destination
          in OsPath -> IO Bool
    doesDirectoryExist OsPath
    absTarget IO Bool -> (Bool -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
              Bool
    True -> IO () -> IO () -> IO ()
    forall {a}. IO a -> IO a -> IO a
    handleSymlinkError (OsPath -> OsPath -> IO ()
    copyDirectoryRecursive OsPath
    absTarget OsPath
    absPath)
                (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ OsPath -> OsPath -> IO ()
    createDirectoryLink OsPath
    relLinkTarget OsPath
    absPath
              Bool
    False -> IO () -> IO () -> IO ()
    forall {a}. IO a -> IO a -> IO a
    handleSymlinkError (OsPath -> OsPath -> IO ()
    copyFile OsPath
    absTarget OsPath
    absPath)
                (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ OsPath -> OsPath -> IO ()
    createFileLink OsPath
    relLinkTarget OsPath
    absPath

          where
            handleSymlinkError :: IO a -> IO a -> IO a
    handleSymlinkError IO a
    action =
              (IOError -> IO a) -> IO a -> IO a
    forall e a. Exception e => (e -> IO a) -> IO a -> IO a
    handle (\IOError
    e -> if IOError -> IOErrorType
    ioeGetErrorType IOError
    e IOErrorType -> [IOErrorType] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [IOErrorType
    IllegalOperation
                                                        ,IOErrorType
    PermissionDenied
                                                        ,IOErrorType
    InvalidArgument]
                          then IO a
    action
                          else IOError -> IO a
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO IOError
    e
                     )

    filePathToNativeOsPath :: FilePath -> OsPath
    filePathToNativeOsPath :: FilePath -> OsPath
    filePathToNativeOsPath = FilePath -> OsPath
    filePathToOsPath (FilePath -> OsPath)
    -> (FilePath -> FilePath) -> FilePath -> OsPath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> FilePath
    fromFilePathToNative

    -- | Recursively copy the contents of one directory to another path.
    --
    -- This is a rip-off of Cabal library.
    copyDirectoryRecursive :: OsPath -> OsPath -> IO ()
    copyDirectoryRecursive :: OsPath -> OsPath -> IO ()
    copyDirectoryRecursive OsPath
    srcDir OsPath
    destDir = do
      srcFiles <- OsPath -> IO [OsPath]
    getDirectoryContentsRecursive OsPath
    srcDir
      copyFilesWith copyFile destDir [ (srcDir, f)
                                       | f <- srcFiles ]
      where
        -- | Common implementation of 'copyFiles', 'installOrdinaryFiles',
        -- 'installExecutableFiles' and 'installMaybeExecutableFiles'.
        copyFilesWith :: (OsPath -> OsPath -> IO ())
                      -> OsPath -> [(OsPath, OsPath)] -> IO ()
        copyFilesWith :: (OsPath -> OsPath -> IO ())
    -> OsPath -> [(OsPath, OsPath)] -> IO ()
    copyFilesWith OsPath -> OsPath -> IO ()
    doCopy OsPath
    targetDir [(OsPath, OsPath)]
    srcFiles = do

          -- Create parent directories for everything
          let dirs :: [OsPath]
    dirs = (OsPath -> OsPath) -> [OsPath] -> [OsPath]
    forall a b. (a -> b) -> [a] -> [b]
    map (OsPath
    targetDir OsPath -> OsPath -> OsPath
    </>) ([OsPath] -> [OsPath])
    -> ([(OsPath, OsPath)] -> [OsPath])
    -> [(OsPath, OsPath)]
    -> [OsPath]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [OsPath] -> [OsPath]
    forall a. Eq a => [a] -> [a]
    nub ([OsPath] -> [OsPath])
    -> ([(OsPath, OsPath)] -> [OsPath])
    -> [(OsPath, OsPath)]
    -> [OsPath]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((OsPath, OsPath) -> OsPath) -> [(OsPath, OsPath)] -> [OsPath]
    forall a b. (a -> b) -> [a] -> [b]
    map (OsPath -> OsPath
    FilePath.Native.takeDirectory (OsPath -> OsPath)
    -> ((OsPath, OsPath) -> OsPath) -> (OsPath, OsPath) -> OsPath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (OsPath, OsPath) -> OsPath
    forall a b. (a, b) -> b
    snd) ([(OsPath, OsPath)] -> [OsPath]) -> [(OsPath, OsPath)] -> [OsPath]
    forall a b. (a -> b) -> a -> b
    $ [(OsPath, OsPath)]
    srcFiles
          (OsPath -> IO ()) -> [OsPath] -> IO ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    (a -> f b) -> t a -> f ()
    traverse_ (Bool -> OsPath -> IO ()
    createDirectoryIfMissing Bool
    True) [OsPath]
    dirs

          -- Copy all the files
          [IO ()] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    t (m a) -> m ()
    sequence_ [ let src :: OsPath
    src  = OsPath
    srcBase   OsPath -> OsPath -> OsPath
    </> OsPath
    srcFile
                          dest :: OsPath
    dest = OsPath
    targetDir OsPath -> OsPath -> OsPath
    </> OsPath
    srcFile
                       in OsPath -> OsPath -> IO ()
    doCopy OsPath
    src OsPath
    dest
                    | (OsPath
    srcBase, OsPath
    srcFile) <- [(OsPath, OsPath)]
    srcFiles ]

        -- | List all the files in a directory and all subdirectories.
        --
        -- The order places files in sub-directories after all the files in their
        -- parent directories. The list is generated lazily so is not well defined if
        -- the source directory structure changes before the list is used.
        --
        getDirectoryContentsRecursive :: OsPath -> IO [OsPath]
        getDirectoryContentsRecursive :: OsPath -> IO [OsPath]
    getDirectoryContentsRecursive OsPath
    topdir = [OsPath] -> IO [OsPath]
    recurseDirectories [OsPath
    forall a. Monoid a => a
    mempty]
          where
            recurseDirectories :: [OsPath] -> IO [OsPath]
            recurseDirectories :: [OsPath] -> IO [OsPath]
    recurseDirectories []         = [OsPath] -> IO [OsPath]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
            recurseDirectories (OsPath
    dir:[OsPath]
    dirs) = IO [OsPath] -> IO [OsPath]
    forall a. IO a -> IO a
    unsafeInterleaveIO (IO [OsPath] -> IO [OsPath]) -> IO [OsPath] -> IO [OsPath]
    forall a b. (a -> b) -> a -> b
    $ do
              (files, dirs') <- [OsPath] -> [OsPath] -> [OsPath] -> IO ([OsPath], [OsPath])
    collect [] [] ([OsPath] -> IO ([OsPath], [OsPath]))
    -> IO [OsPath] -> IO ([OsPath], [OsPath])
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< OsPath -> IO [OsPath]
    listDirectory (OsPath
    topdir OsPath -> OsPath -> OsPath
    </> OsPath
    dir)
              files' <- recurseDirectories (dirs' ++ dirs)
              return (files ++ files')

              where
                collect :: [OsPath] -> [OsPath] -> [OsPath] -> IO ([OsPath], [OsPath])
    collect [OsPath]
    files [OsPath]
    dirs' []              = ([OsPath], [OsPath]) -> IO ([OsPath], [OsPath])
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([OsPath] -> [OsPath]
    forall a. [a] -> [a]
    reverse [OsPath]
    files
                                                             ,[OsPath] -> [OsPath]
    forall a. [a] -> [a]
    reverse [OsPath]
    dirs')
                collect [OsPath]
    files [OsPath]
    dirs' (OsPath
    entry:[OsPath]
    entries) = do
                  let dirEntry :: OsPath
    dirEntry = OsPath
    dir OsPath -> OsPath -> OsPath
    </> OsPath
    entry
                  isDirectory <- OsPath -> IO Bool
    doesDirectoryExist (OsPath
    topdir OsPath -> OsPath -> OsPath
    </> OsPath
    dirEntry)
                  if isDirectory
                    then collect files (dirEntry:dirs') entries
                    else collect (dirEntry:files) dirs' entries

    setModTime :: OsPath -> EpochTime -> IO ()
    setModTime :: OsPath -> EpochTime -> IO ()
    setModTime OsPath
    path EpochTime
    t =
        OsPath -> UTCTime -> IO ()
    setModificationTime OsPath
    path (POSIXTime -> UTCTime
    posixSecondsToUTCTime (EpochTime -> POSIXTime
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral EpochTime
    t))
          IO () -> (IOError -> IO ()) -> IO ()
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `Exception.catch` \IOError
    e -> case IOError -> IOErrorType
    ioeGetErrorType IOError
    e of
            IOErrorType
    PermissionDenied -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            -- On FAT32 file system setting time prior to DOS Epoch (1980-01-01)
            -- throws InvalidArgument, https://github.com/haskell/tar/issues/37
            IOErrorType
    InvalidArgument -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            IOErrorType
    _ -> IOError -> IO ()
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO IOError
    e

    setOwnerPermissions :: OsPath -> Permissions -> IO ()
    setOwnerPermissions :: OsPath -> Permissions -> IO ()
    setOwnerPermissions OsPath
    path Permissions
    permissions =
      OsPath -> Permissions -> IO ()
    setPermissions OsPath
    path Permissions
    ownerPermissions
      where
        -- | Info on Permission bits can be found here:
        -- https://www.gnu.org/software/libc/manual/html_node/Permission-Bits.html
        ownerPermissions :: Permissions
    ownerPermissions =
          Bool -> Permissions -> Permissions
    setOwnerReadable   (Permissions -> Int -> Bool
    forall a. Bits a => a -> Int -> Bool
    testBit Permissions
    permissions Int
    8) (Permissions -> Permissions) -> Permissions -> Permissions
    forall a b. (a -> b) -> a -> b
    $
          Bool -> Permissions -> Permissions
    setOwnerWritable   (Permissions -> Int -> Bool
    forall a. Bits a => a -> Int -> Bool
    testBit Permissions
    permissions Int
    7) (Permissions -> Permissions) -> Permissions -> Permissions
    forall a b. (a -> b) -> a -> b
    $
          Bool -> Permissions -> Permissions
    setOwnerExecutable (Permissions -> Int -> Bool
    forall a. Bits a => a -> Int -> Bool
    testBit Permissions
    permissions Int
    6) (Permissions -> Permissions) -> Permissions -> Permissions
    forall a b. (a -> b) -> a -> b
    $
          Bool -> Permissions -> Permissions
    setOwnerSearchable (Permissions -> Int -> Bool
    forall a. Bits a => a -> Int -> Bool
    testBit Permissions
    permissions Int
    6)
          Permissions
    emptyPermissions