Julian Ospald
64ae6db83a
This allows to specify the behavior on recursive operations, such that one can collect failures instead of dying on the first failure.
246 lines
7.9 KiB
Haskell
246 lines
7.9 KiB
Haskell
{-# 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
|
|
|
|
|