DAV 1.2 → 1.3

raw patch · 3 files changed

+102/−71 lines, 3 filesdep +haskelinedep ~mtlPVP ok

version bump matches the API change (PVP)

Dependencies added: haskeline

Dependency ranges changed: mtl

API changes (from Hackage documentation)

Files

• DAV.cabal +17/−7
• Network/Protocol/HTTP/DAV.hs +8/−5
• hdav.hs +77/−59

@@ -1,5 +1,5 @@ name:                DAV-version:             1.2+version:             1.3 synopsis:            RFC 4918 WebDAV support description:    This is a library for the Web Distributed Authoring and Versioning@@ -15,7 +15,7 @@ license-file:        LICENSE author:              Clint Adams maintainer:          clint@debian.org-copyright:           Copyright (C) 2012-2015  Clint Adams+copyright:           Copyright (C) 2012-2016  Clint Adams category:            Web build-type:          Simple cabal-version:       >=1.8@@ -25,6 +25,10 @@   description: Get Network.URI from the network-uri package   default: True +flag mtl-compat+  description: Get Control.Monad.Except from the mtl-compat package+  default: False+ library   exposed-modules:  Network.Protocol.HTTP.DAV   other-modules:    Network.Protocol.HTTP.DAV.TH@@ -39,14 +43,17 @@                      , http-client-tls >= 0.2                      , http-types >= 0.7                      , lens >= 3.0-                     , mtl >= 2.1-                     , mtl-compat                      , transformers >= 0.3                      , transformers-base                      , transformers-compat >= 0.3                      , utf8-string                      , xml-conduit >= 1.0                      , xml-hamlet >= 0.4           && < 0.5+  if flag(mtl-compat)+    build-depends: mtl >= 2.1 && < 2.2.1, mtl-compat+  else+    build-depends: mtl >= 2.2.1+ executable hdav   main-is:           hdav.hs   ghc-options:       -Wall@@ -57,12 +64,11 @@                      , containers                      , data-default                      , exceptions >= 0.7+                     , haskeline                      , http-client >= 0.4                      , http-client-tls >= 0.2                      , http-types >= 0.7                      , lens >= 3.0-                     , mtl >= 2.1-                     , mtl-compat                      , optparse-applicative >= 0.10.0                      , transformers >= 0.3                      , transformers-base@@ -70,6 +76,10 @@                      , utf8-string                      , xml-conduit >= 1.0                      , xml-hamlet >= 0.4           && < 0.5+  if flag(mtl-compat)+    build-depends: mtl >= 2.1 && < 2.2.1, mtl-compat+  else+    build-depends: mtl >= 2.2.1   if flag(network-uri)     build-depends: network-uri >= 2.6, network >= 2.6   else@@ -83,4 +93,4 @@ source-repository this   type:     git   location: git://anonscm.debian.org/users/clint/DAV.git-  tag:      DAV/1.2+  tag:      DAV/1.3

