1 module Databrary.Files 2 ( RawFilePath 3 , (</>) 4 , catchDoesNotExist 5 , modificationTimestamp 6 , fileInfo 7 , setFileTimestamps 8 , removeFile 9 , createDir 10 , compareFiles 11 , hashFile 12 , rawFilePath 13 , unRawFilePath 14 ) where 15 16 import Control.Arrow ((&&&)) 17 import Control.Exception (handleJust) 18 import Control.Monad (guard, liftM2) 19 import Crypto.Hash (HashAlgorithm, hashInit, hashUpdate, hashFinalize, Digest) 20 import Data.ByteArray (MemView(..)) 21 import qualified Data.ByteString as BS 22 import Data.ByteString.Lazy.Internal (defaultChunkSize) 23 import Data.Maybe (isJust) 24 import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds) 25 import Foreign.Marshal.Alloc (allocaBytes) 26 import qualified GHC.Foreign as GHC 27 import GHC.IO.Encoding (getFileSystemEncoding) 28 import System.Posix.ByteString.FilePath (RawFilePath) 29 import System.Posix.FilePath ((</>)) 30 import qualified System.Posix as P 31 import qualified System.Posix.ByteString as RP 32 import System.Posix.Types (FileMode) 33 import System.IO (withBinaryFile, IOMode(ReadMode), hGetBufSome) 34 import System.Posix.Types (FileOffset) 35 import System.IO.Error (isDoesNotExistError, isAlreadyExistsError) 36 37 import Databrary.Ops 38 import Databrary.Model.Time 39 40 rawFilePath :: FilePath -> IO RawFilePath 41 rawFilePath s = do 42 enc <- getFileSystemEncoding 43 GHC.withCStringLen enc s BS.packCStringLen 44 45 unRawFilePath :: RawFilePath -> IO FilePath 46 unRawFilePath b = do 47 enc <- getFileSystemEncoding 48 BS.useAsCStringLen b $ GHC.peekCStringLen enc 49 50 catchOnlyIO :: (IOError -> Bool) -> IO a -> IO (Maybe a) 51 catchOnlyIO c f = handleJust (guard . c) (\_ -> return Nothing) $ Just <$> f 52 53 catchDoesNotExist :: IO a -> IO (Maybe a) 54 catchDoesNotExist = catchOnlyIO isDoesNotExistError 55 56 catchAlreadyExists :: IO a -> IO (Maybe a) 57 catchAlreadyExists = catchOnlyIO isAlreadyExistsError 58 59 modificationTimestamp :: P.FileStatus -> Timestamp 60 modificationTimestamp = posixSecondsToUTCTime . P.modificationTimeHiRes 61 62 fileInfo :: RawFilePath -> IO (Maybe (FileOffset, Timestamp)) 63 fileInfo f = 64 (=<<) (liftM2 thenUse P.isRegularFile $ P.fileSize &&& modificationTimestamp) 65 <$> catchDoesNotExist (RP.getFileStatus f) 66 67 setFileTimestamps :: RawFilePath -> Timestamp -> Timestamp -> IO () 68 setFileTimestamps f a m = RP.setFileTimesHiRes f (utcTimeToPOSIXSeconds a) (utcTimeToPOSIXSeconds m) 69 70 removeFile :: RawFilePath -> IO Bool 71 removeFile f = isJust <$> catchDoesNotExist (RP.removeLink f) 72 73 createDir :: RawFilePath -> FileMode -> IO Bool 74 createDir f m = isJust <$> catchAlreadyExists (RP.createDirectory f m) 75 76 -- | Returns 'True' if files are identical 77 compareFiles :: RawFilePath -> RawFilePath -> IO Bool 78 compareFiles f1 f2 = do 79 s1 <- RP.getFileStatus f1 80 s2 <- RP.getFileStatus f2 81 f1p <- unRawFilePath f1 82 f2p <- unRawFilePath f2 83 if P.deviceID s1 == P.deviceID s2 && P.fileID s1 == P.fileID s2 then return True 84 else if P.fileSize s1 /= P.fileSize s2 then return False 85 else withBinaryFile f1p ReadMode $ withBinaryFile f2p ReadMode . cmp where 86 cmp h1 h2 = do 87 b1 <- BS.hGet h1 defaultChunkSize 88 b2 <- BS.hGet h2 defaultChunkSize 89 if b1 == b2 90 then if BS.null b1 then return True else cmp h1 h2 91 else return False 92 93 hashFile :: (HashAlgorithm a) => RawFilePath -> IO (Digest a) 94 hashFile f = do 95 f' <- unRawFilePath f 96 withBinaryFile f' ReadMode $ \h -> 97 allocaBytes z $ \b -> 98 run h b hashInit where 99 run h b s = do 100 n <- hGetBufSome h b z 101 if n == 0 102 then return $! hashFinalize s 103 else run h b $! hashUpdate s (MemView b n) 104 z = 32786