aboutsummaryrefslogtreecommitdiff
path: root/Remote
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2017-09-28 12:01:58 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2017-09-28 12:01:58 -0400
commit4fd1d116689a33ccab63800f481df84d7fab0571 (patch)
treea5c31714b9499a89e25575e4c9eed637b02259a8 /Remote
parentc6fff2e0b4295712f5e50f6f688a73b427b2d2a7 (diff)
webdav: Improve error message for failed request to include the request method and path.
Diffstat (limited to 'Remote')
-rw-r--r--Remote/WebDAV.hs8
1 files changed, 6 insertions, 2 deletions
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index 495b3f8fc..6714dcbe4 100644
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -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)