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
import           Data.Time.Clock.POSIX
import           Foreign.C.Types          (CTime (..))
import qualified System.Directory         as Dir
import qualified System.PosixCompat.Files as Posix


getFileInfo :: FilePath -> IO FileInfo
getFileInfo fp = do
    fs <- Posix.getSymbolicLinkStatus fp
    let uid = fromIntegral $ Posix.fileOwner fs
        gid = fromIntegral $ 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      = encodeFilePath 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 fpStr = decodeFilePath filePath
        CTime modTimeEpoch = fileModTime
        modTime = posixSecondsToUTCTime (fromIntegral modTimeEpoch)
    case fileType of
        FTDirectory -> do
            liftIO $ Dir.createDirectoryIfMissing False fpStr
            yield $
                (Dir.doesDirectoryExist fpStr >>=
                 (`when` Dir.setModificationTime fpStr modTime))
        FTNormal -> sinkFile fpStr
        ty -> error $ "Unsupported tar entry type: " ++ show ty
    liftIO $ do
        Dir.setModificationTime fpStr modTime
        Posix.setFileMode fpStr fileMode