From cd8becbc345e9528fe9cc2245771a0d3b843e70d Mon Sep 17 00:00:00 2001 From: max Date: Thu, 16 Jul 2026 08:51:16 +0200 Subject: [PATCH 1/2] Fix pull attribute ordering --- src/dbval/db.clj | 20 ++++++++++++++++---- src/dbval/pull_api.clj | 8 ++++---- src/dbval/pull_parser.clj | 8 +++----- test/dbval/test/pull_api.clj | 27 +++++++++++++++++++++++++++ 4 files changed, 50 insertions(+), 13 deletions(-) diff --git a/src/dbval/db.clj b/src/dbval/db.clj index 46001415..9c5ae67d 100644 --- a/src/dbval/db.clj +++ b/src/dbval/db.clj @@ -368,19 +368,31 @@ :else v)) +(defn attr-sort-key + "Returns the serialized key used for attribute components in indexes." + [attr] + (when attr + (pr-str attr))) + +(defn attr-compare + "Compares attributes in the same order as dbval indexes store them." + [a b] + (compare (attr-sort-key a) + (attr-sort-key b))) + (defn tuple-list [db order datom] (try (let [[e a v t added] datom] (case (keyword order) :eavt - (list (name order) e (when a (pr-str a)) (serialize-value db a v) t added) + (list (name order) e (attr-sort-key a) (serialize-value db a v) t added) :aevt - (list (name order) (when a (pr-str a)) e (serialize-value db a v) t added) + (list (name order) (attr-sort-key a) e (serialize-value db a v) t added) :avet - (list (name order) (when a (pr-str a)) (serialize-value db a v) e t added) + (list (name order) (attr-sort-key a) (serialize-value db a v) e t added) :teav - (list (name order) t e (when a (pr-str a)) (serialize-value db a v) added) + (list (name order) t e (attr-sort-key a) (serialize-value db a v) added) )) (catch Exception e (throw (ex-info "tuple-list failed" diff --git a/src/dbval/pull_api.clj b/src/dbval/pull_api.clj index 79a1e8b4..4439db90 100644 --- a/src/dbval/pull_api.clj +++ b/src/dbval/pull_api.clj @@ -139,7 +139,7 @@ :let [^Datom datom (first-seq datoms) cmp (when (and datom attr) - (compare (.-name attr) (.-a datom))) + (db/attr-compare (.-name attr) (.-a datom))) attr-ahead? (or (nil? attr) (and cmp (pos? cmp))) datom-ahead? (or (nil? datom) (and cmp (neg? cmp)))] @@ -287,8 +287,8 @@ (take-while (fn [datom] (and (= (:e datom) id) - (<= (compare (:a datom) - to) + (<= (db/attr-compare (:a datom) + to) 0))) (db/-seek-datoms db :eavt id from nil nil)) @@ -298,7 +298,7 @@ (fn [^Datom d] (and (= (.-e d) id) - (<= (compare (.-a d) to) 0)))))] + (<= (db/attr-compare (.-a d) to) 0)))))] (when (.-wildcard? pattern) (visit context :db.pull/wildcard id nil nil)) (AttrsFrame. diff --git a/src/dbval/pull_parser.clj b/src/dbval/pull_parser.clj index bd5cdb29..7775d32c 100644 --- a/src/dbval/pull_parser.clj +++ b/src/dbval/pull_parser.clj @@ -155,11 +155,9 @@ (let [attrs (.-attrs result) db-id? (fn [^PullAttr attr] (#{:db/id ":db/id"} (.-name attr))) key-fn (fn [^PullAttr attr] - (let [name (:name attr)] - (cond - (keyword? name) name - (= ":" (subs name 0 1)) (keyword (subs name 1)) - :eles (keyword name)))) + (if (db-id? attr) + [1 nil] + [0 (db/attr-sort-key (:name attr))])) attrs (if (and (.-wildcard? result) (not (some db-id? (.-attrs result)))) diff --git a/test/dbval/test/pull_api.clj b/test/dbval/test/pull_api.clj index 93f1e04f..83afcbff 100644 --- a/test/dbval/test/pull_api.clj +++ b/test/dbval/test/pull_api.clj @@ -79,6 +79,33 @@ (d/pull-many (test-db) '[:name] [[:name "Petr"] [:name "Elizabeth"] [:name "Eunan"] [:name "Rebecca"]])))) +(deftest test-pull-namespaced-attrs-after-ref-attr + (let [db (:db-after + (d/with + (d/empty-db + {:type {:db/valueType :db.type/ref} + :instagram.story.image.preview/blob {:db/valueType :db.type/ref}}) + [{:db/id "image-type" + :db/ident :type.instagram.story/image} + {:db/id "preview-blob" + :blob/id :preview} + {:db/id "story-media" + :type "image-type" + :story-media/name "image.jpg" + :instagram.story.image.preview/blob "preview-blob"}])) + story-media-eid (ffirst (d/q '[:find ?e + :where + [?e :story-media/name]] + db))] + (is (= {:instagram.story.image.preview/blob {:blob/id :preview} + :story-media/name "image.jpg" + :type {:db/ident :type.instagram.story/image}} + (d/pull db + '[:story-media/name + {:type [:db/ident]} + {:instagram.story.image.preview/blob [:blob/id]}] + story-media-eid))))) + (deftest test-pull-reverse-attr-spec (is (= {:name "David" :_child [{:db/id (eid "petr")}]} (d/pull (test-db) '[:name :_child] [:name "David"]))) From 26dd323a28cf1b4fc5cbbb20769b5673dcd5698b Mon Sep 17 00:00:00 2001 From: max Date: Thu, 16 Jul 2026 11:27:04 +0200 Subject: [PATCH 2/2] Fix the issues the review of the pull-ordering commit confirmed. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - attrs-frame's non-DB branch (FilteredDB pulls) had its take-while outside the ->> — dead code under util/cond+ — so the scan was unbounded and unguarded by entity: pulling an attribute an entity lacks leaked the next entity's value into the result. The take-while now lives inside the pipeline. - The parser stopped normalizing string-spelled keyword attributes: ":name" (and ":db/id") in a pull pattern were silently dropped. parse-attr-name now normalizes ":foo" strings to keywords up front; bare strings still name genuine string attributes. - attr-compare ordered attributes by Java's UTF-16 string compare, but the store orders their serialized form by UTF-8 bytes (code points); the orders disagree for supplementary-plane characters. Comparison now runs in code-point order (compare-attr-keys) — including the parser's sort-by, which also used default string compare and made pulls combining such attributes return nil. - The attribute sort key is computed once at parse time and cached on PullAttr instead of pr-str-ing the pattern attr's name on every frame-loop iteration. With regression tests for the FilteredDB bound, string-spelled attrs, and supplementary-plane attribute pairs. Co-Authored-By: Claude Fable 5 --- src/dbval/db.clj | 27 +++++++++++++++++++++-- src/dbval/pull_api.clj | 27 +++++++++++++---------- src/dbval/pull_parser.clj | 36 +++++++++++++++++++++++++----- test/dbval/test/pull_api.clj | 39 +++++++++++++++++++++++++++++++++ test/dbval/test/pull_parser.clj | 3 ++- 5 files changed, 112 insertions(+), 20 deletions(-) diff --git a/src/dbval/db.clj b/src/dbval/db.clj index 9c5ae67d..9de423d4 100644 --- a/src/dbval/db.clj +++ b/src/dbval/db.clj @@ -374,11 +374,34 @@ (when attr (pr-str attr))) +(defn compare-attr-keys + "Compares two serialized attribute keys (see `attr-sort-key`) in + code-point order — the order of their UTF-8 bytes, which is how the + store sorts serialized attribute components. Java's String compare + orders by UTF-16 code units instead, which disagrees for + supplementary-plane characters (e.g. emoji): surrogates sort below + U+E000..U+FFFF even though their code points are larger." + ^long [^String ka ^String kb] + (cond + (nil? ka) (if (nil? kb) 0 -1) + (nil? kb) 1 + :else + (let [la (.length ka) + lb (.length kb)] + (loop [i (int 0)] + (if (and (< i la) (< i lb)) + (let [ca (.codePointAt ka i) + cb (.codePointAt kb i)] + (if (= ca cb) + (recur (int (+ i (Character/charCount ca)))) + (long (Integer/compare ca cb)))) + (long (Integer/compare la lb))))))) + (defn attr-compare "Compares attributes in the same order as dbval indexes store them." [a b] - (compare (attr-sort-key a) - (attr-sort-key b))) + (compare-attr-keys (attr-sort-key a) + (attr-sort-key b))) (defn tuple-list [db order datom] diff --git a/src/dbval/pull_api.clj b/src/dbval/pull_api.clj index 4439db90..ec82a865 100644 --- a/src/dbval/pull_api.clj +++ b/src/dbval/pull_api.clj @@ -139,7 +139,8 @@ :let [^Datom datom (first-seq datoms) cmp (when (and datom attr) - (db/attr-compare (.-name attr) (.-a datom))) + (db/compare-attr-keys (.-sort-key ^PullAttr attr) + (db/attr-sort-key (.-a datom)))) attr-ahead? (or (nil? attr) (and cmp (pos? cmp))) datom-ahead? (or (nil? datom) (and cmp (neg? cmp)))] @@ -280,25 +281,29 @@ (nil? (.-first-attr pattern)) nil - :let [from (.-name ^PullAttr (.-first-attr pattern)) - to (.-name ^PullAttr (.-last-attr pattern))] + :let [from (.-name ^PullAttr (.-first-attr pattern)) + to-key (.-sort-key ^PullAttr (.-last-attr pattern))] (instance? DB db) (take-while (fn [datom] (and (= (:e datom) id) - (<= (db/attr-compare (:a datom) - to) + (<= (db/compare-attr-keys + (db/attr-sort-key (:a datom)) + to-key) 0))) (db/-seek-datoms db :eavt id from nil nil)) :else - (->> (db/-seek-datoms db :eavt id nil nil nil)) - (take-while - (fn [^Datom d] - (and - (= (.-e d) id) - (<= (db/attr-compare (.-a d) to) 0)))))] + (->> (db/-seek-datoms db :eavt id nil nil nil) + (take-while + (fn [^Datom d] + (and + (= (.-e d) id) + (<= (db/compare-attr-keys + (db/attr-sort-key (.-a d)) + to-key) + 0))))))] (when (.-wildcard? pattern) (visit context :db.pull/wildcard id nil nil)) (AttrsFrame. diff --git a/src/dbval/pull_parser.clj b/src/dbval/pull_parser.clj index 7775d32c..041e4a1c 100644 --- a/src/dbval/pull_parser.clj +++ b/src/dbval/pull_parser.clj @@ -1,15 +1,17 @@ (ns ^:no-doc dbval.pull-parser (:require + [clojure.string :as str] [dbval.built-ins :as built-ins] [dbval.db :as db] [dbval.util :as util])) -(defrecord PullAttr [as default limit name pattern recursion-limit recursive? reverse? xform multival? ref? component?]) +(defrecord PullAttr [as default limit name pattern recursion-limit recursive? reverse? xform multival? ref? component? sort-key]) (defrecord PullPattern [attrs first-attr last-attr reverse-attrs wildcard?]) (def default-db-id-attr - (map->PullAttr {:name :db/id :as :db/id :xform identity})) + (map->PullAttr {:name :db/id :as :db/id :xform identity + :sort-key (db/attr-sort-key :db/id)})) (def default-pattern-ref (map->PullPattern {:attrs (list default-db-id-attr)})) @@ -35,8 +37,20 @@ (throw (ex-info (str "Expected " expected ", got: " (pr-str fragment)) {:error :parser/pull, :fragment fragment})))) +(defn- normalize-attr-spec + "A string attr spec starting with \":\" is the string spelling of a + keyword attribute (e.g. \":name\" or \":ns/_ref\") — normalize it to + the keyword, so it compares equal to the keyword attrs datoms carry. + Other strings name genuine string attributes and stay as-is." + [attr-spec] + (if (and (string? attr-spec) + (str/starts-with? attr-spec ":")) + (keyword (subs attr-spec 1)) + attr-spec)) + (defn parse-attr-name [db attr-spec] - (let [reverse? (db/reverse-ref? attr-spec) + (let [attr-spec (normalize-attr-spec attr-spec) + reverse? (db/reverse-ref? attr-spec) name (if reverse? (db/reverse-ref attr-spec) attr-spec) ref? (db/ref? db name) component? (db/component? db name) @@ -44,6 +58,7 @@ (map->PullAttr {:as attr-spec :name name + :sort-key (db/attr-sort-key name) :xform identity :multival? (when multival? true) :limit (if multival? 1000 nil) @@ -153,17 +168,26 @@ (util/cond+ (empty? pattern) (let [attrs (.-attrs result) - db-id? (fn [^PullAttr attr] (#{:db/id ":db/id"} (.-name attr))) + db-id? (fn [^PullAttr attr] (= :db/id (.-name attr))) key-fn (fn [^PullAttr attr] (if (db-id? attr) [1 nil] - [0 (db/attr-sort-key (:name attr))])) + [0 (.-sort-key attr)])) attrs (if (and (.-wildcard? result) (not (some db-id? (.-attrs result)))) (conj attrs default-db-id-attr) attrs) - attrs (list* (sort-by key-fn attrs)) + ;; sort with the same code-point comparator the frame walk and + ;; the store use — default compare orders strings by UTF-16 + ;; code units, which disagrees for supplementary-plane chars + attrs (list* (sort-by key-fn + (fn [[group-a key-a] [group-b key-b]] + (let [c (compare group-a group-b)] + (if (zero? c) + (db/compare-attr-keys key-a key-b) + c))) + attrs)) datom-attrs (remove db-id? attrs) first-attr (first datom-attrs) last-attr (last datom-attrs)] diff --git a/test/dbval/test/pull_api.clj b/test/dbval/test/pull_api.clj index 83afcbff..6c49957b 100644 --- a/test/dbval/test/pull_api.clj +++ b/test/dbval/test/pull_api.clj @@ -106,6 +106,45 @@ {:instagram.story.image.preview/blob [:blob/id]}] story-media-eid))))) +(deftest test-pull-filtered-db-is-bounded + ;; regression: the non-DB branch of attrs-frame had its take-while outside + ;; the ->>, returning an unbounded, entity-unguarded scan that leaked other + ;; entities' attribute values into the result + (let [e1 #uuid "11111111-1111-1111-1111-111111111111" + e2 #uuid "22222222-2222-2222-2222-222222222222" + db (:db-after + (d/with (d/empty-db) + [{:db/id e1 :name "First"} + {:db/id e2 :name "Second" :extra "must not leak"}])) + fdb (d/filter db (constantly true))] + (is (= {:name "First"} + (d/pull fdb [:name :extra] e1))) + (is (= {:name "Second" :extra "must not leak"} + (d/pull fdb [:name :extra] e2))))) + +(deftest test-pull-string-spelled-attrs + ;; regression: the string spelling of a keyword attribute (":name") was + ;; silently dropped after the parser stopped normalizing it + (is (= {:name "Petr"} + (d/pull (test-db) [":name"] [:name "Petr"]))) + (let [result (d/pull (test-db) [":db/id" :name] [:name "Petr"])] + (is (= "Petr" (:name result))) + (is (uuid? (:db/id result))))) + +(deftest test-pull-supplementary-plane-attrs + ;; regression: attr-compare ordered attributes by UTF-16 code units while + ;; the store orders their serialized form by UTF-8 bytes (code points); + ;; the orders disagree for supplementary-plane characters, cutting the + ;; frame scan short + (let [attr-private (keyword "aa\ue000") ;; U+E000: sorts high in UTF-16 + attr-emoji (keyword "aa\ud83d\ude00") ;; U+1F600: higher code point + db (:db-after + (d/with (d/empty-db) + [{:db/id "e" attr-private 1 attr-emoji 2}])) + eid (:e (first (d/datoms db :aevt attr-private)))] + (is (= {attr-private 1 attr-emoji 2} + (d/pull db [attr-private attr-emoji] eid))))) + (deftest test-pull-reverse-attr-spec (is (= {:name "David" :_child [{:db/id (eid "petr")}]} (d/pull (test-db) '[:name :_child] [:name "David"]))) diff --git a/test/dbval/test/pull_parser.clj b/test/dbval/test/pull_parser.clj index 84a74df3..2af860fc 100644 --- a/test/dbval/test/pull_parser.clj +++ b/test/dbval/test/pull_parser.clj @@ -29,7 +29,8 @@ (defn attr [name & {:as args}] (dpp/map->PullAttr (merge - {:name name :xform identity :as name} + {:name name :xform identity :as name + :sort-key (db/attr-sort-key name)} (when (db/ref? @*db name) {:pattern dpp/default-pattern-ref}) args)))