Windows.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
module Data.Conduit.Tar.Windows
    ( getFileInfo
    , restoreFile
    ) where

import           Conduit
import           Control.Monad            (when)
import           Data.Bits
import qualified Data.ByteString.Char8    as S8
import           Data.Conduit.Tar.Types   (FileInfo (..), FileType (..))
import           Data.Time.Clock.POSIX
import           Foreign.C.Types          (CTime (..))
import qualified System.Directory         as Dir
import qualified System.PosixCompat.Files as Posix

getFileInfo :: S8.ByteString -> IO FileInfo
getFileInfo fp = do
    let fp' = S8.unpack fp
    fs <- Posix.getSymbolicLinkStatus fp'
    let uid = Posix.fileOwner fs
        gid = Posix.fileGroup fs
    (fType, fSize) <-
        case () of
            () | Posix.isRegularFile fs     -> return (FTNormal, Posix.fileSize fs)
               | Posix.isDirectory fs       -> return (FTDirectory, 0)
               | otherwise                  -> error $ "Unsupported file type: " ++ fp'
    return FileInfo
        { filePath      = fp
        , fileUserId    = uid
        , fileUserName  = ""
        , fileGroupId   = gid
        , fileGroupName = ""
        , fileMode      = Posix.fileMode fs .&. 0o7777
        , fileSize      = fSize
        , fileType      = fType
        , fileModTime   = Posix.modificationTime fs
        }

-- | Restore files onto the file system. Produces actions that will set the modification time on the
-- directories, which can be executed after the pipeline has finished and all files have been
-- written to disk.
restoreFile :: (MonadResource m) =>
               FileInfo -> ConduitM S8.ByteString (IO ()) m ()
restoreFile FileInfo {..} = do
    let filePath' = S8.unpack filePath
        CTime modTimeEpoch = fileModTime
        modTime = posixSecondsToUTCTime (fromIntegral modTimeEpoch)
    case fileType of
        FTDirectory -> do
            liftIO $ Dir.createDirectoryIfMissing False filePath'
            yield $
                (Dir.doesDirectoryExist filePath' >>=
                 (`when` Dir.setModificationTime filePath' modTime))
        FTNormal -> sinkFile filePath'
        ty -> error $ "Unsupported tar entry type: " ++ show ty
    liftIO $ do
        Dir.setModificationTime filePath' modTime
        Posix.setSymbolicLinkOwnerAndGroup filePath' fileUserId fileGroupId
        Posix.setFileMode filePath' fileMode