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

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

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 export: New command, can create and efficiently update

View file

@ -16,6 +16,7 @@ import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.UTF8 as B8
import qualified Data.ByteString.Lazy.UTF8 as L8
import Network.HTTP.Client (HttpException(..), RequestBody)
import qualified Network.HTTP.Client as HTTP
import Network.HTTP.Types
import System.IO.Error
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 a = catchJust (matchStatusCodeException (const True)) a go
where
go (HttpExceptionRequest _ (StatusCodeException response message)) = error $ unwords
go (HttpExceptionRequest req (StatusCodeException response message)) = giveup $ unwords
[ "DAV failure:"
, show (responseStatus response)
, show (message)
, "HTTP request:"
, show (HTTP.method req)
, show (HTTP.path req)
]
go e = throwM e
#else
prettifyExceptions :: DAVT IO a -> DAVT IO a
prettifyExceptions a = catchJust (matchStatusCodeException (const True)) a go
where
go (StatusCodeException status _ _) = error $ unwords
go (StatusCodeException status _ _) = giveup $ unwords
[ "DAV failure:"
, show (statusCode status)
, show (statusMessage status)