Implement unified setup/bootstrapping, bootstrapping new databases in a single transaction. Fixes #125. 0.3.7.

package.json

@@ -4,7 +4,7 @@
   "engines": {
     "node": "6.x.x"
   },
-  "version": "0.3.5",
+  "version": "0.3.7",
   "description": "A persistent, embedded knowledge base inspired by Datomic and DataScript.",
   "dependencies": {
     "promise-sqlite": "1.5.0",

project.clj

@@ -1,4 +1,4 @@
-(defproject mozilla/datomish "0.3.5"
+(defproject mozilla/datomish "0.3.7"
   :description "A persistent, embedded knowledge base inspired by Datomic and DataScript."
   :url "https://github.com/mozilla/datomish"
   :license {:name "Apache License, Version 2.0"

src/common/datomish/db.cljc

@@ -124,9 +124,6 @@
 
     Returns a pair-chan resolving to the same pair as the pair-chan returned by `chan-fn`.")
 
-  (<bootstrapped? [db]
-    "Return true if this database has no transactions yet committed.")
-
   (<avs
     [db avs]
     "Search for many matching datoms using the AVET index.
@@ -640,16 +637,6 @@
     (s/in-transaction!
       (:sqlite-connection db) chan-fn))
 
-  (<bootstrapped? [db]
-    (go-pair
-      (->
-        (:sqlite-connection db)
-        (s/all-rows ["SELECT EXISTS(SELECT 1 FROM transactions LIMIT 1) AS bootstrapped"])
-        (<?)
-        (first)
-        (:bootstrapped)
-        (not= 0))))
-
   (<avs
     [db avs]
     {:pre [(sequential? avs)]}

src/common/datomish/db_factory.cljc

@@ -45,6 +45,57 @@
     (let [rows (<? (s/all-rows sqlite-connection ["SELECT part, start, idx FROM parts"]))]
       (into {} (map (fn [row] [(sqlite-schema/<-SQLite :db.type/keyword (:part row)) (select-keys row [:start :idx])])) rows))))
 
+(defn <bootstrapper! [sqlite-connection from-version]
+  (let [exec (partial s/execute! sqlite-connection)
+        part->vector (fn [[part {:keys [start idx]}]]
+                       [(sqlite-schema/->SQLite part) start idx])
+        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))]
+    (case from-version
+      0
+      (go-pair
+        ;; TODO: think more carefully about allocating new parts and bitmasking part ranges.
+        ;; TODO: install these using bootstrap assertions.  It's tricky because the part ranges are implicit.
+        ;; TODO: chunk into 999/3 sections, for safety.
+        (<? (exec
+              (cons (str "INSERT INTO parts VALUES "
+                         (apply str (interpose ", " (repeat (count bootstrap/parts) "(?, ?, ?)"))))
+                    (mapcat part->vector bootstrap/parts))))
+
+        ;; We use <with-internal 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.
+        ;;
+        ;; Note that we use `bootstrap/parts` here to initialize our DB… and that means we
+        ;; have a fixed starting tx.
+        (<? (transact/<with-internal
+              (db/db sqlite-connection bootstrap/idents bootstrap/parts bootstrap/symbolic-schema)
+              (bootstrap/tx-data bootstrap/idents bootstrap/symbolic-schema)
+              fail-alter-attr)))
+
+      1
+      ;; We just need to add the new stuff.
+      (go-pair
+        (<?
+          (transact/<with-internal
+            ;; We read the parts out of the DB so we don't accidentally reuse a tx ID.
+            ;; We use the v1 symbolic schema so that the rest of the system doesn't
+            ;; get confused and think we're implicitly altering an existing schema.
+            (db/db sqlite-connection
+                   bootstrap/idents
+                   (<? (<parts sqlite-connection))
+                   bootstrap/v1-symbolic-schema)
+            (bootstrap/tx-data bootstrap/v2-idents bootstrap/v2-symbolic-schema)
+            fail-alter-attr))))))
+
 (defn <symbolic-schema [sqlite-connection idents]
   "Read the schema map materialized view from the given SQLite store.
   Returns a map (keyword ident) -> (map (keyword attribute -> keyword value)), like
@@ -81,63 +132,53 @@
     (<? (s/all-rows sqlite-connection ["PRAGMA journal_size_limit=3145728"]))
     (<? (s/execute! sqlite-connection ["PRAGMA foreign_keys=ON"]))))
 
