diff options
Diffstat (limited to 'Remote')
| -rw-r--r-- | Remote/Ddar.hs | 1 | ||||
| -rw-r--r-- | Remote/External.hs | 3 | ||||
| -rw-r--r-- | Remote/External/Types.hs | 1 | ||||
| -rw-r--r-- | Remote/GCrypt.hs | 2 | ||||
| -rw-r--r-- | Remote/Git.hs | 4 | ||||
| -rw-r--r-- | Remote/Helper/Chunked.hs | 15 | ||||
| -rw-r--r-- | Remote/Helper/Special.hs | 4 | ||||
| -rw-r--r-- | Remote/WebDAV.hs | 12 |
8 files changed, 16 insertions, 26 deletions
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 |