From 64ae6db83a3a27fc85dd47a16d637018d4829f0b Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Sun, 5 Jun 2016 03:10:28 +0200 Subject: [PATCH] New API: use CopyMode for overwriting and introduce RecursiveMode This allows to specify the behavior on recursive operations, such that one can collect failures instead of dying on the first failure. --- hpath.cabal | 2 + src/HPath/IO.hs | 343 ++++++++---------- src/HPath/IO/Errors.hs | 29 +- test/HPath/IO/CanonicalizePathSpec.hs | 2 - .../IO/CopyDirRecursiveCollectFailuresSpec.hs | 245 +++++++++++++ .../HPath/IO/CopyDirRecursiveOverwriteSpec.hs | 103 ++++-- test/HPath/IO/CopyDirRecursiveSpec.hs | 56 ++- test/HPath/IO/CopyFileOverwriteSpec.hs | 66 ++-- test/HPath/IO/CopyFileSpec.hs | 37 +- test/HPath/IO/CreateDirSpec.hs | 2 - test/HPath/IO/CreateRegularFileSpec.hs | 2 - test/HPath/IO/CreateSymlinkSpec.hs | 3 - test/HPath/IO/DeleteDirRecursiveSpec.hs | 2 - test/HPath/IO/DeleteDirSpec.hs | 2 - test/HPath/IO/DeleteFileSpec.hs | 4 +- test/HPath/IO/GetDirsFilesSpec.hs | 14 - test/HPath/IO/GetFileTypeSpec.hs | 2 - test/HPath/IO/MoveFileOverwriteSpec.hs | 84 +++-- test/HPath/IO/MoveFileSpec.hs | 37 +- test/HPath/IO/RecreateSymlinkOverwriteSpec.hs | 122 +++++++ test/HPath/IO/RecreateSymlinkSpec.hs | 36 +- test/HPath/IO/RenameFileSpec.hs | 2 - test/Utils.hs | 56 ++- 23 files changed, 831 insertions(+), 420 deletions(-) create mode 100644 test/HPath/IO/CopyDirRecursiveCollectFailuresSpec.hs create mode 100644 test/HPath/IO/RecreateSymlinkOverwriteSpec.hs diff --git a/hpath.cabal b/hpath.cabal index 037845d..c4e7376 100644 --- a/hpath.cabal +++ b/hpath.cabal @@ -73,6 +73,7 @@ test-suite spec Main-Is: Main.hs other-modules: HPath.IO.CanonicalizePathSpec + HPath.IO.CopyDirRecursiveCollectFailuresSpec HPath.IO.CopyDirRecursiveOverwriteSpec HPath.IO.CopyDirRecursiveSpec HPath.IO.CopyFileOverwriteSpec @@ -87,6 +88,7 @@ test-suite spec 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 index 54a1415..38e95f4 100644 --- a/src/HPath/IO.hs +++ b/src/HPath/IO.hs @@ -37,14 +37,13 @@ module HPath.IO ( -- * Types FileType(..) + , RecursiveMode(..) + , CopyMode(..) -- * File copying , copyDirRecursive - , copyDirRecursiveOverwrite , recreateSymlink , copyFile - , copyFileOverwrite , easyCopy - , easyCopyOverwrite -- * File deletion , deleteFile , deleteDir @@ -60,7 +59,6 @@ module HPath.IO -- * File renaming/moving , renameFile , moveFile - , moveFileOverwrite -- * File permissions , newFilePerms , newDirPerms @@ -80,12 +78,14 @@ import Control.Applicative ) import Control.Exception ( - bracket + IOException + , bracket , throwIO ) import Control.Monad ( - void + unless + , void , when ) import Data.ByteString @@ -96,6 +96,13 @@ import Data.Foldable ( for_ ) +import Data.IORef + ( + IORef + , modifyIORef + , newIORef + , readIORef + ) import Data.Maybe ( catMaybes @@ -131,7 +138,6 @@ import GHC.IO.Exception import HPath import HPath.Internal import HPath.IO.Errors -import HPath.IO.Utils import Prelude hiding (readFile) import System.IO.Error ( @@ -213,6 +219,27 @@ data FileType = Directory +-- |The 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 and collects the failed sub-operation +-- and keeps on +-- recursing. At the end an exception describing the collected +-- failures will still be raised. +data RecursiveMode = 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 + + -------------------- @@ -228,6 +255,10 @@ data FileType = Directory -- and thus will ignore any file type that is not `RegularFile`, -- `SymbolicLink` or `Directory`. -- +-- For `Overwrite` mode this does not prune destination directory contents, +-- so the destination might contain more files than the source after +-- the operation has completed. +-- -- Safety/reliability concerns: -- -- * not atomic @@ -244,27 +275,51 @@ data FileType = Directory -- - `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) --- - `AlreadyExists` if destination already exists -- - `SameFile` if source and destination are the same file (`HPathIOException`) -- - `DestinationInSource` if destination is contained in source (`HPathIOException`) +-- - `RecursiveFailure` if any sub-operation failed (for `CollectFailures` RecursiveMode only) +-- +-- Throws in `Strict` CopyMode only: +-- +-- - `AlreadyExists` if destination already exists +-- +-- Throws in `CollectFailures` RecursiveMode only: +-- +-- - `AlreadyExists` if destination already exists copyDirRecursive :: Path Abs -- ^ source dir -> Path Abs -- ^ full destination + -> CopyMode + -> RecursiveMode -> 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 +327,51 @@ copyDirRecursive fromp destdirp ftype <- getFileType f newdest <- (destdirp' ) <$> basename f case ftype of - SymbolicLink -> recreateSymlink f newdest - Directory -> go f newdest - RegularFile -> copyFile f newdest - _ -> return () - - --- |Like `copyDirRecursive` except it overwrites contents of directories --- if any. --- --- For directory contents, this has the same behavior as `easyCopyOverwrite` --- and thus will ignore any file type that is not `RegularFile`, --- `SymbolicLink` or `Directory`. --- --- Throws: --- --- - `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 + 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) -- |Recreate a symlink. -- +-- In `Overwrite` mode only files and empty directories are deleted. +-- +-- Safety/reliability concerns: +-- +-- * `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 --- - `AlreadyExists` if destination file already exists +-- - `AlreadyExists` if destination file already exists (for `Strict` CopyMode only) -- - `SameFile` if source and destination are the same file (`HPathIOException`) -- -- 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 +383,11 @@ recreateSymlink symsource newsym -- examine file types. For a more high-level version, use `easyCopy` -- instead. -- +-- In `Overwrite` 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 +402,35 @@ recreateSymlink symsource newsym -- - `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) --- - `AlreadyExists` if destination already exists +-- - `AlreadyExists` if destination already exists (for `Strict` CopyMode only) -- - `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 +copyFile from to cm = 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 - 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] @@ -490,38 +492,18 @@ _copyFile sflags dflags from to -- * calls `copyDirRecursive` for directories easyCopy :: Path Abs -> Path Abs + -> CopyMode + -> RecursiveMode -> IO () -easyCopy from to = do +easyCopy from to cm rm = do ftype <- getFileType from case ftype of - SymbolicLink -> recreateSymlink from to - RegularFile -> copyFile from to - Directory -> copyDirRecursive from to + SymbolicLink -> recreateSymlink from to cm + RegularFile -> copyFile from to cm + Directory -> copyDirRecursive from to cm rm _ -> 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 - ftype <- getFileType from - case ftype of - SymbolicLink -> whenM (doesFileExist to) (deleteFile to) - >> recreateSymlink from to - RegularFile -> copyFileOverwrite from to - Directory -> copyDirRecursiveOverwrite from to - _ -> return () - - - @@ -725,70 +707,53 @@ renameFile fromf tof = do -- -- 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`) +-- - `FileDoesExist` if destination file already exists (`HPathIOException`), +-- only for `Strict` CopyMode -- - `DirDoesExist` if destination directory already exists (`HPathIOException`) +-- only for `Strict` CopyMode -- - `SameFile` if destination and source are the same file (`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 diff --git a/src/HPath/IO/Errors.hs b/src/HPath/IO/Errors.hs index c081076..0153981 100644 --- a/src/HPath/IO/Errors.hs +++ b/src/HPath/IO/Errors.hs @@ -9,7 +9,6 @@ -- -- Provides error handling. -{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ScopedTypeVariables #-} module HPath.IO.Errors @@ -27,6 +26,7 @@ module HPath.IO.Errors , isInvalidOperation , isCan'tOpenDirectory , isCopyFailed + , isRecursiveFailure -- * Path based functions , throwFileDoesExist @@ -70,10 +70,6 @@ import Data.ByteString.UTF8 ( toString ) -import Data.Data - ( - Data(..) - ) import Data.Typeable import Foreign.C.Error ( @@ -114,7 +110,8 @@ data HPathIOException = FileDoesNotExist ByteString | InvalidOperation String | Can'tOpenDirectory ByteString | CopyFailed String - deriving (Typeable, Eq, Data) + | RecursiveFailure [IOException] + deriving (Typeable, Eq) instance Show HPathIOException where @@ -133,6 +130,22 @@ instance Show HPathIOException where 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" + @@ -146,7 +159,7 @@ instance Exception HPathIOException --[ 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 +169,7 @@ isDirDoesExist ex = toConstr (ex :: HPathIOException) == toConstr DirDoesExist{} 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/test/HPath/IO/CanonicalizePathSpec.hs b/test/HPath/IO/CanonicalizePathSpec.hs index b268933..d811720 100644 --- a/test/HPath/IO/CanonicalizePathSpec.hs +++ b/test/HPath/IO/CanonicalizePathSpec.hs @@ -13,8 +13,6 @@ import GHC.IO.Exception IOErrorType(..) ) import Utils -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 (toString) diff --git a/test/HPath/IO/CopyDirRecursiveCollectFailuresSpec.hs b/test/HPath/IO/CopyDirRecursiveCollectFailuresSpec.hs new file mode 100644 index 0000000..25bd7e6 --- /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 Data.Maybe (fromJust) +import HPath.IO +import HPath.IO.Errors +import System.IO.Error + ( + ioeGetErrorType + ) +import GHC.IO.Exception + ( + IOErrorType(..) + ) +import System.Exit +import System.Process +import System.Posix.Env.ByteString + ( + getEnv + ) +import Utils +import qualified Data.ByteString as BS +import Data.ByteString.UTF8 (toString) + + + +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 = before_ setupFiles $ after_ cleanupFiles $ + describe "HPath.IO.copyDirRecursive" $ do + + -- successes -- + it "copyDirRecursive (Strict, CollectFailures), all fine and compare" $ do + 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 [e1, e2]) -> + ioeGetErrorType e1 == InappropriateType && + ioeGetErrorType e2 == PermissionDenied) + normalDirPerms "outputDir1/foo2/foo4" + normalDirPerms "outputDir1/foo2/foo4/inputFile4" + c <- allDirectoryContents' "outputDir1" + pwd <- fromJust <$> getEnv "PWD" + let shouldC = (fmap (\x -> pwd `BS.append` "/" `BS.append` + 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"]) + sort c `shouldBe` sort shouldC + deleteFile' "outputDir1/foo2/inputFile1" + deleteFile' "outputDir1/foo2/inputFile2" + deleteFile' "outputDir1/foo2/inputFile3" + + + 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 index cdafd55..4752e15 100644 --- a/test/HPath/IO/CopyDirRecursiveOverwriteSpec.hs +++ b/test/HPath/IO/CopyDirRecursiveOverwriteSpec.hs @@ -5,6 +5,7 @@ module HPath.IO.CopyDirRecursiveOverwriteSpec where import Test.Hspec +import HPath.IO import HPath.IO.Errors import System.IO.Error ( @@ -17,8 +18,7 @@ import GHC.IO.Exception import System.Exit import System.Process import Utils -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 (toString) +import Data.ByteString.UTF8 (toString) @@ -82,88 +82,113 @@ cleanupFiles = do spec :: Spec spec = before_ setupFiles $ after_ cleanupFiles $ - describe "HPath.IO.copyDirRecursiveOverwrite" $ do + 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 + copyDirRecursive' "inputDir" + "outputDir" + Overwrite + FailEarly (system $ "diff -r --no-dereference " ++ 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 (system $ "diff -r --no-dereference " ++ 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") `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 index 00f2637..a2b84ef 100644 --- a/test/HPath/IO/CopyDirRecursiveSpec.hs +++ b/test/HPath/IO/CopyDirRecursiveSpec.hs @@ -5,6 +5,7 @@ module HPath.IO.CopyDirRecursiveSpec where import Test.Hspec +import HPath.IO import HPath.IO.Errors import System.IO.Error ( @@ -17,10 +18,7 @@ import GHC.IO.Exception import System.Exit import System.Process import Utils -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 (toString) - - +import Data.ByteString.UTF8 (toString) @@ -73,14 +71,18 @@ spec = before_ setupFiles $ after_ 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 copyDirRecursive' "inputDir" "outputDir" + Strict + FailEarly (system $ "diff -r --no-dereference " ++ toString tmpDir ++ "inputDir" ++ " " ++ toString tmpDir ++ "outputDir") @@ -88,63 +90,85 @@ spec = before_ setupFiles $ after_ cleanupFiles $ 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 index 2fa6a8f..8150a38 100644 --- a/test/HPath/IO/CopyFileOverwriteSpec.hs +++ b/test/HPath/IO/CopyFileOverwriteSpec.hs @@ -4,6 +4,7 @@ module HPath.IO.CopyFileOverwriteSpec where import Test.Hspec +import HPath.IO import HPath.IO.Errors import System.IO.Error ( @@ -16,8 +17,7 @@ import GHC.IO.Exception import System.Exit import System.Process import Utils -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 (toString) +import Data.ByteString.UTF8 (toString) setupFiles :: IO () @@ -52,78 +52,88 @@ cleanupFiles = do spec :: Spec spec = before_ setupFiles $ after_ cleanupFiles $ - describe "HPath.IO.copyFileOverwrite" $ do + 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" + it "copyFile (Overwrite), output file already exists, all clear" $ do + 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 + copyFile' "inputFile" "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 index daffbf1..ce8c1a9 100644 --- a/test/HPath/IO/CopyFileSpec.hs +++ b/test/HPath/IO/CopyFileSpec.hs @@ -5,6 +5,7 @@ module HPath.IO.CopyFileSpec where import Test.Hspec +import HPath.IO import HPath.IO.Errors import System.IO.Error ( @@ -17,8 +18,7 @@ import GHC.IO.Exception import System.Exit import System.Process import Utils -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 (toString) +import Data.ByteString.UTF8 (toString) setupFiles :: IO () @@ -55,71 +55,82 @@ spec = before_ setupFiles $ after_ 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 copyFile' "inputFile" "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 index 39b376e..9fdf0ea 100644 --- a/test/HPath/IO/CreateDirSpec.hs +++ b/test/HPath/IO/CreateDirSpec.hs @@ -13,8 +13,6 @@ import GHC.IO.Exception IOErrorType(..) ) import Utils -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 (toString) setupFiles :: IO () diff --git a/test/HPath/IO/CreateRegularFileSpec.hs b/test/HPath/IO/CreateRegularFileSpec.hs index 51c9178..0cacc35 100644 --- a/test/HPath/IO/CreateRegularFileSpec.hs +++ b/test/HPath/IO/CreateRegularFileSpec.hs @@ -13,8 +13,6 @@ import GHC.IO.Exception IOErrorType(..) ) import Utils -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 (toString) setupFiles :: IO () diff --git a/test/HPath/IO/CreateSymlinkSpec.hs b/test/HPath/IO/CreateSymlinkSpec.hs index 7c5a8f1..81bebad 100644 --- a/test/HPath/IO/CreateSymlinkSpec.hs +++ b/test/HPath/IO/CreateSymlinkSpec.hs @@ -4,7 +4,6 @@ module HPath.IO.CreateSymlinkSpec where import Test.Hspec -import HPath.IO.Errors import System.IO.Error ( ioeGetErrorType @@ -14,8 +13,6 @@ import GHC.IO.Exception IOErrorType(..) ) import Utils -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 (toString) setupFiles :: IO () diff --git a/test/HPath/IO/DeleteDirRecursiveSpec.hs b/test/HPath/IO/DeleteDirRecursiveSpec.hs index a251a7f..34a528b 100644 --- a/test/HPath/IO/DeleteDirRecursiveSpec.hs +++ b/test/HPath/IO/DeleteDirRecursiveSpec.hs @@ -17,8 +17,6 @@ import GHC.IO.Exception IOErrorType(..) ) import Utils -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 (toString) setupFiles :: IO () diff --git a/test/HPath/IO/DeleteDirSpec.hs b/test/HPath/IO/DeleteDirSpec.hs index 44d5b85..def02f7 100644 --- a/test/HPath/IO/DeleteDirSpec.hs +++ b/test/HPath/IO/DeleteDirSpec.hs @@ -17,8 +17,6 @@ import GHC.IO.Exception IOErrorType(..) ) import Utils -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 (toString) setupFiles :: IO () diff --git a/test/HPath/IO/DeleteFileSpec.hs b/test/HPath/IO/DeleteFileSpec.hs index 791a104..e0b646d 100644 --- a/test/HPath/IO/DeleteFileSpec.hs +++ b/test/HPath/IO/DeleteFileSpec.hs @@ -4,6 +4,7 @@ module HPath.IO.DeleteFileSpec where import Test.Hspec +import HPath.IO import System.IO.Error ( ioeGetErrorType @@ -17,8 +18,6 @@ import GHC.IO.Exception IOErrorType(..) ) import Utils -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 (toString) setupFiles :: IO () @@ -55,6 +54,7 @@ spec = before_ setupFiles $ after_ cleanupFiles $ 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 index 244e864..2840e2d 100644 --- 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,17 +14,11 @@ import System.IO.Error ( 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) setupFiles :: IO () diff --git a/test/HPath/IO/GetFileTypeSpec.hs b/test/HPath/IO/GetFileTypeSpec.hs index b695490..7369687 100644 --- a/test/HPath/IO/GetFileTypeSpec.hs +++ b/test/HPath/IO/GetFileTypeSpec.hs @@ -14,8 +14,6 @@ import GHC.IO.Exception IOErrorType(..) ) import Utils -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 (toString) setupFiles :: IO () diff --git a/test/HPath/IO/MoveFileOverwriteSpec.hs b/test/HPath/IO/MoveFileOverwriteSpec.hs index 8f2cef8..3450f81 100644 --- a/test/HPath/IO/MoveFileOverwriteSpec.hs +++ b/test/HPath/IO/MoveFileOverwriteSpec.hs @@ -4,6 +4,7 @@ module HPath.IO.MoveFileOverwriteSpec where import Test.Hspec +import HPath.IO import HPath.IO.Errors import System.IO.Error ( @@ -14,8 +15,6 @@ import GHC.IO.Exception IOErrorType(..) ) import Utils -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 (toString) setupFiles :: IO () @@ -46,64 +45,75 @@ cleanupFiles = do spec :: Spec spec = before_ setupFiles $ after_ cleanupFiles $ - describe "HPath.IO.moveFileOverwrite" $ do + 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 index 0bf88fc..80fa9d2 100644 --- a/test/HPath/IO/MoveFileSpec.hs +++ b/test/HPath/IO/MoveFileSpec.hs @@ -4,6 +4,7 @@ module HPath.IO.MoveFileSpec where import Test.Hspec +import HPath.IO import HPath.IO.Errors import System.IO.Error ( @@ -14,8 +15,6 @@ import GHC.IO.Exception IOErrorType(..) ) import Utils -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 (toString) setupFiles :: IO () @@ -51,63 +50,73 @@ spec = before_ setupFiles $ after_ 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 index 0000000..175bbe3 --- /dev/null +++ b/test/HPath/IO/RecreateSymlinkOverwriteSpec.hs @@ -0,0 +1,122 @@ +{-# 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 + + +setupFiles :: IO () +setupFiles = do + createRegularFile' "myFile" + createSymlink' "myFileL" "myFile" + createRegularFile' "alreadyExists" + createDir' "alreadyExistsD" + createDir' "dir" + createDir' "noPerms" + createDir' "noWritePerm" + noPerms "noPerms" + noWritableDirPerms "noWritePerm" + writeFile' "myFile" "Blahfaselgagaga" + + +cleanupFiles :: IO () +cleanupFiles = do + normalDirPerms "noPerms" + normalDirPerms "noWritePerm" + deleteFile' "myFile" + deleteFile' "myFileL" + deleteFile' "alreadyExists" + deleteDir' "alreadyExistsD" + deleteDir' "dir" + deleteDir' "noPerms" + deleteDir' "noWritePerm" + + +spec :: Spec +spec = before_ setupFiles $ after_ 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 a dir" $ do + recreateSymlink' "myFileL" + "alreadyExistsD" + Overwrite + deleteFile' "alreadyExistsD" + createDir' "alreadyExistsD" + + -- posix failures -- + 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 index e55ea16..ce5e26a 100644 --- a/test/HPath/IO/RecreateSymlinkSpec.hs +++ b/test/HPath/IO/RecreateSymlinkSpec.hs @@ -3,7 +3,11 @@ module HPath.IO.RecreateSymlinkSpec 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 ( @@ -14,8 +18,6 @@ import GHC.IO.Exception IOErrorType(..) ) import Utils -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 (toString) setupFiles :: IO () @@ -50,63 +52,73 @@ spec = before_ setupFiles $ after_ 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 index 5aad134..4809819 100644 --- a/test/HPath/IO/RenameFileSpec.hs +++ b/test/HPath/IO/RenameFileSpec.hs @@ -14,8 +14,6 @@ import GHC.IO.Exception IOErrorType(..) ) import Utils -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 (toString) setupFiles :: IO () diff --git a/test/Utils.hs b/test/Utils.hs index 6e8739d..f27305a 100644 --- a/test/Utils.hs +++ b/test/Utils.hs @@ -21,6 +21,10 @@ import Data.Maybe fromJust ) import qualified HPath as P +import System.Posix.Directory.Traversals + ( + allDirectoryContents + ) import System.Posix.Env.ByteString ( getEnv @@ -108,24 +112,15 @@ removeDirIfExists bs = withTmpDir bs $ \p -> whenM (doesDirectoryExist p) (deleteDirRecursive p) -copyFile' :: ByteString -> ByteString -> IO () -copyFile' inputFileP outputFileP = - withTmpDir' inputFileP outputFileP copyFile +copyFile' :: ByteString -> ByteString -> CopyMode -> IO () +copyFile' inputFileP outputFileP cm = + withTmpDir' inputFileP outputFileP (\p1 p2 -> copyFile p1 p2 cm) -copyFileOverwrite' :: ByteString -> ByteString -> IO () -copyFileOverwrite' inputFileP outputFileP = - withTmpDir' inputFileP outputFileP copyFileOverwrite - - -copyDirRecursive' :: ByteString -> ByteString -> IO () -copyDirRecursive' inputDirP outputDirP = - withTmpDir' inputDirP outputDirP copyDirRecursive - - -copyDirRecursiveOverwrite' :: ByteString -> ByteString -> IO () -copyDirRecursiveOverwrite' inputDirP outputDirP = - withTmpDir' inputDirP outputDirP copyDirRecursiveOverwrite +copyDirRecursive' :: ByteString -> ByteString + -> CopyMode -> RecursiveMode -> IO () +copyDirRecursive' inputDirP outputDirP cm rm = + withTmpDir' inputDirP outputDirP (\p1 p2 -> copyDirRecursive p1 p2 cm rm) createDir' :: ByteString -> IO () @@ -148,23 +143,16 @@ renameFile' inputFileP outputFileP = renameFile o i -moveFile' :: ByteString -> ByteString -> IO () -moveFile' inputFileP outputFileP = +moveFile' :: ByteString -> ByteString -> CopyMode -> IO () +moveFile' inputFileP outputFileP cm = withTmpDir' inputFileP outputFileP $ \i o -> do - moveFile i o - moveFile o i + moveFile i o cm + moveFile o i Strict -moveFileOverwrite' :: ByteString -> ByteString -> IO () -moveFileOverwrite' inputFileP outputFileP = - withTmpDir' inputFileP outputFileP $ \i o -> do - moveFileOverwrite i o - moveFile o i - - -recreateSymlink' :: ByteString -> ByteString -> IO () -recreateSymlink' inputFileP outputFileP = - withTmpDir' inputFileP outputFileP recreateSymlink +recreateSymlink' :: ByteString -> ByteString -> CopyMode -> IO () +recreateSymlink' inputFileP outputFileP cm = + withTmpDir' inputFileP outputFileP (\p1 p2 -> recreateSymlink p1 p2 cm) noWritableDirPerms :: ByteString -> IO () @@ -217,5 +205,11 @@ 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] +allDirectoryContents' ip = + withTmpDir ip $ \p -> allDirectoryContents (P.fromAbs p) +