summaryrefslogtreecommitdiff
path: root/Remote
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2014-02-25 15:35:45 -0400
committerGravatar Joey Hess <joey@kitenet.net>2014-02-25 15:58:44 -0400
commitf6e6671641585fcdf37201df9914842b09392089 (patch)
tree4df86e1e0d447573c120c87767e81e7d8d6e80fd /Remote
parent156703043d825c4da5f0080106f130d214fc1d46 (diff)
add protocol-level debugging for dav
Diffstat (limited to 'Remote')
-rw-r--r--Remote/WebDAV.hs24
1 files changed, 18 insertions, 6 deletions
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index 301ec537c..737b98fa7 100644
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -23,6 +23,7 @@ import Network.HTTP.Client (HttpException(..))
import Network.HTTP.Conduit (HttpException(..))
#endif
import Network.HTTP.Types
+import System.Log.Logger (debugM)
import System.IO.Error
import System.FilePath.Posix ((</>), addTrailingPathSeparator)
@@ -312,12 +313,16 @@ contentType = Just $ B8.fromString "application/octet-stream"
throwIO :: String -> IO a
throwIO msg = ioError $ mkIOError userErrorType msg Nothing Nothing
+debugDAV :: DavUrl -> String -> IO ()
+debugDAV msg url = debugM "DAV" $ msg ++ " " ++ url
+
{---------------------------------------------------------------------
- Low-level DAV operations, using the new DAV monad when available.
---------------------------------------------------------------------}
putDAV :: DavUrl -> DavUser -> DavPass -> L.ByteString -> IO ()
-putDAV url user pass b =
+putDAV url user pass b = do
+ debugDAV "PUT" url
#if MIN_VERSION_DAV(0,6,0)
goDAV url user pass $ putContentM (contentType, b)
#else
@@ -325,7 +330,9 @@ putDAV url user pass b =
#endif
getDAV :: DavUrl -> DavUser -> DavPass -> IO (Maybe L.ByteString)
-getDAV url user pass = eitherToMaybe <$> tryNonAsync go
+getDAV url user pass = do
+ debugDAV "GET" url
+ eitherToMaybe <$> tryNonAsync go
where
#if MIN_VERSION_DAV(0,6,0)
go = goDAV url user pass $ snd <$> getContentM
@@ -334,7 +341,8 @@ getDAV url user pass = eitherToMaybe <$> tryNonAsync go
#endif
deleteDAV :: DavUrl -> DavUser -> DavPass -> IO ()
-deleteDAV url user pass =
+deleteDAV url user pass = do
+ debugDAV "DELETE" url
#if MIN_VERSION_DAV(0,6,0)
goDAV url user pass delContentM
#else
@@ -342,7 +350,8 @@ deleteDAV url user pass =
#endif
moveDAV :: DavUrl -> DavUrl -> DavUser -> DavPass -> IO ()
-moveDAV url newurl user pass =
+moveDAV url newurl user pass = do
+ debugDAV ("MOVE to " ++ newurl ++ " from ") url
#if MIN_VERSION_DAV(0,6,0)
goDAV url user pass $ moveContentM newurl'
#else
@@ -352,7 +361,8 @@ moveDAV url newurl user pass =
newurl' = B8.fromString newurl
mkdirDAV :: DavUrl -> DavUser -> DavPass -> IO Bool
-mkdirDAV url user pass =
+mkdirDAV url user pass = do
+ debugDAV "MKDIR" url
#if MIN_VERSION_DAV(0,6,0)
goDAV url user pass mkCol
#else
@@ -360,7 +370,9 @@ mkdirDAV url user pass =
#endif
existsDAV :: DavUrl -> DavUser -> DavPass -> IO (Either String Bool)
-existsDAV url user pass = either (Left . show) id <$> tryNonAsync check
+existsDAV url user pass = do
+ debugDAV "EXISTS" url
+ either (Left . show) id <$> tryNonAsync check
where
ispresent = return . Right
#if MIN_VERSION_DAV(0,6,0)