adding ConnectOpts and an initial SlaveOk option

This commit is contained in:
Scott R. Parish 2010-02-26 19:06:22 -06:00
parent 2cee44d6a3
commit 08b601f124
2 changed files with 24 additions and 16 deletions

View file

@ -26,7 +26,7 @@ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
module Database.MongoDB
(
-- * Connection
Connection,
Connection, ConnectOpt(..),
connect, connectOnPort, conClose, disconnect, dropDatabase,
connectCluster, connectClusterOnPort,
serverInfo, serverShutdown,
@ -89,26 +89,31 @@ data Connection = Connection {
cRand :: IORef [Int]
}
data ConnectOpt
= SlaveOK -- ^ It's fine to connect to the slave
deriving (Show, Eq)
-- | Establish a connection to a MongoDB server
connect :: HostName -> IO Connection
connect = flip connectOnPort $ Network.PortNumber 27017
connect :: HostName -> [ConnectOpt] -> IO Connection
connect = flip connectOnPort (Network.PortNumber 27017)
-- | Establish connections to a list of MongoDB servers
connectCluster :: [HostName] -> IO Connection
connectCluster :: [HostName] -> [ConnectOpt] -> IO Connection
connectCluster xs =
connectClusterOnPort $ fmap (flip (,) $ Network.PortNumber 27017) xs
connectClusterOnPort (fmap (flip (,) $ Network.PortNumber 27017) xs)
-- | Establish connections to a list of MongoDB servers specifying each port.
connectClusterOnPort :: [(HostName, Network.PortID)] -> IO Connection
connectClusterOnPort [] = throwOpFailure "No hostnames in list"
connectClusterOnPort servers = newConnection servers
connectClusterOnPort :: [(HostName, Network.PortID)] -> [ConnectOpt]
-> IO Connection
connectClusterOnPort [] _ = throwOpFailure "No hostnames in list"
connectClusterOnPort servers opts = newConnection servers opts
-- | Establish a connection to a MongoDB server on a non-standard port
connectOnPort :: HostName -> Network.PortID -> IO Connection
connectOnPort :: HostName -> Network.PortID -> [ConnectOpt] -> IO Connection
connectOnPort host port = newConnection [(host, port)]
newConnection :: [(HostName, Network.PortID)] -> IO Connection
newConnection servers = do
newConnection :: [(HostName, Network.PortID)] -> [ConnectOpt] -> IO Connection
newConnection servers opts = do
r <- newStdGen
let ns = randomRs (fromIntegral (minBound :: Int32),
fromIntegral (maxBound :: Int32)) r
@ -116,7 +121,8 @@ newConnection servers = do
hRef <- openHandle (head servers) >>= newIORef
let c = Connection hRef nsRef
res <- isMaster c
if fromBson (fromLookup $ BSON.lookup "ismaster" res) == (1::Int)
if fromBson (fromLookup $ BSON.lookup "ismaster" res) == (1::Int) ||
isJust (List.elemIndex SlaveOK opts)
then return c
else case BSON.lookup "remote" res of
Nothing -> throwConFailure "Couldn't find master to connect to"
@ -268,8 +274,11 @@ splitFullCol col = (L.takeWhile (c2w '.' /=) col,
L.tail $ L.dropWhile (c2w '.' /=) col)
splitHostPort :: String -> (HostName, Network.PortID)
splitHostPort hp = (List.takeWhile (':' /=) hp,
Network.Service $ List.tail $ List.dropWhile (':' /=) hp)
splitHostPort hp = (host, port)
where host = List.takeWhile (':' /=) hp
port = case List.dropWhile (':' /=) hp of
"" -> Network.PortNumber 27017
pstr -> Network.Service $ List.tail pstr
-- | Run a database command. Usually this is unneeded as driver wraps
-- all of the commands for you (eg 'createCollection',

3
TODO
View file

@ -19,7 +19,6 @@ MongoDB
- hint, explain, $where
- database profiling: set/get profiling level, get profiling info
- pair mode connection
- allow connecting only to slave
- handle defunct servers
- connection fail over
- operations on database objects
@ -58,7 +57,7 @@ MongoDB
optional:
- automatic reconnection
- buffer pooling
- advanced connection management (master-server, replica pair, Option_SlaveOk)
- advanced connection management (master-server, replica pair)
- Tailable cursor support
+ support safe operations
+ auto-reconnection