congomongo · Aug 24, 2021 · Aug 24, 2021 · Aug 25, 2021 · Aug 25, 2021 · Aug 25, 2021
Showing with 150 additions and 59 deletions.

+19 −1 .circleci/config.yml

+3 −0 CODEOWNERS

+6 −0 docker-compose.yml

+10 −4 project.clj

+42 −32 src/somnium/congomongo.clj

+36 −8 src/somnium/congomongo/coerce.clj

+34 −14 test/somnium/test/congomongo.clj
diff --git a/.circleci/config.yml b/.circleci/config.yml
@@ -1,10 +1,28 @@
 version: 2.1
 
 jobs:
-  build:
+  test:
     docker:
       - image: cimg/clojure:1.10.1
       - image: mongo:3.6
     steps:
       - checkout
       - run: lein test
+
+  release:
+    docker:
+      - image: cimg/clojure:1.10.1
+    steps:
+      - checkout
+      - run: lein deploy
+
+workflows:
+  ci:
+    jobs:
+      - test
+      - release:
+          context: clojars-publish
+          requires: [test]
+          filters:
+            branches:
+              only: master
diff --git a/CODEOWNERS b/CODEOWNERS
@@ -0,0 +1,3 @@
+# Placeholder CODEOWNERS file as this repo did not have one
+# Please make a PR adding the correct owner or request that this repo be archived
+* @circleci/maintainers-monolith
diff --git a/docker-compose.yml b/docker-compose.yml
@@ -0,0 +1,6 @@
+version: '2'
+services:
+  mongodb:
+    image: mongo:3.6
+    ports:
+      - '127.0.0.1:27017:27017'
diff --git a/project.clj b/project.clj
@@ -1,5 +1,5 @@
-(defproject congomongo
-  "2.2.2"
+(defproject circleci/congomongo
+  "2.2.3.1" ;; the upstream version is 2.2.3
   :description "Clojure-friendly API for MongoDB"
   :url "https://github.com/congomongo/congomongo"
   :mailing-list {:name "CongoMongo mailing list"
@@ -10,9 +10,15 @@
             :distribution :repo}
   :min-lein-version "2.0.0"
   :dependencies [[org.clojure/data.json "0.2.7"]
-                 [org.mongodb/mongo-java-driver "3.10.2"]
+                 [org.mongodb/mongodb-driver-legacy "4.3.1"]
                  [org.clojure/clojure "1.10.1" :scope "provided"]]
-  :deploy-repositories {"releases" {:url "https://repo.clojars.org" :creds :gpg}}
+  :repositories [["releases" {:url "https://repo.clojars.org"
+                              :sign-releases false
+                              :username :env/clojars_username
+                              :password :env/clojars_token}]
+                 ["snapshots" {:url "https://repo.clojars.org"
+                               :username :env/clojars_username
+                               :password :env/clojars_token}]]
   ;; if a :dev profile is added, remember to update :aliases below to
   ;; use it in each with-profile group!
   :profiles {:1.9 {:dependencies [[org.clojure/clojure "1.9.0"]]}

diff --git a/src/somnium/congomongo.clj b/src/somnium/congomongo.clj
@@ -28,8 +28,9 @@
             [somnium.congomongo.coerce :refer [coerce coerce-fields coerce-index-fields]])
   (:import [com.mongodb MongoClient MongoClientOptions MongoClientOptions$Builder
                         MongoClientURI MongoCredential
-                        DB DBCollection DBObject DBRef ServerAddress ReadPreference WriteConcern Bytes
-                        AggregationOptions AggregationOptions$OutputMode
+                        DB DBCollection CursorType DBObject DBRef
+                        ServerAddress ReadPreference WriteConcern
+                        AggregationOptions
                         MapReduceCommand MapReduceCommand$OutputType]
            [com.mongodb.gridfs GridFS]
            [org.bson.types ObjectId]
@@ -142,7 +143,7 @@
                                         (MongoCredential/createCredential username db (.toCharArray password))))
 
         mongo (if credential
-                (make-mongo-client addresses [credential] options)
+                (make-mongo-client addresses credential options)
                 (make-mongo-client addresses options))
 
         n-db (if db (.getDB mongo db) nil)]
