LIB/TESTS: fix moveFileOverwrite and add tests

We must not allow to move a file to a directory, deleting that
directory and effectively changing the filetype.

hsfm.cabal

@@ -133,6 +133,7 @@ Test-Suite spec
                         FileSystem.FileOperations.GetDirsFilesSpec
                         FileSystem.FileOperations.GetFileTypeSpec
                         FileSystem.FileOperations.MoveFileSpec
+                        FileSystem.FileOperations.MoveFileOverwriteSpec
                         FileSystem.FileOperations.RecreateSymlinkSpec
                         FileSystem.FileOperations.RenameFileSpec
                         Utils

src/HSFM/FileSystem/FileOperations.hs

@@ -676,7 +676,7 @@ moveFile from to = do
 -- Safety/reliability concerns:
 --
 --    * copy-delete fallback is inherently non-atomic
---    * checks for destination file existence explicitly
+--    * checks for file types and destination file existence explicitly
 --
 -- Throws:
 --
@@ -691,9 +691,20 @@ moveFileOverwrite :: Path Abs  -- ^ file to move
                   -> IO ()
 moveFileOverwrite from to = do
   throwSameFile from to
-  exists <- (||) <$> doesFileExist to <*> doesDirectoryExist to
+  ft <- getFileType from
   writable <- isWritable $ P.dirname to
-  when (exists && writable) (easyDelete 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)
+    _ -> ioError $ userError $ "Don't know how to handle filetype " ++
+                               show ft
   moveFile from to
 
 

test/FileSystem/FileOperations/MoveFileOverwriteSpec.hs

@@ -0,0 +1,81 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module FileSystem.FileOperations.MoveFileOverwriteSpec where
+
+
+import Test.Hspec
+import HSFM.FileSystem.Errors
+import System.IO.Error
+  (
+    ioeGetErrorType
+  )
+import GHC.IO.Exception
+  (
+    IOErrorType(..)
+  )
+import Utils
+
+
+moveFileOverwriteSpec :: Spec
+moveFileOverwriteSpec =
+  describe "HSFM.FileSystem.FileOperations.moveFileOverwrite" $ do
+
+    -- successes --
+    it "moveFileOverwrite, all fine" $
+      moveFileOverwrite' "test/FileSystem/FileOperations/moveFileOverwriteSpec/myFile"
+                         "test/FileSystem/FileOperations/moveFileOverwriteSpec/movedFile"
+
+    it "moveFileOverwrite, all fine" $
+      moveFileOverwrite' "test/FileSystem/FileOperations/moveFileOverwriteSpec/myFile"
+                         "test/FileSystem/FileOperations/moveFileOverwriteSpec/dir/movedFile"
+
+    it "moveFileOverwrite, all fine on symlink" $
+      moveFileOverwrite' "test/FileSystem/FileOperations/moveFileOverwriteSpec/myFileL"
+                         "test/FileSystem/FileOperations/moveFileOverwriteSpec/movedFile"
+
+    it "moveFileOverwrite, all fine on directory" $
+      moveFileOverwrite' "test/FileSystem/FileOperations/moveFileOverwriteSpec/dir"
+                         "test/FileSystem/FileOperations/moveFileOverwriteSpec/movedFile"
+
+    it "moveFileOverwrite, destination file already exists" $
+      moveFileOverwrite' "test/FileSystem/FileOperations/moveFileOverwriteSpec/myFile"
+                         "test/FileSystem/FileOperations/moveFileOverwriteSpec/alreadyExists"
+
+    -- posix failures --
+    it "moveFileOverwrite, source file does not exist" $
+      moveFileOverwrite' "test/FileSystem/FileOperations/moveFileOverwriteSpec/fileDoesNotExist"
+                         "test/FileSystem/FileOperations/moveFileOverwriteSpec/movedFile"
+        `shouldThrow`
+        (\e -> ioeGetErrorType e == NoSuchThing)
+
+    it "moveFileOverwrite, can't write to destination directory" $
+      moveFileOverwrite' "test/FileSystem/FileOperations/moveFileOverwriteSpec/myFile"
+                         "test/FileSystem/FileOperations/moveFileOverwriteSpec/noWritePerm/movedFile"
+        `shouldThrow`
+        (\e -> ioeGetErrorType e == PermissionDenied)
+
+    it "moveFileOverwrite, can't open destination directory" $
+      moveFileOverwrite' "test/FileSystem/FileOperations/moveFileOverwriteSpec/myFile"
+                         "test/FileSystem/FileOperations/moveFileOverwriteSpec/noPerms/movedFile"
+        `shouldThrow`
+        (\e -> ioeGetErrorType e == PermissionDenied)
+
+    it "moveFileOverwrite, can't open source directory" $
+      moveFileOverwrite' "test/FileSystem/FileOperations/moveFileOverwriteSpec/noPerms/myFile"
+                         "test/FileSystem/FileOperations/moveFileOverwriteSpec/movedFile"
+        `shouldThrow`
+        (\e -> ioeGetErrorType e == PermissionDenied)
+
+    -- custom failures --
+    it "moveFileOverwrite, move from file to dir" $
+      moveFileOverwrite' "test/FileSystem/FileOperations/moveFileOverwriteSpec/myFile"
+                         "test/FileSystem/FileOperations/moveFileOverwriteSpec/alreadyExistsD"
+        `shouldThrow`
+        isDirDoesExist
+
+    it "moveFileOverwrite, source and dest are same file" $
+      moveFileOverwrite' "test/FileSystem/FileOperations/moveFileOverwriteSpec/myFile"
+                         "test/FileSystem/FileOperations/moveFileOverwriteSpec/myFile"
+        `shouldThrow`
+        isSameFile
+

