From f6e6671641585fcdf37201df9914842b09392089 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 25 Feb 2014 15:35:45 -0400 Subject: add protocol-level debugging for dav --- Remote/WebDAV.hs | 24 ++++++++++++++++++------ 1 file 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) -- cgit v1.2.3