hpath/test/HPath/IO/CopyFileOverwriteSpec.hs

152 lines
4.2 KiB
Haskell
Raw Normal View History

2016-05-09 14:53:31 +00:00
{-# LANGUAGE OverloadedStrings #-}
module HPath.IO.CopyFileOverwriteSpec where
import Test.Hspec
import HPath.IO
2016-05-09 14:53:31 +00:00
import HPath.IO.Errors
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import System.Exit
import System.Process
import Utils
import Data.ByteString.UTF8 (toString)
2016-06-05 12:33:53 +00:00
import Data.IORef
(
readIORef
)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "CopyFileOverwriteSpec"
createTmpDir
2016-05-09 14:53:31 +00:00
setupFiles :: IO ()
setupFiles = do
createRegularFile' "inputFile"
createRegularFile' "alreadyExists"
createSymlink' "inputFileSymL" "inputFile"
createDir' "alreadyExistsD"
createDir' "noPerms"
createRegularFile' "noPerms/inputFile"
createDir' "outputDirNoWrite"
createDir' "wrongInput"
noPerms "noPerms"
noWritableDirPerms "outputDirNoWrite"
writeFile' "inputFile" "Blahfaselgagaga"
writeFile' "alreadyExists" "dsaldsalkaklsdlkasksdadasl"
cleanupFiles :: IO ()
cleanupFiles = do
normalDirPerms "noPerms"
normalDirPerms "outputDirNoWrite"
deleteFile' "noPerms/inputFile"
deleteFile' "inputFile"
deleteFile' "alreadyExists"
deleteFile' "inputFileSymL"
deleteDir' "alreadyExistsD"
deleteDir' "noPerms"
deleteDir' "outputDirNoWrite"
deleteDir' "wrongInput"
2016-05-09 14:53:31 +00:00
spec :: Spec
2016-06-05 13:25:57 +00:00
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.copyFile" $ do
2016-05-09 14:53:31 +00:00
-- successes --
it "copyFile (Overwrite), everything clear" $ do
copyFile' "inputFile"
"outputFile"
Overwrite
removeFileIfExists "outputFile"
2016-05-09 14:53:31 +00:00
it "copyFile (Overwrite), output file already exists, all clear" $ do
2016-06-05 12:33:53 +00:00
tmpDir' <- getRawTmpDir
copyFile' "alreadyExists" "alreadyExists.bak" Strict
copyFile' "inputFile" "alreadyExists" Overwrite
2016-06-05 12:33:53 +00:00
(system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " "
++ toString tmpDir' ++ "alreadyExists")
2016-05-09 14:53:31 +00:00
`shouldReturn` ExitSuccess
removeFileIfExists "alreadyExists"
copyFile' "alreadyExists.bak" "alreadyExists" Strict
removeFileIfExists "alreadyExists.bak"
2016-05-09 14:53:31 +00:00
it "copyFile (Overwrite), and compare" $ do
2016-06-05 12:33:53 +00:00
tmpDir' <- getRawTmpDir
copyFile' "inputFile"
"outputFile"
Overwrite
2016-06-05 12:33:53 +00:00
(system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " "
++ toString tmpDir' ++ "outputFile")
2016-05-09 14:53:31 +00:00
`shouldReturn` ExitSuccess
removeFileIfExists "outputFile"
2016-05-09 14:53:31 +00:00
2016-05-09 14:53:31 +00:00
-- posix failures --
it "copyFile (Overwrite), input file does not exist" $
copyFile' "noSuchFile"
"outputFile"
Overwrite
2016-05-09 14:53:31 +00:00
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "copyFile (Overwrite), no permission to write to output directory" $
copyFile' "inputFile"
"outputDirNoWrite/outputFile"
Overwrite
2016-05-09 14:53:31 +00:00
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyFile (Overwrite), cannot open output directory" $
copyFile' "inputFile"
"noPerms/outputFile"
Overwrite
2016-05-09 14:53:31 +00:00
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyFile (Overwrite), cannot open source directory" $
copyFile' "noPerms/inputFile"
"outputFile"
Overwrite
2016-05-09 14:53:31 +00:00
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyFile (Overwrite), wrong input type (symlink)" $
copyFile' "inputFileSymL"
"outputFile"
Overwrite
2016-05-09 14:53:31 +00:00
`shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument)
it "copyFile (Overwrite), wrong input type (directory)" $
copyFile' "wrongInput"
"outputFile"
Overwrite
2016-05-09 14:53:31 +00:00
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
it "copyFile (Overwrite), output file already exists and is a dir" $
copyFile' "inputFile"
"alreadyExistsD"
Overwrite
2016-05-09 14:53:31 +00:00
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
-- custom failures --
it "copyFile (Overwrite), output and input are same file" $
copyFile' "inputFile"
"inputFile"
Overwrite
2016-05-09 14:53:31 +00:00
`shouldThrow` isSameFile