-- DAV.hs: WebDAV client library
-- Copyright © 2012-2016  Clint Adams
--
-- vim: softtabstop=4:shiftwidth=4:expandtab
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

{-# LANGUAGE OverloadedStrings, ConstraintKinds, FlexibleContexts,
             QuasiQuotes, RankNTypes, GeneralizedNewtypeDeriving,
             FlexibleInstances, MultiParamTypeClasses, UndecidableInstances,
             TypeFamilies, CPP #-}

module Network.Protocol.HTTP.DAV (
    DAVT(..)
  , evalDAVT
  , withDAVContext
  , runDAVContext
  , setCreds
  , setDepth
  , setResponseTimeout
  , setUserAgent
  , DAVContext(..)
  , caldavReportM
  , delContentM
  , getPropsM
  , getContentM
  , withContentM
  , mkCol
  , moveContentM
  , putPropsM
  , putContentM
  , putContentM'
  , withLockIfPossible
  , withLockIfPossibleForDelete
  , inDAVLocation
  , getDAVLocation
  , mkDAVContext
  , closeDAVContext
  , module Network.Protocol.HTTP.DAV.TH
) where

import Network.Protocol.HTTP.DAV.TH

#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 (catchJust, throwM, MonadCatch, MonadThrow)
import qualified Control.Monad.Catch as MonadCatch
import Control.Monad.Except (MonadError, catchError, throwError)
import Control.Monad.Fix (MonadFix)
import Control.Monad.Trans.Class (lift, MonadTrans)
import Control.Monad.IO.Class (liftIO, MonadIO)
import Control.Monad.State (evalStateT, runStateT, get, MonadState, StateT)

import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC8
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.UTF8 as UTF8B
import Data.Default (Default, def)
import qualified Data.Map as Map

import Data.Maybe (catMaybes, fromMaybe)

#if MIN_VERSION_http_client(0,5,0)
import Network.HTTP.Client (defaultRequest, HttpExceptionContent(StatusCodeException), parseUrlThrow, responseTimeoutDefault, responseTimeoutMicro, responseTimeoutNone)
#else
import Network.HTTP.Client (parseUrl)
#endif
import Network.HTTP.Client (RequestBody(..), httpLbs, applyBasicAuth, Request(..), Response(..), newManager, HttpException(..), BodyReader, withResponse, path)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import Network.HTTP.Types (hContentType, Method, Status, RequestHeaders, conflict409)

import qualified Text.XML as XML
import Text.XML.Cursor (($/), (&/), element, node, fromDocument, checkName)
import Text.Hamlet.XML (xml)

import Data.CaseInsensitive (mk)

instance Default DAVContext where
#if MIN_VERSION_http_client(0,5,0)
    def :: DAVContext
def = [ByteString]
-> Request
-> ByteString
-> ByteString
-> [ByteString]
-> Maybe Depth
-> Maybe Manager
-> Maybe ByteString
-> ByteString
-> DAVContext
DAVContext [] Request
defaultRequest ByteString
B.empty ByteString
B.empty [] Maybe Depth
forall a. Maybe a
Nothing Maybe Manager
forall a. Default a => a
def Maybe ByteString
forall a. Maybe a
Nothing "hDav-using application"
#else
    def = DAVContext [] def B.empty B.empty [] Nothing def Nothing "hDav-using application"
#endif

newtype DAVT m a = DAVT { DAVT m a -> ExceptT String (StateT DAVContext m) a
runDAVT :: ExceptT String (StateT DAVContext m) a }
    deriving (Applicative (DAVT m)
DAVT m a
Applicative (DAVT m) =>
(forall a. DAVT m a)
-> (forall a. DAVT m a -> DAVT m a -> DAVT m a)
-> (forall a. DAVT m a -> DAVT m [a])
-> (forall a. DAVT m a -> DAVT m [a])
-> Alternative (DAVT m)
DAVT m a -> DAVT m a -> DAVT m a
DAVT m a -> DAVT m [a]
DAVT m a -> DAVT m [a]
forall a. DAVT m a
forall a. DAVT m a -> DAVT m [a]
forall a. DAVT m a -> DAVT m a -> DAVT m a
forall (m :: * -> *). Monad m => Applicative (DAVT m)
forall (m :: * -> *) a. Monad m => DAVT m a
forall (m :: * -> *) a. Monad m => DAVT m a -> DAVT m [a]
forall (m :: * -> *) a. Monad m => DAVT m a -> DAVT m a -> DAVT m a
forall (f :: * -> *).
Applicative f =>
(forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: DAVT m a -> DAVT m [a]
$cmany :: forall (m :: * -> *) a. Monad m => DAVT m a -> DAVT m [a]
some :: DAVT m a -> DAVT m [a]
$csome :: forall (m :: * -> *) a. Monad m => DAVT m a -> DAVT m [a]
<|> :: DAVT m a -> DAVT m a -> DAVT m a
$c<|> :: forall (m :: * -> *) a. Monad m => DAVT m a -> DAVT m a -> DAVT m a
empty :: DAVT m a
$cempty :: forall (m :: * -> *) a. Monad m => DAVT m a
$cp1Alternative :: forall (m :: * -> *). Monad m => Applicative (DAVT m)
Alternative, Functor (DAVT m)
a -> DAVT m a
Functor (DAVT m) =>
(forall a. a -> DAVT m a)
-> (forall a b. DAVT m (a -> b) -> DAVT m a -> DAVT m b)
-> (forall a b c.
    (a -> b -> c) -> DAVT m a -> DAVT m b -> DAVT m c)
-> (forall a b. DAVT m a -> DAVT m b -> DAVT m b)
-> (forall a b. DAVT m a -> DAVT m b -> DAVT m a)
-> Applicative (DAVT m)
DAVT m a -> DAVT m b -> DAVT m b
DAVT m a -> DAVT m b -> DAVT m a
DAVT m (a -> b) -> DAVT m a -> DAVT m b
(a -> b -> c) -> DAVT m a -> DAVT m b -> DAVT m c
forall a. a -> DAVT m a
forall a b. DAVT m a -> DAVT m b -> DAVT m a
forall a b. DAVT m a -> DAVT m b -> DAVT m b
forall a b. DAVT m (a -> b) -> DAVT m a -> DAVT m b
forall a b c. (a -> b -> c) -> DAVT m a -> DAVT m b -> DAVT m c
forall (m :: * -> *). Monad m => Functor (DAVT m)
forall (m :: * -> *) a. Monad m => a -> DAVT m a
forall (m :: * -> *) a b.
Monad m =>
DAVT m a -> DAVT m b -> DAVT m a
forall (m :: * -> *) a b.
Monad m =>
DAVT m a -> DAVT m b -> DAVT m b
forall (m :: * -> *) a b.
Monad m =>
DAVT m (a -> b) -> DAVT m a -> DAVT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> DAVT m a -> DAVT m b -> DAVT m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: DAVT m a -> DAVT m b -> DAVT m a
$c<* :: forall (m :: * -> *) a b.
Monad m =>
DAVT m a -> DAVT m b -> DAVT m a
*> :: DAVT m a -> DAVT m b -> DAVT m b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
DAVT m a -> DAVT m b -> DAVT m b
liftA2 :: (a -> b -> c) -> DAVT m a -> DAVT m b -> DAVT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> DAVT m a -> DAVT m b -> DAVT m c
<*> :: DAVT m (a -> b) -> DAVT m a -> DAVT m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
DAVT m (a -> b) -> DAVT m a -> DAVT m b
pure :: a -> DAVT m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> DAVT m a
$cp1Applicative :: forall (m :: * -> *). Monad m => Functor (DAVT m)
Applicative, a -> DAVT m b -> DAVT m a
(a -> b) -> DAVT m a -> DAVT m b
(forall a b. (a -> b) -> DAVT m a -> DAVT m b)
-> (forall a b. a -> DAVT m b -> DAVT m a) -> Functor (DAVT m)
forall a b. a -> DAVT m b -> DAVT m a
forall a b. (a -> b) -> DAVT m a -> DAVT m b
forall (m :: * -> *) a b. Functor m => a -> DAVT m b -> DAVT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> DAVT m a -> DAVT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> DAVT m b -> DAVT m a
$c<$ :: forall (m :: * -> *) a b. Functor m => a -> DAVT m b -> DAVT m a
fmap :: (a -> b) -> DAVT m a -> DAVT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> DAVT m a -> DAVT m b
Functor, Applicative (DAVT m)
a -> DAVT m a
Applicative (DAVT m) =>
(forall a b. DAVT m a -> (a -> DAVT m b) -> DAVT m b)
-> (forall a b. DAVT m a -> DAVT m b -> DAVT m b)
-> (forall a. a -> DAVT m a)
-> Monad (DAVT m)
DAVT m a -> (a -> DAVT m b) -> DAVT m b
DAVT m a -> DAVT m b -> DAVT m b
forall a. a -> DAVT m a
forall a b. DAVT m a -> DAVT m b -> DAVT m b
forall a b. DAVT m a -> (a -> DAVT m b) -> DAVT m b
forall (m :: * -> *). Monad m => Applicative (DAVT m)
forall (m :: * -> *) a. Monad m => a -> DAVT m a
forall (m :: * -> *) a b.
Monad m =>
DAVT m a -> DAVT m b -> DAVT m b
forall (m :: * -> *) a b.
Monad m =>
DAVT m a -> (a -> DAVT m b) -> DAVT m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> DAVT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> DAVT m a
>> :: DAVT m a -> DAVT m b -> DAVT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
DAVT m a -> DAVT m b -> DAVT m b
>>= :: DAVT m a -> (a -> DAVT m b) -> DAVT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
DAVT m a -> (a -> DAVT m b) -> DAVT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (DAVT m)
Monad, MonadBase b, MonadError String, Monad (DAVT m)
Monad (DAVT m) =>
(forall a. (a -> DAVT m a) -> DAVT m a) -> MonadFix (DAVT m)
(a -> DAVT m a) -> DAVT m a
forall a. (a -> DAVT m a) -> DAVT m a
forall (m :: * -> *).
Monad m =>
(forall a. (a -> m a) -> m a) -> MonadFix m
forall (m :: * -> *). MonadFix m => Monad (DAVT m)
forall (m :: * -> *) a. MonadFix m => (a -> DAVT m a) -> DAVT m a
mfix :: (a -> DAVT m a) -> DAVT m a
$cmfix :: forall (m :: * -> *) a. MonadFix m => (a -> DAVT m a) -> DAVT m a
$cp1MonadFix :: forall (m :: * -> *). MonadFix m => Monad (DAVT m)
MonadFix, Monad (DAVT m)
Monad (DAVT m) => (forall a. IO a -> DAVT m a) -> MonadIO (DAVT m)
IO a -> DAVT m a
forall a. IO a -> DAVT m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (DAVT m)
forall (m :: * -> *) a. MonadIO m => IO a -> DAVT m a
liftIO :: IO a -> DAVT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> DAVT m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (DAVT m)
MonadIO, Monad (DAVT m)
Alternative (DAVT m)
DAVT m a
(Alternative (DAVT m), Monad (DAVT m)) =>
(forall a. DAVT m a)
-> (forall a. DAVT m a -> DAVT m a -> DAVT m a)
-> MonadPlus (DAVT m)
DAVT m a -> DAVT m a -> DAVT m a
forall a. DAVT m a
forall a. DAVT m a -> DAVT m a -> DAVT m a
forall (m :: * -> *). Monad m => Monad (DAVT m)
forall (m :: * -> *). Monad m => Alternative (DAVT m)
forall (m :: * -> *) a. Monad m => DAVT m a
forall (m :: * -> *) a. Monad m => DAVT m a -> DAVT m a -> DAVT m a
forall (m :: * -> *).
(Alternative m, Monad m) =>
(forall a. m a) -> (forall a. m a -> m a -> m a) -> MonadPlus m
mplus :: DAVT m a -> DAVT m a -> DAVT m a
$cmplus :: forall (m :: * -> *) a. Monad m => DAVT m a -> DAVT m a -> DAVT m a
mzero :: DAVT m a
$cmzero :: forall (m :: * -> *) a. Monad m => DAVT m a
$cp2MonadPlus :: forall (m :: * -> *). Monad m => Monad (DAVT m)
$cp1MonadPlus :: forall (m :: * -> *). Monad m => Alternative (DAVT m)
MonadPlus, MonadState DAVContext)

instance MonadCatch m => MonadCatch (DAVT m) where
    catch :: DAVT m a -> (e -> DAVT m a) -> DAVT m a
catch (DAVT m :: ExceptT String (StateT DAVContext m) a
m) f :: e -> DAVT m a
f = ExceptT String (StateT DAVContext m) a -> DAVT m a
forall (m :: * -> *) a.
ExceptT String (StateT DAVContext m) a -> DAVT m a
DAVT (ExceptT String (StateT DAVContext m) a -> DAVT m a)
-> ExceptT String (StateT DAVContext m) a -> DAVT m a
forall a b. (a -> b) -> a -> b
$ ExceptT String (StateT DAVContext m) a
-> (e -> ExceptT String (StateT DAVContext m) a)
-> ExceptT String (StateT DAVContext m) a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
MonadCatch.catch ExceptT String (StateT DAVContext m) a
m (DAVT m a -> ExceptT String (StateT DAVContext m) a
forall (m :: * -> *) a.
DAVT m a -> ExceptT String (StateT DAVContext m) a
runDAVT (DAVT m a -> ExceptT String (StateT DAVContext m) a)
-> (e -> DAVT m a) -> e -> ExceptT String (StateT DAVContext m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> DAVT m a
f)

instance MonadThrow m => MonadThrow (DAVT m) where
    throwM :: e -> DAVT m a
throwM = m a -> DAVT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> DAVT m a) -> (e -> m a) -> e -> DAVT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM

instance MonadTrans DAVT where
    lift :: m a -> DAVT m a
lift = ExceptT String (StateT DAVContext m) a -> DAVT m a
forall (m :: * -> *) a.
ExceptT String (StateT DAVContext m) a -> DAVT m a
DAVT (ExceptT String (StateT DAVContext m) a -> DAVT m a)
-> (m a -> ExceptT String (StateT DAVContext m) a)
-> m a
-> DAVT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT DAVContext m a -> ExceptT String (StateT DAVContext m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT DAVContext m a -> ExceptT String (StateT DAVContext m) a)
-> (m a -> StateT DAVContext m a)
-> m a
-> ExceptT String (StateT DAVContext m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> StateT DAVContext m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

type DAVURL = String

evalDAVT :: MonadIO m => DAVURL -> DAVT m a -> m (Either String a)
evalDAVT :: String -> DAVT m a -> m (Either String a)
evalDAVT u :: String
u f :: DAVT m a
f = do
    DAVContext
ctx <- String -> m DAVContext
forall (m :: * -> *). MonadIO m => String -> m DAVContext
mkDAVContext String
u
    Either String a
r <- (StateT DAVContext m (Either String a)
-> DAVContext -> m (Either String a)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (StateT DAVContext m (Either String a)
 -> DAVContext -> m (Either String a))
-> (DAVT m a -> StateT DAVContext m (Either String a))
-> DAVT m a
-> DAVContext
-> m (Either String a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT String (StateT DAVContext m) a
-> StateT DAVContext m (Either String a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String (StateT DAVContext m) a
 -> StateT DAVContext m (Either String a))
-> (DAVT m a -> ExceptT String (StateT DAVContext m) a)
-> DAVT m a
-> StateT DAVContext m (Either String a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DAVT m a -> ExceptT String (StateT DAVContext m) a
forall (m :: * -> *) a.
DAVT m a -> ExceptT String (StateT DAVContext m) a
runDAVT) DAVT m a
f DAVContext
ctx
    DAVContext -> m ()
forall (m :: * -> *). MonadIO m => DAVContext -> m ()
closeDAVContext DAVContext
ctx
    Either String a -> m (Either String a)
forall (m :: * -> *) a. Monad m => a -> m a
return Either String a
r

mkDAVContext :: MonadIO m => DAVURL -> m DAVContext
mkDAVContext :: String -> m DAVContext
mkDAVContext u :: String
u = IO DAVContext -> m DAVContext
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DAVContext -> m DAVContext) -> IO DAVContext -> m DAVContext
forall a b. (a -> b) -> a -> b
$ do
    Manager
mgr <- IO Manager -> IO Manager
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Manager -> IO Manager) -> IO Manager -> IO Manager
forall a b. (a -> b) -> a -> b
$ ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings
#if MIN_VERSION_http_client(0,5,0)
    Request
req <- IO Request -> IO Request
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Request -> IO Request) -> IO Request -> IO Request
forall a b. (a -> b) -> a -> b
$ String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseUrlThrow String
u
#else
    req <- liftIO $ parseUrl u
#endif
    DAVContext -> IO DAVContext
forall (m :: * -> *) a. Monad m => a -> m a
return (DAVContext -> IO DAVContext) -> DAVContext -> IO DAVContext
forall a b. (a -> b) -> a -> b
$ DAVContext
forall a. Default a => a
def { _baseRequest :: Request
_baseRequest = Request
req, _httpManager :: Maybe Manager
_httpManager = Manager -> Maybe Manager
forall a. a -> Maybe a
Just Manager
mgr }

{-# DEPRECATED closeDAVContext "deprecated because http-client deprecated closeManager" #-}
closeDAVContext :: MonadIO m => DAVContext -> m ()
closeDAVContext :: DAVContext -> m ()
closeDAVContext _ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

withDAVContext :: MonadIO m => DAVURL -> (DAVContext -> m a) -> m a
withDAVContext :: String -> (DAVContext -> m a) -> m a
withDAVContext u :: String
u f :: DAVContext -> m a
f = String -> m DAVContext
forall (m :: * -> *). MonadIO m => String -> m DAVContext
mkDAVContext String
u m DAVContext -> (DAVContext -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DAVContext -> m a
f

runDAVContext :: MonadIO m => DAVContext -> DAVT m a -> m (Either String a, DAVContext)
runDAVContext :: DAVContext -> DAVT m a -> m (Either String a, DAVContext)
runDAVContext ctx :: DAVContext
ctx f :: DAVT m a
f = (StateT DAVContext m (Either String a)
-> DAVContext -> m (Either String a, DAVContext)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (StateT DAVContext m (Either String a)
 -> DAVContext -> m (Either String a, DAVContext))
-> (DAVT m a -> StateT DAVContext m (Either String a))
-> DAVT m a
-> DAVContext
-> m (Either String a, DAVContext)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT String (StateT DAVContext m) a
-> StateT DAVContext m (Either String a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String (StateT DAVContext m) a
 -> StateT DAVContext m (Either String a))
-> (DAVT m a -> ExceptT String (StateT DAVContext m) a)
-> DAVT m a
-> StateT DAVContext m (Either String a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DAVT m a -> ExceptT String (StateT DAVContext m) a
forall (m :: * -> *) a.
DAVT m a -> ExceptT String (StateT DAVContext m) a
runDAVT) DAVT m a
f DAVContext
ctx

setCreds :: MonadIO m => B.ByteString -> B.ByteString -> DAVT m ()
setCreds :: ByteString -> ByteString -> DAVT m ()
setCreds u :: ByteString
u p :: ByteString
p = (ByteString -> Identity ByteString)
-> DAVContext -> Identity DAVContext
Lens' DAVContext ByteString
basicusername ((ByteString -> Identity ByteString)
 -> DAVContext -> Identity DAVContext)
-> ByteString -> DAVT m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ByteString
u DAVT m () -> DAVT m () -> DAVT m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ByteString -> Identity ByteString)
-> DAVContext -> Identity DAVContext
Lens' DAVContext ByteString
basicpassword ((ByteString -> Identity ByteString)
 -> DAVContext -> Identity DAVContext)
-> ByteString -> DAVT m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ByteString
p

setDepth :: MonadIO m => Maybe Depth -> DAVT m ()
setDepth :: Maybe Depth -> DAVT m ()
setDepth d :: Maybe Depth
d = (Maybe Depth -> Identity (Maybe Depth))
-> DAVContext -> Identity DAVContext
Lens' DAVContext (Maybe Depth)
depth ((Maybe Depth -> Identity (Maybe Depth))
 -> DAVContext -> Identity DAVContext)
-> Maybe Depth -> DAVT m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe Depth
d

setUserAgent :: MonadIO m => B.ByteString -> DAVT m ()
setUserAgent :: ByteString -> DAVT m ()
setUserAgent ua :: ByteString
ua = (ByteString -> Identity ByteString)
-> DAVContext -> Identity DAVContext
Lens' DAVContext ByteString
userAgent ((ByteString -> Identity ByteString)
 -> DAVContext -> Identity DAVContext)
-> ByteString -> DAVT m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ByteString
ua

setResponseTimeout :: MonadIO m => Maybe Int -> DAVT m ()
#if MIN_VERSION_http_client(0,5,0)
setResponseTimeout :: Maybe Int -> DAVT m ()
setResponseTimeout rt :: Maybe Int
rt = (Request -> Identity Request) -> DAVContext -> Identity DAVContext
Lens' DAVContext Request
baseRequest ((Request -> Identity Request)
 -> DAVContext -> Identity DAVContext)
-> (Request -> Request) -> DAVT m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= \x :: Request
x -> Request
x { responseTimeout :: ResponseTimeout
responseTimeout = ResponseTimeout
-> (Int -> ResponseTimeout) -> Maybe Int -> ResponseTimeout
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ResponseTimeout
responseTimeoutNone Int -> ResponseTimeout
responseTimeoutMicro Maybe Int
rt }
#else
setResponseTimeout rt = baseRequest %= \x -> x { responseTimeout = rt }
#endif

mkDavRequest :: MonadIO m => Method -> RequestHeaders -> RequestBody -> DAVT m Request
mkDavRequest :: ByteString -> RequestHeaders -> RequestBody -> DAVT m Request
mkDavRequest meth :: ByteString
meth addlhdrs :: RequestHeaders
addlhdrs rbody :: RequestBody
rbody = do
    DAVContext
ctx <- DAVT m DAVContext
forall s (m :: * -> *). MonadState s m => m s
get
    let hdrs :: RequestHeaders
hdrs = [Maybe (CI ByteString, ByteString)] -> RequestHeaders
forall a. [Maybe a] -> [a]
catMaybes
               [ (CI ByteString, ByteString) -> Maybe (CI ByteString, ByteString)
forall a. a -> Maybe a
Just (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
mk "User-Agent", DAVContext
ctx DAVContext
-> Getting ByteString DAVContext ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString DAVContext ByteString
Lens' DAVContext ByteString
userAgent)
               , (Depth -> (CI ByteString, ByteString))
-> Maybe Depth -> Maybe (CI ByteString, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
mk "Depth") (ByteString -> (CI ByteString, ByteString))
-> (Depth -> ByteString) -> Depth -> (CI ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BC8.pack (String -> ByteString) -> (Depth -> String) -> Depth -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Depth -> String
forall a. Show a => a -> String
show) (DAVContext
ctx DAVContext
-> Getting (Maybe Depth) DAVContext (Maybe Depth) -> Maybe Depth
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Depth) DAVContext (Maybe Depth)
Lens' DAVContext (Maybe Depth)
depth)
               ] RequestHeaders -> RequestHeaders -> RequestHeaders
forall a. [a] -> [a] -> [a]
++ RequestHeaders
addlhdrs
        req :: Request
req = (DAVContext
ctx DAVContext -> Getting Request DAVContext Request -> Request
forall s a. s -> Getting a s a -> a
^. Getting Request DAVContext Request
Lens' DAVContext Request
baseRequest) { method :: ByteString
method = ByteString
meth, requestHeaders :: RequestHeaders
requestHeaders = RequestHeaders
hdrs, requestBody :: RequestBody
requestBody = RequestBody
rbody }
        authreq :: Request
authreq = if ByteString -> Bool
B.null (DAVContext
ctx DAVContext
-> Getting ByteString DAVContext ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString DAVContext ByteString
Lens' DAVContext ByteString
basicusername) Bool -> Bool -> Bool
&& ByteString -> Bool
B.null (DAVContext
ctx DAVContext
-> Getting ByteString DAVContext ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString DAVContext ByteString
Lens' DAVContext ByteString
basicpassword)
            then Request
req
            else ByteString -> ByteString -> Request -> Request
applyBasicAuth (DAVContext
ctx DAVContext
-> Getting ByteString DAVContext ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString DAVContext ByteString
Lens' DAVContext ByteString
basicusername) (DAVContext
ctx DAVContext
-> Getting ByteString DAVContext ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString DAVContext ByteString
Lens' DAVContext ByteString
basicpassword) Request
req
    Request -> DAVT m Request
forall (m :: * -> *) a. Monad m => a -> m a
return Request
authreq

davRequest :: MonadIO m => Method -> RequestHeaders -> RequestBody -> DAVT m (Response BL.ByteString)
davRequest :: ByteString
-> RequestHeaders -> RequestBody -> DAVT m (Response ByteString)
davRequest meth :: ByteString
meth addlhdrs :: RequestHeaders
addlhdrs rbody :: RequestBody
rbody = Request -> DAVT m (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
Request -> DAVT m (Response ByteString)
go (Request -> DAVT m (Response ByteString))
-> DAVT m Request -> DAVT m (Response ByteString)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> RequestHeaders -> RequestBody -> DAVT m Request
forall (m :: * -> *).
MonadIO m =>
ByteString -> RequestHeaders -> RequestBody -> DAVT m Request
mkDavRequest ByteString
meth RequestHeaders
addlhdrs RequestBody
rbody
  where
    go :: Request -> DAVT m (Response ByteString)
go req :: Request
req = do
      DAVContext
ctx <- DAVT m DAVContext
forall s (m :: * -> *). MonadState s m => m s
get
      DAVT m (Response ByteString)
-> (Manager -> DAVT m (Response ByteString))
-> Maybe Manager
-> DAVT m (Response ByteString)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ExceptT String (StateT DAVContext m) (Response ByteString)
-> DAVT m (Response ByteString)
forall (m :: * -> *) a.
ExceptT String (StateT DAVContext m) a -> DAVT m a
DAVT (ExceptT String (StateT DAVContext m) (Response ByteString)
 -> DAVT m (Response ByteString))
-> ExceptT String (StateT DAVContext m) (Response ByteString)
-> DAVT m (Response ByteString)
forall a b. (a -> b) -> a -> b
$ String
-> ExceptT String (StateT DAVContext m) (Response ByteString)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE "Can't perform request without manager") (IO (Response ByteString) -> DAVT m (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString) -> DAVT m (Response ByteString))
-> (Manager -> IO (Response ByteString))
-> Manager
-> DAVT m (Response ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Manager -> IO (Response ByteString)
httpLbs Request
req) (DAVContext
ctx DAVContext
-> Getting (Maybe Manager) DAVContext (Maybe Manager)
-> Maybe Manager
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Manager) DAVContext (Maybe Manager)
Lens' DAVContext (Maybe Manager)
httpManager)

matchStatusCodeException :: Status -> HttpException -> Maybe ()
#if MIN_VERSION_http_client(0,5,0)
matchStatusCodeException :: Status -> HttpException -> Maybe ()
matchStatusCodeException want :: Status
want (HttpExceptionRequest _ (StatusCodeException resp :: Response ()
resp _))
    | Response () -> Status
forall body. Response body -> Status
responseStatus Response ()
resp Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
want = () -> Maybe ()
forall a. a -> Maybe a
Just ()
#else
matchStatusCodeException want (StatusCodeException s _ _)
    | s == want = Just ()
#endif
    | Bool
otherwise = Maybe ()
forall a. Maybe a
Nothing
matchStatusCodeException _ _ = Maybe ()
forall a. Maybe a
Nothing

emptyBody :: RequestBody
emptyBody :: RequestBody
emptyBody = ByteString -> RequestBody
RequestBodyLBS ByteString
BL.empty

xmlBody :: XML.Document -> RequestBody
xmlBody :: Document -> RequestBody
xmlBody = ByteString -> RequestBody
RequestBodyLBS (ByteString -> RequestBody)
-> (Document -> ByteString) -> Document -> RequestBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenderSettings -> Document -> ByteString
XML.renderLBS RenderSettings
forall a. Default a => a
XML.def

getOptions :: MonadIO m => DAVT m ()
getOptions :: DAVT m ()
getOptions = do
    Response ByteString
optresp <- ByteString
-> RequestHeaders -> RequestBody -> DAVT m (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
ByteString
-> RequestHeaders -> RequestBody -> DAVT m (Response ByteString)
davRequest "OPTIONS" [] RequestBody
emptyBody
    let meths :: [ByteString]
meths = ((Word8 -> Bool) -> ByteString -> [ByteString]
B.splitWith (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
==(Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum) ',') (ByteString -> [ByteString])
-> (Response ByteString -> ByteString)
-> Response ByteString
-> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
B.empty (Maybe ByteString -> ByteString)
-> (Response ByteString -> Maybe ByteString)
-> Response ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CI ByteString -> RequestHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "Allow" (RequestHeaders -> Maybe ByteString)
-> (Response ByteString -> RequestHeaders)
-> Response ByteString
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response ByteString -> RequestHeaders
forall body. Response body -> RequestHeaders
responseHeaders) Response ByteString
optresp
    let cclass :: [ByteString]
cclass = ((Word8 -> Bool) -> ByteString -> [ByteString]
B.splitWith (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
==(Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum) ',') (ByteString -> [ByteString])
-> (Response ByteString -> ByteString)
-> Response ByteString
-> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
B.empty (Maybe ByteString -> ByteString)
-> (Response ByteString -> Maybe ByteString)
-> Response ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CI ByteString -> RequestHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "DAV" (RequestHeaders -> Maybe ByteString)
-> (Response ByteString -> RequestHeaders)
-> Response ByteString
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response ByteString -> RequestHeaders
forall body. Response body -> RequestHeaders
responseHeaders) Response ByteString
optresp
    ([ByteString] -> Identity [ByteString])
-> DAVContext -> Identity DAVContext
Lens' DAVContext [ByteString]
complianceClasses (([ByteString] -> Identity [ByteString])
 -> DAVContext -> Identity DAVContext)
-> [ByteString] -> DAVT m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [ByteString]
cclass
    ([ByteString] -> Identity [ByteString])
-> DAVContext -> Identity DAVContext
Lens' DAVContext [ByteString]
allowedMethods (([ByteString] -> Identity [ByteString])
 -> DAVContext -> Identity DAVContext)
-> [ByteString] -> DAVT m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [ByteString]
meths

lockResource :: MonadIO m => Bool -> DAVT m ()
lockResource :: Bool -> DAVT m ()
lockResource nocreate :: Bool
nocreate = do
    let ahs' :: RequestHeaders
ahs' = [(CI ByteString
hContentType, "application/xml; charset=\"utf-8\""), (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
mk "Depth", "0"), (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
mk "Timeout", "Second-300")]
    let ahs :: RequestHeaders
ahs = if Bool
nocreate then (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
mk "If-Match", "*")(CI ByteString, ByteString) -> RequestHeaders -> RequestHeaders
forall a. a -> [a] -> [a]
:RequestHeaders
ahs' else RequestHeaders
ahs'
    Response ByteString
lockresp <- ByteString
-> RequestHeaders -> RequestBody -> DAVT m (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
ByteString
-> RequestHeaders -> RequestBody -> DAVT m (Response ByteString)
davRequest "LOCK" RequestHeaders
ahs (Document -> RequestBody
xmlBody Document
locky)
    let hdrtoken :: Maybe ByteString
hdrtoken = (CI ByteString -> RequestHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "Lock-Token" (RequestHeaders -> Maybe ByteString)
-> (Response ByteString -> RequestHeaders)
-> Response ByteString
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response ByteString -> RequestHeaders
forall body. Response body -> RequestHeaders
responseHeaders) Response ByteString
lockresp
    (Maybe ByteString -> Identity (Maybe ByteString))
-> DAVContext -> Identity DAVContext
Lens' DAVContext (Maybe ByteString)
lockToken ((Maybe ByteString -> Identity (Maybe ByteString))
 -> DAVContext -> Identity DAVContext)
-> Maybe ByteString -> DAVT m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe ByteString
hdrtoken

unlockResource :: MonadIO m => DAVT m ()
unlockResource :: DAVT m ()
unlockResource = do
    DAVContext
d <- DAVT m DAVContext
forall s (m :: * -> *). MonadState s m => m s
get
    case DAVContext -> Maybe ByteString
_lockToken DAVContext
d of
        Nothing -> () -> DAVT m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just tok :: ByteString
tok -> do let ahs :: RequestHeaders
ahs = [(ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
mk "Lock-Token", ByteString
tok)]
                       Response ByteString
_ <- ByteString
-> RequestHeaders -> RequestBody -> DAVT m (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
ByteString
-> RequestHeaders -> RequestBody -> DAVT m (Response ByteString)
davRequest "UNLOCK" RequestHeaders
ahs RequestBody
emptyBody
                       (Maybe ByteString -> Identity (Maybe ByteString))
-> DAVContext -> Identity DAVContext
Lens' DAVContext (Maybe ByteString)
lockToken ((Maybe ByteString -> Identity (Maybe ByteString))
 -> DAVContext -> Identity DAVContext)
-> Maybe ByteString -> DAVT m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe ByteString
forall a. Maybe a
Nothing

supportsLocking :: DAVContext -> Bool
supportsLocking :: DAVContext -> Bool
supportsLocking = (Bool -> Bool -> Bool)
-> ([ByteString] -> Bool)
-> ([ByteString] -> Bool)
-> [ByteString]
-> Bool
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&) ("LOCK" ByteString -> [ByteString] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) ("UNLOCK" ByteString -> [ByteString] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) ([ByteString] -> Bool)
-> (DAVContext -> [ByteString]) -> DAVContext -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DAVContext -> [ByteString]
_allowedMethods

getPropsM :: MonadIO m => DAVT m XML.Document
getPropsM :: DAVT m Document
getPropsM = do
    let ahs :: RequestHeaders
ahs = [(CI ByteString
hContentType, "application/xml; charset=\"utf-8\"")]
    Response ByteString
propresp <- ByteString
-> RequestHeaders -> RequestBody -> DAVT m (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
ByteString
-> RequestHeaders -> RequestBody -> DAVT m (Response ByteString)
davRequest "PROPFIND" RequestHeaders
ahs (Document -> RequestBody
xmlBody Document
propname)
    Document -> DAVT m Document
forall (m :: * -> *) a. Monad m => a -> m a
return (Document -> DAVT m Document) -> Document -> DAVT m Document
forall a b. (a -> b) -> a -> b
$ (ParseSettings -> ByteString -> Document
XML.parseLBS_ ParseSettings
forall a. Default a => a
XML.def (ByteString -> Document)
-> (Response ByteString -> ByteString)
-> Response ByteString
-> Document
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response ByteString -> ByteString
forall body. Response body -> body
responseBody) Response ByteString
propresp

-- | Note that the entire request body is buffered in memory.
-- To stream large files use withContentM instead.
getContentM :: MonadIO m => DAVT m (Maybe B.ByteString, BL.ByteString)
getContentM :: DAVT m (Maybe ByteString, ByteString)
getContentM = do
    Response ByteString
resp <- ByteString
-> RequestHeaders -> RequestBody -> DAVT m (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
ByteString
-> RequestHeaders -> RequestBody -> DAVT m (Response ByteString)
davRequest "GET" [] RequestBody
emptyBody
    let ct :: Maybe ByteString
ct = CI ByteString -> RequestHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI ByteString
hContentType (Response ByteString -> RequestHeaders
forall body. Response body -> RequestHeaders
responseHeaders Response ByteString
resp)
    (Maybe ByteString, ByteString)
-> DAVT m (Maybe ByteString, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString
ct, Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
resp)

withContentM :: MonadIO m => (Response BodyReader -> IO a) -> DAVT m a
withContentM :: (Response BodyReader -> IO a) -> DAVT m a
withContentM handleresponse :: Response BodyReader -> IO a
handleresponse = do
    Request
req <- ByteString -> RequestHeaders -> RequestBody -> DAVT m Request
forall (m :: * -> *).
MonadIO m =>
ByteString -> RequestHeaders -> RequestBody -> DAVT m Request
mkDavRequest "GET" [] RequestBody
emptyBody
    DAVContext
ctx <- DAVT m DAVContext
forall s (m :: * -> *). MonadState s m => m s
get
    DAVT m a -> (Manager -> DAVT m a) -> Maybe Manager -> DAVT m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ExceptT String (StateT DAVContext m) a -> DAVT m a
forall (m :: * -> *) a.
ExceptT String (StateT DAVContext m) a -> DAVT m a
DAVT (ExceptT String (StateT DAVContext m) a -> DAVT m a)
-> ExceptT String (StateT DAVContext m) a -> DAVT m a
forall a b. (a -> b) -> a -> b
$ String -> ExceptT String (StateT DAVContext m) a
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE "Can't handle response without manager") (\mgr :: Manager
mgr -> IO a -> DAVT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> DAVT m a) -> IO a -> DAVT m a
forall a b. (a -> b) -> a -> b
$ Request -> Manager -> (Response BodyReader -> IO a) -> IO a
forall a.
Request -> Manager -> (Response BodyReader -> IO a) -> IO a
withResponse Request
req Manager
mgr Response BodyReader -> IO a
handleresponse) (DAVContext
ctx DAVContext
-> Getting (Maybe Manager) DAVContext (Maybe Manager)
-> Maybe Manager
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Manager) DAVContext (Maybe Manager)
Lens' DAVContext (Maybe Manager)
httpManager)

-- | Note that the entire request body is buffered in memory; not suitable
-- for large files.
putContentM :: MonadIO m => (Maybe B.ByteString, BL.ByteString) -> DAVT m ()
putContentM :: (Maybe ByteString, ByteString) -> DAVT m ()
putContentM (ct :: Maybe ByteString
ct, body :: ByteString
body) = (Maybe ByteString, RequestBody) -> DAVT m ()
forall (m :: * -> *).
MonadIO m =>
(Maybe ByteString, RequestBody) -> DAVT m ()
putContentM' (Maybe ByteString
ct, ByteString -> RequestBody
RequestBodyLBS ByteString
body)

