deal with http-conduit changing a data type
Pity that the library does not provide a function to extract the status code from the StatusCodeException, so when they had to add a new field, it breaks every single place that does it.
This commit is contained in:
parent
3a210490b7
commit
b117efc19b
3 changed files with 20 additions and 5 deletions
2
Makefile
2
Makefile
|
@ -6,7 +6,7 @@ BASEFLAGS=-Wall -outputdir $(GIT_ANNEX_TMP_BUILD_DIR) -IUtility
|
||||||
# you can turn off some of these features.
|
# you can turn off some of these features.
|
||||||
#
|
#
|
||||||
# If you're using an old version of yesod, enable -DWITH_OLD_YESOD
|
# If you're using an old version of yesod, enable -DWITH_OLD_YESOD
|
||||||
FEATURES?=$(GIT_ANNEX_LOCAL_FEATURES) -DWITH_ASSISTANT -DWITH_S3 -DWITH_WEBDAV -DWITH_WEBAPP -DWITH_PAIRING -DWITH_XMPP -DWITH_DNS
|
FEATURES?=$(GIT_ANNEX_LOCAL_FEATURES) -DWITH_ASSISTANT -DWITH_S3 -DWITH_WEBDAV -DWITH_WEBAPP -DWITH_PAIRING -DWITH_XMPP -DWITH_DNS -DWITH_OLD_HTTP_CONDUIT
|
||||||
|
|
||||||
bins=git-annex
|
bins=git-annex
|
||||||
mans=git-annex.1 git-annex-shell.1
|
mans=git-annex.1 git-annex-shell.1
|
||||||
|
|
|
@ -5,7 +5,13 @@
|
||||||
- Licensed under the GNU GPL version 3 or higher.
|
- Licensed under the GNU GPL version 3 or higher.
|
||||||
-}
|
-}
|
||||||
|
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables, CPP #-}
|
||||||
|
|
||||||
|
#if defined VERSION_http_conduit
|
||||||
|
#if ! MIN_VERSION_http_conduit(1,9,0)
|
||||||
|
#define WITH_OLD_HTTP_CONDUIT
|
||||||
|
#endif
|
||||||
|
#endif
|
||||||
|
|
||||||
module Remote.WebDAV (remote, davCreds, setCredsEnv) where
|
module Remote.WebDAV (remote, davCreds, setCredsEnv) where
|
||||||
|
|
||||||
|
@ -228,7 +234,11 @@ davUrlExists :: DavUrl -> DavUser -> DavPass -> IO (Either String Bool)
|
||||||
davUrlExists url user pass = decode <$> catchHttp (getProps url user pass)
|
davUrlExists url user pass = decode <$> catchHttp (getProps url user pass)
|
||||||
where
|
where
|
||||||
decode (Right _) = Right True
|
decode (Right _) = Right True
|
||||||
|
#ifdef WITH_OLD_HTTP_CONDUIT
|
||||||
decode (Left (Left (StatusCodeException status _)))
|
decode (Left (Left (StatusCodeException status _)))
|
||||||
|
#else
|
||||||
|
decode (Left (Left (StatusCodeException status _ _)))
|
||||||
|
#endif
|
||||||
| statusCode status == statusCode notFound404 = Right False
|
| statusCode status == statusCode notFound404 = Right False
|
||||||
decode (Left e) = Left $ showEitherException e
|
decode (Left e) = Left $ showEitherException e
|
||||||
|
|
||||||
|
@ -275,7 +285,12 @@ catchHttp a = (Right <$> a) `E.catches`
|
||||||
type EitherException = Either HttpException E.IOException
|
type EitherException = Either HttpException E.IOException
|
||||||
|
|
||||||
showEitherException :: EitherException -> String
|
showEitherException :: EitherException -> String
|
||||||
showEitherException (Left (StatusCodeException status _)) = show $ statusMessage status
|
#ifdef WITH_OLD_HTTP_CONDUIT
|
||||||
|
showEitherException (Left (StatusCodeException status _)) =
|
||||||
|
#else
|
||||||
|
showEitherException (Left (StatusCodeException status _ _)) =
|
||||||
|
#endif
|
||||||
|
show $ statusMessage status
|
||||||
showEitherException (Left httpexception) = show httpexception
|
showEitherException (Left httpexception) = show httpexception
|
||||||
showEitherException (Right ioexception) = show ioexception
|
showEitherException (Right ioexception) = show ioexception
|
||||||
|
|
||||||
|
|
4
debian/rules
vendored
4
debian/rules
vendored
|
@ -1,9 +1,9 @@
|
||||||
#!/usr/bin/make -f
|
#!/usr/bin/make -f
|
||||||
|
|
||||||
ifeq (install ok installed,$(shell dpkg-query -W -f '$${Status}' libghc-yesod-dev 2>/dev/null))
|
ifeq (install ok installed,$(shell dpkg-query -W -f '$${Status}' libghc-yesod-dev 2>/dev/null))
|
||||||
export FEATURES=-DWITH_ASSISTANT -DWITH_S3 -DWITH_HOST -DWITH_PAIRING -DWITH_XMPP -DWITH_WEBAPP -DWITH_OLD_YESOD
|
export FEATURES=-DWITH_ASSISTANT -DWITH_S3 -DWITH_HOST -DWITH_PAIRING -DWITH_XMPP -DWITH_OLD_HTTP_CONDUIT -DWITH_WEBAPP -DWITH_OLD_YESOD
|
||||||
else
|
else
|
||||||
export FEATURES=-DWITH_ASSISTANT -DWITH_S3 -DWITH_HOST -DWITH_PAIRING -DWITH_XMPP
|
export FEATURES=-DWITH_ASSISTANT -DWITH_S3 -DWITH_HOST -DWITH_PAIRING -DWITH_XMPP -DWITH_OLD_HTTP_CONDUIT
|
||||||
endif
|
endif
|
||||||
ifeq (install ok installed,$(shell dpkg-query -W -f '$${Status}' libghc-dav-dev 2>/dev/null))
|
ifeq (install ok installed,$(shell dpkg-query -W -f '$${Status}' libghc-dav-dev 2>/dev/null))
|
||||||
export FEATURES:=${FEATURES} -DWITH_WEBDAV
|
export FEATURES:=${FEATURES} -DWITH_WEBDAV
|
||||||
|
|
Loading…
Reference in a new issue