diff options
author | Joey Hess <joey@kitenet.net> | 2012-12-01 14:32:50 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-12-01 14:32:50 -0400 |
commit | 5b23c50cf75d3f95ac1ed992ee9c8e8d903e1692 (patch) | |
tree | 6dfec3f75e2d2a305233abe1afe8a4634758b316 /Remote | |
parent | aab3d3bd922be355ce0df9616de54c789a2b9411 (diff) |
instrument webdav test
Diffstat (limited to 'Remote')
-rw-r--r-- | Remote/WebDAV.hs | 15 |
1 files changed, 8 insertions, 7 deletions
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs index d6fc35f2e..0611a3e56 100644 --- a/Remote/WebDAV.hs +++ b/Remote/WebDAV.hs @@ -292,14 +292,15 @@ urlParent url = dropTrailingPathSeparator $ testDav :: String -> Maybe CredPair -> Annex () testDav baseurl (Just (u, p)) = do showSideAction "testing WebDAV server" - liftIO $ either (throwIO . showEitherException) (const noop) - =<< catchHttp go + test "make directory" $ davMkdir baseurl user pass + test "write file" $ putContentAndProps testurl user pass + (noProps, (contentType, L.empty)) + test "delete file" $ deleteContent testurl user pass where - go = do - davMkdir baseurl user pass - putContentAndProps testurl user pass - (noProps, (contentType, L.empty)) - deleteContent testurl user pass + test desc a = liftIO $ + either (\e -> throwIO $ "WebDAV failed to " ++ desc ++ ": " ++ showEitherException e) + (const noop) + =<< catchHttp a user = toDavUser u pass = toDavPass p |