-- | To send a large file, pass eg a RequestBodyStream containing the
-- file's content.
putContentM' :: MonadIO m => (Maybe B.ByteString, RequestBody) -> DAVT m ()
putContentM' :: (Maybe ByteString, RequestBody) -> DAVT m ()
putContentM' (ct :: Maybe ByteString
ct, requestbody :: RequestBody
requestbody) = do
    DAVContext
d <- DAVT m DAVContext
forall s (m :: * -> *). MonadState s m => m s
get
    let ahs' :: RequestHeaders
ahs' = RequestHeaders
-> (ByteString -> RequestHeaders)
-> Maybe ByteString
-> RequestHeaders
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((CI ByteString, ByteString) -> RequestHeaders
forall (m :: * -> *) a. Monad m => a -> m a
return ((CI ByteString, ByteString) -> RequestHeaders)
-> (ByteString -> (CI ByteString, ByteString))
-> ByteString
-> RequestHeaders
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
mk "If") (ByteString -> (CI ByteString, ByteString))
-> (ByteString -> ByteString)
-> ByteString
-> (CI ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
parenthesize) (DAVContext
d DAVContext
-> Getting (Maybe ByteString) DAVContext (Maybe ByteString)
-> Maybe ByteString
forall s a. s -> Getting a s a -> a
^. Getting (Maybe ByteString) DAVContext (Maybe ByteString)
Lens' DAVContext (Maybe ByteString)
lockToken)
    let ahs :: RequestHeaders
