Bootstrap DB schema; persist and restore schema from materialized views.

This commit is contained in:
Nick Alexander 2016-08-03 08:47:55 -07:00
parent 5d271454ac
commit 296c9cb436
5 changed files with 420 additions and 215 deletions

View file

@ -209,7 +209,15 @@
(defn id-literal? [x]
(and (instance? TempId x)))
(defrecord TxReport [db-before db-after entities tx-data tempids])
(defrecord TxReport [db-before ;; The DB before the transaction.
db-after ;; The DB after the transaction.
entities ;; The set of entities (like [:db/add e a v tx]) processed.
tx-data ;; The set of datoms applied to the database, like (Datom. e a v tx added).
tempids ;; The map from id-literal -> numeric entid.
added-parts ;; The set of parts added during the transaction via :db.part/db :db.install/part.
added-idents ;; The map of idents -> entid added during the transaction, via e :db/ident ident.
added-attributes ;; The map of schema attributes (ident -> schema fragment) added during the transaction, via :db.part/db :db.install/attribute.
])
(defn- report? [x]
(and (instance? TxReport x)))
@ -234,8 +242,10 @@
;; TODO: implement support for DB parts?
(def tx0 0x2000000)
(def default-schema
{
(def ^{:private true} bootstrap-symbolic-schema
{:db/ident {:db/valueType :db.type/keyword
:db/cardinality :db.cardinality/one
:db/unique :db.unique/identity}
:db.install/partition {:db/valueType :db.type/ref
:db/cardinality :db.cardinality/many}
:db.install/valueType {:db/valueType :db.type/ref
@ -247,10 +257,7 @@
;; :db/cardinality :db.cardinality/many}
:db/txInstant {:db/valueType :db.type/integer
:db/cardinality :db.cardinality/one
:db/index true}
:db/ident {:db/valueType :db.type/keyword
:db/cardinality :db.cardinality/one
:db/unique :db.unique/identity}
} ;; :db/index true} TODO: Handle this using SQLite protocol.
:db/valueType {:db/valueType :db.type/ref
:db/cardinality :db.cardinality/one}
:db/cardinality {:db/valueType :db.type/ref
@ -267,13 +274,90 @@
:db/cardinality :db.cardinality/one}
})
(def ^{:private true} bootstrap-idents
{:db/ident 1
:db.part/db 2
:db/txInstant 3
:db.install/partition 4
:db.install/valueType 5
:db.install/attribute 6
:db/valueType 7
:db/cardinality 8
:db/unique 9
:db/isComponent 10
:db/index 11
:db/fulltext 12
:db/noHistory 13
:db/add 14
:db/retract 15
:db.part/tx 16
:db.part/user 17
:db/excise 18
:db.excise/attrs 19
:db.excise/beforeT 20
:db.excise/before 21
:db.alter/attribute 22
:db.type/ref 23
:db.type/keyword 24
:db.type/integer 25 ;; TODO: :db.type/long, to match Datomic?
:db.type/string 26
:db.type/boolean 27
:db.type/instant 28
:db.type/bytes 29
:db.cardinality/one 30
:db.cardinality/many 31
:db.unique/value 32
:db.unique/identity 33})
(defn- bootstrap-tx-data []
(concat
(map (fn [[ident entid]] [:db/add entid :db/ident ident]) bootstrap-idents)
(map (fn [[ident attrs]] (assoc attrs :db/id ident)) bootstrap-symbolic-schema)
(map (fn [[ident attrs]] [:db/add :db.part/db :db.install/attribute (get bootstrap-idents ident)]) bootstrap-symbolic-schema) ;; TODO: fail if nil.
))
(defn <idents [sqlite-connection]
"Read the ident map materialized view from the given SQLite store.
Returns a map (keyword ident) -> (integer entid), like {:db/ident 0}."
(let [<-SQLite (get-in ds/value-type-map [:db.type/keyword :<-SQLite])] ;; TODO: make this a protocol.
(go-pair
(let [rows (<? (->>
{:select [:e :v] :from [:datoms] :where [:= :a ":db/ident"]} ;; TODO: use raw entid.
{:select [:ident :entid] :from [:idents]}
(sql/format)
(s/all-rows sqlite-connection)))]
(into {} (map #(-> {(keyword (:v %)) (:e %)})) rows))))
(into {} (map (fn [row] [(<-SQLite (:ident row)) (:entid row)])) rows)))))
(defn <current-tx [sqlite-connection]
"Find the largest tx written to the SQLite store.
Returns an integer, -1 if no transactions have been written yet."
(go-pair
(let [rows (<? (s/all-rows sqlite-connection ["SELECT COALESCE(MAX(tx), -1) AS current_tx FROM transactions"]))]
(:current_tx (first rows)))))
(defn <symbolic-schema [sqlite-connection]
"Read the schema map materialized view from the given SQLite store.
Returns a map (keyword ident) -> (map (keyword attribute -> keyword value)), like
{:db/ident {:db/cardinality :db.cardinality/one}}."
(let [<-SQLite (get-in ds/value-type-map [:db.type/keyword :<-SQLite])] ;; TODO: make this a protocol.
(go-pair
(->>
(->>
{:select [:ident :attr :value] :from [:schema]}
(sql/format)
(s/all-rows sqlite-connection))
(<?)
(group-by (comp <-SQLite :ident))
(map (fn [[ident rows]]
[ident
(into {} (map (fn [row]
[(<-SQLite (:attr row)) (<-SQLite (:value row))]) rows))]))
(into {})))))
(declare <with-internal)
(defn <db-with-sqlite-connection
([sqlite-connection]
@ -283,16 +367,56 @@
(go-pair
(when-not (= sqlite-schema/current-version (<? (sqlite-schema/<ensure-current-version sqlite-connection)))
(raise "Could not ensure current SQLite schema version."))
(let [idents (clojure.set/union [:db/txInstant :db/ident :db.part/db :db.install/attribute :db.type/string :db.type/integer :db.type/ref :db/id :db.cardinality/one :db.cardinality/many :db/cardinality :db/valueType :x :y :name :aka :test/kw :age :email :spouse] (keys default-schema))
idents (into {} (map-indexed #(vector %2 %1) idents))
idents (into (<? (<idents sqlite-connection)) idents) ;; TODO: pre-populate idents and SQLite tables?
symbolic-schema (merge schema default-schema)]
(let [current-tx (<? (<current-tx sqlite-connection))
bootstrapped (>= current-tx 0)
current-tx (max current-tx tx0)]
(when-not bootstrapped
;; We need to bootstrap the DB.
(let [fail-alter-ident (fn [old new] (if-not (= old new)
(raise "Altering idents is not yet supported, got " new " altering existing ident " old
{:error :schema/alter-idents :old old :new new})
new))
fail-alter-attr (fn [old new] (if-not (= old new)
(raise "Altering schema attributes is not yet supported, got " new " altering existing schema attribute " old
{:error :schema/alter-schema :old old :new new})
new))]
(-> (map->DB
{:sqlite-connection sqlite-connection
:idents bootstrap-idents
:symbolic-schema bootstrap-symbolic-schema
:schema (ds/schema (into {} (map (fn [[k v]] [(k bootstrap-idents) v]) bootstrap-symbolic-schema))) ;; TODO: fail if ident missing.
:current-tx current-tx})
;; We use <with rather than <transact! to apply the bootstrap transaction data but to
;; not follow the regular schema application process. We can't apply the schema
;; changes, since the applied datoms would conflict with the bootstrapping idents and
;; schema. (The bootstrapping idents and schema are required to be able to write to
;; the database conveniently; without them, we'd have to manually write datoms to the
;; store. It's feasible but awkward.) After bootstrapping, we read back the idents
;; and schema, just like when we re-open.
(<with-internal (bootstrap-tx-data) fail-alter-ident fail-alter-attr)
(<?))))
;; We just bootstrapped, or we are returning to an already bootstrapped DB.
(let [idents (<? (<idents sqlite-connection))
symbolic-schema (<? (<symbolic-schema sqlite-connection))]
(when-not bootstrapped
(when (not (= idents bootstrap-idents))
(raise "After bootstrapping database, expected new materialized idents and old bootstrapped idents to be identical"
{:error :bootstrap/bad-idents,
:new idents :old bootstrap-idents
}))
(when (not (= symbolic-schema bootstrap-symbolic-schema))
(raise "After bootstrapping database, expected new materialized symbolic schema and old bootstrapped symbolic schema to be identical"
{:error :bootstrap/bad-symbolic-schema,
:new symbolic-schema :old bootstrap-symbolic-schema
})))
(map->DB
{:sqlite-connection sqlite-connection
:idents idents
:symbolic-schema symbolic-schema
:schema (ds/schema (into {} (map (fn [[k v]] [(k idents) v]) symbolic-schema)))
:current-tx tx0})))))
:schema (ds/schema (into {} (map (fn [[k v]] [(k idents) v]) symbolic-schema))) ;; TODO: fail if ident missing.
:current-tx (inc current-tx)}))))))
(defn connection-with-db [db]
(map->Connection {:current-db (atom db)}))
@ -688,22 +812,22 @@
(defn- is-ident? [db [_ a & _]]
(= a (get-in db [:idents :db/ident])))
(defn process-db-ident-assertions
(defn collect-db-ident-assertions
"Transactions may add idents, install new partitions, and install new schema attributes.
Handle :db/ident assertions here."
Collect :db/ident assertions into :added-idents here."
[db report]
{:pre [(db? db) (report? report)]}
;; TODO: use q to filter the report!
(let [original-db db
(let [original-report report
tx-data (:tx-data report)
original-ident-assertions (filter (partial is-ident? db) tx-data)]
(loop [db original-db
(loop [report original-report
ident-assertions original-ident-assertions]
(let [[ia & ias] ident-assertions]
(cond
(nil? ia)
db
report
(not (:added ia))
(raise "Retracting a :db/ident is not yet supported, got " ia
@ -713,13 +837,8 @@
:else
;; Added.
(let [ident (:v ia)]
;; TODO: accept re-assertions?
(when (get-in db [:idents ident])
(raise "Re-asserting a :db/ident is not yet supported, got " ia
{:error :schema/idents
:op ia }))
(if (keyword? ident)
(recur (assoc-in db [:idents ident] (:e ia)) ias)
(recur (assoc-in report [:added-idents ident] (:e ia)) ias)
(raise "Cannot assert a :db/ident with a non-keyword value, got " ia
{:error :schema/idents
:op ia }))))))))
@ -735,51 +854,91 @@
(symbolicate tx)
added)))
(defn process-db-install-assertions
(defn collect-db-install-assertions
"Transactions may add idents, install new partitions, and install new schema attributes.
Handle [:db.part/db :db.install/attribute] assertions here."
Collect [:db.part/db :db.install/attribute] assertions here."
[db report]
{:pre [(db? db) (report? report)]}
;; TODO: be more efficient; symbolicating each datom is expensive!
(let [datoms (map (partial symbolicate-datom db) (:tx-data report))
schema-fragment (datomish.schema-changes/datoms->schema-fragment datoms)
fail (fn [old new] (raise "Altering schema elements is not yet supported, got " new " altering existing schema element " old
{:error :schema/alter-schema :old old :new new}))]
schema-fragment (datomish.schema-changes/datoms->schema-fragment datoms)]
(assoc-in report [:added-attributes] schema-fragment)))
(if (empty? schema-fragment)
db
(let [symbolic-schema (merge-with fail (:symbolic-schema db) schema-fragment)
schema (ds/schema (into {} (map (fn [[k v]] [(k (idents db)) v]) symbolic-schema)))]
(assoc db
:symbolic-schema symbolic-schema
:schema schema)))))
(defn <with [db tx-data]
;; TODO: lift to IDB.
(defn <apply-db-ident-assertions [db added-idents]
(go-pair
(let [report (<? (<transact-tx-data db 0xdeadbeef ;; TODO
(let [->SQLite (get-in ds/value-type-map [:db.type/keyword :->SQLite]) ;; TODO: make this a protocol.
exec (partial s/execute! (:sqlite-connection db))]
;; TODO: batch insert.
(doseq [[ident entid] added-idents]
(<? (exec
["INSERT INTO idents VALUES (?, ?)" (->SQLite ident) entid]))))
db))
(defn <apply-db-install-assertions [db fragment]
(go-pair
(let [->SQLite (get-in ds/value-type-map [:db.type/keyword :->SQLite]) ;; TODO: make this a protocol.
exec (partial s/execute! (:sqlite-connection db))]
;; TODO: batch insert.
(doseq [[ident attr-map] fragment]
(doseq [[attr value] attr-map]
(<? (exec
["INSERT INTO schema VALUES (?, ?, ?)" (->SQLite ident) (->SQLite attr) (->SQLite value)])))))
db))
(defn- <with-internal [db tx-data merge-ident merge-attr]
(go-pair
(let [report (->>
(map->TxReport
{:db-before db
:db-after db
;; :current-tx current-tx
:entities tx-data
:tx-data []
:tempids {}})))
:tempids {}
:added-parts {}
:added-idents {}
:added-attributes {}
})
(<transact-tx-data db 0xdeadbeef) ;; TODO: timestamp properly.
(<?)
(collect-db-ident-assertions db)
(collect-db-install-assertions db))
idents (merge-with merge-ident (:idents db) (:added-idents report))
symbolic-schema (merge-with merge-attr (:symbolic-schema db) (:added-attributes report))
schema (ds/schema (into {} (map (fn [[k v]] [(k idents) v]) symbolic-schema)))
db-after (->
db
(<apply-datoms (:tx-data report))
(<?)
(<advance-tx)
(<apply-db-ident-assertions (:added-idents report))
(<?)
(process-db-ident-assertions report)
(<apply-db-install-assertions (:added-attributes report))
(<?)
(process-db-install-assertions report))]
(assoc :idents idents
:symbolic-schema symbolic-schema
:schema schema)
(<advance-tx)
(<?))]
(-> report
(assoc-in [:db-after] db-after)))))
(defn- <with [db tx-data]
(let [fail-touch-ident (fn [old new] (raise "Altering idents is not yet supported, got " new " altering existing ident " old
{:error :schema/alter-idents :old old :new new}))
fail-touch-attr (fn [old new] (raise "Altering schema attributes is not yet supported, got " new " altering existing schema attribute " old
{:error :schema/alter-schema :old old :new new}))]
(<with-internal db tx-data fail-touch-ident fail-touch-attr)))
(defn <db-with [db tx-data]
(go-pair
(:db-after (<? (<with db tx-data)))))

