mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

webdav: Improve error message for failed request to include the request method and path.

Browse source
This commit is contained in:
Joey Hess 2017-09-28 12:01:58 -04:00
parent b614f36873
commit f4746da4ca
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
2 changed files with 13 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

7
CHANGELOG
View file

@ -1,3 +1,10 @@
git-annex (6.20170926) UNRELEASED; urgency=medium
* webdav: Improve error message for failed request to include the request
method and path.
-- Joey Hess <id@joeyh.name> Thu, 28 Sep 2017 12:01:39 -0400
git-annex (6.20170925) unstable; urgency=medium git-annex (6.20170925) unstable; urgency=medium
* git-annex export: New command, can create and efficiently update * git-annex export: New command, can create and efficiently update

8
Remote/WebDAV.hs
View file

@ -16,6 +16,7 @@ import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.UTF8 as B8 import qualified Data.ByteString.UTF8 as B8
import qualified Data.ByteString.Lazy.UTF8 as L8 import qualified Data.ByteString.Lazy.UTF8 as L8
import Network.HTTP.Client (HttpException(..), RequestBody) import Network.HTTP.Client (HttpException(..), RequestBody)
import qualified Network.HTTP.Client as HTTP
import Network.HTTP.Types import Network.HTTP.Types
import System.IO.Error import System.IO.Error
import Control.Monad.Catch import Control.Monad.Catch
@ -378,17 +379,20 @@ goDAV (DavHandle ctx user pass _) a = choke $ run $ prettifyExceptions $ do
prettifyExceptions :: DAVT IO a -> DAVT IO a prettifyExceptions :: DAVT IO a -> DAVT IO a
prettifyExceptions a = catchJust (matchStatusCodeException (const True)) a go prettifyExceptions a = catchJust (matchStatusCodeException (const True)) a go
where where
go (HttpExceptionRequest _ (StatusCodeException response message)) = error $ unwords go (HttpExceptionRequest req (StatusCodeException response message)) = giveup $ unwords
[ "DAV failure:" [ "DAV failure:"
, show (responseStatus response) , show (responseStatus response)
, show (message) , show (message)
, "HTTP request:"
, show (HTTP.method req)
, show (HTTP.path req)
] ]
go e = throwM e go e = throwM e
#else #else
prettifyExceptions :: DAVT IO a -> DAVT IO a prettifyExceptions :: DAVT IO a -> DAVT IO a
prettifyExceptions a = catchJust (matchStatusCodeException (const True)) a go prettifyExceptions a = catchJust (matchStatusCodeException (const True)) a go
where where
go (StatusCodeException status _ _) = error $ unwords go (StatusCodeException status _ _) = giveup $ unwords
[ "DAV failure:" [ "DAV failure:"
, show (statusCode status) , show (statusCode status)
, show (statusMessage status) , show (statusMessage status)