From 5b6a342a9e9ee368d87468211035ab6090aeb94b Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Sun, 8 May 2016 23:20:00 +0200
Subject: [PATCH] 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                                    |  1 +
 src/HSFM/FileSystem/FileOperations.hs         | 17 +++-
 .../FileOperations/MoveFileOverwriteSpec.hs   | 81 +++++++++++++++++++
 .../moveFileOverwriteSpec/dir/.keep           |  0
 .../moveFileOverwriteSpec/myFile              |  4 +
 .../moveFileOverwriteSpec/myFileL             |  1 +
 .../moveFileOverwriteSpec/noPerms/myFile      |  0
 .../moveFileOverwriteSpec/noWritePerm/.keep   |  0
 test/Spec.hs                                  |  4 +
 test/Utils.hs                                 |  7 ++
 10 files changed, 112 insertions(+), 3 deletions(-)
 create mode 100644 test/FileSystem/FileOperations/MoveFileOverwriteSpec.hs
 create mode 100644 test/FileSystem/FileOperations/moveFileOverwriteSpec/dir/.keep
 create mode 100644 test/FileSystem/FileOperations/moveFileOverwriteSpec/myFile
 create mode 120000 test/FileSystem/FileOperations/moveFileOverwriteSpec/myFileL
 create mode 100644 test/FileSystem/FileOperations/moveFileOverwriteSpec/noPerms/myFile
 create mode 100644 test/FileSystem/FileOperations/moveFileOverwriteSpec/noWritePerm/.keep

diff --git a/hsfm.cabal b/hsfm.cabal
index e081d71..7d46d46 100644
--- a/hsfm.cabal
+++ b/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
diff --git a/src/HSFM/FileSystem/FileOperations.hs b/src/HSFM/FileSystem/FileOperations.hs
index 691e742..87fc25a 100644
--- a/src/HSFM/FileSystem/FileOperations.hs
+++ b/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
 
 
diff --git a/test/FileSystem/FileOperations/MoveFileOverwriteSpec.hs b/test/FileSystem/FileOperations/MoveFileOverwriteSpec.hs
new file mode 100644
index 0000000..489883c
--- /dev/null
+++ b/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
+
diff --git a/test/FileSystem/FileOperations/moveFileOverwriteSpec/dir/.keep b/test/FileSystem/FileOperations/moveFileOverwriteSpec/dir/.keep
new file mode 100644
index 0000000..e69de29
diff --git a/test/FileSystem/FileOperations/moveFileOverwriteSpec/myFile b/test/FileSystem/FileOperations/moveFileOverwriteSpec/myFile
new file mode 100644
index 0000000..1f62e72
--- /dev/null
+++ b/test/FileSystem/FileOperations/moveFileOverwriteSpec/myFile
@@ -0,0 +1,4 @@
+asd
+sda
+
+sda
diff --git a/test/FileSystem/FileOperations/moveFileOverwriteSpec/myFileL b/test/FileSystem/FileOperations/moveFileOverwriteSpec/myFileL
new file mode 120000
index 0000000..c97626f
--- /dev/null
+++ b/test/FileSystem/FileOperations/moveFileOverwriteSpec/myFileL
@@ -0,0 +1 @@
+myFile
\ No newline at end of file
diff --git a/test/FileSystem/FileOperations/moveFileOverwriteSpec/noPerms/myFile b/test/FileSystem/FileOperations/moveFileOverwriteSpec/noPerms/myFile
new file mode 100644
index 0000000..e69de29
diff --git a/test/FileSystem/FileOperations/moveFileOverwriteSpec/noWritePerm/.keep b/test/FileSystem/FileOperations/moveFileOverwriteSpec/noWritePerm/.keep
new file mode 100644
index 0000000..e69de29
diff --git a/test/Spec.hs b/test/Spec.hs
index 9c2772c..6e25b02 100644
--- a/test/Spec.hs
+++ b/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"
diff --git a/test/Utils.hs b/test/Utils.hs
index 37c6e05..83ef584 100644
--- a/test/Utils.hs
+++ b/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