diff options
author | Alper Nebi Yasak <alpernebiyasak@gmail.com> | 2016-12-10 15:24:27 +0300 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2016-12-10 10:45:52 -0400 |
commit | cb5724155e20f247c3d4a987aa6635a8e5de039a (patch) | |
tree | b830e7f95dfc538c7745d0353f0a098a11df7944 /Remote | |
parent | d7b969b0835e7a2b5046c62b7f40a4089c4cc760 (diff) |
Remove http-conduit (<2.2.0) constraint
Since https://github.com/aristidb/aws/issues/206 is resolved, this
constraint is no longer necessary. However, http-conduit (>=2.2.0)
requires http-client (>=0.5.0) which introduces some breaking changes.
This commit also implements those changes depending on the version.
Fixes: https://git-annex.branchable.com/bugs/Build_with_aws_head_fails/
Signed-off-by: Alper Nebi Yasak <alpernebiyasak@gmail.com>
Diffstat (limited to 'Remote')
-rw-r--r-- | Remote/S3.hs | 8 | ||||
-rw-r--r-- | Remote/WebDAV.hs | 17 |
2 files changed, 24 insertions, 1 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 |