+(defn- submap?
+  "Returns true if every key in m1 is present in m2 with the same value."
+  [m1 m2]
+  (every? (fn [[k v]]
+            (= v (get m2 k)))
+          m1))
+
 (defn <db-with-sqlite-connection
   [sqlite-connection]
   (go-pair
     (<? (<initialize-connection sqlite-connection))
 
-    (when-not (= sqlite-schema/current-version (<? (sqlite-schema/<ensure-current-version sqlite-connection)))
+    (let [[previous-version current-version]
-      (raise "Could not ensure current SQLite schema version."))
+          (<? (sqlite-schema/<ensure-current-version
-
+                sqlite-connection
-    (let [db            (db/db sqlite-connection bootstrap/idents bootstrap/parts bootstrap/symbolic-schema)
+                <bootstrapper!))]
-          bootstrapped? (<? (db/<bootstrapped? db))]
+      (when-not (= sqlite-schema/current-version current-version)
-      (when-not bootstrapped?
+        (raise "Could not ensure current SQLite schema version."))
-        ;; We need to bootstrap the DB.
-        (let [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))]
-          (let [exec (partial s/execute! (:sqlite-connection db))
-                part->vector (fn [[part {:keys [start idx]}]]
-                               [(sqlite-schema/->SQLite part) start idx])]
-            ;; TODO: allow inserting new parts.
-            ;; TODO: think more carefully about allocating new parts and bitmasking part ranges.
-            ;; TODO: install these using bootstrap assertions.  It's tricky because the part ranges are implicit.
-            ;; TODO: chunk into 999/3 sections, for safety.
-            (<? (exec
-                  (cons (str "INSERT INTO parts VALUES "
-                             (apply str (interpose ", " (repeat (count bootstrap/parts) "(?, ?, ?)"))))
-                        (mapcat part->vector bootstrap/parts)))))
-
-          (-> db
-              ;; We use <with-internal 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.
-              (transact/<with-internal (bootstrap/tx-data) fail-alter-attr)
-              (<?))))
 
       ;; We just bootstrapped, or we are returning to an already bootstrapped DB.
       (let [idents          (<? (<idents sqlite-connection))
             parts           (<? (<parts sqlite-connection))
             symbolic-schema (<? (<symbolic-schema sqlite-connection idents))]
-        (when-not bootstrapped?
+        (when-not (= previous-version current-version)
-          (when (not (= idents bootstrap/idents))
+          (when (not (submap? bootstrap/idents idents))
-            (raise "After bootstrapping database, expected new materialized idents and old bootstrapped idents to be identical"
+            (raise "After bootstrapping database, expected new materialized idents to include all old bootstrapped idents"
                    {:error :bootstrap/bad-idents,
-                    :new   idents :old bootstrap/idents
+                    :new   idents
-                    }))
+                    :old   bootstrap/idents}))
-          (when (not (= (dissoc parts :db.part/tx) (dissoc bootstrap/parts :db.part/tx))) ;; TODO: work around tx allocation.
+
-            (raise "After bootstrapping database, expected new materialized parts and old bootstrapped parts to be identical (outside of db.part/tx)"
+          (when (not (every? (fn [[k {:keys [start idx]}]]
+                               (let [now (get parts k)]
+                                 (and now
+                                      (= start (:start now))
+                                      (<= idx (:idx now)))))
+                             bootstrap/parts))
+            (raise "After bootstrapping database, expected new materialized parts and old bootstrapped parts to be congruent."
                    {:error :bootstrap/bad-parts,
-                    :new   (dissoc parts :db.part/tx) :old (dissoc bootstrap/parts :db.part/tx)
+                    :new   parts
-                    }))
+                    :old   bootstrap/parts}))
-          (when (not (= symbolic-schema bootstrap/symbolic-schema))
+
-            (raise "After bootstrapping database, expected new materialized symbolic schema and old bootstrapped symbolic schema to be identical"
+          (when (not (submap? bootstrap/symbolic-schema symbolic-schema))
+            (raise "After bootstrapping database, expected new materialized symbolic schema to include bootstrapped symbolic schema"
                    {:error :bootstrap/bad-symbolic-schema,
-                    :new   symbolic-schema :old bootstrap/symbolic-schema
+                    :new   symbolic-schema
-                    })))
+                    :old   bootstrap/symbolic-schema})))
+
+        ;; Finally, return a usable DB instance with the metadata that we
+        ;; read from the SQLite database.
         (db/db sqlite-connection idents parts symbolic-schema)))))