ahs = RequestHeaders
ahs' RequestHeaders -> RequestHeaders -> RequestHeaders
forall a. [a] -> [a] -> [a]
++ RequestHeaders
-> (ByteString -> RequestHeaders)
-> Maybe ByteString
-> RequestHeaders
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((CI ByteString, ByteString) -> RequestHeaders
forall (m :: * -> *) a. Monad m => a -> m a
return ((CI ByteString, ByteString) -> RequestHeaders)
-> (ByteString -> (CI ByteString, ByteString))
-> ByteString
-> RequestHeaders
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) CI ByteString
hContentType) Maybe ByteString
ct
    Response ByteString
_ <- ByteString
-> RequestHeaders -> RequestBody -> DAVT m (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
ByteString
-> RequestHeaders -> RequestBody -> DAVT m (Response ByteString)
davRequest "PUT" RequestHeaders
ahs RequestBody
requestbody
    () -> DAVT m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

delContentM :: MonadIO m => DAVT m ()
delContentM :: DAVT m ()
delContentM = do
    Response ByteString
_ <- ByteString
-> RequestHeaders -> RequestBody -> DAVT m (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
ByteString
-> RequestHeaders -> RequestBody -> DAVT m (Response ByteString)
davRequest "DELETE" [] RequestBody
emptyBody
    () -> DAVT m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

moveContentM :: MonadIO m => B.ByteString -> DAVT m ()
moveContentM :: ByteString -> DAVT m ()
moveContentM newurl :: ByteString
newurl = do
    let ahs :: RequestHeaders
ahs = [ (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
mk "Destination", ByteString
newurl) ]
    Response ByteString
_ <- ByteString
-> RequestHeaders -> RequestBody -> DAVT m (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
ByteString
-> RequestHeaders -> RequestBody -> DAVT m (Response ByteString)
davRequest "MOVE" RequestHeaders
ahs RequestBody
emptyBody
    () -> DAVT m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

mkCol' :: MonadIO m => DAVT m ()
mkCol' :: DAVT m ()
mkCol' = do
    Response ByteString
_ <- ByteString
-> RequestHeaders -> RequestBody -> DAVT m (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
ByteString
-> RequestHeaders -> RequestBody -> DAVT m (Response ByteString)
davRequest "MKCOL" [] RequestBody
emptyBody
    () -> DAVT m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

mkCol :: (MonadIO m, MonadBase IO m, MonadCatch m) => DAVT m Bool
mkCol :: DAVT m Bool
mkCol = (HttpException -> Maybe ())
-> DAVT m Bool -> (() -> DAVT m Bool) -> DAVT m Bool
forall (m :: * -> *) e b a.
(MonadCatch m, Exception e) =>
(e -> Maybe b) -> m a -> (b -> m a) -> m a
catchJust
        (Status -> HttpException -> Maybe ()
matchStatusCodeException Status
conflict409)
        (DAVT m ()
forall (m :: * -> *). MonadIO m => DAVT m ()
mkCol' DAVT m () -> DAVT m Bool -> DAVT m Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> DAVT m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
        (\_ -> Bool -> DAVT m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)

parenthesize :: B.ByteString -> B.ByteString
parenthesize :: ByteString -> ByteString
parenthesize x :: ByteString
x = [ByteString] -> ByteString
B.concat ["(", ByteString
x, ")"]

putPropsM :: MonadIO m => XML.Document -> DAVT m ()
putPropsM :: Document -> DAVT m ()
putPropsM props :: Document
props = do
    DAVContext
d <- DAVT m DAVContext
forall s (m :: * -> *). MonadState s m => m s
get
    let ah' :: (CI ByteString, ByteString)
ah' = (CI ByteString
hContentType, "application/xml; charset=\"utf-8\"")
    let ahs :: RequestHeaders
ahs = (CI ByteString, ByteString)
ah'(CI ByteString, ByteString) -> RequestHeaders -> RequestHeaders
forall a. a -> [a] -> [a]
:RequestHeaders
-> (ByteString -> RequestHeaders)
-> Maybe ByteString
-> RequestHeaders
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((CI ByteString, ByteString) -> RequestHeaders
forall (m :: * -> *) a. Monad m => a -> m a
return ((CI ByteString, ByteString) -> RequestHeaders)
-> (ByteString -> (CI ByteString, ByteString))
-> ByteString
-> RequestHeaders
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
mk "If") (ByteString -> (CI ByteString, ByteString))
-> (ByteString -> ByteString)
-> ByteString
-> (CI ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
parenthesize) (DAVContext -> Maybe ByteString
_lockToken DAVContext
d)
    Response ByteString
_ <- ByteString
-> RequestHeaders -> RequestBody -> DAVT m (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
ByteString
-> RequestHeaders -> RequestBody -> DAVT m (Response ByteString)
davRequest "PROPPATCH" RequestHeaders
ahs ((ByteString -> RequestBody
RequestBodyLBS (ByteString -> RequestBody)
-> (Document -> ByteString) -> Document -> RequestBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Document -> ByteString
props2patch) Document
props) -- FIXME: should diff and remove props from target
    () -> DAVT m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

props2patch :: XML.Document -> BL.ByteString
props2patch :: Document -> ByteString
props2patch = RenderSettings -> Document -> ByteString
XML.renderLBS RenderSettings
forall a. Default a => a
XML.def (Document -> ByteString)
-> (Document -> Document) -> Document -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Node] -> Document
patch ([Node] -> Document)
-> (Document -> [Node]) -> Document -> Document
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cursor Node -> [Node]
props (Cursor Node -> [Node])
-> (Document -> Cursor Node) -> Document -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Document -> Cursor Node
fromDocument
   where
       props :: Cursor Node -> [Node]
props cursor :: Cursor Node
cursor = (Cursor Node -> Node) -> [Cursor Node] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map Cursor Node -> Node
forall node. Cursor node -> node
node (Cursor Node
cursor Cursor Node -> (Cursor Node -> [Cursor Node]) -> [Cursor Node]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Cursor Node -> [Cursor Node]
element "{DAV:}response" (Cursor Node -> [Cursor Node])
-> (Cursor Node -> [Cursor Node]) -> Cursor Node -> [Cursor Node]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Cursor Node -> [Cursor Node]
element "{DAV:}propstat" (Cursor Node -> [Cursor Node])
-> (Cursor Node -> [Cursor Node]) -> Cursor Node -> [Cursor Node]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Cursor Node -> [Cursor Node]
element "{DAV:}prop" (Cursor Node -> [Cursor Node])
-> (Cursor Node -> [Cursor Node]) -> Cursor Node -> [Cursor Node]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ (Name -> Bool) -> Cursor Node -> [Cursor Node]
forall b. Boolean b => (Name -> b) -> Cursor Node -> [Cursor Node]
checkName (Bool -> Bool
not (Bool -> Bool) -> (Name -> Bool) -> Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> [Name] -> Bool) -> [Name] -> Name -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Name]
blacklist))
       patch :: [Node] -> Document
patch prop :: [Node]
prop = Prologue -> Element -> [Miscellaneous] -> Document
XML.Document ([Miscellaneous] -> Maybe Doctype -> [Miscellaneous] -> Prologue
XML.Prologue [] Maybe Doctype
forall a. Maybe a
Nothing []) ([Node] -> Element
root [Node]
prop) []
       root :: [Node] -> Element
root [] = [Node] -> Element
propertyupdate []
       root prop :: [Node]
prop = [Node] -> Element
propertyupdate
           [ Element -> Node
XML.NodeElement (Element -> Node) -> Element -> Node
forall a b. (a -> b) -> a -> b
$ Name -> Map Name Text -> [Node] -> Element
XML.Element "D:set" Map Name Text
forall k a. Map k a
Map.empty
             [ Element -> Node
XML.NodeElement (Element -> Node) -> Element -> Node
forall a b. (a -> b) -> a -> b
$ Name -> Map Name Text -> [Node] -> Element
XML.Element "D:prop" Map Name Text
forall k a. Map k a
Map.empty [Node]
prop ]
           ]
       propertyupdate :: [Node] -> Element
propertyupdate = Name -> Map Name Text -> [Node] -> Element
XML.Element "D:propertyupdate" ([(Name, Text)] -> Map Name Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [("xmlns:D", "DAV:")])
       blacklist :: [Name]
blacklist = [ "{DAV:}creationdate"
                   , "{DAV:}displayname"
                   , "{DAV:}getcontentlength"
                   , "{DAV:}getcontenttype"
                   , "{DAV:}getetag"
                   , "{DAV:}getlastmodified"
                   , "{DAV:}lockdiscovery"
                   , "{DAV:}resourcetype"
                   , "{DAV:}supportedlock"
                   ]

caldavReportM :: MonadIO m => DAVT m XML.Document
caldavReportM :: DAVT m Document
caldavReportM = do
    let ahs :: RequestHeaders
ahs = [(CI ByteString
hContentType, "application/xml; charset=\"utf-8\"")]
    Response ByteString
calrresp <- ByteString
-> RequestHeaders -> RequestBody -> DAVT m (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
ByteString
-> RequestHeaders -> RequestBody -> DAVT m (Response ByteString)
davRequest "REPORT" RequestHeaders
ahs (Document -> RequestBody
xmlBody Document
calendarquery)
    Document -> DAVT m Document
forall (m :: * -> *) a. Monad m => a -> m a
return (Document -> DAVT m Document) -> Document -> DAVT m Document
forall a b. (a -> b) -> a -> b
$ (ParseSettings -> ByteString -> Document
XML.parseLBS_ ParseSettings
forall a. Default a => a
XML.def (ByteString -> Document)
-> (Response ByteString -> ByteString)
-> Response ByteString
-> Document
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response ByteString -> ByteString
forall body. Response body -> body
responseBody) Response ByteString
calrresp

getOptionsOnce :: MonadIO m => DAVT m ()
getOptionsOnce :: DAVT m ()
getOptionsOnce = DAVT m ()
forall (m :: * -> *). MonadIO m => DAVT m ()
getOptions -- this should only happen once

withLockIfPossible :: (MonadIO m, MonadBase IO m) => Bool -> DAVT m a -> DAVT m a
withLockIfPossible :: Bool -> DAVT m a -> DAVT m a
withLockIfPossible nocreate :: Bool
nocreate f :: DAVT m a
f = do
    DAVT m ()
forall (m :: * -> *). MonadIO m => DAVT m ()
getOptionsOnce
    DAVContext
o <- DAVT m DAVContext
forall s (m :: * -> *). MonadState s m => m s
get
    Bool -> DAVT m () -> DAVT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DAVContext -> Bool
supportsLocking DAVContext
o) (Bool -> DAVT m ()
forall (m :: * -> *). MonadIO m => Bool -> DAVT m ()
lockResource Bool
nocreate)
    a
res <- DAVT m a
f
    Bool -> DAVT m () -> DAVT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DAVContext -> Bool
supportsLocking DAVContext
o) DAVT m ()
forall (m :: * -> *). MonadIO m => DAVT m ()
unlockResource
    a -> DAVT m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res

withLockIfPossibleForDelete :: (MonadIO m, MonadBase IO m) => Bool -> DAVT m a -> DAVT m a
withLockIfPossibleForDelete :: Bool -> DAVT m a -> DAVT m a
withLockIfPossibleForDelete nocreate :: Bool
nocreate f :: DAVT m a
f = do
    DAVT m ()
forall (m :: * -> *). MonadIO m => DAVT m ()
getOptionsOnce
    DAVContext
o <- DAVT m DAVContext
forall s (m :: * -> *). MonadState s m => m s
get
    Bool -> DAVT m () -> DAVT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DAVContext -> Bool
supportsLocking DAVContext
o) (Bool -> DAVT m ()
forall (m :: * -> *). MonadIO m => Bool -> DAVT m ()
lockResource Bool
nocreate)
    -- a successful delete destroys locks, so only unlock on error
    DAVT m a -> (String -> DAVT m a) -> DAVT m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError DAVT m a
