mongoDB 2.4.0.1 → 2.5.0.0
raw patch · 8 files changed
+112/−48 lines, 8 filesdep +network-bsddep ~network
Dependencies added: network-bsd
Dependency ranges changed: network
Files
- CHANGELOG.md +5/−0
- Database/MongoDB/Connection.hs +2/−6
- Database/MongoDB/GridFS.hs +19/−19
- Database/MongoDB/Internal/Network.hs +52/−0
- Database/MongoDB/Internal/Util.hs +7/−13
- Database/MongoDB/Query.hs +0/−4
- Database/MongoDB/Transport/Tls.hs +2/−2
- mongoDB.cabal +25/−4
CHANGELOG.md view
@@ -2,6 +2,11 @@ All notable changes to this project will be documented in this file. This project adheres to [Package Versioning Policy](https://wiki.haskell.org/Package_versioning_policy). +## [2.5.0.0] - 2019-06-14++### Fixed+Compatibility with network 3.0 package+ ## [2.4.0.1] - 2019-03-03 ### Fixed
Database/MongoDB/Connection.hs view
@@ -30,7 +30,6 @@ #endif import Control.Monad (forM_)-import Network (HostName, PortID(..), connectTo) import System.IO.Unsafe (unsafePerformIO) import System.Timeout (timeout) import Text.ParserCombinators.Parsec (parse, many1, letter, digit, char, eof,@@ -39,7 +38,7 @@ import Control.Monad.Identity (runIdentity)-import Control.Monad.Error (throwError)+import Control.Monad.Except (throwError) import Control.Concurrent.MVar.Lifted (MVar, newMVar, withMVar, modifyMVar, readMVar) import Data.Bson (Document, at, (=:))@@ -48,6 +47,7 @@ import qualified Data.Bson as B import qualified Data.Text as T +import Database.MongoDB.Internal.Network (HostName, PortID(..), connectTo) import Database.MongoDB.Internal.Protocol (Pipe, newPipe, close, isClosed) import Database.MongoDB.Internal.Util (untilSuccess, liftIOE, updateAssocs, shuffle, mergesortM)@@ -79,11 +79,7 @@ -- TODO: Distinguish Service and UnixSocket port showHostPort (Host hostname port) = hostname ++ ":" ++ portname where portname = case port of- Service s -> s PortNumber p -> show p-#if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS) && !defined(_WIN32)- UnixSocket s -> s-#endif readHostPortM :: (Monad m) => String -> m Host -- ^ Read string \"hostname:port\" as @Host hosthame (PortNumber port)@ or \"hostname\" as @host hostname@ (default port). Fail if string does not match either syntax.
Database/MongoDB/GridFS.hs view
@@ -27,7 +27,7 @@ import Control.Monad(when) import Control.Monad.IO.Class-import Control.Monad.Trans(MonadTrans, lift)+import Control.Monad.Trans(lift) import Data.Conduit import Data.Digest.Pure.MD5@@ -121,14 +121,14 @@ -- Used to keep data during writing data FileWriter = FileWriter- { fwChunkSize :: Int64- , fwBucket :: Bucket- , fwFilesId :: ObjectId- , fwChunkIndex :: Int- , fwSize :: Int64- , fwAcc :: L.ByteString- , fwMd5Context :: MD5Context- , fwMd5acc :: L.ByteString+ { _fwChunkSize :: Int64+ , _fwBucket :: Bucket+ , _fwFilesId :: ObjectId+ , _fwChunkIndex :: Int+ , _fwSize :: Int64+ , _fwAcc :: L.ByteString+ , _fwMd5Context :: MD5Context+ , _fwMd5acc :: L.ByteString } -- Finalize file, calculating md5 digest, saving the last chunk, and creating the file in the bucket@@ -136,10 +136,10 @@ finalizeFile filename (FileWriter chunkSize bucket files_id i size acc md5context md5acc) = do let md5digest = finalizeMD5 md5context (L.toStrict md5acc) when (L.length acc > 0) $ putChunk bucket files_id i acc- timestamp <- liftIO $ getCurrentTime+ currentTimestamp <- liftIO $ getCurrentTime let doc = [ "_id" =: files_id , "length" =: size- , "uploadDate" =: timestamp+ , "uploadDate" =: currentTimestamp , "md5" =: show (md5digest) , "chunkSize" =: chunkSize , "filename" =: filename@@ -149,13 +149,13 @@ -- finalize the remainder and return the MD5Digest. finalizeMD5 :: MD5Context -> S.ByteString -> MD5Digest-finalizeMD5 ctx rest =- md5Finalize ctx2 (S.drop lu rest) -- can only handle max md5BlockSizeInBytes length+finalizeMD5 ctx remainder =+ md5Finalize ctx2 (S.drop lu remainder) -- can only handle max md5BlockSizeInBytes length where- l = S.length rest+ l = S.length remainder r = l `mod` md5BlockSizeInBytes lu = l - r- ctx2 = md5Update ctx (S.take lu rest)+ ctx2 = md5Update ctx (S.take lu remainder) -- Write as many chunks as can be written from the file writer writeChunks :: (Monad m, MonadIO m) => FileWriter -> L.ByteString -> Action m FileWriter@@ -167,16 +167,16 @@ if (L.length md5acc_temp < md5BlockLength) then (md5context, md5acc_temp) else let numBlocks = L.length md5acc_temp `div` md5BlockLength- (current, rest) = L.splitAt (md5BlockLength * numBlocks) md5acc_temp- in (md5Update md5context (L.toStrict current), rest)+ (current, remainder) = L.splitAt (md5BlockLength * numBlocks) md5acc_temp+ in (md5Update md5context (L.toStrict current), remainder) -- Update chunks let size' = (size + L.length chunk) let acc_temp = (acc `L.append` chunk) if (L.length acc_temp < chunkSize) then return (FileWriter chunkSize bucket files_id i size' acc_temp md5context' md5acc') else do- let (chunk, acc') = L.splitAt chunkSize acc_temp- putChunk bucket files_id i chunk+ let (newChunk, acc') = L.splitAt chunkSize acc_temp+ putChunk bucket files_id i newChunk writeChunks (FileWriter chunkSize bucket files_id (i+1) size' acc' md5context' md5acc') L.empty sinkFile :: (Monad m, MonadIO m) => Bucket -> Text -> Consumer S.ByteString (Action m) File
+ Database/MongoDB/Internal/Network.hs view
@@ -0,0 +1,52 @@+-- | Compatibility layer for network package, including newtype 'PortID'+{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-}++module Database.MongoDB.Internal.Network (PortID(..), N.HostName, connectTo) where+++#if !MIN_VERSION_network(2, 9, 0)++import qualified Network as N+import System.IO (Handle)++#else++import Control.Exception (bracketOnError)+import Network.BSD as BSD+import qualified Network.Socket as N+import System.IO (Handle, IOMode(ReadWriteMode))++#endif+++-- | Wraps network's 'PortNumber'+-- Used to ease compatibility between older and newer network versions.+newtype PortID = PortNumber N.PortNumber deriving (Enum, Eq, Integral, Num, Ord, Read, Real, Show)+++#if !MIN_VERSION_network(2, 9, 0)++-- Unwrap our newtype and use network's PortID and connectTo+connectTo :: N.HostName -- Hostname+ -> PortID -- Port Identifier+ -> IO Handle -- Connected Socket+connectTo hostname (PortNumber port) = N.connectTo hostname (N.PortNumber port)++#else++-- Copied implementation from network 2.8's 'connectTo', but using our 'PortID' newtype.+-- https://github.com/haskell/network/blob/e73f0b96c9da924fe83f3c73488f7e69f712755f/Network.hs#L120-L129+connectTo :: N.HostName -- Hostname+ -> PortID -- Port Identifier+ -> IO Handle -- Connected Socket+connectTo hostname (PortNumber port) = do+ proto <- BSD.getProtocolNumber "tcp"+ bracketOnError+ (N.socket N.AF_INET N.Stream proto)+ (N.close) -- only done if there's an error+ (\sock -> do+ he <- BSD.getHostByName hostname+ N.connect sock (N.SockAddrInet port (hostAddress he))+ N.socketToHandle sock ReadWriteMode+ )+#endif
Database/MongoDB/Internal/Util.hs view
@@ -1,9 +1,7 @@--- | Miscellaneous general functions and Show, Eq, and Ord instances for PortID+-- | Miscellaneous general functions {-# LANGUAGE FlexibleInstances, UndecidableInstances, StandaloneDeriving #-} {-# LANGUAGE CPP #-}--- PortID instances-{-# OPTIONS_GHC -fno-warn-orphans #-} module Database.MongoDB.Internal.Util where @@ -14,26 +12,19 @@ import Control.Monad (liftM, liftM2) import Data.Bits (Bits, (.|.)) import Data.Word (Word8)-import Network (PortID(..)) import Numeric (showHex) import System.Random (newStdGen) import System.Random.Shuffle (shuffle') import qualified Data.ByteString as S -import Control.Monad.Error (MonadError(..), Error(..))+import Control.Monad.Except (MonadError(..)) import Control.Monad.Trans (MonadIO, liftIO) import Data.Bson import Data.Text (Text) import qualified Data.Text as T -#if !MIN_VERSION_network(2, 4, 1)-deriving instance Show PortID-deriving instance Eq PortID-#endif-deriving instance Ord PortID- -- | A monadic sort implementation derived from the non-monadic one in ghc's Prelude mergesortM :: Monad m => (a -> a -> m Ordering) -> [a] -> m [a] mergesortM cmp = mergesortM' cmp . map wrap@@ -69,9 +60,12 @@ -- ^ Repeatedy execute action, collecting results, until it returns Nothing loop act = act >>= maybe (return []) (\a -> (a :) `liftM` loop act) -untilSuccess :: (MonadError e m, Error e) => (a -> m b) -> [a] -> m b+untilSuccess :: (MonadError e m) => (a -> m b) -> [a] -> m b -- ^ Apply action to elements one at a time until one succeeds. Throw last error if all fail. Throw 'strMsg' error if list is empty.-untilSuccess = untilSuccess' (strMsg "empty untilSuccess")+untilSuccess = untilSuccess' (error "empty untilSuccess")+-- Use 'error' copying behavior in removed 'Control.Monad.Error.Error' instance:+-- instance Error Failure where strMsg = error+-- 'fail' is treated the same as a programming 'error'. In other words, don't use it. untilSuccess' :: (MonadError e m) => e -> (a -> m b) -> [a] -> m b -- ^ Apply action to elements one at a time until one succeeds. Throw last error if all fail. Throw given error if list is empty
Database/MongoDB/Query.hs view
@@ -72,7 +72,6 @@ import Control.Applicative ((<$>)) import Control.Exception (catch) import Control.Monad (when, void)-import Control.Monad.Error (Error(..)) import Control.Monad.Reader (MonadReader, ReaderT, runReaderT, ask, asks, local) import Control.Monad.Trans (MonadIO, liftIO) import Data.Binary.Put (runPut)@@ -137,9 +136,6 @@ type ErrorCode = Int -- ^ Error code from getLastError or query failure--instance Error Failure where strMsg = error--- ^ 'fail' is treated the same as a programming 'error'. In other words, don't use it. -- | Type of reads and writes to perform data AccessMode =
Database/MongoDB/Transport/Tls.hs view
@@ -39,7 +39,7 @@ import Database.MongoDB.Transport (Transport(Transport)) import qualified Database.MongoDB.Transport as T import System.IO.Error (mkIOError, eofErrorType)-import Network (connectTo, HostName, PortID)+import Database.MongoDB.Internal.Network (connectTo, HostName, PortID) import qualified Network.TLS as TLS import qualified Network.TLS.Extra.Cipher as TLS import Database.MongoDB.Query (access, slaveOk, retrieveServerData)@@ -50,7 +50,7 @@ let params = (TLS.defaultParamsClient host "") { TLS.clientSupported = def- { TLS.supportedCiphers = TLS.ciphersuite_all}+ { TLS.supportedCiphers = TLS.ciphersuite_default} , TLS.clientHooks = def { TLS.onServerCertificate = \_ _ _ _ -> return []} }
mongoDB.cabal view
@@ -1,5 +1,5 @@ Name: mongoDB-Version: 2.4.0.1+Version: 2.5.0.0 Synopsis: Driver (client) for MongoDB, a free, scalable, fast, document DBMS Description: This package lets you connect to MongoDB servers and@@ -19,6 +19,11 @@ Stability: alpha Extra-Source-Files: CHANGELOG.md +-- Imitated from https://github.com/mongodb-haskell/bson/pull/18+Flag _old-network+ description: Control whether to use <http://hackage.haskell.org/package/network-bsd network-bsd>+ manual: False+ Library GHC-options: -Wall default-language: Haskell2010@@ -34,7 +39,6 @@ , conduit-extra , mtl >= 2 , cryptohash -any- , network -any , parsec -any , random -any , random-shuffle -any@@ -54,6 +58,14 @@ , base64-bytestring >= 1.0.0.1 , nonce >= 1.0.5 + if flag(_old-network)+ -- "Network.BSD" is only available in network < 2.9+ build-depends: network < 2.9+ else+ -- "Network.BSD" has been moved into its own package `network-bsd`+ build-depends: network >= 3.0+ , network-bsd >= 2.7 && < 2.9+ Exposed-modules: Database.MongoDB Database.MongoDB.Admin Database.MongoDB.Connection@@ -61,7 +73,8 @@ Database.MongoDB.Query Database.MongoDB.Transport Database.MongoDB.Transport.Tls- Other-modules: Database.MongoDB.Internal.Protocol+ Other-modules: Database.MongoDB.Internal.Network+ Database.MongoDB.Internal.Protocol Database.MongoDB.Internal.Util Source-repository head@@ -105,7 +118,6 @@ , containers -any , mtl >= 2 , cryptohash -any- , network -any , nonce >= 1.0.5 , stm , parsec -any@@ -116,5 +128,14 @@ , transformers-base >= 0.4.1 , hashtables >= 1.1.2.0 , criterion++ if flag(_old-network)+ -- "Network.BSD" is only available in network < 2.9+ build-depends: network < 2.9+ else+ -- "Network.BSD" has been moved into its own package `network-bsd`+ build-depends: network >= 3.0+ , network-bsd >= 2.7 && < 2.9+ default-language: Haskell2010 default-extensions: OverloadedStrings