@@ -262,20 +263,20 @@ When with-mongo and set-connection! interact, last one wins"
 
 (def write-concern-map
   {:acknowledged         WriteConcern/ACKNOWLEDGED
-   :fsynced              WriteConcern/FSYNCED
+   :fsynced              WriteConcern/JOURNALED
    :journaled            WriteConcern/JOURNALED
    :majority             WriteConcern/MAJORITY
-   :replica-acknowledged WriteConcern/REPLICA_ACKNOWLEDGED
+   :replica-acknowledged WriteConcern/W2
    :unacknowledged       WriteConcern/UNACKNOWLEDGED
    ;; these are pre-2.10.x names for write concern:
-   :fsync-safe    WriteConcern/FSYNC_SAFE  ;; deprecated - use :fsynced
-   :journal-safe  WriteConcern/JOURNAL_SAFE ;; deprecated - use :journaled
-   :normal        WriteConcern/NORMAL ;; deprecated - use :unacknowledged
-   :replicas-safe WriteConcern/REPLICAS_SAFE ;; deprecated - use :replica-acknowledged
-   :safe          WriteConcern/SAFE ;; deprecated - use :acknowledged
+   :fsync-safe    WriteConcern/JOURNALED
+   :journal-safe  WriteConcern/JOURNALED
+   :normal        WriteConcern/UNACKNOWLEDGED
+   :replicas-safe WriteConcern/W2
+   :safe          WriteConcern/ACKNOWLEDGED
    ;; these are left for backward compatibility but are deprecated:
-   :replica-safe WriteConcern/REPLICAS_SAFE
-   :strict       WriteConcern/SAFE
+   :replica-safe WriteConcern/W2
+   :strict       WriteConcern/ACKNOWLEDGED
    })
 
 (defn set-write-concern
@@ -349,20 +350,6 @@ When with-mongo and set-connection! interact, last one wins"
                      ^String (named collection)
                      (coerce options [:clojure :mongo])))
 
-(def query-option-map
-  {:tailable    Bytes/QUERYOPTION_TAILABLE
-   :slaveok     Bytes/QUERYOPTION_SLAVEOK
-   :oplogreplay Bytes/QUERYOPTION_OPLOGREPLAY
-   :notimeout   Bytes/QUERYOPTION_NOTIMEOUT
-   :awaitdata   Bytes/QUERYOPTION_AWAITDATA})
-
-(defn calculate-query-options
-  "Calculates the cursor's query option from a list of options"
-   [options]
-   (reduce bit-or 0 (map query-option-map (if (keyword? options)
-                                            (list options)
-                                            options))))
-
 (def ^:private read-preference-map
   "Private map of facory functions of ReadPreferences to aliases."
   {:nearest (fn nearest ([] (ReadPreference/nearest)) ([^List tags] (ReadPreference/nearest tags)))
@@ -414,6 +401,20 @@ When with-mongo and set-connection! interact, last one wins"
   [collection]
   (.getReadPreference (get-coll collection)))
 
+(defn set-options!
+  "sets the options on the cursor"
+  [cursor {:keys [tailable secondary-preferred slaveok oplog notimeout awaitdata]}]
+  (when tailable
+    (.cursorType cursor CursorType/Tailable))
+  (when awaitdata
+    (.cursorType cursor CursorType/TailableAwait))
+  (when (or secondary-preferred slaveok)
+    (.setReadPreference cursor (ReadPreference/secondaryPreferred)))
+  (when oplog
+    (.oplogReplay cursor true))
+  (when notimeout
+    (.noCursorTimeout cursor true)))
+
 (defn fetch
   "Fetches objects from a collection.
    Note that MongoDB always adds the _id and _ns
@@ -482,13 +483,12 @@ You should use fetch with :limit 1 instead."))); one? and sort should NEVER be c
                                         ; (with negative limit) doesn't match expectations therefore changed to keep limit as is.
           n-limit (or limit 0)
           n-sort (when sort (coerce sort [from :mongo]))
-          n-options (calculate-query-options options)
           n-preferences (cond
                           (nil? read-preferences) nil
                           (instance? ReadPreference read-preferences) read-preferences
                           :else (somnium.congomongo/read-preference read-preferences))]
       (cond
-        count? (.getCount n-col n-where n-only)
+        count? (.getCount n-col n-where)
 
         ;; The find command isn't documented so there's no nice way to build a
         ;; find command that adds read-preferences when necessary
@@ -504,10 +504,21 @@ You should use fetch with :limit 1 instead."))); one? and sort should NEVER be c
                    (.setReadPreference cursor n-preferences))
                  (when hint
                    (if (string? hint)
-                     (.hint cursor ^String hint)
+                     ;; hint no longer supports strings
+                     ;; .hintString exists for DBCollectionCountOptions but not
+                     ;; for DBCursor. It would be possible to hack support by
+                     ;; creating a DBCollectionCountOptions that is not used
+                     ;; except for setting a hint string on it and getting the
+                     ;; hint out as an object. For now follow the mongo
+                     ;; deprecation and let this be a place where we don't have
+                     ;; backwards compatibility. They have also added the string
+                     ;; hint functionality back into the non-legacy client so it
+                     ;; is possible that support will be restored via the java
+                     ;; client.
+                     (throw (IllegalArgumentException. "String hints are not currently supported. Use a seq instead."))
                      (.hint cursor ^DBObject (coerce-index-fields hint))))
-                 (when n-options
-                   (.setOptions cursor n-options))
+                 (when options
+                   (set-options! cursor options))
                  (when n-sort
                    (.sort cursor n-sort))
                  (when skip
@@ -725,7 +736,6 @@ You should use fetch with :limit 1 instead."))); one? and sort should NEVER be c
         cursor (.aggregate (get-coll coll)
                            ^List (coerce (conj ops op) [from :mongo])
                            ^AggregationOptions (-> (AggregationOptions/builder)
-                                                   (.outputMode AggregationOptions$OutputMode/CURSOR)
                                                    (.build)))]
     {:serverUsed (.toString (.getServerAddress cursor))
      :result (coerce cursor [:mongo to] :many true)

diff --git a/src/somnium/congomongo/coerce.clj b/src/somnium/congomongo/coerce.clj
@@ -19,12 +19,19 @@
 ; THE SOFTWARE.
 
 (ns somnium.congomongo.coerce
-  (:require [clojure.data.json :refer [write-str read-str]])
-  (:import [clojure.lang IPersistentMap IPersistentVector Keyword]
+  (:require [clojure.data.json :as json :refer [write-str read-str]])
+  (:import [clojure.lang IPersistentMap Keyword]
            [java.util Map List Set]
            [com.mongodb DBObject BasicDBObject BasicDBList]
-           [com.mongodb.gridfs GridFSFile]
-           [com.mongodb.util JSON]))
+           [org.bson.json JsonWriterSettings JsonMode]
+           [org.bson.types ObjectId]))
+
+(def ^:private json-settings
+  ; Create a settings object to allow us to serialize an object with "RELAXED" JSON.
+  ; https://github.com/mongodb/specifications/blob/df6be82f865e9b72444488fd62ae1eb5fca18569/source/extended-json.rst
+  (-> (JsonWriterSettings/builder)
+      (.outputMode JsonMode/RELAXED)
+      (.build)))
 
 (def ^{:dynamic true
        :doc "Set this to false to prevent coercion from setting string keys to keywords"
@@ -47,6 +54,26 @@
         (string? x)
         (instance? java.util.Map x))))
 
