mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

Avoid backtraces on expected failures when built with ghc 8; only use backtraces for unexpected errors.

Browse source 
ghc 8 added backtraces on uncaught errors. This is great, but git-annex was
using error in many places for a error message targeted at the user, in
some known problem case. A backtrace only confuses such a message, so omit it.

Notably, commands like git annex drop that failed due to eg, numcopies,
used to use error, so had a backtrace.

This commit was sponsored by Ethan Aubin.
This commit is contained in:
Joey Hess 2016-11-15 21:29:54 -04:00
parent 69915c6c9b
commit 0a4479b8ec
No known key found for this signature in database
GPG key ID: C910D9222512E3C7
116 changed files with 287 additions and 270 deletions
Download patch file Download diff file Expand all files Collapse all files

14
Remote/S3.hs
View file

@ -136,7 +136,7 @@ s3Setup' new u mcreds c gc
-- Ensure user enters a valid bucket name, since
-- this determines the name of the archive.org item.
let validbucket = replace " " "-" $
fromMaybe (error "specify bucket=") $
fromMaybe (giveup "specify bucket=") $
getBucketName c'
let archiveconfig =
-- IA acdepts x-amz-* as an alias for x-archive-*
@ -252,7 +252,7 @@ retrieve r info Nothing = case getpublicurl info of
return False
Just geturl -> fileRetriever $ \f k p ->
unlessM (downloadUrl k p [geturl k] f) $
error "failed to download content"
giveup "failed to download content"
retrieveCheap :: Key -> AssociatedFile -> FilePath -> Annex Bool
retrieveCheap _ _ _ = return False
@ -301,7 +301,7 @@ checkKey r info (Just h) k = do
checkKey r info Nothing k = case getpublicurl info of
Nothing -> do
warnMissingCredPairFor "S3" (AWS.creds $ uuid r)
error "No S3 credentials configured"
giveup "No S3 credentials configured"
Just geturl -> do
showChecking r
withUrlOptions $ checkBoth (geturl k) (keySize k)
@ -415,7 +415,7 @@ withS3Handle c gc u a = withS3HandleMaybe c gc u $ \mh -> case mh of
Just h -> a h
Nothing -> do
warnMissingCredPairFor "S3" (AWS.creds u)
error "No S3 credentials configured"
giveup "No S3 credentials configured"
withS3HandleMaybe :: RemoteConfig -> RemoteGitConfig -> UUID -> (Maybe S3Handle -> Annex a) -> Annex a
withS3HandleMaybe c gc u a = do
@ -437,7 +437,7 @@ s3Configuration c = cfg
{ S3.s3Port = port
, S3.s3RequestStyle = case M.lookup "requeststyle" c of
Just "path" -> S3.PathStyle
Just s -> error $ "bad S3 requeststyle value: " ++ s
Just s -> giveup $ "bad S3 requeststyle value: " ++ s
Nothing -> S3.s3RequestStyle cfg
}
where
@ -455,7 +455,7 @@ s3Configuration c = cfg
port = let s = fromJust $ M.lookup "port" c in
case reads s of
[(p, _)] -> p
_ -> error $ "bad S3 port value: " ++ s
_ -> giveup $ "bad S3 port value: " ++ s
cfg = S3.s3 proto endpoint False
tryS3 :: Annex a -> Annex (Either S3.S3Error a)
@ -475,7 +475,7 @@ data S3Info = S3Info
extractS3Info :: RemoteConfig -> Annex S3Info
extractS3Info c = do
b <- maybe
(error "S3 bucket not configured")
(giveup "S3 bucket not configured")
(return . T.pack)
(getBucketName c)
let info = S3Info