diff options
| -rw-r--r-- | Assistant/Threads/XMPPClient.hs | 2 | ||||
| -rw-r--r-- | Backend/Hash.hs | 19 | ||||
| -rw-r--r-- | Utility/Exception.hs | 15 |
3 files changed, 18 insertions, 18 deletions
diff --git a/Assistant/Threads/XMPPClient.hs b/Assistant/Threads/XMPPClient.hs index 78d527920..da29c4ae4 100644 --- a/Assistant/Threads/XMPPClient.hs +++ b/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 diff --git a/Backend/Hash.hs b/Backend/Hash.hs index 7f61c4f3e..7967b1714 100644 --- a/Backend/Hash.hs +++ b/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 diff --git a/Utility/Exception.hs b/Utility/Exception.hs index 13000e033..8b110ae6d 100644 --- a/Utility/Exception.hs +++ b/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 |