View file

@ -21,7 +21,8 @@
Input: a sequence of datoms, like [e :keyword-attr v _ added].
1. Select [:db.part/db :db.install/attribute ... ].
2. Fail if any are not (= added true)
3. For each [ :db.part/db :db.install/attribute e ], collect {e {:db/* v}}.
3. For each [ :db.part/db :db.install/attribute e ], collect
{e {:db/* v}}, dropping the inner :db/ident key.
4. Map e -> ident; fail if not possible.
5. Return the map, with ident keys.
@ -55,6 +56,6 @@
db-avs (into {} (map ->av (filter db-*? datoms)))]
;; TODO: get ident from existing datom, to allow [:db.part/db :db.install/attribute existing-id].
(if-let [ident (:db/ident db-avs)]
[ident db-avs]
[ident (dissoc db-avs :db/ident)]
(raise ":db.install/attribute requires :db/ident, got " db-avs " for " e
{:error :schema/db-install :op db-avs}))))))))))

View file

@ -25,11 +25,24 @@
"CREATE INDEX aevt ON datoms (a, e)" ;; No v -- that's an opt-in index.
"CREATE UNIQUE INDEX avet ON datoms (a, v, e) WHERE index_avet = 1" ;; Opt-in index: only if a has :db/index true.
"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.
;; TODO: possibly remove this index. :db.unique/value should be asserted by the transactor in
;; all cases, but the index may speed up some of SQLite's query planning. For now, it services
;; to validate the transactor implementation.
"CREATE UNIQUE INDEX unique_value ON datoms (v) WHERE unique_value = 1"
;; TODO: possibly remove this index. :db.unique/identity should be asserted by the transactor in
;; all cases, but the index may speed up some of SQLite's query planning. For now, it serves to
;; validate the transactor implementation.
"CREATE UNIQUE INDEX unique_identity ON datoms (a, v) WHERE unique_identity = 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 TABLE attributes (name TEXT NOT NULL PRIMARY KEY, a INTEGER UNIQUE NOT NULL)"])
;; Materialized views of the schema.
"CREATE TABLE idents (ident TEXT NOT NULL PRIMARY KEY, entid INTEGER UNIQUE NOT NULL)"
"CREATE TABLE schema (ident TEXT NOT NULL, attr TEXT NOT NULL, value TEXT NOT NULL, FOREIGN KEY (ident) REFERENCES idents (ident))"
"CREATE INDEX unique_schema ON schema (ident, attr, value)"
])
(defn <create-current-version
[db]

View file

@ -11,6 +11,7 @@
(:require
[datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise cond-let]]
[datomish.sqlite :as s]
[datomish.sqlite-schema]
[datomish.datom]
[datascript.core :as d]
@ -35,16 +36,19 @@
#?(:cljs
(def Throwable js/Error))
(defn- <datoms [db]
(defn- <datoms-after [db tx]
(let [entids (zipmap (vals (dm/idents db)) (keys (dm/idents db)))]
(go-pair
(->>
(s/all-rows (:sqlite-connection db) ["SELECT e, a, v, tx FROM datoms"])
(s/all-rows (:sqlite-connection db) ["SELECT e, a, v, tx FROM datoms WHERE tx >= ?" tx])
(<?)
(mapv #(vector (:e %) (entids (:a %)) (:v %)))
(mapv #(vector (:e %) (get entids (:a %) (str "fail" (:a %))) (:v %)))
(filter #(not (= :db/txInstant (second %))))
(set)))))
(defn- <datoms [db]
(<datoms-after db 0))
(defn- <shallow-entity [db eid]
(let [entids (zipmap (vals (dm/idents db)) (keys (dm/idents db)))]
(go-pair
@ -54,32 +58,57 @@
(mapv #(vector (entids (:a %)) (:v %)))
(reduce conj {})))))
(defn- <transactions [db]
(defn- <transactions-after [db tx]
(let [entids (zipmap (vals (dm/idents db)) (keys (dm/idents db)))]
(go-pair
(->>
(s/all-rows (:sqlite-connection db) ["SELECT e, a, v, tx, added FROM transactions ORDER BY tx ASC, e, a, v, added"])
(s/all-rows (:sqlite-connection db) ["SELECT e, a, v, tx, added FROM transactions WHERE tx >= ? ORDER BY tx ASC, e, a, v, added" tx])
(<?)
(mapv #(vector (:e %) (entids (:a %)) (:v %) (:tx %) (:added %)))))))
(defn- <transactions [db]
(<transactions-after db 0))
(defn tx [report]
(get-in report [:db-after :current-tx]))
;; TODO: use reverse refs!
(def test-schema
{:x {:db/unique :db.unique/identity
[{:db/id (dm/id-literal :test -1)
:db/ident :x
:db/unique :db.unique/identity
:db/valueType :db.type/integer}
:y {:db/cardinality :db.cardinality/many
{:db/id :db.part/db :db.install/attribute (dm/id-literal :test -1)}
{:db/id (dm/id-literal :test -2)
:db/ident :name
:db/unique :db.unique/identity
:db/valueType :db.type/string}
{:db/id :db.part/db :db.install/attribute (dm/id-literal :test -2)}
{:db/id (dm/id-literal :test -3)
:db/ident :y
:db/cardinality :db.cardinality/many
:db/valueType :db.type/integer}
:name {:db/unique :db.unique/identity
{:db/id :db.part/db :db.install/attribute (dm/id-literal :test -3)}
{:db/id (dm/id-literal :test -5)
:db/ident :aka
:db/cardinality :db.cardinality/many
:db/valueType :db.type/string}
:aka {:db/cardinality :db.cardinality/many
{:db/id :db.part/db :db.install/attribute (dm/id-literal :test -5)}
{:db/id (dm/id-literal :test -6)
:db/ident :age
:db/valueType :db.type/integer}
{:db/id :db.part/db :db.install/attribute (dm/id-literal :test -6)}
{:db/id (dm/id-literal :test -7)
:db/ident :email
:db/unique :db.unique/identity
:db/valueType :db.type/string}
:age {:db/valueType :db.type/integer}
:email {:db/unique :db.unique/identity
{:db/id :db.part/db :db.install/attribute (dm/id-literal :test -7)}
{:db/id (dm/id-literal :test -8)
:db/ident :spouse
:db/unique :db.unique/value
:db/valueType :db.type/string}
:spouse {:db/unique :db.unique/value
:db/valueType :db.type/string}
})
{:db/id :db.part/db :db.install/attribute (dm/id-literal :test -8)}
])
(deftest-async test-add-one
(with-tempfile [t (tempfile)]
@ -88,12 +117,14 @@
conn (dm/connection-with-db db)
now 0xdeadbeef]
(try
(is (not (= nil (<? (dm/<transact! conn test-schema now)))))
(let [;; TODO: drop now, allow to set :db/txInstant.
report (<? (dm/<transact! conn [[:db/add 0 :name "valuex"]] now))
tx (tx report)]
(is (= (<? (<datoms (dm/db conn)))
(is (= (<? (<datoms-after (dm/db conn) tx))
#{[0 :name "valuex"]}))
(is (= (<? (<transactions (dm/db conn)))
(is (= (<? (<transactions-after (dm/db conn) tx))
[[0 :name "valuex" tx 1] ;; TODO: true, not 1.
[tx :db/txInstant now tx 1]])))
(finally
@ -106,16 +137,18 @@
conn (dm/connection-with-db db)
now 0xdeadbeef]
(try
(is (not (= nil (<? (dm/<transact! conn test-schema now)))))
(let [tx1 (tx (<? (dm/<transact! conn [[:db/add 1 :name "Ivan"]] now)))
tx2 (tx (<? (dm/<transact! conn [[:db/add 1 :name "Petr"]] now)))
tx3 (tx (<? (dm/<transact! conn [[:db/add 1 :aka "Tupen"]] now)))
tx4 (tx (<? (dm/<transact! conn [[:db/add 1 :aka "Devil"]] now)))]
(is (= (<? (<datoms (dm/db conn)))
(is (= (<? (<datoms-after (dm/db conn) tx1))
#{[1 :name "Petr"]
[1 :aka "Tupen"]
[1 :aka "Devil"]}))
(is (= (<? (<transactions (dm/db conn)))
(is (= (<? (<transactions-after (dm/db conn) tx1))
[[1 :name "Ivan" tx1 1] ;; TODO: true, not 1.
[tx1 :db/txInstant now tx1 1]
[1 :name "Ivan" tx2 0]
@ -136,11 +169,13 @@
conn (dm/connection-with-db db)
now 0xdeadbeef]
(try
(is (not (= nil (<? (dm/<transact! conn test-schema now)))))
(let [txa (tx (<? (dm/<transact! conn [[:db/add 0 :x 123]] now)))
txb (tx (<? (dm/<transact! conn [[:db/retract 0 :x 123]] now)))]
(is (= (<? (<datoms db))
(is (= (<? (<datoms-after (dm/db conn) txa))
#{}))
(is (= (<? (<transactions db))
(is (= (<? (<transactions-after (dm/db conn) txa))
[[0 :x 123 txa 1] ;; TODO: true, not 1.
[txa :db/txInstant now txa 1]
[0 :x 123 txb 0]
@ -155,6 +190,8 @@
conn (dm/connection-with-db db)
now -1]
(try
(is (not (= nil (<? (dm/<transact! conn test-schema now)))))
(let [report (<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/user -1) :x 0]
[:db/add (dm/id-literal :db.part/user -1) :y 1]
[:db/add (dm/id-literal :db.part/user -2) :y 2]
@ -163,9 +200,10 @@
[(dm/id-literal :db.part/user -1)
(dm/id-literal :db.part/user -2)]))
(let [eid1 (get-in report [:tempids (dm/id-literal :db.part/user -1)])
(let [tx (get-in report [:db-after :current-tx])
eid1 (get-in report [:tempids (dm/id-literal :db.part/user -1)])
eid2 (get-in report [:tempids (dm/id-literal :db.part/user -2)])]
(is (= (<? (<datoms db))
(is (= (<? (<datoms-after (dm/db conn) tx))
#{[eid1 :x 0]
[eid1 :y 1]
[eid2 :y 2]
@ -181,6 +219,8 @@
conn (dm/connection-with-db db)
now -1]
(try
(is (not (= nil (<? (dm/<transact! conn test-schema now)))))
(testing "Multiple :db/unique values in tx-data violate unique constraint, no tempid"
(is (thrown-with-msg?
ExceptionInfo #"unique constraint"
@ -199,30 +239,35 @@
(deftest-async test-valueType-keyword
(with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t))
db (<? (dm/<db-with-sqlite-connection c
(merge test-schema {:test/kw {:db/unique :db.unique/identity
:db/valueType :db.type/keyword}})))
db (<? (dm/<db-with-sqlite-connection c test-schema))
conn (dm/connection-with-db db)
now -1]
(try
(<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user -1)
:db/ident :test/kw
:db/unique :db.unique/identity
:db/valueType :db.type/keyword}
{:db/id :db.part/db :db.install/attribute (dm/id-literal :db.part/user -1)}] now))
(let [report (<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/user -1) :test/kw :test/kw1]] now))
tx (get-in report [:db-after :current-tx])
eid (get-in report [:tempids (dm/id-literal :db.part/user -1)])]
(is (= (<? (<datoms db))
(is (= (<? (<datoms-after (dm/db conn) tx))
#{[eid :test/kw ":test/kw1"]})) ;; Value is raw.
(testing "Adding the same value compares existing values correctly."
(<? (dm/<transact! conn [[:db/add eid :test/kw :test/kw1]] now))
(is (= (<? (<datoms db))
(is (= (<? (<datoms-after (dm/db conn) tx))
#{[eid :test/kw ":test/kw1"]}))) ;; Value is raw.
(testing "Upserting retracts existing value correctly."
(<? (dm/<transact! conn [[:db/add eid :test/kw :test/kw2]] now))
(is (= (<? (<datoms db))
(is (= (<? (<datoms-after (dm/db conn) tx))
#{[eid :test/kw ":test/kw2"]}))) ;; Value is raw.
(testing "Retracting compares values correctly."
(<? (dm/<transact! conn [[:db/retract eid :test/kw :test/kw2]] now))
(is (= (<? (<datoms db))
(is (= (<? (<datoms-after (dm/db conn) tx))
#{}))))
(finally
@ -233,41 +278,39 @@
(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))))
now 0xdeadbeef
tempids (fn [tx] (into {} (map (juxt (comp :idx first) second) (:tempids tx))))]
(try
(is (not (= nil (<? (dm/<transact! conn test-schema now)))))
;; Not having DB-as-value really hurts us here. This test only works because all upserts
;; succeed on top of each other, so we never need to reset the underlying store.
(<? (dm/<transact! conn test-schema now))
(<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :email "@1"}
{:db/id 102 :name "Petr" :email "@2"}] now))
(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))
(let [report (<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/user -1) :name "Ivan"]
[:db/add (dm/id-literal :db.part/user -1) :age 12]] now))]
(is (= (<? (<shallow-entity (dm/db conn) 101))
{:name "Ivan" :age 12 :email "@1"}))
(is (= (tempids tx)
{-1 1}))))
(is (= (tempids report)
{-1 101}))))
(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}))))
(let [report (<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/user -1) :age 13]
[:db/add (dm/id-literal :db.part/user -1) :name "Petr"]] now))]
(is (= (<? (<shallow-entity (dm/db conn) 102))
{:name "Petr" :age 13 :email "@2"}))
(is (= (tempids report)
{-1 102}))))
(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"]
(<? (dm/<transact! conn [[: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]]))))))
[:db/add (dm/id-literal :db.part/user -1) :age 36]] now)))))
(finally
(<? (dm/close-db db)))))))
@ -276,56 +319,52 @@
(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))))
now 0xdeadbeef
tempids (fn [tx] (into {} (map (juxt (comp :idx first) second) (:tempids tx))))]
(try
;; Not having DB-as-value really hurts us here. This test only works because all upserts
;; succeed on top of each other, so we never need to reset the underlying store.
(<? (dm/<transact! conn test-schema now))
(<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :email "@1"}
{:db/id 102 :name "Petr" :email "@2"}] now))
(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))
(let [tx (<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :age 35}] now))]
(is (= (<? (<shallow-entity (dm/db conn) 101))
{:name "Ivan" :email "@1" :age 35}))
(is (= (tempids tx)
{-1 1}))))
{-1 101}))))
(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))
(let [tx (<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :email "@1" :age 35}] now))]
(is (= (<? (<shallow-entity (dm/db conn) 101))
{: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}])))))
{-1 101}))))
(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}))
(let [tx (<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :age 36}] now))]
(is (= (<? (<shallow-entity (dm/db conn) 101))
{:name "Ivan" :email "@1" :age 36}))
(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}))
(let [tx (<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :email "@1" :age 37}] now))]
(is (= (<? (<shallow-entity (dm/db conn) 101))
{:name "Ivan" :email "@1" :age 37}))
(is (= (tempids tx)
{})))))
{}))))
(testing "upsert to two entities, resolve to same tempid, fails due to overlapping writes"
(is (thrown-with-msg? Throwable #"cardinality constraint"
(<? (dm/<transact! conn [{: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}] now)))))
(testing "upsert to two entities, two tempids, fails due to overlapping writes"
(is (thrown-with-msg? Throwable #"cardinality constraint"
(<? (dm/<transact! conn [{: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}] now)))))
(finally
(<? (dm/close-db db)))))))
@ -335,40 +374,36 @@
(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))))
now 0xdeadbeef
tempids (fn [tx] (into {} (map (juxt (comp :idx first) second) (:tempids tx))))]
(try
;; Not having DB-as-value really hurts us here. This test only works because all upserts
;; fail until the final one, so we never need to reset the underlying store.
(<? (dm/<transact! conn test-schema now))
(<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :email "@1"}
{:db/id 102 :name "Petr" :email "@2"}] now))
;; 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}])))))
(<? (dm/<transact! conn [{:db/id 102 :name "Ivan" :age 36}] now)))))
;; 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}))))
(<? (dm/<transact! conn [{:db/id 103 :name "Ivan" :age 36}] now)))))
;; 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}]))))))
(<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :email "@2" :age 35}] now)))))
(testing "upsert by non-existing value resolves as update"
(let [report (<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :email "@3" :age 35}] now))]
(is (= (<? (<shallow-entity (dm/db conn) 101))
{:name "Ivan" :email "@3" :age 35}))
(is (= (tempids report)
{-1 101}))))
(finally
(<? (dm/close-db db)))))))
@ -423,14 +458,13 @@
(testing "Schema is modified"
(is (= (get-in db-after [:symbolic-schema :test/attr])
{:db/ident :test/attr,
:db/valueType :db.type/string,
{:db/valueType :db.type/string,
:db/cardinality :db.cardinality/one})))
(testing "Schema is used in subsequent transaction"
(<? (dm/<transact! conn [{:db/id 1 :test/attr "value 1"}]))
(<? (dm/<transact! conn [{:db/id 1 :test/attr "value 2"}]))
(is (= (<? (<shallow-entity (dm/db conn) 1))
(<? (dm/<transact! conn [{:db/id 100 :test/attr "value 1"}]))
(<? (dm/<transact! conn [{:db/id 100 :test/attr "value 2"}]))
(is (= (<? (<shallow-entity (dm/db conn) 100))
{:test/attr "value 2"}))))
(finally

View file

@ -61,13 +61,11 @@
[2 :db/valueType :db.value/integer]
[2 :db/cardinalty :db.cardinality/many]]
{:test/attr1
{:db/ident :test/attr1
:db/valueType :db.value/string
{:db/valueType :db.value/string
:db/cardinalty :db.cardinality/one
:db/unique :db.unique/identity}
:test/attr2
{:db/ident :test/attr2
:db/valueType :db.value/integer
{:db/valueType :db.value/integer
:db/cardinalty :db.cardinality/many}})
;; :db/ident, :db/valueType, and :db/cardinality are required. valueType and cardinality are