+(defn json->mongo [^String s]
+  (BasicDBObject/parse s))
+
+(defn- write-basic-db-object
+  [^BasicDBObject dbo ^Appendable out]
+  (.append out (.toJson dbo json-settings)))
+
+(extend BasicDBObject clojure.data.json/JSONWriter {:-write write-basic-db-object})
+
+(defn write-object-id
+  [^ObjectId id ^Appendable out]
+  (.append out "\"")
+  (.append out (str id))
+  (.append out "\""))
+
+(extend ObjectId json/JSONWriter {:-write write-object-id})
+
+(defn mongo->json [o]
+  (write-str o))
+
 ;;; Converting data from mongo into Clojure data objects
 
 (defprotocol ConvertibleFromMongo
@@ -126,11 +153,11 @@
      *translations* {[:clojure :mongo  ] #'clojure->mongo
                      [:clojure :json   ] #'write-str
                      [:mongo   :clojure] #(mongo->clojure ^DBObject % ^boolean *keywordize*)
-                     [:mongo   :json   ] #(JSON/serialize %)
+                     [:mongo   :json   ] #'mongo->json
                      [:json    :clojure] #(read-str % :key-fn (if *keywordize*
                                                                 keyword
                                                                 identity))
-                     [:json    :mongo  ] #(JSON/parse %)})
+                     [:json    :mongo  ] #'json->mongo})
 
 (defn coerce
   "takes an object, a vector of keywords:
@@ -150,8 +177,9 @@
                           (f obj))
                         (throw (RuntimeException. "unsupported keyword pair"))))))
 
