{-# LANGUAGE OverloadedStrings #-} import Test.Hspec import HSFM.FileSystem.FileOperations import Data.Maybe ( fromJust ) import qualified HPath as P import System.Posix.Env.ByteString ( getEnv ) import HSFM.FileSystem.Errors import HSFM.Utils.IO import System.IO.Error ( ioeGetErrorType ) import GHC.IO.Exception ( IOErrorType(..) ) import Data.ByteString ( ByteString ) import System.Exit import System.Process import System.Posix.Files.ByteString ( groupExecuteMode , groupReadMode , nullFileMode , otherExecuteMode , otherReadMode , ownerExecuteMode , ownerReadMode , setFileMode , unionFileModes ) -- TODO: chardev, blockdev, namedpipe, socket main :: IO () main = hspec $ before_ fixPermissions $ after_ revertPermissions $ do let tests = [copyFileSpec , copyDirRecursiveSpec , createDirSpec , createRegularFileSpec , renameFileSpec , moveFileSpec , recreateSymlinkSpec , getFileTypeSpec ] -- run all stateful tests twice to catch missing cleanups or state skew sequence_ tests sequence_ tests -- TODO: deleteFile, deleteDir, deleteDirRecursive, getDirsFiles, getFileType where noWriteDirs = ["test/copyFileSpec/outputDirNoWrite" ,"test/copyDirRecursiveSpec/noWritePerm" ,"test/createDirSpec/noWritePerms" ,"test/createRegularFileSpec/noWritePerms" ,"test/renameFile/noWritePerm" ,"test/moveFile/noWritePerm" ,"test/recreateSymlinkSpec/noWritePerm" ] noPermsDirs = ["test/copyFileSpec/noPerms" ,"test/copyDirRecursiveSpec/noPerms" ,"test/createDirSpec/noPerms" ,"test/createRegularFileSpec/noPerms" ,"test/renameFile/noPerms" ,"test/moveFile/noPerms" ,"test/recreateSymlinkSpec/noPerms" ,"test/getFileTypeSpec/noPerms" ] fixPermissions = do sequence_ $ fmap noWritableDirPerms noWriteDirs sequence_ $ fmap noPerms noPermsDirs revertPermissions = do sequence_ $ fmap normalDirPerms noWriteDirs sequence_ $ fmap normalDirPerms noPermsDirs ------------- --[ Specs ]-- ------------- copyFileSpec :: Spec copyFileSpec = describe "HSFM.FileSystem.FileOperations.copyFile" $ do -- successes -- it "copyFile, everything clear" $ copyFile' "test/copyFileSpec/inputFile" "test/copyFileSpec/outputFile" it "copyFile, and compare" $ copyFile'' "test/copyFileSpec/inputFile" "test/copyFileSpec/outputFile" (system $ "cmp -s " ++ "test/copyFileSpec/inputFile" ++ " " ++ "test/copyFileSpec/outputFile") `shouldReturn` ExitSuccess -- posix failures -- it "copyFile, input file does not exist" $ copyFile' "test/copyFileSpec/noSuchFile" "test/copyFileSpec/outputFile" `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) it "copyFile, no permission to write to output directory" $ copyFile' "test/copyFileSpec/inputFile" "test/copyFileSpec/outputDirNoWrite/outputFile" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "copyFile, cannot open output directory" $ copyFile' "test/copyFileSpec/inputFile" "test/copyFileSpec/noPerms/outputFile" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "copyFile, cannot open source directory" $ copyFile' "test/copyFileSpec/noPerms/inputFile" "test/copyFileSpec/outputFile" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "copyFile, wrong input type (symlink)" $ copyFile' "test/copyFileSpec/inputFileSymL" "test/copyFileSpec/outputFile" `shouldThrow` (\e -> ioeGetErrorType e == InvalidArgument) it "copyFile, wrong input type (directory)" $ copyFile' "test/copyFileSpec/wrongInput" "test/copyFileSpec/outputFile" `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) it "copyFile, output and input are same file" $ copyFile' "test/copyFileSpec/inputFile" "test/copyFileSpec/inputFile" `shouldThrow` (\e -> ioeGetErrorType e == AlreadyExists) it "copyFile, output file already exists" $ copyFile' "test/copyFileSpec/inputFile" "test/copyFileSpec/alreadyExists" `shouldThrow` (\e -> ioeGetErrorType e == AlreadyExists) it "copyFile, output file already exists and is a dir" $ copyFile' "test/copyFileSpec/inputFile" "test/copyFileSpec/alreadyExistsD" `shouldThrow` (\e -> ioeGetErrorType e == AlreadyExists) copyDirRecursiveSpec :: Spec copyDirRecursiveSpec = describe "HSFM.FileSystem.FileOperations.copyDirRecursive" $ do -- successes -- it "copyDirRecursive, all fine" $ copyDirRecursive' "test/copyDirRecursiveSpec/inputDir" "test/copyDirRecursiveSpec/outputDir" it "copyDirRecursive, all fine and compare" $ copyDirRecursive'' "test/copyDirRecursiveSpec/inputDir" "test/copyDirRecursiveSpec/outputDir" (system $ "diff -r --no-dereference " ++ "test/copyDirRecursiveSpec/inputDir" ++ " " ++ "test/copyDirRecursiveSpec/outputDir") `shouldReturn` ExitSuccess -- posix failures -- it "copyDirRecursive, source directory does not exist" $ copyDirRecursive' "test/copyDirRecursiveSpec/doesNotExist" "test/copyDirRecursiveSpec/outputDir" `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) it "copyDirRecursive, no write permission on output dir" $ copyDirRecursive' "test/copyDirRecursiveSpec/inputDir" "test/copyDirRecursiveSpec/noWritePerm/foo" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "copyDirRecursive, cannot open output dir" $ copyDirRecursive' "test/copyDirRecursiveSpec/inputDir" "test/copyDirRecursiveSpec/noPerms/foo" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "copyDirRecursive, cannot open source dir" $ copyDirRecursive' "test/copyDirRecursiveSpec/noPerms/inputDir" "test/copyDirRecursiveSpec/foo" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "copyDirRecursive, destination dir already exists" $ copyDirRecursive' "test/copyDirRecursiveSpec/inputDir" "test/copyDirRecursiveSpec/alreadyExistsD" `shouldThrow` (\e -> ioeGetErrorType e == AlreadyExists) it "copyDirRecursive, destination already exists and is a file" $ copyDirRecursive' "test/copyDirRecursiveSpec/inputDir" "test/copyDirRecursiveSpec/alreadyExists" `shouldThrow` (\e -> ioeGetErrorType e == AlreadyExists) it "copyDirRecursive, destination and source same directory" $ copyDirRecursive' "test/copyDirRecursiveSpec/inputDir" "test/copyDirRecursiveSpec/inputDir" `shouldThrow` (\e -> ioeGetErrorType e == AlreadyExists) it "copyDirRecursive, wrong input (regular file)" $ copyDirRecursive' "test/copyDirRecursiveSpec/wrongInput" "test/copyDirRecursiveSpec/outputDir" `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) it "copyDirRecursive, wrong input (symlink to directory)" $ copyDirRecursive' "test/copyDirRecursiveSpec/wrongInputSymL" "test/copyDirRecursiveSpec/outputDir" `shouldThrow` (\e -> ioeGetErrorType e == InvalidArgument) -- custom failures it "copyDirRecursive, destination in source" $ copyDirRecursive' "test/copyDirRecursiveSpec/inputDir" "test/copyDirRecursiveSpec/inputDir/foo" `shouldThrow` isDestinationInSource createDirSpec :: Spec createDirSpec = describe "HSFM.FileSystem.FileOperations.createDir" $ do -- successes -- it "createDir, all fine" $ createDir' "test/createDirSpec/newDir" -- posix failures -- it "createDir, can't write to output directory" $ createDir' "test/createDirSpec/noWritePerms/newDir" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "createDir, can't open output directory" $ createDir' "test/createDirSpec/noPerms/newDir" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "createDir, destination directory already exists" $ createDir' "test/createDirSpec/alreadyExists" `shouldThrow` (\e -> ioeGetErrorType e == AlreadyExists) createRegularFileSpec :: Spec createRegularFileSpec = describe "HSFM.FileSystem.FileOperations.createRegularFile" $ do -- successes -- it "createRegularFile, all fine" $ createRegularFile' "test/createRegularFileSpec/newDir" -- posix failures -- it "createRegularFile, can't write to destination directory" $ createRegularFile' "test/createRegularFileSpec/noWritePerms/newDir" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "createRegularFile, can't write to destination directory" $ createRegularFile' "test/createRegularFileSpec/noPerms/newDir" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "createRegularFile, destination file already exists" $ createRegularFile' "test/createRegularFileSpec/alreadyExists" `shouldThrow` (\e -> ioeGetErrorType e == AlreadyExists) renameFileSpec :: Spec renameFileSpec = describe "HSFM.FileSystem.FileOperations.renameFile" $ do -- successes -- it "renameFile, all fine" $ renameFile' "test/renameFile/myFile" "test/renameFile/renamedFile" it "renameFile, all fine" $ renameFile' "test/renameFile/myFile" "test/renameFile/dir/renamedFile" it "renameFile, all fine on symlink" $ renameFile' "test/renameFile/myFileL" "test/renameFile/renamedFile" it "renameFile, all fine on directory" $ renameFile' "test/renameFile/dir" "test/renameFile/renamedFile" -- posix failures -- it "renameFile, source file does not exist" $ renameFile' "test/renameFile/fileDoesNotExist" "test/renameFile/renamedFile" `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) it "renameFile, can't write to output directory" $ renameFile' "test/renameFile/myFile" "test/renameFile/noWritePerm/renamedFile" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "renameFile, can't open output directory" $ renameFile' "test/renameFile/myFile" "test/renameFile/noPerms/renamedFile" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "renameFile, can't open source directory" $ renameFile' "test/renameFile/noPerms/myFile" "test/renameFile/renamedFile" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) -- custom failures -- it "renameFile, destination file already exists" $ renameFile' "test/renameFile/myFile" "test/renameFile/alreadyExists" `shouldThrow` isFileDoesExist it "renameFile, move from file to dir" $ renameFile' "test/renameFile/myFile" "test/renameFile/alreadyExistsD" `shouldThrow` isDirDoesExist it "renameFile, source and dest are same file" $ renameFile' "test/renameFile/myFile" "test/renameFile/myFile" `shouldThrow` isSameFile moveFileSpec :: Spec moveFileSpec = describe "HSFM.FileSystem.FileOperations.moveFile" $ do -- successes -- it "moveFile, all fine" $ moveFile' "test/moveFile/myFile" "test/moveFile/movedFile" it "moveFile, all fine" $ moveFile' "test/moveFile/myFile" "test/moveFile/dir/movedFile" it "moveFile, all fine on symlink" $ moveFile' "test/moveFile/myFileL" "test/moveFile/movedFile" it "moveFile, all fine on directory" $ moveFile' "test/moveFile/dir" "test/moveFile/movedFile" -- posix failures -- it "moveFile, source file does not exist" $ moveFile' "test/moveFile/fileDoesNotExist" "test/moveFile/movedFile" `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) it "moveFile, can't write to destination directory" $ moveFile' "test/moveFile/myFile" "test/moveFile/noWritePerm/movedFile" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "moveFile, can't open destination directory" $ moveFile' "test/moveFile/myFile" "test/moveFile/noPerms/movedFile" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "moveFile, can't open source directory" $ moveFile' "test/moveFile/noPerms/myFile" "test/moveFile/movedFile" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) -- custom failures -- it "moveFile, destination file already exists" $ moveFile' "test/moveFile/myFile" "test/moveFile/alreadyExists" `shouldThrow` isFileDoesExist it "moveFile, move from file to dir" $ moveFile' "test/moveFile/myFile" "test/moveFile/alreadyExistsD" `shouldThrow` isDirDoesExist it "moveFile, source and dest are same file" $ moveFile' "test/moveFile/myFile" "test/moveFile/myFile" `shouldThrow` isSameFile recreateSymlinkSpec :: Spec recreateSymlinkSpec = describe "HSFM.FileSystem.FileOperations.recreateSymlink" $ do -- successes -- it "recreateSymLink, all fine" $ recreateSymlink' "test/recreateSymlinkSpec/myFileL" "test/recreateSymlinkSpec/movedFile" it "recreateSymLink, all fine" $ recreateSymlink' "test/recreateSymlinkSpec/myFileL" "test/recreateSymlinkSpec/dir/movedFile" -- posix failures -- it "recreateSymLink, wrong input type (file)" $ recreateSymlink' "test/recreateSymlinkSpec/myFile" "test/recreateSymlinkSpec/movedFile" `shouldThrow` (\e -> ioeGetErrorType e == InvalidArgument) it "recreateSymLink, wrong input type (directory)" $ recreateSymlink' "test/recreateSymlinkSpec/dir" "test/recreateSymlinkSpec/movedFile" `shouldThrow` (\e -> ioeGetErrorType e == InvalidArgument) it "recreateSymLink, can't write to destination directory" $ recreateSymlink' "test/recreateSymlinkSpec/myFileL" "test/recreateSymlinkSpec/noWritePerm/movedFile" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "recreateSymLink, can't open destination directory" $ recreateSymlink' "test/recreateSymlinkSpec/myFileL" "test/recreateSymlinkSpec/noPerms/movedFile" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "recreateSymLink, can't open source directory" $ recreateSymlink' "test/recreateSymlinkSpec/noPerms/myFileL" "test/recreateSymlinkSpec/movedFile" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "recreateSymLink, destination file already exists" $ recreateSymlink' "test/recreateSymlinkSpec/myFileL" "test/recreateSymlinkSpec/alreadyExists" `shouldThrow` (\e -> ioeGetErrorType e == AlreadyExists) it "recreateSymLink, destination already exists and is a dir" $ recreateSymlink' "test/recreateSymlinkSpec/myFileL" "test/recreateSymlinkSpec/alreadyExistsD" `shouldThrow` (\e -> ioeGetErrorType e == AlreadyExists) it "recreateSymLink, source and destination are the same file" $ recreateSymlink' "test/recreateSymlinkSpec/myFileL" "test/recreateSymlinkSpec/myFileL" `shouldThrow` (\e -> ioeGetErrorType e == AlreadyExists) getFileTypeSpec :: Spec getFileTypeSpec = describe "HSFM.FileSystem.FileOperations.getFileType" $ do -- successes -- it "getFileType, regular file" $ getFileType' "test/getFileTypeSpec/regularfile" `shouldReturn` RegularFile it "getFileType, directory" $ getFileType' "test/getFileTypeSpec/directory" `shouldReturn` Directory it "getFileType, directory with null permissions" $ getFileType' "test/getFileTypeSpec/noPerms" `shouldReturn` Directory it "getFileType, symlink to file" $ getFileType' "test/getFileTypeSpec/symlink" `shouldReturn` SymbolicLink it "getFileType, symlink to directory" $ getFileType' "test/getFileTypeSpec/symlinkD" `shouldReturn` SymbolicLink it "getFileType, broken symlink" $ getFileType' "test/getFileTypeSpec/brokenSymlink" `shouldReturn` SymbolicLink -- posix failures -- it "getFileType, file does not exist" $ getFileType' "test/getFileTypeSpec/nothingHere" `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) it "getFileType, can't open directory" $ getFileType' "test/getFileTypeSpec/noPerms/forz" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) ----------------- --[ Utilities ]-- ----------------- copyFile'' :: ByteString -> ByteString -> IO a -> IO a copyFile'' inputFileP outputFileP before_cleanup = do pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs inputFile <- (pwd P.) <$> P.parseRel inputFileP outputFile <- (pwd P.) <$> P.parseRel outputFileP copyFile inputFile outputFile r <- before_cleanup whenM (doesFileExist outputFile) (deleteFile outputFile) return r copyFile' :: ByteString -> ByteString -> IO () copyFile' inputFileP outputFileP = copyFile'' inputFileP outputFileP (return ()) copyDirRecursive'' :: ByteString -> ByteString -> IO a -> IO a copyDirRecursive'' inputDirP outputDirP before_cleanup = do pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs inputDir <- (pwd P.) <$> P.parseRel inputDirP outputDir <- (pwd P.) <$> P.parseRel outputDirP copyDirRecursive inputDir outputDir r <- before_cleanup whenM (doesDirectoryExist outputDir) (deleteDirRecursive outputDir) return r copyDirRecursive' :: ByteString -> ByteString -> IO () copyDirRecursive' inputDirP outputDirP = copyDirRecursive'' inputDirP outputDirP (return ()) createDir' :: ByteString -> IO () createDir' dest = do pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs outputDir <- (pwd P.) <$> P.parseRel dest createDir outputDir whenM (doesDirectoryExist outputDir) (deleteDir outputDir) createRegularFile' :: ByteString -> IO () createRegularFile' dest = do pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs outputFile <- (pwd P.) <$> P.parseRel dest createRegularFile outputFile whenM (doesFileExist outputFile) (deleteFile outputFile) renameFile' :: ByteString -> ByteString -> IO () renameFile' inputFileP outputFileP = do pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs inputFile <- (pwd P.) <$> P.parseRel inputFileP outputFile <- (pwd P.) <$> P.parseRel outputFileP renameFile inputFile outputFile renameFile outputFile inputFile moveFile' :: ByteString -> ByteString -> IO () moveFile' inputFileP outputFileP = do pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs inputFile <- (pwd P.) <$> P.parseRel inputFileP outputFile <- (pwd P.) <$> P.parseRel outputFileP moveFile inputFile outputFile moveFile outputFile inputFile recreateSymlink' :: ByteString -> ByteString -> IO () recreateSymlink' inputFileP outputFileP = do pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs inputFile <- (pwd P.) <$> P.parseRel inputFileP outputFile <- (pwd P.) <$> P.parseRel outputFileP recreateSymlink inputFile outputFile whenM (doesFileExist outputFile) (deleteFile outputFile) noWritableDirPerms :: ByteString -> IO () noWritableDirPerms path = do pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs file <- (pwd P.) <$> P.parseRel path setFileMode (P.fromAbs file) perms where perms = ownerReadMode `unionFileModes` ownerExecuteMode `unionFileModes` groupReadMode `unionFileModes` groupExecuteMode `unionFileModes` otherReadMode `unionFileModes` otherExecuteMode noPerms :: ByteString -> IO () noPerms path = do pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs file <- (pwd P.) <$> P.parseRel path setFileMode (P.fromAbs file) nullFileMode normalDirPerms :: ByteString -> IO () normalDirPerms path = do pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs file <- (pwd P.) <$> P.parseRel path setFileMode (P.fromAbs file) newDirPerms getFileType' :: ByteString -> IO FileType getFileType' path = do pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs file <- (pwd P.) <$> P.parseRel path getFileType file