generalize catchHardwareFault to catchIOErrorType

Assistant/Threads/XMPPClient.hs

@@ -7,7 +7,7 @@
 
 module Assistant.Threads.XMPPClient where
 
-import Assistant.Common
+import Assistant.Common hiding (ProtocolError)
 import Assistant.XMPP
 import Assistant.XMPP.Client
 import Assistant.NetMessager

Assistant/WebApp/Common.hs

@@ -13,5 +13,5 @@ import Assistant.WebApp.Page as X
 import Assistant.WebApp.Form as X
 import Assistant.WebApp.Types as X
 import Assistant.WebApp.RepoId as X
-import Utility.Yesod as X hiding (textField, passwordField, insertBy, replace, joinPath, deleteBy, delete, insert, Key, Option)
+import Utility.Yesod as X hiding (textField, passwordField, insertBy, replace, joinPath, deleteBy, delete, insert, Key, Option, PermissionDenied)
 import Data.Text as X (Text)

Backend/Hash.hs

@@ -108,9 +108,7 @@ selectExtension f
 
 {- A key's checksum is checked during fsck. -}
 checkKeyChecksum :: Hash -> Key -> FilePath -> Annex Bool
-checkKeyChecksum hash key file = go `catchHardwareFault` hwfault
+checkKeyChecksum hash key file = catchIOErrorType HardwareFault hwfault $ do
-  where
-	go = do
 	fast <- Annex.getState Annex.fast
 	mstat <- liftIO $ catchMaybeIO $ getFileStatus file
 	case (mstat, fast) of
@@ -119,6 +117,7 @@ checkKeyChecksum hash key file = go `catchHardwareFault` hwfault
 			showAction "checksum"
 			check <$> hashFile hash file filesize
 		_ -> return True
+  where
 	expected = keyHash key
 	check s
 		| s == expected = True

Utility/Exception.hs

@@ -20,7 +20,8 @@ module Utility.Exception (
 	catchNonAsync,
 	tryNonAsync,
 	tryWhenExists,
-	catchHardwareFault,
+	catchIOErrorType,
+	IOErrorType(..)
 ) where
 
 import Control.Monad.Catch as X hiding (Handler)
@@ -88,11 +89,11 @@ tryWhenExists a = do
 	v <- tryJust (guard . isDoesNotExistError) a
 	return (eitherToMaybe v)
 
-{- Catches only exceptions caused by hardware faults.
+{- Catches only IO exceptions of a particular type.
- - Ie, disk IO error. -}
+ - Ie, use HardwareFault to catch disk IO errors. -}
-catchHardwareFault :: MonadCatch m => m a -> (IOException -> m a) -> m a
+catchIOErrorType :: MonadCatch m => IOErrorType -> (IOException -> m a) -> m a -> m a
-catchHardwareFault a onhardwareerr = catchIO a onlyhw
+catchIOErrorType errtype onmatchingerr a = catchIO a onlymatching
   where
-	onlyhw e
+	onlymatching e
-		| ioeGetErrorType e == HardwareFault = onhardwareerr e
+		| ioeGetErrorType e == errtype = onmatchingerr e
 		| otherwise = throwM e