@@ -1,5 +1,5 @@ -- DAV.hs: WebDAV client library--- Copyright © 2012-2015  Clint Adams+-- Copyright © 2012-2016  Clint Adams -- -- vim: softtabstop=4:shiftwidth=4:expandtab --@@ -19,7 +19,7 @@ {-# LANGUAGE OverloadedStrings, ConstraintKinds, FlexibleContexts,              QuasiQuotes, RankNTypes, GeneralizedNewtypeDeriving,              FlexibleInstances, MultiParamTypeClasses, UndecidableInstances,-             TypeFamilies #-}+             TypeFamilies, CPP #-}  module Network.Protocol.HTTP.DAV (     DAVT(..)@@ -52,12 +52,15 @@  import Network.Protocol.HTTP.DAV.TH -import Control.Applicative (liftA2, Alternative, Applicative)+#if !MIN_VERSION_base(4,8,0)+import Control.Applicative (Applicative)+#endif+import Control.Applicative (liftA2, Alternative) import Control.Monad.Trans.Except (ExceptT(..), throwE, runExceptT) import Control.Lens ((^.), (.=), (%=), (.~)) import Control.Monad (when, MonadPlus) import Control.Monad.Base (MonadBase(..))-import Control.Monad.Catch (bracket, bracketOnError, catchJust, finally, throwM, mask, uninterruptibleMask, MonadCatch, MonadThrow)+import Control.Monad.Catch (catchJust, throwM, MonadCatch, MonadThrow) import qualified Control.Monad.Catch as MonadCatch import Control.Monad.Except (MonadError, catchError, throwError) import Control.Monad.Fix (MonadFix)@@ -76,7 +79,7 @@  import Network.HTTP.Client (RequestBody(..), httpLbs, parseUrl, applyBasicAuth, Request(..), Response(..), newManager, HttpException(..), BodyReader, withResponse, path) import Network.HTTP.Client.TLS (tlsManagerSettings)-import Network.HTTP.Types (hContentType, Method, Status, RequestHeaders, unauthorized401, conflict409)+import Network.HTTP.Types (hContentType, Method, Status, RequestHeaders, conflict409)  import qualified Text.XML as XML import Text.XML.Cursor (($/), (&/), element, node, fromDocument, checkName)

@@ -1,7 +1,5 @@-{-# LANGUAGE FlexibleContexts #-}- -- hdav.hs: WebDAV client--- Copyright © 2012-2014  Clint Adams+-- Copyright © 2012-2016  Clint Adams -- -- vim: softtabstop=4:shiftwidth=4:expandtab --@@ -18,20 +16,23 @@ -- You should have received a copy of the GNU General Public License -- along with this program.  If not, see <http://www.gnu.org/licenses/>. -import qualified Data.ByteString.Char8 as BC8+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}  import Paths_DAV (version)-import Control.Applicative ((<$>),(<*>), optional, pure)+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.UTF8 as BU+#if !MIN_VERSION_base(4,8,0)+import Control.Applicative ((<$>),(<*>), pure)+#endif+import Control.Applicative (optional) import Control.Monad (liftM2, unless) import Control.Monad.IO.Class (MonadIO) import Data.Version (showVersion)-import Data.Maybe (fromMaybe) import Data.Monoid ((<>))-import Text.XML (renderLBS, def)-import qualified Data.ByteString.Lazy.Char8 as B  import Network (withSocketsDo)- import Network.URI (normalizePathSegments)  import Network.Protocol.HTTP.DAV (DAVT, evalDAVT, setCreds, setDepth, setUserAgent, getPropsM, getContentM, putContentM, putPropsM, delContentM, moveContentM, mkCol, Depth(..), caldavReportM, withLockIfPossible, withLockIfPossibleForDelete)@@ -40,13 +41,18 @@ import Options.Applicative.Extra (customExecParser) import Options.Applicative.Types (Parser) +import System.Console.Haskeline (runInputT, getPassword)+import qualified System.Console.Haskeline as SCH++import Text.XML (renderLBS, def)+ data Options = Options {     url :: String   , url2 :: String-  , username :: String-  , password :: String-  , username2 :: String-  , password2 :: String+  , username :: Maybe String+  , password :: Maybe String+  , username2 :: Maybe String+  , password2 :: Maybe String }  data Command = Copy Options | Move Options | Delete Options | MakeCollection Options | GetProps Options (Maybe Depth) | Put FilePath Options | CaldavReport Options@@ -55,104 +61,108 @@ oneUUP = Options     <$> argument str ( metavar "URL" )     <*> pure ""-    <*> (fromMaybe "" <$> (optional $ strOption+    <*> (optional $ strOption         ( long "username"        <> metavar "USERNAME"-       <> help "username for URL" )))-    <*> (fromMaybe "" <$> (optional $ strOption+       <> help "username for URL" ))+    <*> (optional $ strOption         ( long "password"        <> metavar "PASSWORD"-       <> help "password for URL" )))-    <*> pure ""-    <*> pure ""+       <> help "password for URL" ))+    <*> pure Nothing+    <*> pure Nothing  twoUUP :: Parser Options twoUUP = Options     <$> argument str ( metavar "SOURCEURL" )     <*> argument str ( metavar "TARGETURL" )-    <*> (fromMaybe "" <$> (optional $ strOption+    <*> (optional $ strOption         ( long "source-username"        <> metavar "USERNAME"-       <> help "username for source URL" )))-    <*> (fromMaybe "" <$> (optional $ strOption+       <> help "username for source URL" ))+    <*> (optional $ strOption         ( long "source-password"        <> metavar "PASSWORD"-       <> help "password for source URL" )))-    <*> (fromMaybe "" <$> (optional $ strOption+       <> help "password for source URL" ))+    <*> (optional $ strOption         ( long "target-username"        <> metavar "USERNAME"-       <> help "username for target URL" )))-    <*> (fromMaybe "" <$> (optional $ strOption+       <> help "username for target URL" ))+    <*> (optional $ strOption         ( long "target-password"        <> metavar "PASSWORD"-       <> help "password for target URL" )))+       <> help "password for target URL" ))  twoUoneUP :: Parser Options twoUoneUP = Options     <$> argument str ( metavar "SOURCEURL" )     <*> argument str ( metavar "TARGETURL" )-    <*> (fromMaybe "" <$> (optional $ strOption+    <*> (optional $ strOption         ( long "username"        <> metavar "USERNAME"-       <> help "username for URL" )))-    <*> (fromMaybe "" <$> (optional $ strOption+       <> help "username for URL" ))+    <*> (optional $ strOption         ( long "password"        <> metavar "PASSWORD"-       <> help "password for URL" )))-    <*> pure ""-    <*> pure ""+       <> help "password for URL" ))+    <*> pure Nothing+    <*> pure Nothing  doCopy :: Options -> IO () doCopy o = do+     (sourceUsername, sourcePassword) <- ingestCreds ("source URL " ++ sourceurl) (username o) (password o)+     (targetUsername, targetPassword) <- ingestCreds ("target URL " ++ targeturl) (username2 o) (password2 o)      (p, b) <- runDAV sourceurl $ setCreds sourceUsername sourcePassword >> setDepth (Just Depth0) >> withLockIfPossible True (liftM2 (,) getPropsM getContentM)      runDAV targeturl $ setCreds targetUsername targetPassword >> withLockIfPossible False (putContentM b >> putPropsM p)      where          sourceurl = url o          targeturl = url2 o-         sourceUsername = BC8.pack $ username o-         sourcePassword = BC8.pack $ password o-         targetUsername = BC8.pack $ username2 o-         targetPassword = BC8.pack $ password2 o  doDelete :: Options -> IO ()-doDelete o = runDAV (url o) $ setCreds (BC8.pack $ username o) (BC8.pack $ password o) >> withLockIfPossibleForDelete False delContentM+doDelete o = do+    (u, p) <- ingestCreds ("URL " ++ url o) (username o) (password o)+    runDAV (url o) $ setCreds u p >> withLockIfPossibleForDelete False delContentM  doMove :: Options -> IO ()-doMove o = runDAV (url o) $ setCreds (BC8.pack $ username o) (BC8.pack $ password o) >> moveContentM (BC8.pack $ url2 o)+doMove o = do+    (u, p) <- ingestCreds ("URL " ++ url o) (username o) (password o)+    runDAV (url o) $ setCreds u p >> moveContentM (BU.fromString $ url2 o)  doMakeCollection :: Options -> IO ()-doMakeCollection o = go (url o)+doMakeCollection o = do+    (u, p) <- ingestCreds ("URL " ++ url o) (username o) (password o)+    go (url o) (u, p)   where-     u = BC8.pack . username $ o-     p = BC8.pack . password $ o--     go url' = do-       ok <- makeCollection url'+     go url' (u, p) = do+       ok <- makeCollection url' (u, p)        unless ok $ do-         go (parent url')-         ok' <- makeCollection url'+         go (parent url') (u, p)+         ok' <- makeCollection url' (u, p)          unless ok' $            error $ "failed creating " ++ url'       parent url' = reverse $ dropWhile (== '/')$ reverse $         normalizePathSegments (url' ++ "/..") -     makeCollection url' = runDAV url' $ setCreds u p >> mkCol+     makeCollection url' (u, p) = runDAV url' $ setCreds u p >> mkCol  doGetProps :: Options -> Maybe Depth -> IO () doGetProps o md = do-     doc <- runDAV (url o) $ setCreds (BC8.pack $ username o) (BC8.pack $ password o) >> setDepth md >> getPropsM-     B.putStrLn (renderLBS def doc)+    (u, p) <- ingestCreds ("URL " ++ url o) (username o) (password o)+    doc <- runDAV (url o) $ setCreds u p >> setDepth md >> getPropsM+    BL.putStr (renderLBS def doc)  doPut :: FilePath -> Options -> IO () doPut file o = do-     bs <- B.readFile file-     runDAV (url o) $ setCreds (BC8.pack $ username o) (BC8.pack $ password o) >> putContentM (Nothing, bs)+    (u, p) <- ingestCreds ("URL " ++ url o) (username o) (password o)+    bs <- BL.readFile file+    runDAV (url o) $ setCreds u p >> putContentM (Nothing, bs)  doReport :: Options -> IO () doReport o = do-     doc <- runDAV (url o) $ setCreds (BC8.pack $ username o) (BC8.pack $ password o) >> setDepth (Just Depth1) >> caldavReportM-     B.putStrLn (renderLBS def doc)+    (u, p) <- ingestCreds ("URL " ++ url o) (username o) (password o)+    doc <- runDAV (url o) $ setCreds u p >> setDepth (Just Depth1) >> caldavReportM+    BL.putStr (renderLBS def doc)  dispatch :: Command -> IO () dispatch (Copy o) = doCopy o@@ -165,10 +175,11 @@  main :: IO () main = withSocketsDo $ do-    putStrLn $ "hDAV version " ++ showVersion version ++ ", Copyright (C) 2012-2014  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"+    putStrLn $ concat [+      "hDAV version ", showVersion version, ", Copyright (C) 2012-2016  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"]      customExecParser (prefs showHelpOnError) (info cmd idm) >>= dispatch @@ -187,6 +198,13 @@    depth = option auto ( long "depth" <> metavar "DEPTH" <> help "depth" ) :: Parser Depth  runDAV :: MonadIO m => String -> DAVT m a -> m a-runDAV u f = evalDAVT u (setUserAgent (BC8.pack $ "hDAV/" ++ showVersion version) >> f) >>= \x -> case x of+runDAV u f = evalDAVT u (setUserAgent (BU.fromString $ "hDAV/" ++ showVersion version) >> f) >>= \x -> case x of     Left e -> error e     Right r -> return r++ingestCreds :: String -> Maybe String -> Maybe String -> IO (B.ByteString, B.ByteString)+ingestCreds _ Nothing _ = return (B.empty, B.empty)+ingestCreds _ (Just u) (Just p) = return (BU.fromString u, BU.fromString p)+ingestCreds q (Just u) Nothing = do+    mnewp <- runInputT SCH.defaultSettings $ getPassword (Just '*') (concat ["Password for ", u, " at ", q, ": "])+    return (BU.fromString u, maybe B.empty BU.fromString mnewp)