    {-# LANGUAGE CPP                 #-}
    {-# LANGUAGE OverloadedStrings   #-}
    {-# LANGUAGE RecordWildCards     #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    module Data.Conduit.Tar.Unix
        ( getFileInfo
        , restoreFileInternal
        ) where

    import           Conduit                       hiding (throwM)
    import           Control.Exception.Safe
    import           Control.Monad                 (void, when, unless)
    import           Data.Bits
    import qualified Data.ByteString.Char8         as S8
    import           Data.Either
    import           Data.Conduit.Tar.Types
    import           Foreign.C.Types               (CTime (..))
    import qualified System.Directory              as Dir
    import qualified System.Posix.Files            as Posix
    import qualified System.Posix.User             as Posix
    import qualified System.FilePath.Posix         as Posix
    #if MIN_VERSION_unix(2,8,0)
    import qualified System.Posix.User.ByteString as UBS
    #endif

    getFileInfo :: FilePath -> IO FileInfo
    getFileInfo :: [Char] -> IO FileInfo
    getFileInfo [Char]
    fpStr = do
        let fp :: ByteString
    fp = [Char] -> ByteString
    encodeFilePath [Char]
    fpStr
        fs <- [Char] -> IO FileStatus
    Posix.getSymbolicLinkStatus [Char]
    fpStr
        let uid = FileStatus -> UserID
    Posix.fileOwner FileStatus
    fs
            gid = FileStatus -> GroupID
    Posix.fileGroup FileStatus
    fs
        -- Allow for username/group retrieval failure, especially useful for non-tty environment.
        -- Workaround for: https://ghc.haskell.org/trac/ghc/ticket/1487
        -- Moreover, names are non-critical as they are not used during unarchival process
    #if MIN_VERSION_unix(2,8,0)
        euEntry :: Either IOException UBS.UserEntry <- try $ Posix.getUserEntryForID uid
        egEntry :: Either IOException UBS.GroupEntry <- try $ Posix.getGroupEntryForID gid
        let
          fileUserName = (IOException -> ByteString)
    -> (UserEntry -> ByteString)
    -> Either IOException UserEntry
    -> ByteString
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (ByteString -> IOException -> ByteString
    forall a b. a -> b -> a
    const ByteString
    "") UserEntry -> ByteString
    UBS.userName Either IOException UserEntry
    euEntry
          fileGroupName = (IOException -> ByteString)
    -> (GroupEntry -> ByteString)
    -> Either IOException GroupEntry
    -> ByteString
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (ByteString -> IOException -> ByteString
    forall a b. a -> b -> a
    const ByteString
    "") GroupEntry -> ByteString
    UBS.groupName Either IOException GroupEntry
    egEntry
    #else
        euEntry :: Either IOException Posix.UserEntry <- try $ Posix.getUserEntryForID uid
        egEntry :: Either IOException Posix.GroupEntry <- try $ Posix.getGroupEntryForID gid
        let
          fileUserName = either (const "") (S8.pack . Posix.userName) euEntry
          fileGroupName = either (const "") (S8.pack . Posix.groupName) egEntry
    #endif
        (fType, fSize) <-
            case () of
                () | FileStatus -> Bool
    Posix.isRegularFile FileStatus
    fs     -> (FileType, FileOffset) -> IO (FileType, FileOffset)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FileType
    FTNormal, FileStatus -> FileOffset
    Posix.fileSize FileStatus
    fs)
                   | FileStatus -> Bool
    Posix.isSymbolicLink FileStatus
    fs    -> do
                         ln <- [Char] -> IO [Char]
    Posix.readSymbolicLink [Char]
    fpStr
                         return (FTSymbolicLink (encodeFilePath ln), 0)
                   | FileStatus -> Bool
    Posix.isCharacterDevice FileStatus
    fs -> (FileType, FileOffset) -> IO (FileType, FileOffset)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FileType
    FTCharacterSpecial, FileOffset
    0)
                   | FileStatus -> Bool
    Posix.isBlockDevice FileStatus
    fs     -> (FileType, FileOffset) -> IO (FileType, FileOffset)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FileType
    FTBlockSpecial, FileOffset
    0)
                   | FileStatus -> Bool
    Posix.isDirectory FileStatus
    fs       -> (FileType, FileOffset) -> IO (FileType, FileOffset)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FileType
    FTDirectory, FileOffset
    0)
                   | FileStatus -> Bool
    Posix.isNamedPipe FileStatus
    fs       -> (FileType, FileOffset) -> IO (FileType, FileOffset)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FileType
    FTFifo, FileOffset
    0)
                   | Bool
    otherwise                  -> [Char] -> IO (FileType, FileOffset)
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> IO (FileType, FileOffset))
    -> [Char] -> IO (FileType, FileOffset)
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Unsupported file type: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ ByteString -> [Char]
    S8.unpack ByteString
    fp
        return $! FileInfo
            { filePath      = fp
            , fileUserId    = uid
            , fileUserName  = fileUserName
            , fileGroupId   = gid
            , fileGroupName = fileGroupName
            , fileMode      = Posix.fileMode fs .&. 0o7777
            , fileSize      = fSize
            , fileType      = fType
            , fileModTime   = Posix.modificationTime fs
            }

    -- | See 'Data.Conduit.Tar.restoreFileWithErrors' for documentation
    restoreFileInternal ::
           (MonadResource m)
        => Bool
        -> FileInfo
        -> ConduitM S8.ByteString (IO (FileInfo, [SomeException])) m ()
    restoreFileInternal :: forall (m :: * -> *).
    MonadResource m =>
    Bool
    -> FileInfo
    -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
    restoreFileInternal Bool
    lenient fi :: FileInfo
    fi@FileInfo {EpochTime
    GroupID
    FileMode
    FileOffset
    UserID
    ByteString
    FileType
    filePath :: FileInfo -> ByteString
    fileUserId :: FileInfo -> UserID
    fileUserName :: FileInfo -> ByteString
    fileGroupId :: FileInfo -> GroupID
    fileGroupName :: FileInfo -> ByteString
    fileMode :: FileInfo -> FileMode
    fileSize :: FileInfo -> FileOffset
    fileType :: FileInfo -> FileType
    fileModTime :: FileInfo -> EpochTime
    filePath :: ByteString
    fileUserId :: UserID
    fileUserName :: ByteString
    fileGroupId :: GroupID
    fileGroupName :: ByteString
    fileMode :: FileMode
    fileSize :: FileOffset
    fileType :: FileType
    fileModTime :: EpochTime
    ..} = do
        let fpStr :: [Char]
    fpStr = ByteString -> [Char]
    decodeFilePath ByteString
    filePath
            tryAnyCond :: m a -> m (Either SomeException a)
    tryAnyCond m a
    action = if Bool
    lenient then m a -> m (Either SomeException a)
    forall (m :: * -> *) a.
    (HasCallStack, MonadCatch m) =>
    m a -> m (Either SomeException a)
    tryAny m a
    action else (a -> Either SomeException a) -> m a -> m (Either SomeException a)
    forall a b. (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> Either SomeException a
    forall a b. b -> Either a b
    Right m a
    action
            restorePermissions :: IO [SomeException]
    restorePermissions = do
                eExc1 <- IO () -> IO (Either SomeException ())
    forall {m :: * -> *} {a}.
    MonadCatch m =>
    m a -> m (Either SomeException a)
    tryAnyCond (IO () -> IO (Either SomeException ()))
    -> IO () -> IO (Either SomeException ())
    forall a b. (a -> b) -> a -> b
    $ [Char] -> UserID -> GroupID -> IO ()
    Posix.setOwnerAndGroup [Char]
    fpStr UserID
    fileUserId GroupID
    fileGroupId
                eExc2 <- tryAnyCond $ Posix.setFileMode fpStr fileMode
                return $! fst $ partitionEithers [eExc1, eExc2]
            -- | Catch all exceptions, but only if lenient is set to True
        case FileType
    fileType of
            FileType
    FTDirectory -> do
                excs <- IO [SomeException]
    -> ConduitT
         ByteString (IO (FileInfo, [SomeException])) m [SomeException]
    forall a.
    IO a -> ConduitT ByteString (IO (FileInfo, [SomeException])) m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO [SomeException]
     -> ConduitT
          ByteString (IO (FileInfo, [SomeException])) m [SomeException])
    -> IO [SomeException]
    -> ConduitT
         ByteString (IO (FileInfo, [SomeException])) m [SomeException]
    forall a b. (a -> b) -> a -> b
    $ do
                    Bool -> [Char] -> IO ()
    Dir.createDirectoryIfMissing Bool
    True [Char]
    fpStr
                    IO [SomeException]
    restorePermissions
                yield $ do
                    eExc <- tryAnyCond (Dir.doesDirectoryExist fpStr >>=
                                        (`when` Posix.setFileTimes fpStr fileModTime fileModTime))
                    return (fi, either ((excs ++) . pure) (const excs) eExc)
            FTSymbolicLink ByteString
    link -> do
                excs <- IO [SomeException]
    -> ConduitT
         ByteString (IO (FileInfo, [SomeException])) m [SomeException]
    forall a.
    IO a -> ConduitT ByteString (IO (FileInfo, [SomeException])) m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO [SomeException]
     -> ConduitT
          ByteString (IO (FileInfo, [SomeException])) m [SomeException])
    -> IO [SomeException]
    -> ConduitT
         ByteString (IO (FileInfo, [SomeException])) m [SomeException]
    forall a b. (a -> b) -> a -> b
    $ do
                    -- Try to unlink any existing file/symlink
                    IO (Either SomeException ()) -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO (Either SomeException ()) -> IO ())
    -> IO (Either SomeException ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ IO () -> IO (Either SomeException ())
    forall (m :: * -> *) a.
    (HasCallStack, MonadCatch m) =>
    m a -> m (Either SomeException a)
    tryAny (IO () -> IO (Either SomeException ()))
    -> IO () -> IO (Either SomeException ())
    forall a b. (a -> b) -> a -> b
    $ [Char] -> IO ()
    Posix.removeLink [Char]
    fpStr
                    Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    lenient (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Bool -> [Char] -> IO ()
    Dir.createDirectoryIfMissing Bool
    True ([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [Char]
    Posix.takeDirectory [Char]
    fpStr
                    [Char] -> [Char] -> IO ()
    Posix.createSymbolicLink (ByteString -> [Char]
    decodeFilePath ByteString
    link) [Char]
    fpStr
                    eExc1 <- IO () -> IO (Either SomeException ())
    forall {m :: * -> *} {a}.
    MonadCatch m =>
    m a -> m (Either SomeException a)
    tryAnyCond (IO () -> IO (Either SomeException ()))
    -> IO () -> IO (Either SomeException ())
    forall a b. (a -> b) -> a -> b
    $ [Char] -> UserID -> GroupID -> IO ()
    Posix.setSymbolicLinkOwnerAndGroup [Char]
    fpStr UserID
    fileUserId GroupID
    fileGroupId
    #if MIN_VERSION_unix(2,7,0)
                    -- Try best effort in setting symbolic link modification time.
                    let CTime epochInt32 = fileModTime
                        unixModTime = Integer -> POSIXTime
    forall a. Num a => Integer -> a
    fromInteger (Int64 -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int64
    epochInt32)
                    eExc2 <- tryAny $ Posix.setSymbolicLinkTimesHiRes fpStr unixModTime unixModTime
    #endif
                    return $ fst $ partitionEithers [eExc1, eExc2]
                unless (null excs) $ yield (return (fi, excs))
            FTHardLink ByteString
    link -> do
                excs <- IO [SomeException]
    -> ConduitT
         ByteString (IO (FileInfo, [SomeException])) m [SomeException]
    forall a.
    IO a -> ConduitT ByteString (IO (FileInfo, [SomeException])) m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO [SomeException]
     -> ConduitT
          ByteString (IO (FileInfo, [SomeException])) m [SomeException])
    -> IO [SomeException]
    -> ConduitT
         ByteString (IO (FileInfo, [SomeException])) m [SomeException]
    forall a b. (a -> b) -> a -> b
    $ do
                    let linkedFp :: [Char]
    linkedFp = ByteString -> [Char]
    decodeFilePath ByteString
    link
                    Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    lenient (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                        linkedFileExists <- [Char] -> IO Bool
    Posix.fileExist [Char]
    linkedFp
                        -- If the linked file does not exist (yet), we cannot create a hard link.
                        -- Try to "pre-create" it.
                        unless linkedFileExists $ do
                            Dir.createDirectoryIfMissing True $ Posix.takeDirectory linkedFp
                            writeFile linkedFp ""
                    Bool -> [Char] -> IO ()
    Dir.createDirectoryIfMissing Bool
    True ([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [Char]
    Posix.takeDirectory [Char]
    fpStr
                    -- Try to unlink any existing file/hard link
                    IO (Either SomeException ()) -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO (Either SomeException ()) -> IO ())
    -> IO (Either SomeException ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ IO () -> IO (Either SomeException ())
    forall (m :: * -> *) a.
    (HasCallStack, MonadCatch m) =>
    m a -> m (Either SomeException a)
    tryAny (IO () -> IO (Either SomeException ()))
    -> IO () -> IO (Either SomeException ())
    forall a b. (a -> b) -> a -> b
    $ [Char] -> IO ()
    Posix.removeLink [Char]
    fpStr
                    [Char] -> [Char] -> IO ()
    Posix.createLink [Char]
    linkedFp [Char]
    fpStr
                    IO [SomeException] -> IO [SomeException]
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO [SomeException] -> IO [SomeException])
    -> IO [SomeException] -> IO [SomeException]
    forall a b. (a -> b) -> a -> b
    $ do
                        excs <- IO [SomeException]
    restorePermissions
                        eExc <- tryAnyCond $ Posix.setFileTimes fpStr fileModTime fileModTime
                        return (either ((excs ++) . pure) (const excs) eExc)
                unless (null excs) $ yield (return (fi, excs))
            FileType
    FTNormal -> do
                Bool
    -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
    -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    lenient (ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
     -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ())
    -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
    -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
    forall a b. (a -> b) -> a -> b
    $ IO () -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
    forall a.
    IO a -> ConduitT ByteString (IO (FileInfo, [SomeException])) m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ()
     -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ())
    -> IO ()
    -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
    forall a b. (a -> b) -> a -> b
    $ Bool -> [Char] -> IO ()
    Dir.createDirectoryIfMissing Bool
    True ([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [Char]
    Posix.takeDirectory [Char]
    fpStr
                [Char] -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
    forall (m :: * -> *) o.
    MonadResource m =>
    [Char] -> ConduitT ByteString o m ()
    sinkFile [Char]
    fpStr
                excs <- IO [SomeException]
    -> ConduitT
         ByteString (IO (FileInfo, [SomeException])) m [SomeException]
    forall a.
    IO a -> ConduitT ByteString (IO (FileInfo, [SomeException])) m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO [SomeException]
     -> ConduitT
          ByteString (IO (FileInfo, [SomeException])) m [SomeException])
    -> IO [SomeException]
    -> ConduitT
         ByteString (IO (FileInfo, [SomeException])) m [SomeException]
    forall a b. (a -> b) -> a -> b
    $ do
                    excs <- IO [SomeException]
    restorePermissions
                    eExc <- tryAnyCond $ Posix.setFileTimes fpStr fileModTime fileModTime
                    return (either ((excs ++) . pure) (const excs) eExc)
                unless (null excs) $ yield $ return (fi, excs)
            FileType
    ty -> do
                let exc :: TarException
    exc = FileType -> TarException
    UnsupportedType FileType
    ty
                Bool
    -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
    -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    lenient (ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
     -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ())
    -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
    -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
    forall a b. (a -> b) -> a -> b
    $ IO () -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
    forall a.
    IO a -> ConduitT ByteString (IO (FileInfo, [SomeException])) m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ()
     -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ())
    -> IO ()
    -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
    forall a b. (a -> b) -> a -> b
    $ TarException -> IO ()
    forall (m :: * -> *) e a.
    (HasCallStack, MonadThrow m, Exception e) =>
    e -> m a
    throwM TarException
    exc
                IO (FileInfo, [SomeException])
    -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
    forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
    yield (IO (FileInfo, [SomeException])
     -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ())
    -> IO (FileInfo, [SomeException])
    -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
    forall a b. (a -> b) -> a -> b
    $ (FileInfo, [SomeException]) -> IO (FileInfo, [SomeException])
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FileInfo
    fi, [TarException -> SomeException
    forall e. Exception e => e -> SomeException
    toException TarException
    exc])