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,17 +108,16 @@ 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
+	fast <- Annex.getState Annex.fast
+	mstat <- liftIO $ catchMaybeIO $ getFileStatus file
+	case (mstat, fast) of
+		(Just stat, False) -> do
+			filesize <- liftIO $ getFileSize' file stat
+			showAction "checksum"
+			check <$> hashFile hash file filesize
+		_ -> return True
   where
-	go = do
-		fast <- Annex.getState Annex.fast
-		mstat <- liftIO $ catchMaybeIO $ getFileStatus file
-		case (mstat, fast) of
-			(Just stat, False) -> do
-				filesize <- liftIO $ getFileSize' file stat
-				showAction "checksum"
-				check <$> hashFile hash file filesize
-			_ -> return True
 	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.
- - Ie, disk IO error. -}
-catchHardwareFault :: MonadCatch m => m a -> (IOException -> m a) -> m a
-catchHardwareFault a onhardwareerr = catchIO a onlyhw
+{- Catches only IO exceptions of a particular type.
+ - Ie, use HardwareFault to catch disk IO errors. -}
+catchIOErrorType :: MonadCatch m => IOErrorType -> (IOException -> m a) -> m a -> m a
+catchIOErrorType errtype onmatchingerr a = catchIO a onlymatching
   where
-	onlyhw e
-		| ioeGetErrorType e == HardwareFault = onhardwareerr e
+	onlymatching e
+		| ioeGetErrorType e == errtype = onmatchingerr e
 		| otherwise = throwM e