f (\e :: String
e -> Bool -> DAVT m () -> DAVT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DAVContext -> Bool
supportsLocking DAVContext
o) DAVT m ()
forall (m :: * -> *). MonadIO m => DAVT m ()
unlockResource DAVT m () -> DAVT m a -> DAVT m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> DAVT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
e)

propname :: XML.Document
propname :: Document
propname = Prologue -> Element -> [Miscellaneous] -> Document
XML.Document ([Miscellaneous] -> Maybe Doctype -> [Miscellaneous] -> Prologue
XML.Prologue [] Maybe Doctype
forall a. Maybe a
Nothing []) Element
root []
    where
        root :: Element
root = Name -> Map Name Text -> [Node] -> Element
XML.Element "D:propfind" ([(Name, Text)] -> Map Name Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [("xmlns:D", "DAV:")]) [xml|
<D:allprop>
|]

locky :: XML.Document
locky :: Document
locky = Prologue -> Element -> [Miscellaneous] -> Document
XML.Document ([Miscellaneous] -> Maybe Doctype -> [Miscellaneous] -> Prologue
XML.Prologue [] Maybe Doctype
forall a. Maybe a
Nothing []) Element
root []
    where
        root :: Element
root = Name -> Map Name Text -> [Node] -> Element
XML.Element "D:lockinfo" ([(Name, Text)] -> Map Name Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [("xmlns:D", "DAV:")]) [xml|
<D:lockscope>
  <D:exclusive>
<D:locktype>
  <D:write>
<D:owner>Haskell DAV user
|]

