aboutsummaryrefslogtreecommitdiff
path: root/Remote
diff options
context:
space:
mode:
authorGravatar Alper Nebi Yasak <alpernebiyasak@gmail.com>2016-12-10 15:24:27 +0300
committerGravatar Joey Hess <joeyh@joeyh.name>2016-12-10 10:45:52 -0400
commitcb5724155e20f247c3d4a987aa6635a8e5de039a (patch)
treeb830e7f95dfc538c7745d0353f0a098a11df7944 /Remote
parentd7b969b0835e7a2b5046c62b7f40a4089c4cc760 (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.hs8
-rw-r--r--Remote/WebDAV.hs17
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