greg/mentat
1
0
Fork 0
Code Issues 294 Pull requests Projects Releases 9 Packages Wiki Activity

Validate value types.

Browse source
This commit is contained in:
Nick Alexander 2016-07-27 17:07:05 -07:00
parent bceee3b5fb
commit 43423b7d0a
3 changed files with 116 additions and 43 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

52
src/datomish/db.cljc
View file

@ -207,6 +207,11 @@
;; TODO: implement support for DB parts?
(def tx0 0x2000000)
(def default-schema
{:db/txInstant {:db/valueType :db.type/integer}
:db/ident {:db/valueType :db.type/keyword}
})
(defn <idents [sqlite-connection]
(go-pair
(let [rows (<? (->>
@ -223,11 +228,11 @@
(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 (into (<? (<idents sqlite-connection)) {:db/txInstant 100 :db/ident 101 :x 102 :y 103})] ;; 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})] ;; TODO: pre-populate idents and SQLite tables?
(map->DB
{:sqlite-connection sqlite-connection
:idents idents
:schema (ds/schema (into {} (map (fn [[k v]] [(k idents) v]) schema)))
:schema (ds/schema (into {} (map (fn [[k v]] [(k idents) v]) (merge schema default-schema))))
:current-tx tx0})))))
(defn connection-with-db [db]
@ -288,6 +293,8 @@
[op e a v (or tx current-tx)]))
(defn preprocess [db report]
{:pre [(db? db) (report? report)]}
(let [initial-es (conj (or (:entities report) []) (tx-entity db))]
(when-not (sequential? initial-es)
(raise "Bad transaction data " initial-es ", expected sequential collection"
@ -351,6 +358,8 @@
(defn <resolve-lookup-refs [db report]
{:pre [(db? db) (report? report)]}
(go-pair
(->>
(vec (for [[op & entity] (:entities report)]
@ -409,21 +418,29 @@
simple allocations."
[db report]
{:pre [(db? db) (report? report)]}
(go-pair
(let [keyfn (fn [[op e a v tx]]
(if (and (id-literal? e)
(not-any? id-literal? [a v tx]))
(- 5)
(- (count (filter id-literal? [e a v tx])))))
initial-report (dissoc report :entities) ;; TODO.
initial-report (assoc report :entities []) ;; TODO.
initial-entities (sort-by keyfn (:entities report))]
(loop [report initial-report
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]
(cond
(nil? entity)
;; We can add :db.part/temp id-literals; remove them.
(update report :tempids #(into {} (filter (comp not temp-literal? first) %)))
(if (report? report)
(update report :tempids #(into {} (filter (comp not temp-literal? first) %)))
(raise "fail" {:report report}))
(and (not= op :db/add)
(not (empty? (filter id-literal? [e a v tx]))))
@ -438,9 +455,7 @@
(let [upserted-eid (:e (first (<? (<avet db [a v])))) ;; TODO: define this interface.
allocated-eid (get-in report [:tempids e])]
(if (and upserted-eid allocated-eid (not= upserted-eid allocated-eid))
(do
(<? (<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.
(let [eid (or upserted-eid allocated-eid (next-eid db))]
(recur (allocate-eid report e eid) (cons [op eid a v tx] entities)))))
@ -471,7 +486,22 @@
(defn- transact-report [report datom]
(update-in report [:tx-data] conj datom))
(defn- ensure-schema-constraints
"Verify that all entities obey the schema constraints."
[db report]
{:pre [(db? db) (report? report)]}
;; TODO: :db/unique :db.unique/value.
;; TODO: consider accumulating errors to show more meaningful error reports.
;; TODO: constrain entities; constrain attributes.
(doseq [[op e a v tx] (:entities report)]
(ds/ensure-valid-value (schema db) a v))
report)
(defn <postprocess [db report]
{:pre [(db? db) (report? report)]}
(go-pair
(let [initial-report report]
(loop [report initial-report
@ -505,11 +535,11 @@
{:error :transact/syntax, :operation op, :tx-data entity})))))))
(defn <transact-tx-data
[db now initial-report]
{:pre [(db? db)]}
[db now report]
{:pre [(db? db) (report? report)]}
(go-pair
(->> initial-report
(->> report
(preprocess db)
(<resolve-lookup-refs db)
@ -518,6 +548,8 @@
(<resolve-id-literals db)
(<?)
(ensure-schema-constraints db)
(<postprocess db)
(<?))))

37
src/datomish/schema.cljc
View file

@ -4,7 +4,8 @@
;; Purloined from DataScript.
(ns datomish.schema)
(ns datomish.schema
(:require [datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise]]))
(defprotocol ISchema
(attrs-by
@ -39,6 +40,9 @@
:cljs [^boolean unique-value?]) [schema attr]
(is-attr? schema attr :db.unique/value))
(defn schema? [x]
(satisfies? ISchema x))
(defrecord Schema [schema rschema]
ISchema
(attrs-by [schema property]
@ -76,8 +80,37 @@
:key k
:value v}))))
;; TODO: consider doing this with a protocol and extending the underlying Clojure(Script) types.
(def value-type-map
{:db.type/ref { :valid? #(and (integer? %) (pos? %)) :->SQLite identity :<-SQLite identity }
:db.type/keyword { :valid? keyword? :->SQLite name :<-SQLite keyword }
:db.type/string { :valid? string? :->SQLite identity :<-SQLite identity }
:db.type/boolean { :valid? #(instance? Boolean %) :->SQLite #(if % 1 0) :<-SQLite #(if (= % 1) true false) }
:db.type/integer { :valid? integer? :->SQLite identity :<-SQLite identity }
:db.type/real { :valid? float? :->SQLite identity :<-SQLite identity }
})
(defn #?@(:clj [^Boolean ensure-valid-value]
:cljs [^boolean ensure-valid-value]) [schema attr value]
{:pre [(schema? schema)]}
(let [schema (.-schema schema)]
(if-let [valueType (get-in schema [attr :db/valueType])]
(if-let [valid? (get-in value-type-map [valueType :valid?])]
(when-not (valid? value)
(raise "Invalid value for attribute " attr ", expected " valueType " but got " value
{:error :schema/valueType, :attribute attr, :value value}))
(raise "Unknown valueType for attribute " attr ", expected one of " (sorted-set (keys value-type-map))
{:error :schema/valueType, :attribute attr}))
(raise "Unknown attribute " attr ", expected one of " (sorted-set (keys schema))
{:error :schema/valueType, :attribute attr}))))
(defn- validate-schema [schema]
(doseq [[a kv] schema]
(when-not (:db/valueType kv)
(throw (ex-info (str "Bad attribute specification for " a ": should have {:db/valueType ...}")
{:error :schema/validation
:attribute a
:key :db/valueType})))
(let [comp? (:db/isComponent kv false)]
(validate-schema-key a :db/isComponent (:db/isComponent kv) #{true false})
(when (and comp? (not= (:db/valueType kv) :db.type/ref))
@ -86,7 +119,7 @@
:attribute a
:key :db/isComponent}))))
(validate-schema-key a :db/unique (:db/unique kv) #{:db.unique/value :db.unique/identity})
(validate-schema-key a :db/valueType (:db/valueType kv) #{:db.type/ref})
(validate-schema-key a :db/valueType (:db/valueType kv) (set (keys value-type-map)))
(validate-schema-key a :db/cardinality (:db/cardinality kv) #{:db.cardinality/one :db.cardinality/many}))
schema)

70
test/datomish/db_test.cljc
View file

@ -53,20 +53,30 @@
(defn tx [report]
(get-in report [:db-after :current-tx]))
(def test-schema
{:x {:db/unique :db.unique/identity
:db/valueType :db.type/integer}
:y {:db/cardinality :db.cardinality/many
:db/valueType :db.type/integer}
:name {:db/unique :db.unique/identity
:db/valueType :db.type/string}
:aka {:db/cardinality :db.cardinality/many
:db/valueType :db.type/string}})
(deftest-async test-add-one
(with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t))
db (<? (dm/<db-with-sqlite-connection c))
db (<? (dm/<db-with-sqlite-connection c test-schema))
conn (dm/connection-with-db db)
now 0xdeadbeef]
(try
(let [;; TODO: drop now, allow to set :db/txInstant.
report (<? (dm/<transact! conn [[:db/add 0 :x "valuex"]] now))
report (<? (dm/<transact! conn [[:db/add 0 :name "valuex"]] now))
tx (tx report)]
(is (= (<? (<datoms (dm/db conn)))
#{[0 :x "valuex"]}))
#{[0 :name "valuex"]}))
(is (= (<? (<transactions (dm/db conn)))
[[0 :x "valuex" tx 1] ;; TODO: true, not 1.
[[0 :name "valuex" tx 1] ;; TODO: true, not 1.
[tx :db/txInstant now tx 1]])))
(finally
(<? (dm/close-db db)))))))
@ -74,30 +84,28 @@
(deftest-async test-add-two
(with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t))
db (<? (dm/<db-with-sqlite-connection c
{:x {:db/unique :db.unique/identity} ;; TODO: :name and :aka.
:y {:db/cardinality :db.cardinality/many}}))
db (<? (dm/<db-with-sqlite-connection c test-schema))
conn (dm/connection-with-db db)
now 0xdeadbeef]
(try
(let [tx1 (tx (<? (dm/<transact! conn [[:db/add 1 :x "Ivan"]] now)))
tx2 (tx (<? (dm/<transact! conn [[:db/add 1 :x "Petr"]] now)))
tx3 (tx (<? (dm/<transact! conn [[:db/add 1 :y "Tupen"]] now)))
tx4 (tx (<? (dm/<transact! conn [[:db/add 1 :y "Devil"]] 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)))
#{[1 :x "Petr"]
[1 :y "Tupen"]
[1 :y "Devil"]}))
#{[1 :name "Petr"]
[1 :aka "Tupen"]
[1 :aka "Devil"]}))
(is (= (<? (<transactions (dm/db conn)))
[[1 :x "Ivan" tx1 1] ;; TODO: true, not 1.
[[1 :name "Ivan" tx1 1] ;; TODO: true, not 1.
[tx1 :db/txInstant now tx1 1]
[1 :x "Ivan" tx2 0]
[1 :x "Petr" tx2 1]
[1 :name "Ivan" tx2 0]
[1 :name "Petr" tx2 1]
[tx2 :db/txInstant now tx2 1]
[1 :y "Tupen" tx3 1]
[1 :aka "Tupen" tx3 1]
[tx3 :db/txInstant now tx3 1]
[1 :y "Devil" tx4 1]
[1 :aka "Devil" tx4 1]
[tx4 :db/txInstant now tx4 1]])))
(finally
(<? (dm/close-db db)))))))
@ -106,18 +114,18 @@
(deftest-async test-retract
(with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t))
db (<? (dm/<db-with-sqlite-connection c))
db (<? (dm/<db-with-sqlite-connection c test-schema))
conn (dm/connection-with-db db)
now 0xdeadbeef]
(try
(let [txa (tx (<? (dm/<transact! conn [[:db/add 0 :x "valuex"]] now)))
txb (tx (<? (dm/<transact! conn [[:db/retract 0 :x "valuex"]] 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 (= (<? (<transactions db))
[[0 :x "valuex" txa 1] ;; TODO: true, not 1.
[[0 :x 123 txa 1] ;; TODO: true, not 1.
[txa :db/txInstant now txa 1]
[0 :x "valuex" txb 0]
[0 :x 123 txb 0]
[txb :db/txInstant now txb 1]])))
(finally
(<? (dm/close-db db)))))))
@ -125,7 +133,7 @@
(deftest-async test-id-literal-1
(with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t))
db (<? (dm/<db-with-sqlite-connection c))
db (<? (dm/<db-with-sqlite-connection c test-schema))
conn (dm/connection-with-db db)
now -1]
(try
@ -151,19 +159,19 @@
(deftest-async test-add-ident
(with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t))
db (<? (dm/<db-with-sqlite-connection c))
db (<? (dm/<db-with-sqlite-connection c test-schema))
conn (dm/connection-with-db db)
now -1]
(try
(let [report (<? (dm/<transact! conn [[:db/add 44 :db/ident :name]] now))
(let [report (<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/db -1) :db/ident :test/ident]] now))
db-after (:db-after report)
tx (:current-tx db-after)]
(is (= (:name (dm/idents db-after)) 44)))
(is (= (:test/ident (dm/idents db-after)) (get-in report [:tempids (dm/id-literal :db.part/db -1)]))))
;; TODO: This should fail, but doesn't, due to stringification of :name.
;; TODO: This should fail, but doesn't, due to stringification of :test/ident.
;; (is (thrown-with-msg?
;; ExceptionInfo #"Retracting a :db/ident is not yet supported, got "
;; (<? (dm/<transact! conn [[:db/retract 44 :db/ident :name]] now))))
;; (<? (dm/<transact! conn [[:db/retract 44 :db/ident :test/ident]] now))))
;; ;; Renaming looks like retraction and then assertion.
;; (is (thrown-with-msg?
@ -172,7 +180,7 @@
;; (is (thrown-with-msg?
;; ExceptionInfo #"Re-asserting a :db/ident is not yet supported, got"
;; (<? (dm/<transact! conn [[:db/add 55 :db/ident :name]] now))))
;; (<? (dm/<transact! conn [[:db/add 55 :db/ident :test/ident]] now))))
(finally
(<? (dm/close-db db)))))))