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

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

Browse source
This commit is contained in:
Richard Newman 2016-11-30 11:11:43 -08:00
parent 8e16bee201
commit 9cc26616a9
9 changed files with 209 additions and 89 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
package.json
View file

@ -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",

2
project.clj
View file

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

13
src/common/datomish/db.cljc
View file

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

133
src/common/datomish/db_factory.cljc
View file

@ -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)))
(raise "Could not ensure current SQLite schema version."))
(let [db (db/db sqlite-connection bootstrap/idents bootstrap/parts bootstrap/symbolic-schema)
bootstrapped? (<? (db/<bootstrapped? db))]
(when-not bootstrapped?
;; 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)
(<?))))
(let [[previous-version current-version]
(<? (sqlite-schema/<ensure-current-version
sqlite-connection
<bootstrapper!))]
(when-not (= sqlite-schema/current-version current-version)
(raise "Could not ensure current SQLite schema version."))
;; 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 (= idents bootstrap/idents))
(raise "After bootstrapping database, expected new materialized idents and old bootstrapped idents to be identical"
(when-not (= previous-version current-version)
(when (not (submap? bootstrap/idents idents))
(raise "After bootstrapping database, expected new materialized idents to include all old bootstrapped idents"
{:error :bootstrap/bad-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)"
:new idents
:old bootstrap/idents}))
(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)
}))
(when (not (= symbolic-schema bootstrap/symbolic-schema))
(raise "After bootstrapping database, expected new materialized symbolic schema and old bootstrapped symbolic schema to be identical"
:new parts
:old bootstrap/parts}))
(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)))))

4
src/common/datomish/sqlite.cljc
View file

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

52
src/common/datomish/sqlite_schema.cljc
View file

@ -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)))
(s/in-transaction! db)))
[0 (<? (s/get-user-version 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
(raise-str "No migrations yet defined!")
(<? (s/set-user-version db current-version))
(<? (s/get-user-version db))))
(println "Upgrading database from" from-version "to" current-version)
(s/in-transaction!
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

32
src/common/datomish/transact/bootstrap.cljc
View file

@ -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.alter/attribute {:db/valueType :db.type/ref
:db/cardinality :db.cardinality/many}
:db/cardinality :db.cardinality/one}})
(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.schema/version 36 ; Fragment -> version.
:db/doc 35})
(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]] [:db/add :db.part/db :db.install/attribute (get idents ident)]) symbolic-schema) ;; TODO: fail if nil.
(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)]) new-symbolic-schema) ;; TODO: fail if nil.
))

60
test/datomish/upgrade_test.clj Normal file
View file

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

BIN
test/v1.db Normal file
View file

Binary file not shown.