diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,9 @@ +0.8.0 + * 'copyDirRecursiveOverwrite', 'copyFileOverwrite', 'easyCopyOverwrite' and 'moveFileOverwrite' have been removed, instead use the versions without the *Overwrite suffix and pass in 'Strict' (for default behavior) or 'Overwrite' as the CopyMode argument + * introduced a new 'RecursiveErrorMode' type to allow controlling recursive behavior of 'copyDirRecursive' (use 'FailEarly' for default behavior) + * 'createRegularFile' and 'createDir' now take FileMode as a parameter (also see 'newFilePerms' and 'newDirPerms') + * various documentation fixes + * improved reliability of tests 0.7.5: * relicense to BSD3 0.7.3: diff --git a/hpath.cabal b/hpath.cabal --- a/hpath.cabal +++ b/hpath.cabal @@ -1,5 +1,5 @@ name: hpath -version: 0.7.5 +version: 0.8.0 synopsis: Support for well-typed paths description: Support for well-typed paths, utilizing ByteString under the hood. license: BSD3 @@ -19,7 +19,10 @@ library hs-source-dirs: src/ default-language: Haskell2010 - ghc-options: -Wall + if impl(ghc >= 8.0) + ghc-options: -Wall -Wno-redundant-constraints + else + ghc-options: -Wall c-sources: cbits/dirutils.c exposed-modules: HPath, HPath.IO, @@ -73,6 +76,7 @@ Main-Is: Main.hs other-modules: HPath.IO.CanonicalizePathSpec + HPath.IO.CopyDirRecursiveCollectFailuresSpec HPath.IO.CopyDirRecursiveOverwriteSpec HPath.IO.CopyDirRecursiveSpec HPath.IO.CopyFileOverwriteSpec @@ -87,6 +91,7 @@ HPath.IO.GetFileTypeSpec HPath.IO.MoveFileOverwriteSpec HPath.IO.MoveFileSpec + HPath.IO.RecreateSymlinkOverwriteSpec HPath.IO.RecreateSymlinkSpec HPath.IO.RenameFileSpec Spec diff --git a/src/HPath/IO.hs b/src/HPath/IO.hs --- a/src/HPath/IO.hs +++ b/src/HPath/IO.hs @@ -37,14 +37,13 @@ ( -- * Types FileType(..) + , RecursiveErrorMode(..) + , CopyMode(..) -- * File copying , copyDirRecursive - , copyDirRecursiveOverwrite , recreateSymlink , copyFile - , copyFileOverwrite , easyCopy - , easyCopyOverwrite -- * File deletion , deleteFile , deleteDir @@ -60,7 +59,6 @@ -- * File renaming/moving , renameFile , moveFile - , moveFileOverwrite -- * File permissions , newFilePerms , newDirPerms @@ -80,12 +78,14 @@ ) import Control.Exception ( - bracket + IOException + , bracket , throwIO ) import Control.Monad ( - void + unless + , void , when ) import Data.ByteString @@ -96,6 +96,13 @@ ( for_ ) +import Data.IORef + ( + IORef + , modifyIORef + , newIORef + , readIORef + ) import Data.Maybe ( catMaybes @@ -131,7 +138,6 @@ import HPath import HPath.Internal import HPath.IO.Errors -import HPath.IO.Utils import Prelude hiding (readFile) import System.IO.Error ( @@ -213,21 +219,53 @@ +-- |The error mode for any recursive operation. +-- +-- On `FailEarly` the whole operation fails immediately if any of the +-- recursive sub-operations fail, which is sort of the default +-- for IO operations. +-- +-- On `CollectFailures` skips errors in the recursion and keeps on recursing. +-- However all errors are collected in the `RecursiveFailure` error type, +-- which is raised finally if there was any error. +data RecursiveErrorMode = FailEarly + | CollectFailures +-- |The mode for copy and file moves. +-- Overwrite mode is usually not very well defined, but is a convenience +-- shortcut. +data CopyMode = Strict -- ^ fail if any target exists + | Overwrite -- ^ overwrite targets + + + + -------------------- --[ File Copying ]-- -------------------- --- |Copies a directory recursively to the given destination. --- Does not follow symbolic links. +-- |Copies the contents of a directory recursively to the given destination. +-- Does not follow symbolic links. This behaves more or less like: -- --- For directory contents, this has the same behavior as `easyCopy` --- and thus will ignore any file type that is not `RegularFile`, --- `SymbolicLink` or `Directory`. +-- @ +-- mkdir \/destination\/dir +-- cp -R \/source\/dir\/* \/destination\/dir\/ +-- @ -- +-- For directory contents, this will ignore any file type that is not +-- `RegularFile`, `SymbolicLink` or `Directory`. +-- +-- For `Overwrite` copy mode this does not prune destination directory +-- contents, so the destination might contain more files than the source after +-- the operation has completed. Permissions of existing directories are +-- fixed. +-- +-- Note that there is no guaranteed ordering of the exceptions +-- contained within `RecursiveFailure` in `CollectFailures` RecursiveErrorMode. +-- -- Safety/reliability concerns: -- -- * not atomic @@ -240,31 +278,62 @@ -- Throws: -- -- - `NoSuchThing` if source directory does not exist --- - `PermissionDenied` if output directory is not writable -- - `PermissionDenied` if source directory can't be opened +-- - `SameFile` if source and destination are the same file +-- (`HPathIOException`) +-- - `DestinationInSource` if destination is contained in source +-- (`HPathIOException`) +-- +-- Throws in `FailEarly` RecursiveErrorMode only: +-- +-- - `PermissionDenied` if output directory is not writable -- - `InvalidArgument` if source directory is wrong type (symlink) --- - `InvalidArgument` if source directory is wrong type (regular file) +-- - `InappropriateType` if source directory is wrong type (regular file) +-- +-- Throws in `CollectFailures` RecursiveErrorMode only: +-- +-- - `RecursiveFailure` if any of the recursive operations that are not +-- part of the top-directory sanity-checks fail (`HPathIOException`) +-- +-- Throws in `Strict` CopyMode only: +-- -- - `AlreadyExists` if destination already exists --- - `SameFile` if source and destination are the same file (`HPathIOException`) --- - `DestinationInSource` if destination is contained in source (`HPathIOException`) -copyDirRecursive :: Path Abs -- ^ source dir - -> Path Abs -- ^ full destination +copyDirRecursive :: Path Abs -- ^ copy contents of this source dir + -> Path Abs -- ^ to this full destination (parent dirs + -- are not automatically created) + -> CopyMode + -> RecursiveErrorMode -> IO () -copyDirRecursive fromp destdirp +copyDirRecursive fromp destdirp cm rm = do + ce <- newIORef [] -- for performance, sanity checks are only done for the top dir throwSameFile fromp destdirp throwDestinationInSource fromp destdirp - go fromp destdirp + go ce fromp destdirp + collectedExceptions <- readIORef ce + unless (null collectedExceptions) + (throwIO . RecursiveFailure $ collectedExceptions) where - go :: Path Abs -> Path Abs -> IO () - go fromp' destdirp' = do + go :: IORef [IOException] -> Path Abs -> Path Abs -> IO () + go ce fromp' destdirp' = do + -- order is important here, so we don't get empty directories -- on failure - contents <- getDirsFiles fromp' + contents <- handleIOE ce [] $ do + contents <- getDirsFiles fromp' - fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus (fromAbs fromp') - createDirectory (fromAbs destdirp') fmode' + fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus (fromAbs fromp') + case cm of + Strict -> createDirectory (fromAbs destdirp') fmode' + Overwrite -> catchIOError (createDirectory (fromAbs destdirp') + fmode') + $ \e -> + case ioeGetErrorType e of + AlreadyExists -> setFileMode (fromAbs destdirp') + fmode' + _ -> ioError e + return contents -- we can't use `easyCopy` here, because we want to call `go` -- recursively to skip the top-level sanity checks @@ -272,81 +341,60 @@ ftype <- getFileType f newdest <- (destdirp' ) <$> basename f case ftype of - SymbolicLink -> recreateSymlink f newdest - Directory -> go f newdest - RegularFile -> copyFile f newdest + SymbolicLink -> handleIOE ce () + $ recreateSymlink f newdest cm + Directory -> go ce f newdest + RegularFile -> handleIOE ce () $ copyFile f newdest cm _ -> return () + handleIOE :: IORef [IOException] -> a -> IO a -> IO a + handleIOE ce def = case rm of + FailEarly -> handleIOError throwIO + CollectFailures -> handleIOError (\e -> modifyIORef ce (e:) + >> return def) --- |Like `copyDirRecursive` except it overwrites contents of directories --- if any. +-- |Recreate a symlink. -- --- For directory contents, this has the same behavior as `easyCopyOverwrite` --- and thus will ignore any file type that is not `RegularFile`, --- `SymbolicLink` or `Directory`. +-- In `Overwrite` copy mode only files and empty directories are deleted. -- --- Throws: +-- Safety/reliability concerns: -- --- - `NoSuchThing` if source directory does not exist --- - `PermissionDenied` if output directory is not writable --- - `PermissionDenied` if source directory can't be opened --- - `InvalidArgument` if source directory is wrong type (symlink) --- - `InvalidArgument` if source directory is wrong type (regular file) --- - `SameFile` if source and destination are the same file (`HPathIOException`) --- - `DestinationInSource` if destination is contained in source (`HPathIOException`) -copyDirRecursiveOverwrite :: Path Abs -- ^ source dir - -> Path Abs -- ^ full destination - -> IO () -copyDirRecursiveOverwrite fromp destdirp - = do - -- for performance, sanity checks are only done for the top dir - throwSameFile fromp destdirp - throwDestinationInSource fromp destdirp - go fromp destdirp - where - go :: Path Abs -> Path Abs -> IO () - go fromp' destdirp' = do - -- order is important here, so we don't get empty directories - -- on failure - contents <- getDirsFiles fromp' - - fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus (fromAbs fromp') - catchIOError (createDirectory (fromAbs destdirp') fmode') $ \e -> - case ioeGetErrorType e of - AlreadyExists -> setFileMode (fromAbs destdirp') fmode' - _ -> ioError e - - -- we can't use `easyCopyOverwrite` here, because we want to call `go` - -- recursively to skip the top-level sanity checks - for_ contents $ \f -> do - ftype <- getFileType f - newdest <- (destdirp' ) <$> basename f - case ftype of - SymbolicLink -> whenM (doesFileExist newdest) (deleteFile newdest) - >> recreateSymlink f newdest - Directory -> go f newdest - RegularFile -> copyFileOverwrite f newdest - _ -> return () - - --- |Recreate a symlink. +-- * `Overwrite` mode is inherently non-atomic -- -- Throws: -- -- - `InvalidArgument` if source file is wrong type (not a symlink) -- - `PermissionDenied` if output directory cannot be written to -- - `PermissionDenied` if source directory cannot be opened +-- - `SameFile` if source and destination are the same file +-- (`HPathIOException`) +-- +-- +-- Throws in `Strict` mode only: +-- -- - `AlreadyExists` if destination file already exists --- - `SameFile` if source and destination are the same file (`HPathIOException`) -- +-- Throws in `Overwrite` mode only: +-- +-- - `UnsatisfiedConstraints` if destination file is non-empty directory +-- -- Note: calls `symlink` recreateSymlink :: Path Abs -- ^ the old symlink file -> Path Abs -- ^ destination file + -> CopyMode -> IO () -recreateSymlink symsource newsym +recreateSymlink symsource newsym cm = do throwSameFile symsource newsym sympoint <- readSymbolicLink (fromAbs symsource) + case cm of + Strict -> return () + Overwrite -> do + writable <- isWritable (dirname newsym) + isfile <- doesFileExist newsym + isdir <- doesDirectoryExist newsym + when (writable && isfile) (deleteFile newsym) + when (writable && isdir) (deleteDir newsym) createSymbolicLink sympoint (fromAbs newsym) @@ -358,8 +406,11 @@ -- examine file types. For a more high-level version, use `easyCopy` -- instead. -- +-- In `Overwrite` copy mode only overwrites actual files, not directories. +-- -- Safety/reliability concerns: -- +-- * `Overwrite` mode is not atomic -- * when used on `CharacterDevice`, reads the "contents" and copies -- them to a regular file, which might take indefinitely -- * when used on `BlockDevice`, may either read the "contents" @@ -374,61 +425,39 @@ -- - `PermissionDenied` if output directory is not writable -- - `PermissionDenied` if source directory can't be opened -- - `InvalidArgument` if source file is wrong type (symlink or directory) +-- - `SameFile` if source and destination are the same file +-- (`HPathIOException`) +-- +-- Throws in `Strict` mode only: +-- -- - `AlreadyExists` if destination already exists --- - `SameFile` if source and destination are the same file (`HPathIOException`) -- -- Note: calls `sendfile` and possibly `read`/`write` as fallback copyFile :: Path Abs -- ^ source file -> Path Abs -- ^ destination file + -> CopyMode -> IO () -copyFile from to = do - throwSameFile from to - _copyFile [SPDF.oNofollow] - [SPDF.oNofollow, SPDF.oExcl] - from to - - --- |Like `copyFile` except it overwrites the destination if it already --- exists. --- --- Safety/reliability concerns: --- --- * when used on `CharacterDevice`, reads the "contents" and copies --- them to a regular file, which might take indefinitely --- * when used on `BlockDevice`, may either read the "contents" --- and copy them to a regular file (potentially hanging indefinitely) --- or may create a regular empty destination file --- * when used on `NamedPipe`, will hang indefinitely --- * not atomic, since it uses read/write --- --- Throws: --- --- - `NoSuchThing` if source file does not exist --- - `NoSuchThing` if source file is a `Socket` --- - `PermissionDenied` if output directory is not writable --- - `PermissionDenied` if source directory can't be opened --- - `InvalidArgument` if source file is wrong type (symlink or directory) --- - `SameFile` if source and destination are the same file (`HPathIOException`) --- --- Note: calls `sendfile` and possibly `read`/`write` as fallback -copyFileOverwrite :: Path Abs -- ^ source file - -> Path Abs -- ^ destination file - -> IO () -copyFileOverwrite from to = do +copyFile from to cm = do throwSameFile from to - catchIOError (_copyFile [SPDF.oNofollow] - [SPDF.oNofollow, SPDF.oTrunc] - from to) $ \e -> - case ioeGetErrorType e of - -- if the destination file is not writable, we need to - -- figure out if we can still copy by deleting it first - PermissionDenied -> do - exists <- doesFileExist to - writable <- isWritable (dirname to) - if exists && writable - then deleteFile to >> copyFile from to - else ioError e - _ -> ioError e + + case cm of + Strict -> _copyFile [SPDF.oNofollow] + [SPDF.oNofollow, SPDF.oExcl] + from to + Overwrite -> + catchIOError (_copyFile [SPDF.oNofollow] + [SPDF.oNofollow, SPDF.oTrunc] + from to) $ \e -> + case ioeGetErrorType e of + -- if the destination file is not writable, we need to + -- figure out if we can still copy by deleting it first + PermissionDenied -> do + exists <- doesFileExist to + writable <- isWritable (dirname to) + if exists && writable + then deleteFile to >> copyFile from to Strict + else ioError e + _ -> ioError e _copyFile :: [SPDF.Flags] @@ -439,8 +468,8 @@ _copyFile sflags dflags from to = -- from sendfile(2) manpage: - -- Applications may wish to fall back to read(2)/write(2) in the case - -- where sendfile() fails with EINVAL or ENOSYS. + -- Applications may wish to fall back to read(2)/write(2) in + -- the case where sendfile() fails with EINVAL or ENOSYS. withAbsPath to $ \to' -> withAbsPath from $ \from' -> catchErrno [eINVAL, eNOSYS] (sendFileCopy from' to') @@ -476,7 +505,8 @@ if size == 0 then return $ fromIntegral totalsize else do rsize <- SPB.fdWriteBuf dfd buf size - when (rsize /= size) (throwIO . CopyFailed $ "wrong size!") + when (rsize /= size) (throwIO . CopyFailed + $ "wrong size!") write' sfd dfd buf (totalsize + fromIntegral size) @@ -490,41 +520,21 @@ -- * calls `copyDirRecursive` for directories easyCopy :: Path Abs -> Path Abs + -> CopyMode + -> RecursiveErrorMode -> IO () -easyCopy from to = do - ftype <- getFileType from - case ftype of - SymbolicLink -> recreateSymlink from to - RegularFile -> copyFile from to - Directory -> copyDirRecursive from to - _ -> return () - - --- |Like `easyCopy` except it overwrites the destination if it already exists. --- For directories, this overwrites contents without pruning them, so the resulting --- directory may have more files than have been copied. --- --- Safety/reliability concerns: --- --- * examines filetypes explicitly --- * calls `copyDirRecursive` for directories -easyCopyOverwrite :: Path Abs - -> Path Abs - -> IO () -easyCopyOverwrite from to = do +easyCopy from to cm rm = do ftype <- getFileType from case ftype of - SymbolicLink -> whenM (doesFileExist to) (deleteFile to) - >> recreateSymlink from to - RegularFile -> copyFileOverwrite from to - Directory -> copyDirRecursiveOverwrite from to + SymbolicLink -> recreateSymlink from to cm + RegularFile -> copyFile from to cm + Directory -> copyDirRecursive from to cm rm _ -> return () - --------------------- --[ File Deletion ]-- --------------------- @@ -644,15 +654,16 @@ --------------------- --- |Create an empty regular file at the given directory with the given filename. +-- |Create an empty regular file at the given directory with the given +-- filename. -- -- Throws: -- -- - `PermissionDenied` if output directory cannot be written to -- - `AlreadyExists` if destination file already exists -createRegularFile :: Path Abs -> IO () -createRegularFile dest = - bracket (SPI.openFd (fromAbs dest) SPI.WriteOnly (Just newFilePerms) +createRegularFile :: FileMode -> Path Abs -> IO () +createRegularFile fm dest = + bracket (SPI.openFd (fromAbs dest) SPI.WriteOnly (Just fm) (SPI.defaultFileFlags { exclusive = True })) SPI.closeFd (\_ -> return ()) @@ -664,8 +675,8 @@ -- -- - `PermissionDenied` if output directory cannot be written to -- - `AlreadyExists` if destination directory already exists -createDir :: Path Abs -> IO () -createDir dest = createDirectory (fromAbs dest) newDirPerms +createDir :: FileMode -> Path Abs -> IO () +createDir fm dest = createDirectory (fromAbs dest) fm -- |Create a symlink. @@ -703,10 +714,14 @@ -- - `NoSuchThing` if source file does not exist -- - `PermissionDenied` if output directory cannot be written to -- - `PermissionDenied` if source directory cannot be opened --- - `UnsupportedOperation` if source and destination are on different devices --- - `FileDoesExist` if destination file already exists (`HPathIOException`) --- - `DirDoesExist` if destination directory already exists (`HPathIOException`) --- - `SameFile` if destination and source are the same file (`HPathIOException`) +-- - `UnsupportedOperation` if source and destination are on different +-- devices +-- - `FileDoesExist` if destination file already exists +-- (`HPathIOException`) +-- - `DirDoesExist` if destination directory already exists +-- (`HPathIOException`) +-- - `SameFile` if destination and source are the same file +-- (`HPathIOException`) -- -- Note: calls `rename` (but does not allow to rename over existing files) renameFile :: Path Abs -> Path Abs -> IO () @@ -725,70 +740,56 @@ -- -- Safety/reliability concerns: -- +-- * `Overwrite` mode is not atomic -- * copy-delete fallback is inherently non-atomic -- * since this function calls `easyCopy` and `easyDelete` as a fallback -- to `renameFile`, file types that are not `RegularFile`, `SymbolicLink` -- or `Directory` may be ignored +-- * for `Overwrite` mode, the destination will be deleted (not recursively) +-- before moving -- -- Throws: -- -- - `NoSuchThing` if source file does not exist -- - `PermissionDenied` if output directory cannot be written to -- - `PermissionDenied` if source directory cannot be opened --- - `FileDoesExist` if destination file already exists (`HPathIOException`) --- - `DirDoesExist` if destination directory already exists (`HPathIOException`) --- - `SameFile` if destination and source are the same file (`HPathIOException`) +-- - `SameFile` if destination and source are the same file +-- (`HPathIOException`) -- +-- Throws in `Strict` mode only: +-- +-- - `FileDoesExist` if destination file already exists (`HPathIOException`) +-- - `DirDoesExist` if destination directory already exists +-- (`HPathIOException`) +-- -- Note: calls `rename` (but does not allow to rename over existing files) moveFile :: Path Abs -- ^ file to move -> Path Abs -- ^ destination + -> CopyMode -> IO () -moveFile from to = do +moveFile from to cm = do throwSameFile from to - catchErrno [eXDEV] (renameFile from to) $ do - easyCopy from to - easyDelete from + case cm of + Strict -> catchErrno [eXDEV] (renameFile from to) $ do + easyCopy from to Strict FailEarly + easyDelete from + Overwrite -> do + ft <- getFileType from + writable <- isWritable $ dirname to + case ft of + RegularFile -> do + exists <- doesFileExist to + when (exists && writable) (deleteFile to) + SymbolicLink -> do + exists <- doesFileExist to + when (exists && writable) (deleteFile to) + Directory -> do + exists <- doesDirectoryExist to + when (exists && writable) (deleteDir to) + _ -> return () + moveFile from to Strict --- |Like `moveFile`, but overwrites the destination if it exists. --- --- Does not follow symbolic links, but renames the symbolic link file. --- --- Ignores any file type that is not `RegularFile`, `SymbolicLink` or --- `Directory`. --- --- Safety/reliability concerns: --- --- * copy-delete fallback is inherently non-atomic --- * checks for file types and destination file existence explicitly --- --- Throws: --- --- - `NoSuchThing` if source file does not exist --- - `PermissionDenied` if output directory cannot be written to --- - `PermissionDenied` if source directory cannot be opened --- - `SameFile` if destination and source are the same file (`HPathIOException`) --- --- Note: calls `rename` (but does not allow to rename over existing files) -moveFileOverwrite :: Path Abs -- ^ file to move - -> Path Abs -- ^ destination - -> IO () -moveFileOverwrite from to = do - throwSameFile from to - ft <- getFileType from - writable <- isWritable $ dirname to - case ft of - RegularFile -> do - exists <- doesFileExist to - when (exists && writable) (deleteFile to) - SymbolicLink -> do - exists <- doesFileExist to - when (exists && writable) (deleteFile to) - Directory -> do - exists <- doesDirectoryExist to - when (exists && writable) (deleteDir to) - _ -> return () - moveFile from to @@ -827,6 +828,8 @@ -- |Gets all filenames of the given directory. This excludes "." and "..". -- This version does not follow symbolic links. +-- +-- The contents are not sorted and there is no guarantee on the ordering. -- -- Throws: -- diff --git a/src/HPath/IO/Errors.hs b/src/HPath/IO/Errors.hs --- a/src/HPath/IO/Errors.hs +++ b/src/HPath/IO/Errors.hs @@ -27,6 +27,7 @@ , isInvalidOperation , isCan'tOpenDirectory , isCopyFailed + , isRecursiveFailure -- * Path based functions , throwFileDoesExist @@ -70,10 +71,6 @@ ( toString ) -import Data.Data - ( - Data(..) - ) import Data.Typeable import Foreign.C.Error ( @@ -114,7 +111,8 @@ | InvalidOperation String | Can'tOpenDirectory ByteString | CopyFailed String - deriving (Typeable, Eq, Data) + | RecursiveFailure [IOException] + deriving (Typeable, Eq) instance Show HPathIOException where @@ -133,9 +131,25 @@ show (Can'tOpenDirectory fp) = "Can't open directory: " ++ toString fp show (CopyFailed str) = "Copying failed: " ++ str + show (RecursiveFailure exs) = "Recursive operation failed: " + ++ show exs +toConstr :: HPathIOException -> String +toConstr FileDoesNotExist {} = "FileDoesNotExist" +toConstr DirDoesNotExist {} = "DirDoesNotExist" +toConstr SameFile {} = "SameFile" +toConstr DestinationInSource {} = "DestinationInSource" +toConstr FileDoesExist {} = "FileDoesExist" +toConstr DirDoesExist {} = "DirDoesExist" +toConstr InvalidOperation {} = "InvalidOperation" +toConstr Can'tOpenDirectory {} = "Can'tOpenDirectory" +toConstr CopyFailed {} = "CopyFailed" +toConstr RecursiveFailure {} = "RecursiveFailure" + + + instance Exception HPathIOException @@ -146,7 +160,7 @@ --[ Exception identifiers ]-- ----------------------------- -isFileDoesNotExist, isDirDoesNotExist, isSameFile, isDestinationInSource, isFileDoesExist, isDirDoesExist, isInvalidOperation, isCan'tOpenDirectory, isCopyFailed :: HPathIOException -> Bool +isFileDoesNotExist, isDirDoesNotExist, isSameFile, isDestinationInSource, isFileDoesExist, isDirDoesExist, isInvalidOperation, isCan'tOpenDirectory, isCopyFailed, isRecursiveFailure :: HPathIOException -> Bool isFileDoesNotExist ex = toConstr (ex :: HPathIOException) == toConstr FileDoesNotExist{} isDirDoesNotExist ex = toConstr (ex :: HPathIOException) == toConstr DirDoesNotExist{} isSameFile ex = toConstr (ex :: HPathIOException) == toConstr SameFile{} @@ -156,7 +170,7 @@ isInvalidOperation ex = toConstr (ex :: HPathIOException) == toConstr InvalidOperation{} isCan'tOpenDirectory ex = toConstr (ex :: HPathIOException) == toConstr Can'tOpenDirectory{} isCopyFailed ex = toConstr (ex :: HPathIOException) == toConstr CopyFailed{} - +isRecursiveFailure ex = toConstr (ex :: HPathIOException) == toConstr RecursiveFailure{} diff --git a/src/System/Posix/Directory/Traversals.hs b/src/System/Posix/Directory/Traversals.hs --- a/src/System/Posix/Directory/Traversals.hs +++ b/src/System/Posix/Directory/Traversals.hs @@ -10,6 +10,7 @@ -- Traversal and read operations on directories. +{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} @@ -37,7 +38,10 @@ , realpath ) where -import Control.Applicative + +#if __GLASGOW_HASKELL__ < 710 +import Control.Applicative ((<$>)) +#endif import Control.Monad import System.Posix.FilePath (()) import System.Posix.Directory.Foreign diff --git a/test/HPath/IO/CanonicalizePathSpec.hs b/test/HPath/IO/CanonicalizePathSpec.hs --- a/test/HPath/IO/CanonicalizePathSpec.hs +++ b/test/HPath/IO/CanonicalizePathSpec.hs @@ -13,12 +13,15 @@ IOErrorType(..) ) import Utils -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 (toString) +upTmpDir :: IO () +upTmpDir = do + setTmpDir "CanonicalizePathSpec" + createTmpDir + setupFiles :: IO () setupFiles = do createRegularFile' "file" @@ -37,7 +40,7 @@ spec :: Spec -spec = before_ setupFiles $ after_ cleanupFiles $ +spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ describe "HPath.IO.canonicalizePath" $ do -- successes -- diff --git a/test/HPath/IO/CopyDirRecursiveCollectFailuresSpec.hs b/test/HPath/IO/CopyDirRecursiveCollectFailuresSpec.hs new file mode 100644 --- /dev/null +++ b/test/HPath/IO/CopyDirRecursiveCollectFailuresSpec.hs @@ -0,0 +1,245 @@ +{-# LANGUAGE OverloadedStrings #-} + + +module HPath.IO.CopyDirRecursiveCollectFailuresSpec where + + +import Test.Hspec +import Data.List (sort) +import HPath.IO +import HPath.IO.Errors +import System.IO.Error + ( + ioeGetErrorType + ) +import GHC.IO.Exception + ( + IOErrorType(..) + ) +import System.Exit +import System.Process +import Utils +import qualified Data.ByteString as BS +import Data.ByteString.UTF8 (toString) + + + +upTmpDir :: IO () +upTmpDir = do + setTmpDir "CopyDirRecursiveCollectFailuresSpec" + createTmpDir + +setupFiles :: IO () +setupFiles = do + createRegularFile' "alreadyExists" + createRegularFile' "wrongInput" + createSymlink' "wrongInputSymL" "inputDir/" + createDir' "alreadyExistsD" + createDir' "noPerms" + createDir' "noWritePerm" + + createDir' "inputDir" + createDir' "inputDir/bar" + createDir' "inputDir/foo" + createRegularFile' "inputDir/foo/inputFile1" + createRegularFile' "inputDir/inputFile2" + createRegularFile' "inputDir/bar/inputFile3" + writeFile' "inputDir/foo/inputFile1" "SDAADSdsada" + writeFile' "inputDir/inputFile2" "Blahfaselgagaga" + writeFile' "inputDir/bar/inputFile3" + "fdfdssdffsd3223sasdasdasdadasasddasdasdasasd4" + + createDir' "inputDir1" + createDir' "inputDir1/foo2" + createDir' "inputDir1/foo2/foo3" + createDir' "inputDir1/foo2/foo4" + createRegularFile' "inputDir1/foo2/inputFile1" + createRegularFile' "inputDir1/foo2/inputFile2" + createRegularFile' "inputDir1/foo2/inputFile3" + createRegularFile' "inputDir1/foo2/foo4/inputFile4" + createRegularFile' "inputDir1/foo2/foo4/inputFile6" + createRegularFile' "inputDir1/foo2/foo3/inputFile5" + noPerms "inputDir1/foo2/foo3" + + createDir' "outputDir1" + createDir' "outputDir1/foo2" + createDir' "outputDir1/foo2/foo4" + createDir' "outputDir1/foo2/foo4/inputFile4" + createRegularFile' "outputDir1/foo2/foo4/inputFile6" + noPerms "outputDir1/foo2/foo4/inputFile4" + noPerms "outputDir1/foo2/foo4" + + noPerms "noPerms" + noWritableDirPerms "noWritePerm" + + +cleanupFiles :: IO () +cleanupFiles = do + normalDirPerms "noPerms" + normalDirPerms "noWritePerm" + + normalDirPerms "inputDir1/foo2/foo3" + deleteFile' "inputDir1/foo2/foo4/inputFile4" + deleteFile' "inputDir1/foo2/foo4/inputFile6" + deleteFile' "inputDir1/foo2/inputFile1" + deleteFile' "inputDir1/foo2/inputFile2" + deleteFile' "inputDir1/foo2/inputFile3" + deleteFile' "inputDir1/foo2/foo3/inputFile5" + deleteDir' "inputDir1/foo2/foo3" + deleteDir' "inputDir1/foo2/foo4" + deleteDir' "inputDir1/foo2" + deleteDir' "inputDir1" + + normalDirPerms "outputDir1/foo2/foo4" + normalDirPerms "outputDir1/foo2/foo4/inputFile4" + deleteFile' "outputDir1/foo2/foo4/inputFile6" + deleteDir' "outputDir1/foo2/foo4/inputFile4" + deleteDir' "outputDir1/foo2/foo4" + deleteDir' "outputDir1/foo2" + deleteDir' "outputDir1" + + deleteFile' "alreadyExists" + deleteFile' "wrongInput" + deleteFile' "wrongInputSymL" + deleteDir' "alreadyExistsD" + deleteDir' "noPerms" + deleteDir' "noWritePerm" + deleteFile' "inputDir/foo/inputFile1" + deleteFile' "inputDir/inputFile2" + deleteFile' "inputDir/bar/inputFile3" + deleteDir' "inputDir/foo" + deleteDir' "inputDir/bar" + deleteDir' "inputDir" + + + + +spec :: Spec +spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ + describe "HPath.IO.copyDirRecursive" $ do + + -- successes -- + it "copyDirRecursive (Strict, CollectFailures), all fine and compare" $ do + tmpDir' <- getRawTmpDir + copyDirRecursive' "inputDir" + "outputDir" + Strict + CollectFailures + (system $ "diff -r --no-dereference " + ++ toString tmpDir' ++ "inputDir" ++ " " + ++ toString tmpDir' ++ "outputDir") + `shouldReturn` ExitSuccess + removeDirIfExists "outputDir" + + -- posix failures -- + it "copyDirRecursive (Strict, CollectFailures), source directory does not exist" $ + copyDirRecursive' "doesNotExist" + "outputDir" + Strict + CollectFailures + `shouldThrow` + (\e -> ioeGetErrorType e == NoSuchThing) + + it "copyDirRecursive (Strict, CollectFailures), cannot open source dir" $ + copyDirRecursive' "noPerms/inputDir" + "foo" + Strict + CollectFailures + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied) + + + -- custom failures + it "copyDirRecursive (Overwrite, CollectFailures), various failures" $ do + copyDirRecursive' "inputDir1/foo2" + "outputDir1/foo2" + Overwrite + CollectFailures + `shouldThrow` + (\(RecursiveFailure ex@[_, _]) -> + any (\e -> ioeGetErrorType e == InappropriateType) ex && + any (\e -> ioeGetErrorType e == PermissionDenied) ex) + normalDirPerms "outputDir1/foo2/foo4" + normalDirPerms "outputDir1/foo2/foo4/inputFile4" + c <- allDirectoryContents' "outputDir1" + tmpDir' <- getRawTmpDir + let shouldC = (fmap (\x -> tmpDir' `BS.append` x) + ["outputDir1" + ,"outputDir1/foo2" + ,"outputDir1/foo2/inputFile1" + ,"outputDir1/foo2/inputFile2" + ,"outputDir1/foo2/inputFile3" + ,"outputDir1/foo2/foo4" + ,"outputDir1/foo2/foo4/inputFile6" + ,"outputDir1/foo2/foo4/inputFile4"]) + deleteFile' "outputDir1/foo2/inputFile1" + deleteFile' "outputDir1/foo2/inputFile2" + deleteFile' "outputDir1/foo2/inputFile3" + sort c `shouldBe` sort shouldC + + + it "copyDirRecursive (Strict, CollectFailures), no write permission on output dir" $ + copyDirRecursive' "inputDir" + "noWritePerm/foo" + Strict + CollectFailures + `shouldThrow` + (\(RecursiveFailure [e]) -> ioeGetErrorType e == PermissionDenied) + + it "copyDirRecursive (Strict, CollectFailures), cannot open output dir" $ + copyDirRecursive' "inputDir" + "noPerms/foo" + Strict + CollectFailures + `shouldThrow` + isRecursiveFailure + + it "copyDirRecursive (Strict, CollectFailures), destination dir already exists" $ + copyDirRecursive' "inputDir" + "alreadyExistsD" + Strict + CollectFailures + `shouldThrow` + (\(RecursiveFailure [e]) -> ioeGetErrorType e == AlreadyExists) + + it "copyDirRecursive (Strict, CollectFailures), destination already exists and is a file" $ + copyDirRecursive' "inputDir" + "alreadyExists" + Strict + CollectFailures + `shouldThrow` + isRecursiveFailure + + it "copyDirRecursive (Strict, CollectFailures), wrong input (regular file)" $ + copyDirRecursive' "wrongInput" + "outputDir" + Strict + CollectFailures + `shouldThrow` + (\(RecursiveFailure [e]) -> ioeGetErrorType e == InappropriateType) + + it "copyDirRecursive (Strict, CollectFailures), wrong input (symlink to directory)" $ + copyDirRecursive' "wrongInputSymL" + "outputDir" + Strict + CollectFailures + `shouldThrow` + (\(RecursiveFailure [e]) -> ioeGetErrorType e == InvalidArgument) + + it "copyDirRecursive (Strict, CollectFailures), destination in source" $ + copyDirRecursive' "inputDir" + "inputDir/foo" + Strict + CollectFailures + `shouldThrow` + isDestinationInSource + + it "copyDirRecursive (Strict, CollectFailures), destination and source same directory" $ + copyDirRecursive' "inputDir" + "inputDir" + Strict + CollectFailures + `shouldThrow` + isSameFile + + diff --git a/test/HPath/IO/CopyDirRecursiveOverwriteSpec.hs b/test/HPath/IO/CopyDirRecursiveOverwriteSpec.hs --- a/test/HPath/IO/CopyDirRecursiveOverwriteSpec.hs +++ b/test/HPath/IO/CopyDirRecursiveOverwriteSpec.hs @@ -5,6 +5,7 @@ import Test.Hspec +import HPath.IO import HPath.IO.Errors import System.IO.Error ( @@ -17,11 +18,16 @@ import System.Exit import System.Process import Utils -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 (toString) +import Data.ByteString.UTF8 (toString) +upTmpDir :: IO () +upTmpDir = do + setTmpDir "CopyDirRecursiveOverwriteSpec" + createTmpDir + + setupFiles :: IO () setupFiles = do createRegularFile' "alreadyExists" @@ -81,89 +87,116 @@ spec :: Spec -spec = before_ setupFiles $ after_ cleanupFiles $ - describe "HPath.IO.copyDirRecursiveOverwrite" $ do +spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ + describe "HPath.IO.copyDirRecursive" $ do -- successes -- - it "copyDirRecursiveOverwrite, all fine" $ do - copyDirRecursiveOverwrite' "inputDir" - "outputDir" + it "copyDirRecursive (Overwrite, FailEarly), all fine" $ do + copyDirRecursive' "inputDir" + "outputDir" + Overwrite + FailEarly removeDirIfExists "outputDir" - it "copyDirRecursiveOverwrite, all fine and compare" $ do - copyDirRecursiveOverwrite' "inputDir" - "outputDir" + it "copyDirRecursive (Overwrite, FailEarly), all fine and compare" $ do + tmpDir' <- getRawTmpDir + copyDirRecursive' "inputDir" + "outputDir" + Overwrite + FailEarly (system $ "diff -r --no-dereference " - ++ toString tmpDir ++ "inputDir" ++ " " - ++ toString tmpDir ++ "outputDir") + ++ toString tmpDir' ++ "inputDir" ++ " " + ++ toString tmpDir' ++ "outputDir") `shouldReturn` ExitSuccess removeDirIfExists "outputDir" - it "copyDirRecursiveOverwrite, destination dir already exists" $ do + it "copyDirRecursive (Overwrite, FailEarly), destination dir already exists" $ do + tmpDir' <- getRawTmpDir (system $ "diff -r --no-dereference " - ++ toString tmpDir ++ "inputDir" ++ " " - ++ toString tmpDir ++ "alreadyExistsD") + ++ toString tmpDir' ++ "inputDir" ++ " " + ++ toString tmpDir' ++ "alreadyExistsD") `shouldReturn` (ExitFailure 1) - copyDirRecursiveOverwrite' "inputDir" - "alreadyExistsD" + copyDirRecursive' "inputDir" + "alreadyExistsD" + Overwrite + FailEarly (system $ "diff -r --no-dereference " - ++ toString tmpDir ++ "inputDir" ++ " " - ++ toString tmpDir ++ "alreadyExistsD") + ++ toString tmpDir' ++ "inputDir" ++ " " + ++ toString tmpDir' ++ "alreadyExistsD") `shouldReturn` ExitSuccess removeDirIfExists "outputDir" + -- posix failures -- - it "copyDirRecursiveOverwrite, source directory does not exist" $ - copyDirRecursiveOverwrite' "doesNotExist" - "outputDir" + it "copyDirRecursive, source directory does not exist" $ + copyDirRecursive' "doesNotExist" + "outputDir" + Overwrite + FailEarly `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) - it "copyDirRecursiveOverwrite, no write permission on output dir" $ - copyDirRecursiveOverwrite' "inputDir" - "noWritePerm/foo" + it "copyDirRecursive, no write permission on output dir" $ + copyDirRecursive' "inputDir" + "noWritePerm/foo" + Overwrite + FailEarly `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - it "copyDirRecursiveOverwrite, cannot open output dir" $ - copyDirRecursiveOverwrite' "inputDir" - "noPerms/foo" + it "copyDirRecursive, cannot open output dir" $ + copyDirRecursive' "inputDir" + "noPerms/foo" + Overwrite + FailEarly `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - it "copyDirRecursiveOverwrite, cannot open source dir" $ - copyDirRecursiveOverwrite' "noPerms/inputDir" - "foo" + it "copyDirRecursive, cannot open source dir" $ + copyDirRecursive' "noPerms/inputDir" + "foo" + Overwrite + FailEarly `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - it "copyDirRecursiveOverwrite, destination already exists and is a file" $ - copyDirRecursiveOverwrite' "inputDir" - "alreadyExists" + it "copyDirRecursive, destination already exists and is a file" $ + copyDirRecursive' "inputDir" + "alreadyExists" + Overwrite + FailEarly `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) - it "copyDirRecursiveOverwrite, wrong input (regular file)" $ - copyDirRecursiveOverwrite' "wrongInput" - "outputDir" + it "copyDirRecursive, wrong input (regular file)" $ + copyDirRecursive' "wrongInput" + "outputDir" + Overwrite + FailEarly `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) - it "copyDirRecursiveOverwrite, wrong input (symlink to directory)" $ - copyDirRecursiveOverwrite' "wrongInputSymL" - "outputDir" + it "copyDirRecursive, wrong input (symlink to directory)" $ + copyDirRecursive' "wrongInputSymL" + "outputDir" + Overwrite + FailEarly `shouldThrow` (\e -> ioeGetErrorType e == InvalidArgument) -- custom failures - it "copyDirRecursiveOverwrite, destination in source" $ - copyDirRecursiveOverwrite' "inputDir" - "inputDir/foo" + it "copyDirRecursive (Overwrite, FailEarly), destination in source" $ + copyDirRecursive' "inputDir" + "inputDir/foo" + Overwrite + FailEarly `shouldThrow` isDestinationInSource - it "copyDirRecursiveOverwrite, destination and source same directory" $ - copyDirRecursiveOverwrite' "inputDir" - "inputDir" + it "copyDirRecursive (Overwrite, FailEarly), destination and source same directory" $ + copyDirRecursive' "inputDir" + "inputDir" + Overwrite + FailEarly `shouldThrow` isSameFile diff --git a/test/HPath/IO/CopyDirRecursiveSpec.hs b/test/HPath/IO/CopyDirRecursiveSpec.hs --- a/test/HPath/IO/CopyDirRecursiveSpec.hs +++ b/test/HPath/IO/CopyDirRecursiveSpec.hs @@ -5,6 +5,7 @@ import Test.Hspec +import HPath.IO import HPath.IO.Errors import System.IO.Error ( @@ -17,12 +18,14 @@ import System.Exit import System.Process import Utils -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 (toString) - +import Data.ByteString.UTF8 (toString) +upTmpDir :: IO () +upTmpDir = do + setTmpDir "CopyDirRecursiveSpec" + createTmpDir setupFiles :: IO () setupFiles = do @@ -69,82 +72,109 @@ spec :: Spec -spec = before_ setupFiles $ after_ cleanupFiles $ +spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ describe "HPath.IO.copyDirRecursive" $ do -- successes -- - it "copyDirRecursive, all fine" $ do + it "copyDirRecursive (Strict, FailEarly), all fine" $ do copyDirRecursive' "inputDir" "outputDir" + Strict + FailEarly removeDirIfExists "outputDir" - it "copyDirRecursive, all fine and compare" $ do + it "copyDirRecursive (Strict, FailEarly), all fine and compare" $ do + tmpDir' <- getRawTmpDir copyDirRecursive' "inputDir" "outputDir" + Strict + FailEarly (system $ "diff -r --no-dereference " - ++ toString tmpDir ++ "inputDir" ++ " " - ++ toString tmpDir ++ "outputDir") + ++ toString tmpDir' ++ "inputDir" ++ " " + ++ toString tmpDir' ++ "outputDir") `shouldReturn` ExitSuccess removeDirIfExists "outputDir" -- posix failures -- - it "copyDirRecursive, source directory does not exist" $ + it "copyDirRecursive (Strict, FailEarly), source directory does not exist" $ copyDirRecursive' "doesNotExist" "outputDir" + Strict + FailEarly `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) - it "copyDirRecursive, no write permission on output dir" $ + it "copyDirRecursive (Strict, FailEarly), no write permission on output dir" $ copyDirRecursive' "inputDir" "noWritePerm/foo" + Strict + FailEarly `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - it "copyDirRecursive, cannot open output dir" $ + it "copyDirRecursive (Strict, FailEarly), cannot open output dir" $ copyDirRecursive' "inputDir" "noPerms/foo" + Strict + FailEarly `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - it "copyDirRecursive, cannot open source dir" $ + it "copyDirRecursive (Strict, FailEarly), cannot open source dir" $ copyDirRecursive' "noPerms/inputDir" "foo" + Strict + FailEarly `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - it "copyDirRecursive, destination dir already exists" $ + it "copyDirRecursive (Strict, FailEarly), destination dir already exists" $ copyDirRecursive' "inputDir" "alreadyExistsD" + Strict + FailEarly `shouldThrow` (\e -> ioeGetErrorType e == AlreadyExists) - it "copyDirRecursive, destination already exists and is a file" $ + it "copyDirRecursive (Strict, FailEarly), destination already exists and is a file" $ copyDirRecursive' "inputDir" "alreadyExists" + Strict + FailEarly `shouldThrow` (\e -> ioeGetErrorType e == AlreadyExists) - it "copyDirRecursive, wrong input (regular file)" $ + it "copyDirRecursive (Strict, FailEarly), wrong input (regular file)" $ copyDirRecursive' "wrongInput" "outputDir" + Strict + FailEarly `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) - it "copyDirRecursive, wrong input (symlink to directory)" $ + it "copyDirRecursive (Strict, FailEarly), wrong input (symlink to directory)" $ copyDirRecursive' "wrongInputSymL" "outputDir" + Strict + FailEarly `shouldThrow` (\e -> ioeGetErrorType e == InvalidArgument) -- custom failures - it "copyDirRecursive, destination in source" $ + it "copyDirRecursive (Strict, FailEarly), destination in source" $ copyDirRecursive' "inputDir" "inputDir/foo" + Strict + FailEarly `shouldThrow` isDestinationInSource - it "copyDirRecursive, destination and source same directory" $ + it "copyDirRecursive (Strict, FailEarly), destination and source same directory" $ copyDirRecursive' "inputDir" "inputDir" + Strict + FailEarly `shouldThrow` isSameFile + + diff --git a/test/HPath/IO/CopyFileOverwriteSpec.hs b/test/HPath/IO/CopyFileOverwriteSpec.hs --- a/test/HPath/IO/CopyFileOverwriteSpec.hs +++ b/test/HPath/IO/CopyFileOverwriteSpec.hs @@ -4,6 +4,7 @@ import Test.Hspec +import HPath.IO import HPath.IO.Errors import System.IO.Error ( @@ -16,10 +17,16 @@ import System.Exit import System.Process import Utils -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 (toString) +import Data.ByteString.UTF8 (toString) + +upTmpDir :: IO () +upTmpDir = do + setTmpDir "CopyFileOverwriteSpec" + createTmpDir + + setupFiles :: IO () setupFiles = do createRegularFile' "inputFile" @@ -51,79 +58,91 @@ spec :: Spec -spec = before_ setupFiles $ after_ cleanupFiles $ - describe "HPath.IO.copyFileOverwrite" $ do +spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ + describe "HPath.IO.copyFile" $ do -- successes -- - it "copyFileOverwrite, everything clear" $ do - copyFileOverwrite' "inputFile" + it "copyFile (Overwrite), everything clear" $ do + copyFile' "inputFile" "outputFile" + Overwrite removeFileIfExists "outputFile" - it "copyFileOverwrite, output file already exists, all clear" $ do - copyFile' "alreadyExists" "alreadyExists.bak" - copyFileOverwrite' "inputFile" - "alreadyExists" - (system $ "cmp -s " ++ toString tmpDir ++ "inputFile" ++ " " - ++ toString tmpDir ++ "alreadyExists") + it "copyFile (Overwrite), output file already exists, all clear" $ do + tmpDir' <- getRawTmpDir + copyFile' "alreadyExists" "alreadyExists.bak" Strict + copyFile' "inputFile" "alreadyExists" Overwrite + (system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " " + ++ toString tmpDir' ++ "alreadyExists") `shouldReturn` ExitSuccess removeFileIfExists "alreadyExists" - copyFile' "alreadyExists.bak" "alreadyExists" + copyFile' "alreadyExists.bak" "alreadyExists" Strict removeFileIfExists "alreadyExists.bak" - it "copyFileOverwrite, and compare" $ do - copyFileOverwrite' "inputFile" + it "copyFile (Overwrite), and compare" $ do + tmpDir' <- getRawTmpDir + copyFile' "inputFile" "outputFile" - (system $ "cmp -s " ++ toString tmpDir ++ "inputFile" ++ " " - ++ toString tmpDir ++ "outputFile") + Overwrite + (system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " " + ++ toString tmpDir' ++ "outputFile") `shouldReturn` ExitSuccess removeFileIfExists "outputFile" + -- posix failures -- - it "copyFileOverwrite, input file does not exist" $ - copyFileOverwrite' "noSuchFile" + it "copyFile (Overwrite), input file does not exist" $ + copyFile' "noSuchFile" "outputFile" + Overwrite `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) - it "copyFileOverwrite, no permission to write to output directory" $ - copyFileOverwrite' "inputFile" + it "copyFile (Overwrite), no permission to write to output directory" $ + copyFile' "inputFile" "outputDirNoWrite/outputFile" + Overwrite `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - it "copyFileOverwrite, cannot open output directory" $ - copyFileOverwrite' "inputFile" + it "copyFile (Overwrite), cannot open output directory" $ + copyFile' "inputFile" "noPerms/outputFile" + Overwrite `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - it "copyFileOverwrite, cannot open source directory" $ - copyFileOverwrite' "noPerms/inputFile" + it "copyFile (Overwrite), cannot open source directory" $ + copyFile' "noPerms/inputFile" "outputFile" + Overwrite `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - it "copyFileOverwrite, wrong input type (symlink)" $ - copyFileOverwrite' "inputFileSymL" + it "copyFile (Overwrite), wrong input type (symlink)" $ + copyFile' "inputFileSymL" "outputFile" + Overwrite `shouldThrow` (\e -> ioeGetErrorType e == InvalidArgument) - it "copyFileOverwrite, wrong input type (directory)" $ - copyFileOverwrite' "wrongInput" + it "copyFile (Overwrite), wrong input type (directory)" $ + copyFile' "wrongInput" "outputFile" + Overwrite `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) - it "copyFileOverwrite, output file already exists and is a dir" $ - copyFileOverwrite' "inputFile" + it "copyFile (Overwrite), output file already exists and is a dir" $ + copyFile' "inputFile" "alreadyExistsD" + Overwrite `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) -- custom failures -- - it "copyFileOverwrite, output and input are same file" $ - copyFileOverwrite' "inputFile" + it "copyFile (Overwrite), output and input are same file" $ + copyFile' "inputFile" "inputFile" + Overwrite `shouldThrow` isSameFile diff --git a/test/HPath/IO/CopyFileSpec.hs b/test/HPath/IO/CopyFileSpec.hs --- a/test/HPath/IO/CopyFileSpec.hs +++ b/test/HPath/IO/CopyFileSpec.hs @@ -5,6 +5,7 @@ import Test.Hspec +import HPath.IO import HPath.IO.Errors import System.IO.Error ( @@ -17,10 +18,15 @@ import System.Exit import System.Process import Utils -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 (toString) +import Data.ByteString.UTF8 (toString) + +upTmpDir :: IO () +upTmpDir = do + setTmpDir "CopyFileSpec" + createTmpDir + setupFiles :: IO () setupFiles = do createRegularFile' "inputFile" @@ -51,75 +57,87 @@ spec :: Spec -spec = before_ setupFiles $ after_ cleanupFiles $ +spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ describe "HPath.IO.copyFile" $ do -- successes -- - it "copyFile, everything clear" $ do + it "copyFile (Strict), everything clear" $ do copyFile' "inputFile" "outputFile" + Strict removeFileIfExists "outputFile" - it "copyFile, and compare" $ do + it "copyFile (Strict), and compare" $ do + tmpDir' <- getRawTmpDir copyFile' "inputFile" "outputFile" - (system $ "cmp -s " ++ toString tmpDir ++ "inputFile" ++ " " - ++ toString tmpDir ++ "outputFile") + Strict + (system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " " + ++ toString tmpDir' ++ "outputFile") `shouldReturn` ExitSuccess removeFileIfExists "outputFile" -- posix failures -- - it "copyFile, input file does not exist" $ + it "copyFile (Strict), input file does not exist" $ copyFile' "noSuchFile" "outputFile" + Strict `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) - it "copyFile, no permission to write to output directory" $ + it "copyFile (Strict), no permission to write to output directory" $ copyFile' "inputFile" "outputDirNoWrite/outputFile" + Strict `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - it "copyFile, cannot open output directory" $ + it "copyFile (Strict), cannot open output directory" $ copyFile' "inputFile" "noPerms/outputFile" + Strict `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - it "copyFile, cannot open source directory" $ + it "copyFile (Strict), cannot open source directory" $ copyFile' "noPerms/inputFile" "outputFile" + Strict `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - it "copyFile, wrong input type (symlink)" $ + it "copyFile (Strict), wrong input type (symlink)" $ copyFile' "inputFileSymL" "outputFile" + Strict `shouldThrow` (\e -> ioeGetErrorType e == InvalidArgument) - it "copyFile, wrong input type (directory)" $ + it "copyFile (Strict), wrong input type (directory)" $ copyFile' "wrongInput" "outputFile" + Strict `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) - it "copyFile, output file already exists" $ + it "copyFile (Strict), output file already exists" $ copyFile' "inputFile" "alreadyExists" + Strict `shouldThrow` (\e -> ioeGetErrorType e == AlreadyExists) - it "copyFile, output file already exists and is a dir" $ + it "copyFile (Strict), output file already exists and is a dir" $ copyFile' "inputFile" "alreadyExistsD" + Strict `shouldThrow` (\e -> ioeGetErrorType e == AlreadyExists) -- custom failures -- - it "copyFile, output and input are same file" $ + it "copyFile (Strict), output and input are same file" $ copyFile' "inputFile" "inputFile" + Strict `shouldThrow` isSameFile diff --git a/test/HPath/IO/CreateDirSpec.hs b/test/HPath/IO/CreateDirSpec.hs --- a/test/HPath/IO/CreateDirSpec.hs +++ b/test/HPath/IO/CreateDirSpec.hs @@ -13,10 +13,14 @@ IOErrorType(..) ) import Utils -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 (toString) + +upTmpDir :: IO () +upTmpDir = do + setTmpDir "CreateDirSpec" + createTmpDir + setupFiles :: IO () setupFiles = do createDir' "alreadyExists" @@ -37,7 +41,7 @@ spec :: Spec -spec = before_ setupFiles $ after_ cleanupFiles $ +spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ describe "HPath.IO.createDir" $ do -- successes -- diff --git a/test/HPath/IO/CreateRegularFileSpec.hs b/test/HPath/IO/CreateRegularFileSpec.hs --- a/test/HPath/IO/CreateRegularFileSpec.hs +++ b/test/HPath/IO/CreateRegularFileSpec.hs @@ -13,10 +13,14 @@ IOErrorType(..) ) import Utils -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 (toString) + +upTmpDir :: IO () +upTmpDir = do + setTmpDir "CreateRegularFileSpec" + createTmpDir + setupFiles :: IO () setupFiles = do createRegularFile' "alreadyExists" @@ -25,8 +29,6 @@ noPerms "noPerms" noWritableDirPerms "noWritePerms" - - cleanupFiles :: IO () cleanupFiles = do normalDirPerms "noPerms" @@ -37,7 +39,7 @@ spec :: Spec -spec = before_ setupFiles $ after_ cleanupFiles $ +spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ describe "HPath.IO.createRegularFile" $ do -- successes -- diff --git a/test/HPath/IO/CreateSymlinkSpec.hs b/test/HPath/IO/CreateSymlinkSpec.hs --- a/test/HPath/IO/CreateSymlinkSpec.hs +++ b/test/HPath/IO/CreateSymlinkSpec.hs @@ -4,7 +4,6 @@ import Test.Hspec -import HPath.IO.Errors import System.IO.Error ( ioeGetErrorType @@ -14,10 +13,14 @@ IOErrorType(..) ) import Utils -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 (toString) +upTmpDir :: IO () +upTmpDir = do + setTmpDir "CreateSymlinkSpec" + createTmpDir + + setupFiles :: IO () setupFiles = do createRegularFile' "alreadyExists" @@ -37,7 +40,7 @@ spec :: Spec -spec = before_ setupFiles $ after_ cleanupFiles $ +spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ describe "HPath.IO.createSymlink" $ do -- successes -- diff --git a/test/HPath/IO/DeleteDirRecursiveSpec.hs b/test/HPath/IO/DeleteDirRecursiveSpec.hs --- a/test/HPath/IO/DeleteDirRecursiveSpec.hs +++ b/test/HPath/IO/DeleteDirRecursiveSpec.hs @@ -17,10 +17,15 @@ IOErrorType(..) ) import Utils -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 (toString) + +upTmpDir :: IO () +upTmpDir = do + setTmpDir "DeleteDirRecursiveSpec" + createTmpDir + + setupFiles :: IO () setupFiles = do createRegularFile' "file" @@ -46,7 +51,7 @@ spec :: Spec -spec = before_ setupFiles $ after_ cleanupFiles $ +spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ describe "HPath.IO.deleteDirRecursive" $ do -- successes -- diff --git a/test/HPath/IO/DeleteDirSpec.hs b/test/HPath/IO/DeleteDirSpec.hs --- a/test/HPath/IO/DeleteDirSpec.hs +++ b/test/HPath/IO/DeleteDirSpec.hs @@ -17,10 +17,16 @@ IOErrorType(..) ) import Utils -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 (toString) + + +upTmpDir :: IO () +upTmpDir = do + setTmpDir "DeleteDirSpec" + createTmpDir + + setupFiles :: IO () setupFiles = do createRegularFile' "file" @@ -46,7 +52,7 @@ spec :: Spec -spec = before_ setupFiles $ after_ cleanupFiles $ +spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ describe "HPath.IO.deleteDir" $ do -- successes -- diff --git a/test/HPath/IO/DeleteFileSpec.hs b/test/HPath/IO/DeleteFileSpec.hs --- a/test/HPath/IO/DeleteFileSpec.hs +++ b/test/HPath/IO/DeleteFileSpec.hs @@ -4,6 +4,7 @@ import Test.Hspec +import HPath.IO import System.IO.Error ( ioeGetErrorType @@ -17,10 +18,14 @@ IOErrorType(..) ) import Utils -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 (toString) +upTmpDir :: IO () +upTmpDir = do + setTmpDir "DeleteFileSpec" + createTmpDir + + setupFiles :: IO () setupFiles = do createRegularFile' "foo" @@ -41,7 +46,7 @@ spec :: Spec -spec = before_ setupFiles $ after_ cleanupFiles $ +spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ describe "HPath.IO.deleteFile" $ do -- successes -- @@ -55,6 +60,7 @@ it "deleteFile, symlink, all fine" $ do recreateSymlink' "syml" "testFile" + Strict deleteFile' "testFile" getSymbolicLinkStatus "testFile" `shouldThrow` diff --git a/test/HPath/IO/GetDirsFilesSpec.hs b/test/HPath/IO/GetDirsFilesSpec.hs --- a/test/HPath/IO/GetDirsFilesSpec.hs +++ b/test/HPath/IO/GetDirsFilesSpec.hs @@ -3,18 +3,10 @@ module HPath.IO.GetDirsFilesSpec where -import Control.Applicative - ( - (<$>) - ) import Data.List ( sort ) -import Data.Maybe - ( - fromJust - ) import qualified HPath as P import HPath.IO import Test.Hspec @@ -22,19 +14,19 @@ ( ioeGetErrorType ) -import System.Posix.Env.ByteString - ( - getEnv - ) import GHC.IO.Exception ( IOErrorType(..) ) import Utils -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 (toString) +upTmpDir :: IO () +upTmpDir = do + setTmpDir "GetDirsFilesSpec" + createTmpDir + + setupFiles :: IO () setupFiles = do createRegularFile' "file" @@ -61,7 +53,7 @@ spec :: Spec -spec = before_ setupFiles $ after_ cleanupFiles $ +spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ describe "HPath.IO.getDirsFiles" $ do -- successes -- diff --git a/test/HPath/IO/GetFileTypeSpec.hs b/test/HPath/IO/GetFileTypeSpec.hs --- a/test/HPath/IO/GetFileTypeSpec.hs +++ b/test/HPath/IO/GetFileTypeSpec.hs @@ -14,10 +14,15 @@ IOErrorType(..) ) import Utils -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 (toString) + +upTmpDir :: IO () +upTmpDir = do + setTmpDir "GetFileTypeSpec" + createTmpDir + + setupFiles :: IO () setupFiles = do createRegularFile' "regularfile" @@ -42,7 +47,7 @@ spec :: Spec -spec = before_ setupFiles $ after_ cleanupFiles $ +spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ describe "HPath.IO.getFileType" $ do -- successes -- diff --git a/test/HPath/IO/MoveFileOverwriteSpec.hs b/test/HPath/IO/MoveFileOverwriteSpec.hs --- a/test/HPath/IO/MoveFileOverwriteSpec.hs +++ b/test/HPath/IO/MoveFileOverwriteSpec.hs @@ -4,6 +4,7 @@ import Test.Hspec +import HPath.IO import HPath.IO.Errors import System.IO.Error ( @@ -14,10 +15,15 @@ IOErrorType(..) ) import Utils -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 (toString) + +upTmpDir :: IO () +upTmpDir = do + setTmpDir "MoveFileOverwriteSpec" + createTmpDir + + setupFiles :: IO () setupFiles = do createRegularFile' "myFile" @@ -45,65 +51,76 @@ spec :: Spec -spec = before_ setupFiles $ after_ cleanupFiles $ - describe "HPath.IO.moveFileOverwrite" $ do +spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ + describe "HPath.IO.moveFile" $ do -- successes -- - it "moveFileOverwrite, all fine" $ - moveFileOverwrite' "myFile" - "movedFile" + it "moveFile (Overwrite), all fine" $ + moveFile' "myFile" + "movedFile" + Overwrite - it "moveFileOverwrite, all fine" $ - moveFileOverwrite' "myFile" - "dir/movedFile" + it "moveFile (Overwrite), all fine" $ + moveFile' "myFile" + "dir/movedFile" + Overwrite - it "moveFileOverwrite, all fine on symlink" $ - moveFileOverwrite' "myFileL" - "movedFile" + it "moveFile (Overwrite), all fine on symlink" $ + moveFile' "myFileL" + "movedFile" + Overwrite - it "moveFileOverwrite, all fine on directory" $ - moveFileOverwrite' "dir" - "movedFile" + it "moveFile (Overwrite), all fine on directory" $ + moveFile' "dir" + "movedFile" + Overwrite - it "moveFileOverwrite, destination file already exists" $ - moveFileOverwrite' "myFile" - "alreadyExists" + it "moveFile (Overwrite), destination file already exists" $ + moveFile' "myFile" + "alreadyExists" + Overwrite -- posix failures -- - it "moveFileOverwrite, source file does not exist" $ - moveFileOverwrite' "fileDoesNotExist" - "movedFile" + it "moveFile (Overwrite), source file does not exist" $ + moveFile' "fileDoesNotExist" + "movedFile" + Overwrite `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) - it "moveFileOverwrite, can't write to destination directory" $ - moveFileOverwrite' "myFile" - "noWritePerm/movedFile" + it "moveFile (Overwrite), can't write to destination directory" $ + moveFile' "myFile" + "noWritePerm/movedFile" + Overwrite `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - it "moveFileOverwrite, can't open destination directory" $ - moveFileOverwrite' "myFile" - "noPerms/movedFile" + it "moveFile (Overwrite), can't open destination directory" $ + moveFile' "myFile" + "noPerms/movedFile" + Overwrite `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - it "moveFileOverwrite, can't open source directory" $ - moveFileOverwrite' "noPerms/myFile" - "movedFile" + it "moveFile (Overwrite), can't open source directory" $ + moveFile' "noPerms/myFile" + "movedFile" + Overwrite `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) -- custom failures -- - it "moveFileOverwrite, move from file to dir" $ - moveFileOverwrite' "myFile" - "alreadyExistsD" + + it "moveFile (Overwrite), move from file to dir" $ + moveFile' "myFile" + "alreadyExistsD" + Overwrite `shouldThrow` isDirDoesExist - it "moveFileOverwrite, source and dest are same file" $ - moveFileOverwrite' "myFile" - "myFile" + it "moveFile (Overwrite), source and dest are same file" $ + moveFile' "myFile" + "myFile" + Overwrite `shouldThrow` isSameFile - diff --git a/test/HPath/IO/MoveFileSpec.hs b/test/HPath/IO/MoveFileSpec.hs --- a/test/HPath/IO/MoveFileSpec.hs +++ b/test/HPath/IO/MoveFileSpec.hs @@ -4,6 +4,7 @@ import Test.Hspec +import HPath.IO import HPath.IO.Errors import System.IO.Error ( @@ -14,10 +15,15 @@ IOErrorType(..) ) import Utils -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 (toString) + +upTmpDir :: IO () +upTmpDir = do + setTmpDir "MoveFileSpec" + createTmpDir + + setupFiles :: IO () setupFiles = do createRegularFile' "myFile" @@ -47,67 +53,77 @@ spec :: Spec -spec = before_ setupFiles $ after_ cleanupFiles $ +spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ describe "HPath.IO.moveFile" $ do -- successes -- - it "moveFile, all fine" $ + it "moveFile (Strict), all fine" $ moveFile' "myFile" "movedFile" + Strict - it "moveFile, all fine" $ + it "moveFile (Strict), all fine" $ moveFile' "myFile" "dir/movedFile" + Strict - it "moveFile, all fine on symlink" $ + it "moveFile (Strict), all fine on symlink" $ moveFile' "myFileL" "movedFile" + Strict - it "moveFile, all fine on directory" $ + it "moveFile (Strict), all fine on directory" $ moveFile' "dir" "movedFile" + Strict -- posix failures -- - it "moveFile, source file does not exist" $ + it "moveFile (Strict), source file does not exist" $ moveFile' "fileDoesNotExist" "movedFile" + Strict `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) - it "moveFile, can't write to destination directory" $ + it "moveFile (Strict), can't write to destination directory" $ moveFile' "myFile" "noWritePerm/movedFile" + Strict `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - it "moveFile, can't open destination directory" $ + it "moveFile (Strict), can't open destination directory" $ moveFile' "myFile" "noPerms/movedFile" + Strict `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - it "moveFile, can't open source directory" $ + it "moveFile (Strict), can't open source directory" $ moveFile' "noPerms/myFile" "movedFile" + Strict `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) -- custom failures -- - it "moveFile, destination file already exists" $ + it "moveFile (Strict), destination file already exists" $ moveFile' "myFile" "alreadyExists" + Strict `shouldThrow` isFileDoesExist - it "moveFile, move from file to dir" $ + it "moveFile (Strict), move from file to dir" $ moveFile' "myFile" "alreadyExistsD" + Strict `shouldThrow` isDirDoesExist - it "moveFile, source and dest are same file" $ + it "moveFile (Strict), source and dest are same file" $ moveFile' "myFile" "myFile" + Strict `shouldThrow` isSameFile - diff --git a/test/HPath/IO/RecreateSymlinkOverwriteSpec.hs b/test/HPath/IO/RecreateSymlinkOverwriteSpec.hs new file mode 100644 --- /dev/null +++ b/test/HPath/IO/RecreateSymlinkOverwriteSpec.hs @@ -0,0 +1,139 @@ +{-# LANGUAGE OverloadedStrings #-} + +module HPath.IO.RecreateSymlinkOverwriteSpec where + + +-- TODO: exception if destination exists but is not a file + `OverWrite` CopyMode + + +import Test.Hspec +import HPath.IO +import HPath.IO.Errors +import System.IO.Error + ( + ioeGetErrorType + ) +import GHC.IO.Exception + ( + IOErrorType(..) + ) +import Utils + + +upTmpDir :: IO () +upTmpDir = do + setTmpDir "RecreateSymlinkOverwriteSpec" + createTmpDir + + +setupFiles :: IO () +setupFiles = do + createRegularFile' "myFile" + createSymlink' "myFileL" "myFile" + createRegularFile' "alreadyExists" + createDir' "alreadyExistsD" + createDir' "dir" + createDir' "noPerms" + createDir' "noWritePerm" + createDir' "alreadyExistsD2" + createRegularFile' "alreadyExistsD2/lala" + noPerms "noPerms" + noWritableDirPerms "noWritePerm" + writeFile' "myFile" "Blahfaselgagaga" + + +cleanupFiles :: IO () +cleanupFiles = do + normalDirPerms "noPerms" + normalDirPerms "noWritePerm" + deleteFile' "myFile" + deleteFile' "myFileL" + deleteFile' "alreadyExists" + deleteFile' "alreadyExistsD2/lala" + deleteDir' "alreadyExistsD" + deleteDir' "alreadyExistsD2" + deleteDir' "dir" + deleteDir' "noPerms" + deleteDir' "noWritePerm" + + +spec :: Spec +spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ + describe "HPath.IO.recreateSymlink" $ do + + -- successes -- + it "recreateSymLink (Overwrite), all fine" $ do + recreateSymlink' "myFileL" + "movedFile" + Overwrite + removeFileIfExists "movedFile" + + it "recreateSymLink (Overwrite), all fine" $ do + recreateSymlink' "myFileL" + "dir/movedFile" + Overwrite + removeFileIfExists "dir/movedFile" + + it "recreateSymLink (Overwrite), destination file already exists" $ + recreateSymlink' "myFileL" + "alreadyExists" + Overwrite + + it "recreateSymLink (Overwrite), destination already exists and is an empty dir" $ do + recreateSymlink' "myFileL" + "alreadyExistsD" + Overwrite + deleteFile' "alreadyExistsD" + createDir' "alreadyExistsD" + + -- posix failures -- + it "recreateSymLink (Overwrite), destination already exists and is a non-empty dir" $ + recreateSymlink' "myFileL" + "alreadyExistsD2" + Overwrite + `shouldThrow` + (\e -> ioeGetErrorType e == UnsatisfiedConstraints) + + it "recreateSymLink (Overwrite), wrong input type (file)" $ + recreateSymlink' "myFile" + "movedFile" + Overwrite + `shouldThrow` + (\e -> ioeGetErrorType e == InvalidArgument) + + it "recreateSymLink (Overwrite), wrong input type (directory)" $ + recreateSymlink' "dir" + "movedFile" + Overwrite + `shouldThrow` + (\e -> ioeGetErrorType e == InvalidArgument) + + it "recreateSymLink (Overwrite), can't write to destination directory" $ + recreateSymlink' "myFileL" + "noWritePerm/movedFile" + Overwrite + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied) + + it "recreateSymLink (Overwrite), can't open destination directory" $ + recreateSymlink' "myFileL" + "noPerms/movedFile" + Overwrite + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied) + + it "recreateSymLink (Overwrite), can't open source directory" $ + recreateSymlink' "noPerms/myFileL" + "movedFile" + Overwrite + `shouldThrow` + (\e -> ioeGetErrorType e == PermissionDenied) + + -- custom failures -- + it "recreateSymLink (Overwrite), source and destination are the same file" $ + recreateSymlink' "myFileL" + "myFileL" + Overwrite + `shouldThrow` + isSameFile + diff --git a/test/HPath/IO/RecreateSymlinkSpec.hs b/test/HPath/IO/RecreateSymlinkSpec.hs --- a/test/HPath/IO/RecreateSymlinkSpec.hs +++ b/test/HPath/IO/RecreateSymlinkSpec.hs @@ -3,7 +3,10 @@ module HPath.IO.RecreateSymlinkSpec where + + import Test.Hspec +import HPath.IO import HPath.IO.Errors import System.IO.Error ( @@ -14,10 +17,15 @@ IOErrorType(..) ) import Utils -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 (toString) + +upTmpDir :: IO () +upTmpDir = do + setTmpDir "RecreateSymlinkSpec" + createTmpDir + + setupFiles :: IO () setupFiles = do createRegularFile' "myFile" @@ -46,67 +54,77 @@ spec :: Spec -spec = before_ setupFiles $ after_ cleanupFiles $ +spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ describe "HPath.IO.recreateSymlink" $ do -- successes -- - it "recreateSymLink, all fine" $ do + it "recreateSymLink (Strict), all fine" $ do recreateSymlink' "myFileL" "movedFile" + Strict removeFileIfExists "movedFile" - it "recreateSymLink, all fine" $ do + it "recreateSymLink (Strict), all fine" $ do recreateSymlink' "myFileL" "dir/movedFile" + Strict removeFileIfExists "dir/movedFile" -- posix failures -- - it "recreateSymLink, wrong input type (file)" $ + it "recreateSymLink (Strict), wrong input type (file)" $ recreateSymlink' "myFile" "movedFile" + Strict `shouldThrow` (\e -> ioeGetErrorType e == InvalidArgument) - it "recreateSymLink, wrong input type (directory)" $ + it "recreateSymLink (Strict), wrong input type (directory)" $ recreateSymlink' "dir" "movedFile" + Strict `shouldThrow` (\e -> ioeGetErrorType e == InvalidArgument) - it "recreateSymLink, can't write to destination directory" $ + it "recreateSymLink (Strict), can't write to destination directory" $ recreateSymlink' "myFileL" "noWritePerm/movedFile" + Strict `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - it "recreateSymLink, can't open destination directory" $ + it "recreateSymLink (Strict), can't open destination directory" $ recreateSymlink' "myFileL" "noPerms/movedFile" + Strict `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - it "recreateSymLink, can't open source directory" $ + it "recreateSymLink (Strict), can't open source directory" $ recreateSymlink' "noPerms/myFileL" "movedFile" + Strict `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - it "recreateSymLink, destination file already exists" $ + it "recreateSymLink (Strict), destination file already exists" $ recreateSymlink' "myFileL" "alreadyExists" + Strict `shouldThrow` (\e -> ioeGetErrorType e == AlreadyExists) - it "recreateSymLink, destination already exists and is a dir" $ + it "recreateSymLink (Strict), destination already exists and is a dir" $ recreateSymlink' "myFileL" "alreadyExistsD" + Strict `shouldThrow` (\e -> ioeGetErrorType e == AlreadyExists) -- custom failures -- - it "recreateSymLink, source and destination are the same file" $ + it "recreateSymLink (Strict), source and destination are the same file" $ recreateSymlink' "myFileL" "myFileL" + Strict `shouldThrow` isSameFile diff --git a/test/HPath/IO/RenameFileSpec.hs b/test/HPath/IO/RenameFileSpec.hs --- a/test/HPath/IO/RenameFileSpec.hs +++ b/test/HPath/IO/RenameFileSpec.hs @@ -14,10 +14,15 @@ IOErrorType(..) ) import Utils -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 (toString) + +upTmpDir :: IO () +upTmpDir = do + setTmpDir "RenameFileSpec" + createTmpDir + + setupFiles :: IO () setupFiles = do createRegularFile' "myFile" @@ -46,7 +51,7 @@ spec :: Spec -spec = before_ setupFiles $ after_ cleanupFiles $ +spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ describe "HPath.IO.renameFile" $ do -- successes -- diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -14,10 +14,6 @@ main = hspecWith defaultConfig { configFormatter = Just progress } - $ before_ up - $ after_ down + $ beforeAll_ createBaseTmpDir + $ afterAll_ deleteBaseTmpDir $ Spec.spec - where - up = createTmpDir - down = deleteTmpDir - diff --git a/test/Utils.hs b/test/Utils.hs --- a/test/Utils.hs +++ b/test/Utils.hs @@ -11,8 +11,17 @@ ) import Control.Monad ( - void + forM_ + , void ) +import qualified Data.ByteString as BS +import Data.IORef + ( + newIORef + , readIORef + , writeIORef + , IORef + ) import HPath.IO import HPath.IO.Errors import HPath.IO.Utils @@ -21,6 +30,11 @@ fromJust ) import qualified HPath as P +import System.IO.Unsafe + ( + unsafePerformIO + ) +import qualified System.Posix.Directory.Traversals as DT import System.Posix.Env.ByteString ( getEnv @@ -47,41 +61,78 @@ -tmpDir :: ByteString -tmpDir = "test/HPath/IO/tmp/" +baseTmpDir :: ByteString +baseTmpDir = "test/HPath/IO/tmp/" +tmpDir :: IORef ByteString +{-# NOINLINE tmpDir #-} +tmpDir = unsafePerformIO (newIORef baseTmpDir) + + ----------------- --[ Utilities ]-- ----------------- +setTmpDir :: ByteString -> IO () +{-# NOINLINE setTmpDir #-} +setTmpDir bs = writeIORef tmpDir (baseTmpDir `BS.append` bs) + + createTmpDir :: IO () +{-# NOINLINE createTmpDir #-} createTmpDir = do pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs - tmp <- P.parseRel tmpDir - void $ createDir (pwd P. tmp) + tmp <- P.parseRel =<< readIORef tmpDir + void $ createDir newDirPerms (pwd P. tmp) deleteTmpDir :: IO () +{-# NOINLINE deleteTmpDir #-} deleteTmpDir = do pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs - tmp <- P.parseRel tmpDir + tmp <- P.parseRel =<< readIORef tmpDir void $ deleteDir (pwd P. tmp) +createBaseTmpDir :: IO () +{-# NOINLINE createBaseTmpDir #-} +createBaseTmpDir = do + pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs + tmp <- P.parseRel baseTmpDir + void $ createDir newDirPerms (pwd P. tmp) + + +deleteBaseTmpDir :: IO () +{-# NOINLINE deleteBaseTmpDir #-} +deleteBaseTmpDir = do + pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs + tmp <- P.parseRel baseTmpDir + contents <- getDirsFiles (pwd P. tmp) + forM_ contents deleteDir + void $ deleteDir (pwd P. tmp) + + withRawTmpDir :: (P.Path P.Abs -> IO a) -> IO a +{-# NOINLINE withRawTmpDir #-} withRawTmpDir f = do pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs - tmp <- P.parseRel tmpDir + tmp <- P.parseRel =<< readIORef tmpDir f (pwd P. tmp) +getRawTmpDir :: IO ByteString +{-# NOINLINE getRawTmpDir #-} +getRawTmpDir = withRawTmpDir (return . flip BS.append "/" . P.fromAbs) + + withTmpDir :: ByteString -> (P.Path P.Abs -> IO a) -> IO a +{-# NOINLINE withTmpDir #-} withTmpDir ip f = do pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs - tmp <- P.parseRel tmpDir + tmp <- P.parseRel =<< readIORef tmpDir p <- (pwd P. tmp P.) <$> P.parseRel ip f p @@ -90,84 +141,80 @@ -> ByteString -> (P.Path P.Abs -> P.Path P.Abs -> IO a) -> IO a +{-# NOINLINE withTmpDir' #-} withTmpDir' ip1 ip2 f = do pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs - tmp <- P.parseRel tmpDir + tmp <- P.parseRel =<< readIORef tmpDir p1 <- (pwd P. tmp P.) <$> P.parseRel ip1 p2 <- (pwd P. tmp P.) <$> P.parseRel ip2 f p1 p2 removeFileIfExists :: ByteString -> IO () +{-# NOINLINE removeFileIfExists #-} removeFileIfExists bs = withTmpDir bs $ \p -> whenM (doesFileExist p) (deleteFile p) removeDirIfExists :: ByteString -> IO () +{-# NOINLINE removeDirIfExists #-} removeDirIfExists bs = withTmpDir bs $ \p -> whenM (doesDirectoryExist p) (deleteDirRecursive p) -copyFile' :: ByteString -> ByteString -> IO () -copyFile' inputFileP outputFileP = - withTmpDir' inputFileP outputFileP copyFile - - -copyFileOverwrite' :: ByteString -> ByteString -> IO () -copyFileOverwrite' inputFileP outputFileP = - withTmpDir' inputFileP outputFileP copyFileOverwrite - - -copyDirRecursive' :: ByteString -> ByteString -> IO () -copyDirRecursive' inputDirP outputDirP = - withTmpDir' inputDirP outputDirP copyDirRecursive +copyFile' :: ByteString -> ByteString -> CopyMode -> IO () +{-# NOINLINE copyFile' #-} +copyFile' inputFileP outputFileP cm = + withTmpDir' inputFileP outputFileP (\p1 p2 -> copyFile p1 p2 cm) -copyDirRecursiveOverwrite' :: ByteString -> ByteString -> IO () -copyDirRecursiveOverwrite' inputDirP outputDirP = - withTmpDir' inputDirP outputDirP copyDirRecursiveOverwrite +copyDirRecursive' :: ByteString -> ByteString + -> CopyMode -> RecursiveErrorMode -> IO () +{-# NOINLINE copyDirRecursive' #-} +copyDirRecursive' inputDirP outputDirP cm rm = + withTmpDir' inputDirP outputDirP (\p1 p2 -> copyDirRecursive p1 p2 cm rm) createDir' :: ByteString -> IO () -createDir' dest = withTmpDir dest createDir +{-# NOINLINE createDir' #-} +createDir' dest = withTmpDir dest (createDir newDirPerms) createRegularFile' :: ByteString -> IO () -createRegularFile' dest = withTmpDir dest createRegularFile +{-# NOINLINE createRegularFile' #-} +createRegularFile' dest = withTmpDir dest (createRegularFile newFilePerms) createSymlink' :: ByteString -> ByteString -> IO () +{-# NOINLINE createSymlink' #-} createSymlink' dest sympoint = withTmpDir dest (\x -> createSymlink x sympoint) renameFile' :: ByteString -> ByteString -> IO () +{-# NOINLINE renameFile' #-} renameFile' inputFileP outputFileP = withTmpDir' inputFileP outputFileP $ \i o -> do renameFile i o renameFile o i -moveFile' :: ByteString -> ByteString -> IO () -moveFile' inputFileP outputFileP = - withTmpDir' inputFileP outputFileP $ \i o -> do - moveFile i o - moveFile o i - - -moveFileOverwrite' :: ByteString -> ByteString -> IO () -moveFileOverwrite' inputFileP outputFileP = +moveFile' :: ByteString -> ByteString -> CopyMode -> IO () +{-# NOINLINE moveFile' #-} +moveFile' inputFileP outputFileP cm = withTmpDir' inputFileP outputFileP $ \i o -> do - moveFileOverwrite i o - moveFile o i + moveFile i o cm + moveFile o i Strict -recreateSymlink' :: ByteString -> ByteString -> IO () -recreateSymlink' inputFileP outputFileP = - withTmpDir' inputFileP outputFileP recreateSymlink +recreateSymlink' :: ByteString -> ByteString -> CopyMode -> IO () +{-# NOINLINE recreateSymlink' #-} +recreateSymlink' inputFileP outputFileP cm = + withTmpDir' inputFileP outputFileP (\p1 p2 -> recreateSymlink p1 p2 cm) noWritableDirPerms :: ByteString -> IO () +{-# NOINLINE noWritableDirPerms #-} noWritableDirPerms path = withTmpDir path $ \p -> setFileMode (P.fromAbs p) perms where @@ -180,42 +227,58 @@ noPerms :: ByteString -> IO () +{-# NOINLINE noPerms #-} noPerms path = withTmpDir path $ \p -> setFileMode (P.fromAbs p) nullFileMode normalDirPerms :: ByteString -> IO () +{-# NOINLINE normalDirPerms #-} normalDirPerms path = withTmpDir path $ \p -> setFileMode (P.fromAbs p) newDirPerms getFileType' :: ByteString -> IO FileType +{-# NOINLINE getFileType' #-} getFileType' path = withTmpDir path getFileType getDirsFiles' :: ByteString -> IO [P.Path P.Abs] +{-# NOINLINE getDirsFiles' #-} getDirsFiles' path = withTmpDir path getDirsFiles deleteFile' :: ByteString -> IO () +{-# NOINLINE deleteFile' #-} deleteFile' p = withTmpDir p deleteFile deleteDir' :: ByteString -> IO () +{-# NOINLINE deleteDir' #-} deleteDir' p = withTmpDir p deleteDir deleteDirRecursive' :: ByteString -> IO () +{-# NOINLINE deleteDirRecursive' #-} deleteDirRecursive' p = withTmpDir p deleteDirRecursive canonicalizePath' :: ByteString -> IO (P.Path P.Abs) +{-# NOINLINE canonicalizePath' #-} canonicalizePath' p = withTmpDir p canonicalizePath writeFile' :: ByteString -> ByteString -> IO () +{-# NOINLINE writeFile' #-} writeFile' ip bs = withTmpDir ip $ \p -> do fd <- SPI.openFd (P.fromAbs p) SPI.WriteOnly Nothing SPI.defaultFileFlags - SPB.fdWrite fd bs + _ <- SPB.fdWrite fd bs SPI.closeFd fd + + +allDirectoryContents' :: ByteString -> IO [ByteString] +{-# NOINLINE allDirectoryContents' #-} +allDirectoryContents' ip = + withTmpDir ip $ \p -> DT.allDirectoryContents' (P.fromAbs p) +