make removeKey throw exceptions

This commit is contained in:
Joey Hess 2020-05-14 14:08:09 -04:00
parent b5ee97f32a
commit 4be94c67c7
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
28 changed files with 134 additions and 111 deletions

View file

@ -226,14 +226,14 @@ removeKeyM d k = liftIO $ removeDirGeneric d (storeDir d k)
{- Removes the directory, which must be located under the topdir.
-
- Succeeds even on directories and contents that do not have write
- permission.
- permission, if it's possible to turn the write bit on.
-
- If the directory does not exist, succeeds as long as the topdir does
- exist. If the topdir does not exist, fails, because in this case the
- remote is not currently accessible and probably still has the content
- we were supposed to remove from it.
-}
removeDirGeneric :: FilePath -> FilePath -> IO Bool
removeDirGeneric :: FilePath -> FilePath -> IO ()
removeDirGeneric topdir dir = do
void $ tryIO $ allowWrite dir
#ifdef mingw32_HOST_OS
@ -241,12 +241,11 @@ removeDirGeneric topdir dir = do
- before it can delete them. -}
void $ tryIO $ mapM_ allowWrite =<< dirContents dir
#endif
ok <- catchBoolIO $ do
removeDirectoryRecursive dir
return True
if ok
then return ok
else doesDirectoryExist topdir <&&> (not <$> doesDirectoryExist dir)
tryNonAsync (removeDirectoryRecursive dir) >>= \case
Right () -> return ()
Left e ->
unlessM (doesDirectoryExist topdir <&&> (not <$> doesDirectoryExist dir)) $
throwM e
checkPresentM :: FilePath -> ChunkConfig -> CheckPresent
checkPresentM d (LegacyChunks _) k = Legacy.checkKey d locations k