test/FileSystem/FileOperations/moveFileOverwriteSpec/myFile

@@ -0,0 +1,4 @@
+asd
+sda
+
+sda

test/FileSystem/FileOperations/moveFileOverwriteSpec/myFileL

@@ -0,0 +1 @@
+myFile

test/Spec.hs

@@ -14,6 +14,7 @@ import FileSystem.FileOperations.DeleteFileSpec
 import FileSystem.FileOperations.GetDirsFilesSpec
 import FileSystem.FileOperations.GetFileTypeSpec
 import FileSystem.FileOperations.MoveFileSpec
+import FileSystem.FileOperations.MoveFileOverwriteSpec
 import FileSystem.FileOperations.RecreateSymlinkSpec
 import FileSystem.FileOperations.RenameFileSpec
 import Utils
@@ -32,6 +33,7 @@ main = hspec $ before_ fixPermissions $ after_ revertPermissions $ do
               ,createRegularFileSpec
               ,renameFileSpec
               ,moveFileSpec
+              ,moveFileOverwriteSpec
               ,recreateSymlinkSpec
               ,deleteFileSpec
               ,deleteDirSpec
@@ -55,6 +57,7 @@ main = hspec $ before_ fixPermissions $ after_ revertPermissions $ do
                    ,"test/FileSystem/FileOperations/createRegularFileSpec/noWritePerms"
                    ,"test/FileSystem/FileOperations/renameFileSpec/noWritePerm"
                    ,"test/FileSystem/FileOperations/moveFileSpec/noWritePerm"
+                   ,"test/FileSystem/FileOperations/moveFileOverwriteSpec/noWritePerm"
                    ,"test/FileSystem/FileOperations/recreateSymlinkSpec/noWritePerm"
                    ]
     noPermsDirs =  ["test/FileSystem/FileOperations/copyFileSpec/noPerms"
@@ -65,6 +68,7 @@ main = hspec $ before_ fixPermissions $ after_ revertPermissions $ do
                    ,"test/FileSystem/FileOperations/createRegularFileSpec/noPerms"
                    ,"test/FileSystem/FileOperations/renameFileSpec/noPerms"
                    ,"test/FileSystem/FileOperations/moveFileSpec/noPerms"
+                   ,"test/FileSystem/FileOperations/moveFileOverwriteSpec/noPerms"
                    ,"test/FileSystem/FileOperations/recreateSymlinkSpec/noPerms"
                    ,"test/FileSystem/FileOperations/getFileTypeSpec/noPerms"
                    ,"test/FileSystem/FileOperations/getDirsFilesSpec/noPerms"

test/Utils.hs

@@ -109,6 +109,13 @@ moveFile' inputFileP outputFileP =
     moveFile o i
 
 
+moveFileOverwrite' :: ByteString -> ByteString -> IO ()
+moveFileOverwrite' inputFileP outputFileP =
+  withPwd' inputFileP outputFileP $ \i o -> do
+    moveFileOverwrite i o
+    moveFile o i
+
+
 recreateSymlink' :: ByteString -> ByteString -> IO ()
 recreateSymlink' inputFileP outputFileP =
   withPwd' inputFileP outputFileP recreateSymlink