module Database.CouchDB.Conduit.Attachment (
couchGetAttach,
couchPutAttach,
couchDeleteAttach
) where
import Control.Exception.Lifted (throw)
import Data.Maybe (fromMaybe)
import Data.ByteString (ByteString)
import Data.ByteString.Char8 (split)
import qualified Data.Aeson as A
import Data.Conduit (ResumableSource, ($$+-))
import qualified Data.Conduit.Attoparsec as CA
import Network.HTTP.Conduit (RequestBody(..), Response(..))
import qualified Network.HTTP.Types as HT
import Database.CouchDB.Conduit.Internal.Connection
(MonadCouch (..), Path, Revision, mkPath)
import Database.CouchDB.Conduit.Internal.Parser (extractRev)
import Database.CouchDB.Conduit.LowLevel (couch, protect')
couchGetAttach :: MonadCouch m =>
Path
-> Path
-> ByteString
-> m (ResumableSource m ByteString, ByteString)
couchGetAttach db doc att = do
Response _ _ hs bsrc <- couch HT.methodGet
(attachPath db doc att)
[]
[]
(RequestBodyBS "")
protect'
return (bsrc, fromMaybe "" . lookup "Content-Type" $ hs)
couchPutAttach :: MonadCouch m =>
Path
-> Path
-> ByteString
-> Revision
-> ByteString
-> RequestBody m
-> m Revision
couchPutAttach db doc att rev contentType body = do
Response _ _ _ bsrc <- couch HT.methodPut
(attachPath db doc att)
[(HT.hContentType, contentType)]
[("rev", Just rev)]
body
protect'
j <- bsrc $$+- CA.sinkParser A.json
either throw return $ extractRev j
couchDeleteAttach :: MonadCouch m =>
Path
-> Path
-> ByteString
-> Revision
-> m Revision
couchDeleteAttach db doc att rev = do
Response _ _ _ bsrc <- couch HT.methodDelete
(attachPath db doc att)
[]
[("rev", Just rev)]
(RequestBodyBS "")
protect'
j <- bsrc $$+- CA.sinkParser A.json
either throw return $ extractRev j
attachPath :: Path -> Path -> ByteString -> Path
attachPath db doc att =
mkPath $ db : doc : attP
where
attP = split '/' att