calendarquery :: XML.Document
calendarquery :: Document
calendarquery = Prologue -> Element -> [Miscellaneous] -> Document
XML.Document ([Miscellaneous] -> Maybe Doctype -> [Miscellaneous] -> Prologue
XML.Prologue [] Maybe Doctype
forall a. Maybe a
Nothing []) Element
root []
    where
        root :: Element
root = Name -> Map Name Text -> [Node] -> Element
XML.Element "C:calendar-query" ([(Name, Text)] -> Map Name Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [("xmlns:D", "DAV:"),("xmlns:C", "urn:ietf:params:xml:ns:caldav")]) [xml|
<D:prop>
  <D:getetag>
  <C:calendar-data>
<C:filter>
  <C:comp-filter name="VCALENDAR">
|]

-- | Normally, DAVT actions act on the url that is provided to eg, evalDAVT.
-- Sometimes, it's useful to adjust the url that is acted on, while
-- remaining in the same DAV session.
--
-- inLocation temporarily adjusts the url's path, while performing a
-- DAVT action.
--
-- For example:
--
-- > import System.FilePath.Posix -- posix for url path manipulation
-- >
-- > mkColRecursive d = do
-- >   let parent = takeDirectory d
-- >   when (parent /= d) $
-- >     mkColRecursive parent
-- >   inDAVLocation (</> d) mkCol
--
-- Note that operations that modify the DAVContext
-- (such as setCreds and setCreds) can be run inside davLocation,
-- but will not have any effect on the calling DAVContext.
inDAVLocation :: MonadIO m => (String -> String) -> DAVT m a -> DAVT m a
inDAVLocation :: (String -> String) -> DAVT m a -> DAVT m a
inDAVLocation f :: String -> String
f a :: DAVT m a
a = do
    DAVContext
