From c6fd4cb9ea2fca35dfe5a504c3fb740deb0a513c Mon Sep 17 00:00:00 2001 From: Dary Cabrera Date: Fri, 16 Aug 2024 15:53:01 -0600 Subject: [PATCH 1/6] Remove deprecated mongo snapshot query option This flag was deprecated since Mongo Server 3.7.4. Its presence in queries produce failures in the mongoDB driver when interfacing against Mongo Servers >= version 6.0. --- persistent-mongoDB/Database/Persist/MongoDB.hs | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/persistent-mongoDB/Database/Persist/MongoDB.hs b/persistent-mongoDB/Database/Persist/MongoDB.hs index d232fea10..86acbaefc 100644 --- a/persistent-mongoDB/Database/Persist/MongoDB.hs +++ b/persistent-mongoDB/Database/Persist/MongoDB.hs @@ -722,7 +722,6 @@ instance PersistQueryRead DB.MongoContext where pure (cnt > 0) -- | uses cursor option NoCursorTimeout - -- If there is no sorting, it will turn the $snapshot option on -- and explicitly closes the cursor when done selectSourceRes filts opts = do context <- ask @@ -732,9 +731,7 @@ instance PersistQueryRead DB.MongoContext where close context cursor = runReaderT (DB.closeCursor cursor) context open :: DB.MongoContext -> IO DB.Cursor open = runReaderT (DB.find (makeQuery filts opts) - -- it is an error to apply $snapshot when sorting - { DB.snapshot = noSort - , DB.options = [DB.NoCursorTimeout] + { DB.options = [DB.NoCursorTimeout] }) pullCursor context cursor = do mdoc <- liftIO $ runReaderT (DB.nextBatch cursor) context @@ -744,8 +741,6 @@ instance PersistQueryRead DB.MongoContext where forM_ docs $ fromPersistValuesThrow t >=> yield pullCursor context cursor t = entityDef $ Just $ dummyFromFilts filts - (_, _, orders) = limitOffsetOrder opts - noSort = null orders selectFirst filts opts = DB.findOne (makeQuery filts opts) >>= Traversable.mapM (fromPersistValuesThrow t) From 3a2ca9f775a5e3458719b1ba67f1693aec28389f Mon Sep 17 00:00:00 2001 From: Dary Cabrera Date: Mon, 19 Aug 2024 12:55:42 -0600 Subject: [PATCH 2/6] Update mongo deletion calls Replace the mongo driver's delete calls with deleteMany to restore correct behavior with Mongo 6.0 while preserving compatibility with Mongo 5.0. --- .../Database/Persist/MongoDB.hs | 25 ++++++++----------- 1 file changed, 11 insertions(+), 14 deletions(-) diff --git a/persistent-mongoDB/Database/Persist/MongoDB.hs b/persistent-mongoDB/Database/Persist/MongoDB.hs index 86acbaefc..c6f655490 100644 --- a/persistent-mongoDB/Database/Persist/MongoDB.hs +++ b/persistent-mongoDB/Database/Persist/MongoDB.hs @@ -114,7 +114,7 @@ module Database.Persist.MongoDB ) where import Control.Exception (throw, throwIO) -import Control.Monad (forM_, liftM, unless, (>=>)) +import Control.Monad (forM_, liftM, unless, (>=>), void) import Control.Monad.IO.Class (liftIO) import qualified Control.Monad.IO.Class as Trans import Control.Monad.IO.Unlift (MonadUnliftIO, withRunInIO) @@ -562,10 +562,9 @@ instance PersistStoreWrite DB.MongoContext where return () delete k = - DB.deleteOne DB.Select { - DB.coll = collectionNameFromKey k - , DB.selector = keyToMongoDoc k - } + void $ DB.deleteMany + (collectionNameFromKey k) + [(keyToMongoDoc k, [DB.SingleRemove])] update _ [] = return () update key upds = @@ -608,10 +607,9 @@ instance PersistUniqueRead DB.MongoContext where instance PersistUniqueWrite DB.MongoContext where deleteBy uniq = - DB.delete DB.Select { - DB.coll = collectionName $ dummyFromUnique uniq - , DB.selector = toUniquesDoc uniq - } + void $ DB.deleteMany + (collectionName $ dummyFromUnique uniq) + [(toUniquesDoc uniq, [DB.SingleRemove])] upsert newRecord upds = do uniq <- onlyUnique newRecord @@ -703,11 +701,10 @@ instance PersistQueryWrite DB.MongoContext where , DB.selector = filtersToDoc filts } $ updatesToDoc upds - deleteWhere filts = do - DB.delete DB.Select { - DB.coll = collectionName $ dummyFromFilts filts - , DB.selector = filtersToDoc filts - } + deleteWhere filts = + void $ DB.deleteMany + (collectionName $ dummyFromFilts filts) + [ (filtersToDoc filts, [])] instance PersistQueryRead DB.MongoContext where count filts = do From 89e3591614da432e7d6727313ec19aa2cb3ea252 Mon Sep 17 00:00:00 2001 From: Dary Cabrera Date: Mon, 26 Aug 2024 12:44:34 -0600 Subject: [PATCH 3/6] Update mongo update and upsert calls Replace the mongo driver's modify(update) calls with updateMany to restore correct behavior in Mongo 6.0 and above. The key change here is that the writeConcern is now back to being set based on environment context rather than being hardcoded to "0". --- .../Database/Persist/MongoDB.hs | 25 ++++++++++--------- 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/persistent-mongoDB/Database/Persist/MongoDB.hs b/persistent-mongoDB/Database/Persist/MongoDB.hs index c6f655490..71cd23557 100644 --- a/persistent-mongoDB/Database/Persist/MongoDB.hs +++ b/persistent-mongoDB/Database/Persist/MongoDB.hs @@ -568,9 +568,9 @@ instance PersistStoreWrite DB.MongoContext where update _ [] = return () update key upds = - DB.modify - (DB.Select (keyToMongoDoc key) (collectionNameFromKey key)) - $ updatesToDoc upds + void $ DB.updateMany + (collectionNameFromKey key) + [(keyToMongoDoc key, updatesToDoc upds, [DB.MultiUpdate])] updateGet key upds = do context <- ask @@ -628,12 +628,14 @@ instance PersistUniqueWrite DB.MongoContext where upsertBy uniq newRecord upds = do let uniqueDoc = toUniquesDoc uniq :: [DB.Field] let uniqKeys = map DB.label uniqueDoc :: [DB.Label] - let insDoc = DB.exclude uniqKeys $ toInsertDoc newRecord :: DB.Document - let selection = DB.select uniqueDoc $ collectionName newRecord :: DB.Selection mdoc <- getBy uniq - case mdoc of - Nothing -> unless (null upds) (DB.upsert selection ["$setOnInsert" DB.=: insDoc]) - Just _ -> unless (null upds) (DB.modify selection $ DB.exclude uniqKeys $ updatesToDoc upds) + let updateOrUpsert = case mdoc of + Nothing -> + let insDoc = DB.exclude uniqKeys $ toInsertDoc newRecord :: DB.Document + in [(uniqueDoc, ["$setOnInsert" DB.=: insDoc], [DB.Upsert])] + Just _ -> + [(uniqueDoc, DB.exclude uniqKeys $ updatesToDoc upds, [DB.MultiUpdate])] + unless (null upds) . void $ DB.updateMany (collectionName newRecord) updateOrUpsert newMdoc <- getBy uniq case newMdoc of Nothing -> err "possible race condition: getBy found Nothing" @@ -696,10 +698,9 @@ projectionFromRecord = projectionFromEntityDef . entityDef . Just instance PersistQueryWrite DB.MongoContext where updateWhere _ [] = return () updateWhere filts upds = - DB.modify DB.Select { - DB.coll = collectionName $ dummyFromFilts filts - , DB.selector = filtersToDoc filts - } $ updatesToDoc upds + void $ DB.updateMany + (collectionName $ dummyFromFilts filts) + [(filtersToDoc filts, updatesToDoc upds, [DB.MultiUpdate])] deleteWhere filts = void $ DB.deleteMany From ec3d1921deef58c2d2aae4473fb866b3977baa89 Mon Sep 17 00:00:00 2001 From: Dary Cabrera Date: Fri, 30 Aug 2024 08:16:16 -0600 Subject: [PATCH 4/6] Update mongoDB lib version constraint Match the current stack snapshot at version 2.7.1.2. --- persistent-mongoDB/persistent-mongoDB.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/persistent-mongoDB/persistent-mongoDB.cabal b/persistent-mongoDB/persistent-mongoDB.cabal index dcefd7d78..8547468cf 100644 --- a/persistent-mongoDB/persistent-mongoDB.cabal +++ b/persistent-mongoDB/persistent-mongoDB.cabal @@ -27,7 +27,7 @@ library , cereal >= 0.5 , conduit >= 1.2 , http-api-data >= 0.3.7 && < 0.7 - , mongoDB >= 2.3 && < 2.8 + , mongoDB >= 2.7.1.2 && < 2.8 , network >= 2.6 , path-pieces >= 0.2 , resource-pool >= 0.2 && < 0.5 From ccb36a2ca5360808992cdf91723a95373a22eeb7 Mon Sep 17 00:00:00 2001 From: Dary Cabrera Date: Fri, 30 Aug 2024 12:51:52 -0600 Subject: [PATCH 5/6] Remove obsolete GHC CI builds Co-authored-by: Matt Parsons --- .github/workflows/haskell.yml | 2 -- 1 file changed, 2 deletions(-) diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index 4bdab79f1..6ca754c22 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -47,8 +47,6 @@ jobs: matrix: cabal: ["3.10"] ghc: - - "8.4.4" - - "8.6.5" - "8.8.4" - "8.10.7" - "9.0.2" From d1f12e9cb8ad79846b51cdfb7861b4b8bb605140 Mon Sep 17 00:00:00 2001 From: Dary Cabrera Date: Fri, 6 Sep 2024 10:28:29 -0600 Subject: [PATCH 6/6] persistent-mongoDB-2.13.0.2 --- persistent-mongoDB/ChangeLog.md | 4 ++++ persistent-mongoDB/persistent-mongoDB.cabal | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/persistent-mongoDB/ChangeLog.md b/persistent-mongoDB/ChangeLog.md index 607d748fa..7bf562515 100644 --- a/persistent-mongoDB/ChangeLog.md +++ b/persistent-mongoDB/ChangeLog.md @@ -1,5 +1,9 @@ # Changelog for persistent-mongoDB +## 2.13.0.2 + +* Fix behavioral compatibility with MongoDB Driver for MongoDB >= 6.0 [#1545](https://github.com/yesodweb/persistent/pull/1545) + ## 2.13.0.1 * [#1367](https://github.com/yesodweb/persistent/pull/1367), diff --git a/persistent-mongoDB/persistent-mongoDB.cabal b/persistent-mongoDB/persistent-mongoDB.cabal index 8547468cf..2c6de362b 100644 --- a/persistent-mongoDB/persistent-mongoDB.cabal +++ b/persistent-mongoDB/persistent-mongoDB.cabal @@ -1,5 +1,5 @@ name: persistent-mongoDB -version: 2.13.0.1 +version: 2.13.0.2 license: MIT license-file: LICENSE author: Greg Weber