diff options
| -rw-r--r-- | Remote/S3.hs | 8 | ||||
| -rw-r--r-- | Remote/WebDAV.hs | 17 | ||||
| -rw-r--r-- | Utility/Url.hs | 8 | ||||
| -rw-r--r-- | git-annex.cabal | 3 |
4 files changed, 33 insertions, 3 deletions
diff --git a/Remote/S3.hs b/Remote/S3.hs index 4c1bd5784..9563b5a0f 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -49,6 +49,12 @@ import Annex.Content import Annex.Url (withUrlOptions) import Utility.Url (checkBoth, managerSettings, closeManager) +#if MIN_VERSION_http_client(0,5,0) +import Network.HTTP.Client (responseTimeoutNone) +#else +responseTimeoutNone = Nothing +#endif + type BucketName = String remote :: RemoteType @@ -430,7 +436,7 @@ withS3HandleMaybe c gc u a = do where s3cfg = s3Configuration c httpcfg = managerSettings - { managerResponseTimeout = Nothing } + { managerResponseTimeout = responseTimeoutNone } s3Configuration :: RemoteConfig -> S3.S3Configuration AWS.NormalQuery s3Configuration c = cfg diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs index 19dbaa8af..14947f1e9 100644 --- a/Remote/WebDAV.hs +++ b/Remote/WebDAV.hs @@ -5,6 +5,7 @@ - Licensed under the GNU GPL version 3 or higher. -} +{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} module Remote.WebDAV (remote, davCreds, configUrl) where @@ -34,6 +35,10 @@ import Utility.Url (URLString, matchStatusCodeException) import Annex.UUID import Remote.WebDAV.DavLocation +#if MIN_VERSION_http_client(0,5,0) +import Network.HTTP.Client (HttpExceptionContent(..), responseStatus) +#endif + remote :: RemoteType remote = RemoteType { typename = "webdav", @@ -302,6 +307,17 @@ goDAV (DavHandle ctx user pass _) a = choke $ run $ prettifyExceptions $ do {- Catch StatusCodeException and trim it to only the statusMessage part, - eliminating a lot of noise, which can include the whole request that - failed. The rethrown exception is no longer a StatusCodeException. -} +#if MIN_VERSION_http_client(0,5,0) +prettifyExceptions :: DAVT IO a -> DAVT IO a +prettifyExceptions a = catchJust (matchStatusCodeException (const True)) a go + where + go (HttpExceptionRequest _ (StatusCodeException response message)) = error $ unwords + [ "DAV failure:" + , show (responseStatus response) + , show (message) + ] + go e = throwM e +#else prettifyExceptions :: DAVT IO a -> DAVT IO a prettifyExceptions a = catchJust (matchStatusCodeException (const True)) a go where @@ -311,6 +327,7 @@ prettifyExceptions a = catchJust (matchStatusCodeException (const True)) a go , show (statusMessage status) ] go e = throwM e +#endif prepDAV :: DavUser -> DavPass -> DAVT IO () prepDAV user pass = do diff --git a/Utility/Url.hs b/Utility/Url.hs index 9b68871dd..d0e1b3739 100644 --- a/Utility/Url.hs +++ b/Utility/Url.hs @@ -350,8 +350,16 @@ hUserAgent = "User-Agent" - - > catchJust (matchStatusCodeException (== notFound404)) -} +#if MIN_VERSION_http_client(0,5,0) +matchStatusCodeException :: (Status -> Bool) -> HttpException -> Maybe HttpException +matchStatusCodeException want e@(HttpExceptionRequest _ (StatusCodeException r _)) + | want (responseStatus r) = Just e + | otherwise = Nothing +matchStatusCodeException _ _ = Nothing +#else matchStatusCodeException :: (Status -> Bool) -> HttpException -> Maybe HttpException matchStatusCodeException want e@(StatusCodeException s _ _) | want s = Just e | otherwise = Nothing matchStatusCodeException _ _ = Nothing +#endif diff --git a/git-annex.cabal b/git-annex.cabal index ec54a146d..83d45a1d9 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -357,8 +357,7 @@ Executable git-annex resourcet, http-client, http-types, - -- Old version needed due to https://github.com/aristidb/aws/issues/206 - http-conduit (<2.2.0), + http-conduit, time, old-locale, esqueleto, |