Validate value types.

src/datomish/db.cljc

@@ -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.
+            (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.
-                  )
                 (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]
+  [db now report]
-  {:pre [(db? db)]}
+  {: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)
          (<?))))
 

src/datomish/schema.cljc

@@ -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)
 

test/datomish/db_test.cljc

@@ -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
+          db   (<? (dm/<db-with-sqlite-connection c test-schema))
-                                                  {:x {:db/unique :db.unique/identity} ;; TODO: :name and :aka.
-                                                   :y {:db/cardinality :db.cardinality/many}}))
           conn (dm/connection-with-db db)
           now  0xdeadbeef]
       (try
-        (let [tx1 (tx (<? (dm/<transact! conn [[:db/add 1 :x "Ivan"]] now)))
+        (let [tx1 (tx (<? (dm/<transact! conn [[:db/add 1 :name "Ivan"]] now)))
-              tx2 (tx (<? (dm/<transact! conn [[:db/add 1 :x "Petr"]] now)))
+              tx2 (tx (<? (dm/<transact! conn [[:db/add 1 :name "Petr"]] now)))
-              tx3 (tx (<? (dm/<transact! conn [[:db/add 1 :y "Tupen"]] now)))
+              tx3 (tx (<? (dm/<transact! conn [[:db/add 1 :aka "Tupen"]] now)))
-              tx4 (tx (<? (dm/<transact! conn [[:db/add 1 :y "Devil"]] now)))]
+              tx4 (tx (<? (dm/<transact! conn [[:db/add 1 :aka "Devil"]] now)))]
           (is (= (<? (<datoms (dm/db conn)))
-                 #{[1 :x "Petr"]
+                 #{[1 :name "Petr"]
-                   [1 :y "Tupen"]
+                   [1 :aka  "Tupen"]
-                   [1 :y "Devil"]}))
+                   [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 :name "Ivan" tx2 0]
-                  [1 :x "Petr" tx2 1]
+                  [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)))
+        (let [txa (tx (<? (dm/<transact! conn [[:db/add     0 :x 123]] now)))
-              txb (tx (<? (dm/<transact! conn [[:db/retract 0 :x "valuex"]] 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)))))))