ctx <- DAVT m DAVContext
forall s (m :: * -> *). MonadState s m => m s
get
    let r :: Request
r = DAVContext
ctx DAVContext -> Getting Request DAVContext Request -> Request
forall s a. s -> Getting a s a -> a
^. Getting Request DAVContext Request
Lens' DAVContext Request
baseRequest
        r' :: Request
r' = Request
r { path :: ByteString
path = Request -> ByteString
adjustpath Request
r }
        ctx' :: DAVContext
ctx' = (Request -> Identity Request) -> DAVContext -> Identity DAVContext
Lens' DAVContext Request
baseRequest ((Request -> Identity Request)
 -> DAVContext -> Identity DAVContext)
-> Request -> DAVContext -> DAVContext
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Request
r' (DAVContext -> DAVContext) -> DAVContext -> DAVContext
forall a b. (a -> b) -> a -> b
$ DAVContext
ctx
    m a -> DAVT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> DAVT m a) -> m a -> DAVT m a
forall a b. (a -> b) -> a -> b
$ (String -> m a) -> (a -> m a) -> Either String a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> m a
forall a. HasCallStack => String -> a
error a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String a -> m a) -> m (Either String a) -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (StateT DAVContext m (Either String a)
-> DAVContext -> m (Either String a)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (StateT DAVContext m (Either String a)
 -> DAVContext -> m (Either String a))
-> (DAVT m a -> StateT DAVContext m (Either String a))
-> DAVT m a
-> DAVContext
-> m (Either String a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT String (StateT DAVContext m) a
-> StateT DAVContext m (Either String a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String (StateT DAVContext m) a
 -> StateT DAVContext m (Either String a))
-> (DAVT m a -> ExceptT String (StateT DAVContext m) a)
-> DAVT m a
-> StateT DAVContext m (Either String a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DAVT m a -> ExceptT String (StateT DAVContext m) a
forall (m :: * -> *) a.
DAVT m a -> ExceptT String (StateT DAVContext m) a
runDAVT) DAVT m a
a DAVContext
ctx'
  where
    adjustpath :: Request -> ByteString
adjustpath = String -> ByteString
UTF8B.fromString (String -> ByteString)
-> (Request -> String) -> Request -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
f (String -> String) -> (Request -> String) -> Request -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
UTF8B.toString (ByteString -> String)
-> (Request -> ByteString) -> Request -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> ByteString
path

-- | Gets the path of the url that DAVT actions will act on.
getDAVLocation :: Monad m => DAVT m String
getDAVLocation :: DAVT m String
getDAVLocation = do
    DAVContext
ctx <- DAVT m DAVContext
forall s (m :: * -> *). MonadState s m => m s
get
    String -> DAVT m String
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> String
UTF8B.toString (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
path (Request -> ByteString) -> Request -> ByteString
forall a b. (a -> b) -> a -> b
$ DAVContext
ctx DAVContext -> Getting Request DAVContext Request -> Request
forall s a. s -> Getting a s a -> a
^. Getting Request DAVContext Request
Lens' DAVContext Request
baseRequest)