DAV 0.0.1 → 0.1

raw patch · 3 files changed

+38/−7 lines, 3 filesdep ~http-typesPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: http-types

API changes (from Hackage documentation)

Files

• DAV.cabal +3/−3
• Network/Protocol/HTTP/DAV.hs +19/−2
• hdav.hs +16/−2

@@ -1,5 +1,5 @@ name:                DAV-version:             0.0.1+version:             0.1 synopsis:            RFC 4918 WebDAV support description:    This is a library for the Web Distributed Authoring and Versioning@@ -29,7 +29,7 @@                      , case-insensitive >= 0.4                      , containers                      , http-conduit >= 1.4-                     , http-types >= 0.6+                     , http-types >= 0.7                      , lens >= 3.0                      , lifted-base >= 0.1                      , mtl >= 2.1@@ -47,7 +47,7 @@                      , cmdargs >= 0.9                      , containers                      , http-conduit >= 1.4-                     , http-types >= 0.6+                     , http-types >= 0.7                      , lens >= 3.0                      , lifted-base >= 0.1                      , mtl >= 2.1

@@ -23,13 +23,14 @@   , DAVContext(..)   , getPropsAndContent   , putContentAndProps+  , deleteContent   , module Network.Protocol.HTTP.DAV.TH ) where  import Network.Protocol.HTTP.DAV.TH  import Control.Applicative (liftA2)-import Control.Exception.Lifted (catchJust, finally)+import Control.Exception.Lifted (catchJust, finally, bracketOnError) import Control.Lens ((.~), (^.)) import Control.Monad (when) import Control.Monad.Trans (lift)@@ -135,6 +136,11 @@     _ <- davRequest "PUT" ahs (RequestBodyLBS body)     return () +delContent :: MonadResourceBase m => DAVState m ()+delContent = do+    _ <- davRequest "DELETE" [] emptyBody+    return ()+ parenthesize :: B.ByteString -> B.ByteString parenthesize x = B.concat ["(", x, ")"] @@ -151,10 +157,12 @@    where        props cursor = map node (cursor $/ element "{DAV:}response" &/ element "{DAV:}propstat" &/ element "{DAV:}prop" &/ checkName (not . flip elem blacklist))        patch prop = XML.Document (XML.Prologue [] Nothing []) (root prop) []-       root prop = XML.Element "D:propertyupdate" (Map.fromList [("xmlns:D", "DAV:")])+       root [] = propertyupdate []+       root prop = propertyupdate            [ XML.NodeElement $ XML.Element "D:set" Map.empty 	     [ XML.NodeElement $ XML.Element "D:prop" Map.empty prop ] 	   ]+       propertyupdate = XML.Element "D:propertyupdate" (Map.fromList [("xmlns:D", "DAV:")])        blacklist = [ "{DAV:}creationdate"                    , "{DAV:}displayname"                    , "{DAV:}getcontentlength"@@ -182,6 +190,15 @@     when (supportsLocking o) (lockResource False)     (do putContent b         putProps p) `finally` when (supportsLocking o) (unlockResource)++deleteContent :: String -> B.ByteString -> B.ByteString -> IO ()+deleteContent url username password = withDS url username password $ do+    getOptions+    o <- get+    let lock = when (supportsLocking o) (lockResource False)+    -- a successful delete destroys locks, so only unlock on error+    let unlock = when (supportsLocking o) (unlockResource)+    bracketOnError lock (\_ -> unlock) (\_ -> delContent)  propname :: XML.Document propname = XML.Document (XML.Prologue [] Nothing []) root []

@@ -18,13 +18,15 @@  import qualified Data.ByteString.Char8 as BC8 +import Paths_DAV (version)+import Data.Version (showVersion) import Data.Maybe (fromMaybe, fromJust)  import Network (withSocketsDo)  import qualified System.Console.CmdArgs.Explicit as CA -import Network.Protocol.HTTP.DAV (getPropsAndContent, putContentAndProps)+import Network.Protocol.HTTP.DAV (getPropsAndContent, putContentAndProps, deleteContent)  doCopy :: [(String, String)] -> IO () doCopy as = do@@ -37,9 +39,17 @@      (p, b) <- getPropsAndContent url1 sourceUsername sourcePassword      putContentAndProps url2 targetUsername targetPassword (p, b) +doDelete :: [(String, String)] -> IO ()+doDelete as = do+     let url = fromJust . lookup "url" $ as+     let username = BC8.pack . fromMaybe "" . lookup "username" $ as+     let password = BC8.pack . fromMaybe "" . lookup "password" $ as+     deleteContent url username password+ dispatch :: String -> [(String, String)] -> IO () dispatch m as     | m == "copy" = doCopy as+    | m == "delete" = doDelete as     | otherwise = fail "Unexpected condition."  showHelp :: IO ()@@ -47,7 +57,7 @@  main :: IO () main = withSocketsDo $ do-    putStrLn "hDAV version 0.0.0, Copyright (C) 2012  Clint Adams\n\+    putStrLn $ "hDAV version " ++ showVersion version ++ ", Copyright (C) 2012  Clint Adams\n\    \hDAV comes with ABSOLUTELY NO WARRANTY.\n\    \This is free software, and you are welcome to redistribute it\n\    \under certain conditions.\n\n"@@ -67,5 +77,9 @@ 		, CA.flagReq ["target-username"] (upd "target-username") "USERNAME" "username for target URL" 		, CA.flagReq ["target-password"] (upd "target-password") "PASSWORD" "password for target URL" 		, CA.flagHelpSimple (("help",""):)]) { CA.modeArgs = ([(CA.flagArg (upd "sourceurl") "SOURCEURL") { CA.argRequire = True }, (CA.flagArg (upd "targeturl") "TARGETURL") { CA.argRequire = True }], Nothing) }+              , (CA.mode "delete" [("mode", "delete")] "delete" (CA.flagArg (upd "url") "URL") [+	          CA.flagReq ["username"] (upd "username") "USERNAME" "username for URL"+		, CA.flagReq ["password"] (upd "password") "PASSWORD" "password for URL"+		, CA.flagHelpSimple (("help",""):)]) { CA.modeArgs = ([(CA.flagArg (upd "url") "URL") { CA.argRequire = True }], Nothing) } 	    ]     where upd msg x v = Right $ (msg,x):v