DAV 0.4.1 → 0.5
raw patch · 3 files changed
+21/−18 lines, 3 filesdep +http-clientdep ~http-conduit
Dependencies added: http-client
Dependency ranges changed: http-conduit
Files
- DAV.cabal +6/−4
- Network/Protocol/HTTP/DAV.hs +13/−12
- Network/Protocol/HTTP/DAV/TH.hs +2/−2
DAV.cabal view
@@ -1,5 +1,5 @@ name: DAV-version: 0.4.1+version: 0.5 synopsis: RFC 4918 WebDAV support description: This is a library for the Web Distributed Authoring and Versioning@@ -29,7 +29,8 @@ , bytestring , case-insensitive >= 0.4 , containers- , http-conduit >= 1.9.0+ , http-client >= 0.2+ , http-conduit >= 2 , http-types >= 0.7 , lens >= 3.0 , lifted-base >= 0.1@@ -46,7 +47,8 @@ , bytestring , case-insensitive >= 0.4 , containers- , http-conduit >= 1.9.0+ , http-client >= 0.2+ , http-conduit >= 2 , http-types >= 0.7 , lens >= 3.0 , lifted-base >= 0.1@@ -66,4 +68,4 @@ source-repository this type: git location: git://anonscm.debian.org/users/clint/DAV.git- tag: DAV/0.3+ tag: DAV/0.5
Network/Protocol/HTTP/DAV.hs view
@@ -49,7 +49,8 @@ import Data.Maybe (catMaybes, fromMaybe) -import Network.HTTP.Conduit (httpLbs, parseUrl, applyBasicAuth, Request(..), RequestBody(..), Response(..), newManager, closeManager, ManagerSettings(..), def, HttpException(..))+import Network.HTTP.Client (defaultManagerSettings, RequestBody(..))+import Network.HTTP.Conduit (httpLbs, parseUrl, applyBasicAuth, Request(..), Response(..), newManager, closeManager, ManagerSettings(..), HttpException(..)) import Network.HTTP.Types (hContentType, Method, Status, RequestHeaders, unauthorized401, conflict409) import qualified Text.XML as XML@@ -58,23 +59,23 @@ import Data.CaseInsensitive (mk) -type DAVState m a = StateT (DAVContext m) (ResourceT m) a+type DAVState m a = StateT DAVContext (ResourceT m) a -initialDS :: String -> B.ByteString -> B.ByteString -> Maybe Depth -> ManagerSettings -> IO (DAVContext a)+initialDS :: String -> B.ByteString -> B.ByteString -> Maybe Depth -> ManagerSettings -> IO DAVContext initialDS u username password md s = do mgr <- newManager s req <- parseUrl u return $ DAVContext [] req [] mgr Nothing username password md -closeDS :: DAVContext a -> IO ()+closeDS :: DAVContext -> IO () closeDS = closeManager . _httpManager withDS :: MonadResourceBase m => String -> B.ByteString -> B.ByteString -> Maybe Depth -> DAVState m a -> m a withDS url username password md f = runResourceT $ do- (_, ds) <- allocate (initialDS url username password md def) closeDS+ (_, ds) <- allocate (initialDS url username password md defaultManagerSettings) closeDS evalStateT f ds -davRequest :: MonadResourceBase m => Method -> RequestHeaders -> RequestBody (ResourceT m) -> DAVState m (Response BL.ByteString)+davRequest :: MonadResourceBase m => Method -> RequestHeaders -> RequestBody -> DAVState m (Response BL.ByteString) davRequest meth addlhdrs rbody = do ctx <- get let hdrs = catMaybes@@ -94,10 +95,10 @@ | otherwise = Nothing matchStatusCodeException _ _ = Nothing -emptyBody :: RequestBody m+emptyBody :: RequestBody emptyBody = RequestBodyLBS BL.empty -xmlBody :: XML.Document -> RequestBody m+xmlBody :: XML.Document -> RequestBody xmlBody = RequestBodyLBS . XML.renderLBS XML.def getOptions :: MonadResourceBase m => DAVState m ()@@ -125,17 +126,17 @@ _ <- davRequest "UNLOCK" ahs emptyBody modify (lockToken .~ Nothing) -supportsLocking :: DAVContext a -> Bool+supportsLocking :: DAVContext -> Bool supportsLocking = liftA2 (&&) ("LOCK" `elem`) ("UNLOCK" `elem`) . _allowedMethods -supportsCalDAV :: DAVContext a -> Bool+supportsCalDAV :: DAVContext -> Bool supportsCalDAV = ("calendar-access" `elem`) . _complianceClasses getPropsM :: MonadResourceBase m => DAVState m XML.Document getPropsM = do let ahs = [(hContentType, "application/xml; charset=\"utf-8\"")] propresp <- davRequest "PROPFIND" ahs (xmlBody propname)- return $ (XML.parseLBS_ def . responseBody) propresp+ return $ (XML.parseLBS_ XML.def . responseBody) propresp getContentM :: MonadResourceBase m => DAVState m (Maybe B.ByteString, BL.ByteString) getContentM = do@@ -204,7 +205,7 @@ caldavReportM = do let ahs = [(hContentType, "application/xml; charset=\"utf-8\"")] calrresp <- davRequest "REPORT" ahs (xmlBody calendarquery)- return $ (XML.parseLBS_ def . responseBody) calrresp+ return $ (XML.parseLBS_ XML.def . responseBody) calrresp getProps :: String -> B.ByteString -> B.ByteString -> Maybe Depth -> IO XML.Document getProps url username password md = withDS url username password md getPropsM
Network/Protocol/HTTP/DAV/TH.hs view
@@ -36,9 +36,9 @@ show Depth1 = "1" show DepthInfinity = "infinity" -data DAVContext a = DAVContext {+data DAVContext = DAVContext { _allowedMethods :: [B.ByteString]- , _baseRequest :: Request a+ , _baseRequest :: Request , _complianceClasses :: [B.ByteString] , _httpManager :: Manager , _lockToken :: Maybe B.ByteString