LIB: add copyFileOverwrite
This commit is contained in:
parent
1487351f29
commit
d58fd6e6f0
@ -315,7 +315,32 @@ recreateSymlink symsource newsym
|
||||
copyFile :: Path Abs -- ^ source file
|
||||
-> Path Abs -- ^ destination file
|
||||
-> IO ()
|
||||
copyFile from to
|
||||
copyFile from to = _copyFile SPI.defaultFileFlags { exclusive = True } from to
|
||||
|
||||
|
||||
-- |Like `copyFile` except it overwrites the destination if it already exists.
|
||||
-- This also works if source and destination are the same file.
|
||||
--
|
||||
-- Throws:
|
||||
--
|
||||
-- - `NoSuchThing` if source file does not exist
|
||||
-- - `PermissionDenied` if output directory is not writable
|
||||
-- - `PermissionDenied` if source directory can't be opened
|
||||
-- - `InvalidArgument` if source file is wrong type (symlink)
|
||||
-- - `InvalidArgument` if source file is wrong type (directory)
|
||||
--
|
||||
-- Note: calls `sendfile`
|
||||
copyFileOverwrite :: Path Abs -- ^ source file
|
||||
-> Path Abs -- ^ destination file
|
||||
-> IO ()
|
||||
copyFileOverwrite from to = _copyFile SPI.defaultFileFlags { exclusive = False } from to
|
||||
|
||||
|
||||
_copyFile :: SPI.OpenFileFlags
|
||||
-> Path Abs -- ^ source file
|
||||
-> Path Abs -- ^ destination file
|
||||
-> IO ()
|
||||
_copyFile off from to
|
||||
=
|
||||
-- from sendfile(2) manpage:
|
||||
-- Applications may wish to fall back to read(2)/write(2) in the case
|
||||
@ -332,8 +357,7 @@ copyFile from to
|
||||
$ \sfd -> do
|
||||
fileM <- System.Posix.Files.ByteString.fileMode
|
||||
<$> getFdStatus sfd
|
||||
bracketeer (SPI.openFd dest SPI.WriteOnly (Just fileM)
|
||||
SPI.defaultFileFlags { exclusive = True })
|
||||
bracketeer (SPI.openFd dest SPI.WriteOnly (Just fileM) off)
|
||||
SPI.closeFd
|
||||
(\fd -> SPI.closeFd fd >> deleteFile to)
|
||||
$ \dfd -> sendfileFd dfd sfd EntireFile
|
||||
@ -345,8 +369,7 @@ copyFile from to
|
||||
$ \sfd -> do
|
||||
fileM <- System.Posix.Files.ByteString.fileMode
|
||||
<$> getFdStatus sfd
|
||||
bracketeer (SPI.openFd dest SPI.WriteOnly (Just fileM)
|
||||
SPI.defaultFileFlags { exclusive = True })
|
||||
bracketeer (SPI.openFd dest SPI.WriteOnly (Just fileM) off)
|
||||
SPI.closeFd
|
||||
(\fd -> SPI.closeFd fd >> deleteFile to)
|
||||
$ \dfd -> allocaBytes (fromIntegral bufSize) $ \buf ->
|
||||
@ -360,6 +383,7 @@ copyFile from to
|
||||
if size == 0
|
||||
then return $ fromIntegral totalsize
|
||||
else do rsize <- SPB.fdWriteBuf dfd buf size
|
||||
-- TODO: switch to IOError?
|
||||
when (rsize /= size) (throw . CopyFailed $ "wrong size!")
|
||||
write' sfd dfd buf (totalsize + fromIntegral size)
|
||||
|
||||
|
||||
89
test/FileSystem/FileOperations/CopyFileOverwriteSpec.hs
Normal file
89
test/FileSystem/FileOperations/CopyFileOverwriteSpec.hs
Normal file
@ -0,0 +1,89 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module FileSystem.FileOperations.CopyFileOverwriteSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import System.Exit
|
||||
import System.Process
|
||||
import Utils
|
||||
|
||||
|
||||
|
||||
copyFileOverwriteSpec :: Spec
|
||||
copyFileOverwriteSpec =
|
||||
describe "HSFM.FileSystem.FileOperations.copyFileOverwrite" $ do
|
||||
|
||||
-- successes --
|
||||
it "copyFileOverwrite, everything clear" $ do
|
||||
copyFileOverwrite' "test/FileSystem/FileOperations/copyFileOverwriteSpec/inputFile"
|
||||
"test/FileSystem/FileOperations/copyFileOverwriteSpec/outputFile"
|
||||
removeFileIfExists "test/FileSystem/FileOperations/copyFileOverwriteSpec/outputFile"
|
||||
|
||||
it "copyFileOverwrite, output file already exists, all clear" $
|
||||
copyFileOverwrite' "test/FileSystem/FileOperations/copyFileOverwriteSpec/inputFile"
|
||||
"test/FileSystem/FileOperations/copyFileOverwriteSpec/alreadyExists"
|
||||
|
||||
it "copyFileOverwrite, output and input are same file" $
|
||||
copyFileOverwrite' "test/FileSystem/FileOperations/copyFileOverwriteSpec/inputFile"
|
||||
"test/FileSystem/FileOperations/copyFileOverwriteSpec/inputFile"
|
||||
|
||||
it "copyFileOverwrite, and compare" $ do
|
||||
copyFileOverwrite' "test/FileSystem/FileOperations/copyFileOverwriteSpec/inputFile"
|
||||
"test/FileSystem/FileOperations/copyFileOverwriteSpec/outputFile"
|
||||
(system $ "cmp -s " ++ "test/FileSystem/FileOperations/copyFileOverwriteSpec/inputFile" ++ " "
|
||||
++ "test/FileSystem/FileOperations/copyFileOverwriteSpec/outputFile")
|
||||
`shouldReturn` ExitSuccess
|
||||
removeFileIfExists "test/FileSystem/FileOperations/copyFileOverwriteSpec/outputFile"
|
||||
|
||||
-- posix failures --
|
||||
it "copyFileOverwrite, input file does not exist" $
|
||||
copyFileOverwrite' "test/FileSystem/FileOperations/copyFileOverwriteSpec/noSuchFile"
|
||||
"test/FileSystem/FileOperations/copyFileOverwriteSpec/outputFile"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
it "copyFileOverwrite, no permission to write to output directory" $
|
||||
copyFileOverwrite' "test/FileSystem/FileOperations/copyFileOverwriteSpec/inputFile"
|
||||
"test/FileSystem/FileOperations/copyFileOverwriteSpec/outputDirNoWrite/outputFile"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "copyFileOverwrite, cannot open output directory" $
|
||||
copyFileOverwrite' "test/FileSystem/FileOperations/copyFileOverwriteSpec/inputFile"
|
||||
"test/FileSystem/FileOperations/copyFileOverwriteSpec/noPerms/outputFile"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "copyFileOverwrite, cannot open source directory" $
|
||||
copyFileOverwrite' "test/FileSystem/FileOperations/copyFileOverwriteSpec/noPerms/inputFile"
|
||||
"test/FileSystem/FileOperations/copyFileOverwriteSpec/outputFile"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "copyFileOverwrite, wrong input type (symlink)" $
|
||||
copyFileOverwrite' "test/FileSystem/FileOperations/copyFileOverwriteSpec/inputFileSymL"
|
||||
"test/FileSystem/FileOperations/copyFileOverwriteSpec/outputFile"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InvalidArgument)
|
||||
|
||||
it "copyFileOverwrite, wrong input type (directory)" $
|
||||
copyFileOverwrite' "test/FileSystem/FileOperations/copyFileOverwriteSpec/wrongInput"
|
||||
"test/FileSystem/FileOperations/copyFileOverwriteSpec/outputFile"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InappropriateType)
|
||||
|
||||
it "copyFileOverwrite, output file already exists and is a dir" $
|
||||
copyFileOverwrite' "test/FileSystem/FileOperations/copyFileOverwriteSpec/inputFile"
|
||||
"test/FileSystem/FileOperations/copyFileOverwriteSpec/alreadyExistsD"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InappropriateType)
|
||||
|
||||
@ -0,0 +1,4 @@
|
||||
abc
|
||||
def
|
||||
|
||||
dsadasdsa
|
||||
@ -0,0 +1,4 @@
|
||||
abc
|
||||
def
|
||||
|
||||
dsadasdsa
|
||||
@ -0,0 +1 @@
|
||||
inputFile
|
||||
22
test/Spec.hs
22
test/Spec.hs
@ -3,6 +3,7 @@
|
||||
import Test.Hspec
|
||||
|
||||
import FileSystem.FileOperations.CopyDirRecursiveSpec
|
||||
import FileSystem.FileOperations.CopyFileOverwriteSpec
|
||||
import FileSystem.FileOperations.CopyFileSpec
|
||||
import FileSystem.FileOperations.CreateDirSpec
|
||||
import FileSystem.FileOperations.CreateRegularFileSpec
|
||||
@ -23,15 +24,16 @@ import Utils
|
||||
main :: IO ()
|
||||
main = hspec $ before_ fixPermissions $ after_ revertPermissions $ do
|
||||
let tests = [copyFileSpec
|
||||
, copyDirRecursiveSpec
|
||||
, createDirSpec
|
||||
, createRegularFileSpec
|
||||
, renameFileSpec
|
||||
, moveFileSpec
|
||||
, recreateSymlinkSpec
|
||||
, deleteFileSpec
|
||||
, deleteDirSpec
|
||||
, deleteDirRecursiveSpec
|
||||
,copyFileOverwriteSpec
|
||||
,copyDirRecursiveSpec
|
||||
,createDirSpec
|
||||
,createRegularFileSpec
|
||||
,renameFileSpec
|
||||
,moveFileSpec
|
||||
,recreateSymlinkSpec
|
||||
,deleteFileSpec
|
||||
,deleteDirSpec
|
||||
,deleteDirRecursiveSpec
|
||||
]
|
||||
|
||||
-- run all stateful tests twice to catch missing cleanups or state skew
|
||||
@ -44,6 +46,7 @@ main = hspec $ before_ fixPermissions $ after_ revertPermissions $ do
|
||||
|
||||
where
|
||||
noWriteDirs = ["test/FileSystem/FileOperations/copyFileSpec/outputDirNoWrite"
|
||||
,"test/FileSystem/FileOperations/copyFileOverwriteSpec/outputDirNoWrite"
|
||||
,"test/FileSystem/FileOperations/copyDirRecursiveSpec/noWritePerm"
|
||||
,"test/FileSystem/FileOperations/createDirSpec/noWritePerms"
|
||||
,"test/FileSystem/FileOperations/createRegularFileSpec/noWritePerms"
|
||||
@ -52,6 +55,7 @@ main = hspec $ before_ fixPermissions $ after_ revertPermissions $ do
|
||||
,"test/FileSystem/FileOperations/recreateSymlinkSpec/noWritePerm"
|
||||
]
|
||||
noPermsDirs = ["test/FileSystem/FileOperations/copyFileSpec/noPerms"
|
||||
,"test/FileSystem/FileOperations/copyFileOverwriteSpec/noPerms"
|
||||
,"test/FileSystem/FileOperations/copyDirRecursiveSpec/noPerms"
|
||||
,"test/FileSystem/FileOperations/createDirSpec/noPerms"
|
||||
,"test/FileSystem/FileOperations/createRegularFileSpec/noPerms"
|
||||
|
||||
@ -72,6 +72,11 @@ copyFile' inputFileP outputFileP =
|
||||
withPwd' inputFileP outputFileP copyFile
|
||||
|
||||
|
||||
copyFileOverwrite' :: ByteString -> ByteString -> IO ()
|
||||
copyFileOverwrite' inputFileP outputFileP =
|
||||
withPwd' inputFileP outputFileP copyFileOverwrite
|
||||
|
||||
|
||||
copyDirRecursive' :: ByteString -> ByteString -> IO ()
|
||||
copyDirRecursive' inputDirP outputDirP =
|
||||
withPwd' inputDirP outputDirP copyDirRecursive
|
||||
|
||||
Loading…
Reference in New Issue
Block a user