diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -2,6 +2,15 @@
 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.3.0] - 2017-05-31
+
+### Changed
+- Description of access function
+- Lift MonadBaseControl restriction
+- Update and delete results are squashed into one WriteResult type
+- Functions insertMany, updateMany, deleteMany are rewritten to properly report
+  various errors
+
 ## [2.2.0] - 2017-04-08
 
 ### Added
diff --git a/Database/MongoDB/Admin.hs b/Database/MongoDB/Admin.hs
--- a/Database/MongoDB/Admin.hs
+++ b/Database/MongoDB/Admin.hs
@@ -42,7 +42,6 @@
 import qualified Data.Set as Set
 
 import Control.Monad.Trans (MonadIO, liftIO)
-import Control.Monad.Trans.Control (MonadBaseControl)
 import Data.Bson (Document, Field(..), at, (=:), (=?), exclude, merge)
 import Data.Text (Text)
 
@@ -138,7 +137,7 @@
     resetIndexCache
     runCommand ["deleteIndexes" =: coll, "index" =: idxName]
 
-getIndexes :: (MonadIO m, MonadBaseControl IO m, Functor m) => Collection -> Action m [Document]
+getIndexes :: MonadIO m => Collection -> Action m [Document]
 -- ^ Get all indexes on this collection
 getIndexes coll = do
     db <- thisDatabase
@@ -191,9 +190,9 @@
 
 -- ** User
 
-allUsers :: (MonadIO m, MonadBaseControl IO m, Functor m) => Action m [Document]
+allUsers :: MonadIO m => Action m [Document]
 -- ^ Fetch all users of this database
