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.
This commit is contained in:
Joey Hess 2014-08-07 21:55:44 -04:00
parent 8e3d62dd5d
commit c784ef4586
60 changed files with 142 additions and 237 deletions

View file

@ -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

View file

@ -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

View file

@ -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(..))

View file

@ -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

View file

@ -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. -}

View file

@ -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

View file

@ -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

View file

@ -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