Small edits to some comments. fix secondaryOk to return master only when no secondaries available

This commit is contained in:
Tony Hannan 2011-07-13 15:34:52 -04:00
parent 8672652395
commit 8025ac4ec4
5 changed files with 28 additions and 20 deletions

View file

@ -3,13 +3,14 @@
{-# LANGUAGE CPP, OverloadedStrings, ScopedTypeVariables, TupleSections #-} {-# LANGUAGE CPP, OverloadedStrings, ScopedTypeVariables, TupleSections #-}
module Database.MongoDB.Connection ( module Database.MongoDB.Connection (
-- * Util
IOE, runIOE, IOE, runIOE,
-- * Connection -- * Connection
Pipe, close, isClosed, Pipe, close, isClosed,
-- * Host -- * Server
Host(..), PortID(..), host, showHostPort, readHostPort, readHostPortM, connect, Host(..), PortID(..), defaultPort, host, showHostPort, readHostPort, readHostPortM, connect,
-- * Replica Set -- * Replica Set
ReplicaSetName, openReplicaSet, ReplicaSet, primary, secondaryOk ReplicaSetName, openReplicaSet, ReplicaSet, primary, secondaryOk, closeReplicaSet
) where ) where
import Prelude hiding (lookup) import Prelude hiding (lookup)
@ -28,7 +29,7 @@ import Data.UString (UString, unpack)
import Data.Bson as D (Document, lookup, at, (=:)) import Data.Bson as D (Document, lookup, at, (=:))
import Database.MongoDB.Query (access, slaveOk, Failure(ConnectionFailure), Command, runCommand) import Database.MongoDB.Query (access, slaveOk, Failure(ConnectionFailure), Command, runCommand)
import Database.MongoDB.Internal.Util (untilSuccess, liftIOE, runIOE, updateAssocs, shuffle) import Database.MongoDB.Internal.Util (untilSuccess, liftIOE, runIOE, updateAssocs, shuffle)
import Data.List as L (lookup, intersect, partition, (\\)) import Data.List as L (lookup, intersect, partition, (\\), delete)
adminCommand :: Command -> Pipe -> IOE Document adminCommand :: Command -> Pipe -> IOE Document
-- ^ Run command against admin database on server connected to pipe. Fail if connection fails. -- ^ Run command against admin database on server connected to pipe. Fail if connection fails.
@ -43,10 +44,11 @@ adminCommand cmd pipe =
data Host = Host HostName PortID deriving (Show, Eq, Ord) data Host = Host HostName PortID deriving (Show, Eq, Ord)
defaultPort :: PortID defaultPort :: PortID
-- ^ Default MongoDB port = 27017
defaultPort = PortNumber 27017 defaultPort = PortNumber 27017
host :: HostName -> Host host :: HostName -> Host
-- ^ Host on default MongoDB port -- ^ Host on 'defaultPort'
host hostname = Host hostname defaultPort host hostname = Host hostname defaultPort
showHostPort :: Host -> String showHostPort :: Host -> String
@ -61,7 +63,7 @@ showHostPort (Host hostname port) = hostname ++ ":" ++ portname where
#endif #endif
readHostPortM :: (Monad m) => String -> m Host readHostPortM :: (Monad m) => String -> m Host
-- ^ Read string \"hostname:port\" as @Host hosthame port@ or \"hostname\" as @host hostname@ (default port). Fail if string does not match either syntax. -- ^ Read string \"hostname:port\" as @Host hosthame (PortNumber port)@ or \"hostname\" as @host hostname@ (default port). Fail if string does not match either syntax.
-- TODO: handle Service and UnixSocket port -- TODO: handle Service and UnixSocket port
readHostPortM = either (fail . show) return . parse parser "readHostPort" where readHostPortM = either (fail . show) return . parse parser "readHostPort" where
hostname = many1 (letter <|> digit <|> char '-' <|> char '.') hostname = many1 (letter <|> digit <|> char '-' <|> char '.')
@ -75,7 +77,7 @@ readHostPortM = either (fail . show) return . parse parser "readHostPort" where
return $ Host h (PortNumber $ fromIntegral port) return $ Host h (PortNumber $ fromIntegral port)
readHostPort :: String -> Host readHostPort :: String -> Host
-- ^ Read string \"hostname:port\" as @Host hostname port@ or \"hostname\" as @host hostname@ (default port). Error if string does not match either syntax. -- ^ Read string \"hostname:port\" as @Host hostname (PortNumber port)@ or \"hostname\" as @host hostname@ (default port). Error if string does not match either syntax.
readHostPort = runIdentity . readHostPortM readHostPort = runIdentity . readHostPortM
connect :: Host -> IOE Pipe connect :: Host -> IOE Pipe
@ -98,8 +100,12 @@ openReplicaSet (rsName, seedList) = do
_ <- updateMembers rs _ <- updateMembers rs
return rs return rs
closeReplicaSet :: ReplicaSet -> IO ()
-- ^ Close all connections to replica set
closeReplicaSet (ReplicaSet _ vMembers) = withMVar vMembers $ mapM_ (maybe (return ()) close . snd)
primary :: ReplicaSet -> IOE Pipe primary :: ReplicaSet -> IOE Pipe
-- ^ Return connection to current primary of replica set -- ^ Return connection to current primary of replica set. Fail if no primary available.
primary rs@(ReplicaSet rsName _) = do primary rs@(ReplicaSet rsName _) = do
mHost <- statedPrimary <$> updateMembers rs mHost <- statedPrimary <$> updateMembers rs
case mHost of case mHost of
@ -107,11 +113,12 @@ primary rs@(ReplicaSet rsName _) = do
Nothing -> throwError $ userError $ "replica set " ++ unpack rsName ++ " has no primary" Nothing -> throwError $ userError $ "replica set " ++ unpack rsName ++ " has no primary"
secondaryOk :: ReplicaSet -> IOE Pipe secondaryOk :: ReplicaSet -> IOE Pipe
-- ^ Return connection to a random member (secondary or primary) -- ^ Return connection to a random secondary, or primary if no secondaries available.
secondaryOk rs = do secondaryOk rs = do
info <- updateMembers rs info <- updateMembers rs
hosts <- lift $ shuffle (possibleHosts info) hosts <- lift $ shuffle (possibleHosts info)
untilSuccess (connection rs Nothing) hosts let hosts' = maybe hosts (\p -> delete p hosts ++ [p]) (statedPrimary info)
untilSuccess (connection rs Nothing) hosts'
type ReplicaInfo = (Host, Document) type ReplicaInfo = (Host, Document)
-- ^ Result of isMaster command on host in replica set. Returned fields are: setName, ismaster, secondary, hosts, [primary]. primary only present when ismaster = false -- ^ Result of isMaster command on host in replica set. Returned fields are: setName, ismaster, secondary, hosts, [primary]. primary only present when ismaster = false

View file

@ -221,7 +221,7 @@ data Request =
data QueryOption = data QueryOption =
TailableCursor -- ^ Tailable means cursor is not closed when the last data is retrieved. Rather, the cursor marks the final object's position. You can resume using the cursor later, from where it was located, if more data were received. Like any "latent cursor", the cursor may become invalid at some point for example if the final object it references were deleted. Thus, you should be prepared to requery on CursorNotFound exception. TailableCursor -- ^ Tailable means cursor is not closed when the last data is retrieved. Rather, the cursor marks the final object's position. You can resume using the cursor later, from where it was located, if more data were received. Like any "latent cursor", the cursor may become invalid at some point for example if the final object it references were deleted. Thus, you should be prepared to requery on CursorNotFound exception.
| SlaveOK -- ^ Allow query of replica slave. Normally these return an error except for namespace "local". | SlaveOK -- ^ Allow query of replica slave. Normally these return an error except for namespace "local".
| NoCursorTimeout -- The server normally times out idle cursors after an inactivity period (10 minutes) to prevent excess memory use. Set this option to prevent that. | NoCursorTimeout -- ^ The server normally times out idle cursors after 10 minutes to prevent a memory leak in case a client forgets to close a cursor. Set this option to allow a cursor to live forever until it is closed.
| AwaitData -- ^ Use with TailableCursor. If we are at the end of the data, block for a while rather than returning no data. After a timeout period, we do return as normal. | AwaitData -- ^ Use with TailableCursor. If we are at the end of the data, block for a while rather than returning no data. After a timeout period, we do return as normal.
-- | Exhaust -- ^ Stream the data down full blast in multiple "more" packages, on the assumption that the client will fully read all data queried. Faster when you are pulling a lot of data and know you want to pull it all down. Note: the client is not allowed to not read all the data unless it closes the connection. -- | Exhaust -- ^ Stream the data down full blast in multiple "more" packages, on the assumption that the client will fully read all data queried. Faster when you are pulling a lot of data and know you want to pull it all down. Note: the client is not allowed to not read all the data unless it closes the connection.
deriving (Show, Eq) deriving (Show, Eq)

View file

@ -25,7 +25,7 @@ module Database.MongoDB.Query (
delete, deleteOne, delete, deleteOne,
-- * Read -- * Read
-- ** Query -- ** Query
Query(..), QueryOption(..), Projector, Limit, Order, BatchSize, Query(..), QueryOption(NoCursorTimeout), Projector, Limit, Order, BatchSize,
explain, find, findOne, fetch, count, distinct, explain, find, findOne, fetch, count, distinct,
-- *** Cursor -- *** Cursor
Cursor, next, nextN, rest, closeCursor, isCursorClosed, Cursor, next, nextN, rest, closeCursor, isCursorClosed,
@ -64,7 +64,7 @@ newtype Action m a = Action (ErrorT Failure (ReaderT Context m) a)
instance MonadTrans Action where lift = Action . lift . lift instance MonadTrans Action where lift = Action . lift . lift
access :: (MonadIO m) => Pipe -> AccessMode -> Database -> Action m a -> m (Either Failure a) access :: (MonadIO m) => Pipe -> AccessMode -> Database -> Action m a -> m (Either Failure a)
-- ^ Run action against database on server at other end of pipe. Use write mode for any writes and read mode for any reads. Return Left on connection or read/write failure. -- ^ Run action against database on server at other end of pipe. Use access mode for any reads and writes. Return Left on connection failure or read/write failure.
access myPipe myAccessMode myDatabase (Action action) = runReaderT (runErrorT action) Context{..} access myPipe myAccessMode myDatabase (Action action) = runReaderT (runErrorT action) Context{..}
-- | A connection failure, or a read or write exception like cursor expired or inserting a duplicate key. -- | A connection failure, or a read or write exception like cursor expired or inserting a duplicate key.
@ -115,9 +115,9 @@ writeMode (ConfirmWrites z) = Confirm z
-- | Values needed when executing a db operation -- | Values needed when executing a db operation
data Context = Context { data Context = Context {
myPipe :: Pipe, -- | operations read/write to this pipelined TCP connection to a MongoDB server myPipe :: Pipe, -- ^ operations read/write to this pipelined TCP connection to a MongoDB server
myAccessMode :: AccessMode, -- | read/write operation will use this access mode myAccessMode :: AccessMode, -- ^ read/write operation will use this access mode
myDatabase :: Database } -- | operations query/update this database myDatabase :: Database } -- ^ operations query/update this database
myReadMode :: Context -> ReadMode myReadMode :: Context -> ReadMode
myReadMode = readMode . myAccessMode myReadMode = readMode . myAccessMode
@ -138,7 +138,7 @@ call ns r = Action $ do
promise <- liftIOE ConnectionFailure $ P.call pipe ns r promise <- liftIOE ConnectionFailure $ P.call pipe ns r
return (liftIOE ConnectionFailure promise) return (liftIOE ConnectionFailure promise)
-- | If you stack a monad on top of 'Action' then make it an instance of this class and use 'liftDB' to execute an DB Actions within it. Instances already exist for simple mtl transformers. -- | If you stack a monad on top of 'Action' then make it an instance of this class and use 'liftDB' to execute a DB Action within it. Instances already exist for the basic mtl transformers.
class (Monad m, MonadMVar (BaseMonad m), Applicative (BaseMonad m), Functor (BaseMonad m)) => MonadDB m where class (Monad m, MonadMVar (BaseMonad m), Applicative (BaseMonad m), Functor (BaseMonad m)) => MonadDB m where
type BaseMonad m :: * -> * type BaseMonad m :: * -> *
liftDB :: Action (BaseMonad m) a -> m a liftDB :: Action (BaseMonad m) a -> m a

View file

@ -1,4 +1,4 @@
{- | Pipelining is sending multiple requests over a socket and receiving the responses later, in the same order. This is faster than sending one request, waiting for the response, then sending the next request, and so on. This implementation returns a /promise (future)/ response for each request that when invoked waits for the response if not already arrived. Multiple threads can send on the same pipeline (and get promises back); it will send each thread's request right away without waiting. {- | Pipelining is sending multiple requests over a socket and receiving the responses later in the same order (a' la HTTP pipelining). This is faster than sending one request, waiting for the response, then sending the next request, and so on. This implementation returns a /promise (future)/ response for each request that when invoked waits for the response if not already arrived. Multiple threads can send on the same pipeline (and get promises back); it will send each thread's request right away without waiting.
A pipeline closes itself when a read or write causes an error, so you can detect a broken pipeline by checking isClosed. It also closes itself when garbage collected, or you can close it explicitly. -} A pipeline closes itself when a read or write causes an error, so you can detect a broken pipeline by checking isClosed. It also closes itself when garbage collected, or you can close it explicitly. -}
@ -27,6 +27,7 @@ onException (ErrorT action) releaser = ErrorT $ do
return e return e
type IOE = ErrorT IOError IO type IOE = ErrorT IOError IO
-- ^ IO monad with explicit error
-- * IOStream -- * IOStream
@ -59,7 +60,7 @@ newPipeline stream = do
return pipe return pipe
close :: Pipeline i o -> IO () close :: Pipeline i o -> IO ()
-- | Close pipe and underlying connection -- ^ Close pipe and underlying connection
close Pipeline{..} = do close Pipeline{..} = do
killThread listenThread killThread listenThread
closeStream =<< readMVar vStream closeStream =<< readMVar vStream

View file

@ -22,7 +22,7 @@ stability: alpha
homepage: http://github.com/TonyGen/mongoDB-haskell homepage: http://github.com/TonyGen/mongoDB-haskell
package-url: package-url:
bug-reports: bug-reports:
synopsis: Driver (client) for MongoDB, a free, scalable, fast, document database management system synopsis: Driver (client) for MongoDB, a free, scalable, fast, document DBMS
description: This package lets you connect to MongoDB servers and update/query their data. Please see the example in Database.MongoDB and the tutorial from the homepage. For information about MongoDB itself, see www.mongodb.org. description: This package lets you connect to MongoDB servers and update/query their data. Please see the example in Database.MongoDB and the tutorial from the homepage. For information about MongoDB itself, see www.mongodb.org.
category: Database category: Database
author: Tony Hannan <tony@10gen.com> & Scott Parish <srp@srparish.net> author: Tony Hannan <tony@10gen.com> & Scott Parish <srp@srparish.net>