This commit is contained in:
Joey Hess 2014-02-25 01:55:01 -04:00
parent 003fc2b7e1
commit 06142f4943
Failed to extract signature
2 changed files with 10 additions and 13 deletions

View file

@ -17,7 +17,11 @@ import qualified Data.ByteString.Lazy as L
import Network.URI (normalizePathSegments) import Network.URI (normalizePathSegments)
import qualified Control.Exception as E import qualified Control.Exception as E
import qualified Control.Exception.Lifted as EL import qualified Control.Exception.Lifted as EL
#if MIN_VERSION_DAV(0,6,0)
import Network.HTTP.Client (HttpException(..))
#else
import Network.HTTP.Conduit (HttpException(..)) import Network.HTTP.Conduit (HttpException(..))
#endif
import Network.HTTP.Types import Network.HTTP.Types
import System.IO.Error import System.IO.Error
@ -355,8 +359,9 @@ mkdirDAV url user pass =
#endif #endif
existsDAV :: DavUrl -> DavUser -> DavPass -> IO (Either String Bool) existsDAV :: DavUrl -> DavUser -> DavPass -> IO (Either String Bool)
existsDAV url user pass = either onerr id <$> tryNonAsync check existsDAV url user pass = either (Left . show) id <$> tryNonAsync check
where where
ispresent = return . Right
#if MIN_VERSION_DAV(0,6,0) #if MIN_VERSION_DAV(0,6,0)
check = goDAV url user pass $ do check = goDAV url user pass $ do
setDepth Nothing setDepth Nothing
@ -374,20 +379,12 @@ existsDAV url user pass = either onerr id <$> tryNonAsync check
#endif #endif
(const $ ispresent False) (const $ ispresent False)
#endif #endif
ispresent = return . Right
{- This is a horrible hack, it seems that the type of the
- HttpException gets screwed up with DAV 0.6.x, and so
- I'm reduced to string matching. :( -}
onerr e
| "StatusCodeException" `isInfixOf` show e
&& "statusCode = 404" `isInfixOf` show e = Right False
| otherwise = Left (show e)
matchStatusCodeException :: Status -> HttpException -> Maybe () matchStatusCodeException :: Status -> HttpException -> Maybe ()
#if ! MIN_VERSION_http_conduit(1,9,0) #if MIN_VERSION_DAV(0,6,0)
matchStatusCodeException want (StatusCodeException s _)
#else
matchStatusCodeException want (StatusCodeException s _ _) matchStatusCodeException want (StatusCodeException s _ _)
#else
matchStatusCodeException want (StatusCodeException s _)
#endif #endif
| s == want = Just () | s == want = Just ()
| otherwise = Nothing | otherwise = Nothing

View file

@ -134,7 +134,7 @@ Executable git-annex
if flag(WebDAV) if flag(WebDAV)
Build-Depends: DAV ((>= 0.3 && < 0.6) || > 0.6), Build-Depends: DAV ((>= 0.3 && < 0.6) || > 0.6),
http-conduit, xml-conduit, http-types, lifted-base http-client, http-conduit, http-types, lifted-base
CPP-Options: -DWITH_WEBDAV CPP-Options: -DWITH_WEBDAV
if flag(Assistant) && ! os(solaris) if flag(Assistant) && ! os(solaris)