From c06248bf84db94210c046ab2da9b589bcaed83e1 Mon Sep 17 00:00:00 2001 From: max Date: Wed, 15 Jul 2026 21:53:54 +0200 Subject: [PATCH] Port as-of, since, history, and with-dry-run from slateval. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Temporal views become explicit fields on the DB handle (as-of-tx, since-tx, history?), and the per-index filter chains consolidate into `tx-visibility-xform` (plus a reverse variant for rseek, which slateval did not have): upper bound (basis / as-of), optional lower bound (since), and datoms-filter unless history. Temporal views are read-only — guarded in both conn/with and transact-tx-data. `with-dry-run` is a natural fit for the pending-overlay engine: the transaction runs normally but nothing is committed and the overlay stays on :db-after, so reads see the speculative datoms; chained dry-runs accumulate, and a real transact against a speculative value throws. Also ports Datomic's 5-element datom patterns binding the assert/retract flag ([?e :age ?a _ ?added]), which history views need to be useful. Bugfix found while porting (latent in slateval too): a `since` lower bound can orphan a retract by filtering out its add; `datoms-filter`'s pairing logic then emitted the tombstone as a datom and could even swallow an unrelated preceding add. It now never emits non-adds and never drops an add against an unrelated retract. With regression tests. Co-Authored-By: Claude Fable 5 --- src/dbval/conn.clj | 19 ++++ src/dbval/core.clj | 30 +++++ src/dbval/db.clj | 195 ++++++++++++++++++++++++++------ src/dbval/query.clj | 14 ++- test/dbval/test.clj | 1 + test/dbval/test/time_travel.clj | 115 +++++++++++++++++++ 6 files changed, 335 insertions(+), 39 deletions(-) create mode 100644 test/dbval/test/time_travel.clj diff --git a/src/dbval/conn.clj b/src/dbval/conn.clj index accfaac..1894438 100644 --- a/src/dbval/conn.clj +++ b/src/dbval/conn.clj @@ -50,6 +50,9 @@ ([db tx-data] (with db tx-data nil)) ([db tx-data tx-meta] {:pre [(db/db? db)]} + (when (db/temporal-view? db) + (throw (ex-info "Cannot transact against an as-of/since/history database value" + {:error :transact/temporal-view}))) (let [q-max-tx (db/q-max-tx db) max-tx (db/basis-tx db)] ;; Check that the storage hasn't been modified since this db snapshot was created. @@ -69,6 +72,22 @@ {:pre [(db/db? db)]} (:db-after (with db tx-data))) +(defn with-dry-run + "Like `with`, but speculative: the transaction is validated and applied to + the returned :db-after value in memory only — nothing is written to + storage. Reads on :db-after see the new datoms via its pending overlay. + Chaining another dry-run on the returned :db-after keeps the previous + speculative datoms visible; a real transact against a speculative db + value throws." + ([db tx-data] (with-dry-run db tx-data nil)) + ([db tx-data tx-meta] + {:pre [(db/db? db)]} + (if (instance? FilteredDB db) + (throw (ex-info "Filtered DB cannot be modified" {:error :transaction/filtered})) + (db/transact-tx-data (assoc (db/->TxReport db db [] {} tx-meta) + :dbval.db/dry-run true) + tx-data)))) + (defn conn-from-db [db] {:pre [(db/db? db)]} (make-conn db)) diff --git a/src/dbval/core.clj b/src/dbval/core.clj index 577172a..9fdc087 100644 --- a/src/dbval/core.clj +++ b/src/dbval/core.clj @@ -206,6 +206,36 @@ :doc "Returns a schema of a database."} schema db/-schema) +(def ^{:arglists '([db tx-data] [db tx-data tx-meta])} + with-dry-run + "Like [[with]], but speculative: the transaction is validated and applied to the returned :db-after value in memory only — nothing is written to storage. Chaining another dry-run on the returned :db-after keeps the previous speculative datoms visible; a real transact against a speculative db value throws." + conn/with-dry-run) + +(def ^{:arglists '([db t])} + as-of + "Returns the value of the database as of transaction t (a transaction squuid or an instant). As-of views are read-only." + db/as-of) + +(def ^{:arglists '([db])} + as-of-t + "Returns the as-of transaction of a db view created by [[as-of]], or nil." + db/as-of-t) + +(def ^{:arglists '([db t])} + since + "Returns a value of the database containing only datoms asserted after transaction t (exclusive). t is a transaction squuid or an instant. Since views are read-only." + db/since) + +(def ^{:arglists '([db])} + since-t + "Returns the since transaction of a db view created by [[since]], or nil." + db/since-t) + +(def ^{:arglists '([db])} + history + "Returns a value of the database containing all datom versions, including retractions. Datoms report assertion vs retraction via their :added flag; a 5th element in a query pattern binds it (e.g. [?e :age ?a _ ?added]). History views are read-only." + db/history) + (def ^{:arglists '([db]) :doc "Returns the transaction id (the basis) up to which this database value sees the store. diff --git a/src/dbval/db.clj b/src/dbval/db.clj index c67c5fd..4600141 100644 --- a/src/dbval/db.clj +++ b/src/dbval/db.clj @@ -538,18 +538,27 @@ (vreset! previous nil) ;; next step should ignore d2 result) ;; add nothing since datom was retracted in the same transaction. + ;; d2 is a retract unrelated to d1. In a full stream a + ;; retract directly follows its own add (handled above), but + ;; a `since` lower bound can orphan a retract by filtering + ;; out its add — d1 must not be swallowed by it. (not (:added d2)) (do ;; (prn "d2 retract" d1 d2) (vreset! previous d2) - result) + (if (:added d1) + (rf result d1) + result)) :else (do ;; (prn "else" d1 d2) (vreset! previous d2) - (rf result d1)) + ;; d1 can be an orphaned retract (see above) — never emit it + (if (:added d1) + (rf result d1) + result)) )))))))) (defn datoms-filter-reverse @@ -588,6 +597,45 @@ (vswap! buffer conj d)) result'))))))) +(defn tx-visibility-xform + "Composed transducer applying a db value's transaction visibility rules to + an ascending stream of datoms: + + - upper bound: only datoms with `tx <= max-tx` are visible. This is what + makes a db an immutable value (and what `as-of` relies on, since + transaction squuids increase monotonically). + - optional lower bound: when `since-tx` is set, only datoms with + `tx > since-tx` are visible (see `since`). + - `datoms-filter` removes retracted datoms, unless `history?` is set, in + which case all datom versions (including retractions) are returned + (see `history`)." + [max-tx since-tx history?] + (apply comp + (concat + [(filter (fn [datom] + (uuid<= (:tx datom) + max-tx)))] + (when since-tx + [(filter (fn [datom] + (pos? (compare (:tx datom) since-tx))))]) + (when-not history? + [datoms-filter])))) + +(defn tx-visibility-xform-reverse + "Like `tx-visibility-xform`, for a descending stream of datoms (see + `datoms-filter-reverse`)." + [max-tx since-tx history?] + (apply comp + (concat + [(filter (fn [datom] + (uuid<= (:tx datom) + max-tx)))] + (when since-tx + [(filter (fn [datom] + (pos? (compare (:tx datom) since-tx))))]) + (when-not history? + [datoms-filter-reverse])))) + (defn sort-components [order [c0 c1 c2 c3]] (case order @@ -663,7 +711,7 @@ ;; `basis-tx` (and know which store they came from) — content-based value ;; semantics would have to realize a potentially larger-than-memory database. (deftype DB [schema max-tx rschema pull-patterns pull-attrs - store pending] + store pending as-of-tx since-tx history?] IDB @@ -689,10 +737,7 @@ ] (->Eduction (comp (map (bytes-to-datoms-xf db)) - (filter (fn [datom] - (uuid<= (:tx datom) - max-tx))) - datoms-filter + (tx-visibility-xform max-tx since-tx history?) (filter (partial datom= [e a v tx]))) (slice {:db db @@ -721,12 +766,9 @@ components)] (->Eduction (comp (map (bytes-to-datoms-xf db)) - (filter (fn [datom] - (uuid<= (:tx datom) - max-tx))) - datoms-filter - (filter (partial datom= - [e a v tx]))) + (tx-visibility-xform max-tx since-tx history?) + (filter (partial datom= + [e a v tx]))) (slice {:db db :begin begin :end end})))) @@ -751,10 +793,7 @@ [_begin end] (tuple-range (name index))] (->Eduction (comp (map (bytes-to-datoms-xf db)) - (filter (fn [datom] - (uuid<= (:tx datom) - max-tx))) - datoms-filter) + (tx-visibility-xform max-tx since-tx history?)) (slice {:db db :begin begin :end end})))) @@ -780,10 +819,7 @@ [begin _end] (tuple-range (name index))] (->Eduction (comp (map (bytes-to-datoms-xf db)) - (filter (fn [datom] - (uuid<= (:tx datom) - max-tx))) - datoms-filter-reverse) + (tx-visibility-xform-reverse max-tx since-tx history?)) (slice {:db db :begin begin :end end @@ -806,10 +842,7 @@ [(serialize-value db attr end*)]))] (->Eduction (comp (map (bytes-to-datoms-xf db)) - (filter (fn [datom] - (uuid<= (:tx datom) - max-tx))) - datoms-filter) + (tx-visibility-xform max-tx since-tx history?)) (slice {:db db :begin begin :end end})))) @@ -896,14 +929,83 @@ [^DB db max-tx] (DB. (.-schema db) max-tx (.-rschema db) (.-pull-patterns db) (.-pull-attrs db) - (.-store db) (.-pending db))) + (.-store db) (.-pending db) + (.-as-of-tx db) (.-since-tx db) (.-history? db))) + +(declare with-pending) + +(defn- coerce-tx + "Coerces `t` — a transaction squuid or an instant — to a transaction id." + [t] + (cond + (uuid? t) t + (inst? t) (squuid/time->uuid t) + :else (util/raise "Expected a transaction UUID or an instant, got " t + {:error :time-point/syntax, :t t}))) + +(defn ^DB as-of + "Returns the value of the database as of transaction t (a transaction + squuid or an instant). Since transaction squuids increase strictly + monotonically, the as-of view is the same database value with its basis + bounded to t — every index read filters datoms accordingly (see + `tx-visibility-xform`)." + [^DB db t] + {:pre [(instance? DB db)]} + (let [tx (coerce-tx t)] + (DB. (.-schema db) tx (.-rschema db) + (.-pull-patterns db) (.-pull-attrs db) + (.-store db) (.-pending db) + tx (.-since-tx db) (.-history? db)))) + +(defn as-of-t + "Returns the as-of transaction of a database view created by `as-of`, or + nil if db is not an as-of view." + [db] + (.-as-of-tx (unfiltered-db db))) + +(defn ^DB since + "Returns a value of the database containing only datoms asserted after + transaction t (exclusive). t is a transaction squuid or an instant." + [^DB db t] + {:pre [(instance? DB db)]} + (DB. (.-schema db) (.-max-tx db) (.-rschema db) + (.-pull-patterns db) (.-pull-attrs db) + (.-store db) (.-pending db) + (.-as-of-tx db) (coerce-tx t) (.-history? db))) + +(defn since-t + "Returns the since transaction of a database view created by `since`, or + nil if db is not a since view." + [db] + (.-since-tx (unfiltered-db db))) + +(defn ^DB history + "Returns a value of the database containing all datom versions, including + retractions (`datoms-filter` is skipped, see `tx-visibility-xform`). + Datoms report assertion vs retraction via their `:added` flag." + [^DB db] + {:pre [(instance? DB db)]} + (DB. (.-schema db) (.-max-tx db) (.-rschema db) + (.-pull-patterns db) (.-pull-attrs db) + (.-store db) (.-pending db) + (.-as-of-tx db) (.-since-tx db) true)) + +(defn temporal-view? + "True if db is an as-of, since, or history view. Temporal views are + read-only: they cannot be transacted against." + [db] + (let [^DB db (unfiltered-db db)] + (boolean (or (.-as-of-tx db) + (.-since-tx db) + (.-history? db))))) (defn- ^DB with-pending "Copy of `db` with a different pending overlay (nil to clear)." [^DB db pending] (DB. (.-schema db) (.-max-tx db) (.-rschema db) (.-pull-patterns db) (.-pull-attrs db) - (.-store db) pending)) + (.-store db) pending + (.-as-of-tx db) (.-since-tx db) (.-history? db))) ;; ---------------------------------------------------------------------------- @@ -1043,7 +1145,7 @@ (lru/cache 100) (lru/cache 100) store - nil)] + nil nil nil nil)] (with-max-tx db (q-max-tx db)))) (defrecord TxReport [db-before db-after tx-data tempids tx-meta]) @@ -1086,7 +1188,10 @@ (lru/cache 100) (lru/cache 100) (.-store db) - (.-pending db))) + (.-pending db) + (.-as-of-tx db) + (.-since-tx db) + (.-history? db))) (do @@ -2170,12 +2275,25 @@ (sequential? es)) (util/raise "Bad transaction data " es ", expected sequential collection" {:error :transact/syntax, :tx-data es})) - (let [tx-id (squuid/generate-squuid) + (when (temporal-view? (:db-before report)) + (util/raise "Cannot transact against an as-of/since/history database value" + {:error :transact/temporal-view})) + (let [dry-run? (::dry-run report) + tx-id (squuid/generate-squuid) ;; The pending overlay collects this transaction's keys; reads during ;; the transaction merge it over the store (see `slice`), so nothing ;; touches the store until the final atomic commit — an exception ;; while transacting simply discards the overlay. pending (java.util.TreeSet. ^java.util.Comparator store/byte-array-comparator) + ;; Carry over speculative datoms when chaining a dry-run on a dry-run + ;; db-after, so they stay visible in the new speculative view. A real + ;; transact must not inherit them: they were never committed and would + ;; go missing from storage. + _ (when-some [^java.util.NavigableSet prev (db-pending (:db-after report))] + (if dry-run? + (.addAll ^java.util.TreeSet pending prev) + (util/raise "Cannot transact against a speculative (dry-run) database value" + {:error :transact/speculative-view}))) report' (-> report (assoc ::tx-id tx-id) ;; Set max-tx to current tx-id so datoms added during this @@ -2186,8 +2304,15 @@ ;; Pre-populate tempids with the tempid -> UUID mapping report'' (update report' :tempids merge id-map) result (transact-tx-data-impl report'' tx-data)] - (store/commit! (db-store (:db-after result)) (seq pending)) - (-> result - (update :db-after with-pending nil) - ;; Add :tx field with the transaction UUID - (assoc :tx tx-id)))) + (if dry-run? + ;; Speculative transaction: nothing is written to the store. Keep the + ;; pending overlay on db-after so reads see the new datoms via `slice`. + (-> result + (dissoc ::dry-run) + (assoc :tx tx-id)) + (do + (store/commit! (db-store (:db-after result)) (seq pending)) + (-> result + (update :db-after with-pending nil) + ;; Add :tx field with the transaction UUID + (assoc :tx tx-id)))))) diff --git a/src/dbval/query.clj b/src/dbval/query.clj index d6abdbc..facd5a6 100644 --- a/src/dbval/query.clj +++ b/src/dbval/query.clj @@ -378,7 +378,7 @@ (defn resolve-pattern-lookup-refs [source pattern] (if (satisfies? db/IDB source) - (let [[e a v tx] pattern + (let [[e a v tx added] pattern e' (if (or (lookup-ref? e) (attr? e)) (db/entid-strict source e) e) @@ -388,7 +388,7 @@ tx' (if (lookup-ref? tx) (db/entid-strict source tx) tx)] - (subvec [e' a v' tx'] 0 (count pattern))) + (subvec [e' a v' tx' added] 0 (count pattern))) pattern)) (defn lookup-pattern-db [context db pattern] @@ -397,8 +397,14 @@ (substitute-constants context) (resolve-pattern-lookup-refs db) (mapv #(if (or (= % '_) (free-var? %)) nil %))) - datoms (db/-search db search-pattern) - attr->prop (->> (map vector pattern ["e" "a" "v" "tx"]) + ;; like Datomic, a 5th pattern element binds the assert/retract flag + ;; (mostly useful on `history` dbs, where retract datoms are visible) + added (nth search-pattern 4 nil) + datoms (db/-search db (subvec search-pattern 0 (min 4 (count search-pattern)))) + datoms (if (some? added) + (filter #(= (:added %) (boolean added)) datoms) + datoms) + attr->prop (->> (map vector pattern ["e" "a" "v" "tx" "added"]) (filter (fn [[s _]] (free-var? s))) (into {}))] (Relation. attr->prop datoms))) diff --git a/test/dbval/test.clj b/test/dbval/test.clj index 5fa33dc..c5c843c 100644 --- a/test/dbval/test.clj +++ b/test/dbval/test.clj @@ -23,6 +23,7 @@ dbval.test.pull-api dbval.test.pull-parser dbval.test.store + dbval.test.time-travel dbval.test.query dbval.test.query-aggregates dbval.test.query-find-specs diff --git a/test/dbval/test/time_travel.clj b/test/dbval/test/time_travel.clj new file mode 100644 index 0000000..26e681f --- /dev/null +++ b/test/dbval/test/time_travel.clj @@ -0,0 +1,115 @@ +(ns dbval.test.time-travel + (:require + [clojure.test :as t :refer [is deftest testing]] + [dbval.core :as d] + [com.yetanalytics.squuid :as squuid])) + +(defn- setup + "Returns {:conn .. :tx1 .. :db ..} with two transactions: + tx1 asserts Alice/30, tx2 updates Alice to 31 and adds Bob/25." + [] + (let [conn (d/create-conn {:name {:db/unique :db.unique/identity}}) + r1 (d/transact! conn [{:name "Alice" :age 30}]) + ;; make sure tx2's squuid lands in a later millisecond than tx1, + ;; so `as-of` by instant (tx1 time + 1ms) excludes it deterministically + _ (Thread/sleep 5) + _ (d/transact! conn [{:name "Alice" :age 31} + {:name "Bob" :age 25}])] + {:conn conn + :tx1 (:tx r1) + :db (d/db conn)})) + +(deftest test-as-of + (let [{:keys [tx1 db]} (setup)] + (testing "current value sees the update and Bob" + (is (= #{["Alice" 31] ["Bob" 25]} + (d/q '[:find ?n ?a :where [?e :name ?n] [?e :age ?a]] db)))) + (testing "as-of a tx squuid sees the past" + (let [past (d/as-of db tx1)] + (is (= #{["Alice" 30]} + (d/q '[:find ?n ?a :where [?e :name ?n] [?e :age ?a]] past))) + (is (= tx1 (d/as-of-t past))))) + (testing "as-of an instant" + (let [inst (.plusMillis ^java.time.Instant (squuid/uuid->time tx1) 1) + past (d/as-of db inst)] + (is (= #{["Alice" 30]} + (d/q '[:find ?n ?a :where [?e :name ?n] [?e :age ?a]] past))))) + (testing "as-of view is read-only" + (is (thrown-with-msg? Exception #"Cannot transact" + (d/with (d/as-of db tx1) [{:name "Carol"}])))))) + +(deftest test-since + (let [{:keys [tx1 db]} (setup)] + (testing "since only sees datoms asserted after t" + (is (= #{["Bob"]} + (d/q '[:find ?n :where [?e :name ?n]] (d/since db tx1)))) + (is (= tx1 (d/since-t (d/since db tx1))))))) + +(deftest test-since-with-retractions + ;; regression: a `since` lower bound can orphan a retract by filtering out + ;; its add — `datoms-filter` must neither emit the tombstone nor let it + ;; swallow an unrelated add + (let [conn (d/create-conn {:name {:db/unique :db.unique/identity} + :aka {:db/cardinality :db.cardinality/many}}) + r1 (d/transact! conn [{:name "Alice" :age 30}]) + _ (d/transact! conn [{:name "Alice" :age 31}])] + (testing "a pre-window datom retracted inside the window stays invisible" + ;; the age-30 add is before the window, its retract (by the upsert to + ;; 31) is inside it — the orphaned tombstone must not surface as [30] + (is (= #{[31]} + (d/q '[:find ?a :where [_ :age ?a]] (d/since (d/db conn) (:tx r1)))))) + + (testing "an orphaned retract does not swallow an unrelated add" + (let [conn (d/create-conn {:name {:db/unique :db.unique/identity} + :aka {:db/cardinality :db.cardinality/many}}) + r1 (d/transact! conn [{:name "Alice" :aka ["b"]}]) + alice (:e (first (d/datoms (d/db conn) :avet :name "Alice"))) + _ (d/transact! conn [[:db/add alice :aka "a"]]) + _ (d/transact! conn [[:db/retract alice :aka "b"]])] + ;; in the since window the stream for :aka is [add "a", retract "b"]: + ;; the add of "b" is filtered out, so the retract is orphaned and + ;; directly follows the unrelated add of "a" + (is (= #{["a"]} + (d/q '[:find ?aka :where [_ :aka ?aka]] + (d/since (d/db conn) (:tx r1))))))))) + +(deftest test-history + (let [{:keys [db]} (setup) + history (d/history db)] + (testing "history exposes retracted datom versions" + (is (= #{[30] [31] [25]} + (d/q '[:find ?a :where [_ :age ?a]] history)))) + (testing "a 5th pattern element binds the assert/retract flag like Datomic" + (is (= #{[30 true] [30 false] [31 true] [25 true]} + (d/q '[:find ?a ?added :where [_ :age ?a _ ?added]] history))) + (is (= #{[30]} + (d/q '[:find ?a :where [_ :age ?a _ false]] history))) + (is (= #{[30] [31] [25]} + (d/q '[:find ?a :where [_ :age ?a _ true]] history)))) + (testing "history view is read-only" + (is (thrown-with-msg? Exception #"Cannot transact" + (d/with history [{:name "Carol"}])))))) + +(deftest test-with-dry-run + (let [{:keys [conn db]} (setup)] + (testing "speculative datoms are visible on db-after only" + (let [report (d/with-dry-run db [{:name "Carol" :age 40}])] + (is (= #{["Alice"] ["Bob"] ["Carol"]} + (d/q '[:find ?n :where [?e :name ?n]] (:db-after report)))) + (is (contains? (:tempids report) :db/current-tx)) + (is (= #{["Alice"] ["Bob"]} + (d/q '[:find ?n :where [?e :name ?n]] (d/db conn)))))) + (testing "chained dry-runs accumulate speculative datoms" + (let [r1 (d/with-dry-run db [{:name "Carol"}]) + r2 (d/with-dry-run (:db-after r1) [{:name "Dave"}])] + (is (= #{["Alice"] ["Bob"] ["Carol"] ["Dave"]} + (d/q '[:find ?n :where [?e :name ?n]] (:db-after r2)))))) + (testing "a real transact against a speculative value throws" + (let [speculative (:db-after (d/with-dry-run db [{:name "Carol"}]))] + (is (thrown-with-msg? Exception #"speculative" + (d/with speculative [{:name "Eve"}]))))) + (testing "the connection still accepts real transactions afterwards" + (d/with-dry-run (d/db conn) [{:name "Frank"}]) + (d/transact! conn [{:name "Grace"}]) + (is (= #{["Alice"] ["Bob"] ["Grace"]} + (d/q '[:find ?n :where [?e :name ?n]] (d/db conn)))))))