mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

add protocol-level debugging for dav

Browse source
This commit is contained in:
Joey Hess 2014-02-25 15:35:45 -04:00
parent 2b66aaa763
commit b1931d1cc1
1 changed files with 18 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

24
Remote/WebDAV.hs
View file

@ -23,6 +23,7 @@ import Network.HTTP.Client (HttpException(..))
import Network.HTTP.Conduit (HttpException(..)) import Network.HTTP.Conduit (HttpException(..))
#endif #endif
import Network.HTTP.Types import Network.HTTP.Types
import System.Log.Logger (debugM)
import System.IO.Error import System.IO.Error
import System.FilePath.Posix ((</>), addTrailingPathSeparator) import System.FilePath.Posix ((</>), addTrailingPathSeparator)
@ -312,12 +313,16 @@ contentType = Just $ B8.fromString "application/octet-stream"
throwIO :: String -> IO a throwIO :: String -> IO a
throwIO msg = ioError $ mkIOError userErrorType msg Nothing Nothing 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. - Low-level DAV operations, using the new DAV monad when available.
---------------------------------------------------------------------} ---------------------------------------------------------------------}
putDAV :: DavUrl -> DavUser -> DavPass -> L.ByteString -> IO () 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) #if MIN_VERSION_DAV(0,6,0)
goDAV url user pass $ putContentM (contentType, b) goDAV url user pass $ putContentM (contentType, b)
#else #else
@ -325,7 +330,9 @@ putDAV url user pass b =
#endif #endif
getDAV :: DavUrl -> DavUser -> DavPass -> IO (Maybe L.ByteString) 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 where
#if MIN_VERSION_DAV(0,6,0) #if MIN_VERSION_DAV(0,6,0)
go = goDAV url user pass $ snd <$> getContentM go = goDAV url user pass $ snd <$> getContentM
@ -334,7 +341,8 @@ getDAV url user pass = eitherToMaybe <$> tryNonAsync go
#endif #endif
deleteDAV :: DavUrl -> DavUser -> DavPass -> IO () deleteDAV :: DavUrl -> DavUser -> DavPass -> IO ()
deleteDAV url user pass = deleteDAV url user pass = do
debugDAV "DELETE" url
#if MIN_VERSION_DAV(0,6,0) #if MIN_VERSION_DAV(0,6,0)
goDAV url user pass delContentM goDAV url user pass delContentM
#else #else
@ -342,7 +350,8 @@ deleteDAV url user pass =
#endif #endif
moveDAV :: DavUrl -> DavUrl -> DavUser -> DavPass -> IO () 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) #if MIN_VERSION_DAV(0,6,0)
goDAV url user pass $ moveContentM newurl' goDAV url user pass $ moveContentM newurl'
#else #else
@ -352,7 +361,8 @@ moveDAV url newurl user pass =
newurl' = B8.fromString newurl newurl' = B8.fromString newurl
mkdirDAV :: DavUrl -> DavUser -> DavPass -> IO Bool 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) #if MIN_VERSION_DAV(0,6,0)
goDAV url user pass mkCol goDAV url user pass mkCol
#else #else
@ -360,7 +370,9 @@ mkdirDAV url user pass =
#endif #endif
existsDAV :: DavUrl -> DavUser -> DavPass -> IO (Either String Bool) 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 where
ispresent = return . Right ispresent = return . Right
#if MIN_VERSION_DAV(0,6,0) #if MIN_VERSION_DAV(0,6,0)