-(defn ^DBObject dbobject [& args]
-  "Create a DBObject from a sequence of key/value pairs, in order."
+(defn ^DBObject dbobject
+   "Create a DBObject from a sequence of key/value pairs, in order."
+  [& args]
   (let [dbo (BasicDBObject.)]
     (doseq [[k v] (partition 2 args)]
       (.put dbo

diff --git a/test/somnium/test/congomongo.clj b/test/somnium/test/congomongo.clj
@@ -246,7 +246,7 @@
           uri (str "mongodb://" userpass test-db-host ":" test-db-port "/congomongotest-db-a?maxpoolsize=123&w=1&safe=true")
           a (make-connection uri)
           ^MongoClient m (:mongo a)
-          opts (.getMongoOptions m)]
+          opts (.getMongoClientOptions m)]
       (testing "make-connection parses options from URI"
         (is (= 123 (.getConnectionsPerHost opts)))
         (is (= WriteConcern/W1 (.getWriteConcern opts))))
@@ -285,15 +285,6 @@
           (close-connection a)
           (is (= nil *mongo-config*)))))))
 
-(deftest query-options
-  (are [x y] (= (calculate-query-options x) y)
-       nil 0
-       [] 0
-       [:tailable] 2
-       [:tailable :slaveok] 6
-       [:tailable :slaveok :notimeout] 22
-       :notimeout 16))
-
 (deftest fetch-with-options
   (with-test-mongo
     (insert! :thingies {:foo 1})
@@ -501,31 +492,32 @@
       (add-index! :test_col [[:key1 -1]]) ;; index3
       (add-index! :test_col [:key1 [:key2 -1]]) ;; index 4
 
-      (testing "index1"
+      ;; strings supplied as hints are not currently supported
+      #_(testing "index1"
         (let [plan (-> (fetch :test_col :where {:key1 1} :explain? true :hint "key1_1"))]
           (is (= "key1_1" (-> plan :queryPlanner :winningPlan :inputStage :indexName)))))
 
       (testing "index1 seq"
         (let [plan (-> (fetch :test_col :where {:key1 1} :explain? true :hint [:key1]))]
           (is (= "key1_1" (-> plan :queryPlanner :winningPlan :inputStage :indexName)))))
 
-      (testing "index2"
+      #_(testing "index2"
         (let [plan (-> (fetch :test_col :where {:key1 1} :explain? true :hint "key1_1_key2_1"))]
           (is (= "key1_1_key2_1" (-> plan :queryPlanner :winningPlan :inputStage :indexName)))))
 
       (testing "index2 seq"
         (let [plan (-> (fetch :test_col :where {:key1 1} :explain? true :hint [:key1 :key2]))]
           (is (= "key1_1_key2_1" (-> plan :queryPlanner :winningPlan :inputStage :indexName)))))
 
-      (testing "index3"
+      #_(testing "index3"
         (let [plan (-> (fetch :test_col :where {:key1 1} :explain? true :hint "key1_-1"))]
           (is (= "key1_-1" (-> plan :queryPlanner :winningPlan :inputStage :indexName)))))
 
       (testing "index3 seq"
         (let [plan (-> (fetch :test_col :where {:key1 1} :explain? true :hint [[:key1 -1]]))]
           (is (= "key1_-1" (-> plan :queryPlanner :winningPlan :inputStage :indexName)))))
 
-      (testing "index4"
+      #_(testing "index4"
         (let [plan (-> (fetch :test_col :where {:key1 1} :explain? true :hint "key1_1_key2_-1"))]
           (is (= "key1_1_key2_-1" (-> plan :queryPlanner :winningPlan :inputStage :indexName)))))
 
@@ -649,6 +641,7 @@
              "suffusion of yellow")))))
 
 
+;; TODO: this is failing on the json branch too
 (deftest test-distinct-values
   (with-test-mongo
     (insert! :distinct {:genus "Pan" :species "troglodytes" :common-name "chimpanzee"})
@@ -1097,3 +1090,30 @@
         (is (= 3 (count index-info)))
         (is (set/subset? #{"key1_1" "key1_-1"}
                          (set (map :name index-info))))))))
+
+
+(deftest test-json-serialization
+  (with-test-mongo
+    (drop-coll! :json-test)
+    (insert! :json-test {:fruit "bananas" :count 1})
+    (let [bananas (fetch-one :json-test :as :json)
+          parsed (read-str bananas)]
+      (is (= {"fruit" "bananas"
+              "count" 1}
+             (select-keys parsed ["fruit" "count"]))))
+    (insert! :json-test
+
+             (clojure.data.json/write-str
+              {:fruit "apples" :count 2})
+
+             :from :json)
+    (let [fruits (->>
+                  (fetch :json-test :as :json)
+                  (map read-str)
+                  (map #(select-keys % ["fruit" "count"]))
+                  (set))]
+      (is (= #{{"fruit" "bananas"
+                "count" 1}
+               {"fruit" "apples"
+                "count" 2}}
+             fruits)))))