mongoDB 0.9.4 → 0.9.5

raw patch · 3 files changed

+38/−27 lines, 3 filesdep +cryptohashdep −nano-md5PVP ok

version bump matches the API change (PVP)

Dependencies added: cryptohash

Dependencies removed: nano-md5

API changes (from Hackage documentation)

Files

• Database/MongoDB/Connection.hs +22/−22
• Database/MongoDB/Internal/Protocol.hs +14/−3
• mongoDB.cabal +2/−2

@@ -16,10 +16,11 @@ 	connHost, replicaSet ) where +import Prelude hiding (lookup) import Database.MongoDB.Internal.Protocol as X import qualified Network.Abstract as C import Network.Abstract (IOE, NetworkIO, ANetwork)-import Data.Bson ((=:), at, UString)+import Data.Bson ((=:), at, lookup, UString) import Control.Pipeline as P import Control.Applicative ((<$>)) import Control.Exception (assert)@@ -44,7 +45,7 @@ 	qOptions = [SlaveOK] 	qFullCollection = "admin.$cmd" 	qSkip = 0-	qBatchSize = 0+	qBatchSize = -1 	qSelector = cmd 	qProjector = [] @@ -52,7 +53,9 @@ -- ^ Extract first document from reply. Error if query error, using given string as prefix error message. commandReply title Reply{..} = if elem QueryError rResponseFlags 	then error $ title ++ ": " ++ at "$err" (head rDocuments)-	else head rDocuments+	else if null rDocuments+		then error ("empty reply to: " ++ title)+		else head rDocuments  -- * Host @@ -103,16 +106,17 @@  -- ** Replica Info -getReplicaInfo :: Pipe -> IOE ReplicaInfo+getReplicaInfo :: ConnPool Host -> IOE ReplicaInfo -- ^ Get replica info of the connected host. Throw IOError if connection fails or host is not part of a replica set (no /hosts/ and /primary/ field).-getReplicaInfo pipe = do+getReplicaInfo conn = do+	pipe <- getHostPipe conn 	promise <- X.call pipe [] (adminCommand ["ismaster" =: (1 :: Int)]) 	info <- commandReply "ismaster" <$> promise 	_ <- look "hosts" info-	_ <- look "primary" info-	return info+	_ <- look "ismaster" info+	return $ ReplicaInfo (connHost conn) info -type ReplicaInfo = Document+data ReplicaInfo = ReplicaInfo {_infoHost :: Host, infoDoc :: Document}  deriving (Show) -- ^ Configuration info of a host in a replica set (result of /ismaster/ command). Contains all the hosts in the replica set plus its role in that set (master, slave, or arbiter)  {- isPrimary :: ReplicaInfo -> Bool@@ -123,18 +127,14 @@ -- ^ Is the replica described by this info a slave/secondary (not master or arbiter) isSecondary = true1 "secondary" -} -replicas :: ReplicaInfo -> [Host]--- ^ All replicas in set according to this replica configuration info.-replicas = map readHostPort . at "hosts"--primary :: ReplicaInfo -> Host--- ^ Read primary from configuration info-primary = readHostPort . at "primary"+primary :: ReplicaInfo -> Maybe Host+-- ^ Read primary from configuration info. During failover or minor network partition there is no primary (Nothing).+primary (ReplicaInfo host' info) = if at "ismaster" info then Just host' else readHostPort <$> lookup "primary" info -hosts :: ReplicaInfo -> [Host]--- ^ replicas with primary at head-hosts info = master : delete master members  where-	members = replicas info+replicas :: ReplicaInfo -> [Host]+-- ^ All replicas in set according to this replica configuration info with primary at head, if there is one.+replicas info = maybe members (\m -> m : delete m members) master  where+	members = map readHostPort $ at "hosts" (infoDoc info) 	master = primary info  -- * MasterOrSlaveOk@@ -219,8 +219,8 @@  getMembers :: Name -> [ConnPool Host] -> IOE [Host] -- ^ Get members of replica set, master first. Query supplied connections until config found.--- TODO: Verify config for request replica set name and not some other replica set. ismaster config should include replica set name in result but currently does not.-getMembers _repsetName connections = hosts <$> untilSuccess (getReplicaInfo <=< getHostPipe) connections+-- TODO: Verify config for request replica set name and not some other replica set. "ismaster" reply includes "setName" in result.+getMembers _repsetName connections = replicas <$> untilSuccess getReplicaInfo connections  refreshMembers :: ANetwork -> Name -> [ConnPool Host] -> IOE [ConnPool Host] -- ^ Update current members with master at head. Reuse unchanged members. Throw IOError if can't connect to any and fetch config. Dropped connections are not closed in case they still have users; they will be closed when garbage collected.@@ -246,5 +246,5 @@   {- Authors: Tony Hannan <tony@10gen.com>-   Copyright 2010 10gen Inc.+   Copyright 2011 10gen Inc.    Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at: http://www.apache.org/licenses/LICENSE-2.0. Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. -}

@@ -32,14 +32,17 @@ import Data.Bits import Data.IORef import System.IO.Unsafe (unsafePerformIO)-import Data.Digest.OpenSSL.MD5 (md5sum)+import qualified Crypto.Hash.MD5 as MD5 (hash) import Data.UString as U (pack, append, toByteString)+import qualified Data.ByteString as BS (ByteString, unpack)+import Data.Word (Word8) import System.IO.Error as E (try) import Control.Monad.Error import Control.Monad.Util (whenJust) import Network.Abstract hiding (send) import System.IO (hFlush) import Database.MongoDB.Internal.Util (hGetN, bitOr)+import Numeric (showHex)  -- Network -> Server -> (Sink, Source) -- (Sink, Source) -> Pipeline@@ -306,7 +309,15 @@ type Nonce = UString  pwHash :: Username -> Password -> UString-pwHash u p = pack . md5sum . toByteString $ u `U.append` ":mongo:" `U.append` p+pwHash u p = pack . byteStringHex . MD5.hash . toByteString $ u `U.append` ":mongo:" `U.append` p  pwKey :: Nonce -> Username -> Password -> UString-pwKey n u p = pack . md5sum . toByteString . U.append n . U.append u $ pwHash u p+pwKey n u p = pack . byteStringHex . MD5.hash . toByteString . U.append n . U.append u $ pwHash u p++byteStringHex :: BS.ByteString -> String+-- ^ Hexadecimal string representation of a byte string. Each byte yields two hexadecimal characters.+byteStringHex = concatMap byteHex . BS.unpack++byteHex :: Word8 -> String+-- ^ Two char hexadecimal representation of byte+byteHex b = (if b < 16 then ('0' :) else id) (showHex b "")

@@ -1,5 +1,5 @@ name: mongoDB-version: 0.9.4+version: 0.9.5 build-type: Simple license: OtherLicense license-file: LICENSE@@ -13,7 +13,7 @@     bytestring -any,     containers -any,     mtl >= 2,-    nano-md5 -any,+    cryptohash -any,     network -any,     parsec -any,     random -any