From 69ef3f1025fb32a19f03517d072c1e64dcb326b7 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 7 Aug 2014 21:55:44 -0400 Subject: unify exception handling into Utility.Exception Removed old extensible-exceptions, only needed for very old ghc. Made webdav use Utility.Exception, to work after some changes in DAV's exception handling. Removed Annex.Exception. Mostly this was trivial, but note that tryAnnex is replaced with tryNonAsync and catchAnnex replaced with catchNonAsync. In theory that could be a behavior change, since the former caught all exceptions, and the latter don't catch async exceptions. However, in practice, nothing in the Annex monad uses async exceptions. Grepping for throwTo and killThread only find stuff in the assistant, which does not seem related. Command.Add.undo is changed to accept a SomeException, and things that use it for rollback now catch non-async exceptions, rather than only IOExceptions. --- Remote/Ddar.hs | 1 - Remote/External.hs | 3 +-- Remote/External/Types.hs | 1 - Remote/GCrypt.hs | 2 +- Remote/Git.hs | 4 +--- Remote/Helper/Chunked.hs | 15 +++++++-------- Remote/Helper/Special.hs | 4 +--- Remote/WebDAV.hs | 12 +++++------- 8 files changed, 16 insertions(+), 26 deletions(-) (limited to 'Remote') diff --git a/Remote/Ddar.hs b/Remote/Ddar.hs index fba05312b..beeb4d7cc 100644 --- a/Remote/Ddar.hs +++ b/Remote/Ddar.hs @@ -8,7 +8,6 @@ module Remote.Ddar (remote) where -import Control.Exception import qualified Data.Map as M import qualified Data.ByteString.Lazy as L import System.IO.Error diff --git a/Remote/External.hs b/Remote/External.hs index f326f26ba..4fb760afd 100644 --- a/Remote/External.hs +++ b/Remote/External.hs @@ -21,7 +21,6 @@ import Logs.PreferredContent.Raw import Logs.RemoteState import Config.Cost import Annex.UUID -import Annex.Exception import Creds import Control.Concurrent.STM @@ -137,7 +136,7 @@ checkKey external k = either error id <$> go _ -> Nothing safely :: Annex Bool -> Annex Bool -safely a = go =<< tryAnnex a +safely a = go =<< tryNonAsync a where go (Right r) = return r go (Left e) = do diff --git a/Remote/External/Types.hs b/Remote/External/Types.hs index 983764f70..3a69ae9ea 100644 --- a/Remote/External/Types.hs +++ b/Remote/External/Types.hs @@ -32,7 +32,6 @@ module Remote.External.Types ( ) where import Common.Annex -import Annex.Exception import Types.Key (file2key, key2file) import Types.StandardGroups (PreferredContentExpression) import Utility.Metered (BytesProcessed(..)) diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs index 55a775811..8891977f7 100644 --- a/Remote/GCrypt.hs +++ b/Remote/GCrypt.hs @@ -15,7 +15,7 @@ module Remote.GCrypt ( import qualified Data.Map as M import qualified Data.ByteString.Lazy as L -import Control.Exception.Extensible +import Control.Exception import Common.Annex import Types.Remote diff --git a/Remote/Git.hs b/Remote/Git.hs index da5ca4c4a..34c60d98f 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -27,7 +27,6 @@ import qualified Annex import Logs.Presence import Annex.Transfer import Annex.UUID -import Annex.Exception import qualified Annex.Content import qualified Annex.BranchState import qualified Annex.Branch @@ -56,7 +55,6 @@ import Creds import Control.Concurrent import Control.Concurrent.MSampleVar import qualified Data.Map as M -import Control.Exception.Extensible remote :: RemoteType remote = RemoteType { @@ -281,7 +279,7 @@ tryGitConfigRead r s <- Annex.new r Annex.eval s $ do Annex.BranchState.disableUpdate - void $ tryAnnex $ ensureInitialized + void $ tryNonAsync $ ensureInitialized Annex.getState Annex.repo {- Checks if a given remote has the content for a key in its annex. -} diff --git a/Remote/Helper/Chunked.hs b/Remote/Helper/Chunked.hs index 953c533b6..5e4ea111f 100644 --- a/Remote/Helper/Chunked.hs +++ b/Remote/Helper/Chunked.hs @@ -24,7 +24,6 @@ import Logs.Chunk import Utility.Metered import Crypto (EncKey) import Backend (isStableKey) -import Annex.Exception import qualified Data.ByteString.Lazy as L import qualified Data.Map as M @@ -172,7 +171,7 @@ seekResume h chunkkeys checker = do liftIO $ hSeek h AbsoluteSeek sz return (cks, toBytesProcessed sz) | otherwise = do - v <- tryNonAsyncAnnex (checker k) + v <- tryNonAsync (checker k) case v of Right True -> check pos' cks' sz @@ -231,7 +230,7 @@ retrieveChunks retriever u chunkconfig encryptor basek dest basep sink -- Optimisation: Try the unchunked key first, to avoid -- looking in the git-annex branch for chunk counts -- that are likely not there. - getunchunked `catchNonAsyncAnnex` + getunchunked `catchNonAsync` const (go =<< chunkKeysOnly u basek) | otherwise = go =<< chunkKeys u chunkconfig basek where @@ -241,7 +240,7 @@ retrieveChunks retriever u chunkconfig encryptor basek dest basep sink let ls' = maybe ls (setupResume ls) currsize if any null ls' then return True -- dest is already complete - else firstavail currsize ls' `catchNonAsyncAnnex` giveup + else firstavail currsize ls' `catchNonAsync` giveup giveup e = do warning (show e) @@ -251,20 +250,20 @@ retrieveChunks retriever u chunkconfig encryptor basek dest basep sink firstavail currsize ([]:ls) = firstavail currsize ls firstavail currsize ((k:ks):ls) | k == basek = getunchunked - `catchNonAsyncAnnex` (const $ firstavail currsize ls) + `catchNonAsync` (const $ firstavail currsize ls) | otherwise = do let offset = resumeOffset currsize k let p = maybe basep (offsetMeterUpdate basep . toBytesProcessed) offset - v <- tryNonAsyncAnnex $ + v <- tryNonAsync $ retriever (encryptor k) p $ \content -> bracketIO (maybe opennew openresume offset) hClose $ \h -> do void $ tosink (Just h) p content let sz = toBytesProcessed $ fromMaybe 0 $ keyChunkSize k getrest p h sz sz ks - `catchNonAsyncAnnex` giveup + `catchNonAsync` giveup case v of Left e | null ls -> giveup e @@ -372,7 +371,7 @@ checkPresentChunks checker u chunkconfig encryptor basek Right False -> return $ Right False Left e -> return $ Left $ show e - check = tryNonAsyncAnnex . checker . encryptor + check = tryNonAsync . checker . encryptor {- A key can be stored in a remote unchunked, or as a list of chunked keys. - This can be the case whether or not the remote is currently configured diff --git a/Remote/Helper/Special.hs b/Remote/Helper/Special.hs index fc0e11d2f..ba9ff4fb4 100644 --- a/Remote/Helper/Special.hs +++ b/Remote/Helper/Special.hs @@ -42,13 +42,11 @@ import Remote.Helper.Chunked as X import Remote.Helper.Encryptable as X import Remote.Helper.Messages import Annex.Content -import Annex.Exception import qualified Git import qualified Git.Command import qualified Git.Construct import qualified Data.ByteString.Lazy as L -import Control.Exception (bracket) import qualified Data.Map as M {- Special remotes don't have a configured url, so Git.Repo does not @@ -174,7 +172,7 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp cip = cipherKey c gpgopts = getGpgEncParams encr - safely a = catchNonAsyncAnnex a (\e -> warning (show e) >> return False) + safely a = catchNonAsync a (\e -> warning (show e) >> return False) -- chunk, then encrypt, then feed to the storer storeKeyGen k p enc = safely $ preparestorer k $ safely . go diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs index b70001ddb..4caebaf21 100644 --- a/Remote/WebDAV.hs +++ b/Remote/WebDAV.hs @@ -14,10 +14,10 @@ import qualified Data.Map as M import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.UTF8 as B8 import qualified Data.ByteString.Lazy.UTF8 as L8 -import qualified Control.Exception.Lifted as EL import Network.HTTP.Client (HttpException(..)) import Network.HTTP.Types import System.IO.Error +import Control.Monad.Catch import Common.Annex import Types.Remote @@ -31,7 +31,6 @@ import Creds import Utility.Metered import Utility.Url (URLString) import Annex.UUID -import Annex.Exception import Remote.WebDAV.DavLocation remote :: RemoteType @@ -301,11 +300,11 @@ moveDAV baseurl src dest = inLocation src $ moveContentM newurl newurl = B8.fromString (locationUrl baseurl dest) existsDAV :: DavLocation -> DAVT IO (Either String Bool) -existsDAV l = inLocation l check `EL.catch` (\(e :: EL.SomeException) -> return (Left $ show e)) +existsDAV l = inLocation l check `catchNonAsync` (\e -> return (Left $ show e)) where check = do setDepth Nothing - EL.catchJust + catchJust (matchStatusCodeException notFound404) (getPropsM >> ispresent True) (const $ ispresent False) @@ -319,8 +318,7 @@ matchStatusCodeException _ _ = Nothing -- Ignores any exceptions when performing a DAV action. safely :: DAVT IO a -> DAVT IO (Maybe a) -safely a = (Just <$> a) - `EL.catch` (\(_ :: EL.SomeException) -> return Nothing) +safely = eitherToMaybe <$$> tryNonAsync choke :: IO (Either String a) -> IO a choke f = do @@ -336,7 +334,7 @@ withDAVHandle r a = do mcreds <- getCreds (config r) (uuid r) case (mcreds, configUrl r) of (Just (user, pass), Just baseurl) -> - bracketIO (mkDAVContext baseurl) closeDAVContext $ \ctx -> + withDAVContext baseurl $ \ctx -> a (Just (DavHandle ctx (toDavUser user) (toDavPass pass) baseurl)) _ -> a Nothing -- cgit v1.2.3