Respect :db/unique constraints; test upserts.

This version includes SQLite-level unique indexes; these should never be
needed.  I've included them as a fail-safe while testing; they'll help
us catch errors in the transaction layer above.
This commit is contained in:
Nick Alexander 2016-07-28 15:30:46 -07:00
parent 80742242e2
commit 9497d69b44
4 changed files with 343 additions and 95 deletions

View file

@ -77,7 +77,7 @@
(let [e (:e row) (let [e (:e row)
a (:a row) a (:a row)
v (:v row)] v (:v row)]
(Datom. e a (ds/<-SQLite schema a v) (:tx row) (:added row)))) (Datom. e a (ds/<-SQLite schema a v) (:tx row) (and (some? (:added row)) (not= 0 (:added row))))))
(defrecord DB [sqlite-connection schema idents current-tx] (defrecord DB [sqlite-connection schema idents current-tx]
;; idents is map {ident -> entid} of known idents. See http://docs.datomic.com/identity.html#idents. ;; idents is map {ident -> entid} of known idents. See http://docs.datomic.com/identity.html#idents.
@ -98,7 +98,7 @@
v (and v (ds/->SQLite schema a v))] ;; We assume e and a are always given. v (and v (ds/->SQLite schema a v))] ;; We assume e and a are always given.
(go-pair (go-pair
(->> (->>
{:select [:*] ;; e :a :v :tx] ;; TODO: generalize columns. {:select [:e :a :v :tx [1 :added]] ;; TODO: generalize columns.
:from [:datoms] :from [:datoms]
:where (cons :and (map #(vector := %1 %2) [:e :a :v :tx] (take-while (comp not nil?) [e a v tx])))} ;; Must drop nils. :where (cons :and (map #(vector := %1 %2) [:e :a :v :tx] (take-while (comp not nil?) [e a v tx])))} ;; Must drop nils.
(sql/format) (sql/format)
@ -113,7 +113,9 @@
v (ds/->SQLite schema a v)] v (ds/->SQLite schema a v)]
(go-pair (go-pair
(->> (->>
{:select [:*] :from [:datoms] :where [:and [:= :a a] [:= :v v]]} {:select [:e :a :v :tx [1 :added]] ;; TODO: generalize columns.
:from [:datoms]
:where [:and [:= :a a] [:= :v v] [:= :index_avet 1]]}
(sql/format) (sql/format)
(s/all-rows (:sqlite-connection db)) (s/all-rows (:sqlite-connection db))
@ -134,8 +136,12 @@
;; Update materialized datom view. ;; Update materialized datom view.
(if (.-added datom) (if (.-added datom)
(<? (exec (<? (exec
;; TODO: use schema to insert correct indexing flags. ["INSERT INTO datoms VALUES (?, ?, ?, ?, ?, ?, ?, ?)" e a v tx
["INSERT INTO datoms VALUES (?, ?, ?, ?, 0, 0)" e a v tx])) (ds/indexing? (.-schema db) a) ;; index_avet
(ds/ref? (.-schema db) a) ;; index_vaet
(ds/unique-value? (.-schema db) a) ;; unique_value
(ds/unique-identity? (.-schema db) a) ;; unique_identity
]))
(<? (exec (<? (exec
;; TODO: verify this is correct. ;; TODO: verify this is correct.
["DELETE FROM datoms WHERE (e = ? AND a = ? AND v = ?)" e a v])))))) ["DELETE FROM datoms WHERE (e = ? AND a = ? AND v = ?)" e a v]))))))
@ -202,9 +208,22 @@
(defn id-literal? [x] (defn id-literal? [x]
(and (instance? TempId x))) (and (instance? TempId x)))
(defn temp-literal? [x] (defrecord TxReport [db-before db-after entities tx-data tempids])
(and (id-literal? x)
(= :db.part/temp (:part x)))) (defn- report? [x]
(and (instance? TxReport x)))
(defonce -eid (atom (- 0x200 1)))
;; TODO: better here.
(defn- next-eid [db]
(swap! -eid inc))
(defn- allocate-eid
[report id-literal eid]
{:pre [(report? report) (id-literal? id-literal) (and (integer? eid) (not (neg? eid)))]}
(assoc-in report [:tempids id-literal] eid))
;; (def data-readers {'db/id id-literal}) ;; (def data-readers {'db/id id-literal})
@ -235,7 +254,7 @@
(go-pair (go-pair
(when-not (= sqlite-schema/current-version (<? (sqlite-schema/<ensure-current-version sqlite-connection))) (when-not (= sqlite-schema/current-version (<? (sqlite-schema/<ensure-current-version sqlite-connection)))
(raise "Could not ensure current SQLite schema version.")) (raise "Could not ensure current SQLite schema version."))
(let [idents (into (<? (<idents sqlite-connection)) {:db/txInstant 100 :db/ident 101 :x 102 :y 103 :name 104 :aka 105 :test/kw 106})] ;; TODO: pre-populate idents and SQLite tables? (let [idents (into (<? (<idents sqlite-connection)) {:db/txInstant 100 :db/ident 101 :x 102 :y 103 :name 104 :aka 105 :test/kw 106 :age 107 :email 108 :spouse 109})] ;; TODO: pre-populate idents and SQLite tables?
(map->DB (map->DB
{:sqlite-connection sqlite-connection {:sqlite-connection sqlite-connection
:idents idents :idents idents
@ -245,11 +264,6 @@
(defn connection-with-db [db] (defn connection-with-db [db]
(map->Connection {:current-db (atom db)})) (map->Connection {:current-db (atom db)}))
(defrecord TxReport [db-before db-after entities tx-data tempids])
(defn- report? [x]
(and (instance? TxReport x)))
;; ;; TODO: persist max-tx and max-eid in SQLite. ;; ;; TODO: persist max-tx and max-eid in SQLite.
(defn maybe-datom->entity [entity] (defn maybe-datom->entity [entity]
@ -265,21 +279,28 @@
true true
entity)) entity))
(defn maybe-explode [schema entity] ;; TODO db? schema? (defn explode-entities [schema report]
(let [initial-es (:entities report)
initial-report (assoc report :entities [])]
(loop [report initial-report
es initial-es]
(let [[entity & entities] es]
(cond (cond
(nil? entity)
report
(map? entity) (map? entity)
;; TODO: reverse refs, lists, nested maps ;; TODO: reverse refs, lists, nested maps
(let [eid (or (:db/id entity) (if-let [eid (:db/id entity)]
(id-literal :db.part/temp))] ;; Must upsert if no ID given. TODO: check if this fails in Datomic/DS. (let [exploded (for [[a v] (dissoc entity :db/id)]
(for [[a v] (dissoc entity :db/id)] [:db/add eid a v])]
[:db/add eid a v])) (recur report (concat exploded entities)))
(raise "Map entity missing :db/id, got " entity
;; (raise "Map entities are not yet supported, got " entity {:error :transact/entity-missing-db-id
;; {:error :transact/syntax :op entity }))
;; :op entity })
true true
[entity])) (recur (util/conj-in report [:entities] entity) entities))))))
(defn maybe-ident->entid [db [op & entity :as orig]] (defn maybe-ident->entid [db [op & entity :as orig]]
;; TODO: use something faster than `into` here. ;; TODO: use something faster than `into` here.
@ -302,32 +323,30 @@
(defn preprocess [db report] (defn preprocess [db report]
{:pre [(db? db) (report? report)]} {:pre [(db? db) (report? report)]}
(let [initial-es (conj (or (:entities report) []) (tx-entity db))] (let [initial-es (or (:entities report) [])]
(when-not (sequential? initial-es) (when-not (sequential? initial-es)
(raise "Bad transaction data " initial-es ", expected sequential collection" (raise "Bad transaction data " initial-es ", expected sequential collection"
{:error :transact/syntax, :tx-data initial-es})) {:error :transact/syntax, :tx-data initial-es}))
(->> ;; TODO: find an approach that generates less garbage.
(-> (->
(comp report
;; Track the provenance of each assertion for error reporting.
(map #(with-meta % {:source %})) (update :entities conj (tx-entity db))
;; Normalize Datoms into :db/add or :db/retract vectors. ;; Normalize Datoms into :db/add or :db/retract vectors.
(map maybe-datom->entity) (update :entities (partial map maybe-datom->entity))
;; Explode map shorthand, such as {:db/id e :attr value :_reverse ref}, ;; Explode map shorthand, such as {:db/id e :attr value :_reverse ref},
;; to a list of vectors, like ;; to a list of vectors, like
;; [[:db/add e :attr value] [:db/add ref :reverse e]]. ;; [[:db/add e :attr value] [:db/add ref :reverse e]].
(mapcat (partial maybe-explode (schema db))) (->> (explode-entities (schema db)))
;; Replace idents with entids where possible. ;; Replace idents with entids where possible.
(map (partial maybe-ident->entid db)) (update :entities (partial map (partial maybe-ident->entid db)))
;; Add tx if not given. ;; Add tx if not given.
(map (partial maybe-add-current-tx (current-tx db)))) (update :entities (partial map (partial maybe-add-current-tx (current-tx db)))))))
(transduce conj [] initial-es))
(assoc-in report [:entities]))))
(defn- lookup-ref? [x] (defn- lookup-ref? [x]
(and (sequential? x) (and (sequential? x)
@ -376,16 +395,6 @@
field))))) field)))))
(assoc-in report [:entities])))) ;; TODO: meta. (assoc-in report [:entities])))) ;; TODO: meta.
(defonce -eid (atom (- 0x200 1)))
;; TODO: better here.
(defn- next-eid [db]
(swap! -eid inc))
(defn- allocate-eid
[report id-literal eid]
(assoc-in report [:tempids id-literal] eid))
(declare <resolve-id-literals) (declare <resolve-id-literals)
(defn <retry-with-tempid [db report es tempid upserted-eid] (defn <retry-with-tempid [db report es tempid upserted-eid]
@ -437,17 +446,10 @@
initial-entities (sort-by keyfn (:entities report))] initial-entities (sort-by keyfn (:entities report))]
(loop [report initial-report (loop [report initial-report
es initial-entities] es initial-entities]
(if (report? initial-report)
(update report :tempids #(into {} (filter (comp not temp-literal? first) %)))
(raise "fail" {:initial-report report}))
(let [[[op e a v tx :as entity] & entities] es] (let [[[op e a v tx :as entity] & entities] es]
(cond (cond
(nil? entity) (nil? entity)
;; We can add :db.part/temp id-literals; remove them. report
(if (report? report)
(update report :tempids #(into {} (filter (comp not temp-literal? first) %)))
(raise "fail" {:report report}))
(and (not= op :db/add) (and (not= op :db/add)
(not (empty? (filter id-literal? [e a v tx])))) (not (empty? (filter id-literal? [e a v tx]))))
@ -457,9 +459,9 @@
;; Upsert! ;; Upsert!
(and (id-literal? e) (and (id-literal? e)
(ds/unique-identity? (schema db) a) ;; TODO: schema. (ds/unique-identity? (schema db) a)
(not-any? id-literal? [a v tx])) (not-any? id-literal? [a v tx]))
(let [upserted-eid (:e (first (<? (<avet db [a v])))) ;; TODO: define this interface. (let [upserted-eid (:e (first (<? (<avet db [a v]))))
allocated-eid (get-in report [:tempids e])] allocated-eid (get-in report [:tempids e])]
(if (and upserted-eid allocated-eid (not= upserted-eid allocated-eid)) (if (and upserted-eid allocated-eid (not= upserted-eid allocated-eid))
(<? (<retry-with-tempid db initial-report initial-entities e upserted-eid)) ;; TODO: not initial report, just the sorted entities here. (<? (<retry-with-tempid db initial-report initial-entities e upserted-eid)) ;; TODO: not initial report, just the sorted entities here.
@ -493,21 +495,73 @@
(defn- transact-report [report datom] (defn- transact-report [report datom]
(update-in report [:tx-data] conj datom)) (update-in report [:tx-data] conj datom))
(defn- ensure-schema-constraints (defn- <ensure-schema-constraints
"Verify that all entities obey the schema constraints." "Throw unless all entities in :entities obey the schema constraints."
[db report] [db report]
{:pre [(db? db) (report? report)]} {:pre [(db? db) (report? report)]}
;; TODO: :db/unique :db.unique/value.
;; TODO: consider accumulating errors to show more meaningful error reports. ;; TODO: consider accumulating errors to show more meaningful error reports.
;; TODO: constrain entities; constrain attributes. ;; TODO: constrain entities; constrain attributes.
(go-pair
(doseq [[op e a v tx] (:entities report)] (doseq [[op e a v tx] (:entities report)]
(ds/ensure-valid-value (schema db) a v)) (ds/ensure-valid-value (schema db) a v))
report) report))
(defn <postprocess [db report] (defn- <ensure-unique-constraints
"Throw unless all datoms in :tx-data obey the uniqueness constraints."
[db report]
{:pre [(db? db) (report? report)]}
;; TODO: consider accumulating errors to show more meaningful error reports.
;; TODO: constrain entities; constrain attributes.
(go-pair
;; TODO: comment on applying datoms that violate uniqueness.
(let [unique-datoms (transient {})] ;; map (nil, a, v)|(e, a, nil)|(e, a, v) -> datom.
(doseq [[e a v tx added :as datom] (:tx-data report)]
(when added
;; Check for violated :db/unique constraint between datom and existing store.
(when (ds/unique? (schema db) a)
(when-let [found (first (<? (<avet db [a v])))]
(raise "Cannot add " datom " because of unique constraint: " found
{:error :transact/unique
:attribute a ;; TODO: map attribute back to ident.
:entity datom})))
;; Check for violated :db/unique constraint between datoms.
(when (ds/unique? (schema db) a)
(let [key [nil a v]]
(when-let [other (get unique-datoms key)]
(raise "Cannot add " datom " and " other " because together they violate unique constraint"
{:error :transact/unique
:attribute a ;; TODO: map attribute back to ident.
:entity datom}))
(assoc! unique-datoms key datom)))
;; Check for violated :db/cardinality :db.cardinality/one constraint between datoms.
(when-not (ds/multival? (schema db) a)
(let [key [e a nil]]
(when-let [other (get unique-datoms key)]
(raise "Cannot add " datom " and " other " because together they violate cardinality constraint"
{:error :transact/unique
:entity datom}))
(assoc! unique-datoms key datom)))
;; Check for duplicated datoms. Datomic doesn't allow overlapping writes, and we don't
;; want to guarantee order, so we don't either.
(let [key [e a v]]
(when-let [other (get unique-datoms key)]
(raise "Cannot add duplicate " datom
{:error :transact/unique
:entity datom}))
(assoc! unique-datoms key datom)))))
report))
(defn <entities->tx-data [db report]
{:pre [(db? db) (report? report)]} {:pre [(db? db) (report? report)]}
(go-pair (go-pair
(let [initial-report report] (let [initial-report report]
@ -546,7 +600,8 @@
{:pre [(db? db) (report? report)]} {:pre [(db? db) (report? report)]}
(go-pair (go-pair
(->> report (->>
report
(preprocess db) (preprocess db)
(<resolve-lookup-refs db) (<resolve-lookup-refs db)
@ -555,9 +610,13 @@
(<resolve-id-literals db) (<resolve-id-literals db)
(<?) (<?)
(ensure-schema-constraints db) (<ensure-schema-constraints db)
(<?)
(<postprocess db) (<entities->tx-data db)
(<?)
(<ensure-unique-constraints db)
(<?)))) (<?))))
;; Normalize as [op int|id-literal int|id-literal value|id-literal tx|id-literal]. ;; TODO: mention lookup-refs. ;; Normalize as [op int|id-literal int|id-literal value|id-literal tx|id-literal]. ;; TODO: mention lookup-refs.
@ -573,9 +632,8 @@
"Transactions may add idents, install new partitions, and install new schema attributes. "Transactions may add idents, install new partitions, and install new schema attributes.
Handle :db/ident assertions here." Handle :db/ident assertions here."
[db tx-data] [db tx-data]
{:pre [(db? db) {:pre [(db? db)]}
;; (report? report)
]}
;; TODO: use q to filter the report! ;; TODO: use q to filter the report!
(let [original-db db (let [original-db db
original-ident-assertions (filter (partial is-ident? db) tx-data)] original-ident-assertions (filter (partial is-ident? db) tx-data)]

View file

@ -32,6 +32,10 @@
:cljs [^boolean indexing?]) [schema attr] :cljs [^boolean indexing?]) [schema attr]
(is-attr? schema attr :db/index)) (is-attr? schema attr :db/index))
(defn #?@(:clj [^Boolean unique?]
:cljs [^boolean unique?]) [schema attr]
(is-attr? schema attr :db/unique))
(defn #?@(:clj [^Boolean unique-identity?] (defn #?@(:clj [^Boolean unique-identity?]
:cljs [^boolean unique-identity?]) [schema attr] :cljs [^boolean unique-identity?]) [schema attr]
(is-attr? schema attr :db.unique/identity)) (is-attr? schema attr :db.unique/identity))

View file

@ -18,11 +18,15 @@
(def current-version 1) (def current-version 1)
(def v1-statements (def v1-statements
["CREATE TABLE datoms (e INTEGER NOT NULL, a SMALLINT NOT NULL, v BLOB NOT NULL, tx INTEGER NOT NULL, index_avet TINYINT NOT NULL DEFAULT 0, index_vaet TINYINT NOT NULL DEFAULT 0)" ["CREATE TABLE datoms (e INTEGER NOT NULL, a SMALLINT NOT NULL, v BLOB NOT NULL, tx INTEGER NOT NULL,
index_avet TINYINT NOT NULL DEFAULT 0, index_vaet TINYINT NOT NULL DEFAULT 0,
unique_value TINYINT NOT NULL DEFAULT 0, unique_identity TINYINT NOT NULL DEFAULT 0)"
"CREATE INDEX eavt ON datoms (e, a)" ;; No v -- that's an opt-in index. "CREATE INDEX eavt ON datoms (e, a)" ;; No v -- that's an opt-in index.
"CREATE INDEX aevt ON datoms (a, e)" ;; No v -- that's an opt-in index. "CREATE INDEX aevt ON datoms (a, e)" ;; No v -- that's an opt-in index.
"CREATE INDEX avet ON datoms (a, v, e) WHERE index_avet = 1" ;; Opt-in index: only if a has :db/index true. "CREATE UNIQUE INDEX avet ON datoms (a, v, e) WHERE index_avet = 1" ;; Opt-in index: only if a has :db/index true.
"CREATE INDEX vaet ON datoms (v, a, e) WHERE index_vaet = 1" ;; Opt-in index: only if a has :db/valueType :db.type/ref "CREATE UNIQUE INDEX vaet ON datoms (v, a, e) WHERE index_vaet = 1" ;; Opt-in index: only if a has :db/valueType :db.type/ref
"CREATE UNIQUE INDEX unique_value ON datoms (v) WHERE unique_value = 1" ;; TODO.
"CREATE UNIQUE INDEX unique_identity ON datoms (a, v) WHERE unique_identity = 1" ;; TODO.
"CREATE TABLE transactions (e INTEGER NOT NULL, a SMALLINT NOT NULL, v BLOB NOT NULL, tx INTEGER NOT NULL, added TINYINT NOT NULL DEFAULT 1)" "CREATE TABLE transactions (e INTEGER NOT NULL, a SMALLINT NOT NULL, v BLOB NOT NULL, tx INTEGER NOT NULL, added TINYINT NOT NULL DEFAULT 1)"
"CREATE INDEX tx ON transactions (tx)" "CREATE INDEX tx ON transactions (tx)"
"CREATE TABLE attributes (name TEXT NOT NULL PRIMARY KEY, a INTEGER UNIQUE NOT NULL)"]) "CREATE TABLE attributes (name TEXT NOT NULL PRIMARY KEY, a INTEGER UNIQUE NOT NULL)"])

View file

@ -45,6 +45,15 @@
(filter #(not (= :db/txInstant (second %)))) (filter #(not (= :db/txInstant (second %))))
(set))))) (set)))))
(defn- <shallow-entity [db eid]
(let [entids (zipmap (vals (dm/idents db)) (keys (dm/idents db)))]
(go-pair
(->>
(s/all-rows (:sqlite-connection db) ["SELECT a, v FROM datoms WHERE e = ?" eid])
(<?)
(mapv #(vector (entids (:a %)) (:v %)))
(reduce conj {})))))
(defn- <transactions [db] (defn- <transactions [db]
(let [entids (zipmap (vals (dm/idents db)) (keys (dm/idents db)))] (let [entids (zipmap (vals (dm/idents db)) (keys (dm/idents db)))]
(go-pair (go-pair
@ -64,7 +73,13 @@
:name {:db/unique :db.unique/identity :name {:db/unique :db.unique/identity
:db/valueType :db.type/string} :db/valueType :db.type/string}
:aka {:db/cardinality :db.cardinality/many :aka {:db/cardinality :db.cardinality/many
:db/valueType :db.type/string}}) :db/valueType :db.type/string}
:age {:db/valueType :db.type/integer}
:email {:db/unique :db.unique/identity
:db/valueType :db.type/string}
:spouse {:db/unique :db.unique/value
:db/valueType :db.type/string}
})
(deftest-async test-add-one (deftest-async test-add-one
(with-tempfile [t (tempfile)] (with-tempfile [t (tempfile)]
@ -159,6 +174,28 @@
(finally (finally
(<? (dm/close-db db))))))) (<? (dm/close-db db)))))))
(deftest-async test-unique
(with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t))
db (<? (dm/<db-with-sqlite-connection c test-schema))
conn (dm/connection-with-db db)
now -1]
(try
(testing "Multiple :db/unique values in tx-data violate unique constraint, no tempid"
(is (thrown-with-msg?
ExceptionInfo #"unique constraint"
(<? (dm/<transact! conn [[:db/add 1 :x 0]
[:db/add 2 :x 0]] now)))))
(testing "Multiple :db/unique values in tx-data violate unique constraint, tempid"
(is (thrown-with-msg?
ExceptionInfo #"unique constraint"
(<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/user -1) :spouse "Dana"]
[:db/add (dm/id-literal :db.part/user -2) :spouse "Dana"]] now)))))
(finally
(<? (dm/close-db db)))))))
(deftest-async test-add-ident (deftest-async test-add-ident
(with-tempfile [t (tempfile)] (with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t)) (let [c (<? (s/<sqlite-connection t))
@ -219,3 +256,148 @@
(finally (finally
(<? (dm/close-db db))))))) (<? (dm/close-db db)))))))
(deftest-async test-vector-upsert
(with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t))
db (<? (dm/<db-with-sqlite-connection c test-schema))
conn (dm/connection-with-db db)
now 0xdeadbeef]
(try
;; Not having DB-as-value really hurts us here.
(let [<with-base-and (fn [entities]
(go-pair
(<? (s/execute! (:sqlite-connection (dm/db conn)) ["DELETE FROM datoms"]))
(<? (s/execute! (:sqlite-connection (dm/db conn)) ["DELETE FROM transactions"]))
;; TODO: don't rely on explicit IDs.
(<? (dm/<transact! conn [{:db/id 1 :name "Ivan" :email "@1"}
{:db/id 2 :name "Petr" :email "@2"}] now))
(<? (dm/<transact! conn entities now))))
tempids (fn [tx] (into {} (map (juxt (comp :idx first) second) (:tempids tx))))]
(testing "upsert with tempid"
(let [tx (<? (<with-base-and [[:db/add (dm/id-literal :db.part/user -1) :name "Ivan"]
[:db/add (dm/id-literal :db.part/user -1) :age 12]]))]
(is (= (<? (<shallow-entity (dm/db conn) 1))
{:name "Ivan" :age 12 :email "@1"}))
(is (= (tempids tx)
{-1 1}))))
(testing "upsert with tempid, order does not matter"
(let [tx (<? (<with-base-and [[:db/add (dm/id-literal :db.part/user -1) :age 12]
[:db/add (dm/id-literal :db.part/user -1) :name "Ivan"]]))]
(is (= (<? (<shallow-entity (dm/db conn) 1))
{:name "Ivan" :age 12 :email "@1"}))
(is (= (tempids tx)
{-1 1}))))
(testing "Conflicting upserts fail"
(is (thrown-with-msg? Throwable #"Conflicting upsert: #datomish.db.TempId\{:part :db.part/user, :idx -\d+\} resolves both to \d+ and \d+"
(<? (dm/<with db [[:db/add (dm/id-literal :db.part/user -1) :name "Ivan"]
[:db/add (dm/id-literal :db.part/user -1) :age 35]
[:db/add (dm/id-literal :db.part/user -1) :name "Petr"]
[:db/add (dm/id-literal :db.part/user -1) :age 36]]))))))
(finally
(<? (dm/close-db db)))))))
(deftest-async test-map-upsert
(with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t))
db (<? (dm/<db-with-sqlite-connection c test-schema))
conn (dm/connection-with-db db)
now 0xdeadbeef]
(try
;; Not having DB-as-value really hurts us here.
(let [<with-base-and (fn [entities]
(go-pair
(<? (s/execute! (:sqlite-connection (dm/db conn)) ["DELETE FROM datoms"]))
(<? (s/execute! (:sqlite-connection (dm/db conn)) ["DELETE FROM transactions"]))
;; TODO: don't rely on explicit IDs.
(<? (dm/<transact! conn [{:db/id 1 :name "Ivan" :email "@1"}
{:db/id 2 :name "Petr" :email "@2"}] now))
(<? (dm/<transact! conn entities now))))
tempids (fn [tx] (into {} (map (juxt (comp :idx first) second) (:tempids tx))))]
(testing "upsert with tempid"
(let [tx (<? (<with-base-and [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :age 35}]))]
(is (= (<? (<shallow-entity (dm/db conn) 1))
{:name "Ivan" :email "@1" :age 35}))
(is (= (tempids tx)
{-1 1}))))
(testing "upsert by 2 attrs with tempid"
(let [tx (<? (<with-base-and [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :email "@1" :age 35}]))]
(is (= (<? (<shallow-entity (dm/db conn) 1))
{:name "Ivan" :email "@1" :age 35}))
(is (= (tempids tx)
{-1 1}))))
(testing "upsert to two entities, resolve to same tempid, fails due to overlapping writes"
(is (thrown-with-msg? Throwable #"cardinality constraint"
(<? (<with-base-and [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :age 35}
{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :age 36}])))))
(testing "upsert to two entities, two tempids, fails due to overlapping writes"
(is (thrown-with-msg? Throwable #"cardinality constraint"
(<? (<with-base-and [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :age 35}
{:db/id (dm/id-literal :db.part/user -2) :name "Ivan" :age 36}])))))
(testing "upsert with existing id"
(let [tx (<? (<with-base-and [{:db/id 1 :name "Ivan" :age 35}]))]
(is (= (<? (<shallow-entity (dm/db conn) 1))
{:name "Ivan" :email "@1" :age 35}))
(is (= (tempids tx)
{}))))
(testing "upsert by 2 attrs with existing id"
(let [tx (<? (<with-base-and [{:db/id 1 :name "Ivan" :email "@1" :age 35}]))]
(is (= (<? (<shallow-entity (dm/db conn) 1))
{:name "Ivan" :email "@1" :age 35}))
(is (= (tempids tx)
{})))))
(finally
(<? (dm/close-db db)))))))
(deftest-async test-map-upsert-conflicts
(with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t))
db (<? (dm/<db-with-sqlite-connection c test-schema))
conn (dm/connection-with-db db)
now 0xdeadbeef]
(try
;; Not having DB-as-value really hurts us here.
(let [<with-base-and (fn [entities]
(go-pair
(<? (s/execute! (:sqlite-connection (dm/db conn)) ["DELETE FROM datoms"]))
(<? (s/execute! (:sqlite-connection (dm/db conn)) ["DELETE FROM transactions"]))
;; TODO: don't rely on explicit IDs.
(<? (dm/<transact! conn [{:db/id 1 :name "Ivan" :email "@1"}
{:db/id 2 :name "Petr" :email "@2"}] now))
(<? (dm/<transact! conn entities now))))
tempids (fn [tx] (into {} (map (juxt (comp :idx first) second) (:tempids tx))))]
;; TODO: improve error message to refer to upsert inputs.
(testing "upsert conficts with existing id"
(is (thrown-with-msg? Throwable #"unique constraint"
(<? (<with-base-and [{:db/id 2 :name "Ivan" :age 36}])))))
;; TODO: improve error message to refer to upsert inputs.
(testing "upsert conficts with non-existing id"
(is (thrown-with-msg? Throwable #"unique constraint"
(<? (<with-base-and [{:db/id 3 :name "Ivan" :age 36}])))))
(testing "upsert by non-existing value resolves as update"
(let [tx (<? (<with-base-and [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :email "@3" :age 35}]))]
(is (= (<? (<shallow-entity (dm/db conn) 1))
{:name "Ivan" :email "@3" :age 35}))
(is (= (tempids tx)
{-1 1}))))
;; TODO: improve error message to refer to upsert inputs.
(testing "upsert by 2 conflicting fields"
(is (thrown-with-msg? Throwable #"Conflicting upsert: #datomish.db.TempId\{:part :db.part/user, :idx -\d+\} resolves both to \d+ and \d+"
(<? (<with-base-and [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :email "@2" :age 35}]))))))
(finally
(<? (dm/close-db db)))))))