src/common/datomish/sqlite.cljc

@@ -29,6 +29,8 @@
 ;; but not automatically safe for use.
 (def sql-quoting-style :ansi)
 
+(def log-sql? false)
+
 (defn format [args]
   (honeysql.core/format args :quoting sql-quoting-style))
 
@@ -56,6 +58,8 @@
 
 (defn execute!
   [db [sql & bindings]]
+  (when log-sql?
+    (println "Running SQL:" sql (pr-str bindings)))
   (-execute! db sql bindings))
 
 (defn each-row

src/common/datomish/sqlite_schema.cljc

@@ -21,7 +21,13 @@
    #?@(:cljs [[datomish.pair-chan]
               [cljs.core.async :as a :refer [<! >!]]])))
 
-(def current-version 1)
+;; Version history:
+;; 1: initial schema.
+;; 2: added :db.schema/version and /attribute in bootstrap; assigned
+;;    idents 36 and 37, so we bump the part range here; tie bootstrapping
+;;    to the SQLite user_version.
+
+(def current-version 2)
 
 (def v1-statements
   ["CREATE TABLE datoms (e INTEGER NOT NULL, a SMALLINT NOT NULL, v BLOB NOT NULL, tx INTEGER NOT NULL,
@@ -103,6 +109,8 @@
    "CREATE TABLE parts (part TEXT NOT NULL PRIMARY KEY, start INTEGER NOT NULL, idx INTEGER NOT NULL)"
    ])
 
