Skip to content
Browse files

SecureDB

  • Loading branch information...
1 parent e4159c2 commit 2b4ed58e75fafcd006ef9a72aa862c9ea58be416 @akaspin committed Jan 16, 2012
Showing with 37 additions and 5 deletions.
  1. +1 −1 ChangeLog
  2. +1 −1 couchdb-conduit.cabal
  3. +35 −3 src/Database/CouchDB/Conduit/DB.hs
View
2 ChangeLog
@@ -1,4 +1,4 @@
- 16.01.2011, Version 0.2.0.1 * Avoid escaping path in couch' 16.01.2011, Version 0.2.0 * Low-lewel API * "Don't care" versions of couchPut. * Brain-free couchRev'. * All database methods ignores DB in connection. * couchPutDB' renamed to couchPutDB_. * Database replication. 14.01.2011, Version 0.1.3.0 * Safe version of couchViewPut 14.01.2011, Version 0.1.2.0 * Authentification 11.01.2011, Version 0.1.1.0
+ 16.01.2011, Version 0.2.1 * Secure DB. 16.01.2011, Version 0.2.0.1 * Avoid escaping path in couch' 16.01.2011, Version 0.2.0 * Low-lewel API * "Don't care" versions of couchPut. * Brain-free couchRev'. * All database methods ignores DB in connection. * couchPutDB' renamed to couchPutDB_. * Database replication. 14.01.2011, Version 0.1.3.0 * Safe version of couchViewPut 14.01.2011, Version 0.1.2.0 * Authentification 11.01.2011, Version 0.1.1.0
* API Changes. `couchViewPut` moved to Database.CouchDB.Design and lost
language argument.
* Tests. 10.01.2011, Version 0.1.0.1
View
2 couchdb-conduit.cabal
@@ -1,5 +1,5 @@
name: couchdb-conduit
-version: 0.2.0.1
+version: 0.2.1
cabal-version: >= 1.8
build-type: Simple
stability: Experimental
View
38 src/Database/CouchDB/Conduit/DB.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
{- | CouchDB database methods.
@@ -13,11 +14,18 @@ module Database.CouchDB.Conduit.DB (
couchPutDB,
couchPutDB_,
couchDeleteDB,
- couchReplicateDB
+ -- * Replication
+ couchReplicateDB,
+ -- * Security
+ couchSecureDB
) where
+--import Control.Applicative ((<$>), (<*>), empty)
+
import qualified Data.ByteString as B
import qualified Data.Aeson as A
+--import Data.Generics (Data, Typeable)
+--import Data.Default (Default (def))
import Data.Conduit (ResourceT)
@@ -27,6 +35,7 @@ import qualified Network.HTTP.Types as HT
import Database.CouchDB.Conduit (MonadCouch(..), Path)
import Database.CouchDB.Conduit.LowLevel (couch, protect, protect')
+
-- | Create CouchDB database.
couchPutDB :: MonadCouch m =>
Path -- ^ CouchDB Database name.
@@ -75,5 +84,28 @@ couchReplicateDB source target createTarget continuous cancel =
"target" A..= target,
"create_target" A..= createTarget,
"continuous" A..= continuous,
- "cancel" A..= cancel
- ]
+ "cancel" A..= cancel ]
+
+couchSecureDB :: MonadCouch m =>
+ Path -- ^ Database
+ -> [B.ByteString] -- ^ Admin roles
+ -> [B.ByteString] -- ^ Admin names
+ -> [B.ByteString] -- ^ Readers roles
+ -> [B.ByteString] -- ^ Readers names
+ -> ResourceT m ()
+couchSecureDB p adminRoles adminNames readersRoles readersNames =
+ couch HT.methodPut (`B.append` B.append "/" p) [] []
+ reqBody protect'
+ >> return ()
+ where
+ reqBody = H.RequestBodyLBS $ A.encode $ A.object [
+ "admins" A..= A.object [ "roles" A..= adminRoles,
+ "names" A..= adminNames ],
+ "readers" A..= A.object [ "roles" A..= readersRoles,
+ "names" A..= readersNames ] ]
+
+
+
+
+
+

0 comments on commit 2b4ed58

Please sign in to comment.
Something went wrong with that request. Please try again.