-allUsers = map (exclude ["_id"]) <$> (rest =<< find
+allUsers = map (exclude ["_id"]) `liftM` (rest =<< find
     (select [] "system.users") {sort = ["user" =: (1 :: Int)], project = ["user" =: (1 :: Int), "readOnly" =: (1 :: Int)]})
 
 addUser :: (MonadIO m)
@@ -260,7 +259,7 @@
 totalIndexSize :: (MonadIO m) => Collection -> Action m Int
 totalIndexSize c = at "totalIndexSize" `liftM` collectionStats c
 
-totalSize :: (MonadIO m, MonadBaseControl IO m) => Collection -> Action m Int
+totalSize :: MonadIO m => Collection -> Action m Int
 totalSize coll = do
     x <- storageSize coll
     xs <- mapM isize =<< getIndexes coll
diff --git a/Database/MongoDB/GridFS.hs b/Database/MongoDB/GridFS.hs
--- a/Database/MongoDB/GridFS.hs
+++ b/Database/MongoDB/GridFS.hs
@@ -28,7 +28,6 @@
 import Control.Monad(when)
 import Control.Monad.IO.Class
 import Control.Monad.Trans(MonadTrans, lift)
-import Control.Monad.Trans.Control(MonadBaseControl)
 import Control.Monad.Trans.Resource(MonadResource(..))
 import Data.Conduit
 import Data.Digest.Pure.MD5
@@ -76,7 +75,7 @@
     Just (Binary b) -> return (Just b)
     _ -> return Nothing
 
-findFile :: (MonadIO m, MonadBaseControl IO m) => Bucket -> Selector -> Action m [File]
+findFile :: MonadIO m => Bucket -> Selector -> Action m [File]
 -- ^ Find files in the bucket
 findFile bucket sel = do
   cursor <- find $ select sel $ files bucket
diff --git a/Database/MongoDB/Internal/Util.hs b/Database/MongoDB/Internal/Util.hs
--- a/Database/MongoDB/Internal/Util.hs
+++ b/Database/MongoDB/Internal/Util.hs
@@ -65,9 +65,9 @@
 -- ^ Randomly shuffle items in list
 shuffle list = shuffle' list (length list) <$> newStdGen
 
-loop :: (Functor m, Monad m) => m (Maybe a) -> m [a]
+loop :: Monad m => m (Maybe a) -> m [a]
 -- ^ Repeatedy execute action, collecting results, until it returns Nothing
-loop act = act >>= maybe (return []) (\a -> (a :) <$> loop act)
+loop act = act >>= maybe (return []) (\a -> (a :) `liftM` loop act)
 
 untilSuccess :: (MonadError e m, Error 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 'strMsg' error if list is empty.
diff --git a/Database/MongoDB/Query.hs b/Database/MongoDB/Query.hs
--- a/Database/MongoDB/Query.hs
+++ b/Database/MongoDB/Query.hs
@@ -1,6 +1,6 @@
 -- | Query and update documents
 
-{-# LANGUAGE OverloadedStrings, RecordWildCards, NamedFieldPuns, TupleSections, FlexibleContexts, FlexibleInstances, UndecidableInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, StandaloneDeriving, TypeSynonymInstances, TypeFamilies, CPP, DeriveDataTypeable, ScopedTypeVariables #-}
+{-# LANGUAGE OverloadedStrings, RecordWildCards, NamedFieldPuns, TupleSections, FlexibleContexts, FlexibleInstances, UndecidableInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, StandaloneDeriving, TypeSynonymInstances, TypeFamilies, CPP, DeriveDataTypeable, ScopedTypeVariables, BangPatterns #-}
 
 module Database.MongoDB.Query (
     -- * Monad
@@ -22,9 +22,9 @@
     insert, insert_, insertMany, insertMany_, insertAll, insertAll_,
     -- ** Update
     save, replace, repsert, upsert, Modifier, modify, updateMany, updateAll,
-    UpdateResult, UpdateOption(..),
+    WriteResult(..), UpdateOption(..), Upserted(..),
     -- ** Delete
-    delete, deleteOne, deleteMany, deleteAll, DeleteResult, DeleteOption(..),
+    delete, deleteOne, deleteMany, deleteAll, DeleteOption(..),
     -- * Read
     -- ** Query
     Query(..), QueryOption(NoCursorTimeout, TailableCursor, AwaitData, Partial),
@@ -43,39 +43,41 @@
     MRResult, mapReduce, runMR, runMR',
     -- * Command
     Command, runCommand, runCommand1,
-    eval, retrieveServerData
+    eval, retrieveServerData, ServerData(..)
 ) where
 
 import Prelude hiding (lookup)
-import Control.Exception (Exception, throwIO, throw)
-import Control.Monad (unless, replicateM, liftM, forM, forM_)
+import Control.Exception (Exception, throwIO)
+import Control.Monad (unless, replicateM, liftM, liftM2)
 import Data.Int (Int32, Int64)
+import Data.Either (lefts, rights)
+import Data.List (foldl1')
 import Data.Maybe (listToMaybe, catMaybes, isNothing)
 import Data.Word (Word32)
 #if !MIN_VERSION_base(4,8,0)
 import Data.Monoid (mappend)
 #endif
 import Data.Typeable (Typeable)
+import System.Mem.Weak (Weak)
 
+import qualified Control.Concurrent.MVar as MV
 #if MIN_VERSION_base(4,6,0)
-import Control.Concurrent.MVar.Lifted (MVar, newMVar, mkWeakMVar,
-                                       readMVar, modifyMVar)
+import Control.Concurrent.MVar.Lifted (MVar,
+                                       readMVar)
 #else
-import Control.Concurrent.MVar.Lifted (MVar, newMVar, addMVarFinalizer,
-                                         readMVar, modifyMVar)
+import Control.Concurrent.MVar.Lifted (MVar, addMVarFinalizer,
+                                         readMVar)
 #endif
 import Control.Applicative ((<$>))
-import Control.Exception (SomeException, catch)
-import Control.Monad (when)
-import Control.Monad.Base (MonadBase)
+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 Control.Monad.Trans.Control (MonadBaseControl(..))
 import Data.Binary.Put (runPut)
 import Data.Bson (Document, Field(..), Label, Val, Value(String, Doc, Bool),
                   Javascript, at, valueAt, lookup, look, genObjectId, (=:),
-                  (=?), (!?), Val(..))
+                  (=?), (!?), Val(..), ObjectId, Value(..))
 import Data.Bson.Binary (putDocument)
 import Data.Text (Text)
 import qualified Data.Text as T
@@ -98,6 +100,7 @@
 import qualified Data.ByteString.Base16 as B16
 import qualified Data.ByteString.Base64 as B64
 import qualified Data.ByteString.Char8 as B
+import qualified Data.Either as E
 import qualified Crypto.Hash.MD5 as MD5
 import qualified Crypto.Hash.SHA1 as SHA1
 import qualified Crypto.MAC.HMAC as HMAC
@@ -106,17 +109,14 @@
 import Text.Read (readMaybe)
 import Data.Maybe (fromMaybe)
 
-#if !MIN_VERSION_base(4,6,0)
---mkWeakMVar = addMVarFinalizer
-#endif
-
 -- * Monad
 
 type Action = ReaderT MongoContext
 -- ^ A monad on top of m (which must be a MonadIO) that may access the database and may fail with a DB 'Failure'
 
 access :: (MonadIO m) => Pipe -> AccessMode -> Database -> Action m a -> m a
--- ^ 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.
+-- ^ Run action against database on server at other end of pipe. Use access mode for any reads and writes.
+-- Throw 'Failure' in case of any error.
 access mongoPipe mongoAccessMode mongoDatabase action = runReaderT action MongoContext{..}
 
 -- | A connection failure, or a read or write exception like cursor expired or inserting a duplicate key.
@@ -125,9 +125,12 @@
      ConnectionFailure IOError  -- ^ TCP connection ('Pipeline') failed. May work if you try again on the same Mongo 'Connection' which will create a new Pipe.
     | CursorNotFoundFailure CursorId  -- ^ Cursor expired because it wasn't accessed for over 10 minutes, or this cursor came from a different server that the one you are currently connected to (perhaps a fail over happen between servers in a replica set)
     | QueryFailure ErrorCode String  -- ^ Query failed for some reason as described in the string
-    | WriteFailure ErrorCode String  -- ^ Error observed by getLastError after a write, error description is in string
+    | WriteFailure Int ErrorCode String -- ^ Error observed by getLastError after a write, error description is in string, index of failed document is the first argument
+    | WriteConcernFailure Int String  -- ^ Write concern error. It's reported only by insert, update, delete commands. Not by wire protocol.
     | DocNotFound Selection  -- ^ 'fetch' found no document matching selection
     | AggregateFailure String -- ^ 'aggregate' returned an error
+    | CompoundFailure [Failure] -- ^ When we need to aggregate several failures and report them.
+    | ProtocolFailure Int String -- ^ The structure of the returned documents doesn't match what we expected
     deriving (Show, Eq, Typeable)
 instance Exception Failure
 
@@ -147,10 +150,33 @@
 type GetLastError = Document
 -- ^ Parameters for getLastError command. For example @[\"w\" =: 2]@ tells the server to wait for the write to reach at least two servers in replica set before acknowledging. See <http://www.mongodb.org/display/DOCS/Last+Error+Commands> for more options.
 
-data UpdateResult = UpdateResult
+class Result a where
+  isFailed :: a -> Bool
 
-data DeleteResult = DeleteResult
+data WriteResult = WriteResult
+                  { failed      :: Bool
+                  , nMatched    :: Int
+                  , nModified   :: Maybe Int
+                  , nRemoved    :: Int
+                  -- ^ Mongodb server before 2.6 doesn't allow to calculate this value.
+                  -- This field is meaningless if we can't calculate the number of modified documents.
+                  , upserted    :: [Upserted]
+                  , writeErrors :: [Failure]
+                  , writeConcernErrors :: [Failure]
+                  } deriving Show
 
+instance Result WriteResult where
+  isFailed = failed
+
+instance Result (Either a b) where
+  isFailed (Left _) = True
+  isFailed _ = False
+
+data Upserted = Upserted
+              { upsertedIndex :: Int
+              , upsertedId    :: ObjectId
+              } deriving Show
+
 master :: AccessMode
 -- ^ Same as 'ConfirmWrites' []
 master = ConfirmWrites []
@@ -313,7 +339,7 @@
 type Collection = Text
 -- ^ Collection name (not prefixed with database)
 
-allCollections :: (MonadIO m, MonadBaseControl IO m) => Action m [Collection]
+allCollections :: MonadIO m => Action m [Collection]
 -- ^ List all collections in this database
 allCollections = do
     p <- asks mongoPipe
@@ -371,12 +397,13 @@
     | Confirm GetLastError  -- ^ Receive an acknowledgment after every write, and raise exception if one says the write failed. This is acomplished by sending the getLastError command, with given 'GetLastError' parameters, after every write.
     deriving (Show, Eq)
 
-write :: Notice -> Action IO ()
+write :: Notice -> Action IO (Maybe Document)
 -- ^ Send write to server, and if write-mode is 'Safe' then include getLastError request and raise 'WriteFailure' if it reports an error.
 write notice = asks mongoWriteMode >>= \mode -> case mode of
     NoConfirm -> do
       pipe <- asks mongoPipe
       liftIOE ConnectionFailure $ P.send pipe [notice]
+      return Nothing
     Confirm params -> do
         let q = query (("getlasterror" =: (1 :: Int)) : params) "$cmd"
         pipe <- asks mongoPipe
@@ -384,22 +411,29 @@
           r <- queryRequest False q {limit = 1}
           rr <- liftIO $ request pipe [notice] r
           fulfill rr
-        case lookup "err" doc of
-            Nothing -> return ()
-            Just err -> liftIO $ throwIO $ WriteFailure (maybe 0 id $ lookup "code" doc) err
+        return $ Just doc
 
 -- ** Insert
 
 insert :: (MonadIO m) => Collection -> Document -> Action m Value
 -- ^ Insert document into collection and return its \"_id\" value, which is created automatically if not supplied
-insert col doc = head `liftM` insertBlock [] col [doc]
+insert col doc = do
+  doc' <- liftIO $ assignId doc
+  res <- insertBlock [] col (0, [doc'])
+  case res of
+    Left failure -> liftIO $ throwIO failure
+    Right r -> return $ head r
 
 insert_ :: (MonadIO m) => Collection -> Document -> Action m ()
 -- ^ Same as 'insert' except don't return _id
 insert_ col doc = insert col doc >> return ()
 
 insertMany :: (MonadIO m) => Collection -> [Document] -> Action m [Value]
--- ^ Insert documents into collection and return their \"_id\" values, which are created automatically if not supplied. If a document fails to be inserted (eg. due to duplicate key) then remaining docs are aborted, and LastError is set.
+-- ^ Insert documents into collection and return their \"_id\" values,
+-- which are created automatically if not supplied.
+-- If a document fails to be inserted (eg. due to duplicate key)
+-- then remaining docs are aborted, and LastError is set.
+-- An exception will be throw if any error occurs.
 insertMany = insert' []
 
 insertMany_ :: (MonadIO m) => Collection -> [Document] -> Action m ()
@@ -407,7 +441,10 @@
 insertMany_ col docs = insertMany col docs >> return ()
 
 insertAll :: (MonadIO m) => Collection -> [Document] -> Action m [Value]
--- ^ Insert documents into collection and return their \"_id\" values, which are created automatically if not supplied. If a document fails to be inserted (eg. due to duplicate key) then remaining docs are still inserted. LastError is set if any doc fails, not just last one.
+-- ^ Insert documents into collection and return their \"_id\" values,
+-- which are created automatically if not supplied. If a document fails
+-- to be inserted (eg. due to duplicate key) then remaining docs
+-- are still inserted.
 insertAll = insert' [KeepGoing]
 
 insertAll_ :: (MonadIO m) => Collection -> [Document] -> Action m ()
@@ -422,75 +459,107 @@
           , "writeConcern" =: writeConcern
           ]
 
+takeRightsUpToLeft :: [Either a b] -> [b]
+takeRightsUpToLeft l = E.rights $ takeWhile E.isRight l
+
 insert' :: (MonadIO m)
         => [InsertOption] -> Collection -> [Document] -> Action m [Value]
 -- ^ Insert documents into collection and return their \"_id\" values, which are created automatically if not supplied
 insert' opts col docs = do
   p <- asks mongoPipe
   let sd = P.serverData p
+  docs' <- liftIO $ mapM assignId docs
   mode <- asks mongoWriteMode
   let writeConcern = case mode of
                         NoConfirm -> ["w" =: (0 :: Int)]
                         Confirm params -> params
   let docSize = sizeOfDocument $ insertCommandDocument opts col [] writeConcern
-  chunks <- forM (splitAtLimit
-                      (not (KeepGoing `elem` opts))
+  let ordered = (not (KeepGoing `elem` opts))
+  let preChunks = splitAtLimit
                       (maxBsonObjectSize sd - docSize)
                                            -- size of auxiliary part of insert
                                            -- document should be subtracted from
                                            -- the overall size
                       (maxWriteBatchSize sd)
-                      docs)
-                 (insertBlock opts col)
-  return $ concat chunks
+                      docs'
+  let chunks =
+        if ordered
+            then takeRightsUpToLeft preChunks
+            else rights preChunks
 
+  let lens = map length chunks
+  let lSums = 0 : (zipWith (+) lSums lens)
+
+  chunkResults <- interruptibleFor ordered (zip lSums chunks) $ insertBlock opts col
+
+  let lchunks = lefts preChunks
+  when (not $ null lchunks) $ do
+    liftIO $ throwIO $ head lchunks
+
+  let lresults = lefts chunkResults
+  when (not $ null lresults) $ liftIO $ throwIO $ head lresults
+  return $ concat $ rights chunkResults
+
 insertBlock :: (MonadIO m)
-            => [InsertOption] -> Collection -> [Document] -> Action m [Value]
+            => [InsertOption] -> Collection -> (Int, [Document]) -> Action m (Either Failure [Value])
 -- ^ This will fail if the list of documents is bigger than restrictions
-insertBlock _ _ [] = return []
-insertBlock opts col docs = do
+insertBlock _ _ (_, []) = return $ Right []
+insertBlock opts col (prevCount, docs) = do
     db <- thisDatabase
-    docs' <- liftIO $ mapM assignId docs
 
     p <- asks mongoPipe
     let sd = P.serverData p
     if (maxWireVersion sd < 2)
       then do
-        liftDB $ write (Insert (db <.> col) opts docs')
-        return $ map (valueAt "_id") docs'
+        res <- liftDB $ write (Insert (db <.> col) opts docs)
+        let errorMessage = do
+              jRes <- res
+              em <- lookup "err" jRes
+              return $ WriteFailure prevCount (maybe 0 id $ lookup "code" jRes)  em
+              -- In older versions of ^^ the protocol we can't really say which document failed.
+              -- So we just report the accumulated number of documents in the previous blocks.
+
+        case errorMessage of
+          Just failure -> return $ Left failure
+          Nothing -> return $ Right $ map (valueAt "_id") docs
       else do
         mode <- asks mongoWriteMode
         let writeConcern = case mode of
                               NoConfirm -> ["w" =: (0 :: Int)]
                               Confirm params -> params
-        doc <- runCommand $ insertCommandDocument opts col docs' writeConcern
+        doc <- runCommand $ insertCommandDocument opts col docs writeConcern
         case (look "writeErrors" doc, look "writeConcernError" doc) of
-          (Nothing, Nothing) -> return $ map (valueAt "_id") docs'
-          (Just err, Nothing) -> do
-            liftIO $ throwIO $ WriteFailure
-                                    (maybe 0 id $ lookup "ok" doc)
-                                    (show err)
+          (Nothing, Nothing) -> return $ Right $ map (valueAt "_id") docs
+          (Just (Array errs), Nothing) -> do
+            let writeErrors = map (anyToWriteError prevCount) $ errs
+            let errorsWithFailureIndex = map (addFailureIndex prevCount) writeErrors
+            return $ Left $ CompoundFailure errorsWithFailureIndex
           (Nothing, Just err) -> do
-            liftIO $ throwIO $ WriteFailure
+            return $ Left $ WriteFailure
+                                    prevCount
                                     (maybe 0 id $ lookup "ok" doc)
                                     (show err)
-          (Just err, Just writeConcernErr) -> do
-            liftIO $ throwIO $ WriteFailure
+          (Just (Array errs), Just writeConcernErr) -> do
+            let writeErrors = map (anyToWriteError prevCount) $ errs
+            let errorsWithFailureIndex = map (addFailureIndex prevCount) writeErrors
+            return $ Left $ CompoundFailure $ (WriteFailure
+                                    prevCount
                                     (maybe 0 id $ lookup "ok" doc)
-                                    (show err ++ show writeConcernErr)
+                                    (show writeConcernErr)) : errorsWithFailureIndex
+          (Just unknownValue, Nothing) -> do
+            return $ Left $ ProtocolFailure prevCount $ "Expected array of errors. Received: " ++ show unknownValue
+          (Just unknownValue, Just writeConcernErr) -> do
+            return $ Left $ CompoundFailure $ [ ProtocolFailure prevCount $ "Expected array of errors. Received: " ++ show unknownValue
+                                              , WriteFailure prevCount (maybe 0 id $ lookup "ok" doc) $ show writeConcernErr]
 
-splitAtLimit :: Bool -> Int -> Int -> [Document] -> [[Document]]
-splitAtLimit ordered maxSize maxCount list = chop (go 0 0 []) list
+splitAtLimit :: Int -> Int -> [Document] -> [Either Failure [Document]]
+splitAtLimit maxSize maxCount list = chop (go 0 0 []) list
   where
-    go :: Int -> Int -> [Document] -> [Document] -> ([Document], [Document])
-    go _ _ res [] = (reverse res, [])
+    go :: Int -> Int -> [Document] -> [Document] -> ((Either Failure [Document]), [Document])
+    go _ _ res [] = (Right $ reverse res, [])
     go curSize curCount [] (x:xs) |
       ((curSize + (sizeOfDocument x) + 2 + curCount) > maxSize) =
-        if (not ordered)
-          then
-            go curSize curCount [] xs -- Skip this document and insert the other documents.
-          else
-            throw $ WriteFailure 0 "One document is too big for the message"
+        (Left $ WriteFailure 0 0 "One document is too big for the message", xs)
     go curSize curCount res (x:xs) =
       if (   ((curSize + (sizeOfDocument x) + 2 + curCount) > maxSize)
                                  -- we have ^ 2 brackets and curCount commas in
@@ -498,7 +567,7 @@
                                  -- account
           || ((curCount + 1) > maxCount))
         then
-          (reverse res, x:xs)
+          (Right $ reverse res, x:xs)
         else
           go (curSize + (sizeOfDocument x)) (curCount + 1) (x:res) xs
 
@@ -552,8 +621,9 @@
        => [UpdateOption] -> Selection -> Document -> Action m ()
 -- ^ Update first document in selection using updater document, unless 'MultiUpdate' option is supplied then update all documents in selection. If 'Upsert' option is supplied then treat updater as document and insert it if selection is empty.
 update opts (Select sel col) up = do
-  _ <- update' True col [(sel, up, opts)]
-  return ()
+    db <- thisDatabase
+    ctx <- ask
+    liftIO $ runReaderT (void $ write (Update (db <.> col) opts sel up)) ctx
 
 updateCommandDocument :: Collection -> Bool -> [Document] -> Document -> Document
 updateCommandDocument col ordered updates writeConcern =
@@ -565,31 +635,36 @@
 
 {-| Bulk update operation. If one update fails it will not update the remaining
  - documents. Current returned value is only a place holder. With mongodb server
- - before 2.6 it will send update requests one by one. After 2.6 it will use
- - bulk update feature in mongodb.
+ - before 2.6 it will send update requests one by one. In order to receive
+ - error messages in versions under 2.6 you need to user confirmed writes.
+ - Otherwise even if the errors had place the list of errors will be empty and
+ - the result will be success.  After 2.6 it will use bulk update feature in
+ - mongodb.
  -}
 updateMany :: (MonadIO m)
            => Collection
            -> [(Selector, Document, [UpdateOption])]
-           -> Action m UpdateResult
+           -> Action m WriteResult
 updateMany = update' True
 
 {-| Bulk update operation. If one update fails it will proceed with the
- - remaining documents. Current returned value is only a place holder. With
- - mongodb server before 2.6 it will send update requests one by one. After 2.6
- - it will use bulk update feature in mongodb.
+ - remaining documents. With mongodb server before 2.6 it will send update
+ - requests one by one. In order to receive error messages in versions under
+ - 2.6 you need to use confirmed writes.  Otherwise even if the errors had
+ - place the list of errors will be empty and the result will be success.
+ - After 2.6 it will use bulk update feature in mongodb.
  -}
 updateAll :: (MonadIO m)
            => Collection
            -> [(Selector, Document, [UpdateOption])]
-           -> Action m UpdateResult
+           -> Action m WriteResult
 updateAll = update' False
 
 update' :: (MonadIO m)
         => Bool
         -> Collection
         -> [(Selector, Document, [UpdateOption])]
-        -> Action m UpdateResult
+        -> Action m WriteResult
 update' ordered col updateDocs = do
   p <- asks mongoPipe
   let sd = P.serverData p
@@ -600,66 +675,160 @@
                 updateDocs
 
   mode <- asks mongoWriteMode
-  let writeConcern = case mode of
-                        NoConfirm -> ["w" =: (0 :: Int)]
-                        Confirm params -> params
-  let docSize = sizeOfDocument $ updateCommandDocument col ordered [] writeConcern
-  let chunks = splitAtLimit
-                      ordered
-                      (maxBsonObjectSize sd - docSize)
-                                           -- size of auxiliary part of update
-                                           -- document should be subtracted from
-                                           -- the overall size
-                      (maxWriteBatchSize sd)
-                      updates
-  forM_ chunks (updateBlock ordered col)
-  return UpdateResult
+  ctx <- ask
+  liftIO $ do
+    let writeConcern = case mode of
+                          NoConfirm -> ["w" =: (0 :: Int)]
+                          Confirm params -> params
+    let docSize = sizeOfDocument $ updateCommandDocument
+                                                      col
+                                                      ordered
+                                                      []
+                                                      writeConcern
+    let preChunks = splitAtLimit
+                        (maxBsonObjectSize sd - docSize)
+                                             -- size of auxiliary part of update
+                                             -- document should be subtracted from
+                                             -- the overall size
+                        (maxWriteBatchSize sd)
+                        updates
+    let chunks =
+          if ordered
+              then takeRightsUpToLeft preChunks
+              else rights preChunks
+    let lens = map length chunks
+    let lSums = 0 : (zipWith (+) lSums lens)
+    blocks <- interruptibleFor ordered (zip lSums chunks) $ \b -> do
+      ur <- runReaderT (updateBlock ordered col b) ctx
+      return ur
+      `catch` \(e :: Failure) -> do
+        return $ WriteResult True 0 Nothing 0 [] [e] []
+    let failedTotal = or $ map failed blocks
+    let updatedTotal = sum $ map nMatched blocks
+    let modifiedTotal =
+          if all isNothing $ map nModified blocks
+            then Nothing
+            else Just $ sum $ catMaybes $ map nModified blocks
+    let totalWriteErrors = concat $ map writeErrors blocks
+    let totalWriteConcernErrors = concat $ map writeConcernErrors blocks
 
+    let upsertedTotal = concat $ map upserted blocks
+    return $ WriteResult
+                  failedTotal
+                  updatedTotal
+                  modifiedTotal
+                  0 -- nRemoved
+                  upsertedTotal
+                  totalWriteErrors
+                  totalWriteConcernErrors
+
+    `catch` \(e :: Failure) -> return $ WriteResult True 0 Nothing 0 [] [e] []
+
 updateBlock :: (MonadIO m)
-            => Bool -> Collection -> [Document] -> Action m ()
-updateBlock ordered col docs = do
+            => Bool -> Collection -> (Int, [Document]) -> Action m WriteResult
+updateBlock ordered col (prevCount, docs) = do
   p <- asks mongoPipe
   let sd = P.serverData p
   if (maxWireVersion sd < 2)
-    then do
-      db <- thisDatabase
-      ctx <- ask
-      errors <-
-        liftIO $ forM docs $ \updateDoc -> do
-          let doc = (at "u" updateDoc) :: Document
-          let sel = (at "q" updateDoc) :: Document
-          let upsrt = if at "upsert" updateDoc then [Upsert] else []
-          let multi = if at "multi" updateDoc then [MultiUpdate] else []
-          runReaderT (write (Update (db <.> col) (upsrt ++ multi) sel doc)) ctx
-          return Nothing
-          `catch` \(e :: SomeException) -> do
-                     when ordered $ liftIO $ throwIO e
-                     return $ Just e
-      let onlyErrors = catMaybes errors
-      if not $ null onlyErrors
-        then liftIO $ throwIO $ WriteFailure 0 (show onlyErrors)
-        else return ()
+    then liftIO $ ioError $ userError "updateMany doesn't support mongodb older than 2.6"
     else do
       mode <- asks mongoWriteMode
       let writeConcern = case mode of
                           NoConfirm -> ["w" =: (0 :: Int)]
                           Confirm params -> params
       doc <- runCommand $ updateCommandDocument col ordered docs writeConcern
-      case (look "writeErrors" doc, look "writeConcernError" doc) of
-        (Nothing, Nothing) -> return ()
-        (Just err, Nothing) -> do
-          liftIO $ throwIO $ WriteFailure
-                                  (maybe 0 id $ lookup "ok" doc)
-                                  (show err)
-        (Nothing, Just err) -> do
-          liftIO $ throwIO $ WriteFailure
-                                  (maybe 0 id $ lookup "ok" doc)
-                                  (show err)
-        (Just err, Just writeConcernErr) -> do
-          liftIO $ throwIO $ WriteFailure
-                                  (maybe 0 id $ lookup "ok" doc)
-                                  (show err ++ show writeConcernErr)
 
+      let n = fromMaybe 0 $ doc !? "n"
+      let writeErrorsResults =
+            case look "writeErrors" doc of
+              Nothing -> WriteResult False 0 (Just 0) 0 [] [] []
+              Just (Array err) -> WriteResult True 0 (Just 0) 0 [] (map (anyToWriteError prevCount) err) []
+              Just unknownErr -> WriteResult
+                                      True
+                                      0
+                                      (Just 0)
+                                      0
+                                      []
+                                      [ ProtocolFailure
+                                            prevCount
+                                          $ "Expected array of error docs, but received: "
+                                              ++ (show unknownErr)]
+                                      []
+
+      let writeConcernResults =
+            case look "writeConcernError" doc of
+              Nothing ->  WriteResult False 0 (Just 0) 0 [] [] []
+              Just (Doc err) -> WriteResult
+                                    True
+                                    0
+                                    (Just 0)
+                                    0
+                                    []
+                                    []
+                                    [ WriteConcernFailure
+                                        (fromMaybe (-1) $ err !? "code")
+                                        (fromMaybe "" $ err !? "errmsg")
+                                    ]
+              Just unknownErr -> WriteResult
+                                      True
+                                      0
+                                      (Just 0)
+                                      0
+                                      []
+                                      []
+                                      [ ProtocolFailure
+                                            prevCount
+                                          $ "Expected doc in writeConcernError, but received: "
+                                              ++ (show unknownErr)]
+
+      let upsertedList = map docToUpserted $ fromMaybe [] (doc !? "upserted")
+      liftIO $ putStrLn $ show doc
+      let successResults = WriteResult False n (doc !? "nModified") 0 upsertedList [] []
+      return $ foldl1' mergeWriteResults [writeErrorsResults, writeConcernResults, successResults]
+
+
+interruptibleFor :: (Monad m, Result b) => Bool -> [a] -> (a -> m b) -> m [b]
+interruptibleFor ordered = go []
+  where
+    go !res [] _ = return $ reverse res
+    go !res (x:xs) f = do
+      y <- f x
+      if isFailed y && ordered
+        then return $ reverse (y:res)
+        else go (y:res) xs f
+
+mergeWriteResults :: WriteResult -> WriteResult -> WriteResult
+mergeWriteResults
+  (WriteResult failed1 nMatched1 nModified1 nDeleted1 upserted1 writeErrors1 writeConcernErrors1)
+  (WriteResult failed2 nMatched2 nModified2 nDeleted2 upserted2 writeErrors2 writeConcernErrors2) =
+    (WriteResult
+        (failed1 || failed2)
+        (nMatched1 + nMatched2)
+        ((liftM2 (+)) nModified1 nModified2)
+        (nDeleted1 + nDeleted2)
+        -- This function is used in foldl1' function. The first argument is the accumulator.
+        -- The list in the accumulator is usually longer than the subsequent value which goes in the second argument.
+        -- So, changing the order of list concatenation allows us to keep linear complexity of the
+        -- whole list accumulation process.
+        (upserted2 ++ upserted1)
+        (writeErrors2 ++ writeErrors1)
+        (writeConcernErrors2 ++ writeConcernErrors1)
+        )
+
+
+docToUpserted :: Document -> Upserted
+docToUpserted doc = Upserted ind uid
+  where
+    ind = at "index" doc
+    uid = at "_id"   doc
+
+docToWriteError :: Document -> Failure
+docToWriteError doc = WriteFailure ind code msg
+  where
+    ind  = at "index"  doc
+    code = at "code"   doc
+    msg  = at "errmsg" doc
+
 -- ** Delete
 
 delete :: (MonadIO m)
@@ -675,8 +844,9 @@
 deleteHelper :: (MonadIO m)
              => [DeleteOption] -> Selection -> Action m ()
 deleteHelper opts (Select sel col) = do
-  _ <- delete' True col [(sel, opts)]
-  return ()
+    db <- thisDatabase
+    ctx <- ask
+    liftIO $ runReaderT (void $ write (Delete (db <.> col) opts sel)) ctx
 
 {-| Bulk delete operation. If one delete fails it will not delete the remaining
  - documents. Current returned value is only a place holder. With mongodb server
@@ -686,7 +856,7 @@
 deleteMany :: (MonadIO m)
            => Collection
            -> [(Selector, [DeleteOption])]
-           -> Action m DeleteResult
+           -> Action m WriteResult
 deleteMany = delete' True
 
 {-| Bulk delete operation. If one delete fails it will proceed with the
@@ -697,7 +867,7 @@
 deleteAll :: (MonadIO m)
           => Collection
           -> [(Selector, [DeleteOption])]
-          -> Action m DeleteResult
+          -> Action m WriteResult
 deleteAll = delete' False
 
 deleteCommandDocument :: Collection -> Bool -> [Document] -> Document -> Document
@@ -712,7 +882,7 @@
         => Bool
         -> Collection
         -> [(Selector, [DeleteOption])]
-        -> Action m DeleteResult
+        -> Action m WriteResult
 delete' ordered col deleteDocs = do
   p <- asks mongoPipe
   let sd = P.serverData p
@@ -728,60 +898,95 @@
                         NoConfirm -> ["w" =: (0 :: Int)]
                         Confirm params -> params
   let docSize = sizeOfDocument $ deleteCommandDocument col ordered [] writeConcern
-  let chunks = splitAtLimit
-                      ordered
+  let preChunks = splitAtLimit
                       (maxBsonObjectSize sd - docSize)
                                            -- size of auxiliary part of delete
                                            -- document should be subtracted from
                                            -- the overall size
                       (maxWriteBatchSize sd)
                       deletes
-  forM_ chunks (deleteBlock ordered col)
-  return DeleteResult
+  let chunks =
+        if ordered
+            then takeRightsUpToLeft preChunks
+            else rights preChunks
+  ctx <- ask
+  let lens = map length chunks
+  let lSums = 0 : (zipWith (+) lSums lens)
+  blockResult <- liftIO $ interruptibleFor ordered (zip lSums chunks) $ \b -> do
+    dr <- runReaderT (deleteBlock ordered col b) ctx
+    return dr
+    `catch` \(e :: Failure) -> do
+      return $ WriteResult True 0 Nothing 0 [] [e] []
+  return $ foldl1' mergeWriteResults blockResult
 
+
+addFailureIndex :: Int -> Failure -> Failure
+addFailureIndex i (WriteFailure ind code s) = WriteFailure (ind + i) code s
+addFailureIndex _ f = f
+
 deleteBlock :: (MonadIO m)
-            => Bool -> Collection -> [Document] -> Action m ()
-deleteBlock ordered col docs = do
+            => Bool -> Collection -> (Int, [Document]) -> Action m WriteResult
+deleteBlock ordered col (prevCount, docs) = do
   p <- asks mongoPipe
   let sd = P.serverData p
   if (maxWireVersion sd < 2)
-    then do
-      db <- thisDatabase
-      ctx <- ask
-      errors <-
-        liftIO $ forM docs $ \deleteDoc -> do
-          let sel = (at "q" deleteDoc) :: Document
-          let opts = if at "limit" deleteDoc == (1 :: Int) then [SingleRemove] else []
-          runReaderT (write (Delete (db <.> col) opts sel)) ctx
-          return Nothing
-          `catch` \(e :: SomeException) -> do
-                     when ordered $ liftIO $ throwIO e
-                     return $ Just e
-      let onlyErrors = catMaybes errors
-      if not $ null onlyErrors
-        then liftIO $ throwIO $ WriteFailure 0 (show onlyErrors)
-        else return ()
+    then liftIO $ ioError $ userError "deleteMany doesn't support mongodb older than 2.6"
     else do
       mode <- asks mongoWriteMode
       let writeConcern = case mode of
                           NoConfirm -> ["w" =: (0 :: Int)]
                           Confirm params -> params
       doc <- runCommand $ deleteCommandDocument col ordered docs writeConcern
-      case (look "writeErrors" doc, look "writeConcernError" doc) of
-        (Nothing, Nothing) -> return ()
-        (Just err, Nothing) -> do
-          liftIO $ throwIO $ WriteFailure
-                                  (maybe 0 id $ lookup "ok" doc)
-                                  (show err)
-        (Nothing, Just err) -> do
-          liftIO $ throwIO $ WriteFailure
-                                  (maybe 0 id $ lookup "ok" doc)
-                                  (show err)
-        (Just err, Just writeConcernErr) -> do
-          liftIO $ throwIO $ WriteFailure
-                                  (maybe 0 id $ lookup "ok" doc)
-                                  (show err ++ show writeConcernErr)
+      let n = fromMaybe 0 $ doc !? "n"
+      liftIO $ putStrLn $ "result of delete block: " ++ (show n)
 
+      let successResults = WriteResult False 0 Nothing n [] [] []
+      let writeErrorsResults =
+            case look "writeErrors" doc of
+              Nothing ->  WriteResult False 0 Nothing 0 [] [] []
+              Just (Array err) -> WriteResult True 0 Nothing 0 [] (map (anyToWriteError prevCount) err) []
+              Just unknownErr -> WriteResult
+                                      True
+                                      0
+                                      Nothing
+                                      0
+                                      []
+                                      [ ProtocolFailure
+                                            prevCount
+                                          $ "Expected array of error docs, but received: "
+                                              ++ (show unknownErr)]
+                                      []
+      let writeConcernResults =
+            case look "writeConcernError" doc of
+              Nothing ->  WriteResult False 0 Nothing 0 [] [] []
+              Just (Doc err) -> WriteResult
+                                    True
+                                    0
+                                    Nothing
+                                    0
+                                    []
+                                    []
+                                    [ WriteConcernFailure
+                                        (fromMaybe (-1) $ err !? "code")
+                                        (fromMaybe "" $ err !? "errmsg")
+                                    ]
+              Just unknownErr -> WriteResult
+                                      True
+                                      0
+                                      Nothing
+                                      0
+                                      []
+                                      []
+                                      [ ProtocolFailure
+                                            prevCount
+                                          $ "Expected doc in writeConcernError, but received: "
+                                              ++ (show unknownErr)]
+      return $ foldl1' mergeWriteResults [successResults, writeErrorsResults, writeConcernResults]
+
+anyToWriteError :: Int -> Value -> Failure
+anyToWriteError _ (Doc d) = docToWriteError d
+anyToWriteError ind _ = ProtocolFailure ind "Unknown bson value"
+
 -- * Read
 
 data ReadMode =
@@ -824,7 +1029,7 @@
 -- ^ Selects documents in collection that match selector. It uses no query options, projects all fields, does not skip any documents, does not limit result size, uses default batch size, does not sort, does not hint, and does not snapshot.
 query sel col = Query [] (Select sel col) [] 0 0 [] False 0 []
 
-find :: (MonadIO m, MonadBaseControl IO m) => Query -> Action m Cursor
+find :: MonadIO m => Query -> Action m Cursor
 -- ^ Fetch documents satisfying query
 find q@Query{selection, batchSize} = do
     db <- thisDatabase
@@ -839,7 +1044,7 @@
     pipe <- asks mongoPipe
     qr <- queryRequest False q {limit = 1}
     rq <- liftIO $ request pipe [] qr
-    Batch _ _ docs <- fulfill rq
+    Batch _ _ docs <- liftDB $ fulfill rq
     return (listToMaybe docs)
 
 fetch :: (MonadIO m) => Query -> Action m Document
@@ -928,7 +1133,7 @@
     pipe <- asks mongoPipe
     qr <- queryRequest True q {limit = 1}
     r <- liftIO $ request pipe [] qr
-    Batch _ _ docs <- fulfill r
+    Batch _ _ docs <- liftDB $ fulfill r
     return $ if null docs then error ("no explain: " ++ show q) else head docs
 
 count :: (MonadIO m) => Query -> Action m Int
@@ -997,7 +1202,7 @@
         CursorNotFound -> throwIO $ CursorNotFoundFailure rCursorId
         QueryError -> throwIO $ QueryFailure (at "code" $ head rDocuments) (at "$err" $ head rDocuments)
 
-fulfill :: (MonadIO m) => DelayedBatch -> Action m Batch
+fulfill :: DelayedBatch -> Action IO Batch
 -- ^ Demand and wait for result, raise failure if exception
 fulfill = liftIO
 
@@ -1006,22 +1211,19 @@
 data Cursor = Cursor FullCollection BatchSize (MVar DelayedBatch)
 -- ^ Iterator over results of a query. Use 'next' to iterate or 'rest' to get all results. A cursor is closed when it is explicitly closed, all results have been read from it, garbage collected, or not used for over 10 minutes (unless 'NoCursorTimeout' option was specified in 'Query'). Reading from a closed cursor raises a 'CursorNotFoundFailure'. Note, a cursor is not closed when the pipe is closed, so you can open another pipe to the same server and continue using the cursor.
 
-newCursor :: (MonadIO m, MonadBaseControl IO m) => Database -> Collection -> BatchSize -> DelayedBatch -> Action m Cursor
+newCursor :: MonadIO m => Database -> Collection -> BatchSize -> DelayedBatch -> Action m Cursor
 -- ^ Create new cursor. If you don't read all results then close it. Cursor will be closed automatically when all results are read from it or when eventually garbage collected.
 newCursor db col batchSize dBatch = do
-    var <- newMVar dBatch
+    var <- liftIO $ MV.newMVar dBatch
     let cursor = Cursor (db <.> col) batchSize var
-    _ <- mkWeakMVar var (closeCursor cursor)
+    _ <- liftDB $ mkWeakMVar var (closeCursor cursor)
     return cursor
-#if !MIN_VERSION_base(4,6,0)
-  where mkWeakMVar = addMVarFinalizer
-#endif
 
-nextBatch :: (MonadIO m, MonadBaseControl IO m) => Cursor -> Action m [Document]
+nextBatch :: MonadIO m => Cursor -> Action m [Document]
 -- ^ Return next batch of documents in query result, which will be empty if finished.
-nextBatch (Cursor fcol batchSize var) = modifyMVar var $ \dBatch -> do
+nextBatch (Cursor fcol batchSize var) = liftDB $ modifyMVar var $ \dBatch -> do
     -- Pre-fetch next batch promise from server and return current batch.
-    Batch mLimit cid docs <- fulfill' fcol batchSize dBatch
+    Batch mLimit cid docs <- liftDB $ fulfill' fcol batchSize dBatch
     let newLimit = do
               limit <- mLimit
               return $ limit - (min limit $ fromIntegral $ length docs)
@@ -1036,7 +1238,7 @@
         return (emptyBatch, resultDocs)
       (_, _)      -> (, resultDocs) <$> getNextBatch
 
-fulfill' :: (MonadIO m) => FullCollection -> BatchSize -> DelayedBatch -> Action m Batch
+fulfill' :: FullCollection -> BatchSize -> DelayedBatch -> Action IO Batch
 -- Discard pre-fetched batch if empty with nonzero cid.
 fulfill' fcol batchSize dBatch = do
     b@(Batch limit cid docs) <- fulfill dBatch
@@ -1050,13 +1252,13 @@
     liftIO $ request pipe [] (GetMore fcol batchSize' cid, remLimit)
     where (batchSize', remLimit) = batchSizeRemainingLimit batchSize limit
 
-next :: (MonadIO m, MonadBaseControl IO m) => Cursor -> Action m (Maybe Document)
+next :: MonadIO m => Cursor -> Action m (Maybe Document)
 -- ^ Return next document in query result, or Nothing if finished.
-next (Cursor fcol batchSize var) = modifyMVar var nextState where
+next (Cursor fcol batchSize var) = liftDB $ modifyMVar var nextState where
     -- Pre-fetch next batch promise from server when last one in current batch is returned.
     -- nextState:: DelayedBatch -> Action m (DelayedBatch, Maybe Document)
     nextState dBatch = do
-        Batch mLimit cid docs <- fulfill' fcol batchSize dBatch
+        Batch mLimit cid docs <- liftDB $ fulfill' fcol batchSize dBatch
         if mLimit == (Just 0)
           then return (return $ Batch (Just 0) 0 [], Nothing)
           else
@@ -1074,27 +1276,29 @@
                     return (dBatch', Just doc)
                 [] -> if cid == 0
                     then return (return $ Batch (Just 0) 0 [], Nothing)  -- finished
-                    else fmap (,Nothing) $ nextBatch' fcol batchSize mLimit cid
+                    else do
+                      nb <- nextBatch' fcol batchSize mLimit cid
+                      return (nb, Nothing)
 
-nextN :: (MonadIO m, MonadBaseControl IO m) => Int -> Cursor -> Action m [Document]
+nextN :: MonadIO m => Int -> Cursor -> Action m [Document]
 -- ^ Return next N documents or less if end is reached
 nextN n c = catMaybes `liftM` replicateM n (next c)
 
-rest :: (MonadIO m, MonadBaseControl IO m) => Cursor -> Action m [Document]
+rest :: MonadIO m => Cursor -> Action m [Document]
 -- ^ Return remaining documents in query result
 rest c = loop (next c)
 
-closeCursor :: (MonadIO m, MonadBaseControl IO m) => Cursor -> Action m ()
-closeCursor (Cursor _ _ var) = modifyMVar var $ \dBatch -> do
+closeCursor :: MonadIO m => Cursor -> Action m ()
+closeCursor (Cursor _ _ var) = liftDB $ modifyMVar var $ \dBatch -> do
     Batch _ cid _ <- fulfill dBatch
     unless (cid == 0) $ do
       pipe <- asks mongoPipe
       liftIOE ConnectionFailure $ P.send pipe [KillCursors [cid]]
     return $ (return $ Batch (Just 0) 0 [], ())
 
-isCursorClosed :: (MonadIO m, MonadBase IO m) => Cursor -> Action m Bool
+isCursorClosed :: MonadIO m => Cursor -> Action m Bool
 isCursorClosed (Cursor _ _ var) = do
-        Batch _ cid docs <- fulfill =<< readMVar var
+        Batch _ cid docs <- liftDB $ fulfill =<< readMVar var
         return (cid == 0 && null docs)
 
 -- ** Aggregate
@@ -1207,7 +1411,7 @@
 -- ^ MapReduce on collection with given map and reduce functions. Remaining attributes are set to their defaults, which are stated in their comments.
 mapReduce col map' red = MapReduce col map' red [] [] 0 Inline Nothing [] False
 
-runMR :: (MonadIO m, MonadBaseControl IO m) => MapReduce -> Action m Cursor
+runMR :: MonadIO m => MapReduce -> Action m Cursor
 -- ^ Run MapReduce and return cursor of results. Error if map/reduce fails (because of bad Javascript)
 runMR mr = do
     res <- runMR' mr
@@ -1240,6 +1444,20 @@
 eval :: (MonadIO m, Val v) => Javascript -> Action m v
 -- ^ Run code on server
 eval code = at "retval" `liftM` runCommand ["$eval" =: code]
+
+modifyMVar :: MVar a -> (a -> Action IO (a, b)) -> Action IO b
+modifyMVar v f = do
+  ctx <- ask
+  liftIO $ MV.modifyMVar v (\x -> runReaderT (f x) ctx)
+
+mkWeakMVar :: MVar a -> Action IO () -> Action IO (Weak (MVar a))
+mkWeakMVar m closing = do
+  ctx <- ask
+#if MIN_VERSION_base(4,6,0)
+  liftIO $ MV.mkWeakMVar m $ runReaderT closing ctx
+#else
+  liftIO $ MV.addMVarFinalizer m $ runReaderT closing ctx
+#endif
 
 
 {- Authors: Tony Hannan <tony@10gen.com>
diff --git a/mongoDB.cabal b/mongoDB.cabal
--- a/mongoDB.cabal
+++ b/mongoDB.cabal
@@ -1,5 +1,5 @@
 Name:           mongoDB
-Version:        2.2.0
+Version:        2.3.0
 Synopsis:       Driver (client) for MongoDB, a free, scalable, fast, document
                 DBMS
 Description:    This package lets you connect to MongoDB servers and
@@ -10,7 +10,7 @@
 Homepage:       https://github.com/mongodb-haskell/mongodb
 Bug-reports:    https://github.com/mongodb-haskell/mongodb/issues
 Author:         Tony Hannan
-Maintainer:     Fedor Gogolev <knsd@knsd.net>, Victor Denisov <denisovenator@gmail.com>
+Maintainer:     Victor Denisov <denisovenator@gmail.com>
 Copyright:      Copyright (c) 2010-2012 10gen Inc.
 License:        Apache-2.0
 License-file:   LICENSE
diff --git a/test/Main.hs b/test/Main.hs
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -5,11 +5,15 @@
 import Database.MongoDB.Query (access, slaveOk)
 import Data.Text (unpack)
 import Test.Hspec.Runner
+import System.Environment (getEnv)
+import System.IO.Error (catchIOError)
+import TestImport
 import qualified Spec
 
 main :: IO ()
 main = do
-  p <- connect $ host "localhost"
+  mongodbHost <- getEnv mongodbHostEnvVariable `catchIOError` (\_ -> return "localhost")
+  p <- connect $ host mongodbHost
   version <- access p slaveOk "admin" serverVersion
   putStrLn $ "Running tests with mongodb version: " ++ (unpack version)
   hspecWith defaultConfig Spec.spec
diff --git a/test/QuerySpec.hs b/test/QuerySpec.hs
--- a/test/QuerySpec.hs
+++ b/test/QuerySpec.hs
@@ -5,7 +5,9 @@
 import Data.String (IsString(..))
 import TestImport
 import Control.Exception
-import Control.Monad (forM_)
+import Control.Monad (forM_, when)
+import System.Environment (getEnv)
+import System.IO.Error (catchIOError)
 import qualified Data.List as L
 
 import qualified Data.Text as T
@@ -15,11 +17,17 @@
 
 db :: Action IO a -> IO a
 db action = do
-    pipe <- connect (host "127.0.0.1")
+    mongodbHost <- getEnv mongodbHostEnvVariable `catchIOError` (\_ -> return "localhost")
+    pipe <- connect (host mongodbHost)
     result <- access pipe master testDBName action
     close pipe
     return result
 
+getWireVersion :: IO Int
+getWireVersion = db $ do
+    sd <- retrieveServerData
+    return $ maxWireVersion sd
+
 withCleanDatabase :: ActionWith () -> IO ()
 withCleanDatabase action = dropDB >> action () >> dropDB >> return ()
   where
@@ -107,8 +115,8 @@
   describe "insertAll" $ do
     it "inserts documents to the collection and returns their _ids" $ do
       (_id1:_id2:_) <- db $ insertAll "team" [ ["name" =: "Yankees", "league" =: "American"]
-                                                 , ["name" =: "Dodgers", "league" =: "American"]
-                                                 ]
+                                             , ["name" =: "Dodgers", "league" =: "American"]
+                                             ]
       result <- db $ rest =<< find (select [] "team")
       result `shouldBe` [["_id" =: _id1, "name" =: "Yankees", "league" =: "American"]
                         ,["_id" =: _id2, "name" =: "Dodgers", "league" =: "American"]
@@ -168,7 +176,7 @@
 
         liftIO $ (length returnedDocs) `shouldBe` 1000
     it "skips one too big document" $ do
-      db $ insertAll_ "hugeDocCollection" [hugeDocument]
+      (db $ insertAll_ "hugeDocCollection" [hugeDocument]) `shouldThrow` anyException
       db $ do
         cur <- find $ (select [] "hugeDocCollection") {limit = 100000, batchSize = 100000}
         returnedDocs <- rest cur
@@ -189,107 +197,146 @@
 
   describe "updateMany" $ do
     it "updates value" $ do
-      _id <- db $ insert "team" ["name" =: "Yankees", "league" =: "American"]
-      result <- db $ rest =<< find (select [] "team")
-      result `shouldBe` [["_id" =: _id, "name" =: "Yankees", "league" =: "American"]]
-      _ <- db $ updateMany "team" [([ "_id" =: _id]
-                                    , ["$set" =: ["league" =: "European"]]
-                                    , [])]
-      updatedResult <- db $ rest =<< find (select [] "team")
-      updatedResult `shouldBe` [["_id" =: _id, "name" =: "Yankees", "league" =: "European"]]
+      wireVersion <- getWireVersion
+      when (wireVersion > 1) $ do
+        _id <- db $ insert "team" ["name" =: "Yankees", "league" =: "American"]
+        result <- db $ rest =<< find (select [] "team")
+        result `shouldBe` [["_id" =: _id, "name" =: "Yankees", "league" =: "American"]]
+        _ <- db $ updateMany "team" [([ "_id" =: _id]
+                                      , ["$set" =: ["league" =: "European"]]
+                                      , [])]
+        updatedResult <- db $ rest =<< find (select [] "team")
+        updatedResult `shouldBe` [["_id" =: _id, "name" =: "Yankees", "league" =: "European"]]
     it "upserts value" $ do
-      c <- db $ count (select [] "team")
-      c `shouldBe` 0
-      _ <- db $ updateMany "team" [( []
-                                   , ["name" =: "Giants", "league" =: "MLB"]
-                                   , [Upsert]
-                                   )]
-      updatedResult <- db $ rest =<< find ((select [] "team") {project = ["_id" =: (0 :: Int)]})
-      map L.sort updatedResult `shouldBe` [["league" =: "MLB", "name" =: "Giants"]]
+      wireVersion <- getWireVersion
+      when (wireVersion > 1) $ do
+        c <- db $ count (select [] "team")
+        c `shouldBe` 0
+        _ <- db $ updateMany "team" [( []
+                                     , ["name" =: "Giants", "league" =: "MLB"]
+                                     , [Upsert]
+                                     )]
+        updatedResult <- db $ rest =<< find ((select [] "team") {project = ["_id" =: (0 :: Int)]})
+        map L.sort updatedResult `shouldBe` [["league" =: "MLB", "name" =: "Giants"]]
     it "updates all documents with Multi enabled" $ do
-      _ <- db $ insert "team" ["name" =: "Yankees", "league" =: "American"]
-      _ <- db $ insert "team" ["name" =: "Yankees", "league" =: "MiLB"]
-      _ <- db $ updateMany "team" [( ["name" =: "Yankees"]
-                                   , ["$set" =: ["league" =: "MLB"]]
-                                   , [MultiUpdate]
-                                   )]
-      updatedResult <- db $ rest =<< find ((select [] "team") {project = ["_id" =: (0 :: Int)]})
-      (L.sort $ map L.sort updatedResult) `shouldBe` [ ["league" =: "MLB", "name" =: "Yankees"]
-                                                     , ["league" =: "MLB", "name" =: "Yankees"]
-                                                     ]
+      wireVersion <- getWireVersion
+      when (wireVersion > 1) $ do
+        _ <- db $ insert "team" ["name" =: "Yankees", "league" =: "American"]
+        _ <- db $ insert "team" ["name" =: "Yankees", "league" =: "MiLB"]
+        _ <- db $ updateMany "team" [( ["name" =: "Yankees"]
+                                     , ["$set" =: ["league" =: "MLB"]]
+                                     , [MultiUpdate]
+                                     )]
+        updatedResult <- db $ rest =<< find ((select [] "team") {project = ["_id" =: (0 :: Int)]})
+        (L.sort $ map L.sort updatedResult) `shouldBe` [ ["league" =: "MLB", "name" =: "Yankees"]
+                                                       , ["league" =: "MLB", "name" =: "Yankees"]
+                                                       ]
     it "updates one document when there is no Multi option" $ do
-      _ <- db $ insert "team" ["name" =: "Yankees", "league" =: "American"]
-      _ <- db $ insert "team" ["name" =: "Yankees", "league" =: "MiLB"]
-      _ <- db $ updateMany "team" [( ["name" =: "Yankees"]
-                                   , ["$set" =: ["league" =: "MLB"]]
-                                   , []
-                                   )]
-      updatedResult <- db $ rest =<< find ((select [] "team") {project = ["_id" =: (0 :: Int)]})
-      (L.sort $ map L.sort updatedResult) `shouldBe` [ ["league" =: "MLB", "name" =: "Yankees"]
-                                                     , ["league" =: "MiLB", "name" =: "Yankees"]
-                                                     ]
+      wireVersion <- getWireVersion
+      when (wireVersion > 1) $ do
+        _ <- db $ insert "team" ["name" =: "Yankees", "league" =: "American"]
+        _ <- db $ insert "team" ["name" =: "Yankees", "league" =: "MiLB"]
+        _ <- db $ updateMany "team" [( ["name" =: "Yankees"]
+                                     , ["$set" =: ["league" =: "MLB"]]
+                                     , []
+                                     )]
+        updatedResult <- db $ rest =<< find ((select [] "team") {project = ["_id" =: (0 :: Int)]})
+        (L.sort $ map L.sort updatedResult) `shouldBe` [ ["league" =: "MLB", "name" =: "Yankees"]
+                                                       , ["league" =: "MiLB", "name" =: "Yankees"]
+                                                       ]
     it "can process different updates" $ do
-      _ <- db $ insert "team" ["name" =: "Yankees", "league" =: "American"]
-      _ <- db $ insert "team" ["name" =: "Giants" , "league" =: "MiLB"]
-      _ <- db $ updateMany "team" [ ( ["name" =: "Yankees"]
-                                    , ["$set" =: ["league" =: "MiLB"]]
-                                    , []
-                                    )
-                                  , ( ["name" =: "Giants"]
-                                    , ["$set" =: ["league" =: "MLB"]]
-                                    , []
-                                    )
-                                  ]
-      updatedResult <- db $ rest =<< find ((select [] "team") {project = ["_id" =: (0 :: Int)]})
-      (L.sort $ map L.sort updatedResult) `shouldBe` [ ["league" =: "MLB" , "name" =: "Giants"]
-                                                     , ["league" =: "MiLB", "name" =: "Yankees"]
-                                                     ]
+      wireVersion <- getWireVersion
+      when (wireVersion > 1) $ do
+        _ <- db $ insert "team" ["name" =: "Yankees", "league" =: "American"]
+        _ <- db $ insert "team" ["name" =: "Giants" , "league" =: "MiLB"]
+        _ <- db $ updateMany "team" [ ( ["name" =: "Yankees"]
+                                      , ["$set" =: ["league" =: "MiLB"]]
+                                      , []
+                                      )
+                                    , ( ["name" =: "Giants"]
+                                      , ["$set" =: ["league" =: "MLB"]]
+                                      , []
+                                      )
+                                    ]
+        updatedResult <- db $ rest =<< find ((select [] "team") {project = ["_id" =: (0 :: Int)]})
+        (L.sort $ map L.sort updatedResult) `shouldBe` [ ["league" =: "MLB" , "name" =: "Giants"]
+                                                       , ["league" =: "MiLB", "name" =: "Yankees"]
+                                                       ]
     it "can process different updates" $ do
-      _ <- db $ insert "team" ["name" =: "Yankees", "league" =: "American", "score" =: (Nothing :: Maybe Int)]
-      _ <- db $ insert "team" ["name" =: "Giants" , "league" =: "MiLB", "score" =: (1 :: Int)]
-      (db $ updateMany "team" [ ( ["name" =: "Yankees"]
-                                , ["$inc" =: ["score" =: (1 :: Int)]]
-                                , []
-                                )
-                              , ( ["name" =: "Giants"]
-                                , ["$inc" =: ["score" =: (2 :: Int)]]
-                                , []
-                                )
-                              ]) `shouldThrow` anyException
-      updatedResult <- db $ rest =<< find ((select [] "team") {project = ["_id" =: (0 :: Int)]})
-      (L.sort $ map L.sort updatedResult) `shouldBe` [ ["league" =: "American", "name" =: "Yankees", "score" =: (Nothing :: Maybe Int)]
-                                                     , ["league" =: "MiLB"    , "name" =: "Giants" , "score" =: (1 :: Int)]
-                                                     ]
+      wireVersion <- getWireVersion
+      when (wireVersion > 1) $ do
+        _ <- db $ insert "team" ["name" =: "Yankees", "league" =: "American", "score" =: (Nothing :: Maybe Int)]
+        _ <- db $ insert "team" ["name" =: "Giants" , "league" =: "MiLB", "score" =: (1 :: Int)]
+        updateResult <- (db $ updateMany "team" [ ( ["name" =: "Yankees"]
+                                                , ["$inc" =: ["score" =: (1 :: Int)]]
+                                                , []
+                                                )
+                                              , ( ["name" =: "Giants"]
+                                                , ["$inc" =: ["score" =: (2 :: Int)]]
+                                                , []
+                                                )
+                                              ])
+        failed updateResult `shouldBe` True
+        updatedResult <- db $ rest =<< find ((select [] "team") {project = ["_id" =: (0 :: Int)]})
+        (L.sort $ map L.sort updatedResult) `shouldBe` [ ["league" =: "American", "name" =: "Yankees", "score" =: (Nothing :: Maybe Int)]
+                                                       , ["league" =: "MiLB"    , "name" =: "Giants" , "score" =: (1 :: Int)]
+                                                       ]
     it "can handle big updates" $ do
-      let docs = (flip map) [0..20000] $ \i ->
-              ["name" =: (T.pack $ "name " ++ (show i))]
-      ids <- db $ insertAll "bigCollection" docs
-      let updateDocs = (flip map) ids (\i -> ( [ "_id" =: i]
-                                      , ["$set" =: ["name" =: ("name " ++ (show i))]]
-                                      , []
-                                      ))
-      _ <- db $ updateMany "team" updateDocs
-      updatedResult <- db $ rest =<< find (select [] "team")
-      forM_ updatedResult $ \r -> let (i :: ObjectId) = "_id" `at` r
-                                   in (("name" `at` r) :: String) `shouldBe` ("name" ++ (show i))
+      wireVersion <- getWireVersion
+      when (wireVersion > 1) $ do
+        let docs = (flip map) [0..20000] $ \i ->
+                ["name" =: (T.pack $ "name " ++ (show i))]
+        ids <- db $ insertAll "bigCollection" docs
+        let updateDocs = (flip map) ids (\i -> ( [ "_id" =: i]
+                                        , ["$set" =: ["name" =: ("name " ++ (show i))]]
+                                        , []
+                                        ))
+        _ <- db $ updateMany "team" updateDocs
+        updatedResult <- db $ rest =<< find (select [] "team")
+        forM_ updatedResult $ \r -> let (i :: ObjectId) = "_id" `at` r
+                                     in (("name" `at` r) :: String) `shouldBe` ("name" ++ (show i))
 
   describe "updateAll" $ do
     it "can process different updates" $ do
-      _ <- db $ insert "team" ["name" =: "Yankees", "league" =: "American", "score" =: (Nothing :: Maybe Int)]
-      _ <- db $ insert "team" ["name" =: "Giants" , "league" =: "MiLB", "score" =: (1 :: Int)]
-      (db $ updateAll "team" [ ( ["name" =: "Yankees"]
-                                , ["$inc" =: ["score" =: (1 :: Int)]]
-                                , []
-                                )
-                              , ( ["name" =: "Giants"]
-                                , ["$inc" =: ["score" =: (2 :: Int)]]
-                                , []
-                                )
-                              ]) `shouldThrow` anyException
-      updatedResult <- db $ rest =<< find ((select [] "team") {project = ["_id" =: (0 :: Int)]})
-      (L.sort $ map L.sort updatedResult) `shouldBe` [ ["league" =: "American", "name" =: "Yankees", "score" =: (Nothing :: Maybe Int)]
-                                                     , ["league" =: "MiLB"    , "name" =: "Giants" , "score" =: (3 :: Int)]
-                                                     ]
+      wireVersion <- getWireVersion
+      when (wireVersion > 1) $ do
+        _ <- db $ insert "team" ["name" =: "Yankees", "league" =: "American", "score" =: (Nothing :: Maybe Int)]
+        _ <- db $ insert "team" ["name" =: "Giants" , "league" =: "MiLB", "score" =: (1 :: Int)]
+        updateResult <- (db $ updateAll "team" [ ( ["name" =: "Yankees"]
+                                               , ["$inc" =: ["score" =: (1 :: Int)]]
+                                               , []
+                                               )
+                                             , ( ["name" =: "Giants"]
+                                               , ["$inc" =: ["score" =: (2 :: Int)]]
+                                               , []
+                                               )
+                                             ])
+        failed updateResult `shouldBe` True
+        updatedResult <- db $ rest =<< find ((select [] "team") {project = ["_id" =: (0 :: Int)]})
+        (L.sort $ map L.sort updatedResult) `shouldBe` [ ["league" =: "American", "name" =: "Yankees", "score" =: (Nothing :: Maybe Int)]
+                                                       , ["league" =: "MiLB"    , "name" =: "Giants" , "score" =: (3 :: Int)]
+                                                       ]
+    it "returns correct number of matched and modified" $ do
+      wireVersion <- getWireVersion
+      when (wireVersion > 1) $ do
+        _ <- db $ insertMany "testCollection" [["myField" =: "myValue"], ["myField2" =: "myValue2"]]
+        _ <- db $ insertMany "testCollection" [["myField" =: "myValue"], ["myField2" =: "myValue2"]]
+        res <- db $ updateMany "testCollection" [(["myField" =: "myValue"], ["$set" =: ["myField" =: "newValue"]], [MultiUpdate])]
+        nMatched res `shouldBe` 2
+        nModified res `shouldBe` (Just 2)
+    it "returns correct number of upserted" $ do
+      wireVersion <- getWireVersion
+      when (wireVersion > 1) $ do
+        res <- db $ updateMany "testCollection" [(["myField" =: "myValue"], ["$set" =: ["myfield" =: "newValue"]], [Upsert])]
+        (length $ upserted res) `shouldBe` 1
+    it "updates only one doc without multi update" $ do
+      wireVersion <- getWireVersion
+      when (wireVersion > 1) $ do
+        _ <- db $ insertMany "testCollection" [["myField" =: "myValue"], ["myField2" =: "myValue2"]]
+        _ <- db $ insertMany "testCollection" [["myField" =: "myValue"], ["myField2" =: "myValue2"]]
+        res <- db $ updateMany "testCollection" [(["myField" =: "myValue"], ["$set" =: ["myField" =: "newValue"]], [])]
+        nMatched res `shouldBe` 1
+        nModified res `shouldBe` (Just 1)
 
   describe "delete" $ do
     it "actually deletes something" $ do
@@ -331,34 +378,47 @@
 
   describe "deleteMany" $ do
     it "actually deletes something" $ do
-      _ <- db $ insert "team" ["name" =: ("Giants" :: String)]
-      _ <- db $ insert "team" ["name" =: ("Yankees" :: String)]
-      _ <- db $ deleteMany "team" [ (["name" =: ("Giants" :: String)], [])
-                                  , (["name" =: ("Yankees" :: String)], [])
-                                  ]
-      updatedResult <- db $ rest =<< find ((select [] "team") {project = ["_id" =: (0 :: Int)]})
-      length updatedResult `shouldBe` 0
+      wireVersion <- getWireVersion
+      when (wireVersion > 1) $ do
+        _ <- db $ insert "team" ["name" =: ("Giants" :: String)]
+        _ <- db $ insert "team" ["name" =: ("Yankees" :: String)]
+        _ <- db $ deleteMany "team" [ (["name" =: ("Giants" :: String)], [])
+                                    , (["name" =: ("Yankees" :: String)], [])
+                                    ]
+        updatedResult <- db $ rest =<< find ((select [] "team") {project = ["_id" =: (0 :: Int)]})
+        length updatedResult `shouldBe` 0
 
   describe "deleteAll" $ do
     it "actually deletes something" $ do
-      _ <- db $ insert "team" [ "name"  =: ("Giants" :: String)
-                              , "score" =: (Nothing :: Maybe Int)
-                              ]
-      _ <- db $ insert "team" [ "name" =: ("Yankees" :: String)
-                              , "score" =: (1 :: Int)
-                              ]
-      _ <- db $ deleteAll "team" [ (["name" =: ("Giants" :: String)], [])
-                                 , (["name" =: ("Yankees" :: String)], [])
-                                 ]
-      updatedResult <- db $ rest =<< find ((select [] "team") {project = ["_id" =: (0 :: Int)]})
-      length updatedResult `shouldBe` 0
+      wireVersion <- getWireVersion
+      when (wireVersion > 1) $ do
+        _ <- db $ insert "team" [ "name"  =: ("Giants" :: String)
+                                , "score" =: (Nothing :: Maybe Int)
+                                ]
+        _ <- db $ insert "team" [ "name" =: ("Yankees" :: String)
+                                , "score" =: (1 :: Int)
+                                ]
+        _ <- db $ deleteAll "team" [ (["name" =: ("Giants" :: String)], [])
+                                   , (["name" =: ("Yankees" :: String)], [])
+                                   ]
+        updatedResult <- db $ rest =<< find ((select [] "team") {project = ["_id" =: (0 :: Int)]})
+        length updatedResult `shouldBe` 0
     it "can handle big deletes" $ do
-      let docs = (flip map) [0..20000] $ \i ->
-              ["name" =: (T.pack $ "name " ++ (show i))]
-      _ <- db $ insertAll "bigCollection" docs
-      _ <- db $ deleteAll "bigCollection" $ map (\d -> (d, [])) docs
-      updatedResult <- db $ rest =<< find ((select [] "bigCollection") {project = ["_id" =: (0 :: Int)]})
-      length updatedResult `shouldBe` 0
+      wireVersion <- getWireVersion
+      when (wireVersion > 1) $ do
+        let docs = (flip map) [0..20000] $ \i ->
+                ["name" =: (T.pack $ "name " ++ (show i))]
+        _ <- db $ insertAll "bigCollection" docs
+        _ <- db $ deleteAll "bigCollection" $ map (\d -> (d, [])) docs
+        updatedResult <- db $ rest =<< find ((select [] "bigCollection") {project = ["_id" =: (0 :: Int)]})
+        length updatedResult `shouldBe` 0
+    it "returns correct result" $ do
+      wireVersion <- getWireVersion
+      when (wireVersion > 1) $ do
+        _ <- db $ insert "testCollection" [ "myField" =: "myValue" ]
+        _ <- db $ insert "testCollection" [ "myField" =: "myValue" ]
+        res <- db $ deleteAll "testCollection" [ (["myField" =: "myValue"], []) ]
+        nRemoved res `shouldBe` 2
 
   describe "allCollections" $ do
     it "returns all collections in a database" $ do
diff --git a/test/TestImport.hs b/test/TestImport.hs
--- a/test/TestImport.hs
+++ b/test/TestImport.hs
@@ -8,7 +8,6 @@
 import Test.Hspec as Export hiding (Selector)
 import Database.MongoDB as Export
 import Control.Monad.Trans as Export (MonadIO, liftIO) 
-import Data.Maybe (fromJust)
 import Data.Time (ParseTime, UTCTime)
 import qualified Data.Time as Time
 
@@ -18,6 +17,7 @@
 import Data.Time.Format (defaultTimeLocale, iso8601DateFormat)
 #else
 import System.Locale (defaultTimeLocale, iso8601DateFormat)
+import Data.Maybe (fromJust)
 #endif
 
 parseTime :: ParseTime t => String -> String -> t
@@ -32,3 +32,6 @@
 
 parseDateTime :: String -> UTCTime
 parseDateTime = parseTime (iso8601DateFormat (Just "%H:%M:%S"))
+
+mongodbHostEnvVariable :: String
+mongodbHostEnvVariable = "HASKELL_MONGODB_TEST_HOST"