+(def v2-statements v1-statements)
+
 (defn create-temp-tx-lookup-statement [table-name]
   ;; n.b., v0/value_type_tag0 can be NULL, in which case we look up v from datoms;
   ;; and the datom columns are NULL into the LEFT JOIN fills them in.
@@ -133,40 +141,54 @@
         " (e0, a0, v0, added0, value_type_tag0) WHERE sv IS NOT NULL")])
 
 (defn <create-current-version
-  [db]
+  [db bootstrapper]
-  (->>
+  (println "Creating database at" current-version)
+  (s/in-transaction!
+    db
     #(go-pair
-       (doseq [statement v1-statements]
+       (doseq [statement v2-statements]
          (try
            (<? (s/execute! db [statement]))
            (catch #?(:clj Throwable :cljs js/Error) e
              (throw (ex-info "Failed to execute statement" {:statement statement} e)))))
+       (<? (bootstrapper db 0))
        (<? (s/set-user-version db current-version))
-       (<? (s/get-user-version db)))
+       [0 (<? (s/get-user-version db))])))
-    (s/in-transaction! db)))
 
 (defn <update-from-version
-  [db from-version]
+  [db from-version bootstrapper]
   {:pre [(> from-version 0)]} ;; Or we'd create-current-version instead.
   {:pre [(< from-version current-version)]} ;; Or we wouldn't need to update-from-version.
-  (go-pair
+  (println "Upgrading database from" from-version "to" current-version)
-    (raise-str "No migrations yet defined!")
+  (s/in-transaction!
-    (<? (s/set-user-version db current-version))
+    db
-    (<? (s/get-user-version db))))
+    #(go-pair
+       ;; We must only be migrating from v1 to v2.
+       (let [statement "UPDATE parts SET idx = idx + 2 WHERE part = ?"]
+         (try
+           (<? (s/execute!
+                 db
+                 [statement :db.part/db]))
+           (catch #?(:clj Throwable :cljs js/Error) e
+             (throw (ex-info "Failed to execute statement" {:statement statement} e)))))
+       (<? (bootstrapper db from-version))
+       (<? (s/set-user-version db current-version))
+       [from-version (<? (s/get-user-version db))])))
 
 (defn <ensure-current-version
-  [db]
+  "Returns a pair: [previous-version current-version]."
+  [db bootstrapper]
   (go-pair
     (let [v (<? (s/get-user-version db))]
       (cond
         (= v current-version)
-        v
+        [v v]
 
         (= v 0)
-        (<? (<create-current-version db))
+        (<? (<create-current-version db bootstrapper))
 
         (< v current-version)
-        (<? (<update-from-version db v))))))
+        (<? (<update-from-version db v bootstrapper))))))
 
 ;; This is close to the SQLite schema since it may impact the value tag bit.
 (defprotocol IEncodeSQLite

src/common/datomish/transact/bootstrap.cljc

@@ -10,7 +10,7 @@
 
 (ns datomish.transact.bootstrap)
 
-(def symbolic-schema
+(def v1-symbolic-schema
   {:db/ident             {:db/valueType   :db.type/keyword
                           :db/cardinality :db.cardinality/one
                           :db/unique      :db.unique/identity}
@@ -41,10 +41,11 @@
    :db/fulltext          {:db/valueType   :db.type/boolean
                           :db/cardinality :db.cardinality/one}
    :db/noHistory         {:db/valueType   :db.type/boolean
-                          :db/cardinality :db.cardinality/one}
+                          :db/cardinality :db.cardinality/one}})
-   :db.alter/attribute   {:db/valueType   :db.type/ref
-                          :db/cardinality :db.cardinality/many}
 
+(def v2-symbolic-schema
+  {:db.alter/attribute   {:db/valueType   :db.type/ref
+                          :db/cardinality :db.cardinality/many}
    :db.schema/version    {:db/valueType   :db.type/long
                           :db/cardinality :db.cardinality/one}
 
@@ -52,10 +53,11 @@
    ;; schema fragment.
    :db.schema/attribute  {:db/valueType   :db.type/ref
                           :db/unique      :db.unique/value
-                          :db/cardinality :db.cardinality/many}
+                          :db/cardinality :db.cardinality/many}})
-   })
 
