fix whitespace (mostly trailing) introduced in merge
This commit is contained in:
parent
2f452e989c
commit
34b4d22856
2 changed files with 26 additions and 26 deletions
|
@ -43,7 +43,7 @@ module Database.MongoDB
|
||||||
QueryOpt(..),
|
QueryOpt(..),
|
||||||
UpdateFlag(..),
|
UpdateFlag(..),
|
||||||
count, countMatching, delete, insert, insertMany, query, remove, update,
|
count, countMatching, delete, insert, insertMany, query, remove, update,
|
||||||
save,
|
save,
|
||||||
-- * Convenience collection operations
|
-- * Convenience collection operations
|
||||||
find, findOne, quickFind, quickFind',
|
find, findOne, quickFind, quickFind',
|
||||||
-- * Query Helpers
|
-- * Query Helpers
|
||||||
|
@ -95,8 +95,8 @@ connect = flip connectOnPort $ Network.PortNumber 27017
|
||||||
-- | Establish connections to a list of MongoDB servers
|
-- | Establish connections to a list of MongoDB servers
|
||||||
connectCluster :: [HostName] -> IO Connection
|
connectCluster :: [HostName] -> IO Connection
|
||||||
connectCluster [] = throwOpFailure "No hostnames in list"
|
connectCluster [] = throwOpFailure "No hostnames in list"
|
||||||
connectCluster xs = do
|
connectCluster xs = do
|
||||||
c <- newConnection
|
c <- newConnection
|
||||||
connectAll c xs $ Network.PortNumber 27017
|
connectAll c xs $ Network.PortNumber 27017
|
||||||
|
|
||||||
connectAll :: Connection -> [HostName] -> Network.PortID -> IO Connection
|
connectAll :: Connection -> [HostName] -> Network.PortID -> IO Connection
|
||||||
|
@ -108,12 +108,12 @@ connectAll c (host:xs) port = do
|
||||||
|
|
||||||
-- | Establish a connection to a MongoDB server on a non-standard port
|
-- | Establish a connection to a MongoDB server on a non-standard port
|
||||||
connectOnPort :: HostName -> Network.PortID -> IO Connection
|
connectOnPort :: HostName -> Network.PortID -> IO Connection
|
||||||
connectOnPort host port = do
|
connectOnPort host port = do
|
||||||
c <- newConnection
|
c <- newConnection
|
||||||
connectAll c [host] port
|
connectAll c [host] port
|
||||||
|
|
||||||
newConnection :: IO Connection
|
newConnection :: IO Connection
|
||||||
newConnection = do
|
newConnection = do
|
||||||
r <- newStdGen
|
r <- newStdGen
|
||||||
let ns = randomRs (fromIntegral (minBound :: Int32),
|
let ns = randomRs (fromIntegral (minBound :: Int32),
|
||||||
fromIntegral (maxBound :: Int32)) r
|
fromIntegral (maxBound :: Int32)) r
|
||||||
|
@ -122,19 +122,19 @@ newConnection = do
|
||||||
return $ Connection [] nsIdx nsRef
|
return $ Connection [] nsIdx nsRef
|
||||||
|
|
||||||
getHandle :: Connection -> IO Handle
|
getHandle :: Connection -> IO Handle
|
||||||
getHandle c = do
|
getHandle c = do
|
||||||
i <- readIORef $ cIndex c
|
i <- readIORef $ cIndex c
|
||||||
return $ (cHandles c) !! i
|
return $ (cHandles c) !! i
|
||||||
|
|
||||||
cPut :: Connection -> L.ByteString -> IO ()
|
cPut :: Connection -> L.ByteString -> IO ()
|
||||||
cPut c msg = getHandle c >>= flip L.hPut msg
|
cPut c msg = getHandle c >>= flip L.hPut msg
|
||||||
|
|
||||||
-- | Close database connection
|
-- | Close database connection
|
||||||
conClose :: Connection -> IO ()
|
conClose :: Connection -> IO ()
|
||||||
conClose c = sequence_ $ map hClose $ cHandles c
|
conClose c = sequence_ $ map hClose $ cHandles c
|
||||||
|
|
||||||
setTarget :: Connection -> Int -> IO ()
|
setTarget :: Connection -> Int -> IO ()
|
||||||
setTarget c i =
|
setTarget c i =
|
||||||
if i > length (cHandles c)
|
if i > length (cHandles c)
|
||||||
then throwOpFailure "Target index higher than length of list"
|
then throwOpFailure "Target index higher than length of list"
|
||||||
else writeIORef (cIndex c) i >> return ()
|
else writeIORef (cIndex c) i >> return ()
|
||||||
|
@ -546,15 +546,15 @@ update c col flags sel obj = do
|
||||||
return reqID
|
return reqID
|
||||||
|
|
||||||
-- | log into the mongodb /Database/ attached to the /Connection/
|
-- | log into the mongodb /Database/ attached to the /Connection/
|
||||||
login :: Connection -> Database -> String -> String -> IO BsonDoc
|
login :: Connection -> Database -> String -> String -> IO BsonDoc
|
||||||
login c db user pass = do
|
login c db user pass = do
|
||||||
doc <- runCommand c db (toBsonDoc [("getnonce", toBson (1 :: Int))])
|
doc <- runCommand c db (toBsonDoc [("getnonce", toBson (1 :: Int))])
|
||||||
let nonce = fromBson $ fromLookup $ BSON.lookup "nonce" doc :: String
|
let nonce = fromBson $ fromLookup $ BSON.lookup "nonce" doc :: String
|
||||||
digest = md5sum $ pack $ nonce ++ user ++
|
digest = md5sum $ pack $ nonce ++ user ++
|
||||||
( md5sum $ pack (user ++ ":mongo:" ++ pass))
|
( md5sum $ pack (user ++ ":mongo:" ++ pass))
|
||||||
request = toBsonDoc [("authenticate", toBson (1 :: Int)),
|
request = toBsonDoc [("authenticate", toBson (1 :: Int)),
|
||||||
("user", toBson user),
|
("user", toBson user),
|
||||||
("nonce", toBson nonce),
|
("nonce", toBson nonce),
|
||||||
("key", toBson digest)]
|
("key", toBson digest)]
|
||||||
in runCommand c db request
|
in runCommand c db request
|
||||||
|
|
||||||
|
@ -562,28 +562,28 @@ login c db user pass = do
|
||||||
addUser :: Connection -> Database -> String -> String -> IO BsonDoc
|
addUser :: Connection -> Database -> String -> String -> IO BsonDoc
|
||||||
addUser c db user pass = do
|
addUser c db user pass = do
|
||||||
let userDoc = toBsonDoc [(s2L"user", toBson user)]
|
let userDoc = toBsonDoc [(s2L"user", toBson user)]
|
||||||
fdb = L.append db (s2L ".system.users")
|
fdb = L.append db (s2L ".system.users")
|
||||||
doc <- liftM (maybe userDoc id) (findOne c fdb userDoc)
|
doc <- liftM (maybe userDoc id) (findOne c fdb userDoc)
|
||||||
let doc' = Map.insert (s2L "pwd")
|
let doc' = Map.insert (s2L "pwd")
|
||||||
(toBson ( md5sum $ pack (user ++ ":mongo:" ++ pass))) doc
|
(toBson ( md5sum $ pack (user ++ ":mongo:" ++ pass))) doc
|
||||||
_ <- save c fdb doc'
|
_ <- save c fdb doc'
|
||||||
return doc'
|
return doc'
|
||||||
|
|
||||||
-- | Conveniently stores the /BsonDoc/ to the /FullCollection/
|
-- | Conveniently stores the /BsonDoc/ to the /FullCollection/
|
||||||
-- | if there is an _id present in the /BsonDoc/ then it already has
|
-- | if there is an _id present in the /BsonDoc/ then it already has
|
||||||
-- | a place in the DB, so we update it using the _id, otherwise
|
-- | a place in the DB, so we update it using the _id, otherwise
|
||||||
-- | we insert it
|
-- | we insert it
|
||||||
save :: Connection -> FullCollection -> BsonDoc -> IO RequestID
|
save :: Connection -> FullCollection -> BsonDoc -> IO RequestID
|
||||||
save c fc doc =
|
save c fc doc =
|
||||||
case Map.lookup (s2L "_id") doc of
|
case Map.lookup (s2L "_id") doc of
|
||||||
Nothing -> insert c fc doc
|
Nothing -> insert c fc doc
|
||||||
Just obj -> update c fc [UFUpsert] (toBsonDoc [("_id", obj)]) doc
|
Just obj -> update c fc [UFUpsert] (toBsonDoc [("_id", obj)]) doc
|
||||||
|
|
||||||
-- | Use this in the place of the query portion of a select type query
|
-- | Use this in the place of the query portion of a select type query
|
||||||
-- | This uses javascript and a scope supplied by a /BsonDoc/ to evaluate
|
-- | This uses javascript and a scope supplied by a /BsonDoc/ to evaluate
|
||||||
-- | documents in the database for retrieval.
|
-- | documents in the database for retrieval.
|
||||||
-- | Example:
|
-- | Example:
|
||||||
-- | > findOne conn mycoll $ whereClause "this.name == (name1 + name2)"
|
-- | > findOne conn mycoll $ whereClause "this.name == (name1 + name2)"
|
||||||
-- | > (toBsonDoc [("name1", toBson "mar"), ("name2", toBson "tha")])
|
-- | > (toBsonDoc [("name1", toBson "mar"), ("name2", toBson "tha")])
|
||||||
whereClause :: String -> BsonDoc -> BsonDoc
|
whereClause :: String -> BsonDoc -> BsonDoc
|
||||||
whereClause qry scope = toBsonDoc [("$where", (BsonCodeWScope (s2L qry) scope))]
|
whereClause qry scope = toBsonDoc [("$where", (BsonCodeWScope (s2L qry) scope))]
|
||||||
|
@ -830,5 +830,5 @@ validateCollectionName col = do
|
||||||
|
|
||||||
fromLookup :: (Maybe a) -> a
|
fromLookup :: (Maybe a) -> a
|
||||||
fromLookup (Just m) = m
|
fromLookup (Just m) = m
|
||||||
fromLookup Nothing = throwColInvalid "cannot find key"
|
fromLookup Nothing = throwColInvalid "cannot find key"
|
||||||
|
|
||||||
|
|
|
@ -22,7 +22,7 @@ Build-Depends: base < 5,
|
||||||
random,
|
random,
|
||||||
time,
|
time,
|
||||||
utf8-string,
|
utf8-string,
|
||||||
nano-md5
|
nano-md5
|
||||||
Build-Type: Simple
|
Build-Type: Simple
|
||||||
Exposed-modules: Database.MongoDB,
|
Exposed-modules: Database.MongoDB,
|
||||||
Database.MongoDB.BSON
|
Database.MongoDB.BSON
|
||||||
|
|
Loading…
Reference in a new issue