-(def idents
+(def symbolic-schema (merge v1-symbolic-schema v2-symbolic-schema))
+
+(def v1-idents
   {:db/ident             1
    :db.part/db           2
    :db/txInstant         3
@@ -90,21 +92,25 @@
    :db.cardinality/many  32
    :db.unique/value      33
    :db.unique/identity   34
-   :db/doc               35
+   :db/doc               35})
-   :db.schema/version    36    ; Fragment -> version.
+
+(def v2-idents
+  {:db.schema/version    36    ; Fragment -> version.
    :db.schema/attribute  37    ; Fragment -> attribute.
    })
 
+(def idents (merge v1-idents v2-idents))
+
 (def parts
   {:db.part/db   {:start 0 :idx (inc (apply max (vals idents)))}
    :db.part/user {:start 0x10000 :idx 0x10000}
    :db.part/tx   {:start 0x10000000 :idx 0x10000000}
    })
 
-(defn tx-data []
+(defn tx-data [new-idents new-symbolic-schema]
   (concat
-    (map (fn [[ident entid]] [:db/add entid :db/ident ident]) idents)
+    (map (fn [[ident entid]] [:db/add entid :db/ident ident]) new-idents)
     ;; TODO: install partitions as well, like (map (fn [[ident entid]] [:db/add :db.part/db :db.install/partition ident])).
-    (map (fn [[ident attrs]] (assoc attrs :db/id ident)) symbolic-schema)
+    (map (fn [[ident attrs]] (assoc attrs :db/id ident)) new-symbolic-schema)
-    (map (fn [[ident attrs]] [:db/add :db.part/db :db.install/attribute (get idents ident)]) symbolic-schema) ;; TODO: fail if nil.
+    (map (fn [[ident attrs]] [:db/add :db.part/db :db.install/attribute (get idents ident)]) new-symbolic-schema) ;; TODO: fail if nil.
     ))

test/datomish/upgrade_test.clj

@@ -0,0 +1,60 @@
+;; Copyright 2016 Mozilla
+;;
+;; Licensed under the Apache License, Version 2.0 (the "License"); you may not use
+;; this file except in compliance with the License. You may obtain a copy of the
+;; License at http://www.apache.org/licenses/LICENSE-2.0
+;; Unless required by applicable law or agreed to in writing, software distributed
+;; under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR
+;; CONDITIONS OF ANY KIND, either express or implied. See the License for the
+;; specific language governing permissions and limitations under the License.
+
+(ns datomish.upgrade-test
+  (:require
+     [clojure.java.io :refer [copy]]
+     [datomish.jdbc-sqlite :as jdbc]
+     [datomish.sqlite :as s]
+     [datomish.api :as d]
+     [datomish.test-macros :refer [deftest-async]]
+     [datomish.pair-chan :refer [go-pair <?]]
+     [clojure.test :as t :refer [is are deftest testing]]))
+
+(deftest-async test-upgrade-v1-connect
+  ;; Copy our test DB to a temporary directory.
+  ;; Open it with Datomish. Make sure nothing untoward happened.
+  (let [out (java.io.File/createTempFile "someprefixstringv1" "db")]
+    (copy (java.io.File. "test/v1.db") out)
+    (let [path (.getAbsolutePath out)
+          conn (<? (d/<connect path))]
+
+      (is (= (d/entid (d/db conn) :db.schema/version) 36))
+      (d/<close conn))))
+
+(deftest-async test-upgrade-v1
+  ;; Copy our test DB to a temporary directory.
+  ;;
+  ;; Open it with SQLite. Verify that v2 features are not present, and the
+  ;; user_version is 1.
+  ;;
+  ;; Open it with Datomish. Verify that bootstrapped v2 features are present,
+  ;; and the user_version is 2.
+  (let [out (java.io.File/createTempFile "someprefixstringv1" "db")]
+    (copy (java.io.File. "test/v1.db") out)
+    (let [path (.getAbsolutePath out)
+          sqlite (<? (jdbc/open path))]
+
+      (is (= (<? (s/get-user-version sqlite))
+             1))
+      (is (= [{:idx 36}]
+             (<? (s/all-rows sqlite ["SELECT idx FROM parts WHERE part = ':db.part/db'"]))))
+      (is (empty? (<? (s/all-rows sqlite ["SELECT * FROM idents WHERE ident = ':db.schema/version'"]))))
+
+      ;; This will automatically upgrade.
+      (let [db (<? (datomish.db-factory/<db-with-sqlite-connection sqlite))]
+        (is (= 2 (<? (s/get-user-version sqlite))))
+        (is (= [{:idx 38}]
+               (<? (s/all-rows sqlite ["SELECT idx FROM parts WHERE part = ':db.part/db'"]))))
+        (is (= [{:entid 36}]
+               (<? (s/all-rows sqlite ["SELECT entid FROM idents WHERE ident = ':db.schema/version'"]))))
+        (is (= (d/entid db :db.schema/version) 36))
+        (s/close sqlite)))))
+