Initial import of LogDarioSeq baseline
Establishes version control for the personal Logseq DB fork before starting the server-client architecture migration and domain features described in docs/agent-guide and the approved implementation plan. Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
This commit is contained in:
301
src/main/frontend/worker/commands.cljs
Normal file
301
src/main/frontend/worker/commands.cljs
Normal file
@@ -0,0 +1,301 @@
|
||||
(ns frontend.worker.commands
|
||||
"Invoke commands based on user settings"
|
||||
(:require [cljs-time.coerce :as tc]
|
||||
[cljs-time.core :as t]
|
||||
[datascript.core :as d]
|
||||
[logseq.common.util.date-time :as date-time-util]
|
||||
[logseq.db :as ldb]
|
||||
[logseq.db.frontend.property :as db-property]
|
||||
[logseq.db.frontend.property.build :as db-property-build]
|
||||
[logseq.db.frontend.property.type :as db-property-type]
|
||||
[logseq.db.sqlite.util :as sqlite-util]
|
||||
[logseq.outliner.page :as outliner-page]
|
||||
[logseq.outliner.pipeline :as outliner-pipeline]))
|
||||
|
||||
;; TODO: allow users to add command or configure it through #Command (which parent should be #Code)
|
||||
(def *commands
|
||||
(atom
|
||||
[[:repeated-task
|
||||
{:title "Repeated task"
|
||||
:entity-conditions [{:property :logseq.property.repeat/repeated?
|
||||
:value true}]
|
||||
:tx-conditions [{:property :status
|
||||
:value :done}]
|
||||
:actions [[:reschedule]
|
||||
[:set-property :status :todo]]}]
|
||||
[:property-history
|
||||
{:title "Record property history"
|
||||
:tx-conditions [{:kind :datom-attribute-check?
|
||||
:property :logseq.property/enable-history?
|
||||
:value true}]
|
||||
:actions [[:record-property-history]]}]]))
|
||||
|
||||
(defn- get-property
|
||||
[entity property]
|
||||
(if (= property :status)
|
||||
(or
|
||||
(:db/ident (:logseq.property.repeat/checked-property entity))
|
||||
:logseq.property/status)
|
||||
property))
|
||||
|
||||
(defn- get-value
|
||||
[entity property value]
|
||||
(cond
|
||||
(and (= property :status) (= value :done))
|
||||
(or
|
||||
(let [p (:logseq.property.repeat/checked-property entity)
|
||||
choices (:property/closed-values p)
|
||||
checkbox? (= :checkbox (:logseq.property/type p))]
|
||||
(if checkbox?
|
||||
true
|
||||
(some (fn [choice]
|
||||
(when (:logseq.property/choice-checkbox-state choice)
|
||||
(:db/id choice))) choices)))
|
||||
:logseq.property/status.done)
|
||||
(and (= property :status) (= value :todo))
|
||||
(or
|
||||
(let [p (:logseq.property.repeat/checked-property entity)
|
||||
choices (:property/closed-values p)
|
||||
checkbox? (= :checkbox (:logseq.property/type p))]
|
||||
(if checkbox?
|
||||
false
|
||||
(some (fn [choice]
|
||||
(when (false? (:logseq.property/choice-checkbox-state choice))
|
||||
(:db/id choice))) choices)))
|
||||
:logseq.property/status.todo)
|
||||
:else
|
||||
value))
|
||||
|
||||
(defn satisfy-condition?
|
||||
"Whether entity or updated datoms satisfy the `condition`"
|
||||
[db entity {:keys [kind property value]} datoms]
|
||||
(let [property' (get-property entity property)
|
||||
value' (get-value entity property value)]
|
||||
(when-let [property-entity (d/entity db property')]
|
||||
(let [value-matches? (fn [datom-value]
|
||||
(let [ref? (contains? db-property-type/all-ref-property-types (:logseq.property/type property-entity))
|
||||
db-value (cond
|
||||
;; entity-conditions
|
||||
(nil? datom-value)
|
||||
(get entity property')
|
||||
;; tx-conditions
|
||||
ref?
|
||||
(d/entity db datom-value)
|
||||
:else
|
||||
datom-value)]
|
||||
(cond
|
||||
(qualified-keyword? value')
|
||||
(and (map? db-value) (= value' (:db/ident db-value)))
|
||||
|
||||
ref?
|
||||
(or
|
||||
(and (uuid? value') (= (:block/uuid db-value) value'))
|
||||
(= value' (db-property/property-value-content db-value))
|
||||
(= value' (:db/id db-value)))
|
||||
|
||||
:else
|
||||
(= db-value value'))))]
|
||||
(if (seq datoms)
|
||||
(case kind
|
||||
:datom-attribute-check?
|
||||
(some (fn [d]
|
||||
(= value' (get (d/entity db (:a d)) property)))
|
||||
datoms)
|
||||
|
||||
(some (fn [d] (and (value-matches? (:v d)) (:added d)))
|
||||
(filter (fn [d] (= property' (:a d))) datoms)))
|
||||
(value-matches? nil))))))
|
||||
|
||||
(defmulti handle-command (fn [action-id & _others] action-id))
|
||||
|
||||
(defn- advance-from-completion
|
||||
"`.+` semantics: next occurrence = now + frequency * unit."
|
||||
[recur-unit frequency]
|
||||
(t/plus (t/now) (recur-unit frequency)))
|
||||
|
||||
(defn- advance-from-scheduled
|
||||
"`+` semantics: next occurrence = scheduled + frequency * unit. Can land in
|
||||
the past if completion was long after scheduled — that's the documented
|
||||
behavior (\"can stack overdue\")."
|
||||
[datetime recur-unit frequency]
|
||||
(t/plus datetime (recur-unit frequency)))
|
||||
|
||||
(defn- advance-until-future
|
||||
"`++` semantics: advance from scheduled in frequency*unit steps until strictly
|
||||
after now. cljs-time arithmetic is UTC, so adding whole weeks preserves
|
||||
day-of-week by construction — no fix-up needed."
|
||||
[datetime recur-unit period-f frequency]
|
||||
(let [now (t/now)
|
||||
periods (max 1
|
||||
(if (t/after? datetime now)
|
||||
1
|
||||
(period-f (t/interval datetime now))))
|
||||
delta (->> (Math/ceil (/ periods frequency))
|
||||
(* frequency)
|
||||
recur-unit)
|
||||
result (t/plus datetime delta)]
|
||||
(loop [candidate result]
|
||||
(if (t/after? candidate now)
|
||||
candidate
|
||||
(recur (t/plus candidate (recur-unit frequency)))))))
|
||||
|
||||
(defn- repeat-next-timestamp
|
||||
"Dispatch on repeat-type db-ident to compute the next occurrence. Mirrors the
|
||||
three org-mode repeater cookies documented at
|
||||
docs.logseq.com: `.+` (dotted-plus), `+` (plus), `++` (double-plus)."
|
||||
[datetime recur-unit period-f frequency repeat-type]
|
||||
(case repeat-type
|
||||
:logseq.property.repeat/repeat-type.dotted-plus
|
||||
(advance-from-completion recur-unit frequency)
|
||||
|
||||
:logseq.property.repeat/repeat-type.plus
|
||||
(advance-from-scheduled datetime recur-unit frequency)
|
||||
|
||||
;; :double-plus or unknown fallback
|
||||
(advance-until-future datetime recur-unit period-f frequency)))
|
||||
|
||||
(defn- get-next-time
|
||||
[current-value unit frequency repeat-type]
|
||||
(let [current-date-time (tc/to-date-time current-value)
|
||||
[recur-unit period-f] (case (:db/ident unit)
|
||||
:logseq.property.repeat/recur-unit.minute [t/minutes t/in-minutes]
|
||||
:logseq.property.repeat/recur-unit.hour [t/hours t/in-hours]
|
||||
:logseq.property.repeat/recur-unit.day [t/days t/in-days]
|
||||
:logseq.property.repeat/recur-unit.week [t/weeks t/in-weeks]
|
||||
:logseq.property.repeat/recur-unit.month [t/months t/in-months]
|
||||
:logseq.property.repeat/recur-unit.year [t/years t/in-years]
|
||||
nil)]
|
||||
;; Guard against frequency <= 0: `advance-until-future` would infinite-loop
|
||||
;; on zero-length intervals, and the other variants produce nonsense.
|
||||
(when (and recur-unit (pos? frequency))
|
||||
(tc/to-long (repeat-next-timestamp current-date-time recur-unit period-f frequency repeat-type)))))
|
||||
|
||||
(defn- resolve-recur-frequency
|
||||
"Returns `[frequency default-value-tx-data]` for a recurring task entity:
|
||||
|
||||
- `[n nil]` when the entity already has an explicit
|
||||
`:logseq.property.repeat/recur-frequency` value `n`.
|
||||
- `[1 tx-data]` when it doesn't — tx-data populates the property's
|
||||
default-value block so subsequent reads see 1.
|
||||
|
||||
The explicit-vs-default branch was previously guarded by `(or [A B] [C D])`,
|
||||
which always selected the first branch because any 2-vector is truthy in
|
||||
Clojure. That made the default-value path unreachable and left migrated
|
||||
recurring tasks without a resolvable frequency. This form checks the value
|
||||
explicitly via `if-let`."
|
||||
[db entity]
|
||||
(if-let [freq (db-property/property-value-content
|
||||
(:logseq.property.repeat/recur-frequency entity))]
|
||||
[freq nil]
|
||||
(let [property (d/entity db :logseq.property.repeat/recur-frequency)
|
||||
default-value-block (db-property-build/build-property-value-block property property 1)
|
||||
default-value-tx-data [default-value-block
|
||||
{:db/id (:db/id property)
|
||||
:logseq.property/default-value [:block/uuid (:block/uuid default-value-block)]}]]
|
||||
[1 default-value-tx-data])))
|
||||
|
||||
(defn- compute-reschedule-property-tx
|
||||
[db entity property-ident]
|
||||
(let [[frequency default-value-tx-data] (resolve-recur-frequency db entity)
|
||||
unit (:logseq.property.repeat/recur-unit entity)
|
||||
repeat-type (or (:db/ident (:logseq.property.repeat/repeat-type entity))
|
||||
:logseq.property.repeat/repeat-type.double-plus)
|
||||
property (d/entity db property-ident)
|
||||
date? (= :date (:logseq.property/type property))
|
||||
current-value (cond->
|
||||
(get entity property-ident)
|
||||
date?
|
||||
(#(date-time-util/journal-day->ms (:block/journal-day %))))]
|
||||
(when (and frequency unit current-value)
|
||||
(when-let [next-time-long (get-next-time current-value unit frequency repeat-type)]
|
||||
(let [journal-day (outliner-pipeline/get-journal-day-from-long db next-time-long)
|
||||
{:keys [tx-data page-uuid]} (if journal-day
|
||||
{:page-uuid (:block/uuid (d/entity db journal-day))}
|
||||
(let [formatter (:logseq.property.journal/title-format (d/entity db :logseq.class/Journal))
|
||||
title (date-time-util/format (t/to-default-time-zone (tc/to-date-time next-time-long)) formatter)]
|
||||
(outliner-page/create db title {})))
|
||||
value (if date? [:block/uuid page-uuid] next-time-long)]
|
||||
(concat
|
||||
default-value-tx-data
|
||||
tx-data
|
||||
(when value
|
||||
[[:db/add (:db/id entity) property-ident value]])))))))
|
||||
|
||||
(def ^:private repeat-temporal-property-idents
|
||||
[:logseq.property/scheduled :logseq.property/deadline])
|
||||
|
||||
(defn- existing-repeat-temporal-property-idents
|
||||
[entity]
|
||||
(filterv #(some? (get entity %)) repeat-temporal-property-idents))
|
||||
|
||||
(defn- reschedule-property-idents
|
||||
[entity]
|
||||
(let [explicit-property-ident (:db/ident (:logseq.property.repeat/temporal-property entity))]
|
||||
(if explicit-property-ident
|
||||
(let [other-property-idents (case explicit-property-ident
|
||||
:logseq.property/scheduled
|
||||
(when (:logseq.property/deadline entity)
|
||||
[:logseq.property/deadline])
|
||||
|
||||
:logseq.property/deadline
|
||||
(when (:logseq.property/scheduled entity)
|
||||
[:logseq.property/scheduled])
|
||||
|
||||
nil)]
|
||||
(distinct (cons explicit-property-ident other-property-idents)))
|
||||
(existing-repeat-temporal-property-idents entity))))
|
||||
|
||||
(defmethod handle-command :reschedule [_ db entity _datoms]
|
||||
(mapcat #(compute-reschedule-property-tx db entity %) (reschedule-property-idents entity)))
|
||||
|
||||
(defmethod handle-command :set-property [_ _db entity _datoms property value]
|
||||
(let [property' (get-property entity property)
|
||||
value' (get-value entity property value)]
|
||||
[[:db/add (:db/id entity) property' value']]))
|
||||
|
||||
(defmethod handle-command :record-property-history [_ db entity datoms]
|
||||
(let [changes (keep (fn [d]
|
||||
(let [property (d/entity db (:a d))]
|
||||
(when (and (true? (get property :logseq.property/enable-history?))
|
||||
(:added d))
|
||||
{:property property
|
||||
:value (:v d)}))) datoms)
|
||||
data (map
|
||||
(fn [{:keys [property value]}]
|
||||
(let [ref? (= :db.type/ref (:db/valueType property))
|
||||
value-key (if ref? :logseq.property.history/ref-value :logseq.property.history/scalar-value)]
|
||||
(sqlite-util/block-with-timestamps
|
||||
{:block/uuid (ldb/new-block-id)
|
||||
value-key value
|
||||
:logseq.property.history/block (:db/id entity)
|
||||
:logseq.property.history/property (:db/id property)})))
|
||||
changes)]
|
||||
data))
|
||||
|
||||
(defmethod handle-command :default [command _db entity datoms]
|
||||
(throw (ex-info "Unhandled command"
|
||||
{:command command
|
||||
:entity entity
|
||||
:datoms datoms})))
|
||||
|
||||
(defn execute-command
|
||||
"Build tx-data"
|
||||
[db entity datoms [_command {:keys [actions]}]]
|
||||
(mapcat (fn [action]
|
||||
(apply handle-command (first action) db entity datoms (rest action))) actions))
|
||||
|
||||
(defn run-commands
|
||||
[{:keys [tx-data db-after]}]
|
||||
(mapcat (fn [[e datoms]]
|
||||
(let [entity (d/entity db-after e)
|
||||
commands (filter (fn [[_command {:keys [entity-conditions tx-conditions]}]]
|
||||
(and
|
||||
(if (seq entity-conditions)
|
||||
(every? #(satisfy-condition? db-after entity % nil) entity-conditions)
|
||||
true)
|
||||
(every? #(satisfy-condition? db-after entity % datoms) tx-conditions))) @*commands)]
|
||||
(mapcat
|
||||
(fn [command]
|
||||
(execute-command db-after entity datoms command))
|
||||
commands)))
|
||||
(group-by :e tx-data)))
|
||||
23
src/main/frontend/worker/db/fix.cljs
Normal file
23
src/main/frontend/worker/db/fix.cljs
Normal file
@@ -0,0 +1,23 @@
|
||||
(ns frontend.worker.db.fix
|
||||
"fix db"
|
||||
(:require [datascript.core :as d]
|
||||
[logseq.db.frontend.schema :as db-schema]))
|
||||
|
||||
(defn check-and-fix-schema!
|
||||
[conn]
|
||||
(let [db-schema (:schema @conn)
|
||||
diffs (->> (keep (fn [[k v]]
|
||||
(let [schema-v (-> (get db-schema k)
|
||||
(dissoc :db/ident))
|
||||
schema-v' (cond-> schema-v
|
||||
(= (:db/cardinality schema-v) :db.cardinality/one)
|
||||
(dissoc :db/cardinality)
|
||||
(and (:db/index schema-v)
|
||||
(nil? (:db/index v)))
|
||||
(dissoc :db/index))]
|
||||
(when-not (or (= v schema-v') (= k :db/ident))
|
||||
(assoc v :db/ident k))))
|
||||
db-schema/schema))]
|
||||
(when (seq diffs)
|
||||
(prn :debug ::check-and-fix-schema! :diffs diffs)
|
||||
(d/transact! conn diffs))))
|
||||
330
src/main/frontend/worker/db/migrate.cljs
Normal file
330
src/main/frontend/worker/db/migrate.cljs
Normal file
@@ -0,0 +1,330 @@
|
||||
(ns frontend.worker.db.migrate
|
||||
"Handles SQLite and datascript migrations for DB graphs"
|
||||
(:require [clojure.string :as string]
|
||||
[clojure.walk :as walk]
|
||||
[datascript.core :as d]
|
||||
[datascript.impl.entity :as de]
|
||||
[frontend.worker-common.util :as worker-util]
|
||||
[logseq.common.config :as common-config]
|
||||
[logseq.common.util :as common-util]
|
||||
[logseq.db :as ldb]
|
||||
[logseq.db.common.delete-blocks :as delete-blocks]
|
||||
[logseq.db.frontend.class :as db-class]
|
||||
[logseq.db.frontend.property :as db-property]
|
||||
[logseq.db.frontend.schema :as db-schema]
|
||||
[logseq.db.sqlite.create-graph :as sqlite-create-graph]
|
||||
[logseq.db.sqlite.util :as sqlite-util]
|
||||
[logseq.outliner.page :as outliner-page]))
|
||||
|
||||
;; Frontend migrations
|
||||
;; ===================
|
||||
|
||||
(defn- add-quick-add-page
|
||||
[_db]
|
||||
(let [page (-> (-> (sqlite-util/build-new-page common-config/quick-add-page-name)
|
||||
sqlite-create-graph/mark-block-as-built-in))]
|
||||
[page]))
|
||||
|
||||
(defn- add-missing-page-name
|
||||
[db]
|
||||
(let [pages (d/datoms db :avet :block/name "")]
|
||||
(keep
|
||||
(fn [d]
|
||||
(let [page (d/entity db (:e d))]
|
||||
(when-not (string/blank? (:block/title page))
|
||||
{:db/id (:db/id page)
|
||||
:block/name (common-util/page-name-sanity-lc (:block/title page))})))
|
||||
pages)))
|
||||
|
||||
(defn delete-property
|
||||
[db property-key]
|
||||
(let [property-entity (d/entity db property-key)
|
||||
property-page? (ldb/property? property-entity)
|
||||
direct-property-datoms (map
|
||||
(fn [eid]
|
||||
[:db/retract eid property-key])
|
||||
(d/q '[:find [?e ...]
|
||||
:in $ ?property-key
|
||||
:where
|
||||
[?e ?property-key ?v]]
|
||||
db
|
||||
property-key))
|
||||
remove-datoms (if property-page?
|
||||
(outliner-page/build-page-retract-tx db property-entity)
|
||||
(concat direct-property-datoms
|
||||
(when property-entity
|
||||
[[:db/retractEntity property-key]])))]
|
||||
(->>
|
||||
(concat
|
||||
(delete-blocks/update-refs-history db remove-datoms {})
|
||||
remove-datoms)
|
||||
distinct)))
|
||||
|
||||
(defn remove-block-path-refs
|
||||
[db]
|
||||
(delete-property db :block/path-refs))
|
||||
|
||||
(defn- remove-position-property-from-url-properties
|
||||
[db]
|
||||
(->> (d/datoms db :avet :logseq.property/type :url)
|
||||
(keep (fn [d]
|
||||
(let [e (d/entity db (:e d))]
|
||||
(when (:logseq.property/ui-position e)
|
||||
[:db/retract (:e d) :logseq.property/ui-position]))))))
|
||||
|
||||
(defn- deprecated-ensure-graph-uuid
|
||||
[_db])
|
||||
|
||||
(defn- tag-comment-blocks
|
||||
[db]
|
||||
(when (d/entity db :logseq.class/Comments)
|
||||
(->> (d/q '[:find [?comment ...]
|
||||
:where
|
||||
[?comments-area :block/tags :logseq.class/Comments]
|
||||
[?comment :block/parent ?comments-area]]
|
||||
db)
|
||||
(map (fn [comment-id]
|
||||
[:db/add comment-id :block/tags :logseq.class/Comment])))))
|
||||
|
||||
(defn- add-single-block-comment-targets
|
||||
[db]
|
||||
(when (d/entity db :logseq.class/Comments)
|
||||
(->> (d/q '[:find ?comments-area-id ?parent-id
|
||||
:where
|
||||
[?comments-area-id :block/tags :logseq.class/Comments]
|
||||
[?comments-area-id :block/parent ?parent-id]]
|
||||
db)
|
||||
(keep (fn [[comments-area-id parent-id]]
|
||||
(let [comments-area (d/entity db comments-area-id)]
|
||||
(when-not (seq (:logseq.property.comments/blocks comments-area))
|
||||
[:db/add comments-area-id :logseq.property.comments/blocks parent-id])))))))
|
||||
|
||||
(defn- missing-class-extends?
|
||||
[class]
|
||||
(let [extends (:logseq.property.class/extends class)]
|
||||
(or (nil? extends)
|
||||
(and (coll? extends) (empty? extends)))))
|
||||
|
||||
(defn- repair-comment-classes-and-targets
|
||||
[db]
|
||||
(let [root-id (:db/id (d/entity db :logseq.class/Root))]
|
||||
(concat
|
||||
(add-single-block-comment-targets db)
|
||||
(mapcat
|
||||
(fn [class-ident]
|
||||
(when-let [class (d/entity db class-ident)]
|
||||
(concat
|
||||
(when (and root-id (missing-class-extends? class))
|
||||
[[:db/add (:db/id class) :logseq.property.class/extends root-id]])
|
||||
(when (:block/order class)
|
||||
[[:db/retract (:db/id class) :block/order (:block/order class)]]))))
|
||||
[:logseq.class/Comments :logseq.class/Comment]))))
|
||||
|
||||
(def schema-version->updates
|
||||
"A vec of tuples defining datascript migrations. Each tuple consists of the
|
||||
schema version integer and a migration map. A migration map can have keys of :properties, :classes
|
||||
and :fix."
|
||||
[["65.7" {:fix add-quick-add-page}]
|
||||
["65.8" {:fix add-missing-page-name}]
|
||||
["65.10" {:properties [:block/journal-day :logseq.property.view/sort-groups-by-property :logseq.property.view/sort-groups-desc?]}]
|
||||
["65.11" {:fix remove-block-path-refs}]
|
||||
["65.12" {:fix remove-position-property-from-url-properties}]
|
||||
["65.13" {:properties [:logseq.property.asset/width
|
||||
:logseq.property.asset/height]}]
|
||||
["65.14" {:properties [:logseq.property.asset/external-src]}]
|
||||
["65.16" {:properties [:logseq.property.asset/external-file-name]}]
|
||||
["65.17" {:properties [:logseq.property.publish/published-url]}]
|
||||
["65.18" {:fix deprecated-ensure-graph-uuid}]
|
||||
["65.19" {:properties [:logseq.property/choice-classes :logseq.property/choice-exclusions]}]
|
||||
["65.20" {:properties [:logseq.property.class/bidirectional-property-title :logseq.property.class/enable-bidirectional?]}]
|
||||
["65.21" {:properties [:logseq.property.sync/large-title-object]}]
|
||||
["65.22" {:properties [:logseq.property.reaction/emoji-id
|
||||
:logseq.property.reaction/target]}]
|
||||
["65.23" {:properties [:logseq.property.asset/align]}]
|
||||
["65.24" {:properties [:logseq.property/deleted-at
|
||||
:logseq.property/deleted-by-ref
|
||||
:logseq.property.recycle/original-parent
|
||||
:logseq.property.recycle/original-page
|
||||
:logseq.property.recycle/original-order]}]
|
||||
["65.25" {:delete-properties [:block/pre-block?
|
||||
:logseq.property.embedding/hnsw-label
|
||||
:logseq.property.embedding/hnsw-label-updated-at]}]
|
||||
["65.26" {:properties [:logseq.property.repeat/repeat-type]}]
|
||||
["65.27" {:classes [:logseq.class/Comments]
|
||||
:properties [:logseq.property.comments/blocks]}]
|
||||
["65.28" {:classes [:logseq.class/Comment]
|
||||
:fix tag-comment-blocks}]
|
||||
["65.29" {:fix add-single-block-comment-targets}]
|
||||
["65.30" {:properties [:logseq.property/assignee]}]
|
||||
["65.31" {:properties [:logseq.property.agent/session-id]}]
|
||||
["65.32" {:fix repair-comment-classes-and-targets}]
|
||||
["65.33" {:properties [:logseq.property.view/gallery-asset-property
|
||||
:logseq.property.view/gallery-display-properties
|
||||
:logseq.property.view/gallery-card-size
|
||||
:logseq.property.view/gallery-card-width
|
||||
:logseq.property.view/gallery-card-height]}]])
|
||||
|
||||
(let [[major minor] (last (sort (map (comp (juxt :major :minor) db-schema/parse-schema-version first)
|
||||
schema-version->updates)))]
|
||||
(when major
|
||||
(let [max-schema-version {:major major :minor minor}
|
||||
compare-result (db-schema/compare-schema-version db-schema/version max-schema-version)]
|
||||
(assert (>= 0 compare-result) [db-schema/version max-schema-version])
|
||||
(when (neg? compare-result)
|
||||
(js/console.warn (str "Current db schema-version is " db-schema/version ", max available schema-version is " max-schema-version))))))
|
||||
|
||||
(defn ensure-built-in-data-exists!
|
||||
"Return tx-data"
|
||||
[conn]
|
||||
(let [*uuids (atom {})
|
||||
initial-data (sqlite-create-graph/build-db-initial-data "")
|
||||
data (->> initial-data
|
||||
(keep (fn [data]
|
||||
(cond
|
||||
;; Already created db-idents like :logseq.kv/graph-initial-schema-version should not be overwritten
|
||||
(= "logseq.kv" (some-> (:db/ident data) namespace))
|
||||
nil
|
||||
|
||||
(= (:block/title data) "Contents")
|
||||
nil
|
||||
|
||||
(:file/path data)
|
||||
(if-let [block (d/entity @conn [:file/path (:file/path data)])]
|
||||
(let [existing-data (assoc (into {} block) :db/id (:db/id block))]
|
||||
(merge data existing-data))
|
||||
data)
|
||||
|
||||
(= [:block/uuid :logseq.property/built-in?] (keys data))
|
||||
data
|
||||
|
||||
(:block/uuid data)
|
||||
(if-let [block (d/entity @conn [:block/uuid (:block/uuid data)])]
|
||||
(do
|
||||
(swap! *uuids assoc (:block/uuid data) (:block/uuid block))
|
||||
(let [existing-data (assoc (into {} block) :db/id (:db/id block))]
|
||||
(reduce
|
||||
(fn [data [k existing-value]]
|
||||
(update data k
|
||||
(fn [v]
|
||||
(cond
|
||||
(= k :logseq.property/built-in?)
|
||||
true
|
||||
(= k :logseq.property/type)
|
||||
v
|
||||
(coll? v)
|
||||
v
|
||||
|
||||
:else
|
||||
(let [existing-value (if (and (coll? existing-value) (not (map? existing-value)))
|
||||
(remove nil? existing-value)
|
||||
existing-value)]
|
||||
(cond
|
||||
(contains? #{:block/title :block/name} k)
|
||||
v
|
||||
(some? existing-value)
|
||||
existing-value
|
||||
:else
|
||||
v))))))
|
||||
data
|
||||
existing-data)))
|
||||
data)
|
||||
|
||||
:else
|
||||
data)))
|
||||
common-util/fast-remove-nils)
|
||||
;; using existing page's uuid
|
||||
data' (->>
|
||||
(walk/prewalk
|
||||
(fn [f]
|
||||
(cond
|
||||
(and (de/entity? f) (:block/uuid f))
|
||||
(or (:db/ident f) [:block/uuid (:block/uuid f)])
|
||||
(and (vector? f) (= :block/uuid (first f)) (@*uuids (second f)))
|
||||
[:block/uuid (@*uuids (second f))]
|
||||
:else
|
||||
f))
|
||||
data)
|
||||
(map (fn [m] (dissoc m :db/id))))
|
||||
|
||||
r (ldb/transact! conn data' {:fix-db? true
|
||||
:db-migrate? true})]
|
||||
(assoc r :migrate-updates
|
||||
;; fake it as a normal :fix type migration
|
||||
{:fix (constantly :ensure-built-in-data-exists!)})))
|
||||
|
||||
(defn- upgrade-version!
|
||||
"Return tx-data"
|
||||
[conn version {:keys [properties classes fix delete-properties] :as migrate-updates}]
|
||||
(let [version (db-schema/parse-schema-version version)
|
||||
db @conn
|
||||
new-properties (->> (select-keys db-property/built-in-properties properties)
|
||||
;; property already exists, this should never happen
|
||||
(remove (fn [[k _]]
|
||||
(when (d/entity db k)
|
||||
(assert (str "DB migration: property already exists " k)))))
|
||||
(into {})
|
||||
sqlite-create-graph/build-properties
|
||||
(map (fn [b] (assoc b :logseq.property/built-in? true))))
|
||||
classes' (->> (concat [:logseq.class/Property :logseq.class/Tag :logseq.class/Page :logseq.class/Journal :logseq.class/Whiteboard] classes)
|
||||
distinct)
|
||||
new-classes (->> (select-keys db-class/built-in-classes classes')
|
||||
;; class already exists, this should never happen
|
||||
(remove (fn [[k _]] (d/entity db k)))
|
||||
(into {})
|
||||
(#(sqlite-create-graph/build-initial-classes* % (zipmap properties properties)))
|
||||
(map (fn [b] (assoc b :logseq.property/built-in? true))))
|
||||
new-class-idents (keep (fn [class]
|
||||
(when-let [db-ident (:db/ident class)]
|
||||
{:db/ident db-ident})) new-classes)
|
||||
fixes (when (fn? fix)
|
||||
(fix db))
|
||||
delete-properties-tx (mapcat
|
||||
(fn [property]
|
||||
(delete-property db property))
|
||||
delete-properties)
|
||||
tx-data (concat new-class-idents new-properties new-classes fixes delete-properties-tx)
|
||||
tx-data' (concat
|
||||
[(sqlite-util/kv :logseq.kv/schema-version version)]
|
||||
tx-data)
|
||||
r (ldb/transact! conn tx-data' {:db-migrate? true
|
||||
:skip-validate-db? true})]
|
||||
(println "DB schema migrated to" version)
|
||||
(assoc r :migrate-updates migrate-updates)))
|
||||
|
||||
(defn migrate
|
||||
"Migrate 'frontend' datascript schema and data. To add a new migration,
|
||||
add an entry to schema-version->updates and bump db-schema/version"
|
||||
[conn & {:keys [target-version] :or {target-version db-schema/version}}]
|
||||
(let [db @conn
|
||||
version-in-db (db-schema/parse-schema-version (or (:kv/value (d/entity db :logseq.kv/schema-version)) 0))
|
||||
compare-result (db-schema/compare-schema-version target-version version-in-db)]
|
||||
(cond
|
||||
(zero? compare-result)
|
||||
nil
|
||||
|
||||
(neg? compare-result) ; outdated client, db version could be synced from server
|
||||
(worker-util/post-message :notification ["Your app is using an outdated version that is incompatible with your current graph. Please update your app before editing this graph." :error false])
|
||||
|
||||
(pos? compare-result)
|
||||
(try
|
||||
(let [updates (keep (fn [[v updates]]
|
||||
(let [v* (db-schema/parse-schema-version v)]
|
||||
(when (and (neg? (db-schema/compare-schema-version version-in-db v*))
|
||||
(not (pos? (db-schema/compare-schema-version v* target-version))))
|
||||
[v updates])))
|
||||
schema-version->updates)
|
||||
result-ks [:tx-data :db-before :db-after :migrate-updates]
|
||||
*upgrade-result-coll (atom [])]
|
||||
(println "DB schema migrated from" version-in-db)
|
||||
(doseq [[v m] updates]
|
||||
(let [r (upgrade-version! conn v m)]
|
||||
(swap! *upgrade-result-coll conj (select-keys r result-ks))))
|
||||
(swap! *upgrade-result-coll conj
|
||||
(select-keys (ensure-built-in-data-exists! conn) result-ks))
|
||||
{:from-version version-in-db
|
||||
:to-version target-version
|
||||
:upgrade-result-coll @*upgrade-result-coll})
|
||||
(catch :default e
|
||||
(prn :error (str "DB migration failed to migrate to " target-version " from " version-in-db ":"))
|
||||
(js/console.error e)
|
||||
(throw e))))))
|
||||
338
src/main/frontend/worker/db/validate.cljs
Normal file
338
src/main/frontend/worker/db/validate.cljs
Normal file
@@ -0,0 +1,338 @@
|
||||
(ns frontend.worker.db.validate
|
||||
"Validate db"
|
||||
(:require [clojure.string :as string]
|
||||
[datascript.core :as d]
|
||||
[datascript.impl.entity :as de]
|
||||
[frontend.worker.db.migrate :as db-migrate]
|
||||
[frontend.worker.shared-service :as shared-service]
|
||||
[logseq.db :as ldb]
|
||||
[logseq.db-sync.checksum :as sync-checksum]
|
||||
[logseq.db.frontend.class :as db-class]
|
||||
[logseq.db.frontend.validate :as db-validate]))
|
||||
|
||||
(defn- get-property-by-title
|
||||
[db title]
|
||||
(when title
|
||||
(some->> (first (ldb/page-exists? db title [:logseq.class/Property]))
|
||||
(d/entity db))))
|
||||
|
||||
(defn- block-missing-uuid?
|
||||
[entity]
|
||||
(and (nil? (:block/uuid entity))
|
||||
(string? (:block/title entity))
|
||||
(:block/page entity)
|
||||
(:block/parent entity)
|
||||
(string? (:block/order entity))
|
||||
(int? (:block/created-at entity))
|
||||
(int? (:block/updated-at entity))))
|
||||
|
||||
(defn- normal-page-missing-updated-at?
|
||||
[entity dispatch-key]
|
||||
(and (= dispatch-key :normal-page)
|
||||
(nil? (:block/updated-at entity))
|
||||
(int? (:block/created-at entity))))
|
||||
|
||||
(defn- ^:large-vars/cleanup-todo fix-invalid-blocks!
|
||||
[conn errors]
|
||||
(let [db @conn
|
||||
fix-tx-data (mapcat
|
||||
(fn [{:keys [entity dispatch-key]}]
|
||||
(let [entity (d/entity db (:db/id entity))]
|
||||
(cond
|
||||
(= :logseq.property.embedding/hnsw-label (:db/ident entity))
|
||||
(db-migrate/delete-property db :logseq.property.embedding/hnsw-label)
|
||||
(some? (:logseq.property/parent entity))
|
||||
[[:db/retract (:db/id entity) :logseq.property/parent]]
|
||||
(and (ldb/class? entity) (:block/order entity))
|
||||
[[:db/retract (:db/id entity) :block/order]]
|
||||
(and (not (ldb/page? entity)) (:block/name entity))
|
||||
[[:db/retract (:db/id entity) :block/name]]
|
||||
(some? (:hide? entity))
|
||||
[[:db/retract (:db/id entity) :hide?]]
|
||||
(some? (:public? entity))
|
||||
[[:db/retract (:db/id entity) :public?]]
|
||||
(some? (:block/pre-block? entity))
|
||||
[[:db/retract (:db/id entity) :block/pre-block?]]
|
||||
(some? (:logseq.property.embedding/hnsw-label entity))
|
||||
[[:db/retract (:db/id entity) :logseq.property.embedding/hnsw-label]]
|
||||
(some? (:logseq.property.embedding/hnsw-label-updated-at entity))
|
||||
[[:db/retract (:db/id entity) :logseq.property.embedding/hnsw-label-updated-at]]
|
||||
(normal-page-missing-updated-at? entity dispatch-key)
|
||||
[[:db/add (:db/id entity) :block/updated-at (:block/created-at entity)]]
|
||||
(and (= "External URL" (:block/title entity))
|
||||
(nil? (:block/tags entity)))
|
||||
[[:db/retractEntity (:db/id entity)]]
|
||||
(and (ldb/property? entity)
|
||||
(some #(= (:db/ident %) :logseq.class/Tag) (:block/tags entity)))
|
||||
[[:db/retract (:db/id entity) :block/tags :logseq.class/Tag]]
|
||||
(and (:db/ident entity)
|
||||
(db-class/user-class-namespace? (str (:db/ident entity)))
|
||||
(not (:logseq.property/built-in? entity))
|
||||
(not (ldb/class? entity)))
|
||||
[[:db/add (:db/id entity) :block/tags :logseq.class/Tag]
|
||||
[:db/retract (:db/id entity) :block/tags :logseq.class/Page]]
|
||||
(and (ldb/class? entity) (:kv/value entity))
|
||||
[[:db/retract (:db/id entity) :kv/value]]
|
||||
(and (ldb/property? entity)
|
||||
(:logseq.property.class/extends entity))
|
||||
(mapv (fn [class]
|
||||
[:db/retract (:db/id entity) :logseq.property.class/extends (:db/id class)])
|
||||
(:logseq.property.class/extends entity))
|
||||
(:block/level entity)
|
||||
[[:db/retract (:db/id entity) :block/level]]
|
||||
;; missing :db/ident
|
||||
(and (ldb/class? entity) (nil? (:db/ident entity)) (:block/title entity))
|
||||
[[:db/add (:db/id entity) :db/ident (db-class/create-user-class-ident-from-name db (:block/title entity))]]
|
||||
(and
|
||||
(= (:block/title (:logseq.property/created-from-property entity)) "description")
|
||||
(nil? (:block/page entity)))
|
||||
(let [property-id (:db/id (:logseq.property/created-from-property entity))]
|
||||
[[:db/add (:db/id entity) :block/page property-id]
|
||||
[:db/add (:db/id entity) :block/parent property-id]])
|
||||
(and (:db/ident entity)
|
||||
(:logseq.property/built-in? entity)
|
||||
(:block/parent entity))
|
||||
[[:db/retract (:db/id entity) :block/parent]]
|
||||
(:block/format entity)
|
||||
[[:db/retract (:db/id entity) :block/format]]
|
||||
(= :whiteboard-shape (:logseq.property/ls-type entity))
|
||||
[[:db/retractEntity (:db/id entity)]]
|
||||
(and (:block/page entity) (not (:block/parent entity)))
|
||||
[[:db/add (:db/id entity) :block/parent (:db/id (:block/page entity))]]
|
||||
(and (:logseq.property/created-by-ref entity)
|
||||
(not (de/entity? (:logseq.property/created-by-ref entity))))
|
||||
[[:db/retractEntity (:db/id entity)]]
|
||||
(block-missing-uuid? entity)
|
||||
[[:db/add (:db/id entity) :block/uuid (random-uuid)]]
|
||||
(vector? (:logseq.property/value entity))
|
||||
[[:db/retractEntity (:db/id entity)]]
|
||||
(and (:block/tx-id entity) (nil? (:block/title entity)))
|
||||
[[:db/retractEntity (:db/id entity)]]
|
||||
(and (:block/title entity) (nil? (:block/page entity)) (nil? (:block/parent entity)) (nil? (:block/name entity)))
|
||||
[[:db/retractEntity (:db/id entity)]]
|
||||
(= :block/path-refs (:db/ident entity))
|
||||
(try
|
||||
(db-migrate/remove-block-path-refs db)
|
||||
(catch :default _e
|
||||
nil))
|
||||
(not-every? (fn [e] (ldb/class? e)) (:block/tags entity))
|
||||
(let [non-tags (remove ldb/class? (:block/tags entity))]
|
||||
(map (fn [tag]
|
||||
[:db/retract (:db/id entity) :block/tags (:db/id tag)]) non-tags))
|
||||
(and (= dispatch-key :normal-page) (:block/page entity))
|
||||
[[:db/retract (:db/id entity) :block/page]]
|
||||
(and (= dispatch-key :block) (nil? (:block/title entity)))
|
||||
[[:db/retractEntity (:db/id entity)]]
|
||||
(and (= dispatch-key :block) (nil? (:block/page entity)))
|
||||
(let [latest-journal-id (:db/id (first (ldb/get-latest-journals db)))
|
||||
page-id (:db/id (:block/page (:block/parent entity)))]
|
||||
(cond
|
||||
page-id
|
||||
[[:db/add (:db/id entity) :block/page page-id]]
|
||||
latest-journal-id
|
||||
[[:db/add (:db/id entity) :block/page latest-journal-id]
|
||||
[:db/add (:db/id entity) :block/parent latest-journal-id]]
|
||||
:else
|
||||
(js/console.error (str "Don't know where to put the block " (:db/id entity)))))
|
||||
|
||||
(and (= dispatch-key :block)
|
||||
(some (fn [k] (= "user.class" (namespace k))) (keys (:logseq.property.table/sized-columns entity))))
|
||||
(let [new-value (->> (keep (fn [[k v]]
|
||||
(if (= "user.class" (namespace k))
|
||||
(when-let [property (get-property-by-title db (:block/title (d/entity db k)))]
|
||||
[(:db/ident property) v])
|
||||
[k v]))
|
||||
(:logseq.property.table/sized-columns entity))
|
||||
(into {}))]
|
||||
[[:db/add (:db/id entity) :logseq.property.table/sized-columns new-value]])
|
||||
|
||||
(some (fn [k] (= "block.temp" (namespace k))) (keys entity))
|
||||
(let [ks (filter (fn [k] (= "block.temp" (namespace k))) (keys entity))]
|
||||
(mapv (fn [k] [:db/retract (:db/id entity) k]) ks))
|
||||
(and (not (:block/page entity)) (not (:block/parent entity)) (not (:block/name entity)))
|
||||
[[:db/retractEntity (:db/id entity)]]
|
||||
(and (= dispatch-key :property-value-block) (:block/title entity))
|
||||
[[:db/retract (:db/id entity) :block/title]]
|
||||
(and (ldb/class? entity) (not (:logseq.property.class/extends entity))
|
||||
(not= (:db/ident entity) :logseq.class/Root))
|
||||
[[:db/add (:db/id entity) :logseq.property.class/extends :logseq.class/Root]]
|
||||
(and (or (ldb/class? entity) (ldb/property? entity)) (ldb/internal-page? entity))
|
||||
[[:db/retract (:db/id entity) :block/tags :logseq.class/Page]]
|
||||
|
||||
(and (:logseq.property.asset/remote-metadata entity) (nil? (:logseq.property.asset/type entity)))
|
||||
[[:db/retractEntity (:db/id entity)]]
|
||||
|
||||
:else
|
||||
nil)))
|
||||
errors)
|
||||
class-as-properties (concat
|
||||
(mapcat
|
||||
(fn [ident]
|
||||
(->> (d/datoms db :avet ident)
|
||||
(mapcat (fn [d]
|
||||
(let [entity (d/entity db (:v d))]
|
||||
(when (ldb/class? entity)
|
||||
(if-let [property (get-property-by-title db (:block/title entity))]
|
||||
[[:db/retract (:e d) (:a d) (:v d)]
|
||||
[:db/add (:e d) (:a d) (:db/id property)]]
|
||||
[[:db/retract (:e d) (:a d) (:v d)]])))))))
|
||||
[:logseq.property.view/group-by-property :logseq.property.table/pinned-columns])
|
||||
(->> (d/datoms db :eavt)
|
||||
(filter (fn [d] (= (namespace (:a d)) "user.class")))
|
||||
(mapcat (fn [d]
|
||||
(let [class-title (:block/title (d/entity db (:a d)))
|
||||
property (get-property-by-title db class-title)]
|
||||
(if property
|
||||
[[:db/retract (:e d) (:a d) (:v d)]
|
||||
[:db/add (:e d) (:db/ident property) (:v d)]]
|
||||
[[:db/retract (:e d) (:a d) (:v d)]]))))))
|
||||
tx-data (concat fix-tx-data
|
||||
class-as-properties)]
|
||||
(when (seq tx-data)
|
||||
(let [tx-report (ldb/transact! conn tx-data {:fix-db? true})]
|
||||
(seq (:tx-data tx-report))))))
|
||||
|
||||
(defn- fix-num-prefix-db-idents!
|
||||
"Fix invalid db/ident keywords for both classes and properties"
|
||||
[conn]
|
||||
(let [db @conn
|
||||
tx-data (->> (d/datoms db :avet :db/ident)
|
||||
(filter (fn [d] (re-find #"^(\d)" (name (:v d)))))
|
||||
(mapcat (fn [d]
|
||||
(let [new-db-ident (keyword (namespace (:v d)) (string/replace-first (name (:v d)) #"^(\d)" "NUM-$1"))
|
||||
property (ldb/property? (d/entity db (:v d)))]
|
||||
(concat
|
||||
[[:db/add (:e d) :db/ident new-db-ident]]
|
||||
(when property
|
||||
(->> (d/datoms db :avet (:v d))
|
||||
(mapcat (fn [d]
|
||||
[[:db/retract (:e d) (:a d) (:v d)]
|
||||
[:db/add (:e d) new-db-ident (:v d)]])))))))))
|
||||
;; FIXME: :logseq.property.table/hidden-columns should be :property type to avoid issues like this
|
||||
hidden-columns-tx-data (->> (d/datoms db :avet :logseq.property.table/hidden-columns)
|
||||
(mapcat (fn [d]
|
||||
(when (re-find #"^(\d)" (name (:v d)))
|
||||
(let [new-value (keyword (namespace (:v d)) (string/replace-first (name (:v d)) #"^(\d)" "NUM-$1"))]
|
||||
[[:db/retract (:e d) (:a d) (:v d)]
|
||||
[:db/add (:e d) (:a d) new-value]])))))
|
||||
tx-data' (concat tx-data hidden-columns-tx-data)]
|
||||
(when (seq tx-data')
|
||||
(ldb/transact! conn tx-data'))))
|
||||
|
||||
(defn- fix-non-closed-values!
|
||||
[conn]
|
||||
(let [db @conn
|
||||
properties (->> (ldb/get-all-properties db)
|
||||
(filter :block/_closed-value-property))
|
||||
tx-data (mapcat
|
||||
(fn [property]
|
||||
(let [closed-values (:block/_closed-value-property property)
|
||||
matches (if (every? de/entity? closed-values)
|
||||
(set (map :db/id closed-values))
|
||||
(set closed-values))
|
||||
values (d/q
|
||||
'[:find ?b ?v
|
||||
:in $ ?p
|
||||
:where
|
||||
[?b ?p ?v]]
|
||||
db
|
||||
(:db/ident property))]
|
||||
(keep
|
||||
(fn [[b v]]
|
||||
(when-not (or (matches v)
|
||||
(= :logseq.property/empty-placeholder (:db/ident (d/entity db v))))
|
||||
[:db/retract b (:db/ident property) v]))
|
||||
values)))
|
||||
properties)]
|
||||
(when (seq tx-data)
|
||||
(prn :debug :fix-non-closed-values tx-data)
|
||||
(ldb/transact! conn tx-data {:fix-db? true}))))
|
||||
|
||||
(defn- fix-icon-wrong-type!
|
||||
[conn]
|
||||
(let [icon (d/entity @conn :logseq.property/icon)]
|
||||
(when (= :db.type/ref (:db/valueType icon))
|
||||
(let [datoms (d/datoms @conn :avet :logseq.property/icon)
|
||||
tx-data (cons
|
||||
[:db/retract (:db/id icon) :db/valueType]
|
||||
(map (fn [d] [:db/retract (:e d) (:a d)]) datoms))]
|
||||
(ldb/transact! conn tx-data {:fix-db? true})))))
|
||||
|
||||
(defn- fix-extends-cardinality!
|
||||
[conn]
|
||||
(when (not= :db.cardinality/many (:db/cardinality (d/entity @conn :logseq.property.class/extends)))
|
||||
(ldb/transact! conn
|
||||
[{:db/ident :logseq.property.class/extends
|
||||
:db/cardinality :db.cardinality/many
|
||||
:db/index true}]
|
||||
{:fix-db? true})))
|
||||
|
||||
(defn- validate-db-result
|
||||
[db]
|
||||
(let [{:keys [errors datom-count entities]} (db-validate/validate-db db)
|
||||
invalid-entity-ids (distinct (map (fn [e] (:db/id (:entity e))) errors))]
|
||||
{:errors errors
|
||||
:datom-count datom-count
|
||||
:entities entities
|
||||
:invalid-entity-ids invalid-entity-ids}))
|
||||
|
||||
(defn- log-validation-errors!
|
||||
[errors]
|
||||
(doseq [error errors]
|
||||
(prn :debug
|
||||
:entity (:entity error)
|
||||
:error (dissoc error :entity))))
|
||||
|
||||
(defn- validate-and-fix-invalid-blocks!
|
||||
[conn]
|
||||
(loop [{:keys [errors] :as result} (validate-db-result @conn)]
|
||||
(log-validation-errors! errors)
|
||||
(if (and (seq errors) (fix-invalid-blocks! conn errors))
|
||||
(recur (validate-db-result @conn))
|
||||
result)))
|
||||
|
||||
(defn validate-db
|
||||
[conn & {:keys [fix] :or {fix true}}]
|
||||
(when fix
|
||||
(fix-extends-cardinality! conn)
|
||||
(fix-icon-wrong-type! conn)
|
||||
(db-migrate/ensure-built-in-data-exists! conn)
|
||||
(fix-non-closed-values! conn)
|
||||
(fix-num-prefix-db-idents! conn))
|
||||
|
||||
(let [{:keys [errors datom-count entities invalid-entity-ids]}
|
||||
(if fix
|
||||
(validate-and-fix-invalid-blocks! conn)
|
||||
(let [{:keys [errors] :as result} (validate-db-result @conn)]
|
||||
(log-validation-errors! errors)
|
||||
result))
|
||||
db @conn
|
||||
counts (assoc (db-validate/graph-counts db entities) :datoms datom-count)]
|
||||
|
||||
(if errors
|
||||
(do
|
||||
(shared-service/broadcast-to-clients! :log [:db-invalid :error
|
||||
{:msg "Validation errors"
|
||||
:errors errors}])
|
||||
(shared-service/broadcast-to-clients! :notification
|
||||
[(str "Validation detected " (count errors) " invalid block(s). These blocks may be buggy."
|
||||
(when fix
|
||||
" Attempting to fix invalid blocks. Run validation again to see if they were fixed."))
|
||||
:warning false]))
|
||||
|
||||
(shared-service/broadcast-to-clients! :notification
|
||||
[(str "Your graph is valid! " counts)
|
||||
:success false]))
|
||||
(merge {:errors errors
|
||||
:invalid-entity-ids invalid-entity-ids}
|
||||
counts)))
|
||||
|
||||
(defn recompute-checksum-diagnostics
|
||||
[_repo conn {:keys [local-checksum remote-checksum] :as _sync-diagnostics}]
|
||||
(let [{:keys [checksum attrs blocks e2ee?]} (sync-checksum/recompute-checksum-diagnostics @conn)]
|
||||
{:recomputed-checksum checksum
|
||||
:local-checksum local-checksum
|
||||
:remote-checksum remote-checksum
|
||||
:e2ee? e2ee?
|
||||
:checksum-attrs attrs
|
||||
:blocks blocks}))
|
||||
1028
src/main/frontend/worker/db_core.cljs
Normal file
1028
src/main/frontend/worker/db_core.cljs
Normal file
File diff suppressed because it is too large
Load Diff
285
src/main/frontend/worker/db_listener.cljs
Normal file
285
src/main/frontend/worker/db_listener.cljs
Normal file
@@ -0,0 +1,285 @@
|
||||
(ns frontend.worker.db-listener
|
||||
"Db listeners for worker-db."
|
||||
(:require [datascript.core :as d]
|
||||
[frontend.common.thread-api :as thread-api]
|
||||
[frontend.worker.handler.block :as block-handler]
|
||||
[frontend.worker.markdown-mirror :as markdown-mirror]
|
||||
[frontend.worker.pipeline :as worker-pipeline]
|
||||
[frontend.worker.platform :as platform]
|
||||
[frontend.worker.render-delta :as render-delta]
|
||||
[frontend.worker.search :as search]
|
||||
[frontend.worker.shared-service :as shared-service]
|
||||
[frontend.worker.state :as worker-state]
|
||||
[frontend.worker.sync :as db-sync]
|
||||
[lambdaisland.glogi :as log]
|
||||
[promesa.core :as p]))
|
||||
|
||||
(defmulti listen-db-changes
|
||||
(fn [listen-key & _] listen-key))
|
||||
|
||||
(defn- perf-time-ms []
|
||||
(if (and (exists? js/performance)
|
||||
(.-now js/performance))
|
||||
(.now js/performance)
|
||||
(js/Date.now)))
|
||||
|
||||
(defonce ^:private *outliner-op-perf (atom {}))
|
||||
(defonce ^:private *outliner-op-deltas (atom {}))
|
||||
|
||||
(defn take-outliner-op-perf!
|
||||
[perf-id]
|
||||
(let [result (get @*outliner-op-perf perf-id)]
|
||||
(swap! *outliner-op-perf dissoc perf-id)
|
||||
result))
|
||||
|
||||
(defn take-outliner-op-delta!
|
||||
[perf-id]
|
||||
(let [delta (get @*outliner-op-deltas perf-id)]
|
||||
(swap! *outliner-op-deltas dissoc perf-id)
|
||||
delta))
|
||||
|
||||
(defn- log-outliner-op-perf!
|
||||
[data]
|
||||
(when-let [perf-id (and goog.DEBUG (:perf-id data))]
|
||||
(swap! *outliner-op-perf update perf-id (fnil conj []) data)
|
||||
(log/info :db-worker/outliner-op-perf data)))
|
||||
|
||||
(def ^:private renderer-tx-meta-keys
|
||||
[:initial-pages?
|
||||
:end?
|
||||
:client-id
|
||||
:outliner-op
|
||||
:deleted-page
|
||||
:data])
|
||||
|
||||
(defn- renderer-tx-meta
|
||||
[tx-meta]
|
||||
(select-keys tx-meta renderer-tx-meta-keys))
|
||||
|
||||
(defn- publish-render-delta?
|
||||
[tx-meta]
|
||||
(not (or (:rtc-download-graph? tx-meta)
|
||||
(:sync-download-graph? tx-meta)
|
||||
(:skip-validate-db? tx-meta)
|
||||
(:logseq.graph-parser.exporter/new-graph? tx-meta))))
|
||||
|
||||
(defn- tagged-with-ident?
|
||||
[db block ident]
|
||||
(some #(= ident (:db/ident (d/entity db (:v %))))
|
||||
(d/datoms db :eavt (:db/id block) :block/tags)))
|
||||
|
||||
(defn- renderer-route-candidates
|
||||
[db blocks]
|
||||
{:task-route-candidate-ids
|
||||
(into [] (keep #(when (tagged-with-ident? db % :logseq.class/Task)
|
||||
(:db/id %))) blocks)
|
||||
:comment-route-candidate-ids
|
||||
(into [] (keep #(when (tagged-with-ident? db % :logseq.class/Comment)
|
||||
(:db/id %))) blocks)})
|
||||
|
||||
(defn- canonical-replacements
|
||||
[{:keys [db-after tx-data]}]
|
||||
(into {}
|
||||
(comp
|
||||
(filter (fn [datom]
|
||||
(and (:added datom)
|
||||
(= :block/tx-id (:a datom)))))
|
||||
(keep (fn [datom]
|
||||
(when-let [entity (d/entity db-after (:e datom))]
|
||||
(let [block (block-handler/canonical-block db-after entity)]
|
||||
[(:block/uuid block) block])))))
|
||||
tx-data))
|
||||
|
||||
(defn- build-render-delta
|
||||
[repo {:keys [db-after tx-meta] :as tx-report}
|
||||
{:keys [affected-keys deleted-block-uuids]}]
|
||||
(let [blocks (canonical-replacements tx-report)
|
||||
deleted-block-uuids (reduce disj deleted-block-uuids (keys blocks))]
|
||||
(render-delta/build
|
||||
{:graph-id repo
|
||||
:rev (:max-tx db-after)
|
||||
:op-id (:db-sync/tx-id tx-meta)
|
||||
:blocks blocks
|
||||
:deleted-block-uuids deleted-block-uuids
|
||||
:affected-keys (set affected-keys)
|
||||
:tx-report tx-report})))
|
||||
|
||||
(defn- main-thread-sync-result
|
||||
"Build the renderer delta and deferred broadcast data."
|
||||
[repo conn {:keys [tx-meta] :as tx-report}]
|
||||
(when repo (worker-state/set-db-latest-tx-time! repo))
|
||||
(when (publish-render-delta? tx-meta)
|
||||
(let [started-at (perf-time-ms)
|
||||
render-result (worker-pipeline/invoke-hooks
|
||||
conn tx-report (worker-state/get-context))
|
||||
pipeline-at (perf-time-ms)
|
||||
processed-tx-report (:tx-report render-result)
|
||||
delta (when render-result
|
||||
(build-render-delta repo processed-tx-report render-result))
|
||||
delta-at (perf-time-ms)
|
||||
route-candidates (renderer-route-candidates (:db-after processed-tx-report)
|
||||
(:blocks render-result))
|
||||
payload (when delta
|
||||
(merge {:repo repo
|
||||
:tx-meta (renderer-tx-meta tx-meta)
|
||||
:delta delta}
|
||||
(into {} (filter (comp seq val)) route-candidates)))]
|
||||
(when (and delta (:ui/perf-id tx-meta))
|
||||
(swap! *outliner-op-deltas assoc (:ui/perf-id tx-meta) delta))
|
||||
(when payload
|
||||
{:tx-report processed-tx-report
|
||||
:started-at started-at
|
||||
:pipeline-at pipeline-at
|
||||
:delta-at delta-at
|
||||
:payload payload}))))
|
||||
|
||||
(defn- broadcast-main-thread-sync!
|
||||
[{:keys [tx-meta]} {:keys [tx-report started-at pipeline-at delta-at payload]}]
|
||||
(when payload
|
||||
(let [broadcast-at (perf-time-ms)]
|
||||
(shared-service/broadcast-to-clients! :sync-db-changes payload)
|
||||
(log-outliner-op-perf!
|
||||
{:stage :sync-db-to-main-thread
|
||||
:perf-id (:ui/perf-id tx-meta)
|
||||
:outliner-op (:outliner-op tx-meta)
|
||||
:tx-count (count (:tx-data tx-report))
|
||||
:pipeline-ms (- pipeline-at started-at)
|
||||
:delta-ms (- delta-at pipeline-at)
|
||||
:broadcast-ms (- (perf-time-ms) broadcast-at)}))))
|
||||
|
||||
(comment
|
||||
(defmethod listen-db-changes :debug-listen-db-changes
|
||||
[_ {} {:keys [tx-data tx-meta]}]
|
||||
(prn :debug-listen-db-changes)
|
||||
(prn :tx-data tx-data)
|
||||
(prn :tx-meta tx-meta)))
|
||||
|
||||
(defmethod listen-db-changes :db-sync
|
||||
[_ {:keys [repo]} tx-report]
|
||||
(db-sync/handle-local-tx! repo tx-report))
|
||||
|
||||
(defmethod listen-db-changes :markdown-mirror
|
||||
[_ {:keys [repo]} tx-report]
|
||||
(markdown-mirror/<handle-tx-report! repo nil tx-report {:defer? true}))
|
||||
|
||||
(defmethod listen-db-changes :search
|
||||
[_ {:keys [repo]} {:keys [tx-meta] :as tx-report}]
|
||||
(when-not (:from-disk? tx-meta)
|
||||
(p/do!
|
||||
(let [{:keys [blocks-to-remove-set blocks-to-add]}
|
||||
(search/sync-search-indice tx-report
|
||||
{:include-vector-title? (some? (worker-state/get-vector-index repo))})]
|
||||
(when (seq blocks-to-remove-set)
|
||||
((@thread-api/*thread-apis :thread-api/search-delete-blocks)
|
||||
repo
|
||||
blocks-to-remove-set))
|
||||
(when (seq blocks-to-add)
|
||||
((@thread-api/*thread-apis :thread-api/search-upsert-blocks)
|
||||
repo
|
||||
blocks-to-add))))))
|
||||
|
||||
(defn- invoke-listener-handler!
|
||||
[handler-timings k handler-fn opt tx-report]
|
||||
(let [handler-started-at (perf-time-ms)
|
||||
result (handler-fn k opt tx-report)]
|
||||
(swap! handler-timings conj
|
||||
[k (- (perf-time-ms) handler-started-at)])
|
||||
result))
|
||||
|
||||
(defn- report-post-commit-error!
|
||||
[repo tx-meta stage error]
|
||||
(let [data {:repo repo
|
||||
:stage stage
|
||||
:outliner-op (:outliner-op tx-meta)
|
||||
:error error}]
|
||||
(log/error :db-worker/post-commit-handler-failed data)
|
||||
(try
|
||||
(platform/post-message!
|
||||
(platform/current)
|
||||
:capture-error
|
||||
{:error error
|
||||
:payload (dissoc data :error)})
|
||||
(catch :default report-error
|
||||
(log/error :db-worker/report-post-commit-handler-failed
|
||||
{:repo repo
|
||||
:stage stage
|
||||
:error report-error})))))
|
||||
|
||||
(defn- run-post-commit!
|
||||
[repo tx-meta stage f]
|
||||
(try
|
||||
(when-let [result (f)]
|
||||
(when (p/promise? result)
|
||||
(p/catch result
|
||||
(fn [error]
|
||||
(report-post-commit-error!
|
||||
repo tx-meta stage error)))))
|
||||
(catch :default error
|
||||
(report-post-commit-error! repo tx-meta stage error))))
|
||||
|
||||
(defn- run-deferred-handlers!
|
||||
[repo tx-meta handlers handler-timings opt tx-report]
|
||||
(doseq [[k handler-fn] handlers]
|
||||
(run-post-commit!
|
||||
repo tx-meta k
|
||||
#(invoke-listener-handler!
|
||||
handler-timings k handler-fn opt tx-report))))
|
||||
|
||||
(defn- process-committed-tx!
|
||||
[repo conn persist-local-tx-handler deferred-handlers
|
||||
sync-db-to-main-thread? {:keys [tx-data tx-meta] :as tx-report}]
|
||||
(let [started-at (perf-time-ms)]
|
||||
(run-post-commit!
|
||||
repo tx-meta :update-checksum
|
||||
#(db-sync/update-local-sync-checksum! repo tx-report))
|
||||
(let [checksum-at (perf-time-ms)
|
||||
opt {:repo repo}
|
||||
handler-timings (atom [])]
|
||||
(when persist-local-tx-handler
|
||||
(run-post-commit!
|
||||
repo tx-meta :persist-local-tx
|
||||
#(invoke-listener-handler! handler-timings
|
||||
:db-sync
|
||||
persist-local-tx-handler
|
||||
opt
|
||||
tx-report)))
|
||||
(let [persist-at (perf-time-ms)
|
||||
sync-result (when sync-db-to-main-thread?
|
||||
(main-thread-sync-result repo conn tx-report))
|
||||
processed-tx-report (or (:tx-report sync-result) tx-report)
|
||||
sync-main-at (perf-time-ms)]
|
||||
(run-deferred-handlers! repo tx-meta deferred-handlers
|
||||
handler-timings opt processed-tx-report)
|
||||
(when sync-result
|
||||
(broadcast-main-thread-sync! tx-report sync-result))
|
||||
(log-outliner-op-perf!
|
||||
{:stage :db-listener-complete
|
||||
:perf-id (:ui/perf-id tx-meta)
|
||||
:outliner-op (:outliner-op tx-meta)
|
||||
:tx-count (count tx-data)
|
||||
:checksum-ms (- checksum-at started-at)
|
||||
:persist-ms (- persist-at checksum-at)
|
||||
:sync-main-ms (- sync-main-at persist-at)
|
||||
:handlers-ms @handler-timings
|
||||
:total-ms (- (perf-time-ms) started-at)})))))
|
||||
|
||||
(defn listen-db-changes!
|
||||
[repo conn & {:keys [handler-keys]}]
|
||||
(let [handlers (if (seq handler-keys)
|
||||
(select-keys (methods listen-db-changes) handler-keys)
|
||||
(methods listen-db-changes))
|
||||
persist-local-tx-handler (get handlers :db-sync)
|
||||
deferred-handlers (dissoc handlers :db-sync)
|
||||
sync-db-to-main-thread?
|
||||
(or (nil? handler-keys)
|
||||
(contains? (set handler-keys) :sync-db-to-main-thread))]
|
||||
(d/unlisten! conn ::listen-db-changes!)
|
||||
(d/listen! conn ::listen-db-changes!
|
||||
(fn listen-db-changes!-inner
|
||||
[{:keys [tx-data tx-meta] :as tx-report}]
|
||||
(when (and (seq tx-data)
|
||||
(or (:batch-final-tx-report? tx-meta)
|
||||
(not (:batch-tx-report? tx-meta))))
|
||||
(process-committed-tx!
|
||||
repo conn persist-local-tx-handler deferred-handlers
|
||||
sync-db-to-main-thread? tx-report))))))
|
||||
50
src/main/frontend/worker/db_worker.cljs
Normal file
50
src/main/frontend/worker/db_worker.cljs
Normal file
@@ -0,0 +1,50 @@
|
||||
(ns frontend.worker.db-worker
|
||||
"Browser worker entrypoint."
|
||||
(:require ["comlink" :as Comlink]
|
||||
[frontend.common.idb :as idb]
|
||||
[frontend.worker.db-core :as db-core]
|
||||
[frontend.worker.platform.browser :as platform-browser]
|
||||
[frontend.worker.state :as worker-state]
|
||||
[goog.object :as gobj]
|
||||
[lambdaisland.glogi :as log]
|
||||
[lambdaisland.glogi.console :as glogi-console]
|
||||
[logseq.db :as ldb]
|
||||
[promesa.core :as p]))
|
||||
|
||||
(def ^:private worker-bootstrap-loaded-key "__logseq_db_worker_bootstrap_loaded__")
|
||||
|
||||
(defn- ensure-worker-bootstrap!
|
||||
[]
|
||||
(when-not (gobj/get js/self worker-bootstrap-loaded-key)
|
||||
(gobj/set js/self worker-bootstrap-loaded-key true)
|
||||
(.importScripts js/self "worker.js")))
|
||||
|
||||
(ensure-worker-bootstrap!)
|
||||
|
||||
(defn- check-worker-scope!
|
||||
[]
|
||||
(when (or (gobj/get js/self "React")
|
||||
(gobj/get js/self "module$react"))
|
||||
(throw (js/Error. "[db-worker] React is forbidden in worker scope!"))))
|
||||
|
||||
(defn init
|
||||
"web worker entry"
|
||||
[]
|
||||
(let [platform (platform-browser/browser-platform)
|
||||
proxy-object (db-core/init-core! platform)]
|
||||
(idb/start)
|
||||
(glogi-console/install!)
|
||||
(log/set-levels {:glogi/root :info})
|
||||
(log/add-handler worker-state/log-append!)
|
||||
(check-worker-scope!)
|
||||
((get-in platform [:timers :set-interval!])
|
||||
#(.postMessage js/self "keepAliveResponse")
|
||||
(* 1000 25))
|
||||
(Comlink/expose proxy-object)
|
||||
(let [^js wrapped-main-thread* (Comlink/wrap js/self)
|
||||
wrapped-main-thread (fn [qkw & args]
|
||||
(p/let [result (.remoteInvoke wrapped-main-thread*
|
||||
(str (namespace qkw) "/" (name qkw))
|
||||
(ldb/write-transit-str args))]
|
||||
(ldb/read-transit-str result)))]
|
||||
(reset! worker-state/*main-thread wrapped-main-thread))))
|
||||
645
src/main/frontend/worker/db_worker_node.cljs
Normal file
645
src/main/frontend/worker/db_worker_node.cljs
Normal file
@@ -0,0 +1,645 @@
|
||||
(ns frontend.worker.db-worker-node
|
||||
"Node.js daemon entrypoint for db-worker."
|
||||
(:require ["http" :as http]
|
||||
[clojure.string :as string]
|
||||
[frontend.worker.db-core :as db-core]
|
||||
[frontend.worker.db-worker-node-lock :as db-lock]
|
||||
[frontend.worker.platform.node :as platform-node]
|
||||
[frontend.worker.state :as worker-state]
|
||||
[lambdaisland.glogi :as log]
|
||||
[logseq.common.graph-dir :as graph-dir]
|
||||
[logseq.common.version :as build-version]
|
||||
[logseq.cli.root-dir :as root-dir]
|
||||
[logseq.cli.style :as style]
|
||||
[logseq.db :as ldb]
|
||||
[logseq.db-worker.log :as db-worker-log]
|
||||
[logseq.db-worker.server-list :as server-list]
|
||||
[promesa.core :as p]))
|
||||
|
||||
(defonce ^:private *ready? (atom false))
|
||||
(defonce ^:private *sse-clients (atom #{}))
|
||||
(defonce ^:private *lock-info (atom nil))
|
||||
(defonce ^:private *server-list-file (atom nil))
|
||||
|
||||
(defn- server-list-file-path
|
||||
[root-dir]
|
||||
(server-list/path root-dir))
|
||||
|
||||
(def ^:private cors-headers
|
||||
#js {"Access-Control-Allow-Origin" "lsp://logseq.com"
|
||||
"Access-Control-Allow-Methods" "GET,POST,OPTIONS"
|
||||
"Access-Control-Allow-Headers" "Content-Type,Authorization"})
|
||||
|
||||
(defn- response-headers
|
||||
[headers]
|
||||
(js/Object.assign #js {} cors-headers headers))
|
||||
|
||||
(defn- send-no-content!
|
||||
[^js res]
|
||||
(.writeHead res 204 cors-headers)
|
||||
(.end res))
|
||||
|
||||
(defn- send-json!
|
||||
[^js res status payload]
|
||||
(.writeHead res status (response-headers #js {"Content-Type" "application/json"}))
|
||||
(.end res (js/JSON.stringify (clj->js payload))))
|
||||
|
||||
(defn- send-text!
|
||||
[^js res status text]
|
||||
(.writeHead res status (response-headers #js {"Content-Type" "text/plain"}))
|
||||
(.end res text))
|
||||
|
||||
(defn- <read-body-buffer
|
||||
[^js req]
|
||||
(p/create
|
||||
(fn [resolve reject]
|
||||
(let [chunks (array)]
|
||||
(.on req "data" (fn [chunk] (.push chunks chunk)))
|
||||
(.on req "end" (fn []
|
||||
(resolve (js/Buffer.concat chunks))))
|
||||
(.on req "error" reject)))))
|
||||
|
||||
(defn- <read-body
|
||||
[^js req]
|
||||
(p/then (<read-body-buffer req)
|
||||
(fn [buf]
|
||||
(.toString buf "utf8"))))
|
||||
|
||||
(defn- parse-args
|
||||
[argv]
|
||||
(loop [args (vec (drop 2 argv))
|
||||
opts {}]
|
||||
(if (empty? args)
|
||||
opts
|
||||
(let [flag (first args)]
|
||||
(case flag
|
||||
"--root-dir" (recur (subvec args 2) (assoc opts :root-dir (second args)))
|
||||
"--repo" (recur (subvec args 2) (assoc opts :repo (second args)))
|
||||
"--owner-source" (recur (subvec args 2) (assoc opts :owner-source (second args)))
|
||||
"--log-level" (recur (subvec args 2) (assoc opts :log-level (second args)))
|
||||
"--embedding-endpoint" (recur (subvec args 2) (assoc opts :embedding-endpoint (second args)))
|
||||
"--embedding-model-id" (recur (subvec args 2) (assoc opts :embedding-model-id (second args)))
|
||||
"--create-empty-db" (recur (subvec args 1) (assoc opts :create-empty-db? true))
|
||||
"--version" (recur (subvec args 1) (assoc opts :version? true))
|
||||
"--help" (recur (subvec args 1) (assoc opts :help? true))
|
||||
(recur (subvec args 1) opts))))))
|
||||
|
||||
(defn- normalize-owner-source
|
||||
[owner-source]
|
||||
(db-lock/normalize-owner-source owner-source))
|
||||
|
||||
(defn- encode-event-type
|
||||
[type]
|
||||
(cond
|
||||
(keyword? type) (subs (str type) 1)
|
||||
(string? type) type
|
||||
(nil? type) nil
|
||||
:else (str type)))
|
||||
|
||||
(defn- encode-event-payload
|
||||
[payload]
|
||||
(if (string? payload)
|
||||
payload
|
||||
(ldb/write-transit-str payload)))
|
||||
|
||||
(defn- normalize-method-kw
|
||||
[method]
|
||||
(cond
|
||||
(keyword? method) method
|
||||
(string? method) (keyword method)
|
||||
(nil? method) nil
|
||||
:else (keyword (str method))))
|
||||
|
||||
(defn- normalize-method-str
|
||||
[method]
|
||||
(cond
|
||||
(keyword? method) (subs (str method) 1)
|
||||
(string? method) method
|
||||
(nil? method) nil
|
||||
:else (str method)))
|
||||
|
||||
(defn- handle-event!
|
||||
[type payload]
|
||||
(let [event (js/JSON.stringify (clj->js {:type (encode-event-type type)
|
||||
:payload (encode-event-payload payload)}))
|
||||
message (str "data: " event "\n\n")]
|
||||
(doseq [^js res @*sse-clients]
|
||||
(try
|
||||
(.write res message)
|
||||
(catch :default e
|
||||
(log/error :sse-write-failed e))))))
|
||||
|
||||
(defn- sse-handler
|
||||
[^js req ^js res]
|
||||
(.writeHead res 200 (response-headers #js {"Content-Type" "text/event-stream"
|
||||
"Cache-Control" "no-cache"
|
||||
"Connection" "keep-alive"}))
|
||||
(.write res "\n")
|
||||
(swap! *sse-clients conj res)
|
||||
(.on req "close" (fn []
|
||||
(swap! *sse-clients disj res))))
|
||||
|
||||
(defn- <invoke!
|
||||
[^js proxy method-str method-kw args]
|
||||
(let [args-transit (if (string? args)
|
||||
args
|
||||
(ldb/write-transit-str args))
|
||||
started-at (js/Date.now)
|
||||
timeout-id (js/setTimeout
|
||||
(fn []
|
||||
(log/warn :db-worker-node-invoke-timeout
|
||||
{:method (or method-kw method-str)
|
||||
:elapsed-ms (- (js/Date.now) started-at)}))
|
||||
10000)]
|
||||
(-> (p/do! (.remoteInvoke proxy method-str args-transit))
|
||||
(p/finally (fn []
|
||||
(js/clearTimeout timeout-id))))))
|
||||
|
||||
(defn- <invoke-binary!
|
||||
[^js proxy method-str method-kw repo payload]
|
||||
(let [started-at (js/Date.now)
|
||||
timeout-id (js/setTimeout
|
||||
(fn []
|
||||
(log/warn :db-worker-node-invoke-timeout
|
||||
{:method (or method-kw method-str)
|
||||
:elapsed-ms (- (js/Date.now) started-at)}))
|
||||
10000)]
|
||||
(-> (p/do! (.remoteInvokeBinary proxy method-str repo payload))
|
||||
(p/finally (fn []
|
||||
(js/clearTimeout timeout-id))))))
|
||||
|
||||
(defn- <init-worker!
|
||||
[proxy]
|
||||
(let [method-kw :thread-api/init
|
||||
method-str (normalize-method-str method-kw)]
|
||||
(<invoke! proxy method-str method-kw [])))
|
||||
|
||||
(defn- <close-bound-repo!
|
||||
[proxy repo]
|
||||
(if (string/blank? repo)
|
||||
(p/resolved nil)
|
||||
(let [method-kw :thread-api/close-db
|
||||
method-str (normalize-method-str method-kw)]
|
||||
(-> (<invoke! proxy method-str method-kw [repo])
|
||||
(p/catch (fn [error]
|
||||
(log/warn :db-worker-node-close-db-before-stop-failed
|
||||
{:repo repo
|
||||
:error error})
|
||||
nil))))))
|
||||
|
||||
(def ^:private non-repo-methods
|
||||
#{:thread-api/init
|
||||
:thread-api/set-db-sync-config
|
||||
:thread-api/get-db-sync-config
|
||||
:thread-api/db-sync-stop
|
||||
:thread-api/db-sync-list-remote-graphs
|
||||
:thread-api/db-sync-update-presence
|
||||
:thread-api/db-sync-ensure-user-rsa-keys
|
||||
:thread-api/list-db
|
||||
:thread-api/get-version
|
||||
:thread-api/set-context
|
||||
:thread-api/sync-app-state
|
||||
:thread-api/update-thread-atom
|
||||
:thread-api/mobile-logs
|
||||
:thread-api/get-user-rsa-key-pair
|
||||
:thread-api/init-user-rsa-key-pair
|
||||
:thread-api/reset-user-rsa-key-pair
|
||||
:thread-api/change-e2ee-password
|
||||
:thread-api/get-e2ee-password
|
||||
:thread-api/save-e2ee-password
|
||||
:thread-api/verify-and-save-e2ee-password
|
||||
:thread-api/resolve-ui-request
|
||||
:thread-api/reject-ui-request
|
||||
:thread-api/cancel-ui-requests})
|
||||
|
||||
(defn- repo-arg
|
||||
[args]
|
||||
(cond
|
||||
(js/Array.isArray args) (aget args 0)
|
||||
(sequential? args) (first args)
|
||||
:else nil))
|
||||
|
||||
(defn- repo-error
|
||||
[method args bound-repo]
|
||||
(let [method-kw (normalize-method-kw method)]
|
||||
(when-not (contains? non-repo-methods method-kw)
|
||||
(let [repo (repo-arg args)]
|
||||
(cond
|
||||
(or (not (string? repo))
|
||||
(string/blank? repo))
|
||||
{:status 400
|
||||
:error {:code :missing-repo
|
||||
:message "repo is required"}}
|
||||
|
||||
(not (graph-dir/same-repo? repo bound-repo))
|
||||
{:status 409
|
||||
:error {:code :repo-mismatch
|
||||
:message "repo does not match bound repo"
|
||||
:repo repo
|
||||
:bound-repo bound-repo}}
|
||||
|
||||
:else
|
||||
nil)))))
|
||||
|
||||
(defn- set-main-thread-stub!
|
||||
[]
|
||||
(reset! worker-state/*main-thread
|
||||
(fn [qkw & _args]
|
||||
(p/rejected (ex-info "main-thread is not available in db-worker-node"
|
||||
{:method qkw})))))
|
||||
|
||||
(defn- query-validation-error?
|
||||
[data]
|
||||
(= :parser/query (:error data)))
|
||||
|
||||
(defn- notification-validation-error?
|
||||
[data]
|
||||
(= :notification (:type data)))
|
||||
|
||||
(defn- invoke-error-status
|
||||
[data]
|
||||
(cond
|
||||
(query-validation-error? data) 400
|
||||
(notification-validation-error? data) 400
|
||||
(#{:missing-repo :repo-mismatch :repo-locked} (:code data)) 409
|
||||
(number? (:status data)) (:status data)
|
||||
:else 500))
|
||||
|
||||
(defn- invoke-error-code
|
||||
[data]
|
||||
(cond
|
||||
(query-validation-error? data) :invalid-query
|
||||
(:code data) (:code data)
|
||||
(notification-validation-error? data) :validation-error
|
||||
:else :exception))
|
||||
|
||||
(defn- invoke-error-message
|
||||
[error data]
|
||||
(or (get-in data [:payload :message])
|
||||
(.-message error)
|
||||
(str error)))
|
||||
|
||||
(defn- health-payload
|
||||
[{:keys [bound-repo host port owner-source root-dir]}]
|
||||
{:repo bound-repo
|
||||
:status (if @*ready? "ready" "starting")
|
||||
:host host
|
||||
:port (if (satisfies? IDeref port) @port port)
|
||||
:pid (.-pid js/process)
|
||||
:owner-source (name (normalize-owner-source owner-source))
|
||||
:root-dir root-dir
|
||||
:revision (build-version/revision)})
|
||||
|
||||
(defn- log-invoke-error!
|
||||
[res error method-kw]
|
||||
(let [data (ex-data error)
|
||||
status (invoke-error-status data)
|
||||
code (invoke-error-code data)
|
||||
message (invoke-error-message error data)
|
||||
payload {:ok false
|
||||
:error {:code code
|
||||
:message message}}]
|
||||
(log/error :db-worker-node-invoke-failed
|
||||
{:status status
|
||||
:code code
|
||||
:error error
|
||||
:message message
|
||||
:method method-kw})
|
||||
(send-json! res status payload)))
|
||||
|
||||
(defn- make-server
|
||||
[proxy {:keys [bound-repo stop-fn host port owner-source root-dir]}]
|
||||
(http/createServer
|
||||
(fn [^js req ^js res]
|
||||
(let [url (.-url req)
|
||||
parsed-url (js/URL. url "http://127.0.0.1")
|
||||
request-path (.-pathname parsed-url)
|
||||
method (.-method req)]
|
||||
(cond
|
||||
(= method "OPTIONS")
|
||||
(send-no-content! res)
|
||||
|
||||
(= request-path "/healthz")
|
||||
(send-json! res (if @*ready? 200 503)
|
||||
(health-payload {:bound-repo bound-repo
|
||||
:host host
|
||||
:port port
|
||||
:owner-source owner-source
|
||||
:root-dir root-dir}))
|
||||
|
||||
(= request-path "/v1/events")
|
||||
(sse-handler req res)
|
||||
|
||||
(= request-path "/v1/import-db-binary")
|
||||
(if (= method "POST")
|
||||
(let [repo (.get (.-searchParams parsed-url) "repo")
|
||||
method-kw :thread-api/import-db-binary
|
||||
method-str (normalize-method-str method-kw)]
|
||||
(-> (p/let [binary (<read-body-buffer req)
|
||||
args-for-validation [repo binary]]
|
||||
(if-let [{:keys [status error]} (repo-error method-kw args-for-validation bound-repo)]
|
||||
(send-json! res status {:ok false :error error})
|
||||
(p/let [_ (let [{:keys [path lock]} @*lock-info]
|
||||
(db-lock/assert-lock-owner! path lock))
|
||||
result (<invoke-binary! proxy method-str method-kw repo binary)]
|
||||
(send-json! res 200 {:ok true :resultTransit (ldb/write-transit-str result)}))))
|
||||
(p/catch (fn [error]
|
||||
(let [data (ex-data error)
|
||||
status (invoke-error-status data)
|
||||
code (invoke-error-code data)
|
||||
message (invoke-error-message error data)
|
||||
payload {:ok false
|
||||
:error {:code code
|
||||
:message message}}]
|
||||
(log/error :db-worker-node-invoke-failed
|
||||
{:status status
|
||||
:code code
|
||||
:method method-str
|
||||
:error error})
|
||||
(send-json! res status payload))))))
|
||||
(send-text! res 405 "method-not-allowed"))
|
||||
|
||||
(= request-path "/v1/invoke")
|
||||
(if (= method "POST")
|
||||
(->
|
||||
(p/let [body (<read-body req)
|
||||
payload (js/JSON.parse body)
|
||||
{:keys [method argsTransit args]} (js->clj payload :keywordize-keys true)
|
||||
method-kw (normalize-method-kw method)
|
||||
method-str (normalize-method-str method)]
|
||||
(-> (p/let [args' (or argsTransit args)
|
||||
args-for-validation (if (string? args')
|
||||
(ldb/read-transit-str args')
|
||||
args')]
|
||||
(if-let [{:keys [status error]} (repo-error method-kw args-for-validation bound-repo)]
|
||||
(send-json! res status {:ok false :error error})
|
||||
(p/let [_ (when-not (contains? non-repo-methods method-kw)
|
||||
(let [{:keys [path lock]} @*lock-info]
|
||||
(db-lock/assert-lock-owner! path lock)))
|
||||
result (<invoke! proxy method-str method-kw args')]
|
||||
(send-json! res 200 {:ok true :resultTransit result}))))
|
||||
(p/catch (fn [error]
|
||||
(log-invoke-error! res error method-kw)))))
|
||||
(p/catch (fn [error]
|
||||
(log-invoke-error! res error nil))))
|
||||
(send-text! res 405 "method-not-allowed"))
|
||||
|
||||
(= url "/v1/shutdown")
|
||||
(if (= method "POST")
|
||||
(do
|
||||
(send-json! res 200 {:ok true})
|
||||
(js/setTimeout (fn []
|
||||
(when stop-fn
|
||||
(stop-fn)))
|
||||
10))
|
||||
(send-text! res 405 "method-not-allowed"))
|
||||
|
||||
:else
|
||||
(send-text! res 404 "not-found"))))))
|
||||
|
||||
(defn- show-help!
|
||||
[]
|
||||
(println (str (style/bold "db-worker-node") " " (style/bold "options") ":"))
|
||||
(println (str " " (style/bold "--root-dir") " <path> (required)"))
|
||||
(println (str " " (style/bold "--repo") " <name> (required)"))
|
||||
(println (str " " (style/bold "--create-empty-db") " (start with empty initial datoms)"))
|
||||
(println (str " " (style/bold "--embedding-endpoint") " <url>"))
|
||||
(println (str " " (style/bold "--embedding-model-id") " <id>"))
|
||||
(println (str " " (style/bold "--log-level") " <level> (default info)"))
|
||||
(println (str " " (style/bold "--version") " (print build metadata and exit)"))
|
||||
(println " logs: <root-dir>/graphs/<graph-dir>/db-worker-node-YYYYMMDD.log (retains 7)"))
|
||||
|
||||
(defn- startup-db-opts
|
||||
[{:keys [create-empty-db?]}]
|
||||
(if create-empty-db?
|
||||
{:datoms []
|
||||
:sync-download-graph? true}
|
||||
{}))
|
||||
|
||||
(defn- assert-lock-owner!
|
||||
[]
|
||||
(let [{:keys [path lock]} @*lock-info]
|
||||
(db-lock/assert-lock-owner! path lock)))
|
||||
|
||||
(defn- recreate-lock!
|
||||
[target-repo]
|
||||
(p/let [{:keys [path lock]} @*lock-info
|
||||
_ (when-not (and (seq path) lock)
|
||||
(throw (ex-info "lock owner missing"
|
||||
{:code :repo-locked
|
||||
:repo target-repo})))
|
||||
_ (when (and (seq target-repo)
|
||||
(not (graph-dir/same-repo? target-repo (:repo lock))))
|
||||
(throw (ex-info "graph lock repo mismatch"
|
||||
{:code :repo-locked
|
||||
:repo target-repo
|
||||
:bound-repo (:repo lock)})))
|
||||
updated-lock (db-lock/update-lock! path lock)]
|
||||
(swap! *lock-info assoc :lock updated-lock)
|
||||
nil))
|
||||
|
||||
(defn- close-server!
|
||||
[server]
|
||||
(p/create
|
||||
(fn [resolve _]
|
||||
(try
|
||||
(.close server (fn [] (resolve true)))
|
||||
(catch :default _
|
||||
(resolve true))))))
|
||||
|
||||
(defn- clear-runtime-state!
|
||||
[actual-port]
|
||||
(reset! *ready? false)
|
||||
(when-let [file-path @*server-list-file]
|
||||
(server-list/remove-entry! file-path {:pid (.-pid js/process)
|
||||
:port actual-port}))
|
||||
(doseq [^js res @*sse-clients]
|
||||
(try
|
||||
(.end res)
|
||||
(catch :default _)))
|
||||
(reset! *sse-clients #{})
|
||||
(when-let [lock-path (:path @*lock-info)]
|
||||
(db-lock/remove-lock! lock-path)))
|
||||
|
||||
(defn- make-stop!
|
||||
[{:keys [proxy repo actual-port server stopped? on-stopped!]}]
|
||||
(fn []
|
||||
(if @stopped?
|
||||
(p/resolved true)
|
||||
(do
|
||||
(reset! stopped? true)
|
||||
(-> (p/let [_ (<close-bound-repo! proxy repo)]
|
||||
(clear-runtime-state! actual-port)
|
||||
(close-server! server)
|
||||
true)
|
||||
(p/finally
|
||||
(fn []
|
||||
(when (fn? on-stopped!)
|
||||
(on-stopped!))
|
||||
(db-worker-log/uninstall!))))))))
|
||||
|
||||
(defn- resolve-listening-daemon!
|
||||
[{:keys [server proxy repo host port* stop!* stopped? on-stopped!]} resolve]
|
||||
(let [address (.address server)
|
||||
actual-port (if (number? address) address (.-port address))
|
||||
_ (reset! port* actual-port)
|
||||
stop! (make-stop! {:proxy proxy
|
||||
:repo repo
|
||||
:actual-port actual-port
|
||||
:server server
|
||||
:stopped? stopped?
|
||||
:on-stopped! on-stopped!})]
|
||||
(reset! *ready? true)
|
||||
(when-let [file-path @*server-list-file]
|
||||
(server-list/append-entry! file-path {:pid (.-pid js/process)
|
||||
:port actual-port}))
|
||||
(reset! stop!* stop!)
|
||||
(resolve {:host host
|
||||
:port actual-port
|
||||
:server server
|
||||
:stop! stop!})))
|
||||
|
||||
(defn- start-http-server!
|
||||
[{:keys [proxy repo host port owner-source root-dir on-stopped!]}]
|
||||
(let [stop!* (atom nil)
|
||||
stopped? (atom false)
|
||||
port* (atom nil)
|
||||
server (make-server proxy {:bound-repo repo
|
||||
:host host
|
||||
:port port*
|
||||
:owner-source owner-source
|
||||
:root-dir root-dir
|
||||
:stop-fn (fn []
|
||||
(when-let [stop! @stop!*]
|
||||
(stop!)))})]
|
||||
(p/create
|
||||
(fn [resolve reject]
|
||||
(.listen server port host
|
||||
(fn []
|
||||
(resolve-listening-daemon! {:server server
|
||||
:proxy proxy
|
||||
:repo repo
|
||||
:host host
|
||||
:port* port*
|
||||
:stop!* stop!*
|
||||
:stopped? stopped?
|
||||
:owner-source owner-source
|
||||
:root-dir root-dir
|
||||
:on-stopped! on-stopped!}
|
||||
resolve)))
|
||||
(.on server "error" (fn [error]
|
||||
(when-let [lock-path (:path @*lock-info)]
|
||||
(db-lock/remove-lock! lock-path))
|
||||
(reject error)))))))
|
||||
|
||||
(defn start-daemon!
|
||||
[{:keys [root-dir repo log-level owner-source on-stopped!] :as opts}]
|
||||
(let [host "127.0.0.1"
|
||||
port 0
|
||||
owner-source (normalize-owner-source owner-source)]
|
||||
(cond
|
||||
(not (seq root-dir))
|
||||
(p/rejected (ex-info "root-dir is required" {:code :missing-root-dir}))
|
||||
|
||||
(not (seq repo))
|
||||
(p/rejected (ex-info "repo is required" {:code :missing-repo}))
|
||||
|
||||
:else
|
||||
(try
|
||||
(let [root-dir (root-dir/ensure-root-dir! root-dir)
|
||||
server-list-file (server-list-file-path root-dir)]
|
||||
(db-worker-log/install! {:root-dir root-dir
|
||||
:repo repo
|
||||
:log-level (keyword (or log-level "info"))})
|
||||
(log/info :db-worker-node-version {:build-time (build-version/build-time)
|
||||
:revision (build-version/revision)})
|
||||
(reset! *ready? false)
|
||||
(reset! *lock-info nil)
|
||||
(reset! *server-list-file server-list-file)
|
||||
(set-main-thread-stub!)
|
||||
(-> (p/let [platform (platform-node/node-platform {:root-dir root-dir
|
||||
:event-fn handle-event!
|
||||
:write-guard-fn assert-lock-owner!
|
||||
:owner-source owner-source
|
||||
:recreate-lock-fn recreate-lock!
|
||||
:embedding-endpoint (:embedding-endpoint opts)
|
||||
:embedding-model-id (:embedding-model-id opts)})
|
||||
proxy (db-core/init-core! platform)
|
||||
_ (<init-worker! proxy)
|
||||
{:keys [path lock]} (db-lock/ensure-lock! {:root-dir root-dir
|
||||
:repo repo
|
||||
:owner-source owner-source})
|
||||
_ (reset! *lock-info {:path path :lock lock})
|
||||
_ (let [method-kw :thread-api/create-or-open-db
|
||||
method-str (normalize-method-str method-kw)]
|
||||
(<invoke! proxy method-str method-kw [repo (startup-db-opts opts)]))]
|
||||
(start-http-server! {:proxy proxy
|
||||
:repo repo
|
||||
:host host
|
||||
:port port
|
||||
:owner-source owner-source
|
||||
:root-dir root-dir
|
||||
:on-stopped! on-stopped!}))
|
||||
(p/catch (fn [e]
|
||||
(when-let [lock-path (:path @*lock-info)]
|
||||
(db-lock/remove-lock! lock-path))
|
||||
(throw e)))))
|
||||
(catch :default e
|
||||
(p/rejected e))))))
|
||||
|
||||
(defn main
|
||||
[]
|
||||
(let [{:keys [root-dir repo help? version? owner-source] :as opts}
|
||||
(parse-args (.-argv js/process))]
|
||||
(when help?
|
||||
(show-help!)
|
||||
(.exit js/process 0))
|
||||
(when version?
|
||||
(println (build-version/format-version))
|
||||
(.exit js/process 0))
|
||||
(when-not (seq root-dir)
|
||||
(.error js/console "root-dir is required")
|
||||
(.exit js/process 1))
|
||||
(when-not (seq repo)
|
||||
(.error js/console "repo is required")
|
||||
(.exit js/process 1))
|
||||
(-> (p/let [{:keys [stop!] :as daemon}
|
||||
(start-daemon! {:root-dir root-dir
|
||||
:repo repo
|
||||
:create-empty-db? (:create-empty-db? opts)
|
||||
:owner-source owner-source
|
||||
:embedding-endpoint (:embedding-endpoint opts)
|
||||
:embedding-model-id (:embedding-model-id opts)
|
||||
:on-stopped! (fn []
|
||||
(log/info :db-worker-node-stopped nil)
|
||||
(.exit js/process 0))
|
||||
:log-level (:log-level opts)})]
|
||||
(log/info :db-worker-node-ready {:host (:host daemon) :port (:port daemon)})
|
||||
(let [shutdown (fn [] (stop!))]
|
||||
(.on js/process "SIGINT" shutdown)
|
||||
(.on js/process "SIGTERM" shutdown)))
|
||||
(p/catch (fn [error]
|
||||
(let [data (ex-data error)
|
||||
code (:code data)
|
||||
message (or (.-message error) (str error))]
|
||||
(cond
|
||||
(#{:missing-root-dir :root-dir-permission} code)
|
||||
(.error js/console message)
|
||||
|
||||
(or (string/includes? message ".node")
|
||||
(string/includes? message "Cannot find module")
|
||||
(string/includes? message "MODULE_NOT_FOUND")
|
||||
(string/includes? message "bindings file"))
|
||||
(.error js/console
|
||||
(str "db-worker-node failed to start: bundled runtime files are missing or incomplete. "
|
||||
"Rebuild with `pnpm db-worker-node:release:bundle` and ensure "
|
||||
"`dist/db-worker-node.js` exists and assets listed in "
|
||||
"`dist/db-worker-node-assets.json` are next to it. "
|
||||
"Root error: "
|
||||
message))
|
||||
|
||||
:else
|
||||
(.error js/console (str "db-worker-node failed to start: " message)))
|
||||
(when-let [stack (.-stack error)]
|
||||
(.error js/console stack))
|
||||
(.exit js/process 1)))))))
|
||||
193
src/main/frontend/worker/db_worker_node_lock.cljs
Normal file
193
src/main/frontend/worker/db_worker_node_lock.cljs
Normal file
@@ -0,0 +1,193 @@
|
||||
(ns frontend.worker.db-worker-node-lock
|
||||
"Lock file helpers for db-worker-node."
|
||||
(:require ["fs" :as fs]
|
||||
["os" :as os]
|
||||
["path" :as node-path]
|
||||
[clojure.string :as string]
|
||||
[frontend.worker-common.util :as worker-util]
|
||||
[lambdaisland.glogi :as log]
|
||||
[logseq.common.graph-dir :as graph-dir]
|
||||
[logseq.common.config :as common-config]
|
||||
[promesa.core :as p]))
|
||||
|
||||
(defn- expand-home
|
||||
[path]
|
||||
(if (string/starts-with? path "~")
|
||||
(node-path/join (.homedir os) (subs path 1))
|
||||
path))
|
||||
|
||||
(defn resolve-root-dir
|
||||
[root-dir]
|
||||
(expand-home (or root-dir (node-path/join (.homedir os) "logseq"))))
|
||||
|
||||
(defn graphs-dir
|
||||
[root-dir]
|
||||
(node-path/join (resolve-root-dir root-dir) "graphs"))
|
||||
|
||||
(defn repo->graph-dir-key
|
||||
[repo]
|
||||
(graph-dir/repo->graph-dir-key repo))
|
||||
|
||||
(defn canonical-graph-dir-key?
|
||||
[graph-dir-key]
|
||||
(and (seq graph-dir-key)
|
||||
(not (string/starts-with? graph-dir-key common-config/db-version-prefix))))
|
||||
|
||||
(defn decode-canonical-graph-dir-key
|
||||
[encoded-graph-dir-key]
|
||||
(let [decoded (worker-util/decode-graph-dir-name encoded-graph-dir-key)]
|
||||
(when (canonical-graph-dir-key? decoded)
|
||||
decoded)))
|
||||
|
||||
(defn repo-dir
|
||||
[graphs-root repo]
|
||||
(node-path/join graphs-root (worker-util/encode-graph-dir-name (repo->graph-dir-key repo))))
|
||||
|
||||
(defn lock-path
|
||||
[root-dir repo]
|
||||
(node-path/join (repo-dir (graphs-dir root-dir) repo) "db-worker.lock"))
|
||||
|
||||
(defn- pid-status
|
||||
[pid]
|
||||
(when (number? pid)
|
||||
(try
|
||||
(.kill js/process pid 0)
|
||||
:alive
|
||||
(catch :default e
|
||||
(case (.-code e)
|
||||
"ESRCH" :not-found
|
||||
"EPERM" :no-permission
|
||||
:error)))))
|
||||
|
||||
(def ^:private valid-owner-sources
|
||||
#{:cli :electron :unknown})
|
||||
|
||||
(defn normalize-owner-source
|
||||
[owner-source]
|
||||
(let [owner-source (cond
|
||||
(keyword? owner-source) owner-source
|
||||
(string? owner-source) (keyword owner-source)
|
||||
:else :unknown)]
|
||||
(if (contains? valid-owner-sources owner-source)
|
||||
owner-source
|
||||
:unknown)))
|
||||
|
||||
(defn- normalize-lock
|
||||
[lock]
|
||||
(when lock
|
||||
(assoc lock :owner-source (normalize-owner-source (:owner-source lock)))))
|
||||
|
||||
(defn read-lock
|
||||
[path]
|
||||
(when (and (seq path) (fs/existsSync path))
|
||||
(normalize-lock
|
||||
(js->clj (js/JSON.parse (.toString (fs/readFileSync path) "utf8"))
|
||||
:keywordize-keys true))))
|
||||
|
||||
(defn remove-lock!
|
||||
[path]
|
||||
(when (and (seq path) (fs/existsSync path))
|
||||
(fs/unlinkSync path)))
|
||||
|
||||
(defn create-lock!
|
||||
[{:keys [root-dir repo owner-source]}]
|
||||
(p/create
|
||||
(fn [resolve reject]
|
||||
(try
|
||||
(let [root-dir (resolve-root-dir root-dir)
|
||||
path (lock-path root-dir repo)
|
||||
existing (read-lock path)]
|
||||
(when (and existing (contains? #{:alive :no-permission} (pid-status (:pid existing))))
|
||||
(throw (ex-info "graph already locked" {:code :repo-locked :lock existing})))
|
||||
(when (and existing (= :not-found (pid-status (:pid existing))))
|
||||
(remove-lock! path))
|
||||
(fs/mkdirSync (node-path/dirname path) #js {:recursive true})
|
||||
(let [fd (fs/openSync path "wx")
|
||||
lock {:repo repo
|
||||
:pid (.-pid js/process)
|
||||
:lock-id (str (random-uuid))
|
||||
:owner-source (normalize-owner-source owner-source)}]
|
||||
(try
|
||||
(fs/writeFileSync fd (js/JSON.stringify (clj->js lock)))
|
||||
(finally
|
||||
(fs/closeSync fd)))
|
||||
(resolve lock)))
|
||||
(catch :default e
|
||||
(log/error :db-worker-node-lock-create-failed e)
|
||||
(reject e))))))
|
||||
|
||||
(defn update-lock!
|
||||
[path lock]
|
||||
(p/create
|
||||
(fn [resolve reject]
|
||||
(try
|
||||
(let [existing (read-lock path)
|
||||
lock' (if existing
|
||||
{:repo (:repo existing)
|
||||
:pid (:pid existing)
|
||||
:lock-id (or (:lock-id existing) (:lock-id lock))
|
||||
:owner-source (normalize-owner-source (:owner-source existing))}
|
||||
{:repo (:repo lock)
|
||||
:pid (:pid lock)
|
||||
:lock-id (:lock-id lock)
|
||||
:owner-source (normalize-owner-source (:owner-source lock))})]
|
||||
(fs/mkdirSync (node-path/dirname path) #js {:recursive true})
|
||||
(fs/writeFileSync path (js/JSON.stringify (clj->js lock')))
|
||||
(resolve lock'))
|
||||
(catch :default e
|
||||
(log/error :db-worker-node-lock-update-failed e)
|
||||
(reject e))))))
|
||||
|
||||
(defn assert-lock-owner!
|
||||
[path {:keys [repo pid lock-id] :as owner-lock}]
|
||||
(let [lock (read-lock path)]
|
||||
(cond
|
||||
(nil? owner-lock)
|
||||
(throw (ex-info "lock owner missing"
|
||||
{:code :repo-locked
|
||||
:path path}))
|
||||
|
||||
(nil? lock)
|
||||
(throw (ex-info "graph lock missing"
|
||||
{:code :repo-locked
|
||||
:path path}))
|
||||
|
||||
(not= :alive (pid-status (:pid lock)))
|
||||
(throw (ex-info "graph lock is stale"
|
||||
{:code :repo-locked
|
||||
:path path
|
||||
:lock lock}))
|
||||
|
||||
(not (graph-dir/same-repo? repo (:repo lock)))
|
||||
(throw (ex-info "graph lock repo mismatch"
|
||||
{:code :repo-locked
|
||||
:path path
|
||||
:lock lock
|
||||
:owner owner-lock}))
|
||||
|
||||
(not= pid (:pid lock))
|
||||
(throw (ex-info "graph lock pid mismatch"
|
||||
{:code :repo-locked
|
||||
:path path
|
||||
:lock lock
|
||||
:owner owner-lock}))
|
||||
|
||||
(not= lock-id (:lock-id lock))
|
||||
(throw (ex-info "graph lock-id mismatch"
|
||||
{:code :repo-locked
|
||||
:path path
|
||||
:lock lock
|
||||
:owner owner-lock}))
|
||||
|
||||
:else
|
||||
lock)))
|
||||
|
||||
(defn ensure-lock!
|
||||
[{:keys [root-dir repo owner-source]}]
|
||||
(let [root-dir (resolve-root-dir root-dir)
|
||||
path (lock-path root-dir repo)]
|
||||
(p/let [lock (create-lock! {:root-dir root-dir
|
||||
:repo repo
|
||||
:owner-source owner-source})]
|
||||
{:path path
|
||||
:lock lock})))
|
||||
24
src/main/frontend/worker/debug.cljs
Normal file
24
src/main/frontend/worker/debug.cljs
Normal file
@@ -0,0 +1,24 @@
|
||||
(ns frontend.worker.debug
|
||||
"For debug usage"
|
||||
(:require [datascript.core :as d]
|
||||
[frontend.worker.state :as worker-state]))
|
||||
|
||||
(defn get-conn
|
||||
"Get current db conn"
|
||||
[]
|
||||
(worker-state/get-datascript-conn (worker-state/get-current-repo)))
|
||||
|
||||
(defn get-db
|
||||
"Get current db"
|
||||
[]
|
||||
(some-> (get-conn) deref))
|
||||
|
||||
#_{:clojure-lsp/ignore [:clojure-lsp/unused-public-var]}
|
||||
(defn pull
|
||||
[eid]
|
||||
(some-> (get-db) (d/pull '[*] eid)))
|
||||
|
||||
#_{:clojure-lsp/ignore [:clojure-lsp/unused-public-var]}
|
||||
(defn entity
|
||||
[eid]
|
||||
(some-> (get-db) (d/entity eid)))
|
||||
144
src/main/frontend/worker/export.cljs
Normal file
144
src/main/frontend/worker/export.cljs
Normal file
@@ -0,0 +1,144 @@
|
||||
(ns frontend.worker.export
|
||||
"Export data"
|
||||
(:require [clojure.string :as string]
|
||||
[datascript.core :as d]
|
||||
[frontend.handler.export.common-impl :as common-impl]
|
||||
[frontend.handler.export.text-impl :as export-text]
|
||||
[logseq.common.export.file :as common-file]
|
||||
[logseq.common.util :as common-util]
|
||||
[logseq.db :as ldb]
|
||||
[logseq.graph-parser.mldoc :as gp-mldoc]
|
||||
[logseq.outliner.tree :as otree]))
|
||||
|
||||
(def get-all-page->content common-file/get-all-page->content)
|
||||
|
||||
(defn- block-content
|
||||
[db root-block-uuid opts content-config]
|
||||
(common-file/block->content db root-block-uuid opts content-config))
|
||||
|
||||
(defn- remove-collapsed-descendants
|
||||
[tree]
|
||||
(mapv
|
||||
(fn [node]
|
||||
(let [children (:block/children node)]
|
||||
(cond
|
||||
(and (:block/collapsed? node) (seq children))
|
||||
(dissoc node :block/children)
|
||||
|
||||
(seq children)
|
||||
(assoc node :block/children (remove-collapsed-descendants children))
|
||||
|
||||
:else
|
||||
node)))
|
||||
tree))
|
||||
|
||||
(defn- content->ast
|
||||
[content]
|
||||
(when content
|
||||
(->> (gp-mldoc/->db-edn content :markdown)
|
||||
(mapv common-impl/remove-block-ast-pos)
|
||||
(remove common-impl/Properties-block-ast?)
|
||||
vec)))
|
||||
|
||||
(defn- block-children-content
|
||||
[db root-block-uuid {:keys [init-level open-blocks-only? include-properties?]
|
||||
:or {init-level 1}} content-config]
|
||||
(let [block (first (ldb/get-block-and-children db root-block-uuid))
|
||||
link (:block/link block)
|
||||
block' (or link block)
|
||||
root-id (:block/uuid block')
|
||||
blocks (ldb/get-block-and-children db root-id)
|
||||
tree (otree/blocks->vec-tree db blocks root-id {:link link})
|
||||
tree (if open-blocks-only?
|
||||
(remove-collapsed-descendants tree)
|
||||
tree)]
|
||||
(common-file/tree->file-content db tree
|
||||
{:init-level init-level
|
||||
:include-properties? include-properties?
|
||||
:link link}
|
||||
content-config)))
|
||||
|
||||
(defn- block-ast
|
||||
[db block-uuid content-config]
|
||||
(let [block (some-> (first (ldb/get-block-and-children db block-uuid)) (into {}))
|
||||
content (common-file/tree->file-content db [block] {:init-level 1} content-config)]
|
||||
(content->ast content)))
|
||||
|
||||
(defn- block-children-ast
|
||||
[db block-uuid content-config]
|
||||
(content->ast (block-children-content db block-uuid nil content-config)))
|
||||
|
||||
(defn- page-ast
|
||||
[db page-name content-config]
|
||||
(when-let [page (ldb/get-page db page-name)]
|
||||
(content->ast (block-content db (:block/uuid page) nil content-config))))
|
||||
|
||||
(defn- root-blocks-content
|
||||
[db root-block-uuids opts content-config]
|
||||
(->> root-block-uuids
|
||||
(mapv #(block-content db % opts content-config))
|
||||
(mapv string/trim-newline)
|
||||
(string/join "\n")))
|
||||
|
||||
(defn get-blocks-export-data
|
||||
[db root-block-uuids-or-page-uuid opts content-config]
|
||||
(let [root-block-uuids (if (coll? root-block-uuids-or-page-uuid)
|
||||
root-block-uuids-or-page-uuid
|
||||
[root-block-uuids-or-page-uuid])
|
||||
blocks (mapv #(d/entity db [:block/uuid %]) root-block-uuids)
|
||||
all-pages? (every? ldb/page? blocks)
|
||||
single-page? (and (= 1 (count blocks)) all-pages?)
|
||||
content (cond
|
||||
single-page?
|
||||
(block-content db (first root-block-uuids) opts content-config)
|
||||
|
||||
all-pages?
|
||||
(->> blocks (map :block/title) (string/join "\n"))
|
||||
|
||||
:else
|
||||
(root-blocks-content db root-block-uuids opts content-config))
|
||||
first-block (first blocks)]
|
||||
{:content content
|
||||
:format (get first-block :block/format :markdown)
|
||||
:title (if (and (uuid? root-block-uuids-or-page-uuid) first-block)
|
||||
(:block/title first-block)
|
||||
"untitled")}))
|
||||
|
||||
(defn export-blocks-as-format
|
||||
[db root-block-uuids-or-page-uuid format-type options content-config]
|
||||
(let [remove-options (set (:remove-options options))
|
||||
include-properties? (not (contains? remove-options :property))
|
||||
open-blocks-only? (boolean (get-in options [:other-options :open-blocks-only]))
|
||||
{:keys [content format]} (get-blocks-export-data
|
||||
db
|
||||
root-block-uuids-or-page-uuid
|
||||
{:open-blocks-only? open-blocks-only?
|
||||
:include-properties? include-properties?}
|
||||
content-config)]
|
||||
(binding [common-impl/*block-ast-resolver* #(block-ast db % content-config)
|
||||
common-impl/*block-children-ast-resolver* #(block-children-ast db % content-config)
|
||||
common-impl/*page-ast-resolver* #(page-ast db % content-config)]
|
||||
(case format-type
|
||||
:markdown (export-text/export-helper content format options)
|
||||
(throw (ex-info "Unsupported worker export format"
|
||||
{:format-type format-type
|
||||
:message "Use :thread-api/export-get-blocks-data and format outside the DB worker."}))))))
|
||||
|
||||
(defn get-debug-datoms
|
||||
[conn]
|
||||
(some->> (d/datoms @conn :eavt)
|
||||
(keep (fn [{:keys [e a v t]}]
|
||||
(cond
|
||||
(and (= a :block/title) (common-util/url? v))
|
||||
(d/datom e a "https://logseq.com/debug" t)
|
||||
|
||||
(and (contains? #{:block/title :block/name} a)
|
||||
(let [entity (d/entity @conn e)]
|
||||
(and (not (:db/ident entity))
|
||||
(not (ldb/journal? entity))
|
||||
(not (:logseq.property/built-in? entity))
|
||||
(not (= :logseq.property/query (:db/ident (:logseq.property/created-from-property entity)))))))
|
||||
(d/datom e a (str "debug " e " " (apply str (repeat (count v) "x"))) t)
|
||||
|
||||
:else
|
||||
(d/datom e a v t))))))
|
||||
8
src/main/frontend/worker/graph_dir.cljs
Normal file
8
src/main/frontend/worker/graph_dir.cljs
Normal file
@@ -0,0 +1,8 @@
|
||||
(ns frontend.worker.graph-dir
|
||||
"Compatibility wrapper around `logseq.common.graph-dir`."
|
||||
(:require [logseq.common.graph-dir :as common-graph-dir]))
|
||||
|
||||
(def repo->graph-dir-key common-graph-dir/repo->graph-dir-key)
|
||||
(def repo->encoded-graph-dir-name common-graph-dir/repo->encoded-graph-dir-name)
|
||||
(def decode-graph-dir-name common-graph-dir/decode-graph-dir-name)
|
||||
(def decode-legacy-graph-dir-name common-graph-dir/decode-legacy-graph-dir-name)
|
||||
1049
src/main/frontend/worker/graph_view.cljs
Normal file
1049
src/main/frontend/worker/graph_view.cljs
Normal file
File diff suppressed because it is too large
Load Diff
542
src/main/frontend/worker/handler/block.cljs
Normal file
542
src/main/frontend/worker/handler/block.cljs
Normal file
@@ -0,0 +1,542 @@
|
||||
(ns frontend.worker.handler.block
|
||||
"Block loading, hierarchy, and reference operations."
|
||||
(:require
|
||||
[clojure.string :as string]
|
||||
[datascript.core :as d]
|
||||
[frontend.common.thread-api :refer [def-thread-api]]
|
||||
[frontend.worker.handler.block-breadcrumb :as block-breadcrumb]
|
||||
[frontend.worker.handler.comments :as comments-handler]
|
||||
[frontend.worker.handler.property :as property-handler]
|
||||
[frontend.worker.handler.query :as query-handler]
|
||||
[frontend.worker.handler.search :as search-handler]
|
||||
[frontend.worker.plain-value :as worker-plain]
|
||||
[frontend.worker.state :as worker-state]
|
||||
[frontend.worker.sync.client-op :as client-op]
|
||||
[logseq.common.util :as common-util]
|
||||
[logseq.db :as ldb]
|
||||
[logseq.db.common.initial-data :as common-initial-data]
|
||||
[logseq.db.common.reference :as db-reference]))
|
||||
|
||||
(defn- resolve-block-entity
|
||||
[db id-or-page-name]
|
||||
(let [eid (cond
|
||||
(uuid? id-or-page-name)
|
||||
[:block/uuid id-or-page-name]
|
||||
|
||||
(integer? id-or-page-name)
|
||||
id-or-page-name
|
||||
|
||||
(keyword? id-or-page-name)
|
||||
id-or-page-name
|
||||
|
||||
:else
|
||||
nil)]
|
||||
(cond
|
||||
eid
|
||||
(d/entity db eid)
|
||||
|
||||
(string? id-or-page-name)
|
||||
(if (common-util/uuid-string? id-or-page-name)
|
||||
(d/entity db [:block/uuid (uuid id-or-page-name)])
|
||||
(d/entity db (common-initial-data/get-first-page-by-name db (name id-or-page-name))))
|
||||
|
||||
:else
|
||||
nil)))
|
||||
|
||||
(defn- block-has-children?
|
||||
[db block-id]
|
||||
(some? (first (d/datoms db :avet :block/parent block-id))))
|
||||
|
||||
(def ^:private canonical-block-excluded-attrs
|
||||
#{:block/children
|
||||
:block/properties
|
||||
:block/properties-text-values})
|
||||
|
||||
(defn- valid-revision?
|
||||
[value]
|
||||
(and (integer? value) (not (neg? value))))
|
||||
|
||||
(defn- fail-render-read!
|
||||
[message data]
|
||||
(throw (ex-info message data)))
|
||||
|
||||
(defn- render-basis-rev
|
||||
[db]
|
||||
(let [basis-rev (:max-tx db)]
|
||||
(when-not (valid-revision? basis-rev)
|
||||
(fail-render-read! "Invalid renderer basis revision"
|
||||
{:basis-rev basis-rev}))
|
||||
basis-rev))
|
||||
|
||||
(defn- render-attr-schema
|
||||
[db attr]
|
||||
(or (get (d/schema db) attr)
|
||||
(when-let [attr-entity (d/entity db attr)]
|
||||
(select-keys attr-entity [:db/valueType :db/cardinality]))))
|
||||
|
||||
(defn- canonical-attr?
|
||||
[attr]
|
||||
(and (not (contains? canonical-block-excluded-attrs attr))
|
||||
(not= "block.temp" (namespace attr))))
|
||||
|
||||
(defn- canonical-positioned-properties-map
|
||||
[db block]
|
||||
(if (seq (property-handler/direct-block-property-ids db (:db/id block)))
|
||||
(->> property-handler/render-property-positions
|
||||
(keep (fn [position]
|
||||
(let [property-uuids
|
||||
(mapv :block/uuid
|
||||
(property-handler/block-positioned-properties
|
||||
db (:db/id block) position))]
|
||||
(when (seq property-uuids)
|
||||
[position property-uuids]))))
|
||||
(into {}))
|
||||
{}))
|
||||
|
||||
(declare block-refs-count)
|
||||
|
||||
(defn canonical-block
|
||||
[db entity]
|
||||
(let [entity-id (:db/id entity)
|
||||
block-uuid (:block/uuid entity)
|
||||
block-tx-id (:block/tx-id entity)
|
||||
raw-title (:block/raw-title entity)
|
||||
display-title (:block/title entity)
|
||||
order-list-type (worker-plain/order-list-type entity)]
|
||||
(when-not (integer? entity-id)
|
||||
(fail-render-read! "Invalid canonical block entity"
|
||||
{:db-id entity-id}))
|
||||
(when-not (uuid? block-uuid)
|
||||
(fail-render-read! "Invalid canonical block UUID"
|
||||
{:db-id entity-id :block-uuid block-uuid}))
|
||||
(when-not (valid-revision? block-tx-id)
|
||||
(fail-render-read! "Invalid canonical block transaction ID"
|
||||
{:db-id entity-id
|
||||
:block-uuid block-uuid
|
||||
:block-title display-title
|
||||
:block-tx-id block-tx-id}))
|
||||
(let [block
|
||||
(reduce
|
||||
(fn [result {:keys [a v]}]
|
||||
(if (canonical-attr? a)
|
||||
(let [{value-type :db/valueType
|
||||
cardinality :db/cardinality} (render-attr-schema db a)
|
||||
value (if (= :db.type/ref value-type)
|
||||
(block-breadcrumb/shallow-ref-identity db v)
|
||||
v)]
|
||||
(if (= :db.cardinality/many cardinality)
|
||||
(update result a (fnil conj []) value)
|
||||
(assoc result a value)))
|
||||
result))
|
||||
{:db/id entity-id}
|
||||
(d/datoms db :eavt entity-id))
|
||||
block (if (ldb/property? entity)
|
||||
(merge block
|
||||
(property-handler/display-property-map db entity-id))
|
||||
block)]
|
||||
(cond-> (assoc block
|
||||
:block.temp/positioned-properties
|
||||
(canonical-positioned-properties-map db entity)
|
||||
:block.temp/breadcrumb
|
||||
(block-breadcrumb/block-breadcrumb db entity)
|
||||
:block.temp/refs-count
|
||||
(block-refs-count db entity-id))
|
||||
(string? raw-title)
|
||||
(assoc :block/raw-title raw-title)
|
||||
|
||||
(string? display-title)
|
||||
(assoc :block/title display-title)
|
||||
|
||||
order-list-type
|
||||
(assoc :block.temp/order-list-index
|
||||
(worker-plain/order-list-index entity order-list-type))))))
|
||||
|
||||
(defn canonical-blocks
|
||||
[db block-uuids]
|
||||
(doseq [block-uuid block-uuids]
|
||||
(when-not (uuid? block-uuid)
|
||||
(fail-render-read! "Invalid canonical block UUID"
|
||||
{:block-uuid block-uuid})))
|
||||
(let [requested (keep #(d/entity db [:block/uuid %]) block-uuids)
|
||||
dependencies
|
||||
(fn [block]
|
||||
(let [positioned-properties
|
||||
(->> property-handler/render-property-positions
|
||||
(mapcat #(property-handler/block-positioned-properties
|
||||
db (:db/id block) %))
|
||||
(keep #(d/entity db (:db/ident %))))]
|
||||
(distinct (concat [block] (:block/refs block) positioned-properties))))
|
||||
dependencies-by-root
|
||||
(into {}
|
||||
(map (fn [block]
|
||||
[(:block/uuid block) (vec (dependencies block))]))
|
||||
requested)
|
||||
groups (into {}
|
||||
(map (fn [[block-uuid entities]]
|
||||
[block-uuid (into #{} (keep :block/uuid) entities)]))
|
||||
dependencies-by-root)
|
||||
entities (distinct (mapcat val dependencies-by-root))]
|
||||
{:basis-rev (render-basis-rev db)
|
||||
:groups groups
|
||||
:blocks
|
||||
(into {}
|
||||
(map (fn [entity]
|
||||
(let [block (canonical-block db entity)]
|
||||
[(:block/uuid block) block])))
|
||||
entities)}))
|
||||
|
||||
(defn direct-children-membership
|
||||
[db parent-uuid]
|
||||
(when-not (uuid? parent-uuid)
|
||||
(fail-render-read! "Invalid direct-children parent UUID"
|
||||
{:parent-uuid parent-uuid}))
|
||||
(let [parent (d/entity db [:block/uuid parent-uuid])
|
||||
parent-id (:db/id parent)
|
||||
parent-tx-id (:block/tx-id parent)]
|
||||
(when-not parent
|
||||
(fail-render-read! "Missing direct-children parent"
|
||||
{:parent-uuid parent-uuid}))
|
||||
(when-not (valid-revision? parent-tx-id)
|
||||
(fail-render-read! "Invalid direct-children parent transaction ID"
|
||||
{:parent-uuid parent-uuid
|
||||
:block-tx-id parent-tx-id}))
|
||||
{:basis-rev (render-basis-rev db)
|
||||
:parent-tx-id parent-tx-id
|
||||
:items
|
||||
(->> (d/datoms db :avet :block/parent parent-id)
|
||||
(map #(d/entity db (:e %)))
|
||||
(remove #(or (ldb/recycled? %)
|
||||
(ldb/closed-value? %)
|
||||
(:logseq.property/created-from-property %)))
|
||||
(map (fn [child]
|
||||
(let [child-uuid (:block/uuid child)
|
||||
order (:block/order child)]
|
||||
(when-not (uuid? child-uuid)
|
||||
(fail-render-read! "Invalid direct-child UUID"
|
||||
{:parent-uuid parent-uuid
|
||||
:block-uuid child-uuid}))
|
||||
(when-not (string? order)
|
||||
(fail-render-read! "Invalid direct-child order"
|
||||
{:parent-uuid parent-uuid
|
||||
:block-uuid child-uuid
|
||||
:block-order order}))
|
||||
[child-uuid order])))
|
||||
(sort-by second)
|
||||
vec)}))
|
||||
|
||||
(defn open-block-tree
|
||||
[db root-uuid]
|
||||
(loop [pending [root-uuid]
|
||||
seen #{}
|
||||
block-uuids #{root-uuid}
|
||||
children {}]
|
||||
(if-let [parent-uuid (peek pending)]
|
||||
(let [pending (pop pending)]
|
||||
(if (contains? seen parent-uuid)
|
||||
(recur pending seen block-uuids children)
|
||||
(let [membership (direct-children-membership db parent-uuid)
|
||||
child-uuids (mapv first (:items membership))
|
||||
open-child-uuids
|
||||
(remove #(true? (:block/collapsed?
|
||||
(d/entity db [:block/uuid %])))
|
||||
child-uuids)]
|
||||
(recur (into pending open-child-uuids)
|
||||
(conj seen parent-uuid)
|
||||
(into block-uuids child-uuids)
|
||||
(assoc children parent-uuid
|
||||
(dissoc membership :basis-rev))))))
|
||||
(let [blocks (:blocks (canonical-blocks db (vec block-uuids)))
|
||||
root-membership (get children root-uuid)]
|
||||
(assoc root-membership
|
||||
:blocks (select-keys blocks block-uuids)
|
||||
:children children)))))
|
||||
|
||||
(def ^:private block-children-limit 100)
|
||||
|
||||
(defn- direct-child-blocks
|
||||
([db block-id]
|
||||
(direct-child-blocks db block-id false))
|
||||
([db block-id reverse?]
|
||||
(let [child-ids (->> (d/datoms db :avet :block/parent block-id)
|
||||
(map :e)
|
||||
set)
|
||||
blocks (if (>= (count child-ids) block-children-limit)
|
||||
(->> ((if reverse? d/rseek-datoms d/datoms) db :avet :block/order)
|
||||
(keep (fn [datom]
|
||||
(when (contains? child-ids (:e datom))
|
||||
(d/entity db (:e datom))))))
|
||||
(cond->> child-ids
|
||||
true (keep #(d/entity db %))
|
||||
true ldb/sort-by-order
|
||||
reverse? reverse))]
|
||||
(remove #(or (:block/closed-value-property %)
|
||||
(:logseq.property/created-from-property %))
|
||||
blocks))))
|
||||
|
||||
(defn- get-block-children
|
||||
[db block {:keys [all? include-collapsed-children?]}]
|
||||
(let [[large-page? children-blocks]
|
||||
(loop [pending [block]
|
||||
seen #{(:db/id block)}
|
||||
result []]
|
||||
(if (and (not all?) (>= (count result) block-children-limit))
|
||||
[true result]
|
||||
(if-let [parent (peek pending)]
|
||||
(let [pending (pop pending)
|
||||
expand? (or include-collapsed-children?
|
||||
(not (true? (property-handler/entity-direct-value db parent :block/collapsed?)))
|
||||
(some? (property-handler/entity-direct-value db parent :block/name)))
|
||||
children (if expand?
|
||||
(remove #(contains? seen (:db/id %))
|
||||
(direct-child-blocks db (:db/id parent)))
|
||||
[])]
|
||||
(recur (into pending children)
|
||||
(into seen (map :db/id) children)
|
||||
(into result children)))
|
||||
[false result])))
|
||||
children-blocks (remove ldb/recycled? children-blocks)
|
||||
children (if large-page?
|
||||
(remove ldb/recycled? (direct-child-blocks db (:db/id block)))
|
||||
children-blocks)]
|
||||
{:large-page? large-page?
|
||||
:children (->> children
|
||||
(remove :block/closed-value-property))}))
|
||||
|
||||
(defn- plain-render-block?
|
||||
[db block]
|
||||
(empty? (remove #{:block/tags}
|
||||
(property-handler/direct-block-property-ids db (:db/id block)))))
|
||||
|
||||
(defn- block-positioned-properties-map
|
||||
[db block]
|
||||
(->> property-handler/render-property-positions
|
||||
(keep (fn [position]
|
||||
(let [properties (property-handler/block-positioned-properties db (:db/id block) position)]
|
||||
(when (seq properties)
|
||||
[position properties]))))
|
||||
(into {})))
|
||||
|
||||
(defn block-reactions
|
||||
[db block-id]
|
||||
(mapv #(d/pull db
|
||||
'[:db/id :block/uuid :logseq.property.reaction/emoji-id
|
||||
{:logseq.property/created-by-ref [:db/id :block/uuid :block/title]}]
|
||||
(:e %))
|
||||
(d/datoms db :avet :logseq.property.reaction/target block-id)))
|
||||
|
||||
(def ^:private empty-render-display-properties
|
||||
{:full-properties []
|
||||
:hidden-properties []
|
||||
:description-property nil
|
||||
:class-properties-property nil})
|
||||
|
||||
(defn- assoc-base-render-data
|
||||
[db block block-map]
|
||||
(cond-> (assoc block-map
|
||||
:block.temp/reactions (block-reactions db (:db/id block)))
|
||||
(plain-render-block? db block)
|
||||
(assoc :block.temp/positioned-properties {}
|
||||
:block.temp/display-properties empty-render-display-properties)))
|
||||
|
||||
(defn- block-refs-count
|
||||
[db block-id]
|
||||
(if (and (empty? (d/datoms db :avet :block/refs block-id))
|
||||
(empty? (d/datoms db :eavt block-id :block/alias))
|
||||
(empty? (d/datoms db :avet :block/alias block-id)))
|
||||
0
|
||||
(common-initial-data/get-block-refs-count db block-id)))
|
||||
|
||||
(defn- assoc-render-property-data
|
||||
[db block block-map]
|
||||
(let [plain? (plain-render-block? db block)]
|
||||
(assoc block-map
|
||||
:block.temp/positioned-properties
|
||||
(if plain?
|
||||
{}
|
||||
(block-positioned-properties-map db block))
|
||||
:block.temp/display-properties
|
||||
(if plain?
|
||||
empty-render-display-properties
|
||||
(property-handler/display-properties db block {} false))
|
||||
:block.temp/reactions
|
||||
(block-reactions db (:db/id block)))))
|
||||
|
||||
(defn- assoc-root-render-data
|
||||
[db block block-map]
|
||||
(assoc (assoc-render-property-data db block block-map)
|
||||
:block.temp/page-display-properties
|
||||
(property-handler/display-properties db block {:page-title? true} false)
|
||||
:block.temp/bidirectional-properties
|
||||
(vec (ldb/get-bidirectional-properties db (:db/id block)))))
|
||||
|
||||
(defn get-block-and-children
|
||||
[db id-or-page-name {:keys [all? children? properties render-data? root-render-data?
|
||||
include-collapsed-children?]
|
||||
:or {include-collapsed-children? false}}]
|
||||
(when-let [block (resolve-block-entity db id-or-page-name)]
|
||||
(let [block-refs-count? (some #{:block.temp/refs-count} properties)
|
||||
{:keys [children]} (when children?
|
||||
(get-block-children db block {:all? all?
|
||||
:include-collapsed-children? include-collapsed-children?}))
|
||||
children' (when children?
|
||||
(map (fn [child]
|
||||
(let [child-map-base (worker-plain/entity-forward-map db child {})
|
||||
child-map (cond
|
||||
render-data?
|
||||
(assoc-render-property-data db child child-map-base)
|
||||
|
||||
(false? render-data?)
|
||||
(assoc-base-render-data db child child-map-base)
|
||||
|
||||
:else
|
||||
child-map-base)]
|
||||
(-> child-map
|
||||
(assoc :block.temp/has-children?
|
||||
(block-has-children? db (:db/id child))))))
|
||||
children))
|
||||
block-map-base (cond-> (merge
|
||||
(property-handler/entity-direct-map db block [:db/id :db/ident :block/uuid :block/name :block/tags])
|
||||
(worker-plain/entity-forward-map db block {:properties properties}))
|
||||
(or render-data? (empty? properties))
|
||||
(assoc :block/properties
|
||||
(property-handler/display-properties-for-block db block)))
|
||||
block-map (cond
|
||||
root-render-data?
|
||||
(assoc-root-render-data db block block-map-base)
|
||||
|
||||
render-data?
|
||||
(assoc-render-property-data db block block-map-base)
|
||||
|
||||
(false? render-data?)
|
||||
(assoc-base-render-data db block block-map-base)
|
||||
|
||||
:else
|
||||
block-map-base)
|
||||
block' (cond-> (assoc block-map
|
||||
:block/tags (or (:block/tags block-map) [])
|
||||
:block/collapsed? (boolean (:block/collapsed? block-map)))
|
||||
|
||||
block-refs-count?
|
||||
(assoc :block.temp/refs-count (common-initial-data/get-block-refs-count db (:db/id block)))
|
||||
true
|
||||
(assoc :block.temp/has-children?
|
||||
(block-has-children? db (:db/id block))))]
|
||||
(cond-> {:block block'}
|
||||
children?
|
||||
(assoc :children children')))))
|
||||
|
||||
(defn- sanitize-block-result
|
||||
[result]
|
||||
(cond-> result
|
||||
(:block result)
|
||||
(update :block common-util/remove-nils-non-nested)
|
||||
|
||||
(:children result)
|
||||
(update :children common-util/fast-remove-nils)))
|
||||
|
||||
(defn- result-blocks
|
||||
[{:keys [block children]}]
|
||||
(cond-> (vec children)
|
||||
block (conj block)))
|
||||
|
||||
(defn- assoc-block-metadata
|
||||
[db conflicts-by-block commented-block-uuids now-ms render-data? block]
|
||||
(let [block-id (:db/id block)
|
||||
block-uuid (:block/uuid block)]
|
||||
(cond-> (assoc block
|
||||
:block.temp/refs-count (block-refs-count db block-id)
|
||||
:block.temp/breadcrumb
|
||||
(block-breadcrumb/block-breadcrumb db block)
|
||||
:block.temp/comment-thread-present?
|
||||
(contains? commented-block-uuids (str block-uuid))
|
||||
:block.temp/sync-conflicts
|
||||
(vec (get conflicts-by-block block-uuid)))
|
||||
render-data?
|
||||
(assoc :block.temp/task-spent-time
|
||||
(or (query-handler/task-spent-time db block-id now-ms) [])))))
|
||||
|
||||
(defn- assoc-result-block-metadata
|
||||
[result db conflicts-by-block commented-block-uuids now-ms render-data? root-render-data?]
|
||||
(cond-> result
|
||||
(:block result)
|
||||
(update :block #(assoc-block-metadata db conflicts-by-block commented-block-uuids
|
||||
now-ms (or render-data? root-render-data?) %))
|
||||
|
||||
(:children result)
|
||||
(update :children (fn [children]
|
||||
(mapv #(assoc-block-metadata db conflicts-by-block commented-block-uuids
|
||||
now-ms render-data? %)
|
||||
children)))))
|
||||
|
||||
(defn- get-blocks-response
|
||||
[repo requests]
|
||||
(when-let [db (some-> (worker-state/get-datascript-conn repo) deref)]
|
||||
(let [results (mapv (fn [{:keys [id opts]}]
|
||||
(let [id' (if (and (string? id) (common-util/uuid-string? id)) (uuid id) id)]
|
||||
(assoc (get-block-and-children db id' opts) :id id)))
|
||||
requests)
|
||||
metadata-blocks (->> (map vector requests results)
|
||||
(keep (fn [[request result]]
|
||||
(when (get-in request [:opts :block-metadata?])
|
||||
(result-blocks result))))
|
||||
(mapcat identity))
|
||||
commented-block-uuids (when (seq metadata-blocks)
|
||||
(->> metadata-blocks
|
||||
(mapv :block/uuid)
|
||||
(comments-handler/get-comment-thread-block-uuids db)
|
||||
set))
|
||||
conflicts-by-block (when (seq metadata-blocks)
|
||||
(client-op/get-all-sync-conflicts repo))
|
||||
now-ms (common-util/time-ms)]
|
||||
(->> (mapv (fn [request result]
|
||||
(cond-> result
|
||||
(get-in request [:opts :block-metadata?])
|
||||
(assoc-result-block-metadata
|
||||
db conflicts-by-block commented-block-uuids now-ms
|
||||
(true? (get-in request [:opts :render-data?]))
|
||||
(true? (get-in request [:opts :root-render-data?])))))
|
||||
requests
|
||||
results)
|
||||
(mapv #(-> %
|
||||
sanitize-block-result
|
||||
worker-plain/with-explicit-ref-fields-recursive))))))
|
||||
|
||||
(def-thread-api :thread-api/get-blocks
|
||||
[repo requests]
|
||||
(get-blocks-response repo requests))
|
||||
|
||||
(def-thread-api :thread-api/get-block-refs
|
||||
[repo id]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(->> (db-reference/get-linked-references @conn id)
|
||||
:ref-blocks
|
||||
(keep (fn [block]
|
||||
(some-> (worker-plain/entity-forward-map @conn block {})
|
||||
worker-plain/with-explicit-ref-fields-recursive))))))
|
||||
|
||||
(def-thread-api :thread-api/get-block-source
|
||||
[repo id]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(:db/id (first (:block/_alias (d/entity @conn id))))))
|
||||
|
||||
(defn unlinked-reference-exists?
|
||||
[db repo id]
|
||||
(let [block (d/entity db id)
|
||||
title (string/lower-case (:block/title block))
|
||||
result (search-handler/search-blocks repo title {:limit 100})]
|
||||
(boolean (some (fn [candidate]
|
||||
(let [candidate (d/entity db (:db/id candidate))]
|
||||
(and (not= id (:db/id candidate))
|
||||
(not ((set (map :db/id (:block/refs candidate))) id))
|
||||
(string/includes? (string/lower-case (:block/title candidate)) title))))
|
||||
result))))
|
||||
|
||||
(def-thread-api :thread-api/get-block-parents
|
||||
[repo id depth]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(let [block-id (:block/uuid (d/entity @conn id))]
|
||||
(->> (ldb/get-block-parents @conn block-id {:depth (or depth 3)})
|
||||
(map (fn [block]
|
||||
(-> (into {} block)
|
||||
(assoc :db/id (:db/id block)
|
||||
:block/title (:block/title block)))))))))
|
||||
84
src/main/frontend/worker/handler/block_breadcrumb.cljs
Normal file
84
src/main/frontend/worker/handler/block_breadcrumb.cljs
Normal file
@@ -0,0 +1,84 @@
|
||||
(ns frontend.worker.handler.block-breadcrumb
|
||||
"Canonical breadcrumb payloads shared by block loads and search results."
|
||||
(:require [datascript.core :as d]
|
||||
[datascript.impl.entity :as de]
|
||||
[logseq.db :as ldb]))
|
||||
|
||||
(def ^:private load-depth 16)
|
||||
|
||||
(defn- fail!
|
||||
[message data]
|
||||
(throw (ex-info message data)))
|
||||
|
||||
(defn shallow-ref-identity
|
||||
[db ref-or-id]
|
||||
(let [ref (if (or (de/entity? ref-or-id) (map? ref-or-id))
|
||||
ref-or-id
|
||||
(d/entity db ref-or-id))
|
||||
ref-id (:db/id ref)
|
||||
ref-uuid (:block/uuid ref)
|
||||
ref-ident (:db/ident ref)
|
||||
ref-title (:block/title ref)
|
||||
ref-name (:block/name ref)
|
||||
ref-tags (mapv (fn [tag]
|
||||
(select-keys tag [:db/id :block/uuid :db/ident]))
|
||||
(:block/tags ref))
|
||||
choice-exclusions
|
||||
(mapv (fn [choice]
|
||||
(select-keys choice [:db/id :block/uuid :db/ident]))
|
||||
(:logseq.property/choice-exclusions ref))
|
||||
property-value (:logseq.property/value ref)
|
||||
property-icon (:logseq.property/icon ref)
|
||||
hide-from-node (:logseq.property.class/hide-from-node ref)
|
||||
property-value-title (when (or (:block/closed-value-property ref)
|
||||
(:logseq.property/created-from-property ref))
|
||||
(:block/title ref))]
|
||||
(when-not ref
|
||||
(fail! "Missing canonical block reference" {:ref-id ref-id}))
|
||||
(when (and (some? ref-uuid) (not (uuid? ref-uuid)))
|
||||
(fail! "Invalid canonical block reference UUID"
|
||||
{:ref-id ref-id :block-uuid ref-uuid}))
|
||||
(when (and (some? ref-ident) (not (keyword? ref-ident)))
|
||||
(fail! "Invalid canonical block reference ident"
|
||||
{:ref-id ref-id :db-ident ref-ident}))
|
||||
(cond-> {:db/id ref-id}
|
||||
ref-uuid (assoc :block/uuid ref-uuid)
|
||||
ref-ident (assoc :db/ident ref-ident)
|
||||
(string? ref-title) (assoc :block/title ref-title)
|
||||
(string? ref-name) (assoc :block/name ref-name)
|
||||
(seq ref-tags) (assoc :block/tags ref-tags)
|
||||
(seq choice-exclusions)
|
||||
(assoc :logseq.property/choice-exclusions choice-exclusions)
|
||||
(some? property-value) (assoc :logseq.property/value property-value)
|
||||
(some? property-icon) (assoc :logseq.property/icon property-icon)
|
||||
(some? hide-from-node) (assoc :logseq.property.class/hide-from-node hide-from-node)
|
||||
(some? property-value-title) (assoc :block/title property-value-title))))
|
||||
|
||||
(defn- breadcrumb-entity
|
||||
[db entity]
|
||||
(cond-> (shallow-ref-identity db entity)
|
||||
(string? (:block/raw-title entity))
|
||||
(assoc :block/raw-title (:block/raw-title entity))
|
||||
|
||||
(:logseq.property.node/display-type entity)
|
||||
(assoc :logseq.property.node/display-type
|
||||
(:logseq.property.node/display-type entity))
|
||||
|
||||
(seq (:block/refs entity))
|
||||
(assoc :block/refs
|
||||
(mapv #(shallow-ref-identity db %)
|
||||
(:block/refs entity)))))
|
||||
|
||||
(defn block-breadcrumb
|
||||
[db block]
|
||||
(let [parents (vec (ldb/get-block-parents
|
||||
db (:block/uuid block) {:depth load-depth}))
|
||||
page (:block/page block)
|
||||
breadcrumb-ancestors (if (and page
|
||||
(not= (:db/id page) (:db/id (first parents))))
|
||||
(into [page] parents)
|
||||
parents)]
|
||||
(cond-> (mapv #(breadcrumb-entity db %) breadcrumb-ancestors)
|
||||
(:logseq.property/created-from-property block)
|
||||
(conj (breadcrumb-entity db
|
||||
(:logseq.property/created-from-property block))))))
|
||||
56
src/main/frontend/worker/handler/cli.cljs
Normal file
56
src/main/frontend/worker/handler/cli.cljs
Normal file
@@ -0,0 +1,56 @@
|
||||
(ns frontend.worker.handler.cli
|
||||
"CLI and API server operations for the db worker."
|
||||
(:require [frontend.common.thread-api :refer [def-thread-api]]
|
||||
[frontend.worker.state :as worker-state]
|
||||
[logseq.api.db-based.tools :as api-tools]
|
||||
[logseq.cli.common.db-worker :as cli-db-worker]))
|
||||
|
||||
(def-thread-api :thread-api/cli-list-properties
|
||||
[repo options]
|
||||
(let [conn (worker-state/get-datascript-conn repo)]
|
||||
(cli-db-worker/list-properties @conn options)))
|
||||
|
||||
(def-thread-api :thread-api/cli-list-tags
|
||||
[repo options]
|
||||
(let [conn (worker-state/get-datascript-conn repo)]
|
||||
(cli-db-worker/list-tags @conn options)))
|
||||
|
||||
(def-thread-api :thread-api/cli-list-pages
|
||||
[repo options]
|
||||
(let [conn (worker-state/get-datascript-conn repo)]
|
||||
(cli-db-worker/list-pages @conn options)))
|
||||
|
||||
(def-thread-api :thread-api/cli-list-tasks
|
||||
[repo options]
|
||||
(let [conn (worker-state/get-datascript-conn repo)]
|
||||
(cli-db-worker/list-tasks @conn options)))
|
||||
|
||||
(def-thread-api :thread-api/cli-list-nodes
|
||||
[repo options]
|
||||
(let [conn (worker-state/get-datascript-conn repo)]
|
||||
(cli-db-worker/list-nodes @conn options)))
|
||||
|
||||
(def-thread-api :thread-api/api-get-page-data
|
||||
[repo page-title]
|
||||
(let [conn (worker-state/get-datascript-conn repo)]
|
||||
(api-tools/get-page-data @conn page-title)))
|
||||
|
||||
(def-thread-api :thread-api/api-list-properties
|
||||
[repo options]
|
||||
(let [conn (worker-state/get-datascript-conn repo)]
|
||||
(api-tools/list-properties @conn options)))
|
||||
|
||||
(def-thread-api :thread-api/api-list-tags
|
||||
[repo options]
|
||||
(let [conn (worker-state/get-datascript-conn repo)]
|
||||
(api-tools/list-tags @conn options)))
|
||||
|
||||
(def-thread-api :thread-api/api-list-pages
|
||||
[repo options]
|
||||
(let [conn (worker-state/get-datascript-conn repo)]
|
||||
(api-tools/list-pages @conn options)))
|
||||
|
||||
(def-thread-api :thread-api/api-build-upsert-nodes-edn
|
||||
[repo ops]
|
||||
(let [conn (worker-state/get-datascript-conn repo)]
|
||||
(api-tools/build-upsert-nodes-edn @conn ops)))
|
||||
309
src/main/frontend/worker/handler/comments.cljs
Normal file
309
src/main/frontend/worker/handler/comments.cljs
Normal file
@@ -0,0 +1,309 @@
|
||||
(ns frontend.worker.handler.comments
|
||||
"Comments operations for the db worker."
|
||||
(:require [datascript.core :as d]
|
||||
[frontend.common.thread-api :refer [def-thread-api]]
|
||||
[frontend.worker.state :as worker-state]
|
||||
[logseq.common.util :as common-util]
|
||||
[logseq.db :as ldb]
|
||||
[logseq.db.frontend.entity-util :as entity-util]
|
||||
[logseq.outliner.op :as outliner-op]))
|
||||
|
||||
(def ^:private comments-tag-ident :logseq.class/Comments)
|
||||
(def ^:private comments-blocks-property :logseq.property.comments/blocks)
|
||||
|
||||
(def ^:private block-selector
|
||||
'[:db/id
|
||||
:block/uuid
|
||||
:block/title
|
||||
:block/name
|
||||
:block/order
|
||||
:block/created-at
|
||||
:block/updated-at
|
||||
:logseq.property/deleted-at
|
||||
{:block/tags [:db/id :db/ident :block/title]}
|
||||
{:block/parent [:db/id :block/uuid :block/title {:block/tags [:db/ident]}]}
|
||||
{:block/page [:db/id :block/uuid :block/title :block/name {:block/tags [:db/ident]}]}
|
||||
{:logseq.property.comments/blocks [:db/id :block/uuid :block/title :logseq.property/deleted-at]}])
|
||||
|
||||
(defn- block-ref-entity
|
||||
[db block-ref]
|
||||
(cond
|
||||
(uuid? block-ref)
|
||||
(d/entity db [:block/uuid block-ref])
|
||||
|
||||
(and (string? block-ref) (common-util/uuid-string? block-ref))
|
||||
(d/entity db [:block/uuid (uuid block-ref)])
|
||||
|
||||
:else
|
||||
(d/entity db block-ref)))
|
||||
|
||||
(defn- block-map
|
||||
[db block]
|
||||
(when block
|
||||
(d/pull db block-selector (:db/id block))))
|
||||
|
||||
(defn- block-map-with-children
|
||||
[db block]
|
||||
(when-let [block' (block-map db block)]
|
||||
(assoc block'
|
||||
:block/children
|
||||
(mapv #(block-map db %) (ldb/get-children db (:db/id block))))))
|
||||
|
||||
(defn- tagged-with?
|
||||
[block tag-ident]
|
||||
(boolean
|
||||
(some (fn [tag]
|
||||
(= tag-ident
|
||||
(if (keyword? tag)
|
||||
tag
|
||||
(:db/ident tag))))
|
||||
(:block/tags block))))
|
||||
|
||||
(defn- comments-area?
|
||||
[block]
|
||||
(tagged-with? block comments-tag-ident))
|
||||
|
||||
(defn- comment-block?
|
||||
[block]
|
||||
(or (tagged-with? block :logseq.class/Comment)
|
||||
(comments-area? (:block/parent block))))
|
||||
|
||||
(defn- comment-target-block?
|
||||
[block]
|
||||
(not (or (comments-area? block)
|
||||
(comment-block? block))))
|
||||
|
||||
(defn- block-lookup-ref
|
||||
[block]
|
||||
[:block/uuid (:block/uuid block)])
|
||||
|
||||
(defn- single-comment-targets
|
||||
[block]
|
||||
#{(block-lookup-ref block)})
|
||||
|
||||
(defn- comments-area-child
|
||||
[db block]
|
||||
(some (fn [child]
|
||||
(when (comments-area? child)
|
||||
child))
|
||||
(ldb/sort-by-order (ldb/get-children db (:db/id block)))))
|
||||
|
||||
(defn- comments-area-title
|
||||
[block]
|
||||
(if (entity-util/page? block)
|
||||
"Comments on this page"
|
||||
"Comments"))
|
||||
|
||||
(defn- comments-area-insert-position
|
||||
[block]
|
||||
(if (entity-util/page? block)
|
||||
{:start? true}
|
||||
{:end? true}))
|
||||
|
||||
(defn- block-ref-uuid
|
||||
[block-ref]
|
||||
(cond
|
||||
(map? block-ref) (:block/uuid block-ref)
|
||||
(uuid? block-ref) block-ref
|
||||
(and (string? block-ref) (common-util/uuid-string? block-ref)) (uuid block-ref)
|
||||
:else nil))
|
||||
|
||||
(defn- comment-thread-target-blocks
|
||||
[comments-area]
|
||||
(->> (get comments-area comments-blocks-property)
|
||||
(remove :logseq.property/deleted-at)
|
||||
vec))
|
||||
|
||||
(defn- same-comment-targets?
|
||||
[comments-area target-uuids]
|
||||
(= target-uuids
|
||||
(->> (comment-thread-target-blocks comments-area)
|
||||
(keep block-ref-uuid)
|
||||
set)))
|
||||
|
||||
(defn- existing-comments-area-for-targets
|
||||
[blocks]
|
||||
(let [target-uuids (set (keep :block/uuid blocks))]
|
||||
(some (fn [comments-area]
|
||||
(when (same-comment-targets? comments-area target-uuids)
|
||||
comments-area))
|
||||
(get (first blocks) :logseq.property.comments/_blocks))))
|
||||
|
||||
(defn- resolve-comments-area
|
||||
[db block-ref]
|
||||
(when-let [block (block-ref-entity db block-ref)]
|
||||
(if-let [comments-area (comments-area-child db block)]
|
||||
(cond-> {:action :existing
|
||||
:comments-area (block-map db comments-area)}
|
||||
(not (seq (get comments-area comments-blocks-property)))
|
||||
(assoc :missing-target (block-lookup-ref block)))
|
||||
{:action :insert
|
||||
:title (comments-area-title block)
|
||||
:opts (merge {:block-uuid (:block/uuid block)
|
||||
:edit-block? false
|
||||
:other-attrs {:block/tags #{comments-tag-ident}
|
||||
comments-blocks-property (single-comment-targets block)}}
|
||||
(comments-area-insert-position block))})))
|
||||
|
||||
(defn- resolve-comments-area-for-blocks
|
||||
[db block-refs]
|
||||
(let [blocks (->> block-refs
|
||||
(keep #(block-ref-entity db %))
|
||||
(filter comment-target-block?)
|
||||
vec)]
|
||||
(when-let [last-block (last blocks)]
|
||||
(if (= 1 (count blocks))
|
||||
{:action :single
|
||||
:block-ref (:block/uuid last-block)}
|
||||
(if-let [comments-area (existing-comments-area-for-targets blocks)]
|
||||
{:action :existing
|
||||
:comments-area (block-map db comments-area)}
|
||||
{:action :insert
|
||||
:title "Comments"
|
||||
:opts {:block-uuid (:block/uuid last-block)
|
||||
:sibling? true
|
||||
:edit-block? false
|
||||
:other-attrs {:block/tags #{comments-tag-ident}
|
||||
comments-blocks-property (set (map block-lookup-ref blocks))}}})))))
|
||||
|
||||
(defn- get-comment-delete-targets
|
||||
[db comment-block-ref]
|
||||
(when-let [comment-block (block-ref-entity db comment-block-ref)]
|
||||
(let [comments-area (:block/parent comment-block)
|
||||
live-children (remove :logseq.property/deleted-at
|
||||
(ldb/get-children db (:db/id comments-area)))]
|
||||
(if (and (comments-area? comments-area)
|
||||
(<= (count live-children) 1))
|
||||
[(block-map-with-children db comments-area)]
|
||||
[(block-map db comment-block)]))))
|
||||
|
||||
(defn- insert-comments-area!
|
||||
[conn {:keys [title opts]}]
|
||||
(let [db @conn
|
||||
target (block-ref-entity db (:block-uuid opts))
|
||||
children (when (:end? opts)
|
||||
(ldb/sort-by-order (ldb/get-children db (:db/id target))))
|
||||
[insert-target sibling?] (cond
|
||||
(:sibling? opts) [target true]
|
||||
(seq children) [(last children) true]
|
||||
:else [target false])
|
||||
comments-area-uuid (ldb/new-block-id)
|
||||
comments-area (merge {:block/title title
|
||||
:block/uuid comments-area-uuid}
|
||||
(:other-attrs opts))
|
||||
insert-opts {:sibling? sibling?
|
||||
:keep-uuid? true}]
|
||||
(outliner-op/apply-ops!
|
||||
conn
|
||||
[[:insert-blocks [[comments-area] (:block/uuid insert-target) insert-opts]]]
|
||||
nil)
|
||||
(some->> (d/entity @conn [:block/uuid comments-area-uuid])
|
||||
(block-map @conn))))
|
||||
|
||||
(defn ensure-comments-area!
|
||||
[conn block-ref]
|
||||
(when-let [{:keys [action comments-area missing-target] :as resolution}
|
||||
(resolve-comments-area @conn block-ref)]
|
||||
(case action
|
||||
:existing
|
||||
(do
|
||||
(when missing-target
|
||||
(ldb/transact!
|
||||
conn
|
||||
[[:db/add
|
||||
[:block/uuid (:block/uuid comments-area)]
|
||||
comments-blocks-property
|
||||
missing-target]]
|
||||
{:outliner-op :save-block}))
|
||||
(or (some->> (d/entity @conn [:block/uuid (:block/uuid comments-area)])
|
||||
(block-map @conn))
|
||||
comments-area))
|
||||
|
||||
:insert
|
||||
(insert-comments-area! conn resolution)
|
||||
|
||||
nil)))
|
||||
|
||||
(defn ensure-comments-area-for-blocks!
|
||||
[conn block-refs]
|
||||
(when-let [{:keys [action block-ref comments-area] :as resolution}
|
||||
(resolve-comments-area-for-blocks @conn block-refs)]
|
||||
(case action
|
||||
:single (ensure-comments-area! conn block-ref)
|
||||
:existing comments-area
|
||||
:insert (insert-comments-area! conn resolution)
|
||||
nil)))
|
||||
|
||||
(defn delete-comment!
|
||||
[conn comment-block-ref]
|
||||
(let [target-uuids (mapv :block/uuid (get-comment-delete-targets @conn comment-block-ref))]
|
||||
(when (seq target-uuids)
|
||||
(outliner-op/apply-ops!
|
||||
conn
|
||||
[[:delete-blocks [target-uuids {}]]]
|
||||
nil))
|
||||
nil))
|
||||
|
||||
(defn get-comment-threads-for-block
|
||||
[db block-uuid]
|
||||
(let [thread-ids (d/q '[:find [?comments-area ...]
|
||||
:in $ ?block-uuid
|
||||
:where
|
||||
[?block :block/uuid ?block-uuid]
|
||||
[?comments-area :logseq.property.comments/blocks ?block]
|
||||
[?comments-area :block/tags :logseq.class/Comments]
|
||||
[(missing? $ ?comments-area :logseq.property/deleted-at)]]
|
||||
db
|
||||
block-uuid)]
|
||||
(mapv #(block-map-with-children db (d/entity db %)) thread-ids)))
|
||||
|
||||
(defn get-comment-thread-block-uuids
|
||||
[db block-uuids]
|
||||
(let [id->uuid (into {}
|
||||
(keep (fn [block-uuid]
|
||||
(let [block-uuid (cond
|
||||
(uuid? block-uuid) block-uuid
|
||||
(and (string? block-uuid)
|
||||
(common-util/uuid-string? block-uuid))
|
||||
(uuid block-uuid))]
|
||||
(when-let [block-id (when block-uuid
|
||||
(d/entid db [:block/uuid block-uuid]))]
|
||||
[block-id block-uuid]))))
|
||||
block-uuids)]
|
||||
(when (seq id->uuid)
|
||||
(->> (keys id->uuid)
|
||||
(mapcat #(d/datoms db :avet comments-blocks-property %))
|
||||
(keep (fn [{comments-area-id :e block-id :v}]
|
||||
(when-let [block-uuid (get id->uuid block-id)]
|
||||
(let [comments-area (d/entity db comments-area-id)]
|
||||
(when (and (some #(= :logseq.class/Comments (:db/ident %))
|
||||
(:block/tags comments-area))
|
||||
(not= block-id (:db/id (:block/parent comments-area)))
|
||||
(nil? (:logseq.property/deleted-at comments-area)))
|
||||
(str block-uuid))))))
|
||||
vec))))
|
||||
|
||||
(def-thread-api :thread-api/ensure-comments-area
|
||||
[repo block-ref]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(ensure-comments-area! conn block-ref)))
|
||||
|
||||
(def-thread-api :thread-api/ensure-comments-area-for-blocks
|
||||
[repo block-refs]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(ensure-comments-area-for-blocks! conn block-refs)))
|
||||
|
||||
(def-thread-api :thread-api/delete-comment
|
||||
[repo comment-block-ref]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(delete-comment! conn comment-block-ref)))
|
||||
|
||||
(def-thread-api :thread-api/get-comment-threads-for-block
|
||||
[repo block-uuid]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(get-comment-threads-for-block @conn block-uuid)))
|
||||
|
||||
(def-thread-api :thread-api/get-comment-thread-block-uuids
|
||||
[repo block-uuids]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(get-comment-thread-block-uuids @conn block-uuids)))
|
||||
94
src/main/frontend/worker/handler/export.cljs
Normal file
94
src/main/frontend/worker/handler/export.cljs
Normal file
@@ -0,0 +1,94 @@
|
||||
(ns frontend.worker.handler.export
|
||||
"Export, import, and validation operations for the db worker."
|
||||
(:require [frontend.common.thread-api :refer [def-thread-api]]
|
||||
[frontend.worker.db.validate :as worker-db-validate]
|
||||
[frontend.worker.export :as worker-export]
|
||||
[frontend.worker.platform :as platform]
|
||||
[frontend.worker.state :as worker-state]
|
||||
[frontend.worker.sync :as db-sync]
|
||||
[frontend.worker.sync.client-op :as client-op]
|
||||
[logseq.db :as ldb]
|
||||
[logseq.db.sqlite.export :as sqlite-export]
|
||||
[logseq.publishing.html :as publish-html]))
|
||||
|
||||
(def-thread-api :thread-api/export-get-debug-datoms
|
||||
[repo]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(worker-export/get-debug-datoms conn)))
|
||||
|
||||
(def-thread-api :thread-api/export-get-all-page->content
|
||||
[repo options]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(worker-export/get-all-page->content @conn options)))
|
||||
|
||||
(def-thread-api :thread-api/export-get-blocks-data
|
||||
[repo root-block-uuids-or-page-uuid opts content-config]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(worker-export/get-blocks-export-data @conn root-block-uuids-or-page-uuid opts content-config)))
|
||||
|
||||
(def-thread-api :thread-api/export-blocks-as-format
|
||||
[repo root-block-uuids-or-page-uuid format-type options content-config]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(worker-export/export-blocks-as-format
|
||||
@conn
|
||||
root-block-uuids-or-page-uuid
|
||||
format-type
|
||||
options
|
||||
content-config)))
|
||||
|
||||
(def-thread-api :thread-api/validate-db
|
||||
[repo & [opts]]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(worker-db-validate/validate-db conn opts)))
|
||||
|
||||
(defn- checksum-diagnostics
|
||||
[repo]
|
||||
{:local-checksum (client-op/get-local-checksum repo)
|
||||
:remote-checksum (get @db-sync/*repo->latest-remote-checksum repo)})
|
||||
|
||||
(def-thread-api :thread-api/recompute-checksum-diagnostics
|
||||
[repo]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(let [result (worker-db-validate/recompute-checksum-diagnostics repo conn (checksum-diagnostics repo))
|
||||
recomputed-checksum (:recomputed-checksum result)]
|
||||
(when (and (some? recomputed-checksum)
|
||||
(worker-state/get-client-ops-conn repo))
|
||||
(client-op/update-local-checksum repo recomputed-checksum))
|
||||
(cond-> result
|
||||
(some? recomputed-checksum)
|
||||
(assoc :local-checksum recomputed-checksum)))))
|
||||
|
||||
;; Returns an export-edn map for given repo. When there's an unexpected error, a map
|
||||
;; with key :export-edn-error is returned.
|
||||
(def-thread-api :thread-api/export-edn
|
||||
[repo options]
|
||||
(let [conn (worker-state/get-datascript-conn repo)]
|
||||
(try
|
||||
(sqlite-export/build-export @conn options)
|
||||
(catch :default e
|
||||
(js/console.error "export-edn error: " e)
|
||||
(js/console.error "Stack:\n" (.-stack e))
|
||||
(platform/post-message! (platform/current)
|
||||
:notification
|
||||
[nil :error nil nil nil
|
||||
{:i18n-key :export/error-unexpected}])
|
||||
{:export-edn-error (.-message e)}))))
|
||||
|
||||
(def-thread-api :thread-api/import-edn
|
||||
[repo export-edn]
|
||||
(let [conn (worker-state/get-datascript-conn repo)]
|
||||
(when-not conn
|
||||
(throw (ex-info "graph not opened" {:code :graph-not-opened :repo repo})))
|
||||
(let [txs (sqlite-export/build-import export-edn @conn {})
|
||||
validation (sqlite-export/validate-import-txs txs @conn)]
|
||||
(if-let [error (:error validation)]
|
||||
{:error error}
|
||||
(let [tx-data (:tx-data validation)
|
||||
tx-meta {::sqlite-export/imported-data? true}]
|
||||
(ldb/transact! conn tx-data tx-meta)
|
||||
{:tx-count (count tx-data)})))))
|
||||
|
||||
(def-thread-api :thread-api/build-publishing-html
|
||||
[repo options]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(publish-html/build-html @conn options)))
|
||||
43
src/main/frontend/worker/handler/flashcard.cljs
Normal file
43
src/main/frontend/worker/handler/flashcard.cljs
Normal file
@@ -0,0 +1,43 @@
|
||||
(ns frontend.worker.handler.flashcard
|
||||
"Flashcard scheduling queries for the db worker."
|
||||
(:require
|
||||
[clojure.string :as string]
|
||||
[datascript.core :as d]
|
||||
[frontend.common.thread-api :refer [def-thread-api]]
|
||||
[frontend.worker.query-dsl :as query-dsl]
|
||||
[frontend.worker.state :as worker-state]
|
||||
[logseq.db.frontend.class :as db-class]))
|
||||
|
||||
(defn- fsrs-due-card-block-ids
|
||||
[db cards-id]
|
||||
(let [now-inst-ms (inst-ms (js/Date.))
|
||||
cards (when (and cards-id (not (contains? #{:global "global"} cards-id)))
|
||||
(d/entity db cards-id))
|
||||
query (when cards
|
||||
(when-let [query (:logseq.property/query cards)]
|
||||
(when-not (string/blank? (:block/title query))
|
||||
(:block/title query))))
|
||||
result (query-dsl/parse query db {})
|
||||
card-tag-id (:db/id (d/entity db :logseq.class/Card))
|
||||
card-tag-children-ids (db-class/get-structured-children db card-tag-id)
|
||||
card-ids (cons card-tag-id card-tag-children-ids)
|
||||
q '[:find [?b ...]
|
||||
:in $ [?t ...] ?now-inst-ms %
|
||||
:where
|
||||
[?b :block/tags ?t]
|
||||
(or-join [?b ?now-inst-ms]
|
||||
(and
|
||||
[?b :logseq.property.fsrs/due ?due]
|
||||
[(>= ?now-inst-ms ?due)])
|
||||
[(missing? $ ?b :logseq.property.fsrs/due)])
|
||||
[?b :block/uuid]]
|
||||
q' (if query
|
||||
(let [query* (:query result)]
|
||||
(concat q (if (coll? (first query*)) query* [query*])))
|
||||
q)]
|
||||
(d/q q' db card-ids now-inst-ms (:rules result))))
|
||||
|
||||
(def-thread-api :thread-api/get-fsrs-due-card-block-ids
|
||||
[repo cards-id]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(fsrs-due-card-block-ids @conn cards-id)))
|
||||
177
src/main/frontend/worker/handler/graph.cljs
Normal file
177
src/main/frontend/worker/handler/graph.cljs
Normal file
@@ -0,0 +1,177 @@
|
||||
(ns frontend.worker.handler.graph
|
||||
"Graph metadata, favorites, and overview operations for the db worker."
|
||||
(:require [cljs.cache :as cache]
|
||||
[clojure.string :as string]
|
||||
[datascript.core :as d]
|
||||
[frontend.common.cache :as common.cache]
|
||||
[frontend.common.thread-api :refer [def-thread-api]]
|
||||
[frontend.worker.graph-view :as graph-view]
|
||||
[frontend.worker.plain-value :as worker-plain]
|
||||
[frontend.worker.state :as worker-state]
|
||||
[logseq.common.config :as common-config]
|
||||
[logseq.common.uuid :as common-uuid]
|
||||
[logseq.db :as ldb]
|
||||
[logseq.outliner.op :as outliner-op]))
|
||||
|
||||
(defn- favorite-page
|
||||
[db]
|
||||
(ldb/get-page db common-config/favorites-page-name))
|
||||
|
||||
(defn- favorite-block
|
||||
[db page-block-uuid]
|
||||
(let [page-block-id (:db/id (d/entity db [:block/uuid page-block-uuid]))]
|
||||
(when-let [page (and page-block-id (favorite-page db))]
|
||||
(some (fn [block]
|
||||
(when (= page-block-id (:db/id (:block/link block)))
|
||||
block))
|
||||
(ldb/get-page-blocks db (:db/id page))))))
|
||||
|
||||
(defn- entity->plain-map
|
||||
[db entity]
|
||||
(some-> (worker-plain/entity-forward-map db entity {})
|
||||
worker-plain/with-explicit-ref-fields-recursive))
|
||||
|
||||
(def-thread-api :thread-api/get-favorite-pages
|
||||
[repo]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(let [db @conn]
|
||||
(when-let [page (favorite-page db)]
|
||||
(->> (ldb/sort-by-order (:block/_parent page))
|
||||
(keep (fn [block]
|
||||
(some->> (:block/link block)
|
||||
(entity->plain-map db))))
|
||||
(remove ldb/recycled?)
|
||||
vec)))))
|
||||
|
||||
(def-thread-api :thread-api/favorited-page?
|
||||
[repo page-block-uuid]
|
||||
(let [db @(worker-state/get-datascript-conn repo)]
|
||||
(boolean (favorite-block db page-block-uuid))))
|
||||
|
||||
(def-thread-api :thread-api/get-recent-pages
|
||||
[repo page-ids]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(let [db @conn]
|
||||
(->> page-ids
|
||||
distinct
|
||||
(take 20)
|
||||
(keep #(some->> (d/entity db %)
|
||||
(entity->plain-map db)))
|
||||
(filter ldb/page?)
|
||||
(remove ldb/hidden?)
|
||||
(remove (fn [entity]
|
||||
(or (and (ldb/property? entity)
|
||||
(true? (:logseq.property/hide? entity)))
|
||||
(string/blank? (:block/title entity)))))
|
||||
vec))))
|
||||
|
||||
(defn- favorite-page-ops
|
||||
[db page-block-uuid]
|
||||
(when-let [page (and (d/entity db [:block/uuid page-block-uuid])
|
||||
(favorite-page db))]
|
||||
[[:insert-blocks [[(ldb/build-favorite-tx page-block-uuid)]
|
||||
(:block/uuid page)
|
||||
{}]]]))
|
||||
|
||||
(defn- unfavorite-page-ops
|
||||
[db page-block-uuid]
|
||||
(when-let [block (favorite-block db page-block-uuid)]
|
||||
[[:delete-blocks [[(:block/uuid block)] {}]]]))
|
||||
|
||||
(def-thread-api :thread-api/set-page-favorite
|
||||
[repo page-block-uuid favorite?]
|
||||
(let [conn (worker-state/get-datascript-conn repo)
|
||||
db @conn
|
||||
favorited? (boolean (favorite-block db page-block-uuid))
|
||||
ops (cond
|
||||
(and favorite? (not favorited?)) (favorite-page-ops db page-block-uuid)
|
||||
(and (not favorite?) favorited?) (unfavorite-page-ops db page-block-uuid))]
|
||||
(when (seq ops)
|
||||
(outliner-op/apply-ops! conn ops nil))
|
||||
nil))
|
||||
|
||||
(defn- page-block-db-id
|
||||
[db page-block-uuid]
|
||||
(let [page-block-uuid' (if (string? page-block-uuid)
|
||||
(parse-uuid page-block-uuid)
|
||||
page-block-uuid)]
|
||||
(:db/id (d/entity db [:block/uuid page-block-uuid']))))
|
||||
|
||||
(defn- reorder-favorites-ops
|
||||
[db favorite-page-uuids]
|
||||
(when-let [page (favorite-page db)]
|
||||
(let [page-block-ids (keep #(page-block-db-id db %) favorite-page-uuids)
|
||||
current-blocks (ldb/sort-by-order (ldb/get-page-blocks db (:db/id page)))]
|
||||
(->> (map vector page-block-ids current-blocks)
|
||||
(keep (fn [[page-block-id block]]
|
||||
(when (not= page-block-id (:db/id (:block/link block)))
|
||||
[:save-block [(assoc block :block/link page-block-id) nil]])))
|
||||
vec))))
|
||||
|
||||
(def-thread-api :thread-api/reorder-favorites
|
||||
[repo favorite-page-uuids]
|
||||
(let [conn (worker-state/get-datascript-conn repo)
|
||||
db @conn
|
||||
ops (reorder-favorites-ops db favorite-page-uuids)]
|
||||
(when (seq ops)
|
||||
(outliner-op/apply-ops! conn ops nil))
|
||||
nil))
|
||||
|
||||
(def-thread-api :thread-api/build-graph
|
||||
[repo option]
|
||||
(let [conn (worker-state/get-datascript-conn repo)]
|
||||
(graph-view/build-graph @conn option)))
|
||||
|
||||
(def ^:private *get-all-page-titles-cache (volatile! (cache/lru-cache-factory {})))
|
||||
|
||||
(defn- get-all-page-titles
|
||||
[db]
|
||||
(let [pages (ldb/get-all-pages db)]
|
||||
(sort (map :block/title pages))))
|
||||
|
||||
(def ^:private get-all-page-titles-with-cache
|
||||
(common.cache/cache-fn
|
||||
*get-all-page-titles-cache
|
||||
(fn [repo]
|
||||
(let [db @(worker-state/get-datascript-conn repo)]
|
||||
[[repo (:max-tx db)]
|
||||
[db]]))
|
||||
get-all-page-titles))
|
||||
|
||||
(def-thread-api :thread-api/get-all-page-titles
|
||||
[repo]
|
||||
(get-all-page-titles-with-cache repo))
|
||||
|
||||
(def-thread-api :thread-api/mobile-logs
|
||||
[]
|
||||
@worker-state/*log)
|
||||
|
||||
(def-thread-api :thread-api/get-key-value
|
||||
[repo key]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(ldb/get-key-value @conn key)))
|
||||
|
||||
(def-thread-api :thread-api/get-rtc-graph-uuid
|
||||
[repo]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(ldb/get-graph-rtc-uuid @conn)))
|
||||
|
||||
(def-thread-api :thread-api/get-graph-uuid
|
||||
[repo]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(or (ldb/get-graph-rtc-uuid @conn)
|
||||
(ldb/get-graph-local-uuid @conn))))
|
||||
|
||||
(defn- new-local-graph-uuid
|
||||
[]
|
||||
(uuid (str "00000000" (subs (str (common-uuid/gen-uuid)) 8))))
|
||||
|
||||
(def-thread-api :thread-api/ensure-local-graph-uuid
|
||||
[repo]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(or (ldb/get-graph-local-uuid @conn)
|
||||
(let [local-graph-uuid (new-local-graph-uuid)]
|
||||
(d/transact! conn
|
||||
[(ldb/kv :logseq.kv/local-graph-uuid local-graph-uuid)]
|
||||
{:graph-open/ensure-local-graph-uuid? true})
|
||||
local-graph-uuid))))
|
||||
40
src/main/frontend/worker/handler/maintenance.cljs
Normal file
40
src/main/frontend/worker/handler/maintenance.cljs
Normal file
@@ -0,0 +1,40 @@
|
||||
(ns frontend.worker.handler.maintenance
|
||||
"Database schema, reset, and garbage-collection operations."
|
||||
(:require
|
||||
[datascript.core :as d]
|
||||
[frontend.common.thread-api :refer [def-thread-api]]
|
||||
[frontend.worker.state :as worker-state]
|
||||
[lambdaisland.glogi :as log]
|
||||
[logseq.common.util :as common-util]
|
||||
[logseq.db :as ldb]
|
||||
[logseq.db.sqlite.gc :as sqlite-gc]
|
||||
[me.tonsky.persistent-sorted-set :refer [BTSet]]))
|
||||
|
||||
(defn- reset-db!
|
||||
[repo db-transit-str]
|
||||
(when-let [conn (get @worker-state/*datascript-conns repo)]
|
||||
(let [new-db (ldb/read-transit-str db-transit-str)
|
||||
new-db' (update new-db :eavt (fn [^BTSet eavt]
|
||||
(set! (.-storage eavt) (.-storage (:eavt @conn)))
|
||||
eavt))]
|
||||
(d/reset-conn! conn new-db' {:reset-conn! true})
|
||||
(d/reset-schema! conn (:schema new-db)))))
|
||||
|
||||
(def-thread-api :thread-api/reset-db
|
||||
[repo db-transit]
|
||||
(reset-db! repo db-transit)
|
||||
nil)
|
||||
|
||||
(def-thread-api :thread-api/gc-graph
|
||||
[repo]
|
||||
(let [{:keys [db]} (get @worker-state/*sqlite-conns repo)
|
||||
conn (get @worker-state/*datascript-conns repo)]
|
||||
(when (and db conn)
|
||||
(log/info :gc-sqlite-dbs "gc current graph")
|
||||
(sqlite-gc/gc-kvs-table! db {:full-gc? true})
|
||||
(.exec db "VACUUM")
|
||||
(ldb/transact! conn [{:db/ident :logseq.kv/graph-last-gc-at
|
||||
:kv/value (common-util/time-ms)}]
|
||||
{:skip-validate-db? true
|
||||
:persist-op? false})
|
||||
nil)))
|
||||
19
src/main/frontend/worker/handler/markdown.cljs
Normal file
19
src/main/frontend/worker/handler/markdown.cljs
Normal file
@@ -0,0 +1,19 @@
|
||||
(ns frontend.worker.handler.markdown
|
||||
"Markdown mirror operations for the db worker."
|
||||
(:require [frontend.common.thread-api :refer [def-thread-api]]
|
||||
[frontend.worker.markdown-mirror :as markdown-mirror]
|
||||
[frontend.worker.state :as worker-state]))
|
||||
|
||||
(def-thread-api :thread-api/markdown-mirror-set-enabled
|
||||
[repo enabled?]
|
||||
(markdown-mirror/set-enabled! repo enabled?)
|
||||
nil)
|
||||
|
||||
(def-thread-api :thread-api/markdown-mirror-flush
|
||||
[repo]
|
||||
(markdown-mirror/<flush-repo! repo {}))
|
||||
|
||||
(def-thread-api :thread-api/markdown-mirror-regenerate
|
||||
[repo]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(markdown-mirror/<mirror-repo! repo @conn {})))
|
||||
312
src/main/frontend/worker/handler/page.cljs
Normal file
312
src/main/frontend/worker/handler/page.cljs
Normal file
@@ -0,0 +1,312 @@
|
||||
(ns frontend.worker.handler.page
|
||||
"Page operations"
|
||||
(:require [clojure.string :as string]
|
||||
[datascript.core :as d]
|
||||
[frontend.common.thread-api :refer [def-thread-api]]
|
||||
[frontend.worker.handler.block :as block-handler]
|
||||
[frontend.worker.plain-value :as worker-plain]
|
||||
[frontend.worker.state :as worker-state]
|
||||
[logseq.common.util :as common-util]
|
||||
[logseq.db :as ldb]
|
||||
[logseq.db.frontend.content :as db-content]
|
||||
[logseq.db.frontend.entity-util :as entity-util]
|
||||
[logseq.outliner.page :as outliner-page]
|
||||
[logseq.outliner.tree :as otree]))
|
||||
|
||||
(defn create!
|
||||
"Creates a page through the outliner page service.
|
||||
|
||||
Supported options:
|
||||
|
||||
* :uuid - when set, use this uuid instead of generating a new one; ignored
|
||||
when :journal? or :today-journal? uses a deterministic journal
|
||||
uuid from :block/journal-day.
|
||||
* :class? - create the page as a Tag class page.
|
||||
* :journal? - create the page as a Journal page.
|
||||
* :today-journal? - mark the create-page tx as today's journal creation.
|
||||
* :tags - tag uuids or tag entities added to :block/tags.
|
||||
* :properties - properties to add to the page.
|
||||
* :split-namespace? - create namespace parent pages for non-journal slash pages.
|
||||
* :class-ident-namespace - namespace used when creating a class ident.
|
||||
* :persist-op? - when true, persist the create-page outliner op."
|
||||
[conn title & {:as options}]
|
||||
(outliner-page/create! conn title options))
|
||||
|
||||
(defn delete!
|
||||
"Deletes a page through the outliner page service.
|
||||
|
||||
Returns true when the page can be deleted. If deletion is rejected, calls
|
||||
:error-handler and returns false.
|
||||
|
||||
Supported options:
|
||||
|
||||
* :persist-op? - when true, persist the delete-page outliner op.
|
||||
* :rename? - mark the tx as part of a rename flow.
|
||||
* :error-handler - callback invoked with {:msg string} on rejection.
|
||||
* :deleted-by-uuid - user uuid recorded in the delete op metadata.
|
||||
* :now-ms - timestamp recorded in the delete op metadata."
|
||||
[conn page-uuid & {:as options}]
|
||||
(outliner-page/delete! conn page-uuid options))
|
||||
|
||||
(defn- page-route-info
|
||||
[db page-id-name-or-uuid]
|
||||
(when-let [page (ldb/get-page db page-id-name-or-uuid)]
|
||||
(let [alias-source (ldb/get-alias-source-page db (:db/id page))]
|
||||
(cond-> {:page-id (:db/id page)
|
||||
:page-uuid (:block/uuid page)
|
||||
:page-title (:block/title page)
|
||||
:hidden? (boolean (ldb/hidden? page))
|
||||
:property? (boolean (ldb/property? page))
|
||||
:built-in? (boolean (ldb/built-in? page))
|
||||
:private-built-in? (boolean (and (ldb/built-in? page)
|
||||
(ldb/private-built-in-page? page)))}
|
||||
(:logseq.property/heading page)
|
||||
(assoc :block-page-name (get-in page [:block/page :block/name])
|
||||
:block-route-name (some->> (:block/title page)
|
||||
(re-find #"^#{0,}\s*(.*)(?:\n|$)")
|
||||
second
|
||||
string/lower-case))
|
||||
|
||||
(:block/uuid alias-source)
|
||||
(assoc :alias-source-id (:db/id alias-source)
|
||||
:alias-source-uuid (:block/uuid alias-source))))))
|
||||
|
||||
(def-thread-api :thread-api/get-page-route-info
|
||||
[repo page-id-name-or-uuid]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(page-route-info @conn page-id-name-or-uuid)))
|
||||
|
||||
(defn- heading-content->route-name
|
||||
[block-content]
|
||||
(some->> block-content
|
||||
(re-find #"^#{0,}\s*(.*)(?:\n|$)")
|
||||
second
|
||||
string/lower-case))
|
||||
|
||||
(defn- heading-route-candidates
|
||||
[db page-id]
|
||||
(mapv #(d/entity db %)
|
||||
(d/q '[:find [?block ...]
|
||||
:in $ ?page-id
|
||||
:where
|
||||
[?block :block/page ?page-id]
|
||||
[?block :logseq.property/heading]
|
||||
[?block :block/title]]
|
||||
db
|
||||
page-id)))
|
||||
|
||||
(defn- heading-route-name
|
||||
[block]
|
||||
(let [ref-tags (distinct (concat (:block/tags block) (:block/refs block)))]
|
||||
(-> (:block/title block)
|
||||
(db-content/id-ref->title-ref ref-tags)
|
||||
(db-content/content-id-ref->page ref-tags)
|
||||
heading-content->route-name)))
|
||||
|
||||
(defn block-route-resolution
|
||||
"Resolve a named heading route together with its page and candidate headings."
|
||||
[db page-id-name-or-uuid route-name]
|
||||
(when-let [page (ldb/get-page db page-id-name-or-uuid)]
|
||||
(let [candidates (heading-route-candidates db (:db/id page))
|
||||
normalized-route-name (string/lower-case route-name)]
|
||||
{:page page
|
||||
:candidates candidates
|
||||
:block (some (fn [block]
|
||||
(when (= normalized-route-name
|
||||
(heading-route-name block))
|
||||
block))
|
||||
candidates)})))
|
||||
|
||||
(defn- block-by-page-name-and-block-route-name
|
||||
[db page-id-name-or-uuid route-name]
|
||||
(some-> (block-route-resolution db page-id-name-or-uuid route-name)
|
||||
:block
|
||||
(select-keys [:block/uuid])))
|
||||
|
||||
(def-thread-api :thread-api/get-block-by-page-name-and-block-route-name
|
||||
[repo page-id-name-or-uuid route-name]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(block-by-page-name-and-block-route-name @conn page-id-name-or-uuid route-name)))
|
||||
|
||||
(defn- page-entity->summary
|
||||
[page]
|
||||
(when page
|
||||
{:db/id (:db/id page)
|
||||
:block/uuid (:block/uuid page)
|
||||
:block/title (:block/title page)
|
||||
:block/raw-title (:block/raw-title page)
|
||||
:block/name (:block/name page)
|
||||
:block/journal-day (:block/journal-day page)}))
|
||||
|
||||
(def-thread-api :thread-api/get-journal-page-by-day
|
||||
[repo journal-day]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(some-> (ldb/get-journal-page-by-day @conn journal-day)
|
||||
page-entity->summary)))
|
||||
|
||||
(def-thread-api :thread-api/get-latest-journals
|
||||
[repo n]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(mapv page-entity->summary
|
||||
(take n (ldb/get-latest-journals @conn)))))
|
||||
|
||||
(def-thread-api :thread-api/page-exists?
|
||||
[repo page-name tags]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(boolean (seq (ldb/page-exists? @conn page-name tags)))))
|
||||
|
||||
(def-thread-api :thread-api/get-case-page
|
||||
[repo page-name-or-uuid]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(some-> (ldb/get-case-page @conn page-name-or-uuid)
|
||||
entity-util/entity->map)))
|
||||
|
||||
(def-thread-api :thread-api/get-tags-by-name
|
||||
[repo name]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(->> (entity-util/get-pages-by-name @conn name)
|
||||
(keep (fn [datom]
|
||||
(some-> (d/entity @conn (:e datom))
|
||||
entity-util/entity->map)))
|
||||
(filter ldb/class?)
|
||||
vec)))
|
||||
|
||||
(def-thread-api :thread-api/get-block-parent
|
||||
[repo block-uuid]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(some-> (d/entity @conn [:block/uuid block-uuid])
|
||||
:block/parent
|
||||
entity-util/entity->map)))
|
||||
|
||||
(defn- block-ref-entity
|
||||
[db block-ref]
|
||||
(cond
|
||||
(uuid? block-ref)
|
||||
(d/entity db [:block/uuid block-ref])
|
||||
|
||||
(and (string? block-ref) (common-util/uuid-string? block-ref))
|
||||
(d/entity db [:block/uuid (uuid block-ref)])
|
||||
|
||||
:else
|
||||
(d/entity db block-ref)))
|
||||
|
||||
(defn- block-page-info
|
||||
[db block-ref]
|
||||
(when-let [block (block-ref-entity db block-ref)]
|
||||
(when-let [page (:block/page block)]
|
||||
{:db/id (:db/id page)
|
||||
:block/uuid (:block/uuid page)
|
||||
:block/title (:block/title page)
|
||||
:block/name (:block/name page)})))
|
||||
|
||||
(def-thread-api :thread-api/get-block-page-info
|
||||
[repo block-ref]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(block-page-info @conn block-ref)))
|
||||
|
||||
(def-thread-api :thread-api/get-block-immediate-children
|
||||
[repo block-uuid]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(mapv entity-util/entity->map (ldb/get-children @conn block-uuid))))
|
||||
|
||||
(def-thread-api :thread-api/get-block-sibling
|
||||
[repo block-id direction]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(let [db @conn]
|
||||
(when-let [block (d/entity db block-id)]
|
||||
(let [sibling (case direction
|
||||
:left (ldb/get-left-sibling block)
|
||||
:right (ldb/get-right-sibling block)
|
||||
:last-child (some->> (:db/id block)
|
||||
(ldb/get-block-last-direct-child-id db)
|
||||
(d/entity db))
|
||||
nil)]
|
||||
(some->> sibling
|
||||
(#(worker-plain/entity-forward-map db % {}))
|
||||
worker-plain/with-explicit-ref-fields-recursive))))))
|
||||
|
||||
(defn- block-index-entry
|
||||
[block parent-ids level]
|
||||
{:db/id (:db/id block)
|
||||
:block/uuid (:block/uuid block)
|
||||
:block/parent {:db/id (:db/id (:block/parent block))}
|
||||
:block/order (:block/order block)
|
||||
:block/collapsed? (boolean (:block/collapsed? block))
|
||||
:block/level level
|
||||
:block.temp/has-children? (contains? parent-ids (:db/id block))})
|
||||
|
||||
(defn- visible-index-entries
|
||||
[index]
|
||||
(loop [entries index
|
||||
collapsed-level nil
|
||||
result []]
|
||||
(if-let [entry (first entries)]
|
||||
(let [level (:block/level entry)
|
||||
hidden? (and collapsed-level (> level collapsed-level))
|
||||
collapsed-level (cond
|
||||
hidden? collapsed-level
|
||||
(:block/collapsed? entry) level
|
||||
:else nil)]
|
||||
(recur (next entries)
|
||||
collapsed-level
|
||||
(cond-> result (not hidden?) (conj entry))))
|
||||
result)))
|
||||
|
||||
(defn- get-page-block-index
|
||||
[db page-id-name-or-uuid initial-limit]
|
||||
(assert (pos-int? initial-limit))
|
||||
(when-let [root (or (block-ref-entity db page-id-name-or-uuid)
|
||||
(ldb/get-page db page-id-name-or-uuid))]
|
||||
(let [tree-entities (vec (ldb/get-block-and-children db (:block/uuid root)))
|
||||
children (subvec tree-entities 1)
|
||||
parent-ids (into #{} (keep #(some-> % :block/parent :db/id)) children)
|
||||
levels (volatile! {(:db/id root) 0})
|
||||
index (mapv (fn [block]
|
||||
(let [parent-id (:db/id (:block/parent block))
|
||||
level (inc (get @levels parent-id 0))]
|
||||
(vswap! levels assoc (:db/id block) level)
|
||||
(block-index-entry block parent-ids level)))
|
||||
children)
|
||||
initial-ids (->> index
|
||||
visible-index-entries
|
||||
(take initial-limit)
|
||||
(map :db/id))
|
||||
blocks (mapv (fn [block-id]
|
||||
(:block (block-handler/get-block-and-children
|
||||
db block-id {:children? false
|
||||
:render-data? true})))
|
||||
initial-ids)
|
||||
block (:block (block-handler/get-block-and-children
|
||||
db (:db/id root) {:children? false
|
||||
:render-data? true}))]
|
||||
{:block block
|
||||
:index index
|
||||
:blocks blocks})))
|
||||
|
||||
(def-thread-api :thread-api/get-page-blocks-tree
|
||||
[repo page-id-name-or-uuid & [option]]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(let [db @conn]
|
||||
(if-let [initial-limit (:initial-limit option)]
|
||||
(get-page-block-index db page-id-name-or-uuid initial-limit)
|
||||
(when-let [page (ldb/get-page db page-id-name-or-uuid)]
|
||||
(otree/blocks->vec-tree db (ldb/get-page-blocks db (:db/id page)) (:db/id page)))))))
|
||||
|
||||
(defn- route-title-info
|
||||
[db route-name]
|
||||
(let [page (ldb/get-page db route-name)]
|
||||
(if (and page (ldb/page? page))
|
||||
{:page-title (:block/title page)}
|
||||
(when (common-util/uuid-string? route-name)
|
||||
(when-let [block (d/entity db [:block/uuid (uuid route-name)])]
|
||||
{:block-title (:block/title block)})))))
|
||||
|
||||
(def-thread-api :thread-api/get-route-title
|
||||
[repo route-name]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(route-title-info @conn route-name)))
|
||||
|
||||
(def-thread-api :thread-api/get-file-content
|
||||
[repo path]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(:file/content (d/entity @conn [:file/path path]))))
|
||||
862
src/main/frontend/worker/handler/property.cljs
Normal file
862
src/main/frontend/worker/handler/property.cljs
Normal file
@@ -0,0 +1,862 @@
|
||||
(ns frontend.worker.handler.property
|
||||
"Property and class operations for the db worker."
|
||||
(:require [clojure.walk :as walk]
|
||||
[datascript.core :as d]
|
||||
[datascript.impl.entity :as de]
|
||||
[frontend.common.thread-api :refer [def-thread-api]]
|
||||
[frontend.worker-common.util :as worker-util]
|
||||
[frontend.worker.plain-value :as worker-plain]
|
||||
[frontend.worker.state :as worker-state]
|
||||
[logseq.db :as ldb]
|
||||
[logseq.db.common.entity-plus :as entity-plus]
|
||||
[logseq.db.common.order :as db-order]
|
||||
[logseq.db.common.view :as db-view]
|
||||
[logseq.db.frontend.class :as db-class]
|
||||
[logseq.db.frontend.content :as db-content]
|
||||
[logseq.db.frontend.entity-util :as entity-util]
|
||||
[logseq.db.frontend.property :as db-property]
|
||||
[logseq.outliner.core :as outliner-core]
|
||||
[logseq.outliner.property :as outliner-property]
|
||||
[logseq.outliner.validate :as outliner-validate]))
|
||||
|
||||
(defn- first-url-property-value
|
||||
[db block-id]
|
||||
(when-let [block (d/entity db block-id)]
|
||||
(some (fn [datom]
|
||||
(let [property-id (:a datom)]
|
||||
(when (db-property/property? property-id)
|
||||
(when-let [property (d/entity db property-id)]
|
||||
(when (= :url (:logseq.property/type property))
|
||||
(let [value (:v datom)
|
||||
value (if (number? value) (d/entity db value) value)]
|
||||
(or (:block/title value)
|
||||
(when (string? value) value))))))))
|
||||
(d/datoms db :eavt (:db/id block)))))
|
||||
|
||||
(def-thread-api :thread-api/get-first-url-property-value
|
||||
[repo block-id]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(first-url-property-value @conn block-id)))
|
||||
|
||||
(defn get-all-classes
|
||||
[db {:keys [except-root-class? except-private-tags? except-extends-hidden-tags?]
|
||||
:or {except-root-class? false
|
||||
except-private-tags? true
|
||||
except-extends-hidden-tags? false}}]
|
||||
(let [classes (->> (d/datoms db :avet :block/tags :logseq.class/Tag)
|
||||
(map (fn [datom]
|
||||
(d/entity db (:e datom))))
|
||||
(remove ldb/recycled?)
|
||||
(remove (fn [class]
|
||||
(and except-private-tags?
|
||||
(contains? ldb/private-tags (:db/ident class)))))
|
||||
(remove (fn [class]
|
||||
(and except-extends-hidden-tags?
|
||||
(contains? ldb/extends-hidden-tags (:db/ident class))))))]
|
||||
(cond->> classes
|
||||
except-root-class?
|
||||
(remove #(= :logseq.class/Root (:db/ident %)))
|
||||
|
||||
true
|
||||
(map entity-util/entity->map))))
|
||||
|
||||
(defn class-extends-children-tree
|
||||
([db class-id]
|
||||
(class-extends-children-tree db class-id #{}))
|
||||
([db class-id seen]
|
||||
(when-not (contains? seen class-id)
|
||||
(let [seen' (conj seen class-id)]
|
||||
(->> (d/datoms db :avet :logseq.property.class/extends class-id)
|
||||
(keep (fn [datom]
|
||||
(when-let [child (d/entity db (:e datom))]
|
||||
(assoc (select-keys (entity-util/entity->map child)
|
||||
[:db/id :block/title :block/uuid :db/ident])
|
||||
:class/children
|
||||
(class-extends-children-tree db (:e datom) seen')))))
|
||||
(sort-by :block/title)
|
||||
vec)))))
|
||||
|
||||
(def ^:private broad-scoped-node-class-idents
|
||||
#{:logseq.class/Page})
|
||||
|
||||
(defn- broad-scoped-node-property?
|
||||
[property classes]
|
||||
(and (= :node (:logseq.property/type property))
|
||||
(some #(contains? broad-scoped-node-class-idents (:db/ident %)) classes)))
|
||||
|
||||
(defn- property-node-selector-values
|
||||
[db property option]
|
||||
(let [values (db-view/get-property-values db (:db/ident property) option)]
|
||||
(if (= :db.type/ref (:db/valueType property))
|
||||
(mapv
|
||||
(fn [choice]
|
||||
(if-let [entity (some->> (get-in choice [:value :db/id])
|
||||
(d/entity db))]
|
||||
(assoc choice :value
|
||||
(cond->
|
||||
(worker-plain/entity-forward-map
|
||||
db entity
|
||||
{:properties [:db/ident :block/uuid :block/tags :block/alias]})
|
||||
(seq (:block/_alias entity))
|
||||
(assoc :block/alias-source-page-id
|
||||
(:db/id (first (:block/_alias entity))))))
|
||||
choice))
|
||||
values)
|
||||
values)))
|
||||
|
||||
(defn- property-node-selector-initial-choices
|
||||
[db property non-root-classes option]
|
||||
(cond
|
||||
(= :property (:logseq.property/type property))
|
||||
nil
|
||||
|
||||
(seq non-root-classes)
|
||||
(if (broad-scoped-node-property? property non-root-classes)
|
||||
(property-node-selector-values db property option)
|
||||
(->> non-root-classes
|
||||
(mapcat (fn [class] (db-class/get-class-objects db (:db/id class))))
|
||||
distinct
|
||||
(mapv #(worker-plain/worker-plain-value db %))))
|
||||
|
||||
:else
|
||||
(property-node-selector-values db property option)))
|
||||
|
||||
(defn property-node-selector-data
|
||||
[db {:keys [property block] :as option}]
|
||||
(let [all-classes (get-all-classes db {:except-root-class? false
|
||||
:except-private-tags? false})
|
||||
class-options (get-all-classes db {:except-root-class? true
|
||||
:except-private-tags? (not (contains? #{:logseq.property/template-applied-to}
|
||||
(:db/ident property)))})
|
||||
extends-class-options (get-all-classes db {:except-extends-hidden-tags? true})
|
||||
classes (:logseq.property/classes property)
|
||||
class? (= :class (:logseq.property/type property))
|
||||
tag-class (some (fn [class]
|
||||
(when (= :logseq.class/Tag (:db/ident class))
|
||||
class))
|
||||
all-classes)
|
||||
non-root-classes (cond-> (remove (fn [class]
|
||||
(= (:db/ident class) :logseq.class/Root))
|
||||
classes)
|
||||
(and class? tag-class)
|
||||
(conj tag-class))
|
||||
extends-property? (= (:db/ident property) :logseq.property.class/extends)
|
||||
class-ids (->> (concat all-classes classes [(when extends-property? block)])
|
||||
(keep :db/id)
|
||||
distinct)
|
||||
structured-children-by-class-id (->> class-ids
|
||||
(map (fn [class-id]
|
||||
[class-id (db-class/get-structured-children db class-id)]))
|
||||
(into {}))
|
||||
extends-by-class-id (->> class-ids
|
||||
(map (fn [class-id]
|
||||
[class-id
|
||||
(mapv entity-util/entity->map
|
||||
(ldb/get-class-extends (d/entity db class-id)))]))
|
||||
(into {}))]
|
||||
{:all-classes all-classes
|
||||
:class-options class-options
|
||||
:extends-class-options extends-class-options
|
||||
:structured-children-by-class-id structured-children-by-class-id
|
||||
:extends-by-class-id extends-by-class-id
|
||||
:initial-choices (property-node-selector-initial-choices db property non-root-classes option)}))
|
||||
|
||||
(def-thread-api :thread-api/get-all-classes
|
||||
[repo opts]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(get-all-classes @conn opts)))
|
||||
|
||||
(def-thread-api :thread-api/get-structured-children
|
||||
[repo class-id]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(db-class/get-structured-children @conn class-id)))
|
||||
|
||||
(def-thread-api :thread-api/get-class-extends-children-tree
|
||||
[repo class-id]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(class-extends-children-tree @conn class-id)))
|
||||
|
||||
(def-thread-api :thread-api/get-block-class-default-properties
|
||||
[repo block-id]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(let [db @conn]
|
||||
(when-let [classes-properties (some-> (outliner-property/get-block-classes-properties db block-id)
|
||||
:classes-properties)]
|
||||
(->> classes-properties
|
||||
(keep (fn [property]
|
||||
(when-let [default-value (:logseq.property/default-value property)]
|
||||
[(:db/ident property)
|
||||
(if (:db/id default-value)
|
||||
(entity-util/entity->map default-value)
|
||||
default-value)])))
|
||||
(into {}))))))
|
||||
|
||||
(def-thread-api :thread-api/get-class-properties
|
||||
[repo class-id]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(let [db @conn]
|
||||
(when-let [class (d/entity db class-id)]
|
||||
(mapv #(worker-plain/entity-forward-map db % {})
|
||||
(outliner-property/get-class-properties class))))))
|
||||
|
||||
(def-thread-api :thread-api/get-alias-source-page
|
||||
[repo page-id]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(some-> (ldb/get-alias-source-page @conn page-id)
|
||||
entity-util/entity->map)))
|
||||
|
||||
(def-thread-api :thread-api/get-property-closed-values
|
||||
[repo property-ident]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(when-let [property (d/entity @conn property-ident)]
|
||||
(mapv (fn [entity]
|
||||
(select-keys (entity-util/entity->map entity)
|
||||
[:db/id :block/uuid :block/title :block/order
|
||||
:logseq.property/value
|
||||
:logseq.property/icon
|
||||
:logseq.property/choice-checkbox-state]))
|
||||
(:block/_closed-value-property property)))))
|
||||
|
||||
(def-thread-api :thread-api/get-property-node-selector-data
|
||||
[repo option]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(property-node-selector-data @conn option)))
|
||||
|
||||
(def-thread-api :thread-api/get-class-objects
|
||||
[repo class-id]
|
||||
(let [db @(worker-state/get-datascript-conn repo)]
|
||||
(->> (db-class/get-class-objects db class-id)
|
||||
(map #(worker-plain/worker-plain-value db %))
|
||||
worker-plain/with-explicit-ref-fields-recursive)))
|
||||
|
||||
(def-thread-api :thread-api/validate-block-tag
|
||||
[repo block-id tag-id]
|
||||
(let [db @(worker-state/get-datascript-conn repo)
|
||||
block (d/entity db [:block/uuid block-id])
|
||||
tag (d/entity db tag-id)]
|
||||
(try
|
||||
(outliner-validate/validate-unique-by-name-and-tags
|
||||
db
|
||||
(:block/title block)
|
||||
(update block :block/tags (fnil conj #{}) tag))
|
||||
{:valid? true}
|
||||
(catch :default e
|
||||
(if (= :notification (:type (ex-data e)))
|
||||
{:valid? false
|
||||
:payload (:payload (ex-data e))}
|
||||
(throw e))))))
|
||||
|
||||
(defn- convert-tag-to-page-tx
|
||||
[db class-id]
|
||||
(let [objects (db-class/get-class-objects db class-id)
|
||||
page-txs [[:db/retract class-id :db/ident]
|
||||
[:db/retract class-id :block/tags :logseq.class/Tag]
|
||||
[:db/retract class-id :logseq.property.class/extends]
|
||||
[:db/retract class-id :logseq.property.class/properties]
|
||||
[:db/add class-id :block/tags :logseq.class/Page]]
|
||||
object-txs (mapcat (fn [obj]
|
||||
[{:db/id (:db/id obj)
|
||||
:block/title (db-content/replace-tag-refs-with-page-refs
|
||||
(:block/title obj)
|
||||
(:block/tags obj))}
|
||||
[:db/retract (:db/id obj) :block/tags class-id]])
|
||||
objects)]
|
||||
(vec (concat page-txs object-txs))))
|
||||
|
||||
(def-thread-api :thread-api/convert-tag-to-page
|
||||
[repo class-id]
|
||||
(let [conn (worker-state/get-datascript-conn repo)]
|
||||
(worker-state/set-db-latest-tx-time! repo)
|
||||
(ldb/transact! conn
|
||||
(convert-tag-to-page-tx @conn class-id)
|
||||
{:outliner-op :save-block})
|
||||
nil))
|
||||
|
||||
(defn- convert-page-to-tag-tx
|
||||
[db page-id]
|
||||
(let [page (d/entity db page-id)
|
||||
class-tx (db-class/build-new-class db
|
||||
{:block/uuid (:block/uuid page)
|
||||
:block/title (:block/title page)
|
||||
:block/created-at (:block/created-at page)})]
|
||||
[class-tx
|
||||
[:db/retract page-id :block/tags :logseq.class/Page]]))
|
||||
|
||||
(def-thread-api :thread-api/convert-page-to-tag
|
||||
[repo page-id]
|
||||
(let [conn (worker-state/get-datascript-conn repo)]
|
||||
(worker-state/set-db-latest-tx-time! repo)
|
||||
(ldb/transact! conn
|
||||
(convert-page-to-tag-tx @conn page-id)
|
||||
{:outliner-op :save-block})
|
||||
nil))
|
||||
|
||||
(def-thread-api :thread-api/get-property-values
|
||||
[repo {:keys [property-ident] :as option}]
|
||||
(let [conn (worker-state/get-datascript-conn repo)]
|
||||
(db-view/get-property-values @conn property-ident option)))
|
||||
|
||||
(def-thread-api :thread-api/get-bidirectional-properties
|
||||
[repo {:keys [target-id]}]
|
||||
(let [conn (worker-state/get-datascript-conn repo)]
|
||||
(worker-util/profile "get-bidirectional-properties"
|
||||
(ldb/get-bidirectional-properties @conn target-id))))
|
||||
|
||||
(defn- ui-non-suitable-property?
|
||||
[block property {:keys [class-schema?]}]
|
||||
(when block
|
||||
(let [block-page? (entity-util/page? block)
|
||||
block-types (let [types (entity-util/get-entity-types block)]
|
||||
(cond-> types
|
||||
(and block-page? (not (contains? types :page)))
|
||||
(conj :page)
|
||||
(empty? types)
|
||||
(conj :block)))
|
||||
view-context (get property :logseq.property/view-context :all)]
|
||||
(or (contains? #{:logseq.property/query} (:db/ident property))
|
||||
(and (not block-page?) (contains? #{:block/alias} (:db/ident property)))
|
||||
(and (not= view-context :all) (not (contains? block-types view-context)))
|
||||
(and (entity-util/built-in? block) (contains? #{:logseq.property.class/extends} (:db/ident property)))
|
||||
(and class-schema? (db-property/public-built-in-property? property) (:logseq.property/view-context property))))))
|
||||
|
||||
(declare display-property-map*)
|
||||
|
||||
(defn- get-all-properties
|
||||
[db {:keys [remove-built-in-property? remove-non-queryable-built-in-property? remove-ui-non-suitable-properties?
|
||||
class-schema? block]
|
||||
:or {remove-built-in-property? true
|
||||
remove-non-queryable-built-in-property? false
|
||||
remove-ui-non-suitable-properties? false}}]
|
||||
(let [result (sort-by (juxt (fn [property]
|
||||
(some-> (:db/ident property)
|
||||
(db-property/plugin-property?)))
|
||||
entity-util/built-in?
|
||||
:block/title)
|
||||
(remove entity-util/recycled?
|
||||
(ldb/get-all-properties db)))]
|
||||
(cond->> result
|
||||
remove-built-in-property?
|
||||
(remove (fn [property]
|
||||
(let [ident (:db/ident property)]
|
||||
(and (entity-util/built-in? property)
|
||||
(not (db-property/public-built-in-property? property))
|
||||
(not= ident :logseq.property/icon)))))
|
||||
remove-non-queryable-built-in-property?
|
||||
(remove (fn [property]
|
||||
(let [ident (:db/ident property)]
|
||||
(and (entity-util/built-in? property)
|
||||
(not (:queryable? (db-property/built-in-properties ident)))))))
|
||||
remove-ui-non-suitable-properties?
|
||||
(remove (fn [property]
|
||||
(ui-non-suitable-property? block property {:class-schema? class-schema?})))
|
||||
true
|
||||
(map (fn [property]
|
||||
(let [display-property (display-property-map* db (:db/id property))
|
||||
raw-title (or (:block/raw-title property)
|
||||
(:block/title property)
|
||||
(:block/name property))]
|
||||
(cond-> display-property
|
||||
raw-title
|
||||
(assoc :block/raw-title raw-title)
|
||||
|
||||
(:logseq.property/deleted-at property)
|
||||
(assoc :logseq.property/deleted-at
|
||||
(:logseq.property/deleted-at property)))))))))
|
||||
|
||||
(def-thread-api :thread-api/get-all-properties
|
||||
[repo opts]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(get-all-properties @conn opts)))
|
||||
|
||||
(def-thread-api :thread-api/validate-property-value
|
||||
[repo {:keys [property value]}]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(outliner-property/validate-property-value @conn property value)))
|
||||
|
||||
(def-thread-api :thread-api/reorder-display-property
|
||||
[repo {:keys [block-id active-ident over-ident direction property-idents]}]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(let [db @conn
|
||||
sorted-properties (db-property/sort-properties
|
||||
(keep #(d/entity db %) property-idents))
|
||||
normalize-tx-data (db-property/normalize-sorted-entities-block-order sorted-properties)
|
||||
move-down? (= direction :down)
|
||||
over (d/entity db over-ident)
|
||||
active (d/entity db active-ident)
|
||||
over-order (:block/order over)
|
||||
new-order (if move-down?
|
||||
(let [next-order (db-order/get-next-order db nil (:db/id over))]
|
||||
(db-order/gen-key over-order next-order))
|
||||
(let [prev-order (db-order/get-prev-order db nil (:db/id over))]
|
||||
(db-order/gen-key prev-order over-order)))]
|
||||
(ldb/transact! conn
|
||||
(conj (vec normalize-tx-data)
|
||||
{:block/uuid (:block/uuid active)
|
||||
:block/order new-order}
|
||||
(outliner-core/block-with-updated-at
|
||||
{:db/id block-id}))
|
||||
{:outliner-op :save-block}))))
|
||||
|
||||
(def ^:private display-property-keys
|
||||
[:db/id
|
||||
:db/ident
|
||||
:block/title
|
||||
:block/uuid
|
||||
:block/name
|
||||
:block/order
|
||||
:block/tags
|
||||
:db/cardinality
|
||||
:logseq.property/type
|
||||
:logseq.property/public?
|
||||
:logseq.property/built-in?
|
||||
:logseq.property/hide?
|
||||
:logseq.property/hide-empty-value
|
||||
:logseq.property/ui-position
|
||||
:logseq.property/view-context
|
||||
:logseq.property/scalar-default-value
|
||||
:logseq.property/default-value])
|
||||
|
||||
(def ^:private display-property-value-keys
|
||||
[:db/id
|
||||
:db/ident
|
||||
:block/title
|
||||
:block/uuid
|
||||
:block/order
|
||||
:logseq.property/value
|
||||
:logseq.property/icon
|
||||
:logseq.property/choice-checkbox-state
|
||||
:logseq.property/choice-classes
|
||||
:logseq.property/deleted-at])
|
||||
|
||||
(defn- entity-direct-values
|
||||
[db entity-or-id attr]
|
||||
(let [eid (cond
|
||||
(number? entity-or-id) entity-or-id
|
||||
(map? entity-or-id) (:db/id entity-or-id)
|
||||
:else (:db/id (d/entity db entity-or-id)))]
|
||||
(map :v (d/datoms db :eavt eid attr))))
|
||||
|
||||
(defn entity-direct-value
|
||||
[db entity-or-id attr]
|
||||
(first (entity-direct-values db entity-or-id attr)))
|
||||
|
||||
(defn entity-direct-map
|
||||
[db entity keys]
|
||||
(if (de/entity? entity)
|
||||
(select-keys (worker-plain/entity-forward-map db entity {}) keys)
|
||||
(select-keys entity keys)))
|
||||
|
||||
(defn- display-property-description
|
||||
[db property]
|
||||
(when-let [description-id (entity-direct-value db property :logseq.property/description)]
|
||||
(when-let [description (d/entity db description-id)]
|
||||
(entity-direct-map db description [:db/id :block/title :block/uuid]))))
|
||||
|
||||
(defn- display-property-closed-values
|
||||
[db property]
|
||||
(->> (d/datoms db :avet :block/closed-value-property (:db/id property))
|
||||
(keep (fn [datom]
|
||||
(when-let [value (d/entity db (:e datom))]
|
||||
(when-not (ldb/recycled? value)
|
||||
value))))
|
||||
(sort-by :block/order)
|
||||
(mapv #(entity-direct-map db % display-property-value-keys))))
|
||||
|
||||
(defn- display-property-map*
|
||||
[db property-id]
|
||||
(when-let [entity (d/entity db property-id)]
|
||||
(let [description (display-property-description db entity)
|
||||
closed-values (display-property-closed-values db entity)]
|
||||
(cond-> (entity-direct-map db entity display-property-keys)
|
||||
description
|
||||
(assoc :logseq.property/description description)
|
||||
|
||||
(seq closed-values)
|
||||
(assoc :property/closed-values closed-values)))))
|
||||
|
||||
(defn display-property-map
|
||||
[db property-id]
|
||||
(display-property-map* db property-id))
|
||||
|
||||
(defn- display-property-value
|
||||
[db property-id value]
|
||||
(worker-plain/attribute-value->plain db property-id value))
|
||||
|
||||
(defn- entity-tagged-with?
|
||||
[db entity tag-ident]
|
||||
(some (fn [datom]
|
||||
(= tag-ident (:db/ident (d/entity db (:v datom)))))
|
||||
(d/datoms db :eavt (:db/id entity) :block/tags)))
|
||||
|
||||
(defn- block-class-properties
|
||||
[db block]
|
||||
(if-let [block-id (:db/id block)]
|
||||
(outliner-property/get-block-classes-properties db block-id)
|
||||
(let [classes (->> (:block/tags block)
|
||||
(keep (fn [tag]
|
||||
(d/entity db (if (map? tag)
|
||||
(or (:db/id tag) (:db/ident tag))
|
||||
tag))))
|
||||
(filter ldb/class?)
|
||||
(sort-by :block/name))
|
||||
class-parents (outliner-property/get-classes-parents classes)
|
||||
all-classes (->> (concat classes class-parents)
|
||||
(filter (comp seq :logseq.property.class/properties)))
|
||||
classes-properties (->> all-classes
|
||||
(mapcat :logseq.property.class/properties)
|
||||
distinct)]
|
||||
{:all-classes all-classes
|
||||
:classes-properties classes-properties})))
|
||||
|
||||
(defn display-properties-for-block
|
||||
[db block]
|
||||
(let [properties (if (de/entity? block)
|
||||
(->> (d/datoms db :eavt (:db/id block))
|
||||
(keep (fn [{:keys [a v]}]
|
||||
(when (db-property/property? a)
|
||||
[a (display-property-value db a v)])))
|
||||
(reduce (fn [result [property-id value]]
|
||||
(if (= :db.cardinality/many
|
||||
(or (get-in (d/schema db) [property-id :db/cardinality])
|
||||
(entity-direct-value db property-id :db/cardinality)))
|
||||
(update result property-id (fnil conj #{}) value)
|
||||
(assoc result property-id value)))
|
||||
{}))
|
||||
(:block/properties block))]
|
||||
(cond-> properties
|
||||
(and (entity-tagged-with? db block :logseq.class/Tag)
|
||||
(not (ldb/built-in? block)))
|
||||
(update :logseq.property.class/enable-bidirectional? #(if (nil? %) false %)))))
|
||||
|
||||
(defn- entity-ref-value?
|
||||
[value]
|
||||
(and (map? value)
|
||||
(or (contains? value :db/id)
|
||||
(contains? value :block/uuid))))
|
||||
|
||||
(defn- contains-recycled-entity-value?
|
||||
[value]
|
||||
(cond
|
||||
(entity-ref-value? value)
|
||||
(ldb/recycled? value)
|
||||
|
||||
(and (coll? value) (not (map? value)))
|
||||
(some (fn [item]
|
||||
(and (entity-ref-value? item)
|
||||
(ldb/recycled? item)))
|
||||
value)
|
||||
|
||||
:else
|
||||
false))
|
||||
|
||||
(defn- filter-recycled-entity-values
|
||||
[value]
|
||||
(let [active-entity-value? (fn [item]
|
||||
(or (not (entity-ref-value? item))
|
||||
(not (ldb/recycled? item))))]
|
||||
(cond
|
||||
(and (entity-ref-value? value) (ldb/recycled? value))
|
||||
nil
|
||||
|
||||
(set? value)
|
||||
(let [value' (set (filter active-entity-value? value))]
|
||||
(when (seq value') value'))
|
||||
|
||||
(vector? value)
|
||||
(let [value' (vec (filter active-entity-value? value))]
|
||||
(when (seq value') value'))
|
||||
|
||||
(and (coll? value) (not (map? value)))
|
||||
(let [value' (vec (filter active-entity-value? value))]
|
||||
(when (seq value') value'))
|
||||
|
||||
:else
|
||||
value)))
|
||||
|
||||
(defn- sanitize-property-values-for-display
|
||||
[properties]
|
||||
(reduce-kv
|
||||
(fn [{:keys [properties recycled-only-property-ids] :as result} property-id property-value]
|
||||
(let [property-value' (filter-recycled-entity-values property-value)]
|
||||
(if (and (nil? property-value')
|
||||
(contains-recycled-entity-value? property-value))
|
||||
(assoc result
|
||||
:properties (assoc properties property-id nil)
|
||||
:recycled-only-property-ids (conj recycled-only-property-ids property-id))
|
||||
(assoc result :properties (assoc properties property-id property-value')))))
|
||||
{:properties {}
|
||||
:recycled-only-property-ids #{}}
|
||||
properties))
|
||||
|
||||
(defn- display-property-row
|
||||
[db property-id value]
|
||||
(when-let [property (display-property-map* db property-id)]
|
||||
{:property-id property-id
|
||||
:property property
|
||||
:value value}))
|
||||
|
||||
(defn- sort-display-property-pairs
|
||||
[db property-pairs]
|
||||
(let [property-pair-map (into {} property-pairs)
|
||||
sorted-properties (db-property/sort-properties
|
||||
(keep (fn [[property-id _]]
|
||||
(d/entity db property-id))
|
||||
property-pairs))]
|
||||
(keep (fn [property]
|
||||
(when-let [[property-id value] (find property-pair-map (:db/ident property))]
|
||||
(display-property-row db property-id value)))
|
||||
sorted-properties)))
|
||||
|
||||
(defn display-properties
|
||||
[db block {:keys [gallery-view? page-title? sidebar-properties? tag-dialog?
|
||||
publishing? state-hide-empty-properties?]} show-empty-and-hidden-properties?]
|
||||
(let [block-entity (or (some->> (:db/id block) (d/entity db)) block)
|
||||
page-properties-area? (and (or page-title?
|
||||
sidebar-properties?
|
||||
tag-dialog?)
|
||||
(or (entity-tagged-with? db block-entity :logseq.class/Page)
|
||||
(entity-tagged-with? db block-entity :logseq.class/Tag)
|
||||
(entity-tagged-with? db block-entity :logseq.class/Property)
|
||||
(entity-tagged-with? db block-entity :logseq.class/Journal)))
|
||||
properties* (display-properties-for-block db block-entity)
|
||||
{:keys [properties recycled-only-property-ids]}
|
||||
(sanitize-property-values-for-display properties*)
|
||||
remove-built-in-or-other-position-properties
|
||||
(fn [property-pairs show-in-hidden-properties?]
|
||||
(remove (fn [property]
|
||||
(let [id (if (vector? property) (first property) property)]
|
||||
(or
|
||||
(= id :block/tags)
|
||||
(when-let [ent (d/entity db id)]
|
||||
(or
|
||||
(and (not (ldb/public-built-in-property? ent))
|
||||
(ldb/built-in? ent))
|
||||
(when-not (or page-properties-area?
|
||||
show-empty-and-hidden-properties?
|
||||
show-in-hidden-properties?)
|
||||
(outliner-property/property-with-other-position? db block-entity ent))
|
||||
(and gallery-view?
|
||||
(contains? #{:logseq.property.class/properties} (:db/ident ent))))))))
|
||||
property-pairs))
|
||||
{:keys [all-classes classes-properties]}
|
||||
(block-class-properties db block-entity)
|
||||
classes-properties-set (set (map :db/ident classes-properties))
|
||||
block-own-properties (->> properties
|
||||
(remove (fn [[id _]] (contains? recycled-only-property-ids id)))
|
||||
(remove (fn [[id _]] (classes-properties-set id))))
|
||||
hide-with-property-id (fn [property-id]
|
||||
(let [property (d/entity db property-id)]
|
||||
(boolean
|
||||
(cond
|
||||
show-empty-and-hidden-properties?
|
||||
false
|
||||
state-hide-empty-properties?
|
||||
(nil? (get properties property-id))
|
||||
(and (:logseq.property/hide-empty-value property)
|
||||
(nil? (get properties property-id)))
|
||||
true
|
||||
:else
|
||||
(boolean (:logseq.property/hide? property))))))
|
||||
property-hide-f (cond
|
||||
publishing?
|
||||
(fn [[property-id property-value]]
|
||||
(or (nil? property-value)
|
||||
(hide-with-property-id property-id)))
|
||||
state-hide-empty-properties?
|
||||
(fn [[property-id property-value]]
|
||||
(if (:logseq.property/hide? (d/entity db property-id))
|
||||
(hide-with-property-id property-id)
|
||||
(nil? property-value)))
|
||||
:else
|
||||
(comp hide-with-property-id first))
|
||||
{block-hidden-properties true
|
||||
block-own-properties' false} (group-by property-hide-f block-own-properties)
|
||||
class-properties (loop [classes all-classes
|
||||
existing-properties (set (map first block-own-properties'))
|
||||
result []]
|
||||
(if-let [class (first classes)]
|
||||
(let [cur-properties (->> (:logseq.property.class/properties class)
|
||||
db-property/sort-properties
|
||||
(map :db/ident)
|
||||
(remove existing-properties))]
|
||||
(recur (rest classes)
|
||||
(into existing-properties cur-properties)
|
||||
(if (seq cur-properties)
|
||||
(into result cur-properties)
|
||||
result)))
|
||||
result))
|
||||
class-property-pairs (->> class-properties
|
||||
(map (fn [property-id] [property-id (get properties property-id)]))
|
||||
(remove (fn [[property-id _]]
|
||||
(contains? recycled-only-property-ids property-id))))
|
||||
full-properties (-> (concat block-own-properties'
|
||||
(remove property-hide-f class-property-pairs))
|
||||
(remove-built-in-or-other-position-properties false))
|
||||
hidden-properties (remove (fn [[property-id _]]
|
||||
(= property-id :logseq.property/query))
|
||||
(remove-built-in-or-other-position-properties
|
||||
(concat block-hidden-properties
|
||||
(filter property-hide-f class-property-pairs))
|
||||
true))]
|
||||
{:full-properties (vec (sort-display-property-pairs db full-properties))
|
||||
:hidden-properties (vec (sort-display-property-pairs db hidden-properties))
|
||||
:description-property
|
||||
(display-property-map* db :logseq.property/description)
|
||||
:class-properties-property
|
||||
(display-property-map* db :logseq.property.class/properties)}))
|
||||
|
||||
(def-thread-api :thread-api/get-display-properties
|
||||
[repo {:keys [block opts show-empty-and-hidden-properties?]}]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(display-properties @conn block opts show-empty-and-hidden-properties?)))
|
||||
|
||||
(def render-property-positions
|
||||
[:block-left :block-right :block-below])
|
||||
|
||||
(defn- render-schema-or-tag-related-property?
|
||||
[property-id]
|
||||
(let [property-ns (some-> property-id namespace)]
|
||||
(or (= :block/tags property-id)
|
||||
(= "logseq.property.class" property-ns)
|
||||
(contains? db-property/schema-properties property-id))))
|
||||
|
||||
(defn- render-tag-class-page?
|
||||
[db block]
|
||||
(or (= :logseq.class/Tag (:db/ident block))
|
||||
(ldb/class-instance? (entity-plus/entity-memoized db :logseq.class/Tag) block)))
|
||||
|
||||
(defn direct-block-property-ids
|
||||
[db block-id]
|
||||
(->> (d/datoms db :eavt block-id)
|
||||
(keep (fn [datom]
|
||||
(let [property-id (:a datom)]
|
||||
(when (db-property/property? property-id)
|
||||
property-id))))
|
||||
distinct))
|
||||
|
||||
(defn- property-has-closed-values?
|
||||
[db property]
|
||||
(boolean (seq (d/datoms db :avet :block/closed-value-property (:db/id property)))))
|
||||
|
||||
(defn- render-bottom-position-property?
|
||||
[db property]
|
||||
(let [property-id (:db/ident property)
|
||||
property-type (:logseq.property/type property)
|
||||
node-many? (and (= :node property-type)
|
||||
(= :db.cardinality/many (:db/cardinality property)))]
|
||||
(and (not (contains? #{:url :asset} property-type))
|
||||
(or node-many?
|
||||
(not= :default property-type)
|
||||
(property-has-closed-values? db property))
|
||||
(not (render-schema-or-tag-related-property? property-id)))))
|
||||
|
||||
(defn- render-property-position
|
||||
[db property]
|
||||
(let [ui-position (:logseq.property/ui-position property)]
|
||||
(cond
|
||||
(contains? #{:properties :block-left :block-right :block-below} ui-position)
|
||||
ui-position
|
||||
|
||||
(render-bottom-position-property? db property)
|
||||
:block-below
|
||||
|
||||
:else
|
||||
:properties)))
|
||||
|
||||
(defn- block-direct-property-value
|
||||
[db block-id property-id]
|
||||
(entity-direct-value db block-id property-id))
|
||||
|
||||
(defn- render-positioned-property?
|
||||
[db block-id property-id position {:keys [allow-empty-block-below?]}]
|
||||
(when-let [property (d/entity db property-id)]
|
||||
(let [property-position (render-property-position db property)
|
||||
property-value (block-direct-property-value db block-id property-id)]
|
||||
(and
|
||||
(not (false? (:logseq.property/public? property)))
|
||||
(= property-position position)
|
||||
(not (and (:logseq.property/hide-empty-value property)
|
||||
(nil? property-value)))
|
||||
(not (:logseq.property/hide? property))
|
||||
(not (and
|
||||
(= property-position :block-below)
|
||||
(nil? property-value)
|
||||
(not allow-empty-block-below?)
|
||||
(not (render-tag-class-page? db (d/entity db block-id)))))))))
|
||||
|
||||
(defn- block-positioned-property-ids
|
||||
[db block-id position]
|
||||
(let [block (d/entity db block-id)
|
||||
class-page? (render-tag-class-page? db block)
|
||||
own-property-ids (direct-block-property-ids db block-id)
|
||||
classes-properties (when-not class-page?
|
||||
(:classes-properties (block-class-properties db block)))
|
||||
classes-property-ids-set (set (map :db/ident classes-properties))
|
||||
property-ids (if class-page?
|
||||
own-property-ids
|
||||
(->> classes-properties
|
||||
(map :db/ident)
|
||||
(concat own-property-ids)
|
||||
distinct))]
|
||||
(->> property-ids
|
||||
(filter (fn [property-id]
|
||||
(render-positioned-property? db block-id property-id position
|
||||
{:allow-empty-block-below?
|
||||
(contains? classes-property-ids-set property-id)})))
|
||||
(keep #(d/entity db %))
|
||||
db-property/sort-properties
|
||||
(map :db/ident))))
|
||||
|
||||
(defn block-positioned-properties
|
||||
[db block-id position]
|
||||
(->> (block-positioned-property-ids db block-id position)
|
||||
(keep #(display-property-map* db %))
|
||||
vec))
|
||||
|
||||
(defn- sort-by-order-recursive
|
||||
[form]
|
||||
(walk/postwalk (fn [value]
|
||||
(if (and (map? value)
|
||||
(:block/_parent value))
|
||||
(let [children (:block/_parent value)]
|
||||
(-> value
|
||||
(dissoc :block/_parent)
|
||||
(assoc :block/children (ldb/sort-by-order children))))
|
||||
value))
|
||||
form))
|
||||
|
||||
(defn- group-by-page
|
||||
[blocks]
|
||||
(if (:block/page (first blocks))
|
||||
(some->> blocks
|
||||
(group-by :block/page))
|
||||
blocks))
|
||||
|
||||
(def ^:private scheduled-deadline-pull-selector
|
||||
'[:*
|
||||
{:block/page [:db/id :block/title :block/uuid]}])
|
||||
|
||||
(defn- get-date-scheduled-or-deadlines
|
||||
[db start-time end-time]
|
||||
(->> (d/q '[:find [(pull ?block ?block-attrs) ...]
|
||||
:in $ ?start-time ?end-time ?block-attrs
|
||||
:where
|
||||
(or [?block :logseq.property/scheduled ?n]
|
||||
[?block :logseq.property/deadline ?n])
|
||||
[(>= ?n ?start-time)]
|
||||
[(<= ?n ?end-time)]
|
||||
[?block :logseq.property/status ?status]
|
||||
[?status :db/ident ?status-ident]
|
||||
[(not= ?status-ident :logseq.property/status.done)]
|
||||
[(not= ?status-ident :logseq.property/status.canceled)]]
|
||||
db
|
||||
start-time
|
||||
end-time
|
||||
scheduled-deadline-pull-selector)
|
||||
sort-by-order-recursive
|
||||
group-by-page))
|
||||
|
||||
(def-thread-api :thread-api/get-date-scheduled-or-deadlines
|
||||
[repo start-time end-time]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(get-date-scheduled-or-deadlines @conn start-time end-time)))
|
||||
287
src/main/frontend/worker/handler/query.cljs
Normal file
287
src/main/frontend/worker/handler/query.cljs
Normal file
@@ -0,0 +1,287 @@
|
||||
(ns frontend.worker.handler.query
|
||||
"Query operations for the db worker."
|
||||
(:require [cljs.reader]
|
||||
[clojure.string :as string]
|
||||
[clojure.walk :as walk]
|
||||
[datascript.core :as d]
|
||||
[frontend.common.thread-api :refer [def-thread-api]]
|
||||
[frontend.worker.query-dsl :as query-dsl]
|
||||
[frontend.worker.state :as worker-state]
|
||||
[logseq.common.util :as common-util]
|
||||
[logseq.common.util.page-ref :as page-ref]
|
||||
[logseq.db :as ldb]
|
||||
[logseq.db.common.initial-data :as common-initial-data]
|
||||
[logseq.db.frontend.datalog :as datalog-util]
|
||||
[logseq.db.frontend.inputs :as db-inputs]
|
||||
[logseq.db.frontend.rules :as rules]))
|
||||
|
||||
(def-thread-api :thread-api/q
|
||||
[repo inputs]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(apply d/q (first inputs) @conn (rest inputs))))
|
||||
|
||||
(def-thread-api :thread-api/query-dsl-query
|
||||
[repo query-string opts]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(query-dsl/execute-query query-string @conn opts)))
|
||||
|
||||
(def-thread-api :thread-api/query-dsl-custom-query
|
||||
[repo query-m opts]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(query-dsl/execute-custom-query query-m @conn opts)))
|
||||
|
||||
(def-thread-api :thread-api/datoms
|
||||
[repo & args]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(let [result (apply d/datoms @conn args)]
|
||||
(map (fn [datom] [(:e datom) (:a datom) (:v datom) (:tx datom) (:added datom)]) result))))
|
||||
|
||||
(def-thread-api :thread-api/pull
|
||||
[repo selector id]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(let [eid (if (and (vector? id) (= :block/name (first id)))
|
||||
(:db/id (ldb/get-page @conn (second id)))
|
||||
id)]
|
||||
(some->> eid
|
||||
(d/pull @conn selector)
|
||||
(common-initial-data/with-parent @conn)))))
|
||||
|
||||
(defn- block-status-history
|
||||
[db block-id]
|
||||
(->> (d/q '[:find ?history ?created-at ?status
|
||||
:in $ ?block-id
|
||||
:where
|
||||
[?history :logseq.property.history/block ?block-id]
|
||||
[?history :logseq.property.history/property :logseq.property/status]
|
||||
[?history :logseq.property.history/ref-value ?status]
|
||||
[?history :block/created-at ?created-at]]
|
||||
db
|
||||
block-id)
|
||||
(map (fn [[history-id created-at status-id]]
|
||||
(let [status (d/entity db status-id)]
|
||||
{:db/id history-id
|
||||
:block/created-at created-at
|
||||
:logseq.property.history/property-ident :logseq.property/status
|
||||
:logseq.property.history/ref-value-ident (:db/ident status)
|
||||
:logseq.property.history/ref-value-uuid (:block/uuid status)
|
||||
:logseq.property.history/ref-value-title (:block/title status)})))
|
||||
(sort-by :block/created-at)))
|
||||
|
||||
(defn task-spent-time
|
||||
[db block-id now-ms]
|
||||
(let [status-history (block-status-history db block-id)]
|
||||
(when (seq status-history)
|
||||
(let [time (loop [[last-item item & others] status-history
|
||||
time 0]
|
||||
(if item
|
||||
(let [last-status (:logseq.property.history/ref-value-ident last-item)
|
||||
this-status (:logseq.property.history/ref-value-ident item)]
|
||||
(if (and (= this-status :logseq.property/status.doing)
|
||||
(empty? others))
|
||||
(-> (+ time (- now-ms (:block/created-at item)))
|
||||
(quot 1000))
|
||||
(let [time' (if (or
|
||||
(= last-status :logseq.property/status.doing)
|
||||
(and
|
||||
(not (contains? #{:logseq.property/status.canceled
|
||||
:logseq.property/status.backlog
|
||||
:logseq.property/status.done} last-status))
|
||||
(= this-status :logseq.property/status.done)))
|
||||
(+ time (- (:block/created-at item) (:block/created-at last-item)))
|
||||
time)]
|
||||
(recur (cons item others) time'))))
|
||||
(quot time 1000)))]
|
||||
[(vec status-history) time]))))
|
||||
|
||||
(def-thread-api :thread-api/task-spent-time
|
||||
[repo block-id]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(task-spent-time @conn block-id (common-util/time-ms))))
|
||||
|
||||
(defn- query-input-value
|
||||
[input]
|
||||
(if (and (string? input)
|
||||
(not (page-ref/page-ref? input)))
|
||||
(try
|
||||
(let [value (cljs.reader/read-string input)]
|
||||
(if (symbol? value)
|
||||
input
|
||||
value))
|
||||
(catch :default _
|
||||
input))
|
||||
input))
|
||||
|
||||
(defn- fail!
|
||||
[message data]
|
||||
(throw (ex-info message data)))
|
||||
|
||||
(defn- resolve-page-ref-equality
|
||||
[query]
|
||||
(let [page-ref? #(and (string? %) (page-ref/page-ref? %))]
|
||||
(walk/postwalk
|
||||
(fn [form]
|
||||
(if (and (list? form)
|
||||
(= (first form) '=)
|
||||
(= 3 (count form))
|
||||
(some page-ref? (rest form)))
|
||||
(let [[left right] (rest form)
|
||||
[page-reference sym] (if (page-ref? left)
|
||||
[left right]
|
||||
[right left])]
|
||||
(list 'contains?
|
||||
sym
|
||||
(page-ref/get-page-name
|
||||
(string/lower-case page-reference))))
|
||||
form))
|
||||
query)))
|
||||
|
||||
(defn- query-current-page-title
|
||||
[db {:keys [current-page current-page-title current-block-uuid]}]
|
||||
(or current-page-title
|
||||
(some-> (and current-block-uuid
|
||||
(d/entity db [:block/uuid current-block-uuid]))
|
||||
:block/page
|
||||
:block/title)
|
||||
(some-> (and current-page (ldb/get-page db current-page))
|
||||
:block/title)))
|
||||
|
||||
(defn- resolve-custom-query-input
|
||||
[db input {:keys [current-block-uuid today-day require-today-day?]
|
||||
:as context}]
|
||||
(let [resolved-input (query-input-value input)
|
||||
current-page-title (query-current-page-title db context)]
|
||||
(case resolved-input
|
||||
:today
|
||||
(when (and require-today-day? (nil? today-day))
|
||||
(fail! "Query today input requires :today-day" {}))
|
||||
|
||||
:current-page
|
||||
(when-not current-page-title
|
||||
(fail! "Query current-page input requires a current page" {}))
|
||||
|
||||
(:query-page :current-block :parent-block)
|
||||
(when-not current-block-uuid
|
||||
(fail! "Query block input requires :current-block-uuid"
|
||||
{:input resolved-input}))
|
||||
|
||||
nil)
|
||||
(if (and (= :today resolved-input) (some? today-day))
|
||||
today-day
|
||||
(db-inputs/resolve-input
|
||||
db resolved-input
|
||||
{:current-block-uuid current-block-uuid
|
||||
:current-page-fn (constantly current-page-title)}))))
|
||||
|
||||
(defn- add-query-rules
|
||||
[{:keys [query] user-rules :rules :as query-m}]
|
||||
(let [{:keys [where in]} (datalog-util/query-vec->map query)
|
||||
rules-found (datalog-util/find-rules-in-where
|
||||
where (set (keys rules/db-query-dsl-rules)))
|
||||
built-in-rules (rules/extract-rules
|
||||
rules/db-query-dsl-rules
|
||||
rules-found
|
||||
{:deps rules/rules-dependencies})
|
||||
rules-input (vec (distinct (concat (or user-rules []) built-in-rules)))
|
||||
rules-required? (or (seq rules-input) (some #{'%} in))
|
||||
query-with-rules (if (and rules-required? (not (some #{'%} in)))
|
||||
(if (contains? (set query) :in)
|
||||
(datalog-util/add-to-end-of-query-section query :in ['%])
|
||||
(into query [:in '$ '%]))
|
||||
query)]
|
||||
(assoc query-m
|
||||
:query query-with-rules
|
||||
:rules-input (when rules-required? rules-input)
|
||||
:rules-required? (boolean rules-required?))))
|
||||
|
||||
(defn custom-query-watch-dependencies
|
||||
[query-m]
|
||||
(let [{:keys [where]} (datalog-util/query-vec->map (:query query-m))
|
||||
built-in-rules (set (keys rules/db-query-dsl-rules))
|
||||
rules-found (set (datalog-util/find-rules-in-where where built-in-rules))
|
||||
opaque-rules (disj rules-found :task)
|
||||
forms (tree-seq coll? seq [(:query query-m) (:rules query-m)])
|
||||
task-vars (into #{}
|
||||
(keep (fn [form]
|
||||
(when (and (sequential? form)
|
||||
(= 'task (first form))
|
||||
(symbol? (second form)))
|
||||
(second form))))
|
||||
forms)
|
||||
datom-clauses (filterv (fn [form]
|
||||
(and (vector? form)
|
||||
(<= 2 (count form))
|
||||
(qualified-keyword? (second form))))
|
||||
forms)
|
||||
task-attrs (into #{}
|
||||
(comp
|
||||
(filter #(contains? task-vars (first %)))
|
||||
(map second))
|
||||
datom-clauses)
|
||||
regular-clause-attrs (into #{}
|
||||
(comp
|
||||
(remove #(contains? task-vars (first %)))
|
||||
(map second))
|
||||
datom-clauses)
|
||||
clause-attrs (into #{} (map second) datom-clauses)
|
||||
all-attrs (into #{} (filter qualified-keyword?) forms)
|
||||
attrs (into regular-clause-attrs (remove clause-attrs) all-attrs)]
|
||||
{:attrs attrs
|
||||
:task-attrs task-attrs
|
||||
:tasks? (contains? rules-found :task)
|
||||
:opaque? (boolean (seq opaque-rules))}))
|
||||
|
||||
(defn execute-custom-query
|
||||
[db query-m context]
|
||||
(when-not (and (map? query-m)
|
||||
(vector? (:query query-m))
|
||||
(= :find (first (:query query-m)))
|
||||
(or (not (contains? query-m :inputs))
|
||||
(vector? (:inputs query-m)))
|
||||
(or (not (contains? query-m :rules))
|
||||
(vector? (:rules query-m))))
|
||||
(fail! "Invalid custom query" {:query query-m}))
|
||||
(let [{query-form :query
|
||||
inputs :inputs
|
||||
rules-input :rules-input
|
||||
rules-required? :rules-required?} (add-query-rules query-m)
|
||||
resolved-query (resolve-page-ref-equality query-form)
|
||||
resolved-inputs (mapv #(resolve-custom-query-input db % context) inputs)
|
||||
query-args (cond-> resolved-inputs
|
||||
rules-required? (conj rules-input))]
|
||||
(apply d/q resolved-query db query-args)))
|
||||
|
||||
(defn- require-query-context!
|
||||
[context]
|
||||
(when-not (and (map? context)
|
||||
(every? #{:current-page :current-page-title} (keys context))
|
||||
(or (not (contains? context :current-page))
|
||||
(uuid? (:current-page context))
|
||||
(and (string? (:current-page context))
|
||||
(not (string/blank? (:current-page context)))))
|
||||
(or (not (contains? context :current-page-title))
|
||||
(and (string? (:current-page-title context))
|
||||
(not (string/blank? (:current-page-title context))))))
|
||||
(fail! "Invalid custom query context" {:context context}))
|
||||
context)
|
||||
|
||||
(def-thread-api :thread-api/query-custom
|
||||
[repo query-m context]
|
||||
(require-query-context! context)
|
||||
(if-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(execute-custom-query @conn query-m context)
|
||||
(fail! "Missing custom query database" {:repo repo})))
|
||||
|
||||
(def-thread-api :thread-api/resolve-query-inputs
|
||||
[repo inputs {:keys [current-page current-page-title today-title]}]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(let [current-page-title (or current-page-title
|
||||
(some-> (when current-page
|
||||
(ldb/get-page @conn current-page))
|
||||
:block/title))]
|
||||
(mapv (fn [input]
|
||||
(db-inputs/resolve-input @conn
|
||||
(query-input-value input)
|
||||
{:current-page-fn (fn []
|
||||
(or current-page-title
|
||||
today-title))}))
|
||||
inputs))))
|
||||
406
src/main/frontend/worker/handler/render_resource/basic.cljs
Normal file
406
src/main/frontend/worker/handler/render_resource/basic.cljs
Normal file
@@ -0,0 +1,406 @@
|
||||
(ns frontend.worker.handler.render-resource.basic
|
||||
"Page, block, journal, and other simple renderer resources."
|
||||
(:require [clojure.string :as string]
|
||||
[datascript.core :as d]
|
||||
[frontend.common.reaction :as reaction]
|
||||
[frontend.worker.handler.block :as block-handler]
|
||||
[frontend.worker.handler.comments :as comments-handler]
|
||||
[frontend.worker.handler.page :as worker-page]
|
||||
[frontend.worker.handler.property :as property-handler]
|
||||
[frontend.worker.handler.query :as query-handler]
|
||||
[frontend.worker.handler.render-resource.common :as common]
|
||||
[logseq.common.config :as common-config]
|
||||
[logseq.common.util :as common-util]
|
||||
[logseq.db :as ldb]))
|
||||
|
||||
(defn- sidebar-page-summary
|
||||
[page]
|
||||
(cond-> (select-keys page
|
||||
[:db/id
|
||||
:block/uuid
|
||||
:block/title
|
||||
:block/raw-title
|
||||
:block/name
|
||||
:block/journal-day
|
||||
:logseq.property/icon
|
||||
:logseq.property.asset/type])
|
||||
(seq (:block/tags page))
|
||||
(assoc :block/tags
|
||||
(mapv #(select-keys % [:db/id :db/ident :logseq.property/icon])
|
||||
(:block/tags page)))))
|
||||
|
||||
(defn- favorites-page
|
||||
[db]
|
||||
(or (ldb/get-page db common-config/favorites-page-name)
|
||||
(common/fail! "Missing favorites page" {})))
|
||||
|
||||
(defn- favorite-targets
|
||||
[db]
|
||||
(->> (favorites-page db)
|
||||
:db/id
|
||||
(ldb/get-page-blocks db)
|
||||
ldb/sort-by-order
|
||||
(keep :block/link)
|
||||
(map #(d/entity db (:db/id %)))
|
||||
(remove ldb/recycled?)
|
||||
vec))
|
||||
|
||||
(defn- favorites
|
||||
[db _resource-key _runtime]
|
||||
(let [favorites-page-uuid (:block/uuid (favorites-page db))
|
||||
targets (favorite-targets db)]
|
||||
[(into #{[:children favorites-page-uuid]}
|
||||
(map (fn [page] [:entity (:block/uuid page)]))
|
||||
targets)
|
||||
(mapv sidebar-page-summary targets)]))
|
||||
|
||||
(defn- favorite-status
|
||||
[db resource-key _runtime]
|
||||
(let [page-uuid (common/require-uuid! :page-uuid (second resource-key))
|
||||
favorites-page-uuid (:block/uuid (favorites-page db))]
|
||||
[#{[:children favorites-page-uuid]}
|
||||
(boolean (some #(= page-uuid (:block/uuid %))
|
||||
(favorite-targets db)))]))
|
||||
|
||||
(defn- recent-pages
|
||||
[db resource-key _runtime]
|
||||
(let [page-ids (second resource-key)]
|
||||
(when-not (and (vector? page-ids) (every? integer? page-ids))
|
||||
(common/fail! "Invalid recent page IDs" {:page-ids page-ids}))
|
||||
(let [pages (->> page-ids
|
||||
distinct
|
||||
(take 20)
|
||||
(keep #(d/entity db %))
|
||||
(filter ldb/page?)
|
||||
(remove ldb/hidden?)
|
||||
(remove (fn [page]
|
||||
(or (and (ldb/property? page)
|
||||
(true? (:logseq.property/hide? page)))
|
||||
(string/blank? (:block/title page)))))
|
||||
vec)]
|
||||
[(into #{} (map (fn [page] [:entity (:block/uuid page)])) pages)
|
||||
(mapv sidebar-page-summary pages)])))
|
||||
|
||||
(defn- page-identity
|
||||
[db resource-key _runtime]
|
||||
(let [lookup (second resource-key)]
|
||||
(when-not (or (uuid? lookup)
|
||||
(and (string? lookup) (not (string/blank? lookup))))
|
||||
(common/fail! "Invalid page identity lookup" {:lookup lookup}))
|
||||
(let [watch-lookup (if (string? lookup)
|
||||
(common-util/page-name-sanity-lc lookup)
|
||||
lookup)]
|
||||
[#{[:page-lookup watch-lookup]}
|
||||
(some-> (ldb/get-page db lookup) :block/uuid)])))
|
||||
|
||||
(defn- page-preview-source
|
||||
[db resource-key _runtime]
|
||||
(let [page-uuid (common/require-uuid! :page-uuid (second resource-key))
|
||||
page (common/entity-by-uuid! db :page-uuid page-uuid)
|
||||
source (or (ldb/get-alias-source-page db (:db/id page)) page)]
|
||||
[#{[:entity page-uuid]
|
||||
[:attr :block/alias]}
|
||||
(common/entity-uuid! db (:db/id source))]))
|
||||
|
||||
(defn- breadcrumb-ref-titles
|
||||
[entities]
|
||||
(into {}
|
||||
(comp
|
||||
(mapcat :block/refs)
|
||||
(keep (fn [ref]
|
||||
(when-let [ref-uuid (:block/uuid ref)]
|
||||
(let [title (:block/title ref)]
|
||||
(when-not (string? title)
|
||||
(common/fail! "Invalid breadcrumb reference title"
|
||||
{:ref-uuid ref-uuid
|
||||
:title title}))
|
||||
[ref-uuid title])))))
|
||||
entities))
|
||||
|
||||
(defn- block-breadcrumb
|
||||
[db resource-key _runtime]
|
||||
(let [[_ block-uuid load-depth] resource-key
|
||||
block (common/entity-by-uuid! db :block-uuid block-uuid)]
|
||||
(when-not (and (integer? load-depth) (pos? load-depth))
|
||||
(common/fail! "Invalid breadcrumb load depth" {:load-depth load-depth}))
|
||||
(let [parents (vec (ldb/get-block-parents db block-uuid {:depth load-depth}))
|
||||
page (:block/page block)
|
||||
ancestor-blocks (if (and page
|
||||
(not= (:db/id page) (:db/id (first parents))))
|
||||
(into [page] parents)
|
||||
parents)
|
||||
from-property (:logseq.property/created-from-property block)
|
||||
ancestor-blocks (cond-> ancestor-blocks
|
||||
from-property
|
||||
(conj from-property))
|
||||
ancestor-uuids (mapv (fn [ancestor]
|
||||
(common/entity-uuid! db (:db/id ancestor)))
|
||||
ancestor-blocks)
|
||||
ref-titles (breadcrumb-ref-titles (into [block] ancestor-blocks))
|
||||
watch-uuids (into (conj (set ancestor-uuids) block-uuid)
|
||||
(keys ref-titles))
|
||||
watch-keys (into #{}
|
||||
(map (fn [watch-uuid]
|
||||
[:entity watch-uuid]))
|
||||
watch-uuids)]
|
||||
[watch-keys
|
||||
{:target-uuid block-uuid
|
||||
:ancestor-uuids ancestor-uuids
|
||||
:ref-titles ref-titles}])))
|
||||
|
||||
(defn- journals
|
||||
[db _resource-key _runtime]
|
||||
[#{[:journals]}
|
||||
(mapv :block/uuid (ldb/get-latest-journals db))])
|
||||
|
||||
(defn- recycle-roots
|
||||
[db _resource-key _runtime]
|
||||
(let [roots (->> (d/q '[:find [?e ...]
|
||||
:where
|
||||
[?e :logseq.property/deleted-at]]
|
||||
db)
|
||||
(map #(d/entity db %))
|
||||
(sort-by :logseq.property/deleted-at #(compare %2 %1)))
|
||||
root-uuids (mapv :block/uuid roots)
|
||||
blocks (:blocks (block-handler/canonical-blocks db root-uuids))]
|
||||
[#{[:recycle-roots]}
|
||||
(mapv blocks root-uuids)]))
|
||||
|
||||
(defn- property-choices
|
||||
[db resource-key _runtime]
|
||||
(let [property-uuid (common/require-uuid! :property-uuid (second resource-key))
|
||||
property (common/entity-by-uuid! db :property-uuid property-uuid)
|
||||
choices (:property/closed-values
|
||||
(property-handler/display-property-map db (:db/id property)))
|
||||
watch-keys (into #{[:entity property-uuid]
|
||||
[:property-membership :block/closed-value-property]}
|
||||
(map (fn [choice]
|
||||
[:entity (:block/uuid choice)]))
|
||||
choices)]
|
||||
[watch-keys (vec choices)]))
|
||||
|
||||
(defn- block-reactions
|
||||
[db resource-key _runtime]
|
||||
(let [[_ target-uuid current-user-uuid] resource-key
|
||||
target (common/entity-by-uuid! db :target-uuid target-uuid)]
|
||||
(when-not (or (nil? current-user-uuid) (uuid? current-user-uuid))
|
||||
(common/fail! "Invalid reaction user UUID" {:current-user-uuid current-user-uuid}))
|
||||
(let [reactions (block-handler/block-reactions db (:db/id target))
|
||||
watch-keys (into #{[:reactions target-uuid]}
|
||||
(keep (fn [item]
|
||||
(when-let [creator-uuid
|
||||
(get-in item [:logseq.property/created-by-ref
|
||||
:block/uuid])]
|
||||
[:entity creator-uuid])))
|
||||
reactions)]
|
||||
[watch-keys (reaction/summarize reactions current-user-uuid)])))
|
||||
|
||||
(defn- block-ref-count
|
||||
[db resource-key _runtime]
|
||||
(let [block-uuid (second resource-key)
|
||||
block (common/entity-by-uuid! db :block-uuid block-uuid)]
|
||||
[#{[:refs block-uuid]}
|
||||
(ldb/get-block-refs-count db (:db/id block))]))
|
||||
|
||||
(defn- block-unlinked-ref-exists
|
||||
[db resource-key {:keys [repo]}]
|
||||
(let [block-uuid (second resource-key)
|
||||
block (common/entity-by-uuid! db :block-uuid block-uuid)]
|
||||
[#{}
|
||||
(block-handler/unlinked-reference-exists? db repo (:db/id block))]))
|
||||
|
||||
(defn- block-comment-threads
|
||||
[db resource-key _runtime]
|
||||
(let [block-uuid (second resource-key)]
|
||||
(common/entity-by-uuid! db :block-uuid block-uuid)
|
||||
[#{[:comments block-uuid]}
|
||||
(->> (comments-handler/get-comment-threads-for-block db block-uuid)
|
||||
ldb/sort-by-order
|
||||
(mapv #(common/require-uuid! :comment-thread-uuid
|
||||
(:block/uuid %))))]))
|
||||
|
||||
(defn- block-task-time
|
||||
[db resource-key _runtime]
|
||||
(let [block-uuid (second resource-key)
|
||||
block (common/entity-by-uuid! db :block-uuid block-uuid)
|
||||
[history seconds]
|
||||
(or (query-handler/task-spent-time db (:db/id block)
|
||||
(common-util/time-ms))
|
||||
[[] 0])]
|
||||
[#{[:task-time block-uuid]}
|
||||
{:history
|
||||
(mapv (fn [item]
|
||||
{:created-at (:block/created-at item)
|
||||
:status-uuid
|
||||
(common/require-uuid!
|
||||
:status-uuid
|
||||
(:logseq.property.history/ref-value-uuid item))})
|
||||
history)
|
||||
:seconds seconds}]))
|
||||
|
||||
(defn- route-block
|
||||
[db resource-key _runtime]
|
||||
(let [[_ page-lookup route-name] resource-key]
|
||||
(when-not (and (string? page-lookup) (not (string/blank? page-lookup)))
|
||||
(common/fail! "Invalid route page lookup" {:page-lookup page-lookup}))
|
||||
(when-not (and (string? route-name) (not (string/blank? route-name)))
|
||||
(common/fail! "Invalid block route name" {:route-name route-name}))
|
||||
(let [normalized-page-lookup (common-util/page-name-sanity-lc page-lookup)
|
||||
{:keys [page candidates block]}
|
||||
(worker-page/block-route-resolution db page-lookup route-name)
|
||||
page-uuid (when page
|
||||
(common/require-uuid! :page-uuid (:block/uuid page)))
|
||||
block-uuid (when block
|
||||
(common/require-uuid! :route-block-uuid (:block/uuid block)))
|
||||
referenced-uuids
|
||||
(into #{}
|
||||
(comp
|
||||
(mapcat #(concat (:block/tags %) (:block/refs %)))
|
||||
(map (fn [reference]
|
||||
(common/require-uuid! :route-reference-uuid
|
||||
(:block/uuid reference)))))
|
||||
candidates)
|
||||
watch-keys
|
||||
(if page
|
||||
(into #{[:page-lookup normalized-page-lookup]
|
||||
[:entity page-uuid]
|
||||
[:route-page page-uuid]}
|
||||
(map (fn [reference-uuid]
|
||||
[:entity reference-uuid]))
|
||||
referenced-uuids)
|
||||
#{[:page-lookup normalized-page-lookup]})]
|
||||
[watch-keys block-uuid])))
|
||||
|
||||
(defn- direct-child-entities
|
||||
[db page-uuid]
|
||||
(mapv (fn [[child-uuid]]
|
||||
(common/entity-by-uuid! db :child-uuid child-uuid))
|
||||
(:items (block-handler/direct-children-membership db page-uuid))))
|
||||
|
||||
(defn- comment-thread?
|
||||
[entity]
|
||||
(boolean
|
||||
(some #(= :logseq.class/Comments (:db/ident %))
|
||||
(:block/tags entity))))
|
||||
|
||||
(defn- comment-author-title
|
||||
[comment-block]
|
||||
(some-> comment-block
|
||||
:logseq.property/created-by-ref
|
||||
:block/title
|
||||
string/trim
|
||||
not-empty))
|
||||
|
||||
(defn- comment-author-uuid
|
||||
[comment-block]
|
||||
(when-let [author (:logseq.property/created-by-ref comment-block)]
|
||||
(common/require-uuid! :comment-author-uuid (:block/uuid author))))
|
||||
|
||||
(defn- block-comment-summary
|
||||
[db resource-key _runtime]
|
||||
(let [thread-uuid (second resource-key)
|
||||
thread (common/entity-by-uuid! db :thread-uuid thread-uuid)]
|
||||
(when-not (comment-thread? thread)
|
||||
(common/fail! "Renderer resource entity is not a comment thread"
|
||||
{:thread-uuid thread-uuid}))
|
||||
(let [comments (direct-child-entities db thread-uuid)
|
||||
_ (doseq [comment-block comments]
|
||||
(when-not (or (nil? (:block/created-at comment-block))
|
||||
(number? (:block/created-at comment-block)))
|
||||
(common/fail! "Invalid comment creation time"
|
||||
{:comment-uuid (:block/uuid comment-block)
|
||||
:created-at (:block/created-at comment-block)})))
|
||||
latest (last (sort-by #(or (:block/created-at %) 0) comments))
|
||||
watch-uuids (concat [thread-uuid]
|
||||
(map :block/uuid comments)
|
||||
(keep comment-author-uuid comments))
|
||||
watch-keys (into #{[:children thread-uuid]}
|
||||
(map (fn [watch-uuid]
|
||||
[:entity watch-uuid]))
|
||||
watch-uuids)]
|
||||
[watch-keys
|
||||
{:count (count comments)
|
||||
:latest-author (comment-author-title latest)
|
||||
:latest-created-at (:block/created-at latest)}])))
|
||||
|
||||
(defn- tagged-with-page?
|
||||
[child page-id]
|
||||
(some #(= page-id (:db/id %)) (:block/tags child)))
|
||||
|
||||
(defn- page-membership
|
||||
[db resource-key _runtime]
|
||||
(let [[_ page-uuid membership-kind current-user-uuid] resource-key
|
||||
page (common/entity-by-uuid! db :page-uuid page-uuid)
|
||||
children (direct-child-entities db page-uuid)]
|
||||
(case membership-kind
|
||||
:class
|
||||
(do
|
||||
(common/require-shape! resource-key :page-membership 3)
|
||||
[#{[:entity page-uuid]
|
||||
[:children page-uuid]
|
||||
[:class-membership page-uuid]}
|
||||
(->> children
|
||||
;; A class membership resource can remain subscribed for the
|
||||
;; transaction that converts its class to a page.
|
||||
(remove #(and (ldb/class? page)
|
||||
(tagged-with-page? % (:db/id page))))
|
||||
(mapv :block/uuid))])
|
||||
|
||||
:property
|
||||
(do
|
||||
(common/require-shape! resource-key :page-membership 3)
|
||||
(when-not (ldb/property? page)
|
||||
(common/fail! "Page membership target is not a property"
|
||||
{:page-uuid page-uuid}))
|
||||
(let [property-ident (:db/ident page)]
|
||||
[#{[:entity page-uuid]
|
||||
[:children page-uuid]
|
||||
[:property-membership property-ident]}
|
||||
(->> children
|
||||
(remove #(some? (property-handler/entity-direct-value
|
||||
db (:db/id %) property-ident)))
|
||||
(mapv :block/uuid))]))
|
||||
|
||||
:quick-add
|
||||
(do
|
||||
(common/require-shape! resource-key :page-membership 4)
|
||||
(when-not (= common-config/quick-add-page-name (:block/title page))
|
||||
(common/fail! "Page membership target is not quick add"
|
||||
{:page-uuid page-uuid}))
|
||||
(let [current-user
|
||||
(common/entity-by-uuid! db :current-user-uuid current-user-uuid)
|
||||
current-user-id (:db/id current-user)]
|
||||
[#{[:entity page-uuid]
|
||||
[:children page-uuid]
|
||||
[:attr :logseq.property/created-by-ref]}
|
||||
(->> children
|
||||
(filter (fn [child]
|
||||
(let [creator-id
|
||||
(property-handler/entity-direct-value
|
||||
db child :logseq.property/created-by-ref)]
|
||||
(or (nil? creator-id)
|
||||
(= current-user-id creator-id)))))
|
||||
(mapv :block/uuid))]))
|
||||
|
||||
(common/fail! "Unsupported page membership kind"
|
||||
{:membership-kind membership-kind
|
||||
:resource-key resource-key}))))
|
||||
|
||||
(def resource-renderers
|
||||
{:favorites (common/renderer 1 favorites)
|
||||
:favorite-status (common/renderer 2 favorite-status)
|
||||
:recent-pages (common/renderer 2 recent-pages)
|
||||
:page-identity (common/renderer 2 page-identity)
|
||||
:page-preview-source (common/renderer 2 page-preview-source)
|
||||
:block-breadcrumb (common/renderer 3 block-breadcrumb)
|
||||
:journals (common/renderer 1 journals)
|
||||
:recycle-roots (common/renderer 1 recycle-roots)
|
||||
:property-choices (common/renderer 2 property-choices)
|
||||
:block-reactions (common/renderer 3 block-reactions)
|
||||
:block-ref-count (common/renderer 2 block-ref-count)
|
||||
:block-unlinked-ref-exists (common/renderer 2 block-unlinked-ref-exists)
|
||||
:block-comment-threads (common/renderer 2 block-comment-threads)
|
||||
:block-comment-summary (common/renderer 2 block-comment-summary)
|
||||
:block-task-time (common/renderer 2 block-task-time)
|
||||
:route-block (common/renderer 3 route-block)
|
||||
:page-membership (common/renderer nil page-membership)})
|
||||
79
src/main/frontend/worker/handler/render_resource/common.cljs
Normal file
79
src/main/frontend/worker/handler/render_resource/common.cljs
Normal file
@@ -0,0 +1,79 @@
|
||||
(ns frontend.worker.handler.render-resource.common
|
||||
"Shared validation and serialization helpers for renderer resources."
|
||||
(:require [datascript.core :as d]
|
||||
[datascript.impl.entity :as de]))
|
||||
|
||||
(def watch-all ::watch-all)
|
||||
|
||||
(defn fail!
|
||||
[message data]
|
||||
(throw (ex-info message data)))
|
||||
|
||||
(defn renderer
|
||||
"Describe a renderer and its fixed resource-key arity."
|
||||
[shape render]
|
||||
{:shape shape
|
||||
:render render})
|
||||
|
||||
(defn invalid-resource-key-value
|
||||
[value]
|
||||
(cond
|
||||
(fn? value) :function
|
||||
(de/entity? value) :entity
|
||||
(map? value) (or (some invalid-resource-key-value (keys value))
|
||||
(some invalid-resource-key-value (vals value)))
|
||||
(coll? value) (some invalid-resource-key-value value)
|
||||
:else false))
|
||||
|
||||
(defn require-shape!
|
||||
[resource-key tag size]
|
||||
(when-not (and (vector? resource-key)
|
||||
(= tag (first resource-key))
|
||||
(= size (count resource-key)))
|
||||
(fail! "Invalid renderer resource key"
|
||||
{:resource-key resource-key
|
||||
:expected-tag tag
|
||||
:expected-size size})))
|
||||
|
||||
(defn require-uuid!
|
||||
[label value]
|
||||
(when-not (uuid? value)
|
||||
(fail! "Invalid renderer resource UUID" {label value}))
|
||||
value)
|
||||
|
||||
(defn entity-by-uuid!
|
||||
[db label value]
|
||||
(require-uuid! label value)
|
||||
(or (d/entity db [:block/uuid value])
|
||||
(fail! "Missing renderer resource entity" {label value})))
|
||||
|
||||
(defn entity-uuid!
|
||||
[db eid]
|
||||
(let [block-uuid (:block/uuid (d/entity db eid))]
|
||||
(when-not (uuid? block-uuid)
|
||||
(fail! "Renderer resource row has no UUID" {:db-id eid}))
|
||||
block-uuid))
|
||||
|
||||
(defn basis-rev
|
||||
[db]
|
||||
(let [rev (:max-tx db)]
|
||||
(when-not (and (integer? rev) (not (neg? rev)))
|
||||
(fail! "Invalid renderer resource revision" {:basis-rev rev}))
|
||||
rev))
|
||||
|
||||
(defn block-slots
|
||||
[blocks]
|
||||
(into {}
|
||||
(map (fn [[block-uuid block]]
|
||||
[[:block block-uuid]
|
||||
{:value block}]))
|
||||
blocks))
|
||||
|
||||
(defn block-bundle-slots
|
||||
[{:keys [blocks children]}]
|
||||
(into (block-slots blocks)
|
||||
(map (fn [[parent-uuid membership]]
|
||||
[[:children parent-uuid]
|
||||
{:tx-id (:parent-tx-id membership)
|
||||
:items (:items membership)}]))
|
||||
children))
|
||||
162
src/main/frontend/worker/handler/render_resource/engine.cljs
Normal file
162
src/main/frontend/worker/handler/render_resource/engine.cljs
Normal file
@@ -0,0 +1,162 @@
|
||||
(ns frontend.worker.handler.render-resource.engine
|
||||
"Renderer resource registry, batching, and thread API."
|
||||
(:require [frontend.common.thread-api :refer [def-thread-api]]
|
||||
[frontend.worker.handler.block :as block-handler]
|
||||
[frontend.worker.handler.render-resource.basic :as basic]
|
||||
[frontend.worker.handler.render-resource.common :as common]
|
||||
[frontend.worker.handler.render-resource.property :as property]
|
||||
[frontend.worker.handler.render-resource.query :as query]
|
||||
[frontend.worker.handler.render-resource.view :as view]
|
||||
[frontend.worker.state :as worker-state]))
|
||||
|
||||
(def resource-renderers
|
||||
(merge basic/resource-renderers
|
||||
property/resource-renderers
|
||||
view/resource-renderers
|
||||
query/resource-renderers
|
||||
{:block-sync-conflicts
|
||||
(common/renderer nil
|
||||
(fn [_db resource-key _runtime]
|
||||
(common/fail!
|
||||
"Renderer resource belongs to a non-DB provider"
|
||||
{:provider :sync-state
|
||||
:resource-key resource-key})))}))
|
||||
|
||||
(defn- resource-value
|
||||
[db resource-key runtime]
|
||||
(when-not (and (vector? resource-key) (seq resource-key))
|
||||
(common/fail! "Invalid renderer resource key"
|
||||
{:resource-key resource-key}))
|
||||
(case (common/invalid-resource-key-value resource-key)
|
||||
:function
|
||||
(common/fail! "Renderer resource keys cannot contain functions"
|
||||
{:resource-key resource-key})
|
||||
|
||||
:entity
|
||||
(common/fail! "Renderer resource keys cannot contain graph entities"
|
||||
{:resource-key resource-key})
|
||||
|
||||
(let [resource-kind (first resource-key)]
|
||||
(if-let [{:keys [shape render]} (get resource-renderers resource-kind)]
|
||||
(do
|
||||
(when shape
|
||||
(common/require-shape! resource-key resource-kind shape))
|
||||
(render db resource-key runtime))
|
||||
(common/fail! "Unknown renderer resource key"
|
||||
{:resource-key resource-key})))))
|
||||
|
||||
(defn- resource-entry
|
||||
[db resource-key runtime]
|
||||
(let [[watch value slots] (resource-value db resource-key runtime)
|
||||
watch-all? (= common/watch-all watch)
|
||||
watch-keys (if watch-all? #{} watch)]
|
||||
(when-not (set? watch-keys)
|
||||
(common/fail! "Invalid renderer resource watch keys"
|
||||
{:resource-key resource-key :watch watch}))
|
||||
{:watch-keys watch-keys
|
||||
:watch-all? watch-all?
|
||||
:value value
|
||||
:slots (or slots {})}))
|
||||
|
||||
(def ^:private snapshot-request-limits
|
||||
{:blocks 1000 :children 25 :resources 25})
|
||||
|
||||
(defn- require-snapshot-request!
|
||||
[request]
|
||||
(when-not (and (map? request)
|
||||
(= #{:blocks :children :resources} (set (keys request)))
|
||||
(some seq (vals request))
|
||||
(every? (fn [[kind values]]
|
||||
(and (vector? values)
|
||||
(<= (count values)
|
||||
(get snapshot-request-limits kind))
|
||||
(= values (vec (distinct values)))))
|
||||
request))
|
||||
(common/fail! "Invalid renderer snapshot request"
|
||||
{:request request :limits snapshot-request-limits}))
|
||||
request)
|
||||
|
||||
(defn- merge-slots
|
||||
[left right]
|
||||
(reduce-kv
|
||||
(fn [slots key value]
|
||||
(when-let [existing (get slots key)]
|
||||
(when-not (= existing value)
|
||||
(common/fail! "Conflicting renderer snapshot slots"
|
||||
{:slot-key key})))
|
||||
(assoc slots key value))
|
||||
left
|
||||
right))
|
||||
|
||||
(defn- block-snapshot-slots
|
||||
[db block-uuids]
|
||||
(let [{:keys [blocks groups]}
|
||||
(block-handler/canonical-blocks db block-uuids)]
|
||||
{:slots (reduce (fn [slots block-uuid]
|
||||
(if (contains? blocks block-uuid)
|
||||
slots
|
||||
(assoc slots [:block block-uuid] {:missing? true})))
|
||||
(common/block-slots blocks)
|
||||
block-uuids)
|
||||
:groups (into {}
|
||||
(map (fn [block-uuid]
|
||||
[[:block block-uuid]
|
||||
(if-let [dependency-uuids (get groups block-uuid)]
|
||||
(into #{} (map #(vector :block %)) dependency-uuids)
|
||||
#{[:block block-uuid]})]))
|
||||
block-uuids)}))
|
||||
|
||||
(defn- children-snapshot-groups
|
||||
[db parent-uuids]
|
||||
(into {}
|
||||
(map (fn [parent-uuid]
|
||||
(let [tree (block-handler/open-block-tree db parent-uuid)]
|
||||
[[:children parent-uuid]
|
||||
(common/block-bundle-slots tree)])))
|
||||
parent-uuids))
|
||||
|
||||
(defn render-snapshots
|
||||
[db {:keys [blocks children resources] :as request} runtime]
|
||||
(require-snapshot-request! request)
|
||||
(let [resource-entries (into {}
|
||||
(map (fn [resource-key]
|
||||
[resource-key
|
||||
(resource-entry db resource-key runtime)]))
|
||||
resources)
|
||||
{block-slots :slots block-groups :groups}
|
||||
(block-snapshot-slots db blocks)
|
||||
children-groups (children-snapshot-groups db children)
|
||||
base-slots (reduce merge-slots block-slots (vals children-groups))
|
||||
slots (reduce-kv
|
||||
(fn [slots resource-key entry]
|
||||
(-> slots
|
||||
(merge-slots (:slots entry))
|
||||
(merge-slots
|
||||
{[:resource resource-key]
|
||||
{:watch {:keys (:watch-keys entry)
|
||||
:all? (:watch-all? entry)}
|
||||
:value (:value entry)}})))
|
||||
base-slots
|
||||
resource-entries)
|
||||
groups (into {}
|
||||
(concat
|
||||
block-groups
|
||||
(map (fn [parent-uuid]
|
||||
[[:children parent-uuid]
|
||||
(set (keys (get children-groups
|
||||
[:children parent-uuid])))])
|
||||
children)
|
||||
(map (fn [[resource-key entry]]
|
||||
[[:resource resource-key]
|
||||
(conj (set (keys (:slots entry)))
|
||||
[:resource resource-key])])
|
||||
resource-entries)))]
|
||||
{:basis-rev (common/basis-rev db)
|
||||
:slots slots
|
||||
:groups groups}))
|
||||
|
||||
(def-thread-api :thread-api/get-render-snapshots
|
||||
[repo request]
|
||||
(if-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(render-snapshots @conn request {:repo repo})
|
||||
(common/fail! "Missing renderer snapshot database" {:repo repo})))
|
||||
159
src/main/frontend/worker/handler/render_resource/property.cljs
Normal file
159
src/main/frontend/worker/handler/render_resource/property.cljs
Normal file
@@ -0,0 +1,159 @@
|
||||
(ns frontend.worker.handler.render-resource.property
|
||||
"Property-related renderer resources."
|
||||
(:require [datascript.core :as d]
|
||||
[frontend.worker.handler.property :as property-handler]
|
||||
[frontend.worker.handler.render-resource.common :as common]
|
||||
[logseq.db :as ldb]))
|
||||
|
||||
(def ^:private display-context-keys
|
||||
#{:gallery-view?
|
||||
:page-title?
|
||||
:sidebar-properties?
|
||||
:tag-dialog?
|
||||
:publishing?
|
||||
:state-hide-empty-properties?
|
||||
:show-empty-and-hidden-properties?})
|
||||
|
||||
(defn- require-display-context!
|
||||
[context]
|
||||
(when-not (and (map? context)
|
||||
(= display-context-keys (set (keys context)))
|
||||
(every? boolean? (vals context)))
|
||||
(common/fail! "Invalid block display properties context" {:context context}))
|
||||
context)
|
||||
|
||||
(defn- normalize-entity-value
|
||||
[value]
|
||||
(letfn [(normalize-coll [values initial]
|
||||
(reduce
|
||||
(fn [[normalized uuids] item]
|
||||
(let [[item uuids'] (normalize-entity-value item)]
|
||||
[(conj normalized item) (into uuids uuids')]))
|
||||
[initial #{}]
|
||||
values))]
|
||||
(cond
|
||||
(and (map? value) (uuid? (:block/uuid value)))
|
||||
[(:block/uuid value) #{(:block/uuid value)}]
|
||||
|
||||
(set? value)
|
||||
(normalize-coll value #{})
|
||||
|
||||
(vector? value)
|
||||
(normalize-coll value [])
|
||||
|
||||
(and (sequential? value) (not (string? value)))
|
||||
(normalize-coll value [])
|
||||
|
||||
(map? value)
|
||||
(common/fail! "Renderer property value has no UUID" {:value value})
|
||||
|
||||
:else
|
||||
[value #{}])))
|
||||
|
||||
(defn- normalize-display-property-row
|
||||
[{:keys [property value]}]
|
||||
(let [property-uuid (common/require-uuid! :property-uuid (:block/uuid property))
|
||||
property-ident (:db/ident property)
|
||||
closed-value-uuids
|
||||
(mapv (fn [closed-value]
|
||||
(common/require-uuid! :closed-value-uuid
|
||||
(:block/uuid closed-value)))
|
||||
(:property/closed-values property))
|
||||
[normalized-value value-uuids] (normalize-entity-value value)]
|
||||
(when-not (keyword? property-ident)
|
||||
(common/fail! "Renderer property has no ident" {:property-uuid property-uuid}))
|
||||
[{:property-uuid property-uuid
|
||||
:property-ident property-ident
|
||||
:value normalized-value}
|
||||
(into #{[:entity property-uuid]}
|
||||
(map (fn [block-uuid] [:entity block-uuid]))
|
||||
(concat value-uuids closed-value-uuids))]))
|
||||
|
||||
(defn- normalize-display-property-rows
|
||||
[rows]
|
||||
(reduce
|
||||
(fn [[normalized watch-keys] row]
|
||||
(let [[row row-watch-keys] (normalize-display-property-row row)]
|
||||
[(conj normalized row) (into watch-keys row-watch-keys)]))
|
||||
[[] #{}]
|
||||
rows))
|
||||
|
||||
(defn- optional-entity-uuid
|
||||
[label entity]
|
||||
(when entity
|
||||
(common/require-uuid! label (:block/uuid entity))))
|
||||
|
||||
(defn- block-display-properties
|
||||
[db resource-key _runtime]
|
||||
(let [[_ block-uuid context] resource-key
|
||||
block (common/entity-by-uuid! db :block-uuid block-uuid)
|
||||
context (require-display-context! context)
|
||||
show-empty-and-hidden-properties?
|
||||
(:show-empty-and-hidden-properties? context)
|
||||
result (property-handler/display-properties
|
||||
db
|
||||
block
|
||||
(dissoc context :show-empty-and-hidden-properties?)
|
||||
show-empty-and-hidden-properties?)
|
||||
[full-properties full-watch-keys]
|
||||
(normalize-display-property-rows (:full-properties result))
|
||||
[hidden-properties hidden-watch-keys]
|
||||
(normalize-display-property-rows (:hidden-properties result))
|
||||
watch-keys (into #{[:display-properties block-uuid]
|
||||
[:class-tree]
|
||||
[:property-config]
|
||||
[:property-membership :block/closed-value-property]}
|
||||
(concat full-watch-keys hidden-watch-keys))]
|
||||
[watch-keys
|
||||
{:full-properties full-properties
|
||||
:hidden-properties hidden-properties
|
||||
:description-property-uuid
|
||||
(optional-entity-uuid :description-property-uuid
|
||||
(:description-property result))
|
||||
:class-properties-property-uuid
|
||||
(optional-entity-uuid :class-properties-property-uuid
|
||||
(:class-properties-property result))}]))
|
||||
|
||||
(defn- property-uuid!
|
||||
[property]
|
||||
(common/require-uuid! :property-uuid (:block/uuid property)))
|
||||
|
||||
(defn- block-positioned-properties
|
||||
[db resource-key _runtime]
|
||||
(let [[_ block-uuid position] resource-key
|
||||
block (common/entity-by-uuid! db :block-uuid block-uuid)]
|
||||
(when-not (contains? (set property-handler/render-property-positions)
|
||||
position)
|
||||
(common/fail! "Invalid block property position" {:position position}))
|
||||
(let [properties (property-handler/block-positioned-properties
|
||||
db (:db/id block) position)
|
||||
candidate-properties
|
||||
(keep #(d/entity db %)
|
||||
(property-handler/direct-block-property-ids db (:db/id block)))
|
||||
property-uuids (mapv property-uuid! properties)
|
||||
watch-uuids (into (set property-uuids)
|
||||
(map property-uuid!)
|
||||
candidate-properties)]
|
||||
[(into #{[:entity block-uuid]
|
||||
[:property-config]}
|
||||
(map (fn [property-uuid] [:entity property-uuid]))
|
||||
watch-uuids)
|
||||
property-uuids])))
|
||||
|
||||
(defn- block-bidirectional-properties
|
||||
[db resource-key _runtime]
|
||||
(let [block-uuid (second resource-key)
|
||||
block (common/entity-by-uuid! db :block-uuid block-uuid)
|
||||
groups (ldb/get-bidirectional-properties db (:db/id block))]
|
||||
[#{[:bidirectional block-uuid]}
|
||||
(mapv (fn [{:keys [class entities]}]
|
||||
{:class-uuid (common/require-uuid! :class-uuid (:block/uuid class))
|
||||
:entity-uuids (mapv #(common/require-uuid! :entity-uuid
|
||||
(:block/uuid %))
|
||||
entities)})
|
||||
groups)]))
|
||||
|
||||
(def resource-renderers
|
||||
{:block-display-properties (common/renderer 3 block-display-properties)
|
||||
:block-positioned-properties (common/renderer 3 block-positioned-properties)
|
||||
:block-bidirectional-properties (common/renderer 2 block-bidirectional-properties)})
|
||||
229
src/main/frontend/worker/handler/render_resource/query.cljs
Normal file
229
src/main/frontend/worker/handler/render_resource/query.cljs
Normal file
@@ -0,0 +1,229 @@
|
||||
(ns frontend.worker.handler.render-resource.query
|
||||
"DSL and Datalog query execution and result normalization."
|
||||
(:require [clojure.string :as string]
|
||||
[datascript.impl.entity :as de]
|
||||
[frontend.worker.handler.query :as query-handler]
|
||||
[frontend.worker.handler.render-resource.common :as common]
|
||||
[frontend.worker.handler.search :as search-handler]
|
||||
[frontend.worker.query-dsl :as query-dsl]
|
||||
[logseq.common.util :as common-util]
|
||||
[logseq.db :as ldb]
|
||||
[logseq.outliner.tree :as otree]
|
||||
[sci.core :as sci]))
|
||||
|
||||
(defn- normalize-query-cell
|
||||
[cell]
|
||||
(cond
|
||||
(and (or (map? cell) (de/entity? cell))
|
||||
(uuid? (:block/uuid cell)))
|
||||
(:block/uuid cell)
|
||||
|
||||
(or (map? cell) (de/entity? cell))
|
||||
(common/fail! "Renderer query result map has no UUID" {:value cell})
|
||||
|
||||
(fn? cell)
|
||||
(common/fail! "Renderer query result contains a function" {})
|
||||
|
||||
(set? cell)
|
||||
(into #{} (map normalize-query-cell) cell)
|
||||
|
||||
(vector? cell)
|
||||
(mapv normalize-query-cell cell)
|
||||
|
||||
(and (sequential? cell) (not (string? cell)))
|
||||
(mapv normalize-query-cell cell)
|
||||
|
||||
:else
|
||||
cell))
|
||||
|
||||
(defn- normalize-query-row
|
||||
[row]
|
||||
(let [tuple (if (vector? row) row [row])
|
||||
tuple (mapv normalize-query-cell tuple)]
|
||||
(if (= 1 (count tuple))
|
||||
(first tuple)
|
||||
tuple)))
|
||||
|
||||
(def ^:private query-common-keys
|
||||
#{:kind
|
||||
:query
|
||||
:current-page-title
|
||||
:current-block-uuid
|
||||
:today-day
|
||||
:remove-block-children?
|
||||
:result-transform-edn})
|
||||
|
||||
(def ^:private query-dsl-keys
|
||||
(conj query-common-keys :cards?))
|
||||
|
||||
(def ^:private query-datalog-keys
|
||||
(conj query-common-keys :inputs :rules))
|
||||
|
||||
(defn- valid-today-day?
|
||||
[value]
|
||||
(and (integer? value)
|
||||
(<= 10000101 value 99991231)))
|
||||
|
||||
(defn- require-query-spec!
|
||||
[query-spec]
|
||||
(let [kind (:kind query-spec)
|
||||
allowed-keys (case kind
|
||||
:dsl query-dsl-keys
|
||||
:datalog query-datalog-keys
|
||||
nil)]
|
||||
(when-not (and (map? query-spec)
|
||||
allowed-keys
|
||||
(every? allowed-keys (keys query-spec))
|
||||
(or (not (contains? query-spec :current-page-title))
|
||||
(and (string? (:current-page-title query-spec))
|
||||
(not (string/blank?
|
||||
(:current-page-title query-spec)))))
|
||||
(or (not (contains? query-spec :current-block-uuid))
|
||||
(uuid? (:current-block-uuid query-spec)))
|
||||
(or (not (contains? query-spec :today-day))
|
||||
(valid-today-day? (:today-day query-spec)))
|
||||
(or (not (contains? query-spec :remove-block-children?))
|
||||
(boolean? (:remove-block-children? query-spec)))
|
||||
(or (not (contains? query-spec :result-transform-edn))
|
||||
(and (string? (:result-transform-edn query-spec))
|
||||
(not (string/blank?
|
||||
(:result-transform-edn query-spec)))))
|
||||
(case kind
|
||||
:dsl
|
||||
(and (string? (:query query-spec))
|
||||
(or (not (contains? query-spec :cards?))
|
||||
(boolean? (:cards? query-spec))))
|
||||
|
||||
:datalog
|
||||
(and (vector? (:query query-spec))
|
||||
(= :find (first (:query query-spec)))
|
||||
(or (not (contains? query-spec :inputs))
|
||||
(vector? (:inputs query-spec)))
|
||||
(or (not (contains? query-spec :rules))
|
||||
(vector? (:rules query-spec))))
|
||||
|
||||
false))
|
||||
(common/fail! "Invalid renderer query resource" {:query-spec query-spec})))
|
||||
query-spec)
|
||||
|
||||
(defn- quoted-query-text
|
||||
[query-string]
|
||||
(when (re-matches #"^\".*\"$" query-string)
|
||||
(let [value (common-util/safe-read-string {:log-error? false}
|
||||
query-string)]
|
||||
(when (and (string? value) (not (string/blank? value)))
|
||||
(string/trim value)))))
|
||||
|
||||
(defn- execute-query-spec
|
||||
[db query-spec {:keys [repo]}]
|
||||
(case (:kind query-spec)
|
||||
:dsl
|
||||
(let [query-string (:query query-spec)]
|
||||
(cond
|
||||
(string/blank? query-string)
|
||||
[]
|
||||
|
||||
(quoted-query-text query-string)
|
||||
(let [query-text (quoted-query-text query-string)]
|
||||
(when-not repo
|
||||
(common/fail! "Full-text query resource requires repository" {}))
|
||||
(mapv vector
|
||||
(search-handler/search-blocks
|
||||
repo query-text
|
||||
{:limit 30
|
||||
:feature/enable-semantic-search? false})))
|
||||
|
||||
:else
|
||||
(query-dsl/execute-query
|
||||
query-string
|
||||
db
|
||||
{:cards? (:cards? query-spec)
|
||||
:current-page-title (:current-page-title query-spec)
|
||||
:today-day (:today-day query-spec)
|
||||
:block-attrs [:db/id :block/uuid
|
||||
{:block/parent [:db/id]}]})))
|
||||
|
||||
:datalog
|
||||
(query-handler/execute-custom-query
|
||||
db query-spec (assoc query-spec :require-today-day? true))))
|
||||
|
||||
(defn- query-tuples
|
||||
[result]
|
||||
(mapv (fn [row]
|
||||
(cond
|
||||
(vector? row) row
|
||||
(map? row) [row]
|
||||
(and (sequential? row) (not (string? row))) (vec row)
|
||||
:else [row]))
|
||||
result))
|
||||
|
||||
(defn- block-query-result?
|
||||
[tuples]
|
||||
(and (seq tuples)
|
||||
(every? (fn [tuple]
|
||||
(and (= 1 (count tuple))
|
||||
(let [value (first tuple)]
|
||||
(and (or (map? value) (de/entity? value))
|
||||
(uuid? (:block/uuid value))))))
|
||||
tuples)))
|
||||
|
||||
(defn- filter-block-query-result
|
||||
[blocks {:keys [current-block-uuid remove-block-children?]}]
|
||||
(let [blocks (->> blocks
|
||||
(remove ldb/hidden?)
|
||||
(remove #(= current-block-uuid (:block/uuid %))))]
|
||||
(if (or (false? remove-block-children?)
|
||||
(not-every? #(integer? (:db/id %)) blocks))
|
||||
blocks
|
||||
(otree/filter-top-level-blocks blocks))))
|
||||
|
||||
(defn- apply-result-transform
|
||||
[rows result-transform-edn]
|
||||
(if result-transform-edn
|
||||
(let [transform (sci/eval-string result-transform-edn)]
|
||||
(when-not (fn? transform)
|
||||
(common/fail! "Query result transform is not a function"
|
||||
{:result-transform-edn result-transform-edn}))
|
||||
(let [result (transform rows)]
|
||||
(when-not (or (sequential? result) (set? result))
|
||||
(common/fail! "Query result transform must return rows"
|
||||
{:result result}))
|
||||
result))
|
||||
rows))
|
||||
|
||||
(defn- query-result-rows
|
||||
[result query-spec]
|
||||
(let [tuples (query-tuples result)
|
||||
rows (if (block-query-result? tuples)
|
||||
(filter-block-query-result (map first tuples) query-spec)
|
||||
tuples)
|
||||
rows (apply-result-transform rows (:result-transform-edn query-spec))]
|
||||
(mapv normalize-query-row rows)))
|
||||
|
||||
(defn- dependency-watch
|
||||
[{:keys [attrs task-attrs tasks? opaque?]}]
|
||||
(let [watch-keys (cond-> (into #{} (map (fn [attr] [:attr attr])) attrs)
|
||||
(seq task-attrs)
|
||||
(into (map (fn [attr] [:task-attr attr])) task-attrs)
|
||||
tasks?
|
||||
(conj [:tasks]))]
|
||||
(if (or opaque? (empty? watch-keys))
|
||||
common/watch-all
|
||||
watch-keys)))
|
||||
|
||||
(defn- query-watch-keys
|
||||
[db query-spec]
|
||||
(dependency-watch
|
||||
(if (= :datalog (:kind query-spec))
|
||||
(query-handler/custom-query-watch-dependencies query-spec)
|
||||
(query-dsl/query-watch-dependencies (:query query-spec) db query-spec))))
|
||||
|
||||
(defn- query
|
||||
[db resource-key runtime]
|
||||
(let [query-spec (require-query-spec! (second resource-key))]
|
||||
[(query-watch-keys db query-spec)
|
||||
{:rows (query-result-rows (execute-query-spec db query-spec runtime)
|
||||
query-spec)}]))
|
||||
|
||||
(def resource-renderers
|
||||
{:query (common/renderer 2 query)})
|
||||
386
src/main/frontend/worker/handler/render_resource/view.cljs
Normal file
386
src/main/frontend/worker/handler/render_resource/view.cljs
Normal file
@@ -0,0 +1,386 @@
|
||||
(ns frontend.worker.handler.render-resource.view
|
||||
"View configuration, scope, grouping, and row normalization."
|
||||
(:require [clojure.string :as string]
|
||||
[datascript.core :as d]
|
||||
[datascript.impl.entity :as de]
|
||||
[frontend.worker.handler.block :as block-handler]
|
||||
[frontend.worker.handler.render-resource.common :as common]
|
||||
[logseq.db :as ldb]
|
||||
[logseq.db.common.view :as db-view]
|
||||
[logseq.db.frontend.class :as db-class]))
|
||||
|
||||
(def ^:private view-eids-query
|
||||
'[:find [?view ...]
|
||||
:in $ ?owner ?feature-type
|
||||
:where
|
||||
[?view :logseq.property/view-for ?owner]
|
||||
[?view :logseq.property.view/feature-type ?feature-type]])
|
||||
|
||||
(defn- views
|
||||
[db resource-key _runtime]
|
||||
(let [[_ owner-uuid feature-type] resource-key
|
||||
owner (common/entity-by-uuid! db :owner-uuid owner-uuid)]
|
||||
(when-not (keyword? feature-type)
|
||||
(common/fail! "Invalid view feature type" {:feature-type feature-type}))
|
||||
[#{resource-key}
|
||||
(->> (d/q view-eids-query db (:db/id owner) feature-type)
|
||||
(map #(d/entity db %))
|
||||
ldb/sort-by-order
|
||||
(mapv (fn [view]
|
||||
(common/entity-uuid! db (:db/id view)))))]))
|
||||
|
||||
(defn- scope-uuids
|
||||
[db eids]
|
||||
(into #{} (map #(common/entity-uuid! db %)) (distinct eids)))
|
||||
|
||||
(def ^:private view-feature-types
|
||||
#{:all-pages
|
||||
:class-objects
|
||||
:property-objects
|
||||
:linked-references
|
||||
:unlinked-references
|
||||
:query-result})
|
||||
|
||||
(def ^:private view-context-keys
|
||||
#{:feature-type
|
||||
:sorting
|
||||
:filters
|
||||
:input
|
||||
:group-by-property-ident
|
||||
:initial-row-count
|
||||
:query-row-uuids})
|
||||
|
||||
(defn- valid-sorting?
|
||||
[sorting]
|
||||
(and (vector? sorting)
|
||||
(every? (fn [item]
|
||||
(and (map? item)
|
||||
(= #{:id :asc?} (set (keys item)))
|
||||
(keyword? (:id item))
|
||||
(boolean? (:asc? item))))
|
||||
sorting)))
|
||||
|
||||
(defn- valid-filters?
|
||||
[filters]
|
||||
(and (map? filters)
|
||||
(every? #{:or? :filters} (keys filters))
|
||||
(or (nil? (:or? filters)) (boolean? (:or? filters)))
|
||||
(vector? (:filters filters))
|
||||
(every? (fn [clause]
|
||||
(and (vector? clause)
|
||||
(= 3 (count clause))
|
||||
(keyword? (first clause))))
|
||||
(:filters filters))))
|
||||
|
||||
(defn- require-view-context!
|
||||
[context]
|
||||
(when-not (and (map? context)
|
||||
(= (set (keys context))
|
||||
(set (filter #(contains? context %) view-context-keys)))
|
||||
(contains? view-context-keys :feature-type)
|
||||
(contains? context :feature-type)
|
||||
(contains? view-feature-types (:feature-type context))
|
||||
(or (not (contains? context :sorting))
|
||||
(valid-sorting? (:sorting context)))
|
||||
(or (not (contains? context :filters))
|
||||
(valid-filters? (:filters context)))
|
||||
(or (not (contains? context :input))
|
||||
(string? (:input context)))
|
||||
(or (not (contains? context :group-by-property-ident))
|
||||
(keyword? (:group-by-property-ident context)))
|
||||
(or (not (contains? context :initial-row-count))
|
||||
(and (= :all-pages (:feature-type context))
|
||||
(integer? (:initial-row-count context))
|
||||
(pos? (:initial-row-count context))
|
||||
(<= (:initial-row-count context) 50)))
|
||||
(or (not (contains? context :query-row-uuids))
|
||||
(and (vector? (:query-row-uuids context))
|
||||
(every? uuid? (:query-row-uuids context)))))
|
||||
(common/fail! "Invalid view resource context" {:context context}))
|
||||
context)
|
||||
|
||||
(defn- property-ident
|
||||
[value]
|
||||
(cond
|
||||
(keyword? value) value
|
||||
(de/entity? value) (:db/ident value)
|
||||
(map? value) (:db/ident value)
|
||||
:else nil))
|
||||
|
||||
(defn- effective-view-config
|
||||
[view context]
|
||||
(let [persisted-sorting (:logseq.property.table/sorting view)
|
||||
empty-sorting? (or (= persisted-sorting
|
||||
:logseq.property/empty-placeholder)
|
||||
(= (property-ident persisted-sorting)
|
||||
:logseq.property/empty-placeholder)
|
||||
(empty? persisted-sorting))
|
||||
sorting (if empty-sorting?
|
||||
(or (:sorting context)
|
||||
[{:id :block/updated-at :asc? false}])
|
||||
persisted-sorting)
|
||||
filters (or (:logseq.property.table/filters view)
|
||||
(:filters context))
|
||||
group-by-property-ident
|
||||
(or (property-ident (:logseq.property.view/group-by-property view))
|
||||
(:group-by-property-ident context))
|
||||
group-sort-property-ident
|
||||
(when group-by-property-ident
|
||||
(or (property-ident
|
||||
(:logseq.property.view/sort-groups-by-property view))
|
||||
:block/journal-day))]
|
||||
{:sorting sorting
|
||||
:filters filters
|
||||
:input (:input context)
|
||||
:group-by-property-ident group-by-property-ident
|
||||
:group-sort-property-ident group-sort-property-ident}))
|
||||
|
||||
(defn- filter-property-idents
|
||||
[filters]
|
||||
(into #{} (map first) (:filters filters)))
|
||||
|
||||
(defn- view-value-watch-keys
|
||||
[{:keys [sorting filters input group-by-property-ident
|
||||
group-sort-property-ident]}
|
||||
view-partition]
|
||||
(cond-> (into #{}
|
||||
(map (fn [{:keys [id]}] [:attr id]))
|
||||
sorting)
|
||||
filters
|
||||
(into (map (fn [filter-ident] [:attr filter-ident]))
|
||||
(filter-property-idents filters))
|
||||
|
||||
(not (string/blank? input))
|
||||
(conj [:attr :block/title])
|
||||
|
||||
group-by-property-ident
|
||||
(conj [:attr group-by-property-ident]
|
||||
[:attr group-sort-property-ident]
|
||||
[:attr :block/title])
|
||||
|
||||
(= :grouped-list view-partition)
|
||||
(conj [:attr :block/parent]
|
||||
[:attr :block/order])))
|
||||
|
||||
(defn- require-view-owner!
|
||||
[feature-type owner view-uuid]
|
||||
(when (and (contains? #{:class-objects
|
||||
:property-objects
|
||||
:linked-references
|
||||
:unlinked-references}
|
||||
feature-type)
|
||||
(nil? owner))
|
||||
(common/fail! "View resource has no owner"
|
||||
{:view-uuid view-uuid
|
||||
:feature-type feature-type}))
|
||||
owner)
|
||||
|
||||
(defn- view-watch-keys
|
||||
[db view-uuid owner feature-type config view-partition]
|
||||
(if (= :unlinked-references feature-type)
|
||||
#{}
|
||||
(let [owner-uuid (:block/uuid owner)
|
||||
value-watch-keys (if (= :linked-references feature-type)
|
||||
#{}
|
||||
(view-value-watch-keys config view-partition))
|
||||
base (cond-> (conj value-watch-keys [:entity view-uuid])
|
||||
owner-uuid (conj [:entity owner-uuid]))]
|
||||
(case feature-type
|
||||
:all-pages
|
||||
(conj base [:page-membership])
|
||||
|
||||
:class-objects
|
||||
(let [classes (scope-uuids db
|
||||
(cons (:db/id owner)
|
||||
(db-class/get-structured-children
|
||||
db (:db/id owner))))]
|
||||
(into (conj base [:class-tree])
|
||||
(map (fn [class-uuid]
|
||||
[:class-membership class-uuid]))
|
||||
classes))
|
||||
|
||||
:property-objects
|
||||
(let [owner-ident (:db/ident owner)]
|
||||
(when-not (keyword? owner-ident)
|
||||
(common/fail! "View property owner has no ident"
|
||||
{:owner-uuid owner-uuid}))
|
||||
(conj base [:property-membership owner-ident]))
|
||||
|
||||
:linked-references
|
||||
(let [class-children (when (ldb/class? owner)
|
||||
(db-class/get-structured-children db (:db/id owner)))
|
||||
refs-scope (scope-uuids db
|
||||
(concat [(:db/id owner)]
|
||||
(ldb/get-block-alias db (:db/id owner))
|
||||
class-children))]
|
||||
(into (conj base [:ref-scope])
|
||||
(map (fn [target-uuid]
|
||||
[:refs target-uuid]))
|
||||
refs-scope))
|
||||
|
||||
:query-result
|
||||
base))))
|
||||
|
||||
(defn- normalize-view-row
|
||||
[db row]
|
||||
(cond
|
||||
(integer? row)
|
||||
(common/entity-uuid! db row)
|
||||
|
||||
(and (map? row) (uuid? (:block/uuid row)))
|
||||
(:block/uuid row)
|
||||
|
||||
(and (map? row) (integer? (:db/id row)))
|
||||
(common/entity-uuid! db (:db/id row))
|
||||
|
||||
(and (de/entity? row) (uuid? (:block/uuid row)))
|
||||
(:block/uuid row)
|
||||
|
||||
:else
|
||||
(common/fail! "Unsupported view resource row" {:row row})))
|
||||
|
||||
(defn- normalize-group-value
|
||||
[value]
|
||||
(cond
|
||||
(nil? value)
|
||||
{:kind :empty}
|
||||
|
||||
(and (or (map? value) (de/entity? value))
|
||||
(uuid? (:block/uuid value)))
|
||||
{:kind :entity :uuid (:block/uuid value)}
|
||||
|
||||
(coll? value)
|
||||
(common/fail! "Unsupported view group value" {:value value})
|
||||
|
||||
:else
|
||||
{:kind :scalar :value value}))
|
||||
|
||||
(defn- grouped-list-partition?
|
||||
[value]
|
||||
(and (vector? value)
|
||||
(= 2 (count value))
|
||||
(uuid? (first value))
|
||||
(sequential? (second value))))
|
||||
|
||||
(defn- grouped-list-data?
|
||||
[data]
|
||||
(and (seq data)
|
||||
(every? (fn [group]
|
||||
(and (vector? group)
|
||||
(= 2 (count group))
|
||||
(let [partitions (second group)]
|
||||
(and (sequential? partitions)
|
||||
(every? grouped-list-partition? partitions)))))
|
||||
data)))
|
||||
|
||||
(defn- normalize-view-rows
|
||||
[db rows]
|
||||
(mapv #(normalize-view-row db %) rows))
|
||||
|
||||
(defn- normalize-flat-view-data
|
||||
[db result]
|
||||
{:partition :flat
|
||||
:count (:count result)
|
||||
:rows (normalize-view-rows db (:data result))})
|
||||
|
||||
(defn- normalize-grouped-view-data
|
||||
[db result]
|
||||
{:partition :grouped
|
||||
:count (:count result)
|
||||
:groups
|
||||
(mapv (fn [[value rows]]
|
||||
{:value (normalize-group-value value)
|
||||
:rows (normalize-view-rows db rows)})
|
||||
(:data result))})
|
||||
|
||||
(defn- normalize-grouped-list-view-data
|
||||
[db result]
|
||||
{:partition :grouped-list
|
||||
:count (:count result)
|
||||
:groups
|
||||
(mapv (fn [[value partitions]]
|
||||
{:value (normalize-group-value value)
|
||||
:partitions
|
||||
(mapv (fn [[breadcrumb-uuid rows]]
|
||||
{:breadcrumb-uuid breadcrumb-uuid
|
||||
:rows (normalize-view-rows db rows)})
|
||||
partitions)})
|
||||
(:data result))})
|
||||
|
||||
(defn- normalize-view-data
|
||||
[db result grouped?]
|
||||
(when-not (map? result)
|
||||
(common/fail! "Invalid view resource result" {:result result}))
|
||||
(let [value (cond
|
||||
(grouped-list-data? (:data result))
|
||||
(normalize-grouped-list-view-data db result)
|
||||
|
||||
grouped?
|
||||
(normalize-grouped-view-data db result)
|
||||
|
||||
:else
|
||||
(normalize-flat-view-data db result))]
|
||||
(cond-> value
|
||||
(contains? result :ref-pages-count)
|
||||
(assoc :ref-pages-count (:ref-pages-count result))
|
||||
|
||||
(contains? result :ref-matched-children-ids)
|
||||
(assoc :matched-child-uuids
|
||||
(when-some [ids (:ref-matched-children-ids result)]
|
||||
(into #{} (map #(common/entity-uuid! db %)) ids)))
|
||||
|
||||
(contains? result :properties)
|
||||
(assoc :properties (mapv identity (:properties result))))))
|
||||
|
||||
(defn- view-data
|
||||
[db resource-key _runtime]
|
||||
(let [[_ view-uuid context] resource-key
|
||||
context (require-view-context! context)
|
||||
feature-type (:feature-type context)
|
||||
view (common/entity-by-uuid! db :view-uuid view-uuid)
|
||||
stored-feature-type (:logseq.property.view/feature-type view)
|
||||
owner (require-view-owner! feature-type
|
||||
(:logseq.property/view-for view)
|
||||
view-uuid)]
|
||||
(when (and stored-feature-type
|
||||
(not= stored-feature-type feature-type))
|
||||
(common/fail! "View resource feature does not match its definition"
|
||||
{:view-uuid view-uuid
|
||||
:feature-type feature-type
|
||||
:stored-feature-type stored-feature-type}))
|
||||
(let [query-row-uuids (:query-row-uuids context)]
|
||||
(when-not (= (= :query-result feature-type)
|
||||
(contains? context :query-row-uuids))
|
||||
(common/fail! "Invalid query-result view rows"
|
||||
{:feature-type feature-type
|
||||
:query-row-uuids query-row-uuids})))
|
||||
(let [config (effective-view-config view context)
|
||||
query-entity-ids (mapv (fn [block-uuid]
|
||||
(:db/id (common/entity-by-uuid! db
|
||||
:query-row-uuid
|
||||
block-uuid)))
|
||||
(:query-row-uuids context))
|
||||
option (cond-> (-> context
|
||||
(dissoc :feature-type :query-row-uuids
|
||||
:initial-row-count)
|
||||
(assoc :view-feature-type feature-type))
|
||||
owner (assoc :view-for-id (:db/id owner))
|
||||
(= :query-result feature-type)
|
||||
(assoc :query-entity-ids query-entity-ids))
|
||||
result (db-view/get-view-data db (:db/id view) option)
|
||||
value (normalize-view-data db result
|
||||
(some? (:group-by-property-ident config)))
|
||||
initial-blocks (when-let [initial-row-count (:initial-row-count context)]
|
||||
(let [initial-row-uuids (->> (:rows value)
|
||||
(take initial-row-count)
|
||||
vec)]
|
||||
(:blocks (block-handler/canonical-blocks
|
||||
db initial-row-uuids))))
|
||||
value-partition (:partition value)]
|
||||
[(view-watch-keys db view-uuid owner feature-type config value-partition)
|
||||
value
|
||||
(common/block-slots initial-blocks)])))
|
||||
|
||||
(def resource-renderers
|
||||
{:views (common/renderer 3 views)
|
||||
:view-data (common/renderer 3 view-data)})
|
||||
451
src/main/frontend/worker/handler/search.cljs
Normal file
451
src/main/frontend/worker/handler/search.cljs
Normal file
@@ -0,0 +1,451 @@
|
||||
(ns frontend.worker.handler.search
|
||||
"Full-text and vector search operations for the db worker."
|
||||
(:require
|
||||
[cljs-bean.core :as bean]
|
||||
[clojure.string :as string]
|
||||
[datascript.core :as d]
|
||||
[frontend.common.thread-api :refer [def-thread-api]]
|
||||
[frontend.worker.platform :as platform]
|
||||
[frontend.worker.search :as search]
|
||||
[frontend.worker.state :as worker-state]
|
||||
[lambdaisland.glogi :as log]
|
||||
[logseq.common.util :as common-util]
|
||||
[promesa.core :as p]))
|
||||
|
||||
(def search-db-version
|
||||
"Current search index version, stored in PRAGMA user_version.
|
||||
Bump to force a rebuild when the index format changes."
|
||||
3)
|
||||
|
||||
(def ^:private search-index-build-batch-size 200)
|
||||
(def ^:private vector-embedding-batch-size 32)
|
||||
(def ^:private vector-embedding-parallelism 2)
|
||||
(def ^:private vector-embedding-max-batch-chars (* vector-embedding-batch-size 2048))
|
||||
(def ^:private vector-embedding-max-title-length 2048)
|
||||
(def ^:private query-embedding-timeout-ms 50)
|
||||
(def ^:private search-index-build-time-budget-ms 8)
|
||||
(def ^:private search-index-build-idle-status-ttl-ms 2000)
|
||||
(def ^:private search-index-build-pause-ms 300)
|
||||
(defonce ^:private *search-index-build-ids (atom {}))
|
||||
(defonce ^:private *vector-index-rebuild-ids (atom {}))
|
||||
|
||||
(defn- node-runtime?
|
||||
[]
|
||||
(= :node (platform/env-flag (platform/current) :runtime)))
|
||||
|
||||
(defn clear-search-index-builds!
|
||||
[repo]
|
||||
(swap! *search-index-build-ids dissoc repo)
|
||||
(swap! *vector-index-rebuild-ids dissoc repo))
|
||||
|
||||
(defn- get-search-db
|
||||
[repo]
|
||||
(worker-state/get-sqlite-conn repo :search))
|
||||
|
||||
(defn- search-index-version
|
||||
[^js search-db]
|
||||
(aget (aget (.exec search-db #js {:sql "PRAGMA user_version" :rowMode "array"}) 0) 0))
|
||||
|
||||
(defn- expected-vector-index-metadata
|
||||
[]
|
||||
{:embedding-model-id (platform/embedding-model-id (platform/current))
|
||||
:embedding-dimension (platform/embedding-dimension (platform/current))
|
||||
:context-version search/vector-context-version})
|
||||
|
||||
(defn- persist-vector-index-metadata!
|
||||
[repo]
|
||||
(when-let [set-metadata! (:set-metadata! (worker-state/get-vector-index repo))]
|
||||
(set-metadata! (expected-vector-index-metadata))))
|
||||
|
||||
(declare <embed-index-batches vector-embedding-batches)
|
||||
|
||||
(defn- start-vector-index-rebuild!
|
||||
[repo build-id]
|
||||
(swap! *vector-index-rebuild-ids assoc repo build-id))
|
||||
|
||||
(defn- active-vector-index-rebuild?
|
||||
[repo build-id]
|
||||
(= build-id (get @*vector-index-rebuild-ids repo)))
|
||||
|
||||
(defn- clear-vector-index-rebuild!
|
||||
[repo build-id]
|
||||
(swap! *vector-index-rebuild-ids
|
||||
(fn [builds]
|
||||
(if (= build-id (get builds repo))
|
||||
(dissoc builds repo)
|
||||
builds))))
|
||||
|
||||
(defn- schedule-vector-index-rebuild!
|
||||
[repo build-id indexed-blocks]
|
||||
(when (worker-state/get-vector-index repo)
|
||||
(start-vector-index-rebuild! repo build-id)
|
||||
(let [indexed-blocks (vec indexed-blocks)]
|
||||
(-> (if (seq indexed-blocks)
|
||||
(p/let [vector-blocks (<embed-index-batches (vector-embedding-batches indexed-blocks))]
|
||||
(when (active-vector-index-rebuild? repo build-id)
|
||||
(when-let [vector-index (worker-state/get-vector-index repo)]
|
||||
(search/upsert-vector-blocks! vector-index vector-blocks))))
|
||||
(p/resolved nil))
|
||||
(p/then (fn [_]
|
||||
(when (active-vector-index-rebuild? repo build-id)
|
||||
(persist-vector-index-metadata! repo))))
|
||||
(p/catch (fn [error]
|
||||
(when (active-vector-index-rebuild? repo build-id)
|
||||
(log/error :search/vector-index-rebuild-failed {:repo repo
|
||||
:error error}))))
|
||||
(p/finally (fn []
|
||||
(clear-vector-index-rebuild! repo build-id))))))
|
||||
nil)
|
||||
|
||||
(defn- start-search-index-build!
|
||||
[repo]
|
||||
(let [build-id (str (random-uuid))]
|
||||
(swap! *search-index-build-ids assoc repo build-id)
|
||||
build-id))
|
||||
|
||||
(defn- clear-search-index-build!
|
||||
[repo build-id]
|
||||
(swap! *search-index-build-ids
|
||||
(fn [builds]
|
||||
(if (= build-id (get builds repo))
|
||||
(dissoc builds repo)
|
||||
builds))))
|
||||
|
||||
(defn- ensure-active-search-index-build!
|
||||
[repo build-id]
|
||||
(when-not (= build-id (get @*search-index-build-ids repo))
|
||||
(throw (ex-info "stale search index build"
|
||||
{:type :search/stale-index-build
|
||||
:repo repo
|
||||
:build-id build-id}))))
|
||||
|
||||
(defn- report-search-index-progress!
|
||||
[repo payload]
|
||||
(if (node-runtime?)
|
||||
(do
|
||||
(platform/post-message! (platform/current)
|
||||
:thread-api/search-index-build-progress
|
||||
[repo payload])
|
||||
(p/resolved nil))
|
||||
(-> (worker-state/<invoke-main-thread :thread-api/search-index-build-progress repo payload)
|
||||
(p/catch (fn [_error] nil)))))
|
||||
|
||||
(defn search-blocks
|
||||
[repo q option]
|
||||
(let [search-db (get-search-db repo)
|
||||
conn (worker-state/get-datascript-conn repo)
|
||||
vector-index (worker-state/get-vector-index repo)]
|
||||
(search/search-blocks conn search-db vector-index q option)))
|
||||
|
||||
(defn- validate-embedding-count!
|
||||
[blocks embeddings]
|
||||
(when-not (= (count blocks) (count embeddings))
|
||||
(throw (ex-info "embedding result count mismatch"
|
||||
{:block-count (count blocks)
|
||||
:embedding-count (count embeddings)
|
||||
:model-id (platform/embedding-model-id (platform/current))}))))
|
||||
|
||||
(defn- embeddable-index-block?
|
||||
[{:keys [id page title]}]
|
||||
(and id page (not (string/blank? (str title)))))
|
||||
|
||||
(defn- vector-embedding-title
|
||||
[block-or-title]
|
||||
(let [title (if (map? block-or-title)
|
||||
(or (:vector-title block-or-title)
|
||||
(:title block-or-title))
|
||||
block-or-title)
|
||||
title (str title)]
|
||||
(if (> (count title) vector-embedding-max-title-length)
|
||||
(subs title 0 vector-embedding-max-title-length)
|
||||
title)))
|
||||
|
||||
(defn- vector-embedding-batches
|
||||
[blocks]
|
||||
(loop [remaining (seq blocks)
|
||||
batch []
|
||||
batch-chars 0
|
||||
result []]
|
||||
(if-let [block (first remaining)]
|
||||
(let [text (vector-embedding-title block)
|
||||
text-chars (count text)
|
||||
full? (or (>= (count batch) vector-embedding-batch-size)
|
||||
(and (seq batch)
|
||||
(> (+ batch-chars text-chars)
|
||||
vector-embedding-max-batch-chars)))]
|
||||
(if full?
|
||||
(recur remaining [] 0 (conj result batch))
|
||||
(recur (next remaining)
|
||||
(conj batch block)
|
||||
(+ batch-chars text-chars)
|
||||
result)))
|
||||
(cond-> result
|
||||
(seq batch) (conj batch)))))
|
||||
|
||||
(defn- <embed-index-batch
|
||||
([batch]
|
||||
(<embed-index-batch #(platform/embed-texts (platform/current) %) batch))
|
||||
([embed-texts-fn batch]
|
||||
(p/let [embeddings (embed-texts-fn (mapv vector-embedding-title batch))
|
||||
_ (validate-embedding-count! batch embeddings)]
|
||||
(mapv (fn [block embedding]
|
||||
(assoc block :embedding embedding))
|
||||
batch
|
||||
embeddings))))
|
||||
|
||||
(defn- <embed-index-batch-with-fallback
|
||||
([batch]
|
||||
(<embed-index-batch-with-fallback #(platform/embed-texts (platform/current) %) batch))
|
||||
([embed-texts-fn batch]
|
||||
(-> (<embed-index-batch embed-texts-fn batch)
|
||||
(p/catch
|
||||
(fn [error]
|
||||
(if (= 1 (count batch))
|
||||
(throw error)
|
||||
(let [split-index (quot (count batch) 2)
|
||||
left (subvec (vec batch) 0 split-index)
|
||||
right (subvec (vec batch) split-index)]
|
||||
(p/let [left-embedded (<embed-index-batch-with-fallback embed-texts-fn left)
|
||||
right-embedded (<embed-index-batch-with-fallback embed-texts-fn right)]
|
||||
(into left-embedded right-embedded)))))))))
|
||||
|
||||
(defn- pop-embedding-batch!
|
||||
[queue]
|
||||
(let [selected (atom nil)]
|
||||
(swap! queue
|
||||
(fn [items]
|
||||
(if (seq items)
|
||||
(do
|
||||
(reset! selected (first items))
|
||||
(subvec items 1))
|
||||
items)))
|
||||
@selected))
|
||||
|
||||
(defn- <embed-index-batches
|
||||
([batches]
|
||||
(<embed-index-batches batches nil))
|
||||
([batches on-batch-embedded]
|
||||
(let [batches (vec batches)]
|
||||
(if (empty? batches)
|
||||
(p/resolved [])
|
||||
(let [queue (atom (mapv vector (range (count batches)) batches))
|
||||
results (atom {})
|
||||
worker-count (min vector-embedding-parallelism (count batches))]
|
||||
(letfn [(worker []
|
||||
(if-let [[idx batch] (pop-embedding-batch! queue)]
|
||||
(-> (<embed-index-batch-with-fallback batch)
|
||||
(p/then (fn [embedded]
|
||||
(swap! results assoc idx embedded)
|
||||
(when on-batch-embedded
|
||||
(on-batch-embedded (count embedded)))
|
||||
(worker))))
|
||||
(p/resolved nil)))]
|
||||
(p/let [_ (p/all (mapv (fn [_] (worker)) (range worker-count)))]
|
||||
(into [] (mapcat (fn [idx]
|
||||
(get @results idx))
|
||||
(range (count batches)))))))))))
|
||||
|
||||
(defn- <embed-index-blocks
|
||||
[repo blocks]
|
||||
(let [blocks (vec (filter embeddable-index-block? blocks))]
|
||||
(if (and (seq blocks) (worker-state/get-vector-index repo))
|
||||
(<embed-index-batches (vector-embedding-batches blocks))
|
||||
(p/resolved []))))
|
||||
|
||||
(defn- schedule-vector-index-upsert!
|
||||
[repo blocks]
|
||||
(when (and (seq blocks) (worker-state/get-vector-index repo))
|
||||
(-> (<embed-index-blocks repo blocks)
|
||||
(p/then (fn [vector-blocks]
|
||||
(when (seq vector-blocks)
|
||||
(search/upsert-vector-blocks! (worker-state/get-vector-index repo) vector-blocks))))
|
||||
(p/catch (fn [error]
|
||||
(log/error :search/vector-index-upsert-failed {:repo repo
|
||||
:error error})))))
|
||||
nil)
|
||||
|
||||
(defn- <search-blocks
|
||||
[repo q option]
|
||||
(let [vector-index (worker-state/get-vector-index repo)]
|
||||
(if (and vector-index
|
||||
(:feature/enable-semantic-search? option)
|
||||
(not (:page-only? option))
|
||||
(not (:query-embedding option))
|
||||
(not (string/blank? q)))
|
||||
(-> (p/let [embeddings (-> (platform/embed-texts (platform/current) [q])
|
||||
(p/timeout query-embedding-timeout-ms))
|
||||
_ (validate-embedding-count! [{:title q}] embeddings)]
|
||||
(search-blocks repo q (assoc option :query-embedding (first embeddings))))
|
||||
(p/catch (fn [error]
|
||||
(log/warn :search/query-embedding-failed {:repo repo
|
||||
:error error})
|
||||
(search-blocks repo q option))))
|
||||
(p/resolved (search-blocks repo q option)))))
|
||||
|
||||
(def-thread-api :thread-api/search-blocks
|
||||
[repo q option]
|
||||
(<search-blocks repo q option))
|
||||
|
||||
(def-thread-api :thread-api/search-upsert-blocks
|
||||
[repo blocks]
|
||||
(when-let [db (get-search-db repo)]
|
||||
(search/upsert-blocks! db (bean/->js blocks))
|
||||
(schedule-vector-index-upsert! repo blocks)
|
||||
nil))
|
||||
|
||||
(def-thread-api :thread-api/search-delete-blocks
|
||||
[repo ids]
|
||||
(when-let [db (get-search-db repo)]
|
||||
(search/delete-vector-blocks! (worker-state/get-vector-index repo) ids)
|
||||
(search/delete-blocks! db ids)
|
||||
nil))
|
||||
|
||||
(def-thread-api :thread-api/search-truncate-tables
|
||||
[repo]
|
||||
(when-let [db (get-search-db repo)]
|
||||
(search/truncate-vector-index! (worker-state/get-vector-index repo))
|
||||
(search/truncate-table! db)
|
||||
nil))
|
||||
|
||||
(def-thread-api :thread-api/search-build-blocks-indice
|
||||
[repo]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(search/build-blocks-indice @conn)))
|
||||
|
||||
(defn- take-search-index-batch
|
||||
[items batch-size time-budget-ms]
|
||||
(let [deadline (+ (common-util/time-ms) time-budget-ms)]
|
||||
(loop [batch (transient [])
|
||||
remaining (seq items)
|
||||
n 0]
|
||||
(if (or (nil? remaining)
|
||||
(>= n batch-size)
|
||||
(and (pos? n) (>= (common-util/time-ms) deadline)))
|
||||
[(persistent! batch) remaining]
|
||||
(recur (conj! batch (first remaining))
|
||||
(next remaining)
|
||||
(inc n))))))
|
||||
|
||||
(defn- search-index-input-idle?
|
||||
[repo]
|
||||
(if (node-runtime?)
|
||||
true
|
||||
(let [status-map @(:thread-atom/search-input-idle-status @worker-state/*state)
|
||||
{:keys [idle? ts]} (get status-map repo)
|
||||
fresh? (and (number? ts)
|
||||
(<= (- (common-util/time-ms) ts)
|
||||
search-index-build-idle-status-ttl-ms))]
|
||||
(if (and fresh? (boolean? idle?))
|
||||
idle?
|
||||
true))))
|
||||
|
||||
(defn- <wait-for-search-index-idle!
|
||||
[repo build-id]
|
||||
(p/loop []
|
||||
(ensure-active-search-index-build! repo build-id)
|
||||
(if (search-index-input-idle? repo)
|
||||
nil
|
||||
(p/let [_ (js/Promise. (fn [resolve] (js/setTimeout resolve search-index-build-pause-ms)))]
|
||||
(p/recur)))))
|
||||
|
||||
(defn- <build-blocks-index!
|
||||
"Build FTS/vector index in batches with yielding. Sets user_version to search-db-version on completion."
|
||||
[repo search-db conn build-id]
|
||||
(ensure-active-search-index-build! repo build-id)
|
||||
(let [db @conn
|
||||
blocks (->> (d/datoms db :avet :block/uuid)
|
||||
(keep #(d/entity db (:e %)))
|
||||
(remove search/hidden-entity?)
|
||||
vec)
|
||||
total (count blocks)
|
||||
vector-index (worker-state/get-vector-index repo)
|
||||
index-opts {:include-vector-title? (some? vector-index)}
|
||||
progress-for-fts (fn [processed]
|
||||
(if (zero? total)
|
||||
100
|
||||
(min 100 (int (* 100 (/ processed total))))))
|
||||
report-progress! (fn [progress processed total]
|
||||
(report-search-index-progress! repo {:build-id build-id
|
||||
:status :running
|
||||
:stage :search-index
|
||||
:progress progress
|
||||
:processed processed
|
||||
:total total}))]
|
||||
(p/do!
|
||||
(report-search-index-progress! repo {:build-id build-id
|
||||
:status :running
|
||||
:stage :search-index
|
||||
:progress 0
|
||||
:processed 0
|
||||
:total total})
|
||||
(<wait-for-search-index-idle! repo build-id)
|
||||
(ensure-active-search-index-build! repo build-id)
|
||||
(search/truncate-table! search-db)
|
||||
(search/truncate-vector-index! vector-index)
|
||||
(p/loop [remaining (seq blocks)
|
||||
processed 0
|
||||
last-progress 0
|
||||
indexed-blocks []]
|
||||
(ensure-active-search-index-build! repo build-id)
|
||||
(if (seq remaining)
|
||||
(let [[batch remaining'] (take-search-index-batch remaining
|
||||
search-index-build-batch-size
|
||||
search-index-build-time-budget-ms)
|
||||
processed' (+ processed (count batch))
|
||||
indexed (vec (keep #(search/block->index % index-opts) batch))
|
||||
indexed-blocks' (into indexed-blocks indexed)
|
||||
progress (progress-for-fts processed')
|
||||
should-report? (> progress last-progress)]
|
||||
(p/let [_ (when (seq indexed)
|
||||
(search/upsert-blocks! search-db (bean/->js indexed)))
|
||||
_ (when should-report?
|
||||
(report-progress! progress processed' total))
|
||||
_ (js/Promise. (fn [resolve] (js/setTimeout resolve 0)))]
|
||||
(p/recur remaining' processed' (if should-report? progress last-progress) indexed-blocks')))
|
||||
(do
|
||||
(ensure-active-search-index-build! repo build-id)
|
||||
(schedule-vector-index-rebuild! repo build-id indexed-blocks)
|
||||
(p/let [_ (do
|
||||
(.exec search-db (str "PRAGMA user_version = " search-db-version))
|
||||
(report-search-index-progress! repo {:build-id build-id
|
||||
:status :completed
|
||||
:stage :search-index
|
||||
:progress 100
|
||||
:processed total
|
||||
:total total}))]
|
||||
nil)))))))
|
||||
|
||||
(def-thread-api :thread-api/search-build-blocks-indice-in-worker
|
||||
[repo & [force?]]
|
||||
(p/let [search-db (get-search-db repo)]
|
||||
(when search-db
|
||||
(let [version (search-index-version search-db)]
|
||||
(if (and (= version search-db-version)
|
||||
(not force?))
|
||||
version
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(let [build-id (start-search-index-build! repo)]
|
||||
(-> (report-search-index-progress! repo {:build-id build-id
|
||||
:status :running
|
||||
:stage :search-index
|
||||
:progress 0
|
||||
:processed 0
|
||||
:total 0})
|
||||
(p/then (fn [_]
|
||||
(js/Promise. (fn [resolve] (js/setTimeout resolve 0)))))
|
||||
(p/then (fn [_]
|
||||
(<build-blocks-index! repo search-db conn build-id)))
|
||||
(p/catch (fn [error]
|
||||
(when-not (= :search/stale-index-build (:type (ex-data error)))
|
||||
(log/error :search/index-build-failed {:repo repo
|
||||
:error error}))))
|
||||
(p/finally (fn []
|
||||
(when (= build-id (get @*search-index-build-ids repo))
|
||||
(report-search-index-progress! repo {:build-id build-id
|
||||
:status :idle}))
|
||||
(clear-search-index-build! repo build-id))))
|
||||
:started)))))))
|
||||
|
||||
(def-thread-api :thread-api/search-build-pages-indice
|
||||
[_repo]
|
||||
nil)
|
||||
104
src/main/frontend/worker/handler/sync.cljs
Normal file
104
src/main/frontend/worker/handler/sync.cljs
Normal file
@@ -0,0 +1,104 @@
|
||||
(ns frontend.worker.handler.sync
|
||||
"Sync operations for the db worker."
|
||||
(:require [frontend.common.thread-api :refer [def-thread-api]]
|
||||
[frontend.worker.shared-service :as shared-service]
|
||||
[frontend.worker.state :as worker-state]
|
||||
[frontend.worker.sync :as db-sync]
|
||||
[frontend.worker.sync.client-op :as client-op]
|
||||
[frontend.worker.sync.crypt :as sync-crypt]
|
||||
[frontend.worker.sync.download :as sync-download]))
|
||||
|
||||
(def-thread-api :thread-api/set-db-sync-config
|
||||
[config]
|
||||
(reset! worker-state/*db-sync-config (worker-state/non-auth-db-sync-config config))
|
||||
nil)
|
||||
|
||||
(def-thread-api :thread-api/get-db-sync-config
|
||||
[]
|
||||
(worker-state/non-auth-db-sync-config @worker-state/*db-sync-config))
|
||||
|
||||
(def-thread-api :thread-api/db-sync-status
|
||||
[repo]
|
||||
(db-sync/status repo))
|
||||
|
||||
(def-thread-api :thread-api/db-sync-stop
|
||||
[]
|
||||
(db-sync/stop!))
|
||||
|
||||
(def-thread-api :thread-api/db-sync-update-presence
|
||||
[editing-block-uuid]
|
||||
(db-sync/update-presence! editing-block-uuid))
|
||||
|
||||
(def-thread-api :thread-api/db-sync-request-asset-download
|
||||
[repo asset-uuid]
|
||||
(db-sync/request-asset-download! repo asset-uuid))
|
||||
|
||||
(def-thread-api :thread-api/db-sync-download-missing-assets
|
||||
[repo graph-id]
|
||||
(db-sync/download-missing-assets! repo graph-id))
|
||||
|
||||
(def-thread-api :thread-api/db-sync-retry-asset-upload
|
||||
[repo]
|
||||
(db-sync/retry-asset-upload! repo))
|
||||
|
||||
(def-thread-api :thread-api/db-sync-grant-graph-access
|
||||
[repo graph-id target-email]
|
||||
(sync-crypt/<grant-graph-access! repo graph-id target-email))
|
||||
|
||||
(def-thread-api :thread-api/db-sync-ensure-user-rsa-keys
|
||||
[& [opts]]
|
||||
(sync-crypt/ensure-user-rsa-keys! opts))
|
||||
|
||||
(def-thread-api :thread-api/db-sync-list-remote-graphs
|
||||
[]
|
||||
(db-sync/list-remote-graphs!))
|
||||
|
||||
(def-thread-api :thread-api/db-sync-upload-graph
|
||||
[repo]
|
||||
(db-sync/upload-graph! repo))
|
||||
|
||||
(def-thread-api :thread-api/db-sync-create-remote-graph
|
||||
[repo graph-e2ee? graph-ready-for-use?]
|
||||
(db-sync/create-remote-graph! repo {:graph-e2ee? graph-e2ee?
|
||||
:graph-ready-for-use? graph-ready-for-use?}))
|
||||
|
||||
(def-thread-api :thread-api/db-sync-stop-upload
|
||||
[repo]
|
||||
(db-sync/stop-upload! repo))
|
||||
|
||||
(def-thread-api :thread-api/db-sync-resume-upload
|
||||
[repo]
|
||||
(db-sync/resume-upload! repo))
|
||||
|
||||
(def-thread-api :thread-api/db-sync-upload-stopped?
|
||||
[repo]
|
||||
(db-sync/upload-stopped? repo))
|
||||
|
||||
(def-thread-api :thread-api/db-sync-get-all-block-conflicts
|
||||
[repo]
|
||||
(let [conflicts (client-op/get-all-sync-conflicts repo)]
|
||||
(when-not (map? conflicts)
|
||||
(throw (ex-info "Expected sync conflicts grouped by block"
|
||||
{:repo repo
|
||||
:conflicts conflicts})))
|
||||
(into {}
|
||||
(map (fn [[block-uuid block-conflicts]]
|
||||
(when-not (uuid? block-uuid)
|
||||
(throw (ex-info "Expected sync conflict block UUID"
|
||||
{:repo repo
|
||||
:block-uuid block-uuid})))
|
||||
[(str block-uuid) block-conflicts]))
|
||||
conflicts)))
|
||||
|
||||
(def-thread-api :thread-api/db-sync-clear-block-conflicts
|
||||
[repo block-uuid]
|
||||
(client-op/clear-sync-conflicts! repo block-uuid)
|
||||
(shared-service/broadcast-to-clients!
|
||||
:sync-conflicts-updated
|
||||
{:repo repo
|
||||
:block-uuid block-uuid
|
||||
:conflicts []}))
|
||||
|
||||
(def-thread-api :thread-api/db-sync-download-graph-by-id
|
||||
[repo graph-id graph-e2ee?]
|
||||
(sync-download/download-graph-by-id! repo graph-id graph-e2ee?))
|
||||
158
src/main/frontend/worker/handler/transaction.cljs
Normal file
158
src/main/frontend/worker/handler/transaction.cljs
Normal file
@@ -0,0 +1,158 @@
|
||||
(ns frontend.worker.handler.transaction
|
||||
"Transaction, outliner operation, and worker-state synchronization operations."
|
||||
(:require
|
||||
[datascript.core :as d]
|
||||
[frontend.common.thread-api :refer [def-thread-api]]
|
||||
[frontend.worker-common.util :as worker-util]
|
||||
[frontend.worker.db-listener :as db-listener]
|
||||
[frontend.worker.handler.block :as block-handler]
|
||||
[frontend.worker.plain-value :as worker-plain]
|
||||
[frontend.worker.shared-service :as shared-service]
|
||||
[frontend.worker.state :as worker-state]
|
||||
[lambdaisland.glogi :as log]
|
||||
[logseq.common.util :as common-util]
|
||||
[logseq.db :as ldb]
|
||||
[logseq.db.common.order :as db-order]
|
||||
[logseq.outliner.op :as outliner-op]
|
||||
[logseq.outliner.recycle :as outliner-recycle]))
|
||||
|
||||
(def ^:private recycle-gc-kv :logseq.kv/recycle-last-gc-at)
|
||||
|
||||
(goog-define OUTLINER-PERF-LOGGING false)
|
||||
|
||||
(def ^:private e2e-perf-op-names
|
||||
#{[:insert-blocks]
|
||||
[:save-block :insert-blocks]
|
||||
[:delete-blocks]})
|
||||
|
||||
(defn maybe-run-recycle-gc!
|
||||
[conn]
|
||||
(let [now (common-util/time-ms)
|
||||
last-gc-at (:kv/value (d/entity @conn recycle-gc-kv))]
|
||||
(when (or (not (number? last-gc-at))
|
||||
(> (- now last-gc-at) outliner-recycle/gc-interval-ms))
|
||||
(outliner-recycle/gc! conn {:now-ms now})
|
||||
(ldb/transact! conn [{:db/ident recycle-gc-kv
|
||||
:kv/value now}]
|
||||
{:persist-op? false
|
||||
:skip-validate-db? true}))))
|
||||
|
||||
(def-thread-api :thread-api/set-context
|
||||
[context]
|
||||
(when context (worker-state/update-context! context))
|
||||
nil)
|
||||
|
||||
(def-thread-api :thread-api/transact
|
||||
[repo tx-data tx-meta context]
|
||||
(assert (some? repo))
|
||||
(worker-state/set-db-latest-tx-time! repo)
|
||||
(let [conn (worker-state/get-datascript-conn repo)]
|
||||
(assert (some? conn) {:repo repo})
|
||||
(try
|
||||
(let [tx-data' (if (contains? #{:insert-blocks} (:outliner-op tx-meta))
|
||||
(map (fn [tx]
|
||||
(if (and (map? tx) (nil? (:block/order tx)))
|
||||
(assoc tx :block/order (db-order/gen-key nil))
|
||||
tx)) tx-data)
|
||||
tx-data)
|
||||
_ (when context (worker-state/set-context! context))
|
||||
tx-meta' (dissoc tx-meta :insert-blocks?)]
|
||||
(when-not (and (:create-today-journal? tx-meta)
|
||||
(:today-journal-name tx-meta)
|
||||
(seq tx-data')
|
||||
(ldb/get-page @conn (:today-journal-name tx-meta)))
|
||||
(worker-util/profile "Worker db transact"
|
||||
(ldb/transact! conn tx-data' tx-meta')))
|
||||
(maybe-run-recycle-gc! conn)
|
||||
nil)
|
||||
(catch :default error
|
||||
(prn :debug :worker-transact-failed :tx-meta tx-meta :tx-data tx-data)
|
||||
(log/error ::worker-transact-failed error)
|
||||
(throw error)))))
|
||||
|
||||
(defn- perf-time-ms []
|
||||
(if (and (exists? js/performance)
|
||||
(.-now js/performance))
|
||||
(.now js/performance)
|
||||
(js/Date.now)))
|
||||
|
||||
(defn- log-outliner-op-perf!
|
||||
[data]
|
||||
(when (:perf-id data)
|
||||
(cond
|
||||
goog.DEBUG
|
||||
(log/info :db-worker/outliner-op-perf
|
||||
(assoc data :worker-apply-ms (:apply-ms data)))
|
||||
|
||||
(and OUTLINER-PERF-LOGGING
|
||||
(contains? e2e-perf-op-names (:op-names data)))
|
||||
(log/info :db-worker/outliner-op-perf
|
||||
(select-keys (assoc data :worker-apply-ms (:apply-ms data))
|
||||
[:op-names :worker-apply-ms])))))
|
||||
|
||||
(def-thread-api :thread-api/apply-outliner-ops
|
||||
[repo ops opts]
|
||||
(let [conn (or (worker-state/get-datascript-conn repo)
|
||||
(throw (ex-info "Missing worker graph connection"
|
||||
{:type :db/missing-connection
|
||||
:repo repo})))]
|
||||
(try
|
||||
(let [started-at (perf-time-ms)
|
||||
perf-id (:ui/perf-id opts)
|
||||
editor-row-uuids (:editor-row-uuids opts)
|
||||
operation-opts (dissoc opts
|
||||
:affected-block-uuids
|
||||
:editor-row-uuids
|
||||
:return-updated-blocks?)
|
||||
apply-started-at (perf-time-ms)
|
||||
operation-result (worker-util/profile
|
||||
"apply outliner ops"
|
||||
(outliner-op/apply-ops! conn ops operation-opts))
|
||||
applied-at (perf-time-ms)
|
||||
delta (db-listener/take-outliner-op-delta! perf-id)
|
||||
listener-perf (db-listener/take-outliner-op-perf! perf-id)
|
||||
listener-at (perf-time-ms)
|
||||
editor-rows (when (seq editor-row-uuids)
|
||||
(select-keys
|
||||
(:blocks (block-handler/canonical-blocks
|
||||
@conn editor-row-uuids))
|
||||
editor-row-uuids))
|
||||
response (cond-> {:result (worker-plain/worker-plain-value
|
||||
@conn operation-result)}
|
||||
delta (assoc :delta delta)
|
||||
(seq editor-row-uuids)
|
||||
(assoc :editor-row-uuids editor-row-uuids
|
||||
:editor-rows editor-rows))
|
||||
plain-at (perf-time-ms)
|
||||
perf-data {:apply-ms (- applied-at apply-started-at)
|
||||
:listener-ms (- listener-at applied-at)
|
||||
:plain-ms (- plain-at listener-at)
|
||||
:total-ms (- plain-at started-at)
|
||||
:listener listener-perf}
|
||||
response-with-perf (cond-> response
|
||||
goog.DEBUG (assoc :perf perf-data))]
|
||||
(log-outliner-op-perf!
|
||||
(merge (dissoc perf-data :listener)
|
||||
{:perf-id perf-id
|
||||
:op-names (mapv first ops)
|
||||
:op-count (count ops)}))
|
||||
response-with-perf)
|
||||
(catch :default error
|
||||
(let [data (ex-data error)
|
||||
{:keys [type payload]} (when (map? data) data)]
|
||||
(case type
|
||||
:notification
|
||||
(do
|
||||
(log/error ::apply-outliner-ops-failed error)
|
||||
(shared-service/broadcast-to-clients! :notification [(:message payload) (:type payload) (:clear? payload) (:uid payload) (:timeout payload)
|
||||
(select-keys payload [:i18n-key :i18n-args])])
|
||||
(throw error))
|
||||
(throw error)))))))
|
||||
|
||||
(def-thread-api :thread-api/sync-app-state
|
||||
[new-state]
|
||||
(when (and (contains? new-state :git/current-repo)
|
||||
(nil? (:git/current-repo new-state)))
|
||||
(log/error :thread-api/sync-app-state {:reason :nil-current-repo}))
|
||||
(worker-state/set-new-state! new-state)
|
||||
nil)
|
||||
36
src/main/frontend/worker/handler/undo_redo.cljs
Normal file
36
src/main/frontend/worker/handler/undo_redo.cljs
Normal file
@@ -0,0 +1,36 @@
|
||||
(ns frontend.worker.handler.undo-redo
|
||||
"Undo and redo operations for the db worker."
|
||||
(:require [frontend.common.thread-api :refer [def-thread-api]]
|
||||
[frontend.worker.undo-redo :as worker-undo-redo]))
|
||||
|
||||
(def-thread-api :thread-api/undo-redo-set-pending-editor-info
|
||||
[repo editor-info]
|
||||
(worker-undo-redo/set-pending-editor-info! repo editor-info)
|
||||
nil)
|
||||
|
||||
(def-thread-api :thread-api/undo-redo-record-editor-info
|
||||
[repo editor-info]
|
||||
(worker-undo-redo/record-editor-info! repo editor-info)
|
||||
nil)
|
||||
|
||||
(def-thread-api :thread-api/undo-redo-record-ui-state
|
||||
[repo ui-state-str]
|
||||
(worker-undo-redo/record-ui-state! repo ui-state-str)
|
||||
nil)
|
||||
|
||||
(def-thread-api :thread-api/undo-redo-undo
|
||||
[repo]
|
||||
(worker-undo-redo/undo repo))
|
||||
|
||||
(def-thread-api :thread-api/undo-redo-redo
|
||||
[repo]
|
||||
(worker-undo-redo/redo repo))
|
||||
|
||||
(def-thread-api :thread-api/undo-redo-clear-history
|
||||
[repo]
|
||||
(worker-undo-redo/clear-history! repo)
|
||||
nil)
|
||||
|
||||
(def-thread-api :thread-api/undo-redo-get-debug-state
|
||||
[repo]
|
||||
(worker-undo-redo/get-debug-state repo))
|
||||
98
src/main/frontend/worker/handler/view.cljs
Normal file
98
src/main/frontend/worker/handler/view.cljs
Normal file
@@ -0,0 +1,98 @@
|
||||
(ns frontend.worker.handler.view
|
||||
"View operations for the db worker."
|
||||
(:require [datascript.core :as d]
|
||||
[frontend.common.thread-api :refer [def-thread-api]]
|
||||
[frontend.worker.plain-value :as worker-plain]
|
||||
[frontend.worker.state :as worker-state]
|
||||
[logseq.db.common.view :as db-view]
|
||||
[logseq.db.frontend.entity-util :as entity-util]))
|
||||
|
||||
(defn- view-filter-operators
|
||||
[property]
|
||||
(if (contains? #{:block/created-at :block/updated-at} (:db/ident property))
|
||||
[:before :after]
|
||||
(vec
|
||||
(concat
|
||||
[:is :is-not]
|
||||
(case (:logseq.property/type property)
|
||||
(:datetime)
|
||||
[:before :after]
|
||||
(:default :url :node)
|
||||
[:text-contains :text-not-contains]
|
||||
(:date)
|
||||
[:date-before :date-after]
|
||||
:number
|
||||
[:number-gt :number-lt :number-gte :number-lte :between]
|
||||
nil)))))
|
||||
|
||||
(defn- view-filter-value-after-operator-change
|
||||
[operator value]
|
||||
(case operator
|
||||
(:is :is-not)
|
||||
(when (set? value) value)
|
||||
|
||||
(:text-contains :text-not-contains)
|
||||
(when (string? value) value)
|
||||
|
||||
(:number-gt :number-lt :number-gte :number-lte)
|
||||
(when (number? value) value)
|
||||
|
||||
:between
|
||||
(when (and (vector? value) (every? number? value))
|
||||
value)
|
||||
|
||||
(:date-before :date-after :before :after)
|
||||
(when (number? value) value)))
|
||||
|
||||
(defn- view-filter-value-source
|
||||
[property operator]
|
||||
(let [type (:logseq.property/type property)]
|
||||
(cond
|
||||
(contains? #{:before :after} operator)
|
||||
:timestamp
|
||||
|
||||
(= :checkbox type)
|
||||
:checkbox
|
||||
|
||||
(contains? #{:data :datetime :checkbox} type)
|
||||
nil
|
||||
|
||||
:else
|
||||
:property-values)))
|
||||
|
||||
(defn- view-filter-many?
|
||||
[property operator]
|
||||
(not (or (contains? #{:date-before :date-after :before :after} operator)
|
||||
(= :checkbox (:logseq.property/type property)))))
|
||||
|
||||
(defn- normalize-view-filter-value
|
||||
[value]
|
||||
(if (map? (:value value))
|
||||
(assoc value :value (:block/uuid (:value value)))
|
||||
value))
|
||||
|
||||
(defn view-filter-data
|
||||
[db {:keys [property property-ident operator value] :as option}]
|
||||
(let [property (or property
|
||||
(some-> (d/entity db property-ident)
|
||||
entity-util/entity->map))
|
||||
operator (or operator :is)
|
||||
value-source (view-filter-value-source property operator)
|
||||
values (when (= :property-values value-source)
|
||||
(mapv normalize-view-filter-value
|
||||
(db-view/get-property-values db (:db/ident property) option)))]
|
||||
{:operators (view-filter-operators property)
|
||||
:value-source value-source
|
||||
:many? (view-filter-many? property operator)
|
||||
:values values
|
||||
:value-after-operator-change (view-filter-value-after-operator-change operator value)}))
|
||||
|
||||
(def-thread-api :thread-api/get-view-filter-data
|
||||
[repo option]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(view-filter-data @conn option)))
|
||||
|
||||
(def-thread-api :thread-api/get-view-data
|
||||
[repo view-id option]
|
||||
(let [db @(worker-state/get-datascript-conn repo)]
|
||||
(worker-plain/worker-plain-value db (db-view/get-view-data db view-id option))))
|
||||
714
src/main/frontend/worker/markdown_mirror.cljs
Normal file
714
src/main/frontend/worker/markdown_mirror.cljs
Normal file
@@ -0,0 +1,714 @@
|
||||
(ns frontend.worker.markdown-mirror
|
||||
"Markdown mirror derived-file support for DB graphs."
|
||||
(:require [clojure.string :as string]
|
||||
[datascript.core :as d]
|
||||
[datascript.impl.entity :as de]
|
||||
[frontend.worker.graph-dir :as graph-dir]
|
||||
[frontend.worker.platform :as platform]
|
||||
[lambdaisland.glogi :as log]
|
||||
[logseq.common.export.file :as common-file]
|
||||
[logseq.common.util :as common-util]
|
||||
[logseq.db :as ldb]
|
||||
[logseq.db.frontend.property :as db-property]
|
||||
[promesa.core :as p]))
|
||||
|
||||
(defn repo-mirror-dir
|
||||
[repo]
|
||||
(str (graph-dir/repo->encoded-graph-dir-name repo) "/mirror/markdown"))
|
||||
|
||||
(def ^:private invalid-file-name-chars-re
|
||||
#"[<>:\"|?*\\/]")
|
||||
|
||||
(def ^:private ascii-control-re
|
||||
#"[\x00-\x1F]")
|
||||
|
||||
(def ^:private trailing-space-or-dot-re
|
||||
#"[ \.]+$")
|
||||
|
||||
(def ^:private reserved-windows-device-names
|
||||
(into #{"CON" "PRN" "AUX" "NUL"}
|
||||
(concat (map #(str "COM" %) (range 1 10))
|
||||
(map #(str "LPT" %) (range 1 10)))))
|
||||
|
||||
(def ^:private max-file-stem-length 160)
|
||||
(def ^:private markdown-block-line-re #"^(\s*)-\s?(.*)$")
|
||||
(def ^:private markdown-property-line-re #"^(\s*)\*\s+[^:\s][^:]*::\s?.*$")
|
||||
(def ^:private property-line-re #"^(\s*)[^:\s][^:]*::\s?.*$")
|
||||
(def ^:private ref-or-tag-re #"(#?)\[\[([^\[\]]+)\]\]")
|
||||
(def ^:private simple-hashtag-re #"(?i)(^|\s)#([^\s#\[\]\(\),.;:'\"`]+)")
|
||||
|
||||
(defonce ^:private *repo->enabled? (atom {}))
|
||||
(defonce ^:private *repo->queued-page-jobs (atom {}))
|
||||
(defonce ^:private *repo->flush-timeout (atom {}))
|
||||
|
||||
(defn- normalize-unicode
|
||||
[s]
|
||||
(let [s (str s)]
|
||||
(if (fn? (.-normalize s))
|
||||
(.normalize s "NFC")
|
||||
s)))
|
||||
|
||||
(defn- reserved-windows-device-name?
|
||||
[s]
|
||||
(contains? reserved-windows-device-names
|
||||
(string/upper-case s)))
|
||||
|
||||
(defn normalize-file-stem
|
||||
[s]
|
||||
(when (some? s)
|
||||
(let [s' (-> (normalize-unicode s)
|
||||
(string/replace invalid-file-name-chars-re "_")
|
||||
(string/replace ascii-control-re "_")
|
||||
(string/replace trailing-space-or-dot-re ""))
|
||||
s' (if (> (count s') max-file-stem-length)
|
||||
(subs s' 0 max-file-stem-length)
|
||||
s')]
|
||||
(when (and (not (string/blank? s'))
|
||||
(not (reserved-windows-device-name? s')))
|
||||
s'))))
|
||||
|
||||
(defn- journal-file-stem
|
||||
[journal-day]
|
||||
(when journal-day
|
||||
(let [s (str journal-day)]
|
||||
(when (= 8 (count s))
|
||||
(str (subs s 0 4) "_" (subs s 4 6) "_" (subs s 6 8))))))
|
||||
|
||||
(defn- non-journal-page?
|
||||
[page]
|
||||
(and (ldb/page? page)
|
||||
(not (ldb/journal? page))))
|
||||
|
||||
(defn- pages-with-file-stem
|
||||
[db stem]
|
||||
(->> (d/datoms db :avet :block/name)
|
||||
(map #(d/entity db (:e %)))
|
||||
(filter #(and (non-journal-page? %)
|
||||
(= stem (normalize-file-stem (:block/title %)))))
|
||||
(sort-by (comp str :block/uuid))))
|
||||
|
||||
(defn page-relative-path
|
||||
([db page]
|
||||
(page-relative-path db page {}))
|
||||
([db page {:keys [journal-file-stem-fn]
|
||||
:or {journal-file-stem-fn journal-file-stem}}]
|
||||
(when page
|
||||
(if (ldb/journal? page)
|
||||
(when-let [stem (normalize-file-stem (journal-file-stem-fn (:block/journal-day page)))]
|
||||
(str "journals/" stem ".md"))
|
||||
(when-let [stem (normalize-file-stem (:block/title page))]
|
||||
(let [duplicate-pages (pages-with-file-stem db stem)
|
||||
index (inc (or (first (keep-indexed
|
||||
(fn [idx p]
|
||||
(when (= (:block/uuid page) (:block/uuid p))
|
||||
idx))
|
||||
duplicate-pages))
|
||||
0))
|
||||
stem' (if (= 1 index)
|
||||
stem
|
||||
(str stem " (" index ")"))]
|
||||
(str "pages/" stem' ".md")))))))
|
||||
|
||||
(defn- mirror-path
|
||||
[repo relative-path]
|
||||
(str (repo-mirror-dir repo) "/" relative-path))
|
||||
|
||||
(defn- page-id-for-entity
|
||||
[db eid]
|
||||
(when-let [entity (d/entity db eid)]
|
||||
(cond
|
||||
(ldb/page? entity) (:db/id entity)
|
||||
(:block/page entity) (:db/id (:block/page entity))
|
||||
(and (:block/parent entity) (ldb/page? (:block/parent entity))) (:db/id (:block/parent entity))
|
||||
(some-> entity :block/parent :block/page) (:db/id (:block/page (:block/parent entity))))))
|
||||
|
||||
(defn affected-page-ids
|
||||
[{:keys [db-before db-after tx-data]}]
|
||||
(->> tx-data
|
||||
(mapcat (fn [{:keys [e a v]}]
|
||||
(cond-> [(page-id-for-entity db-before e)
|
||||
(page-id-for-entity db-after e)]
|
||||
(= a :block/page)
|
||||
(conj v))))
|
||||
(remove nil?)
|
||||
set))
|
||||
|
||||
(defn set-enabled!
|
||||
[repo enabled?]
|
||||
(if enabled?
|
||||
(swap! *repo->enabled? assoc repo true)
|
||||
(do
|
||||
(when-let [timeout-id (get @*repo->flush-timeout repo)]
|
||||
(js/clearTimeout timeout-id))
|
||||
(swap! *repo->enabled? dissoc repo)
|
||||
(swap! *repo->queued-page-jobs dissoc repo)
|
||||
(swap! *repo->flush-timeout dissoc repo)))
|
||||
nil)
|
||||
|
||||
(defn enabled?
|
||||
[repo]
|
||||
(true? (get @*repo->enabled? repo)))
|
||||
|
||||
(defn- storage
|
||||
[platform*]
|
||||
(:storage platform*))
|
||||
|
||||
(defn- not-found-error?
|
||||
[error]
|
||||
(let [data (ex-data error)
|
||||
code (or (:code data) (some-> error .-code))
|
||||
name (some-> error .-name)
|
||||
message (some-> error .-message)]
|
||||
(or (contains? #{:not-found :enoent "ENOENT" "NotFoundError"} code)
|
||||
(= "NotFoundError" name)
|
||||
(boolean (some-> message (string/starts-with? "ENOENT:"))))))
|
||||
|
||||
(defn- <read-text
|
||||
[platform* path]
|
||||
(if-let [f (or (:mirror-read-text! (storage platform*))
|
||||
(:read-text! (storage platform*)))]
|
||||
(-> (f path)
|
||||
(p/catch (fn [error]
|
||||
(if (not-found-error? error)
|
||||
nil
|
||||
(p/rejected error)))))
|
||||
(p/rejected (ex-info "platform storage/read-text! missing" {:path path}))))
|
||||
|
||||
(defn- <write-text-atomic!
|
||||
[platform* path content]
|
||||
(if-let [f (:write-text-atomic! (storage platform*))]
|
||||
(f path content)
|
||||
(p/rejected (ex-info "platform storage/write-text-atomic! missing" {:path path}))))
|
||||
|
||||
(defn- <delete-file!
|
||||
[platform* path]
|
||||
(if-let [f (:delete-file! (storage platform*))]
|
||||
(f path)
|
||||
(p/rejected (ex-info "platform storage/delete-file! missing" {:path path}))))
|
||||
|
||||
(defn- supported-runtime?
|
||||
[platform*]
|
||||
(or (= :node (get-in platform* [:env :runtime]))
|
||||
(= :electron (get-in platform* [:env :owner-source]))))
|
||||
|
||||
(defn- duplicate-journal-day?
|
||||
[db journal-day]
|
||||
(when journal-day
|
||||
(< 1 (count (d/datoms db :avet :block/journal-day journal-day)))))
|
||||
|
||||
(defn- leading-space-count
|
||||
[line]
|
||||
(count (or (second (re-matches #"^(\s*).*$" line)) "")))
|
||||
|
||||
(defn- property-line-indent
|
||||
[line]
|
||||
(or (some-> (re-matches markdown-property-line-re line) second count)
|
||||
(some-> (re-matches property-line-re line) second count)))
|
||||
|
||||
(defn- property-value-line?
|
||||
[line property-indent]
|
||||
(and (some? property-indent)
|
||||
(not (string/blank? line))
|
||||
(< property-indent (leading-space-count line))))
|
||||
|
||||
(defn- content-ref-targets
|
||||
[title]
|
||||
(let [title (or title "")
|
||||
page-ref-targets (keep (fn [[_ prefix page-title]]
|
||||
(when-not (common-util/uuid-string? page-title)
|
||||
{:title page-title
|
||||
:tag? (= "#" prefix)}))
|
||||
(re-seq ref-or-tag-re title))
|
||||
simple-tag-targets (keep (fn [[_ _ tag-title]]
|
||||
(when-not (common-util/uuid-string? tag-title)
|
||||
{:title tag-title
|
||||
:tag? true}))
|
||||
(re-seq simple-hashtag-re title))]
|
||||
(distinct (concat page-ref-targets simple-tag-targets))))
|
||||
|
||||
(defn- status-marker
|
||||
[status]
|
||||
(when-let [content (some-> (cond
|
||||
(keyword? status) (name status)
|
||||
:else (or (db-property/closed-value-content status)
|
||||
(:block/title status)
|
||||
(:logseq.property/value status)))
|
||||
str
|
||||
string/trim)]
|
||||
(when-not (string/blank? content)
|
||||
(-> content
|
||||
string/upper-case
|
||||
(string/replace #"\s+" "-")))))
|
||||
|
||||
(defn- simple-tag-token?
|
||||
[title]
|
||||
(boolean
|
||||
(re-matches #"[^\s#\[\]\(\),.;:'\"`]+" (or title ""))))
|
||||
|
||||
(defn- tag-token
|
||||
[tag]
|
||||
(let [title (or (:block/title tag) (:block/name tag))]
|
||||
(when-not (string/blank? title)
|
||||
(if (simple-tag-token? title)
|
||||
(str "#" title)
|
||||
(str "#[[" title "]]")))))
|
||||
|
||||
(defn- built-in-tag?
|
||||
[tag]
|
||||
(or (ldb/built-in? tag)
|
||||
(some-> tag :db/ident namespace (= "logseq.class"))))
|
||||
|
||||
(defn- mirror-tag-tokens
|
||||
[block]
|
||||
(->> (:block/tags block)
|
||||
(remove built-in-tag?)
|
||||
(keep tag-token)
|
||||
sort
|
||||
vec))
|
||||
|
||||
(defn- id-property-line
|
||||
[block-uuid]
|
||||
(str "id:: " block-uuid))
|
||||
|
||||
(defn- content-has-status-marker?
|
||||
[content marker]
|
||||
(or (= content marker)
|
||||
(string/starts-with? content (str marker " "))))
|
||||
|
||||
(defn- content-tag-titles
|
||||
[content]
|
||||
(->> (content-ref-targets content)
|
||||
(keep (fn [{:keys [title tag?]}]
|
||||
(when tag? (string/lower-case title))))
|
||||
set))
|
||||
|
||||
(defn- token-title
|
||||
[token]
|
||||
(if (string/starts-with? token "#[[")
|
||||
(subs token 3 (- (count token) 2))
|
||||
(subs token 1)))
|
||||
|
||||
(defn- decorate-block-content
|
||||
[{:keys [tag-tokens] :as block-info} content]
|
||||
(let [content (or content "")
|
||||
status-marker' (:status-marker block-info)
|
||||
content (if (and status-marker'
|
||||
(not (content-has-status-marker? content status-marker')))
|
||||
(if (string/blank? content)
|
||||
status-marker'
|
||||
(str status-marker' " " content))
|
||||
content)
|
||||
existing-tag-titles (content-tag-titles content)
|
||||
tag-tokens' (remove (fn [token]
|
||||
(contains? existing-tag-titles
|
||||
(string/lower-case (token-title token))))
|
||||
tag-tokens)]
|
||||
(if (seq tag-tokens')
|
||||
(str content " " (string/join " " tag-tokens'))
|
||||
content)))
|
||||
|
||||
(declare decorate-rendered-content)
|
||||
|
||||
(defn- order-list-number?
|
||||
[block]
|
||||
(let [v (:logseq.property/order-list-type block)
|
||||
content (cond
|
||||
(string? v) v
|
||||
(keyword? v) (name v)
|
||||
:else (db-property/property-value-content v))]
|
||||
(= "number" (some-> content string/lower-case))))
|
||||
|
||||
(defn- embed-target
|
||||
[block]
|
||||
(let [target (:block/link block)]
|
||||
(when (and (:block/uuid target)
|
||||
(not (ldb/page? target)))
|
||||
target)))
|
||||
|
||||
(defn- content-first-line
|
||||
[content]
|
||||
(-> (or content "")
|
||||
string/split-lines
|
||||
first
|
||||
(or "")
|
||||
string/trim))
|
||||
|
||||
(defn- block-first-line-fragment
|
||||
[block]
|
||||
(content-first-line (:block/title block)))
|
||||
|
||||
(defn- code-fence-block-line?
|
||||
[content]
|
||||
(string/starts-with? (string/trim (or content "")) "```"))
|
||||
|
||||
(defn- normalize-rendered-match-text
|
||||
[content]
|
||||
(-> (or content "")
|
||||
string/lower-case
|
||||
(string/replace ref-or-tag-re "$1[[]]")
|
||||
(string/replace simple-hashtag-re "$1#[[]]")
|
||||
(string/replace #"\s+" " ")
|
||||
string/trim))
|
||||
|
||||
(defn- rendered-line-matches-block?
|
||||
[block-info content]
|
||||
(when block-info
|
||||
(let [content (or content "")
|
||||
fragment (:first-line-fragment block-info)
|
||||
content* (normalize-rendered-match-text content)
|
||||
fragment* (normalize-rendered-match-text fragment)]
|
||||
(cond
|
||||
(:code-block? block-info)
|
||||
(code-fence-block-line? content)
|
||||
|
||||
(string/blank? fragment)
|
||||
(string/blank? (string/trim content))
|
||||
|
||||
:else
|
||||
(string/includes? content* fragment*)))))
|
||||
|
||||
(defn- code-block?
|
||||
[block]
|
||||
(or (= :code (:logseq.property.node/display-type block))
|
||||
(some #(= :logseq.class/Code-block (:db/ident %))
|
||||
(:block/tags block))))
|
||||
|
||||
(defn- block-line-info
|
||||
[db block marker]
|
||||
(let [block (if (de/entity? block) block (d/entity db (:db/id block)))]
|
||||
{:first-line-fragment (block-first-line-fragment block)
|
||||
:code-block? (code-block? block)
|
||||
:status-marker (when (or (seq (d/datoms db :eavt (:db/id block) :logseq.property/status))
|
||||
(ldb/class-instance? (d/entity db :logseq.class/Task) block))
|
||||
(some-> (:logseq.property/status block) status-marker))
|
||||
:tag-tokens (mirror-tag-tokens block)
|
||||
:marker marker
|
||||
:embed-target (embed-target block)}))
|
||||
|
||||
(defn- property-derived-block?
|
||||
[block]
|
||||
(or (:logseq.property/created-from-property block)
|
||||
(:block/closed-value-property block)))
|
||||
|
||||
(defn- outline-children
|
||||
[block]
|
||||
(->> (:block/_parent block)
|
||||
(remove property-derived-block?)
|
||||
(sort-by :block/order)))
|
||||
|
||||
(defn- page-root-blocks
|
||||
[page]
|
||||
(outline-children page))
|
||||
|
||||
(defn- block-line-infos
|
||||
[db blocks]
|
||||
(loop [[block & more] blocks
|
||||
number 1
|
||||
result []]
|
||||
(if-not block
|
||||
result
|
||||
(let [ordered? (order-list-number? block)
|
||||
marker (if ordered? (str number ".") "-")
|
||||
result' (-> result
|
||||
(conj (block-line-info db block marker))
|
||||
(into (block-line-infos db (outline-children block))))]
|
||||
(recur more
|
||||
(cond-> number ordered? inc)
|
||||
result')))))
|
||||
|
||||
(defn- rendered-block-line-infos
|
||||
[db page]
|
||||
(block-line-infos db (page-root-blocks page)))
|
||||
|
||||
(defn- block->content-context
|
||||
[options]
|
||||
{:export-bullet-indentation (or (:export-bullet-indentation options) " ")
|
||||
:excluded-properties #{:logseq.property/status}
|
||||
:export-properties-as-list-items? true
|
||||
:export-node-property-values-as-page-refs? true
|
||||
:export-default-property-values-as-blocks? true
|
||||
:preserve-block-refs? true
|
||||
:date-formatter (:date-formatter options)})
|
||||
|
||||
(defn- block-content
|
||||
[db block-uuid tree-opts options]
|
||||
(common-file/block->content db block-uuid tree-opts (block->content-context options)))
|
||||
|
||||
(defn- line-level
|
||||
[spaces options]
|
||||
(let [indent-width (max 1 (count (or (:export-bullet-indentation options) " ")))]
|
||||
(inc (quot (count spaces) indent-width))))
|
||||
|
||||
(defn- decorate-block-line
|
||||
[db block-info line options]
|
||||
(if-let [[_ spaces title] (re-matches markdown-block-line-re line)]
|
||||
(if-let [target (:embed-target block-info)]
|
||||
(string/split-lines
|
||||
(decorate-rendered-content
|
||||
db
|
||||
(block-content db (:block/uuid target) {:init-level (line-level spaces options)} options)
|
||||
(block-line-infos db [target])
|
||||
options
|
||||
{:initial-lines []}))
|
||||
(let [content (decorate-block-content block-info title)
|
||||
marker (or (:marker block-info) "-")]
|
||||
[(str spaces marker
|
||||
(when-not (string/blank? content) " ")
|
||||
content)]))
|
||||
[line]))
|
||||
|
||||
(defn- decorate-rendered-content
|
||||
[db content line-infos options {:keys [initial-lines insert-blank-before-first-block?]}]
|
||||
(let [initial-lines (or initial-lines [])]
|
||||
(loop [[line & more] (string/split-lines (or content ""))
|
||||
[block-line-info' & more-block-line-infos] line-infos
|
||||
lines initial-lines
|
||||
seen-block? false
|
||||
property-indent nil
|
||||
in-code-block? false]
|
||||
(if (nil? line)
|
||||
(string/join "\n" lines)
|
||||
(cond
|
||||
in-code-block?
|
||||
(recur more
|
||||
(cons block-line-info' more-block-line-infos)
|
||||
(conj lines line)
|
||||
seen-block?
|
||||
property-indent
|
||||
(not (code-fence-block-line? line)))
|
||||
|
||||
(property-value-line? line property-indent)
|
||||
(recur more
|
||||
(cons block-line-info' more-block-line-infos)
|
||||
(conj lines line)
|
||||
seen-block?
|
||||
property-indent
|
||||
false)
|
||||
|
||||
:else
|
||||
(if-let [[_ _ title] (re-matches markdown-block-line-re line)]
|
||||
(if (rendered-line-matches-block? block-line-info' title)
|
||||
(let [lines' (cond-> lines
|
||||
(and insert-blank-before-first-block?
|
||||
(not seen-block?)) (conj "")
|
||||
true (into (decorate-block-line db block-line-info' line options)))]
|
||||
(recur more
|
||||
more-block-line-infos
|
||||
lines'
|
||||
true
|
||||
nil
|
||||
(and (:code-block? block-line-info')
|
||||
(code-fence-block-line? title))))
|
||||
(recur more
|
||||
(cons block-line-info' more-block-line-infos)
|
||||
(conj lines line)
|
||||
seen-block?
|
||||
property-indent
|
||||
false))
|
||||
(let [property-indent' (property-line-indent line)]
|
||||
(recur more
|
||||
(cons block-line-info' more-block-line-infos)
|
||||
(conj lines line)
|
||||
seen-block?
|
||||
property-indent'
|
||||
false))))))))
|
||||
|
||||
(defn- add-page-id-to-rendered-content
|
||||
[db page content options]
|
||||
(decorate-rendered-content
|
||||
db
|
||||
content
|
||||
(rendered-block-line-infos db page)
|
||||
options
|
||||
{:initial-lines [(id-property-line (:block/uuid page))]
|
||||
:insert-blank-before-first-block? true}))
|
||||
|
||||
(defn- render-page-content
|
||||
[db page options]
|
||||
(add-page-id-to-rendered-content
|
||||
db
|
||||
page
|
||||
(block-content db (:block/uuid page) {:include-page-properties? true} options)
|
||||
options))
|
||||
|
||||
(defn- mirrorable-page?
|
||||
[page]
|
||||
(and (ldb/page? page)
|
||||
(not (ldb/built-in? page))
|
||||
(not (ldb/property? page))
|
||||
(not (ldb/hidden? page))
|
||||
(not (:logseq.property.user/email page))))
|
||||
|
||||
(defn- mirrorable-pages
|
||||
[db]
|
||||
(->> (d/datoms db :avet :block/name)
|
||||
(map #(d/entity db (:e %)))
|
||||
(filter mirrorable-page?)
|
||||
(sort-by (fn [page]
|
||||
[(if (ldb/journal? page) 0 1)
|
||||
(str (:block/journal-day page))
|
||||
(string/lower-case (or (:block/title page) ""))
|
||||
(str (:block/uuid page))]))))
|
||||
|
||||
(defn- <write-if-changed!
|
||||
[platform* path content]
|
||||
(p/let [current (<read-text platform* path)]
|
||||
(if (= current content)
|
||||
{:status :skipped
|
||||
:reason :unchanged
|
||||
:path path}
|
||||
(p/let [_ (<write-text-atomic! platform* path content)]
|
||||
{:status :written
|
||||
:path path}))))
|
||||
|
||||
(defn- invalid-file-name-result
|
||||
[repo page]
|
||||
(let [result {:status :error
|
||||
:reason :invalid-file-name
|
||||
:repo repo
|
||||
:page-uuid (:block/uuid page)}]
|
||||
(log/error :markdown-mirror/invalid-file-name result)
|
||||
result))
|
||||
|
||||
(defn <mirror-page!
|
||||
[repo db page-id {:keys [platform] :as opts}]
|
||||
(let [platform* (or platform (platform/current))]
|
||||
(if-not (supported-runtime? platform*)
|
||||
(p/resolved {:status :skipped
|
||||
:reason :unsupported-runtime})
|
||||
(if-let [page (d/entity db page-id)]
|
||||
(cond
|
||||
(not (mirrorable-page? page))
|
||||
(p/resolved {:status :skipped
|
||||
:reason :excluded-page
|
||||
:repo repo
|
||||
:page-id page-id})
|
||||
|
||||
(and (ldb/journal? page)
|
||||
(duplicate-journal-day? db (:block/journal-day page)))
|
||||
(let [result {:status :error
|
||||
:reason :duplicate-journal-day
|
||||
:repo repo
|
||||
:journal-day (:block/journal-day page)
|
||||
:page-uuid (:block/uuid page)}]
|
||||
(log/error :markdown-mirror/duplicate-journal-day result)
|
||||
(p/resolved result))
|
||||
|
||||
:else
|
||||
(if-let [relative-path (page-relative-path db page opts)]
|
||||
(let [path (mirror-path repo relative-path)
|
||||
content (render-page-content db page opts)]
|
||||
(<write-if-changed! platform* path content))
|
||||
(p/resolved (invalid-file-name-result repo page))))
|
||||
(p/resolved {:status :skipped
|
||||
:reason :missing-page
|
||||
:repo repo
|
||||
:page-id page-id})))))
|
||||
|
||||
(defn- deleted-page?
|
||||
[page]
|
||||
(or (nil? page)
|
||||
(not (mirrorable-page? page))))
|
||||
|
||||
(defn- page-job
|
||||
[repo {:keys [db-before db-after]} page-id opts]
|
||||
(let [before-page (d/entity db-before page-id)
|
||||
after-page (d/entity db-after page-id)
|
||||
old-relative-path (when before-page (page-relative-path db-before before-page opts))
|
||||
new-relative-path (when after-page (page-relative-path db-after after-page opts))]
|
||||
{:repo repo
|
||||
:page-id page-id
|
||||
:db db-after
|
||||
:old-path (when old-relative-path (mirror-path repo old-relative-path))
|
||||
:new-path (when new-relative-path (mirror-path repo new-relative-path))
|
||||
:delete? (deleted-page? after-page)}))
|
||||
|
||||
(defn- merge-job
|
||||
[old-job new-job]
|
||||
(assoc new-job :old-path (or (:old-path old-job)
|
||||
(:old-path new-job))))
|
||||
|
||||
(defn- queue-job!
|
||||
[repo job]
|
||||
(swap! *repo->queued-page-jobs update-in [repo (:page-id job)] merge-job job))
|
||||
|
||||
(defn- drain-repo-jobs!
|
||||
[repo]
|
||||
(let [jobs (vals (get @*repo->queued-page-jobs repo))]
|
||||
(swap! *repo->queued-page-jobs dissoc repo)
|
||||
jobs))
|
||||
|
||||
(declare <flush-repo!)
|
||||
|
||||
(defn- schedule-flush!
|
||||
[repo opts]
|
||||
(when-not (get @*repo->flush-timeout repo)
|
||||
(let [timeout-id (js/setTimeout
|
||||
(fn []
|
||||
(swap! *repo->flush-timeout dissoc repo)
|
||||
(-> (<flush-repo! repo opts)
|
||||
(p/catch (fn [error]
|
||||
(log/error :markdown-mirror/flush-failed
|
||||
{:repo repo
|
||||
:error error})))))
|
||||
(or (:debounce-ms opts) 1000))]
|
||||
(swap! *repo->flush-timeout assoc repo timeout-id))))
|
||||
|
||||
(defn- <run-job!
|
||||
[platform* {:keys [repo db page-id old-path new-path delete?] :as _job} opts]
|
||||
(cond
|
||||
delete?
|
||||
(if old-path
|
||||
(p/let [_ (<delete-file! platform* old-path)]
|
||||
{:status :deleted
|
||||
:path old-path})
|
||||
(p/resolved {:status :skipped
|
||||
:reason :missing-old-path}))
|
||||
|
||||
:else
|
||||
(p/let [result (<mirror-page! repo db page-id (assoc opts :platform platform*))
|
||||
_ (when (and old-path
|
||||
new-path
|
||||
(not= old-path new-path)
|
||||
(or (= :written (:status result))
|
||||
(and (= :skipped (:status result))
|
||||
(= :unchanged (:reason result)))))
|
||||
(<delete-file! platform* old-path))]
|
||||
result)))
|
||||
|
||||
(defn <handle-tx-report!
|
||||
[repo _conn tx-report {:keys [platform defer?] :as opts}]
|
||||
(let [platform* (or platform (platform/current))]
|
||||
(if (and (enabled? repo)
|
||||
(supported-runtime? platform*)
|
||||
(not (get-in tx-report [:tx-meta :from-disk?])))
|
||||
(let [jobs (map #(page-job repo tx-report % opts)
|
||||
(affected-page-ids tx-report))]
|
||||
(if defer?
|
||||
(do
|
||||
(doseq [job jobs] (queue-job! repo job))
|
||||
(schedule-flush! repo (assoc opts :platform platform*))
|
||||
(p/resolved {:status :queued
|
||||
:count (count jobs)}))
|
||||
(p/all (map #(<run-job! platform* % opts) jobs))))
|
||||
(p/resolved {:status :skipped
|
||||
:reason :disabled-or-unsupported}))))
|
||||
|
||||
(defn <flush-repo!
|
||||
[repo {:keys [platform] :as opts}]
|
||||
(let [platform* (or platform (platform/current))
|
||||
jobs (drain-repo-jobs! repo)]
|
||||
(p/all (map #(<run-job! platform* % opts) jobs))))
|
||||
|
||||
(defn <mirror-repo!
|
||||
[repo db {:keys [platform] :as opts}]
|
||||
(let [platform* (or platform (platform/current))]
|
||||
(if-not (supported-runtime? platform*)
|
||||
(p/resolved {:status :skipped
|
||||
:reason :unsupported-runtime})
|
||||
(p/let [results (p/all
|
||||
(map #(<mirror-page! repo db (:db/id %) (assoc opts :platform platform*))
|
||||
(mirrorable-pages db)))]
|
||||
{:status :completed
|
||||
:count (count results)
|
||||
:results results}))))
|
||||
716
src/main/frontend/worker/pipeline.cljs
Normal file
716
src/main/frontend/worker/pipeline.cljs
Normal file
@@ -0,0 +1,716 @@
|
||||
(ns frontend.worker.pipeline
|
||||
"Pipeline work after transaction"
|
||||
(:require [clojure.set :as set]
|
||||
[clojure.string :as string]
|
||||
[datascript.core :as d]
|
||||
[frontend.worker-common.util :as worker-util]
|
||||
[frontend.worker.commands :as commands]
|
||||
[frontend.worker.render-affected-keys :as render-affected-keys]
|
||||
[frontend.worker.state :as worker-state]
|
||||
[logseq.common.util :as common-util]
|
||||
[logseq.common.util.date-time :as date-time-util]
|
||||
[logseq.common.util.page-ref :as page-ref]
|
||||
[logseq.common.uuid :as common-uuid]
|
||||
[logseq.db :as ldb]
|
||||
[logseq.db.common.entity-plus :as entity-plus]
|
||||
[logseq.db.common.order :as db-order]
|
||||
[logseq.db.frontend.class :as db-class]
|
||||
[logseq.db.frontend.property.build :as db-property-build]
|
||||
[logseq.db.sqlite.create-graph :as sqlite-create-graph]
|
||||
[logseq.db.sqlite.export :as sqlite-export]
|
||||
[logseq.graph-parser.exporter :as gp-exporter]
|
||||
[logseq.outliner.core :as outliner-core]
|
||||
[logseq.outliner.datascript-report :as ds-report]
|
||||
[logseq.outliner.page :as outliner-page]
|
||||
[logseq.outliner.pipeline :as outliner-pipeline]
|
||||
[logseq.outliner.template :as outliner-template]))
|
||||
|
||||
(def ^:private rtc-tx-or-download-graph?
|
||||
(let [p (some-fn :rtc-op? :rtc-tx? :rtc-download-graph? :transact-remote?)]
|
||||
(fn [tx-meta]
|
||||
(p tx-meta))))
|
||||
|
||||
(defn- refs-need-recalculated?
|
||||
[tx-meta]
|
||||
(let [outliner-op (:outliner-op tx-meta)]
|
||||
(not (or
|
||||
(contains? #{:collapse-expand-blocks :delete-blocks} outliner-op)
|
||||
(:undo? tx-meta) (:redo? tx-meta)))))
|
||||
|
||||
(defn- imported-data?
|
||||
[tx-meta]
|
||||
(or (::gp-exporter/imported-data? tx-meta)
|
||||
(::sqlite-export/imported-data? tx-meta)))
|
||||
|
||||
(defn- rebuild-block-refs
|
||||
[{:keys [tx-meta db-after db-before]} blocks]
|
||||
(when (or (and (:outliner-op tx-meta) (refs-need-recalculated? tx-meta))
|
||||
(:rtc-tx? tx-meta)
|
||||
(:rtc-op? tx-meta)
|
||||
(imported-data? tx-meta))
|
||||
(mapcat (fn [block]
|
||||
(when (and (d/entity db-after (:db/id block))
|
||||
;; don't compute refs for reactions
|
||||
(not (:logseq.property.reaction/target (d/entity db-after (:db/id block)))))
|
||||
(let [refs (->> (outliner-core/rebuild-block-refs db-after block) set)
|
||||
old-refs (->> (:block/refs (d/entity db-before (:db/id block)))
|
||||
(map :db/id)
|
||||
set)
|
||||
added-refs (when (and (seq refs) (not= refs old-refs))
|
||||
(set/difference refs old-refs))
|
||||
retracted-refs (when (and (seq old-refs) (not= refs old-refs))
|
||||
(set/difference old-refs refs))]
|
||||
(concat
|
||||
(map (fn [id]
|
||||
[:db/retract (:db/id block) :block/refs id])
|
||||
retracted-refs)
|
||||
(map (fn [id]
|
||||
[:db/add (:db/id block) :block/refs id])
|
||||
added-refs)))))
|
||||
blocks)))
|
||||
|
||||
(defn- journal-title
|
||||
[db journal-day]
|
||||
(date-time-util/int->journal-title
|
||||
journal-day
|
||||
(:logseq.property.journal/title-format (d/entity db :logseq.class/Journal))))
|
||||
|
||||
(defn- ensure-template-journal-pages
|
||||
[db blocks]
|
||||
(reduce
|
||||
(fn [{:keys [db tx-data] :as result} journal-day]
|
||||
(if (ldb/get-journal-page-by-day db journal-day)
|
||||
result
|
||||
(let [{page-tx-data :tx-data} (outliner-page/create db (journal-title db journal-day) {:journal? true})]
|
||||
(when-not (seq page-tx-data)
|
||||
(throw (ex-info "failed to create template journal page" {:journal-day journal-day})))
|
||||
{:db (:db-after (d/with db page-tx-data))
|
||||
:tx-data (concat tx-data page-tx-data)})))
|
||||
{:db db
|
||||
:tx-data []}
|
||||
(outliner-template/dynamic-template-journal-days blocks)))
|
||||
|
||||
(defn- insert-tag-templates
|
||||
[tx-report]
|
||||
(let [db (:db-after tx-report)
|
||||
journal-id (:db/id (d/entity db :logseq.class/Journal))
|
||||
journal-page (some (fn [d] (when (and (= :block/journal-day (:a d)) (:added d))
|
||||
(d/entity db (:e d))))
|
||||
(:tx-data tx-report))
|
||||
journal-template? (some (fn [d] (and (:added d)
|
||||
(= (:a d) :block/tags)
|
||||
(= (:v d) journal-id)))
|
||||
(:tx-data tx-report))
|
||||
tag->templates (fn [id]
|
||||
(let [tag (d/entity db id)
|
||||
parents (ldb/get-class-extends tag)
|
||||
templates (mapcat :logseq.property/_template-applied-to (conj parents tag))]
|
||||
(cond->> templates
|
||||
journal-page
|
||||
(map (fn [t] (assoc t :journal journal-page))))))
|
||||
raw-template-blocks (fn [template]
|
||||
(let [template-children (rest (ldb/get-block-and-children db (:block/uuid template)
|
||||
{:include-property-block? true}))]
|
||||
(->> (cons (assoc (first template-children)
|
||||
:logseq.property/used-template (:db/id template))
|
||||
(rest template-children))
|
||||
(map (fn [block]
|
||||
(cond->
|
||||
(assoc (into {} block) :db/id (:db/id block))
|
||||
(:journal template)
|
||||
(assoc :block/uuid
|
||||
(common-uuid/gen-journal-template-block
|
||||
(:block/uuid (:journal template))
|
||||
(:block/uuid block)))))))))
|
||||
tag-additions (->> (:tx-data tx-report)
|
||||
(filter (fn [d] (and (= (:a d) :block/tags) (:added d))))
|
||||
(group-by :e))
|
||||
insertion-inputs (mapcat
|
||||
(fn [[e datoms]]
|
||||
(let [templates (->> (set (map :v datoms))
|
||||
(mapcat tag->templates)
|
||||
distinct
|
||||
(sort-by :block/created-at))]
|
||||
(map (fn [template]
|
||||
{:object-id e
|
||||
:blocks (raw-template-blocks template)})
|
||||
templates)))
|
||||
tag-additions)
|
||||
{db-with-pages :db page-tx-data :tx-data} (ensure-template-journal-pages db (mapcat :blocks insertion-inputs))
|
||||
insert-tx-data (mapcat
|
||||
(fn [{:keys [object-id blocks]}]
|
||||
(let [object (d/entity db-with-pages object-id)
|
||||
blocks-to-insert (outliner-template/resolve-dynamic-template-blocks db-with-pages object blocks)]
|
||||
(when (seq blocks-to-insert)
|
||||
(let [result (outliner-core/insert-blocks
|
||||
db-with-pages blocks-to-insert object
|
||||
{:sibling? false
|
||||
:keep-uuid? journal-template?
|
||||
:outliner-op :insert-template-blocks})]
|
||||
(concat
|
||||
(:tx-data result)
|
||||
(mapcat (fn [block]
|
||||
(when-let [refs (seq (outliner-pipeline/block-content-refs db-with-pages block))]
|
||||
[{:db/id (:db/id block)
|
||||
:block/refs refs}]))
|
||||
(:blocks result)))))))
|
||||
insertion-inputs)]
|
||||
(concat page-tx-data insert-tx-data)))
|
||||
|
||||
(defn- fix-page-tags
|
||||
"Add missing attributes and remove #Page when inserting or updating block/title with inline tags"
|
||||
[{:keys [db-after tx-data tx-meta]}]
|
||||
(when-not (:rtc-tx? tx-meta)
|
||||
(let [page-tag (d/entity db-after :logseq.class/Page)
|
||||
tag (d/entity db-after :logseq.class/Tag)]
|
||||
(assert page-tag "Page tag doesn't exist")
|
||||
(mapcat
|
||||
(fn [datom]
|
||||
(when (and (= :block/tags (:a datom))
|
||||
(:added datom))
|
||||
(let [entity (d/entity db-after (:e datom))
|
||||
v-entity (d/entity db-after (:v datom))]
|
||||
(cond
|
||||
;; add missing :db/ident and :logseq.property.class/extends for new tag
|
||||
(and (= (:v datom) (:db/id tag))
|
||||
(not (ldb/inline-tag? (:block/raw-title entity) tag))
|
||||
(not (:db/ident entity)))
|
||||
(let [eid (:db/id entity)]
|
||||
(if (:block/page entity)
|
||||
;; Built-in #Tag should never turn a page child block into a class.
|
||||
[[:db/retract eid :block/tags :logseq.class/Tag]]
|
||||
[[:db/add eid :db/ident (db-class/create-user-class-ident-from-name db-after (:block/title entity))]
|
||||
[:db/add eid :logseq.property.class/extends :logseq.class/Root]
|
||||
[:db/retract eid :block/tags :logseq.class/Page]]))
|
||||
|
||||
;; remove #Page from tags/journals etc.
|
||||
(= (:db/id page-tag) (:v datom))
|
||||
(let [tags (->> entity
|
||||
:block/tags
|
||||
(map :db/ident)
|
||||
(remove #{:logseq.class/Page}))]
|
||||
(when (and (seq tags)
|
||||
;; has other page-classes other than `:logseq.class/Page`
|
||||
(some db-class/page-classes tags))
|
||||
[[:db/retract (:e datom) :block/tags :logseq.class/Page]]))
|
||||
|
||||
;; Add other page classes to an existing page
|
||||
;; Caused by invalid tags data from server
|
||||
;; TODO: remove this case
|
||||
;; DEADLINE: 2025-11-30
|
||||
(and (contains? (disj db-class/page-classes :logseq.class/Page) (:db/ident v-entity))
|
||||
(ldb/internal-page? entity))
|
||||
[[:db/retract (:e datom) :block/tags :logseq.class/Page]]
|
||||
|
||||
:else
|
||||
nil))))
|
||||
tx-data))))
|
||||
|
||||
(defn- remove-inline-page-class-from-title
|
||||
"Remove inline page tag from title"
|
||||
[block page-tag]
|
||||
(-> (string/replace (:block/raw-title block) (str "#" (page-ref/->page-ref (:block/uuid page-tag))) "")
|
||||
string/trim))
|
||||
|
||||
(defn- fix-inline-built-in-page-classes
|
||||
[{:keys [db-after tx-data tx-meta]}]
|
||||
(when-not (rtc-tx-or-download-graph? tx-meta)
|
||||
(let [classes (->> (remove #{:logseq.class/Page} db-class/page-classes)
|
||||
(map #(d/entity db-after %)))
|
||||
class-ids (set (map :db/id classes))]
|
||||
(->>
|
||||
(keep
|
||||
(fn [datom]
|
||||
(when (and (= :block/tags (:a datom))
|
||||
(:added datom)
|
||||
(contains? class-ids (:v datom)))
|
||||
(let [id (:e datom)
|
||||
entity (d/entity db-after id)
|
||||
title (or (:block/raw-title entity) (:block/title entity))
|
||||
page-tag (d/entity db-after (:v datom))]
|
||||
(when (and title
|
||||
(string/includes? title "#[[")
|
||||
(ldb/inline-tag? title page-tag))
|
||||
(let [title (remove-inline-page-class-from-title entity page-tag)]
|
||||
[{:db/id id
|
||||
:block/title title}
|
||||
[:db/retract id :block/tags (:v datom)]
|
||||
[:db/retract id :block/tags :logseq.class/Page]])))))
|
||||
tx-data)
|
||||
(apply concat)))))
|
||||
|
||||
(defn- toggle-page-and-block
|
||||
[db {:keys [db-before db-after tx-data tx-meta]}]
|
||||
(when-not (rtc-tx-or-download-graph? tx-meta)
|
||||
(let [page-tag (d/entity db :logseq.class/Page)
|
||||
library-page (ldb/get-library-page db-after)]
|
||||
(mapcat
|
||||
(fn [datom]
|
||||
(let [id (:e datom)
|
||||
page-tag-update? (and (= :block/tags (:a datom))
|
||||
(= (:db/id page-tag) (:v datom)))
|
||||
move-to-library? (and (= :block/parent (:a datom))
|
||||
(= (:db/id library-page) (:v datom))
|
||||
(:added datom))]
|
||||
(when (or page-tag-update? move-to-library?)
|
||||
(let [block-before (d/entity db-before id)
|
||||
block-after (d/entity db-after id)]
|
||||
(when block-after
|
||||
(cond
|
||||
;; move non-page block to Library
|
||||
(and move-to-library? (not (ldb/page? block-after)))
|
||||
[{:db/id id
|
||||
:block/name (common-util/page-name-sanity-lc (:block/title block-after))
|
||||
:block/tags :logseq.class/Page}
|
||||
[:db/retract id :block/page]]
|
||||
|
||||
;; block->page
|
||||
(and (:added datom) (or (nil? block-before) (not (ldb/page? block-before)))) ; block->page
|
||||
(let [block (d/entity db-after (:e datom))
|
||||
block-parent (:block/parent block)
|
||||
;; remove inline #Page from title
|
||||
page-title (remove-inline-page-class-from-title block page-tag)
|
||||
->page-tx (concat
|
||||
[{:db/id id
|
||||
:block/name (common-util/page-name-sanity-lc page-title)
|
||||
:block/title page-title}
|
||||
[:db/retract id :block/page]]
|
||||
(when (or (ldb/class? block-parent) (ldb/property? block-parent))
|
||||
[[:db/retract id :block/parent]
|
||||
[:db/retract id :block/order]]))
|
||||
move-parent-to-library-tx (when (and (ldb/page? block-parent)
|
||||
(nil? (:block/parent block-parent))
|
||||
block-parent
|
||||
(not= (:db/id block-parent) (:db/id library-page))
|
||||
(not (:db/ident block-parent))
|
||||
(not (ldb/built-in? block-parent)))
|
||||
[{:db/id (:db/id block-parent)
|
||||
:block/parent (:db/id (ldb/get-library-page db-after))
|
||||
:block/order (db-order/gen-key)}])]
|
||||
(concat ->page-tx move-parent-to-library-tx))
|
||||
|
||||
;; page->block
|
||||
(and block-before (not (:added datom)) (ldb/internal-page? block-before))
|
||||
(let [parent (:block/parent block-before)
|
||||
parent-page (when parent
|
||||
(loop [parent parent]
|
||||
(if (ldb/page? parent)
|
||||
parent
|
||||
(recur (:block/parent parent)))))]
|
||||
(when parent-page
|
||||
[[:db/retract id :block/name]
|
||||
[:db/add id :block/page (:db/id parent-page)]]))))))))
|
||||
tx-data))))
|
||||
|
||||
(defn- add-missing-properties-to-typed-display-blocks
|
||||
"Add missing properties for these cases:
|
||||
1. Add corresponding tag when invoking commands like /code block.
|
||||
2. Add properties when tagging a block.
|
||||
3. Add properties when removing a tag from a block"
|
||||
[db datoms tx-meta]
|
||||
(when-not (rtc-tx-or-download-graph? tx-meta)
|
||||
(mapcat
|
||||
(fn [d]
|
||||
(cond
|
||||
(and (= (:a d) :logseq.property.node/display-type) (keyword? (:v d)) (:added d))
|
||||
(when-let [tag (ldb/get-class-ident-by-display-type (:v d))]
|
||||
[[:db/add (:e d) :block/tags tag]])
|
||||
|
||||
(and (= (:a d) :block/tags)
|
||||
(contains? ldb/node-display-type-classes (:db/ident (d/entity db (:v d))))
|
||||
(false? (:added d)))
|
||||
[[:db/retract (:e d) :logseq.property.node/display-type]]
|
||||
|
||||
(and (= (:a d) :block/tags)
|
||||
(contains? ldb/node-display-type-classes (:db/ident (d/entity db (:v d))))
|
||||
(:added d))
|
||||
(when-let [display-type (ldb/get-display-type-by-class-ident (:db/ident (d/entity db (:v d))))]
|
||||
(let [block (d/entity db (:e d))
|
||||
latest-code-lang (:kv/value (d/entity db :logseq.kv/latest-code-lang))]
|
||||
[(cond->
|
||||
{:db/id (:e d)
|
||||
:logseq.property.node/display-type display-type}
|
||||
(and (= display-type :code)
|
||||
(nil? (:logseq.property.code/lang block))
|
||||
latest-code-lang)
|
||||
(assoc :logseq.property.code/lang latest-code-lang))]))))
|
||||
datoms)))
|
||||
|
||||
(defn- ensure-query-property-on-tag-additions
|
||||
[tx-report]
|
||||
(let [{:keys [db-after tx-data tx-meta]} tx-report
|
||||
query-class (entity-plus/entity-memoized db-after :logseq.class/Query)
|
||||
query-property (d/entity db-after :logseq.property/query)]
|
||||
(when (and query-class
|
||||
query-property
|
||||
(not (rtc-tx-or-download-graph? tx-meta))
|
||||
(not (:undo? tx-meta))
|
||||
(not (:redo? tx-meta)))
|
||||
(let [tagged-block-ids (->> tx-data
|
||||
(filter (fn [d] (and (= :block/tags (:a d)) (:added d))))
|
||||
(map :e)
|
||||
(distinct))]
|
||||
(mapcat
|
||||
(fn [eid]
|
||||
(when-let [block (d/entity db-after eid)]
|
||||
(when (ldb/class-instance? query-class block)
|
||||
(let [query-entity (:logseq.property/query block)]
|
||||
(when-not (and query-entity (:block/uuid query-entity))
|
||||
(let [query-text (if (string? query-entity) query-entity "")
|
||||
value-block (db-property-build/build-property-value-block
|
||||
block
|
||||
query-property
|
||||
query-text
|
||||
{:block-uuid (common-uuid/gen-uuid)})
|
||||
value-uuid (:block/uuid value-block)]
|
||||
[value-block
|
||||
(outliner-core/block-with-updated-at
|
||||
{:db/id (:db/id block)
|
||||
:logseq.property/query [:block/uuid value-uuid]})]))))))
|
||||
tagged-block-ids)))))
|
||||
|
||||
(defn- ensure-comments-blocks-property-on-tag-additions
|
||||
[tx-report]
|
||||
(let [{:keys [db-after tx-data tx-meta]} tx-report
|
||||
comments-class (d/entity db-after :logseq.class/Comments)]
|
||||
(when (and comments-class
|
||||
(not (rtc-tx-or-download-graph? tx-meta))
|
||||
(not (:undo? tx-meta))
|
||||
(not (:redo? tx-meta)))
|
||||
(->> tx-data
|
||||
(keep (fn [datom]
|
||||
(when (and (= :block/tags (:a datom))
|
||||
(:added datom)
|
||||
(= (:db/id comments-class) (:v datom)))
|
||||
(:e datom))))
|
||||
distinct
|
||||
(keep (fn [eid]
|
||||
(when-let [block (d/entity db-after eid)]
|
||||
(when (and (:block/parent block)
|
||||
(not (seq (:logseq.property.comments/blocks block))))
|
||||
(outliner-core/block-with-updated-at
|
||||
{:db/id eid
|
||||
:logseq.property.comments/blocks (:db/id (:block/parent block))})))))))))
|
||||
|
||||
(defn- gen-created-by-block
|
||||
[decoded-id-token]
|
||||
(let [user-uuid (:sub decoded-id-token)
|
||||
user-name (:cognito:username decoded-id-token)
|
||||
email (:email decoded-id-token)
|
||||
now (common-util/time-ms)]
|
||||
{:block/uuid (uuid user-uuid)
|
||||
:block/name user-name
|
||||
:block/title user-name
|
||||
:block/tags :logseq.class/Page
|
||||
:block/created-at now
|
||||
:block/updated-at now
|
||||
:logseq.property.user/name user-name
|
||||
:logseq.property.user/email email}))
|
||||
|
||||
(defn- add-created-by-ref-hook
|
||||
[db-before db-after tx-data tx-meta]
|
||||
(when (and (not (or (:undo? tx-meta) (:redo? tx-meta) (rtc-tx-or-download-graph? tx-meta)))
|
||||
(seq tx-data))
|
||||
(when-let [decoded-id-token (some-> (worker-state/get-id-token) worker-util/parse-jwt)]
|
||||
(let [created-by-ent (d/entity db-after [:block/uuid (uuid (:sub decoded-id-token))])
|
||||
created-by-block (when (nil? created-by-ent)
|
||||
(assoc (gen-created-by-block decoded-id-token) :db/id "created-by-id"))
|
||||
created-by-id (or (:db/id created-by-ent) "created-by-id")
|
||||
add-created-by-tx-data
|
||||
(keep
|
||||
(fn [datom]
|
||||
(let [attr (:a datom)
|
||||
value (:v datom)
|
||||
e (:e datom)]
|
||||
(cond
|
||||
;; add created-by for new-block
|
||||
(and (keyword-identical? :block/uuid attr)
|
||||
(:added datom))
|
||||
(when-let [ent (d/entity db-after e)]
|
||||
(when-not (:logseq.property/created-by-ref ent)
|
||||
[:db/add e :logseq.property/created-by-ref created-by-id]))
|
||||
|
||||
;; update created-by when block change from empty-block-title to non-empty
|
||||
(and (keyword-identical? :block/title attr)
|
||||
(not (string/blank? value))
|
||||
(let [origin-title (:block/title (d/entity db-before e))]
|
||||
(and (some? origin-title)
|
||||
(string/blank? origin-title))))
|
||||
(when (d/entity db-after e)
|
||||
[:db/add e :logseq.property/created-by-ref created-by-id]))))
|
||||
tx-data)]
|
||||
(cond->> add-created-by-tx-data
|
||||
(nil? created-by-ent) (cons created-by-block))))))
|
||||
|
||||
(defn- revert-disallowed-changes
|
||||
[{:keys [tx-meta tx-data db-before db-after]}]
|
||||
(when-not (or (rtc-tx-or-download-graph? tx-meta)
|
||||
(:fix-db? tx-meta))
|
||||
(let [built-in-page? (fn [id]
|
||||
(let [block (d/entity db-after id)]
|
||||
(and (contains? sqlite-create-graph/built-in-pages-names
|
||||
(:block/title block))
|
||||
(ldb/built-in? block))))
|
||||
tx-data' (mapcat
|
||||
(fn [datom]
|
||||
(let [[e a v _t added] datom]
|
||||
(when added
|
||||
(cond
|
||||
;; using built-in pages as tags
|
||||
(and (= a :block/tags) (built-in-page? v))
|
||||
[[:db/retract v :db/ident]
|
||||
[:db/retract v :logseq.property.class/extends]
|
||||
[:db/retract v :block/tags :logseq.class/Tag]
|
||||
[:db/add v :block/tags :logseq.class/Page]
|
||||
[:db/retract e a v]]
|
||||
|
||||
;; built-in block protected properties updated
|
||||
(and (contains? #{:db/ident :block/title :block/name :block/uuid
|
||||
:logseq.property/type :db/cardinality
|
||||
:logseq.property/built-in? :logseq.property.class/extends} a)
|
||||
(some? (d/entity db-before e))
|
||||
(let [block (d/entity db-after e)]
|
||||
(and (ldb/built-in? block)
|
||||
(not= (get block a) (get (d/entity db-before e) a)))))
|
||||
(if-some [prev-v (get (d/entity db-before e) a)]
|
||||
(if (= a :logseq.property.class/extends)
|
||||
[[:db/retract e a]
|
||||
{:db/id e
|
||||
a (map :db/id prev-v)}]
|
||||
[[:db/add e a prev-v]])
|
||||
[[:db/retract e a v]])
|
||||
|
||||
;; user class extends unexpected built-in classes
|
||||
(and (= a :logseq.property.class/extends)
|
||||
(let [block (d/entity db-after v)]
|
||||
(and (ldb/built-in? block)
|
||||
(not (contains? #{:logseq.class/Root :logseq.class/Page :logseq.class/Property
|
||||
:logseq.class/Task :logseq.class/Card}
|
||||
(:db/ident block))))))
|
||||
(let [prev-v (get (d/entity db-before e) a)]
|
||||
[[:db/retract e a v]
|
||||
(if (seq prev-v)
|
||||
{:db/id e
|
||||
a (map :db/id prev-v)}
|
||||
[:db/add e a :logseq.class/Root])])
|
||||
|
||||
:else
|
||||
nil))))
|
||||
tx-data)]
|
||||
(distinct tx-data'))))
|
||||
|
||||
(defn- compute-extra-tx-data
|
||||
[tx-report]
|
||||
(let [{:keys [db-before db-after tx-data tx-meta]} tx-report
|
||||
db db-after
|
||||
revert-tx-data (revert-disallowed-changes tx-report)
|
||||
fix-page-tags-tx-data (fix-page-tags tx-report)
|
||||
fix-inline-page-tx-data (fix-inline-built-in-page-classes tx-report)
|
||||
toggle-page-and-block-tx-data (when (empty? fix-inline-page-tx-data)
|
||||
(toggle-page-and-block db tx-report))
|
||||
display-blocks-tx-data (add-missing-properties-to-typed-display-blocks db-after tx-data tx-meta)
|
||||
ensure-query-tx-data (ensure-query-property-on-tag-additions tx-report)
|
||||
ensure-comments-tx-data (ensure-comments-blocks-property-on-tag-additions tx-report)
|
||||
commands-tx (when-not (or (:undo? tx-meta)
|
||||
(= :rebase (:outliner-op tx-meta))
|
||||
(rtc-tx-or-download-graph? tx-meta))
|
||||
(commands/run-commands tx-report))
|
||||
before-template-tx-data (concat revert-tx-data
|
||||
toggle-page-and-block-tx-data
|
||||
display-blocks-tx-data
|
||||
ensure-query-tx-data
|
||||
ensure-comments-tx-data
|
||||
commands-tx)
|
||||
template-db (if (seq before-template-tx-data)
|
||||
(:db-after (d/with db-after before-template-tx-data))
|
||||
db-after)
|
||||
insert-templates-tx (when-not (rtc-tx-or-download-graph? tx-meta)
|
||||
(insert-tag-templates (assoc tx-report :db-after template-db)))
|
||||
created-by-tx (add-created-by-ref-hook db-before db-after tx-data tx-meta)]
|
||||
(concat before-template-tx-data
|
||||
insert-templates-tx
|
||||
created-by-tx
|
||||
fix-page-tags-tx-data
|
||||
fix-inline-page-tx-data)))
|
||||
|
||||
(def ^:private journal-protected-update-attrs
|
||||
#{:block/title :block/name})
|
||||
|
||||
(defn- ensure-journal-page-protected-attrs-not-updated!
|
||||
[{:keys [db-before tx-data]}]
|
||||
(when-let [violation
|
||||
(some (fn [{:keys [e a v added]}]
|
||||
(when (and added
|
||||
(contains? journal-protected-update-attrs a))
|
||||
(let [before-ent (d/entity db-before e)]
|
||||
(when (and before-ent
|
||||
(ldb/journal? before-ent)
|
||||
(not= (get before-ent a) v))
|
||||
{:type :journal-page-protected-attr-updated
|
||||
:entity-id e
|
||||
:attr a
|
||||
:before (get before-ent a)
|
||||
:after v
|
||||
:journal-day (:block/journal-day before-ent)}))))
|
||||
tx-data)]
|
||||
(throw (ex-info "journal page protected attr updated" violation))))
|
||||
|
||||
(defn- projected-reference-content-datom?
|
||||
[datom]
|
||||
(not (contains? #{:block/tx-id :block/updated-at} (:a datom))))
|
||||
|
||||
(defn- reference-attrs
|
||||
[db]
|
||||
(let [schema (d/schema db)
|
||||
property-class-id (d/entid db :logseq.class/Property)
|
||||
private-property-ids (into #{}
|
||||
(map :e)
|
||||
(d/datoms db :avet :logseq.property/public? false))]
|
||||
(into #{:block/refs}
|
||||
(keep (fn [datom]
|
||||
(let [property-id (:e datom)
|
||||
ident (some-> (first (d/datoms db :eavt property-id :db/ident))
|
||||
:v)]
|
||||
(when (and ident
|
||||
(not (contains? private-property-ids property-id))
|
||||
(= :db.type/ref
|
||||
(get-in schema [ident :db/valueType])))
|
||||
ident))))
|
||||
(if property-class-id
|
||||
(d/datoms db :avet :block/tags property-class-id)
|
||||
[]))))
|
||||
|
||||
(def ^:private reference-attr-definition-attrs
|
||||
#{:db/ident
|
||||
:db/valueType
|
||||
:block/tags
|
||||
:logseq.property/public?})
|
||||
|
||||
(defn- reference-owner-ids-at
|
||||
[db reference-attrs' target-id]
|
||||
(into #{}
|
||||
(mapcat (fn [attr]
|
||||
(map :e (d/datoms db :avet attr target-id))))
|
||||
reference-attrs'))
|
||||
|
||||
(defn- projected-reference-owner-ids
|
||||
[{:keys [db-before db-after tx-data]}]
|
||||
(let [target-ids (into #{}
|
||||
(comp
|
||||
(filter projected-reference-content-datom?)
|
||||
(map :e)
|
||||
(filter #(d/entity db-before %)))
|
||||
tx-data)]
|
||||
(if (empty? target-ids)
|
||||
#{}
|
||||
(let [reference-attrs-changed?
|
||||
(some #(contains? reference-attr-definition-attrs (:a %)) tx-data)
|
||||
before-reference-attrs (reference-attrs db-before)
|
||||
after-reference-attrs (if reference-attrs-changed?
|
||||
(reference-attrs db-after)
|
||||
before-reference-attrs)]
|
||||
(into #{}
|
||||
(mapcat (fn [target-id]
|
||||
(concat
|
||||
(reference-owner-ids-at db-before before-reference-attrs target-id)
|
||||
(reference-owner-ids-at db-after after-reference-attrs target-id)
|
||||
(map :db/id
|
||||
(keep #(some-> (d/entity % target-id)
|
||||
:block/closed-value-property)
|
||||
[db-before db-after])))))
|
||||
target-ids)))))
|
||||
|
||||
(defn- revision-owner-ids
|
||||
[{:keys [tx-data tx-meta] :as tx-report}]
|
||||
(let [revision-datom? (if (:fix-db? tx-meta)
|
||||
#(not= :block/tx-id (:a %))
|
||||
projected-reference-content-datom?)]
|
||||
(into (projected-reference-owner-ids tx-report)
|
||||
(comp
|
||||
(filter revision-datom?)
|
||||
(map :e))
|
||||
tx-data)))
|
||||
|
||||
(defn transact-pipeline
|
||||
"Compute extra tx-data and block refs, then stamp changed block entities and
|
||||
projected reference owners. This function must stay pure and must not call
|
||||
`d/transact!` or `ldb/transact!`."
|
||||
[{:keys [db-after tx-meta _tx-data] :as tx-report}]
|
||||
(let [derive-extra-data? (not (or (:sync-download-graph? tx-meta)
|
||||
(:reverse? tx-meta)
|
||||
(:transact-remote? tx-meta)
|
||||
(imported-data? tx-meta)))
|
||||
_ (when (and derive-extra-data?
|
||||
(not (rtc-tx-or-download-graph? tx-meta)))
|
||||
(ensure-journal-page-protected-attrs-not-updated! tx-report))
|
||||
extra-tx-data (when derive-extra-data?
|
||||
(compute-extra-tx-data tx-report))
|
||||
tx-report* (if (seq extra-tx-data)
|
||||
(let [result (d/with db-after extra-tx-data)]
|
||||
(assoc tx-report
|
||||
:tx-data (concat (:tx-data tx-report) (:tx-data result))
|
||||
:db-after (:db-after result)))
|
||||
tx-report)
|
||||
{:keys [blocks]} (ds-report/get-blocks-and-pages tx-report*)
|
||||
deleted-blocks (outliner-pipeline/filter-deleted-blocks (:tx-data tx-report*))
|
||||
deleted-block-ids (set (map :db/id deleted-blocks))
|
||||
surviving-blocks (remove (fn [block]
|
||||
(deleted-block-ids (:db/id block)))
|
||||
blocks)
|
||||
block-refs (when (and (or derive-extra-data?
|
||||
(imported-data? tx-meta))
|
||||
(seq surviving-blocks))
|
||||
(rebuild-block-refs tx-report* surviving-blocks))
|
||||
revision-owner-ids' (revision-owner-ids tx-report*)
|
||||
tx-id-data (let [db-after (:db-after tx-report*)
|
||||
tx-id (inc (:max-tx db-after))]
|
||||
(into []
|
||||
(keep (fn [db-id]
|
||||
(when (and (not (contains? deleted-block-ids db-id))
|
||||
(:block/uuid (d/entity db-after db-id)))
|
||||
{:db/id db-id
|
||||
:block/tx-id tx-id})))
|
||||
revision-owner-ids'))
|
||||
block-refs-tx-id-data (concat block-refs tx-id-data)
|
||||
replace-tx-report (when (seq block-refs-tx-id-data)
|
||||
(d/with (:db-after tx-report*) block-refs-tx-id-data))
|
||||
tx-report' (or replace-tx-report tx-report*)
|
||||
full-tx-data (concat (:tx-data tx-report*)
|
||||
(:tx-data replace-tx-report))]
|
||||
(assoc tx-report'
|
||||
:tx-data full-tx-data
|
||||
:tx-meta tx-meta
|
||||
:db-before (:db-before tx-report)
|
||||
:db-after (or (:db-after tx-report')
|
||||
(:db-after tx-report)))))
|
||||
|
||||
(defn- invoke-hooks-default
|
||||
[tx-report _context]
|
||||
(try
|
||||
(let [{:keys [pages blocks]} (ds-report/get-blocks-and-pages tx-report)
|
||||
deleted-blocks (outliner-pipeline/filter-deleted-blocks (:tx-data tx-report))
|
||||
deleted-block-uuids (set (map :block/uuid deleted-blocks))
|
||||
deleted-block-ids (set (map :db/id deleted-blocks))
|
||||
_ (when (seq deleted-block-uuids)
|
||||
(swap! worker-state/*deleted-block-uuid->db-id merge
|
||||
(zipmap (map :block/uuid deleted-blocks)
|
||||
(map :db/id deleted-blocks))))
|
||||
deleted-assets (keep (fn [id]
|
||||
(let [e (d/entity (:db-before tx-report) id)]
|
||||
(when (ldb/asset? e)
|
||||
{:block/uuid (:block/uuid e)
|
||||
:ext (:logseq.property.asset/type e)}))) deleted-block-ids)
|
||||
affected-keys (render-affected-keys/affected-keys tx-report)]
|
||||
{:tx-report tx-report
|
||||
:affected-keys affected-keys
|
||||
:deleted-block-uuids deleted-block-uuids
|
||||
:deleted-assets deleted-assets
|
||||
:pages pages
|
||||
:blocks blocks})
|
||||
(catch :default e
|
||||
(js/console.error e)
|
||||
(throw e))))
|
||||
|
||||
(defn invoke-hooks
|
||||
[_conn tx-report context]
|
||||
(invoke-hooks-default tx-report context))
|
||||
279
src/main/frontend/worker/plain_value.cljs
Normal file
279
src/main/frontend/worker/plain_value.cljs
Normal file
@@ -0,0 +1,279 @@
|
||||
(ns frontend.worker.plain-value
|
||||
"Plain value conversion helpers for db worker responses."
|
||||
(:require [clojure.string :as string]
|
||||
[clojure.walk :as walk]
|
||||
[datascript.core :as d]
|
||||
[datascript.impl.entity :as de]
|
||||
[logseq.db :as ldb]))
|
||||
|
||||
(defn- ref-value->summary
|
||||
[db value]
|
||||
(if-let [entity (d/entity db value)]
|
||||
(let [raw-title (or (:block/raw-title entity) (:block/title entity))
|
||||
property-value-datom (first (d/datoms db :eavt (:db/id entity) :logseq.property/value))
|
||||
tag-idents (into []
|
||||
(keep (fn [datom]
|
||||
(:db/ident (d/entity db (:v datom)))))
|
||||
(d/datoms db :eavt (:db/id entity) :block/tags))]
|
||||
(cond-> {:db/id (:db/id entity)}
|
||||
(seq tag-idents)
|
||||
(assoc :block/tags tag-idents)
|
||||
(:block/uuid entity)
|
||||
(assoc :block/uuid (:block/uuid entity))
|
||||
raw-title
|
||||
(assoc :block/title raw-title
|
||||
:block/raw-title raw-title)
|
||||
(:block/name entity)
|
||||
(assoc :block/name (:block/name entity))
|
||||
(:block/journal-day entity)
|
||||
(assoc :block/journal-day (:block/journal-day entity))
|
||||
(:logseq.property/icon entity)
|
||||
(assoc :logseq.property/icon (:logseq.property/icon entity))
|
||||
(:logseq.property/choice-checkbox-state entity)
|
||||
(assoc :logseq.property/choice-checkbox-state (:logseq.property/choice-checkbox-state entity))
|
||||
property-value-datom
|
||||
(assoc :logseq.property/value (:v property-value-datom))
|
||||
(:db/ident entity)
|
||||
(assoc :db/ident (:db/ident entity))))
|
||||
{:db/id value}))
|
||||
|
||||
(defn- ref-attr?
|
||||
[db attr]
|
||||
(= :db.type/ref
|
||||
(or (get-in (d/schema db) [attr :db/valueType])
|
||||
(:db/valueType (d/entity db attr)))))
|
||||
|
||||
(defn- many-attr?
|
||||
[db attr]
|
||||
(= :db.cardinality/many
|
||||
(or (get-in (d/schema db) [attr :db/cardinality])
|
||||
(:db/cardinality (d/entity db attr)))))
|
||||
|
||||
(defn- node-property-target-id
|
||||
[db value-id]
|
||||
(let [property-value (d/entity db value-id)]
|
||||
(if (:logseq.property/created-from-property property-value)
|
||||
(let [title (:block/title property-value)]
|
||||
(if-let [target-uuid (parse-uuid title)]
|
||||
(let [target (d/entity db [:block/uuid target-uuid])]
|
||||
(assert target (str "Missing node property target: " title))
|
||||
(:db/id target))
|
||||
value-id))
|
||||
value-id)))
|
||||
|
||||
(defn attribute-value->plain
|
||||
[db attr value]
|
||||
(if (ref-attr? db attr)
|
||||
(let [property (d/entity db attr)
|
||||
ref-id (if (= :node (:logseq.property/type property))
|
||||
(node-property-target-id db value)
|
||||
value)]
|
||||
(ref-value->summary db ref-id))
|
||||
value))
|
||||
|
||||
(defn- number->letters
|
||||
[n]
|
||||
(when (pos? n)
|
||||
(loop [n n
|
||||
result ""]
|
||||
(if (pos? n)
|
||||
(let [offset (mod (dec n) 26)
|
||||
ch (.fromCharCode js/String (+ 65 offset))]
|
||||
(recur (quot (- n offset) 26) (str ch result)))
|
||||
result))))
|
||||
|
||||
(defn- number->roman
|
||||
[n]
|
||||
(when (pos? n)
|
||||
(let [pairs [[1000 "M"] [900 "CM"] [500 "D"] [400 "CD"]
|
||||
[100 "C"] [90 "XC"] [50 "L"] [40 "XL"]
|
||||
[10 "X"] [9 "IX"] [5 "V"] [4 "IV"] [1 "I"]]]
|
||||
(loop [n n
|
||||
[[value numeral] & more] pairs
|
||||
result ""]
|
||||
(cond
|
||||
(zero? n) result
|
||||
(>= n value) (recur (- n value) pairs (str result numeral))
|
||||
:else (recur n more result))))))
|
||||
|
||||
(defn order-list-type
|
||||
[block]
|
||||
(some-> (:logseq.property/order-list-type block)
|
||||
str
|
||||
string/lower-case))
|
||||
|
||||
(def ^:private unsafe-plain-attrs
|
||||
#{:block/properties
|
||||
:block/properties-text-values})
|
||||
|
||||
(defn order-list-index
|
||||
[block target-order-list-type]
|
||||
(let [order-block? (fn [block]
|
||||
(= target-order-list-type (order-list-type block)))
|
||||
prev-block-fn ldb/get-left-sibling
|
||||
prev-block (prev-block-fn block)]
|
||||
(letfn [(order-sibling-list [b]
|
||||
(lazy-seq
|
||||
(when (order-block? b)
|
||||
(cons b (order-sibling-list (prev-block-fn b))))))
|
||||
(order-parent-list [b]
|
||||
(lazy-seq
|
||||
(when (order-block? b)
|
||||
(cons b (order-parent-list (:block/parent b))))))]
|
||||
(let [idx (if prev-block
|
||||
(count (order-sibling-list block))
|
||||
1)
|
||||
order-parents-count (dec (count (order-parent-list block)))
|
||||
delta (if (neg? order-parents-count) 0 (mod order-parents-count 3))]
|
||||
(cond
|
||||
(zero? delta) idx
|
||||
(= delta 1) (some-> (number->letters idx) string/lower-case)
|
||||
:else (number->roman idx))))))
|
||||
|
||||
(defn entity-forward-map
|
||||
[db entity {:keys [properties exclude-attrs]}]
|
||||
(when entity
|
||||
(let [property-set (some-> properties set)
|
||||
excluded-attrs (set exclude-attrs)
|
||||
raw-title (or (:block/raw-title entity)
|
||||
(:block/title entity)
|
||||
(:block/name entity))
|
||||
list-type (order-list-type entity)
|
||||
datoms (cond->> (d/datoms db :eavt (:db/id entity))
|
||||
true
|
||||
(remove #(or (contains? unsafe-plain-attrs (:a %))
|
||||
(contains? excluded-attrs (:a %))))
|
||||
|
||||
(seq property-set)
|
||||
(filter #(contains? property-set (:a %))))
|
||||
result (reduce
|
||||
(fn [m {:keys [a v]}]
|
||||
(let [v' (attribute-value->plain db a v)]
|
||||
(if (many-attr? db a)
|
||||
(update m a (fnil conj []) v')
|
||||
(assoc m a v'))))
|
||||
{:db/id (:db/id entity)}
|
||||
datoms)]
|
||||
(cond-> result
|
||||
raw-title
|
||||
(assoc :block/title raw-title
|
||||
:block/raw-title raw-title)
|
||||
|
||||
list-type
|
||||
(assoc :block.temp/order-list-index
|
||||
(order-list-index entity list-type))))))
|
||||
|
||||
(defn- ref-db-id
|
||||
[value]
|
||||
(cond
|
||||
(map? value) (:db/id value)
|
||||
(integer? value) value
|
||||
:else nil))
|
||||
|
||||
(defn- ref-uuid
|
||||
[value]
|
||||
(when (map? value)
|
||||
(:block/uuid value)))
|
||||
|
||||
(defn- ref-ident
|
||||
[value]
|
||||
(when (map? value)
|
||||
(:db/ident value)))
|
||||
|
||||
(defn- with-explicit-ref-fields
|
||||
[m]
|
||||
(let [alias-source (first (:block/_alias m))]
|
||||
(cond-> m
|
||||
(contains? m :block/parent)
|
||||
(assoc :block/parent-id (ref-db-id (:block/parent m))
|
||||
:block/parent-uuid (ref-uuid (:block/parent m)))
|
||||
|
||||
(contains? m :block/page)
|
||||
(assoc :block/page-id (ref-db-id (:block/page m))
|
||||
:block/page-uuid (ref-uuid (:block/page m))
|
||||
:block/page-name (when (map? (:block/page m))
|
||||
(:block/name (:block/page m))))
|
||||
|
||||
(contains? m :block/link)
|
||||
(assoc :block/link-id (ref-db-id (:block/link m)))
|
||||
|
||||
(contains? m :logseq.property/query)
|
||||
(assoc :logseq.property/query-id (ref-db-id (:logseq.property/query m)))
|
||||
|
||||
(contains? m :logseq.property/view-for)
|
||||
(assoc :logseq.property/view-for-id (ref-db-id (:logseq.property/view-for m)))
|
||||
|
||||
(contains? m :logseq.property.view/type)
|
||||
(assoc :logseq.property.view/type-id (ref-db-id (:logseq.property.view/type m))
|
||||
:logseq.property.view/type-ident (ref-ident (:logseq.property.view/type m)))
|
||||
|
||||
(contains? m :logseq.property.view/gallery-asset-property)
|
||||
(assoc :logseq.property.view/gallery-asset-property-ident
|
||||
(ref-ident (:logseq.property.view/gallery-asset-property m)))
|
||||
|
||||
(contains? m :logseq.property/_view-for)
|
||||
(assoc :logseq.property/views (:logseq.property/_view-for m))
|
||||
|
||||
(contains? m :block/_alias)
|
||||
(assoc :block/alias-source-page-id (ref-db-id alias-source)
|
||||
:block/alias-source-page-uuid (ref-uuid alias-source)
|
||||
:block/alias-source-page-class? (boolean (and alias-source
|
||||
(ldb/class? alias-source))))
|
||||
|
||||
(contains? m :logseq.property/_query)
|
||||
(assoc :logseq.property/query-block? (seq (:logseq.property/_query m)))
|
||||
|
||||
(contains? m :logseq.property.comments/_blocks)
|
||||
(assoc :block/comment-threads (:logseq.property.comments/_blocks m))
|
||||
|
||||
(contains? m :logseq.property/description)
|
||||
(assoc :logseq.property/description-title
|
||||
(when (map? (:logseq.property/description m))
|
||||
(:block/title (:logseq.property/description m))))
|
||||
|
||||
(contains? m :logseq.property.recycle/original-page)
|
||||
(assoc :logseq.property.recycle/original-page-title
|
||||
(when (map? (:logseq.property.recycle/original-page m))
|
||||
(:block/title (:logseq.property.recycle/original-page m)))))))
|
||||
|
||||
(defn with-explicit-ref-fields-recursive
|
||||
[form]
|
||||
(walk/postwalk
|
||||
(fn [value]
|
||||
(if (map? value)
|
||||
(with-explicit-ref-fields value)
|
||||
value))
|
||||
form))
|
||||
|
||||
(declare worker-plain-value)
|
||||
|
||||
(defn- worker-plain-map
|
||||
[db m]
|
||||
(with-explicit-ref-fields
|
||||
(persistent!
|
||||
(reduce-kv
|
||||
(fn [result k v]
|
||||
(assoc! result k (worker-plain-value db v)))
|
||||
(transient {})
|
||||
m))))
|
||||
|
||||
(defn worker-plain-value
|
||||
[db value]
|
||||
(cond
|
||||
(de/entity? value)
|
||||
(worker-plain-map db (entity-forward-map db value {}))
|
||||
|
||||
(map? value)
|
||||
(worker-plain-map db value)
|
||||
|
||||
(vector? value)
|
||||
(mapv #(worker-plain-value db %) value)
|
||||
|
||||
(set? value)
|
||||
(set (map #(worker-plain-value db %) value))
|
||||
|
||||
(sequential? value)
|
||||
(mapv #(worker-plain-value db %) value)
|
||||
|
||||
:else
|
||||
value))
|
||||
171
src/main/frontend/worker/platform.cljs
Normal file
171
src/main/frontend/worker/platform.cljs
Normal file
@@ -0,0 +1,171 @@
|
||||
(ns frontend.worker.platform
|
||||
"Platform adapter contract for db-worker runtimes.")
|
||||
|
||||
(defn- normalize-missing-value
|
||||
[value]
|
||||
(if (identical? js/undefined value)
|
||||
nil
|
||||
value))
|
||||
|
||||
(def ^:private required-sections
|
||||
[:env :storage :kv :broadcast :websocket :crypto :timers :sqlite])
|
||||
|
||||
(defonce ^:private *platform (atom nil))
|
||||
|
||||
(defn validate-platform!
|
||||
[platform]
|
||||
(doseq [section required-sections]
|
||||
(when-not (contains? platform section)
|
||||
(throw (ex-info (str "platform adapter missing section: " section)
|
||||
{:section section
|
||||
:platform-keys (keys platform)}))))
|
||||
platform)
|
||||
|
||||
(defn set-platform!
|
||||
[platform]
|
||||
(reset! *platform (validate-platform! platform)))
|
||||
|
||||
(defn current
|
||||
[]
|
||||
(or @*platform
|
||||
(throw (ex-info "platform adapter not initialized" {}))))
|
||||
|
||||
(defn env-flag
|
||||
[platform flag]
|
||||
(get-in platform [:env flag]))
|
||||
|
||||
(defn storage
|
||||
[platform]
|
||||
(:storage platform))
|
||||
|
||||
(defn install-storage-pool
|
||||
[platform sqlite pool-name]
|
||||
(if-let [f (get-in platform [:storage :install-opfs-pool])]
|
||||
(f sqlite pool-name)
|
||||
(throw (ex-info "platform storage/install-opfs-pool missing"
|
||||
{:pool-name pool-name}))))
|
||||
|
||||
(defn resolve-db-path
|
||||
[platform repo pool path]
|
||||
(if-let [f (get-in platform [:storage :resolve-db-path])]
|
||||
(f repo pool path)
|
||||
path))
|
||||
|
||||
(defn remove-storage-pool!
|
||||
[platform pool]
|
||||
(if-let [f (get-in platform [:storage :remove-vfs!])]
|
||||
(f pool)
|
||||
nil))
|
||||
|
||||
(defn kv-get
|
||||
[platform k]
|
||||
(if-let [f (get-in platform [:kv :get])]
|
||||
(-> (f k)
|
||||
(.then normalize-missing-value))
|
||||
(throw (ex-info "platform kv/get missing" {:key k}))))
|
||||
|
||||
(defn kv-set!
|
||||
[platform k value]
|
||||
(if-let [f (get-in platform [:kv :set!])]
|
||||
(f k value)
|
||||
(throw (ex-info "platform kv/set! missing" {:key k}))))
|
||||
|
||||
(defn read-text!
|
||||
[platform path]
|
||||
(if-let [f (get-in platform [:storage :read-text!])]
|
||||
(f path)
|
||||
(throw (ex-info "platform storage/read-text! missing" {:path path}))))
|
||||
|
||||
(defn write-text!
|
||||
[platform path text]
|
||||
(if-let [f (get-in platform [:storage :write-text!])]
|
||||
(f path text)
|
||||
(throw (ex-info "platform storage/write-text! missing" {:path path}))))
|
||||
|
||||
(defn asset-read-bytes!
|
||||
[platform repo file-name]
|
||||
(if-let [f (get-in platform [:storage :asset-read-bytes!])]
|
||||
(f repo file-name)
|
||||
(throw (ex-info "platform storage/asset-read-bytes! missing"
|
||||
{:repo repo
|
||||
:file-name file-name}))))
|
||||
|
||||
(defn asset-write-bytes!
|
||||
[platform repo file-name payload]
|
||||
(if-let [f (get-in platform [:storage :asset-write-bytes!])]
|
||||
(f repo file-name payload)
|
||||
(throw (ex-info "platform storage/asset-write-bytes! missing"
|
||||
{:repo repo
|
||||
:file-name file-name}))))
|
||||
|
||||
(defn asset-stat
|
||||
[platform repo file-name]
|
||||
(if-let [f (get-in platform [:storage :asset-stat])]
|
||||
(f repo file-name)
|
||||
(throw (ex-info "platform storage/asset-stat missing"
|
||||
{:repo repo
|
||||
:file-name file-name}))))
|
||||
|
||||
(defn save-secret-text!
|
||||
[platform key text]
|
||||
(if-let [f (get-in platform [:crypto :save-secret-text!])]
|
||||
(f key text)
|
||||
(throw (ex-info "platform crypto/save-secret-text! missing" {:key key}))))
|
||||
|
||||
(defn read-secret-text
|
||||
[platform key]
|
||||
(if-let [f (get-in platform [:crypto :read-secret-text])]
|
||||
(-> (f key)
|
||||
(.then normalize-missing-value))
|
||||
(throw (ex-info "platform crypto/read-secret-text missing" {:key key}))))
|
||||
|
||||
(defn delete-secret-text!
|
||||
[platform key]
|
||||
(if-let [f (get-in platform [:crypto :delete-secret-text!])]
|
||||
(f key)
|
||||
(throw (ex-info "platform crypto/delete-secret-text! missing" {:key key}))))
|
||||
|
||||
(defn websocket-connect
|
||||
[platform url]
|
||||
(if-let [f (get-in platform [:websocket :connect])]
|
||||
(f url)
|
||||
(throw (ex-info "platform websocket/connect missing" {:url url}))))
|
||||
|
||||
(defn sqlite-init!
|
||||
[platform]
|
||||
(when-let [f (get-in platform [:sqlite :init!])]
|
||||
(f)))
|
||||
|
||||
(defn sqlite-open
|
||||
[platform opts]
|
||||
(if-let [f (get-in platform [:sqlite :open-db])]
|
||||
(f opts)
|
||||
(throw (ex-info "platform sqlite/open-db missing" {:opts opts}))))
|
||||
|
||||
(defn vector-open
|
||||
[platform opts]
|
||||
(when-let [f (get-in platform [:vector :open-index])]
|
||||
(f opts)))
|
||||
|
||||
(defn embedding-model-id
|
||||
[platform]
|
||||
(get-in platform [:embedding :model-id]))
|
||||
|
||||
(defn embedding-dimension
|
||||
[platform]
|
||||
(or (get-in platform [:embedding :dimension])
|
||||
(throw (ex-info "platform embedding/dimension missing"
|
||||
{:model-id (embedding-model-id platform)}))))
|
||||
|
||||
(defn embed-texts
|
||||
[platform texts]
|
||||
(if-let [f (get-in platform [:embedding :embed-texts])]
|
||||
(f texts)
|
||||
(throw (ex-info "platform embedding/embed-texts missing"
|
||||
{:model-id (embedding-model-id platform)
|
||||
:text-count (count texts)}))))
|
||||
|
||||
(defn post-message!
|
||||
[platform type payload]
|
||||
(when-let [f (get-in platform [:broadcast :post-message!])]
|
||||
(f type payload)))
|
||||
234
src/main/frontend/worker/platform/browser.cljs
Normal file
234
src/main/frontend/worker/platform/browser.cljs
Normal file
@@ -0,0 +1,234 @@
|
||||
(ns frontend.worker.platform.browser
|
||||
"Browser platform adapter for db-worker."
|
||||
(:require [frontend.common.idb :as idb]
|
||||
["@sqlite.org/sqlite-wasm" :default sqlite3InitModule]
|
||||
["comlink" :as Comlink]
|
||||
[clojure.string :as string]
|
||||
[frontend.common.file.opfs :as opfs]
|
||||
[frontend.worker-common.util :as worker-util]
|
||||
[lambdaisland.glogi :as log]
|
||||
[logseq.common.config :as common-config]
|
||||
[logseq.common.path :as path]
|
||||
[promesa.core :as p]))
|
||||
|
||||
(defn- iter->vec
|
||||
[iter']
|
||||
(when iter'
|
||||
(p/loop [acc []]
|
||||
(p/let [elem (.next iter')]
|
||||
(if (.-done elem)
|
||||
acc
|
||||
(p/recur (conj acc (.-value elem))))))))
|
||||
|
||||
(defn- list-graphs
|
||||
[]
|
||||
(let [dir? #(= (.-kind %) "directory")
|
||||
db-dir-prefix ".logseq-pool-"]
|
||||
(p/let [^js root (.getDirectory js/navigator.storage)
|
||||
values-iter (when (dir? root) (.values root))
|
||||
values (when values-iter (iter->vec values-iter))
|
||||
current-dir-dirs (filter dir? values)
|
||||
db-dirs (filter (fn [file]
|
||||
(string/starts-with? (.-name file) db-dir-prefix))
|
||||
current-dir-dirs)
|
||||
graph-names (map (fn [dir]
|
||||
(-> (.-name dir)
|
||||
(string/replace-first ".logseq-pool-" "")
|
||||
;; TODO: DRY
|
||||
(string/replace "+3A+" ":")
|
||||
(string/replace "++" "/")))
|
||||
db-dirs)]
|
||||
(log/info :db-dirs (map #(.-name %) db-dirs) :all-dirs (map #(.-name %) current-dir-dirs))
|
||||
(vec graph-names))))
|
||||
|
||||
(defn- db-exists?
|
||||
[graph]
|
||||
(->
|
||||
(p/let [^js root (.getDirectory js/navigator.storage)
|
||||
_dir-handle (.getDirectoryHandle root (str "." (worker-util/get-pool-name graph)))]
|
||||
true)
|
||||
(p/catch
|
||||
(fn [_e] ; not found
|
||||
false))))
|
||||
|
||||
(defn- kv-get
|
||||
[k]
|
||||
(idb/get-item k))
|
||||
|
||||
(defn- kv-set!
|
||||
[k value]
|
||||
(idb/set-item! k value))
|
||||
|
||||
(defn- save-secret-text!
|
||||
[key text]
|
||||
(kv-set! key text))
|
||||
|
||||
(defn- read-secret-text
|
||||
[key]
|
||||
(kv-get key))
|
||||
|
||||
(defn- delete-secret-text!
|
||||
[key]
|
||||
(kv-set! key nil))
|
||||
|
||||
(defn- install-opfs-pool
|
||||
[sqlite pool-name]
|
||||
(.installOpfsSAHPoolVfs ^js sqlite #js {:name pool-name
|
||||
:initialCapacity 20}))
|
||||
|
||||
(defn- export-file
|
||||
[pool path]
|
||||
(.exportFile ^js pool path))
|
||||
|
||||
(defn- import-db
|
||||
[pool path data]
|
||||
(.importDb ^js pool path data))
|
||||
|
||||
(defn- remove-vfs!
|
||||
[pool]
|
||||
(when pool
|
||||
(.removeVfs ^js pool)))
|
||||
|
||||
(defn- read-text!
|
||||
[path]
|
||||
(opfs/<read-text! path))
|
||||
|
||||
(defn- write-text!
|
||||
[path text]
|
||||
(opfs/<write-text! path text))
|
||||
|
||||
(defn- browser-pfs
|
||||
[]
|
||||
(or (some-> js/globalThis .-window .-pfs)
|
||||
(some-> js/globalThis .-pfs)
|
||||
(throw (ex-info "browser pfs is not available" {}))))
|
||||
|
||||
(defn- graph-assets-dir
|
||||
[repo]
|
||||
(when-let [graph-name (some-> repo common-config/strip-leading-db-version-prefix)]
|
||||
(path/url-to-path
|
||||
(path/path-join (str "memory:///" graph-name)
|
||||
common-config/local-assets-dir))))
|
||||
|
||||
(defn- ensure-pfs-dir!
|
||||
[^js pfs dir]
|
||||
(cond
|
||||
(or (nil? dir) (= "" dir) (= "/" dir) (= "." dir))
|
||||
(p/resolved nil)
|
||||
|
||||
:else
|
||||
(-> (.stat pfs dir)
|
||||
(p/then (constantly nil))
|
||||
(p/catch
|
||||
(fn [_]
|
||||
(p/do!
|
||||
(ensure-pfs-dir! pfs (path/parent dir))
|
||||
(.mkdir pfs dir)))))))
|
||||
|
||||
(defn- asset-path
|
||||
[repo file-name]
|
||||
(if-let [assets-dir (graph-assets-dir repo)]
|
||||
(path/path-join assets-dir file-name)
|
||||
(throw (ex-info "missing repo for browser asset path"
|
||||
{:repo repo
|
||||
:file-name file-name}))))
|
||||
|
||||
(defn- asset-read-bytes!
|
||||
[repo file-name]
|
||||
(when-let [^js bfs (browser-pfs)]
|
||||
(.readFile bfs (asset-path repo file-name))))
|
||||
|
||||
(defn- asset-write-bytes!
|
||||
[repo file-name payload]
|
||||
(let [^js pfs (browser-pfs)
|
||||
file-path (asset-path repo file-name)]
|
||||
(p/do!
|
||||
(ensure-pfs-dir! pfs (path/parent file-path))
|
||||
(.writeFile pfs file-path payload))))
|
||||
|
||||
(defn- asset-stat
|
||||
[repo file-name]
|
||||
(let [^js pfs (browser-pfs)]
|
||||
(-> (.stat pfs (asset-path repo file-name))
|
||||
(p/then (fn [^js stat]
|
||||
{:size (.-size stat)
|
||||
:type (.-type stat)}))
|
||||
(p/catch (constantly nil)))))
|
||||
|
||||
(defn- asset-delete!
|
||||
[repo file-name]
|
||||
(let [^js pfs (browser-pfs)]
|
||||
(-> (.unlink pfs (asset-path repo file-name))
|
||||
(p/catch (constantly nil)))))
|
||||
|
||||
(defn- unsupported-mirror-storage!
|
||||
[& _args]
|
||||
(throw (ex-info "Markdown mirror storage is not supported in browser workers"
|
||||
{:platform :browser
|
||||
:feature :markdown-mirror})))
|
||||
|
||||
(defn- websocket-connect
|
||||
[url]
|
||||
(js/WebSocket. url))
|
||||
|
||||
(defn- init-sqlite!
|
||||
[]
|
||||
(sqlite3InitModule (clj->js {:print #(log/info :init-sqlite-module! %)
|
||||
:printErr #(log/error :init-sqlite-module! %)})))
|
||||
|
||||
(defn- open-sqlite-db
|
||||
[{:keys [sqlite pool path mode]}]
|
||||
(if pool
|
||||
(new (.-OpfsSAHPoolDb ^js pool) path)
|
||||
(let [^js DB (.-DB ^js (.-oo1 ^js sqlite))]
|
||||
(new DB path (or mode "c")))))
|
||||
|
||||
(defn- search-param-true?
|
||||
[k]
|
||||
(let [value (.get (js/URLSearchParams. (.-search js/location)) k)]
|
||||
(or (= value "true")
|
||||
(= value "1"))))
|
||||
|
||||
(defn- owner-source
|
||||
[]
|
||||
(cond
|
||||
(search-param-true? "capacitor") :capacitor
|
||||
(search-param-true? "electron") :electron
|
||||
:else :browser))
|
||||
|
||||
(defn browser-platform
|
||||
[]
|
||||
{:env {:publishing? (string/includes? (.. js/location -href) "publishing=true")
|
||||
:runtime :browser
|
||||
:owner-source (owner-source)}
|
||||
:storage {:install-opfs-pool install-opfs-pool
|
||||
:list-graphs list-graphs
|
||||
:db-exists? db-exists?
|
||||
:resolve-db-path (fn [_repo _pool path] path)
|
||||
:export-file export-file
|
||||
:import-db import-db
|
||||
:remove-vfs! remove-vfs!
|
||||
:read-text! read-text!
|
||||
:write-text! write-text!
|
||||
:write-text-atomic! unsupported-mirror-storage!
|
||||
:delete-file! unsupported-mirror-storage!
|
||||
:mirror-read-text! unsupported-mirror-storage!
|
||||
:asset-read-bytes! asset-read-bytes!
|
||||
:asset-write-bytes! asset-write-bytes!
|
||||
:asset-stat asset-stat
|
||||
:asset-delete! asset-delete!
|
||||
:transfer (fn [data transferables]
|
||||
(Comlink/transfer data transferables))}
|
||||
:kv {:get kv-get
|
||||
:set! kv-set!}
|
||||
:broadcast {:post-message! worker-util/post-message}
|
||||
:websocket {:connect websocket-connect}
|
||||
:sqlite {:init! init-sqlite!
|
||||
:open-db open-sqlite-db
|
||||
:close-db (fn [db] (.close db))
|
||||
:exec (fn [db sql-or-opts] (.exec db sql-or-opts))
|
||||
:transaction (fn [db f] (.transaction db f))}
|
||||
:crypto {:save-secret-text! save-secret-text!
|
||||
:read-secret-text read-secret-text
|
||||
:delete-secret-text! delete-secret-text!}
|
||||
:timers {:set-interval! (fn [f ms] (js/setInterval f ms))}})
|
||||
757
src/main/frontend/worker/platform/node.cljs
Normal file
757
src/main/frontend/worker/platform/node.cljs
Normal file
@@ -0,0 +1,757 @@
|
||||
(ns frontend.worker.platform.node
|
||||
"Node.js platform adapter for db-worker."
|
||||
(:require ["fs" :as node-fs]
|
||||
["fs/promises" :as fs]
|
||||
["node:sqlite" :as node-sqlite]
|
||||
["os" :as os]
|
||||
["path" :as node-path]
|
||||
[clojure.string :as string]
|
||||
[cognitect.transit :as transit]
|
||||
[frontend.worker.db-worker-node-lock :as db-lock]
|
||||
[goog.object :as gobj]
|
||||
[lambdaisland.glogi :as log]
|
||||
[logseq.common.config :as common-config]
|
||||
[logseq.db.sqlite.backup :as sqlite-backup]
|
||||
[promesa.core :as p]
|
||||
["keytar" :as keytar]))
|
||||
|
||||
(defn- resolve-database-sync-ctor
|
||||
[]
|
||||
(or (gobj/get node-sqlite "DatabaseSync")
|
||||
(some-> (gobj/get node-sqlite "default")
|
||||
(gobj/get "DatabaseSync"))
|
||||
(let [default-export (gobj/get node-sqlite "default")]
|
||||
(when (fn? default-export)
|
||||
default-export))
|
||||
(throw (ex-info "node:sqlite DatabaseSync constructor missing"
|
||||
{:module-keys (js->clj (js/Object.keys node-sqlite))}))))
|
||||
|
||||
(def ^:private DatabaseSync
|
||||
(resolve-database-sync-ctor))
|
||||
|
||||
(defn- macos?
|
||||
[]
|
||||
(= "darwin" (.-platform js/process)))
|
||||
|
||||
(defn- macos-arm64?
|
||||
[]
|
||||
(and (macos?)
|
||||
(= "arm64" (.-arch js/process))))
|
||||
|
||||
(defn- expand-home
|
||||
[path]
|
||||
(if (string/starts-with? path "~")
|
||||
(node-path/join (.homedir os) (subs path 1))
|
||||
path))
|
||||
|
||||
(defn- ensure-dir!
|
||||
[dir]
|
||||
(fs/mkdir dir #js {:recursive true}))
|
||||
|
||||
(defn- strip-leading-slash
|
||||
[path]
|
||||
(string/replace-first path #"^/" ""))
|
||||
|
||||
(defn- repo-dir
|
||||
[data-dir repo]
|
||||
(db-lock/repo-dir data-dir repo))
|
||||
|
||||
(defn- pool-path
|
||||
[^js pool path]
|
||||
(node-path/join (.-repoDir pool) (strip-leading-slash path)))
|
||||
|
||||
(defn- path-under-data-dir
|
||||
[data-dir path]
|
||||
(let [expanded-path (expand-home path)]
|
||||
(if (node-path/isAbsolute expanded-path)
|
||||
expanded-path
|
||||
(node-path/join data-dir expanded-path))))
|
||||
|
||||
(defn- ->buffer
|
||||
[data]
|
||||
(cond
|
||||
(instance? js/Buffer data) data
|
||||
(instance? js/ArrayBuffer data) (js/Buffer.from data)
|
||||
(and (some? data) (some? (.-buffer data))) (js/Buffer.from (.-buffer data))
|
||||
:else (js/Buffer.from (str data))))
|
||||
|
||||
(def ^:private backup-root-dir-name "backup")
|
||||
|
||||
(defn- list-graphs
|
||||
[data-dir]
|
||||
(let [dir? #(and % (.isDirectory %))]
|
||||
(p/let [entries (fs/readdir data-dir #js {:withFileTypes true})
|
||||
db-dirs (->> entries
|
||||
(filter dir?))
|
||||
graph-names (map (fn [dirent]
|
||||
(db-lock/decode-canonical-graph-dir-key (.-name dirent)))
|
||||
db-dirs)]
|
||||
(->> graph-names
|
||||
(remove #(or (= % common-config/unlinked-graphs-dir)
|
||||
(= % backup-root-dir-name)))
|
||||
(filter some?)
|
||||
(vec)))))
|
||||
|
||||
(defn- db-exists?
|
||||
[data-dir graph]
|
||||
(p/let [db-path (node-path/join (repo-dir data-dir graph) "db.sqlite")]
|
||||
(-> (fs/stat db-path)
|
||||
(p/then (fn [_] true))
|
||||
(p/catch (fn [_] false)))))
|
||||
|
||||
(defn- normalize-bind
|
||||
[bind]
|
||||
(cond
|
||||
(array? bind) bind
|
||||
(and bind (object? bind))
|
||||
(let [out (js-obj)]
|
||||
(doseq [key (js/Object.keys bind)]
|
||||
(let [value (gobj/get bind key)
|
||||
normalized (cond
|
||||
(string/starts-with? key "$") (subs key 1)
|
||||
(string/starts-with? key ":") (subs key 1)
|
||||
:else key)]
|
||||
(gobj/set out normalized value)))
|
||||
out)
|
||||
:else bind))
|
||||
|
||||
(defn- stmt-all
|
||||
[^js stmt bind]
|
||||
(cond
|
||||
(array? bind) (.apply (.-all stmt) stmt bind)
|
||||
(some? bind) (.all stmt bind)
|
||||
:else (.all stmt)))
|
||||
|
||||
(defn- stmt-run
|
||||
[^js stmt bind]
|
||||
(cond
|
||||
(array? bind) (.apply (.-run stmt) stmt bind)
|
||||
(some? bind) (.run stmt bind)
|
||||
:else (.run stmt)))
|
||||
|
||||
(defn- exec-sql
|
||||
[^js db opts-or-sql]
|
||||
(if (string? opts-or-sql)
|
||||
(.exec db opts-or-sql)
|
||||
(let [sql (gobj/get opts-or-sql "sql")
|
||||
bind (gobj/get opts-or-sql "bind")
|
||||
row-mode (gobj/get opts-or-sql "rowMode")
|
||||
return-value (gobj/get opts-or-sql "returnValue")
|
||||
bind' (normalize-bind bind)
|
||||
^js stmt (.prepare db sql)]
|
||||
(if (or (= row-mode "array")
|
||||
(= row-mode "object")
|
||||
(= return-value "resultRows"))
|
||||
(do
|
||||
(when (= row-mode "array")
|
||||
(.setReturnArrays stmt true))
|
||||
(stmt-all stmt bind'))
|
||||
(do
|
||||
(stmt-run stmt bind')
|
||||
nil)))))
|
||||
|
||||
(defn- with-transaction
|
||||
[^js db tx-depth savepoint-seq tx-body]
|
||||
(let [outermost? (zero? @tx-depth)
|
||||
savepoint (when-not outermost?
|
||||
(str "__logseq_tx_" (swap! savepoint-seq inc)))]
|
||||
(if outermost?
|
||||
(.exec db "BEGIN")
|
||||
(.exec db (str "SAVEPOINT " savepoint)))
|
||||
(swap! tx-depth inc)
|
||||
(try
|
||||
(let [result (tx-body)]
|
||||
(if outermost?
|
||||
(.exec db "COMMIT")
|
||||
(.exec db (str "RELEASE SAVEPOINT " savepoint)))
|
||||
result)
|
||||
(catch :default e
|
||||
(if outermost?
|
||||
(try
|
||||
(.exec db "ROLLBACK")
|
||||
(catch :default _))
|
||||
(do
|
||||
(try
|
||||
(.exec db (str "ROLLBACK TO SAVEPOINT " savepoint))
|
||||
(catch :default _))
|
||||
(try
|
||||
(.exec db (str "RELEASE SAVEPOINT " savepoint))
|
||||
(catch :default _))))
|
||||
(throw e))
|
||||
(finally
|
||||
(swap! tx-depth dec)))))
|
||||
|
||||
(defn- backup-db!
|
||||
[write-guard-fn ^js db path]
|
||||
(p/let [_ (when write-guard-fn
|
||||
(write-guard-fn))
|
||||
_ (ensure-dir! (node-path/dirname path))]
|
||||
(sqlite-backup/backup-connection! db path)))
|
||||
|
||||
(defn- wrap-node-sqlite-db
|
||||
[db write-guard-fn]
|
||||
(let [wrapper (js-obj)
|
||||
closed? (atom false)
|
||||
tx-depth (atom 0)
|
||||
savepoint-seq (atom 0)]
|
||||
(set! (.-exec wrapper) (fn [opts-or-sql] (exec-sql db opts-or-sql)))
|
||||
(set! (.-transaction wrapper)
|
||||
(fn [f]
|
||||
(with-transaction db tx-depth savepoint-seq
|
||||
(fn []
|
||||
(f wrapper)))))
|
||||
(set! (.-backup wrapper)
|
||||
(fn [path]
|
||||
(backup-db! write-guard-fn db path)))
|
||||
(set! (.-close wrapper)
|
||||
(fn []
|
||||
(when-not @closed?
|
||||
(reset! closed? true)
|
||||
(try
|
||||
(.close db)
|
||||
(catch :default e
|
||||
(when-not (string/includes? (str e) "database is not open")
|
||||
(throw e)))))
|
||||
nil))
|
||||
wrapper))
|
||||
|
||||
(defn- open-sqlite-db
|
||||
[write-guard-fn {:keys [path]}]
|
||||
(p/let [_ (ensure-dir! (node-path/dirname path))]
|
||||
(wrap-node-sqlite-db (new DatabaseSync path) write-guard-fn)))
|
||||
|
||||
(def ^:private default-embedding-model "all-MiniLM-L6-v2")
|
||||
(def ^:private embedding-fetch-timeout-ms 120000)
|
||||
(def ^:private embedding-fetch-retry-ms 250)
|
||||
(def ^:private embedding-model-dimensions
|
||||
{default-embedding-model 384
|
||||
"BAAI/bge-m3" 1024
|
||||
"Qwen/Qwen3-Embedding-4B" 1024})
|
||||
|
||||
(defn- resolve-embedding-endpoint
|
||||
[configured-endpoint]
|
||||
(or configured-endpoint
|
||||
(gobj/get (.-env js/process) "LOGSEQ_EMBEDDINGS_URL")))
|
||||
|
||||
(defn- resolve-embedding-model-id
|
||||
[configured-model-id]
|
||||
(or configured-model-id
|
||||
(gobj/get (.-env js/process) "LOGSEQ_EMBEDDING_MODEL")
|
||||
default-embedding-model))
|
||||
|
||||
(defn- resolve-embedding-dimension
|
||||
[model-id]
|
||||
(or (get embedding-model-dimensions model-id)
|
||||
(throw (ex-info "Unsupported embedding model dimension"
|
||||
{:model-id model-id}))))
|
||||
|
||||
(defn- embedding-response->vectors
|
||||
[response]
|
||||
(let [data (-> (js->clj response :keywordize-keys true)
|
||||
:data)]
|
||||
(->> data
|
||||
(sort-by #(or (:index %) 0))
|
||||
(mapv (comp vec :embedding)))))
|
||||
|
||||
(defn- <fetch-embedding-response
|
||||
[endpoint model-id request]
|
||||
(let [deadline (+ (js/Date.now) embedding-fetch-timeout-ms)]
|
||||
(letfn [(attempt! []
|
||||
(-> (js/fetch endpoint request)
|
||||
(p/catch
|
||||
(fn [error]
|
||||
(if (< (js/Date.now) deadline)
|
||||
(p/let [_ (p/delay embedding-fetch-retry-ms)]
|
||||
(attempt!))
|
||||
(throw (ex-info "embedding server fetch failed"
|
||||
{:endpoint endpoint
|
||||
:model-id model-id}
|
||||
error)))))))]
|
||||
(attempt!))))
|
||||
|
||||
(defn- <embed-texts
|
||||
[endpoint model-id texts]
|
||||
(let [texts (vec texts)]
|
||||
(if (empty? texts)
|
||||
(p/resolved [])
|
||||
(p/let [resp (<fetch-embedding-response
|
||||
endpoint
|
||||
model-id
|
||||
#js {:method "POST"
|
||||
:headers #js {"Content-Type" "application/json"}
|
||||
:body (js/JSON.stringify
|
||||
(clj->js {:model model-id
|
||||
:input texts}))})
|
||||
_ (when-not (.-ok resp)
|
||||
(throw (ex-info "embedding server request failed"
|
||||
{:endpoint endpoint
|
||||
:status (.-status resp)
|
||||
:model-id model-id})))
|
||||
body (.json resp)]
|
||||
(embedding-response->vectors body)))))
|
||||
|
||||
(defonce ^:private *zvec-module (atom nil))
|
||||
(defonce ^:private *zvec-initialized? (atom false))
|
||||
|
||||
(def ^:private zvec-vector-field "embedding")
|
||||
(def ^:private zvec-page-field "page")
|
||||
(def ^:private zvec-title-field "title")
|
||||
|
||||
(defn- zvec-enum-value
|
||||
[enum-name value-name]
|
||||
(gobj/get (gobj/get @*zvec-module enum-name) value-name))
|
||||
|
||||
(defn- zvec-module []
|
||||
(or @*zvec-module
|
||||
(let [module (js/require "@zvec/zvec")]
|
||||
(reset! *zvec-module module)
|
||||
module)))
|
||||
|
||||
(defn- initialize-zvec! []
|
||||
(zvec-module)
|
||||
(when (compare-and-set! *zvec-initialized? false true)
|
||||
((gobj/get @*zvec-module "ZVecInitialize")
|
||||
#js {:logLevel (zvec-enum-value "ZVecLogLevel" "WARN")})))
|
||||
|
||||
(defn- zvec-schema
|
||||
[dimension]
|
||||
(let [Schema (gobj/get @*zvec-module "ZVecCollectionSchema")]
|
||||
(new Schema
|
||||
#js {:name "blocks"
|
||||
:vectors #js [#js {:name zvec-vector-field
|
||||
:dataType (zvec-enum-value "ZVecDataType" "VECTOR_FP32")
|
||||
:dimension dimension
|
||||
:indexParams #js {:indexType (zvec-enum-value "ZVecIndexType" "HNSW")
|
||||
:metricType (zvec-enum-value "ZVecMetricType" "COSINE")}}]
|
||||
:fields #js [#js {:name zvec-page-field
|
||||
:dataType (zvec-enum-value "ZVecDataType" "STRING")
|
||||
:indexParams #js {:indexType (zvec-enum-value "ZVecIndexType" "INVERT")}}
|
||||
#js {:name zvec-title-field
|
||||
:dataType (zvec-enum-value "ZVecDataType" "STRING")}]})))
|
||||
|
||||
(defn- create-zvec-collection!
|
||||
[path dimension]
|
||||
((gobj/get @*zvec-module "ZVecCreateAndOpen")
|
||||
path
|
||||
(zvec-schema dimension)
|
||||
#js {:enableMMAP true}))
|
||||
|
||||
(defn- zvec-collection-missing-error?
|
||||
[error]
|
||||
(or (= "ZVEC_NOT_FOUND" (gobj/get error "code"))
|
||||
(and (= "ZVEC_INVALID_ARGUMENT" (gobj/get error "code"))
|
||||
(string/includes? (str error) " not exist"))))
|
||||
|
||||
(defn- open-zvec-collection!
|
||||
[path dimension]
|
||||
(initialize-zvec!)
|
||||
(try
|
||||
((gobj/get @*zvec-module "ZVecOpen") path #js {:enableMMAP true})
|
||||
(catch :default error
|
||||
(if (zvec-collection-missing-error? error)
|
||||
(create-zvec-collection! path dimension)
|
||||
(throw error)))))
|
||||
|
||||
(defn- zvec-doc
|
||||
[{:keys [id page embedding vector-title]}]
|
||||
(let [vectors (js-obj)
|
||||
fields (js-obj)]
|
||||
(gobj/set vectors zvec-vector-field (clj->js embedding))
|
||||
(gobj/set fields zvec-page-field page)
|
||||
(gobj/set fields zvec-title-field (or vector-title ""))
|
||||
#js {:id id
|
||||
:vectors vectors
|
||||
:fields fields}))
|
||||
|
||||
(defn- zvec-result->map
|
||||
[doc]
|
||||
(let [fields (gobj/get doc "fields")
|
||||
distance (gobj/get doc "score")]
|
||||
{:id (gobj/get doc "id")
|
||||
:page (gobj/get fields zvec-page-field)
|
||||
:vector-title (gobj/get fields zvec-title-field)
|
||||
:vector-score (if (number? distance)
|
||||
(/ 1 (+ 1 distance))
|
||||
0.0)}))
|
||||
|
||||
(defn- vector-metadata-path
|
||||
[path]
|
||||
(node-path/join path "metadata.json"))
|
||||
|
||||
(defn- read-vector-metadata
|
||||
[path]
|
||||
(let [metadata-path (vector-metadata-path path)]
|
||||
(when (.existsSync node-fs metadata-path)
|
||||
(-> (.readFileSync node-fs metadata-path "utf8")
|
||||
js/JSON.parse
|
||||
(js->clj :keywordize-keys true)))))
|
||||
|
||||
(defn- write-vector-metadata!
|
||||
[path metadata]
|
||||
(.mkdirSync node-fs path #js {:recursive true})
|
||||
(.writeFileSync node-fs
|
||||
(vector-metadata-path path)
|
||||
(js/JSON.stringify (clj->js metadata))
|
||||
"utf8"))
|
||||
|
||||
(def ^:private vector-page-filter-topk-multipliers [4 16 64])
|
||||
|
||||
(defn- vector-query-topks
|
||||
[limit page]
|
||||
(let [limit (or limit 100)]
|
||||
(if page
|
||||
(mapv #(* limit %) vector-page-filter-topk-multipliers)
|
||||
[limit])))
|
||||
|
||||
(defn- query-zvec
|
||||
[collection embedding topk]
|
||||
(.querySync ^js collection
|
||||
#js {:fieldName zvec-vector-field
|
||||
:topk topk
|
||||
:vector (clj->js embedding)
|
||||
:outputFields #js [zvec-page-field zvec-title-field]
|
||||
:params #js {:indexType (zvec-enum-value "ZVecIndexType" "HNSW")
|
||||
:ef 300}}))
|
||||
|
||||
(defn- enough-vector-results?
|
||||
[results limit page]
|
||||
(or (nil? page)
|
||||
(>= (count results) limit)))
|
||||
|
||||
(defn- open-vector-index
|
||||
[{:keys [path dimension]}]
|
||||
(p/let [_ (ensure-dir! (node-path/dirname path))]
|
||||
(let [collection* (atom (open-zvec-collection! path dimension))
|
||||
reopen! (fn []
|
||||
(reset! collection* (open-zvec-collection! path dimension)))]
|
||||
{:query (fn [embedding limit page]
|
||||
(let [limit (or limit 100)
|
||||
topks (vector-query-topks limit page)]
|
||||
(loop [remaining-topks (seq topks)
|
||||
latest-results []]
|
||||
(if-let [topk (first remaining-topks)]
|
||||
(let [docs (query-zvec @collection* embedding topk)
|
||||
results (->> (array-seq docs)
|
||||
(map zvec-result->map)
|
||||
(filter (fn [result]
|
||||
(or (nil? page)
|
||||
(= page (:page result)))))
|
||||
(take limit)
|
||||
vec)]
|
||||
(if (or (enough-vector-results? results limit page)
|
||||
(nil? (next remaining-topks)))
|
||||
results
|
||||
(recur (next remaining-topks) results)))
|
||||
latest-results))))
|
||||
:upsert! (fn [docs]
|
||||
(.upsertSync ^js @collection* (clj->js (mapv zvec-doc docs)))
|
||||
nil)
|
||||
:delete! (fn [ids]
|
||||
(.deleteSync ^js @collection* (clj->js (vec ids)))
|
||||
nil)
|
||||
:truncate! (fn []
|
||||
(.destroySync ^js @collection*)
|
||||
(reopen!)
|
||||
nil)
|
||||
:metadata (fn []
|
||||
(read-vector-metadata path))
|
||||
:set-metadata! (fn [metadata]
|
||||
(write-vector-metadata! path metadata)
|
||||
nil)
|
||||
:close! (fn []
|
||||
(.closeSync ^js @collection*)
|
||||
nil)})))
|
||||
|
||||
(defn- install-opfs-pool
|
||||
[data-dir _sqlite pool-name]
|
||||
(p/let [repo-dir-path (repo-dir data-dir pool-name)
|
||||
_ (ensure-dir! repo-dir-path)
|
||||
^js pool (js-obj)]
|
||||
(set! (.-repoDir pool) repo-dir-path)
|
||||
(set! (.-getCapacity pool) (fn [] 1))
|
||||
(set! (.-pauseVfs pool) (fn [] nil))
|
||||
(set! (.-unpauseVfs pool) (fn [] nil))
|
||||
pool))
|
||||
|
||||
(defn- export-file
|
||||
[pool path]
|
||||
(fs/readFile (pool-path pool path)))
|
||||
|
||||
(defn- import-db
|
||||
[write-guard-fn pool path data]
|
||||
(let [full-path (pool-path pool path)
|
||||
dir (node-path/dirname full-path)]
|
||||
(p/let [_ (when write-guard-fn
|
||||
(write-guard-fn))
|
||||
_ (ensure-dir! dir)]
|
||||
(fs/writeFile full-path (->buffer data)))))
|
||||
|
||||
(defn- remove-vfs!
|
||||
[^js pool]
|
||||
(when pool
|
||||
(fs/rm (.-repoDir pool) #js {:recursive true :force true})))
|
||||
|
||||
(defn- read-text!
|
||||
[data-dir path]
|
||||
(fs/readFile (path-under-data-dir data-dir path) "utf8"))
|
||||
|
||||
(defn- write-text!
|
||||
[write-guard-fn data-dir path text]
|
||||
(let [full-path (path-under-data-dir data-dir path)
|
||||
dir (node-path/dirname full-path)]
|
||||
(p/let [_ (when write-guard-fn
|
||||
(write-guard-fn))
|
||||
_ (ensure-dir! dir)]
|
||||
(fs/writeFile full-path text "utf8"))))
|
||||
|
||||
(defn- write-text-atomic!
|
||||
[write-guard-fn data-dir path text]
|
||||
(let [full-path (path-under-data-dir data-dir path)
|
||||
dir (node-path/dirname full-path)
|
||||
tmp-path (node-path/join dir (str "." (node-path/basename full-path) ".tmp-" (random-uuid)))]
|
||||
(p/let [_ (when write-guard-fn
|
||||
(write-guard-fn))
|
||||
_ (ensure-dir! dir)
|
||||
_ (fs/writeFile tmp-path text "utf8")
|
||||
_ (fs/rename tmp-path full-path)]
|
||||
nil)))
|
||||
|
||||
(defn- delete-file!
|
||||
[write-guard-fn data-dir path]
|
||||
(let [full-path (path-under-data-dir data-dir path)]
|
||||
(p/let [_ (when write-guard-fn
|
||||
(write-guard-fn))]
|
||||
(-> (fs/rm full-path #js {:force true})
|
||||
(p/catch (constantly nil))))))
|
||||
|
||||
(defn- asset-file-path
|
||||
[data-dir repo file-name]
|
||||
(node-path/join (repo-dir data-dir repo)
|
||||
common-config/local-assets-dir
|
||||
file-name))
|
||||
|
||||
(defn- asset-read-bytes!
|
||||
[data-dir repo file-name]
|
||||
(fs/readFile (asset-file-path data-dir repo file-name)))
|
||||
|
||||
(defn- asset-write-bytes!
|
||||
[write-guard-fn data-dir repo file-name payload]
|
||||
(let [full-path (asset-file-path data-dir repo file-name)
|
||||
dir (node-path/dirname full-path)]
|
||||
(p/let [_ (when write-guard-fn
|
||||
(write-guard-fn))
|
||||
_ (ensure-dir! dir)]
|
||||
(fs/writeFile full-path (->buffer payload)))))
|
||||
|
||||
(defn- asset-stat
|
||||
[data-dir repo file-name]
|
||||
(-> (fs/stat (asset-file-path data-dir repo file-name))
|
||||
(p/then (fn [^js stat]
|
||||
{:size (.-size stat)
|
||||
:is-file? (.isFile stat)}))
|
||||
(p/catch (constantly nil))))
|
||||
|
||||
(defn- asset-delete!
|
||||
[write-guard-fn data-dir repo file-name]
|
||||
(let [full-path (asset-file-path data-dir repo file-name)]
|
||||
(p/let [_ (when write-guard-fn
|
||||
(write-guard-fn))]
|
||||
(-> (fs/rm full-path #js {:force true})
|
||||
(p/catch (constantly nil))))))
|
||||
|
||||
(defn- websocket-connect
|
||||
[url]
|
||||
(let [WebSocket (js/require "ws")]
|
||||
(new WebSocket url)))
|
||||
|
||||
(def ^:private kv-transit-writer
|
||||
(transit/writer
|
||||
:json
|
||||
{:handlers
|
||||
{js/Uint8Array
|
||||
(transit/write-handler
|
||||
(constantly "uint8array")
|
||||
(fn [value]
|
||||
(js->clj (js/Array.from value))))}}))
|
||||
|
||||
(def ^:private kv-transit-reader
|
||||
(transit/reader
|
||||
:json
|
||||
{:handlers
|
||||
{"uint8array"
|
||||
(fn [value]
|
||||
(js/Uint8Array. (clj->js value)))}}))
|
||||
|
||||
(defn- parse-kv-state
|
||||
[contents]
|
||||
(try
|
||||
(let [state (transit/read kv-transit-reader contents)]
|
||||
(if (map? state)
|
||||
state
|
||||
{}))
|
||||
(catch :default error
|
||||
(log/warn :db-worker-node-kv-parse-failed
|
||||
{:error error})
|
||||
{})))
|
||||
|
||||
(defn- serialize-kv-state
|
||||
[state]
|
||||
(transit/write kv-transit-writer state))
|
||||
|
||||
(def ^:private keychain-service "Logseq E2EE")
|
||||
|
||||
(defn- <save-secret-text!
|
||||
[kv key text]
|
||||
(-> (p/let [_ (.setPassword ^js keytar keychain-service key text)]
|
||||
nil)
|
||||
(p/catch (fn [e]
|
||||
(log/warn :db-worker/keychain-save-failed {:error e
|
||||
:key key})
|
||||
((:set! kv) key text)))))
|
||||
|
||||
(defn- <read-secret-text
|
||||
[kv key]
|
||||
(-> (p/let [secret (.getPassword ^js keytar keychain-service key)]
|
||||
secret)
|
||||
(p/catch (fn [e]
|
||||
(log/warn :db-worker/keychain-read-failed {:error e
|
||||
:key key})
|
||||
((:get kv) key)))))
|
||||
|
||||
(defn- <delete-secret-text!
|
||||
[kv key]
|
||||
(-> (p/let [_ (.deletePassword ^js keytar keychain-service key)]
|
||||
nil)
|
||||
(p/catch (fn [e]
|
||||
(log/warn :db-worker/keychain-delete-failed {:error e
|
||||
:key key})
|
||||
((:set! kv) key nil)))))
|
||||
|
||||
(defn- truthy-env?
|
||||
[value]
|
||||
(contains? #{"1" "true" "yes" "on"}
|
||||
(string/lower-case (string/trim (str (or value ""))))))
|
||||
|
||||
(defn- use-keychain-for-owner?
|
||||
[owner-source]
|
||||
(not (and (= :cli owner-source)
|
||||
(truthy-env? (gobj/get (.-env js/process) "CLI_E2E_TEST")))))
|
||||
|
||||
(defn- <save-secret-text-by-owner!
|
||||
[kv owner-source key text]
|
||||
(if (use-keychain-for-owner? owner-source)
|
||||
(<save-secret-text! kv key text)
|
||||
((:set! kv) key text)))
|
||||
|
||||
(defn- <read-secret-text-by-owner
|
||||
[kv owner-source key]
|
||||
(if (use-keychain-for-owner? owner-source)
|
||||
(<read-secret-text kv key)
|
||||
((:get kv) key)))
|
||||
|
||||
(defn- <delete-secret-text-by-owner!
|
||||
[kv owner-source key]
|
||||
(if (use-keychain-for-owner? owner-source)
|
||||
(<delete-secret-text! kv key)
|
||||
((:set! kv) key nil)))
|
||||
|
||||
(defn- kv-store
|
||||
[data-dir]
|
||||
(let [kv-path (node-path/join data-dir "kv-store.json")
|
||||
state (atom nil)
|
||||
<load! (fn []
|
||||
(if (some? @state)
|
||||
(p/resolved @state)
|
||||
(-> (fs/readFile kv-path "utf8")
|
||||
(p/then (fn [contents]
|
||||
(let [data (parse-kv-state contents)]
|
||||
(reset! state data)
|
||||
@state)))
|
||||
(p/catch (fn [_]
|
||||
(reset! state {})
|
||||
@state)))))]
|
||||
{:get (fn [k]
|
||||
(p/let [_ (<load!)]
|
||||
(get @state k)))
|
||||
:set! (fn [k value]
|
||||
(p/let [_ (<load!)
|
||||
_ (swap! state assoc k value)
|
||||
payload (serialize-kv-state @state)]
|
||||
(fs/writeFile kv-path payload "utf8")))}))
|
||||
|
||||
(defn node-platform
|
||||
[{:keys [root-dir event-fn write-guard-fn owner-source recreate-lock-fn
|
||||
embedding-endpoint embedding-model-id open-vector-index-fn]}]
|
||||
(let [root-dir (db-lock/resolve-root-dir root-dir)
|
||||
data-dir (db-lock/graphs-dir root-dir)
|
||||
owner-source (db-lock/normalize-owner-source owner-source)
|
||||
embedding-endpoint (resolve-embedding-endpoint embedding-endpoint)
|
||||
vector-embedding-enabled? (boolean
|
||||
(and (macos-arm64?)
|
||||
(seq embedding-endpoint)))
|
||||
embedding-model-id (when vector-embedding-enabled?
|
||||
(resolve-embedding-model-id embedding-model-id))
|
||||
embedding-dimension (when vector-embedding-enabled?
|
||||
(resolve-embedding-dimension embedding-model-id))
|
||||
open-vector-index-fn (or open-vector-index-fn open-vector-index)
|
||||
kv (kv-store root-dir)]
|
||||
(p/do!
|
||||
(ensure-dir! root-dir)
|
||||
(ensure-dir! data-dir)
|
||||
(log/info :db-worker-node-platform {:root-dir root-dir
|
||||
:vector-embedding-enabled? vector-embedding-enabled?
|
||||
:embedding-endpoint embedding-endpoint
|
||||
:embedding-model-id embedding-model-id})
|
||||
(cond->
|
||||
{:env {:publishing? false
|
||||
:runtime :node
|
||||
:root-dir root-dir
|
||||
:owner-source owner-source
|
||||
:recreate-lock-fn recreate-lock-fn}
|
||||
:storage {:install-opfs-pool (fn [sqlite-module pool-name]
|
||||
(install-opfs-pool data-dir sqlite-module pool-name))
|
||||
:list-graphs (fn [] (list-graphs data-dir))
|
||||
:db-exists? (fn [graph] (db-exists? data-dir graph))
|
||||
:resolve-db-path (fn [_repo pool path]
|
||||
(pool-path pool path))
|
||||
:export-file export-file
|
||||
:import-db (fn [pool path data] (import-db write-guard-fn pool path data))
|
||||
:remove-vfs! (fn [pool] (remove-vfs! pool))
|
||||
:read-text! (fn [path] (read-text! data-dir path))
|
||||
:write-text! (fn [path text] (write-text! write-guard-fn data-dir path text))
|
||||
:write-text-atomic! (fn [path text] (write-text-atomic! write-guard-fn data-dir path text))
|
||||
:delete-file! (fn [path] (delete-file! write-guard-fn data-dir path))
|
||||
:asset-read-bytes! (fn [repo file-name]
|
||||
(asset-read-bytes! data-dir repo file-name))
|
||||
:asset-write-bytes! (fn [repo file-name payload]
|
||||
(asset-write-bytes! write-guard-fn data-dir repo file-name payload))
|
||||
:asset-stat (fn [repo file-name]
|
||||
(asset-stat data-dir repo file-name))
|
||||
:asset-delete! (fn [repo file-name]
|
||||
(asset-delete! write-guard-fn data-dir repo file-name))}
|
||||
:kv {:get (:get kv)
|
||||
:set! (:set! kv)}
|
||||
:broadcast {:post-message! (fn [type payload]
|
||||
(when event-fn
|
||||
(event-fn type payload)))}
|
||||
:websocket {:connect websocket-connect}
|
||||
:sqlite {:init! (fn [] nil)
|
||||
:open-db (fn [opts] (open-sqlite-db write-guard-fn opts))
|
||||
:close-db (fn [db] (.close db))
|
||||
:exec (fn [db sql-or-opts] (.exec db sql-or-opts))
|
||||
:transaction (fn [db f] (.transaction db f))
|
||||
:backup-db (fn [^js db path]
|
||||
(.backup db path))}
|
||||
:crypto {:save-secret-text! (fn [key text]
|
||||
(<save-secret-text-by-owner! kv owner-source key text))
|
||||
:read-secret-text (fn [key]
|
||||
(<read-secret-text-by-owner kv owner-source key))
|
||||
:delete-secret-text! (fn [key]
|
||||
(<delete-secret-text-by-owner! kv owner-source key))}
|
||||
:timers {:set-interval! (fn [f ms] (js/setInterval f ms))}}
|
||||
vector-embedding-enabled?
|
||||
(assoc :embedding {:model-id embedding-model-id
|
||||
:dimension embedding-dimension
|
||||
:embed-texts (fn [texts]
|
||||
(<embed-texts embedding-endpoint embedding-model-id texts))}
|
||||
:vector {:open-index open-vector-index-fn})))))
|
||||
248
src/main/frontend/worker/publish.cljs
Normal file
248
src/main/frontend/worker/publish.cljs
Normal file
@@ -0,0 +1,248 @@
|
||||
(ns frontend.worker.publish
|
||||
"Publish"
|
||||
(:require [clojure.string :as string]
|
||||
[datascript.core :as d]
|
||||
[frontend.common.thread-api :refer [def-thread-api]]
|
||||
[frontend.worker.state :as worker-state]
|
||||
[logseq.common.util :as common-util]
|
||||
[logseq.db :as ldb]
|
||||
[logseq.db.frontend.content :as db-content]
|
||||
[logseq.db.frontend.entity-util :as entity-util]
|
||||
[logseq.db.frontend.property :as db-property]
|
||||
[logseq.db.frontend.schema :as db-schema]))
|
||||
|
||||
(defn- publish-entity-title
|
||||
[entity]
|
||||
(or (:block/title entity)
|
||||
"Untitled"))
|
||||
|
||||
(defn- page-tags
|
||||
[page-entity]
|
||||
(let [tags (:block/tags page-entity)]
|
||||
(->> tags
|
||||
(remove (fn [tag]
|
||||
(contains? #{:logseq.class/Page} (:db/ident tag))))
|
||||
(map (fn [tag]
|
||||
{:tag_uuid (:block/uuid tag)
|
||||
:tag_title (:block/title tag)})))))
|
||||
|
||||
(defn- publish-ref-eid [value]
|
||||
(cond
|
||||
(number? value) (when (pos? value) value)
|
||||
(map? value) (let [eid (:db/id value)]
|
||||
(when (and (number? eid) (pos? eid))
|
||||
eid))
|
||||
:else nil))
|
||||
|
||||
(def ^:private comments-class-ident :logseq.class/Comments)
|
||||
(def ^:private comment-class-ident :logseq.class/Comment)
|
||||
|
||||
(defn- comments-area?
|
||||
[db block]
|
||||
(ldb/class-instance? (d/entity db comments-class-ident) block))
|
||||
|
||||
(defn- comment-block?
|
||||
[db block]
|
||||
(or (ldb/class-instance? (d/entity db comment-class-ident) block)
|
||||
(comments-area? db (:block/parent block))))
|
||||
|
||||
(defn- publishable-block?
|
||||
[db block]
|
||||
(not (or (comments-area? db block)
|
||||
(comment-block? db block))))
|
||||
|
||||
(defn- publish-refs-from-blocks
|
||||
[db blocks page-entity graph-uuid]
|
||||
(let [page-uuid (:block/uuid page-entity)
|
||||
page-title (publish-entity-title page-entity)
|
||||
page? (entity-util/page? page-entity)
|
||||
graph-uuid (str graph-uuid)]
|
||||
(mapcat (fn [block]
|
||||
(let [block-uuid (:block/uuid block)
|
||||
block-uuid-str (some-> block-uuid str)]
|
||||
(when (and block-uuid-str
|
||||
(or (not page?)
|
||||
(not= block-uuid page-uuid)))
|
||||
(let [block-content (or (:block/title block)
|
||||
(:block/name block)
|
||||
"")
|
||||
block-format (name (or (:block/format block) :markdown))
|
||||
refs (:block/refs block)
|
||||
refs (if (sequential? refs) refs (when refs [refs]))
|
||||
targets (->> refs
|
||||
(map publish-ref-eid)
|
||||
(keep #(when % (d/entity db %)))
|
||||
(keep :block/uuid)
|
||||
(map str)
|
||||
distinct)]
|
||||
(when (seq targets)
|
||||
(map (fn [target]
|
||||
{:graph_uuid graph-uuid
|
||||
:target_page_uuid target
|
||||
:source_page_uuid (str page-uuid)
|
||||
:source_page_title page-title
|
||||
:source_block_uuid block-uuid-str
|
||||
:source_block_content block-content
|
||||
:source_block_format block-format
|
||||
:updated_at (common-util/time-ms)})
|
||||
targets))))))
|
||||
blocks)))
|
||||
|
||||
(defn- collect-publish-blocks
|
||||
[db entity]
|
||||
(if (entity-util/page? entity)
|
||||
(:block/_page entity)
|
||||
(ldb/get-block-and-children db (:block/uuid entity))))
|
||||
|
||||
(def ^:private publish-search-max-length 4096)
|
||||
|
||||
(defn- block-page-eid
|
||||
[block]
|
||||
(let [page (:block/page block)]
|
||||
(cond
|
||||
(map? page) (:db/id page)
|
||||
(number? page) page
|
||||
:else nil)))
|
||||
|
||||
(defn- block-search-content
|
||||
[block]
|
||||
(let [raw-content (or (:block/title block)
|
||||
(:block/name block)
|
||||
"")
|
||||
raw-content (string/trim raw-content)]
|
||||
(when-not (string/blank? raw-content)
|
||||
(let [content (db-content/recur-replace-uuid-in-block-title
|
||||
(assoc block :block/title raw-content))
|
||||
content (if (> (count content) publish-search-max-length)
|
||||
(subs content 0 publish-search-max-length)
|
||||
content)]
|
||||
(string/trim content)))))
|
||||
|
||||
(defn- collect-search-blocks
|
||||
[blocks page-eid page-uuid]
|
||||
(->> blocks
|
||||
(keep (fn [block]
|
||||
(when (and (= (block-page-eid block) page-eid)
|
||||
(not= (:db/id block) page-eid)
|
||||
(not (:logseq.property/created-from-property block)))
|
||||
(when-let [block-uuid (some-> (:block/uuid block) str)]
|
||||
(when-let [content (block-search-content block)]
|
||||
{:page_uuid (str page-uuid)
|
||||
:block_uuid block-uuid
|
||||
:block_content content})))))))
|
||||
|
||||
(defn- collect-embedded-blocks
|
||||
[db blocks]
|
||||
(let [linked-eids (->> blocks
|
||||
(map :block/link)
|
||||
(map publish-ref-eid)
|
||||
(remove nil?)
|
||||
distinct)]
|
||||
(loop [queue (vec linked-eids)
|
||||
visited #{}
|
||||
acc []]
|
||||
(if (empty? queue)
|
||||
acc
|
||||
(let [eid (first queue)
|
||||
queue (subvec queue 1)]
|
||||
(if (contains? visited eid)
|
||||
(recur queue visited acc)
|
||||
(let [entity (d/entity db eid)
|
||||
uuid (:block/uuid entity)
|
||||
children (when uuid
|
||||
(ldb/get-block-and-children db uuid))
|
||||
children (filter #(publishable-block? db %) children)
|
||||
child-links (->> children
|
||||
(map :block/link)
|
||||
(map publish-ref-eid)
|
||||
(remove nil?))]
|
||||
(recur (into queue child-links)
|
||||
(conj visited eid)
|
||||
(into acc children)))))))))
|
||||
|
||||
(defn- publish-collect-page-eids
|
||||
[db entity]
|
||||
(let [page-id (:db/id entity)
|
||||
blocks (filter #(publishable-block? db %) (collect-publish-blocks db entity))
|
||||
embedded-blocks (collect-embedded-blocks db blocks)
|
||||
blocks (concat blocks embedded-blocks)
|
||||
block-eids (map :db/id blocks)
|
||||
ref-eids (->> blocks
|
||||
(mapcat :block/refs)
|
||||
(map publish-ref-eid)
|
||||
(remove nil?))
|
||||
tag-eids (->> blocks
|
||||
(mapcat :block/tags)
|
||||
(map publish-ref-eid)
|
||||
(remove nil?))
|
||||
page-tag-eids (->> (if-let [tags (:block/tags entity)]
|
||||
(if (sequential? tags) tags [tags])
|
||||
[])
|
||||
(map publish-ref-eid)
|
||||
(remove nil?))
|
||||
page-eids (->> blocks (map :block/page) (keep :db/id))
|
||||
property-eids (->> (cons entity blocks)
|
||||
(map db-property/properties)
|
||||
(mapcat (fn [props]
|
||||
(mapcat (fn [[k v]]
|
||||
(let [property (d/entity db k)
|
||||
pid (:db/id property)
|
||||
ref-type? (= :db.type/ref (:db/valueType property))
|
||||
many? (= :db.cardinality/many (:db/cardinality property))]
|
||||
(cons pid
|
||||
(when ref-type?
|
||||
(if many?
|
||||
(map :db/id v)
|
||||
(list (:db/id v)))))))
|
||||
props)))
|
||||
(remove nil?))]
|
||||
{:blocks blocks
|
||||
:eids (->> (concat [page-id] block-eids ref-eids tag-eids page-tag-eids page-eids property-eids)
|
||||
(remove nil?)
|
||||
distinct)}))
|
||||
|
||||
(defn- normalize-block-publish-datoms
|
||||
[datoms block-eids root-eid]
|
||||
(map (fn [[e a v tx added]]
|
||||
(if (and (contains? block-eids e) (= a :block/page))
|
||||
[e a root-eid tx added]
|
||||
[e a v tx added]))
|
||||
datoms))
|
||||
|
||||
(defn- build-publish-page-payload
|
||||
[db entity]
|
||||
(let [{:keys [blocks eids]} (publish-collect-page-eids db entity)
|
||||
graph-uuid (or (ldb/get-graph-rtc-uuid db)
|
||||
(ldb/get-graph-local-uuid db))
|
||||
refs (when graph-uuid
|
||||
(publish-refs-from-blocks db blocks entity graph-uuid))
|
||||
tags (page-tags entity)
|
||||
search-blocks (collect-search-blocks blocks (:db/id entity) (:block/uuid entity))
|
||||
raw-datoms (->>
|
||||
(mapcat (fn [eid]
|
||||
(map (fn [d] [(:e d) (:a d) (:v d) (:tx d) (:added d)])
|
||||
(d/datoms db :eavt eid)))
|
||||
eids)
|
||||
(remove (fn [[_e a _v _tx _added]]
|
||||
(contains? #{:block/tx-id :logseq.property.user/email} a))))
|
||||
datoms (if (entity-util/page? entity)
|
||||
raw-datoms
|
||||
(normalize-block-publish-datoms raw-datoms (set (map :db/id blocks)) (:db/id entity)))]
|
||||
{:page (entity-util/entity->map entity)
|
||||
:page-uuid (:block/uuid entity)
|
||||
:page-title (publish-entity-title entity)
|
||||
:graph-uuid (some-> graph-uuid str)
|
||||
:block-count (count blocks)
|
||||
:schema-version (db-schema/schema-version->string db-schema/version)
|
||||
:refs refs
|
||||
:page-tags tags
|
||||
:blocks search-blocks
|
||||
:datoms datoms}))
|
||||
|
||||
(def-thread-api :thread-api/build-publish-page-payload
|
||||
[repo eid]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(let [db @conn
|
||||
page-entity (d/entity db eid)]
|
||||
(when (and page-entity (:db/id page-entity))
|
||||
(build-publish-page-payload db page-entity)))))
|
||||
812
src/main/frontend/worker/query_dsl.cljs
Normal file
812
src/main/frontend/worker/query_dsl.cljs
Normal file
@@ -0,0 +1,812 @@
|
||||
(ns frontend.worker.query-dsl
|
||||
"Handles executing dsl queries a.k.a. simple queries"
|
||||
(:require ["chrono-node" :as chrono]
|
||||
[cljs-time.coerce :as tc]
|
||||
[cljs-time.core :as t]
|
||||
[cljs-time.format :as tf]
|
||||
[cljs.reader :as reader]
|
||||
[clojure.set :as set]
|
||||
[clojure.string :as string]
|
||||
[clojure.walk :as walk]
|
||||
[datascript.core :as d]
|
||||
[goog.object :as gobj]
|
||||
[logseq.common.date :as common-date]
|
||||
[logseq.common.util :as common-util]
|
||||
[logseq.common.util.date-time :as date-time-util]
|
||||
[logseq.common.util.page-ref :as page-ref]
|
||||
[logseq.db :as ldb]
|
||||
[logseq.db.frontend.class :as db-class]
|
||||
[logseq.db.frontend.query-dsl :as shared-query-dsl]
|
||||
[logseq.db.frontend.rules :as rules]))
|
||||
|
||||
;; Query fields:
|
||||
|
||||
;; Operators:
|
||||
;; and
|
||||
;; or
|
||||
;; not
|
||||
|
||||
;; Filters:
|
||||
;; between
|
||||
;; Example: (between -7d +7d)
|
||||
;; (between created-at -1d today)
|
||||
;; (between updated-at -1d today)
|
||||
;; [[page-ref]]
|
||||
;; property (block)
|
||||
;; task (block)
|
||||
;; priority (block)
|
||||
;; page
|
||||
;; sample
|
||||
;; full-text-search ""
|
||||
|
||||
;; Time helpers
|
||||
;; ============
|
||||
(def ^:private journal-title-formatters
|
||||
(common-date/journal-title-formatters nil))
|
||||
|
||||
(defn- valid-journal-title?
|
||||
[title]
|
||||
(common-date/valid-journal-title? title nil))
|
||||
|
||||
(defn- journal-title->int
|
||||
[title]
|
||||
(date-time-util/journal-title->int title journal-title-formatters))
|
||||
|
||||
(defn- journal-title->long
|
||||
[title]
|
||||
(date-time-util/journal-title-> title tc/to-long journal-title-formatters))
|
||||
|
||||
(def ^:private template-re #"<%([^%].*?)%>")
|
||||
|
||||
(def ^:private journal-title-formatter
|
||||
(tf/formatter date-time-util/default-journal-title-formatter))
|
||||
|
||||
(defn- journal-name
|
||||
[date-time]
|
||||
(tf/unparse journal-title-formatter date-time))
|
||||
|
||||
(defn- nld-parse
|
||||
[s]
|
||||
(when (string? s)
|
||||
((gobj/get chrono "parseDate") s)))
|
||||
|
||||
(defn- current-time
|
||||
[]
|
||||
(tf/unparse (tf/formatter "h:mm a") (t/now)))
|
||||
|
||||
(defn- variable-rules
|
||||
[{:keys [current-page-title today-day]}]
|
||||
(let [today-date (if today-day
|
||||
(tc/from-long
|
||||
(date-time-util/journal-day->ms today-day))
|
||||
(t/today))
|
||||
today (journal-name today-date)]
|
||||
{"today" (page-ref/->page-ref today)
|
||||
"yesterday" (page-ref/->page-ref
|
||||
(journal-name (t/minus today-date (t/days 1))))
|
||||
"tomorrow" (page-ref/->page-ref
|
||||
(journal-name (t/plus today-date (t/days 1))))
|
||||
"time" (current-time)
|
||||
"current page" (page-ref/->page-ref (or current-page-title today))}))
|
||||
|
||||
(defn- resolve-dynamic-template
|
||||
[content opts]
|
||||
(let [rules (delay (variable-rules opts))]
|
||||
(string/replace content template-re
|
||||
(fn [[_ match]]
|
||||
(let [match (string/trim match)
|
||||
match-key (string/lower-case match)]
|
||||
(cond
|
||||
(string/blank? match)
|
||||
""
|
||||
|
||||
(contains? @rules match-key)
|
||||
(get @rules match-key)
|
||||
|
||||
:else
|
||||
(if-let [parsed (nld-parse match)]
|
||||
(page-ref/->page-ref
|
||||
(journal-name (tc/from-date parsed)))
|
||||
match)))))))
|
||||
|
||||
(defn- ->journal-day-int [input]
|
||||
(let [input (string/lower-case (name input))]
|
||||
(cond
|
||||
(= "today" input)
|
||||
(date-time-util/date->int (t/today))
|
||||
|
||||
(= "yesterday" input)
|
||||
(date-time-util/date->int (t/yesterday))
|
||||
|
||||
(= "tomorrow" input)
|
||||
(date-time-util/date->int (t/plus (t/today) (t/days 1)))
|
||||
|
||||
(page-ref/page-ref? input)
|
||||
(let [input (-> (page-ref/get-page-name input)
|
||||
(string/replace ":" "")
|
||||
(string/capitalize))]
|
||||
(when (valid-journal-title? input)
|
||||
(journal-title->int input)))
|
||||
|
||||
:else
|
||||
(let [duration (parse-long (subs input 0 (dec (count input))))
|
||||
kind (last input)
|
||||
tf (case kind
|
||||
"y" t/years
|
||||
"m" t/months
|
||||
"w" t/weeks
|
||||
t/days)]
|
||||
(date-time-util/date->int (t/plus (t/today) (tf duration)))))))
|
||||
|
||||
(defn- ->timestamp [input]
|
||||
(let [input (string/lower-case (name input))]
|
||||
(cond
|
||||
(= "now" input)
|
||||
(common-util/time-ms)
|
||||
|
||||
(= "today" input)
|
||||
(tc/to-long (t/today))
|
||||
|
||||
(= "yesterday" input)
|
||||
(tc/to-long (t/yesterday))
|
||||
|
||||
(= "tomorrow" input)
|
||||
(tc/to-long (t/plus (t/today) (t/days 1)))
|
||||
|
||||
(page-ref/page-ref? input)
|
||||
(let [input (-> (page-ref/get-page-name input)
|
||||
(string/replace ":" "")
|
||||
(string/capitalize))]
|
||||
(when (valid-journal-title? input)
|
||||
(journal-title->long input)))
|
||||
|
||||
:else
|
||||
(let [duration (parse-long (subs input 0 (dec (count input))))
|
||||
kind (last input)
|
||||
tf (case kind
|
||||
"y" t/years
|
||||
"m" t/months
|
||||
"w" t/weeks
|
||||
"h" t/hours
|
||||
"n" t/minutes ; min
|
||||
t/days)]
|
||||
(tc/to-long (t/plus (t/now) (tf duration)))))))
|
||||
|
||||
;; Boolean operator utils: and, or, not
|
||||
;; ======================
|
||||
(defn- collect-vars
|
||||
[l]
|
||||
(let [vars (atom #{})]
|
||||
(walk/postwalk
|
||||
(fn [f]
|
||||
(when (and (symbol? f) (= \? (first (name f))))
|
||||
(swap! vars conj f))
|
||||
f)
|
||||
l)
|
||||
@vars))
|
||||
|
||||
(defn- build-and-or-not-result
|
||||
[fe clauses current-filter nested-and?]
|
||||
(cond
|
||||
(= fe 'not)
|
||||
(if (every? list? clauses)
|
||||
(cons fe (seq clauses))
|
||||
(let [clauses (if (coll? (first clauses))
|
||||
(apply concat clauses)
|
||||
clauses)
|
||||
clauses (if (and (= 1 (count clauses))
|
||||
(= 'and (ffirst clauses)))
|
||||
;; unflatten
|
||||
(rest (first clauses))
|
||||
clauses)]
|
||||
(cons fe (seq clauses))))
|
||||
|
||||
(coll? (first clauses))
|
||||
(cond
|
||||
(= current-filter 'not)
|
||||
(cons 'and clauses)
|
||||
|
||||
(or (= current-filter 'or)
|
||||
nested-and?)
|
||||
(cons 'and clauses)
|
||||
|
||||
:else
|
||||
(->> clauses
|
||||
(mapcat (fn [result]
|
||||
(cond
|
||||
;; rule like (task ?b #{"NOW"})
|
||||
(list? result)
|
||||
[result]
|
||||
;; datalog clause like [[?b :block/uuid]]
|
||||
(vector? result)
|
||||
result
|
||||
:else
|
||||
[(cons 'and (seq result))])))
|
||||
(apply list fe)))
|
||||
|
||||
:else
|
||||
(apply list fe clauses)))
|
||||
|
||||
(declare build-query)
|
||||
|
||||
(defonce remove-nil? (partial remove nil?))
|
||||
|
||||
(defn- not-clause? [c]
|
||||
(and (seq? c) (= 'not (first c))))
|
||||
|
||||
(defn- distinct-preserve-order [xs]
|
||||
(let [seen (volatile! #{})]
|
||||
(reduce (fn [acc x]
|
||||
(if (contains? @seen x)
|
||||
acc
|
||||
(do (vswap! seen conj x)
|
||||
(conj acc x))))
|
||||
[] xs)))
|
||||
|
||||
(defn- build-and-or-not
|
||||
[e {:keys [current-filter vars] :as env} level fe]
|
||||
(let [raw-clauses (map (fn [form]
|
||||
(build-query form (assoc env :current-filter fe) (inc level)))
|
||||
(rest e))
|
||||
|
||||
;; preserve order (no hash-order surprises)
|
||||
clauses (->> raw-clauses
|
||||
(map :query)
|
||||
remove-nil?
|
||||
(distinct-preserve-order))
|
||||
|
||||
;; for (and ...), ensure any (not ...) comes AFTER positive binders
|
||||
clauses (if (= fe 'and)
|
||||
(let [[nots others] (reduce (fn [[ns os] c]
|
||||
(if (not-clause? c)
|
||||
[(conj ns c) os]
|
||||
[ns (conj os c)]))
|
||||
[[] []]
|
||||
clauses)]
|
||||
(concat others nots))
|
||||
clauses)
|
||||
|
||||
nested-and? (and (= fe 'and) (= current-filter 'and))]
|
||||
|
||||
(when (seq clauses)
|
||||
(let [result (build-and-or-not-result fe clauses current-filter nested-and?)
|
||||
vars' (set/union (set @vars) (collect-vars result))
|
||||
query (cond
|
||||
nested-and? result
|
||||
(and (zero? level) (contains? #{'and 'or} fe)) result
|
||||
(and (= 'not fe) (some? current-filter)) result
|
||||
:else [result])]
|
||||
(reset! vars vars')
|
||||
{:query query
|
||||
:rules (distinct (mapcat :rules raw-clauses))}))))
|
||||
|
||||
;; build-query fns
|
||||
;; ===============
|
||||
|
||||
;; Current DB when query is run
|
||||
(def ^:dynamic *current-db*
|
||||
nil)
|
||||
|
||||
(def get-timestamp-property shared-query-dsl/get-timestamp-property)
|
||||
|
||||
(defn- build-journal-between-two-arg
|
||||
[e]
|
||||
(let [start (->journal-day-int (nth e 1))
|
||||
end (->journal-day-int (nth e 2))
|
||||
[start end] (sort [start end])]
|
||||
{:query (list 'between '?b start end)
|
||||
:rules [:between]}))
|
||||
|
||||
(defn- db-based-build-between-three-arg
|
||||
[e]
|
||||
(when-let [k (get-timestamp-property e)]
|
||||
(let [start (->timestamp (nth e 2))
|
||||
end (->timestamp (nth e 3))]
|
||||
(when (and start end)
|
||||
(let [[start end] (sort [start end])
|
||||
sym '?v]
|
||||
{:query [['?b k sym]
|
||||
[(list '>= sym start)]
|
||||
[(list '< sym end)]]})))))
|
||||
|
||||
(defn- db-based-build-between-two-arg
|
||||
[e]
|
||||
(db-based-build-between-three-arg (concat e ['now])))
|
||||
|
||||
(defn- build-between
|
||||
[e]
|
||||
(cond
|
||||
(= 3 (count e))
|
||||
(let [k (get-timestamp-property e)]
|
||||
(if k
|
||||
(db-based-build-between-two-arg e)
|
||||
(build-journal-between-two-arg e)))
|
||||
|
||||
;; (between created_at -1d today)
|
||||
(= 4 (count e))
|
||||
(db-based-build-between-three-arg e)))
|
||||
|
||||
(defn ->db-property-value
|
||||
"Parses property values for DB graphs"
|
||||
[k v]
|
||||
(let [v' (if (symbol? v) (str v) v)]
|
||||
(cond (string? v')
|
||||
(if (string/starts-with? v' "#")
|
||||
(subs v' 1)
|
||||
(or (page-ref/get-page-name v') v'))
|
||||
;; Convert number pages to string
|
||||
(and (double? v) (= :node (:logseq.property/type (d/entity *current-db* k))))
|
||||
(str v)
|
||||
:else
|
||||
v')))
|
||||
|
||||
(defn- ->db-keyword-property
|
||||
"Returns property db-ident given case sensitive property names for db graphs"
|
||||
[property-name]
|
||||
(if (qualified-keyword? property-name)
|
||||
property-name
|
||||
(or (some->> (name property-name)
|
||||
(d/q '[:find [(pull ?b [:db/ident]) ...]
|
||||
:in $ ?title
|
||||
:where [?b :block/tags :logseq.class/Property] [?b :block/title ?title]]
|
||||
*current-db*)
|
||||
first
|
||||
:db/ident)
|
||||
;; Don't return nil as that incorrectly matches all properties
|
||||
::no-property-found)))
|
||||
|
||||
(defn- build-property-two-arg
|
||||
[e {:keys [private-property?]}]
|
||||
(let [k (->db-keyword-property (nth e 1))
|
||||
v (nth e 2)
|
||||
v' (->db-property-value k v)
|
||||
property (when (qualified-keyword? k)
|
||||
(d/entity *current-db* k))
|
||||
ref-type? (= :db.type/ref (:db/valueType property))
|
||||
default-value (if ref-type?
|
||||
(when-let [value (:logseq.property/default-value property)]
|
||||
(or (:block/title value)
|
||||
(:logseq.property/value value)))
|
||||
(:logseq.property/scalar-default-value property))
|
||||
default-value? (and (some? v') (= default-value v'))
|
||||
rule (if private-property?
|
||||
(cond
|
||||
(and ref-type? default-value?)
|
||||
:private-ref-property-with-default
|
||||
ref-type?
|
||||
:private-ref-property
|
||||
default-value?
|
||||
:private-scalar-property-with-default
|
||||
:else
|
||||
:private-scalar-property)
|
||||
(cond
|
||||
(and ref-type? default-value?)
|
||||
:ref-property-with-default
|
||||
ref-type?
|
||||
:ref-property
|
||||
default-value?
|
||||
:scalar-property-with-default
|
||||
:else
|
||||
:scalar-property))]
|
||||
{:query (list (symbol (name rule)) '?b k v')
|
||||
:rules [rule]}))
|
||||
|
||||
(defn- build-property-one-arg
|
||||
[e {:keys [private-property?]}]
|
||||
(let [k (->db-keyword-property (nth e 1))]
|
||||
(if private-property?
|
||||
{:query (list 'has-private-simple-query-property '?b k)
|
||||
:rules [:has-private-simple-query-property]}
|
||||
{:query (list 'has-simple-query-property '?b k)
|
||||
:rules [:has-simple-query-property]})))
|
||||
|
||||
(defn- build-property [e env]
|
||||
(cond
|
||||
(= 3 (count e))
|
||||
(build-property-two-arg e env)
|
||||
|
||||
(= 2 (count e))
|
||||
(build-property-one-arg e env)))
|
||||
|
||||
(defn- build-task
|
||||
[e]
|
||||
(let [markers (if (coll? (first (rest e)))
|
||||
(first (rest e))
|
||||
(rest e))]
|
||||
(when (seq markers)
|
||||
(let [markers' (set (map (comp common-util/capitalize-all name) markers))]
|
||||
{:query (list 'task '?b (set markers'))
|
||||
:rules [:task]}))))
|
||||
|
||||
(defn- build-priority
|
||||
[e]
|
||||
(let [priorities (if (coll? (first (rest e)))
|
||||
(first (rest e))
|
||||
(rest e))]
|
||||
(when (seq priorities)
|
||||
(let [priorities (set (map (comp string/capitalize name) priorities))]
|
||||
{:query (list 'priority '?b priorities)
|
||||
:rules [:priority]}))))
|
||||
|
||||
(defn- build-tags
|
||||
[e]
|
||||
(let [tags (if (coll? (first (rest e)))
|
||||
(first (rest e))
|
||||
(rest e))
|
||||
tags (map name tags)]
|
||||
(when (seq tags)
|
||||
(let [tags (set (map (comp page-ref/get-page-name!) tags))]
|
||||
{:query (list 'tags
|
||||
'?b
|
||||
(->> tags
|
||||
(mapcat (fn [tag-name]
|
||||
(when-let [tag-id (if (common-util/uuid-string? tag-name)
|
||||
[:block/uuid (uuid tag-name)]
|
||||
(first (ldb/page-exists? *current-db* tag-name #{:logseq.class/Tag})))]
|
||||
(when-let [tag (d/entity *current-db* tag-id)]
|
||||
(->> (db-class/get-structured-children *current-db* (:db/id tag))
|
||||
(cons (:db/id tag)))))))
|
||||
set))
|
||||
:rules [:tags]}))))
|
||||
|
||||
(defn- build-sample
|
||||
[e sample]
|
||||
(when-let [num (second e)]
|
||||
(when (integer? num)
|
||||
(reset! sample num)
|
||||
;; blank b/c this post-process filter doesn't effect query
|
||||
{})))
|
||||
|
||||
(defn- build-page
|
||||
[e]
|
||||
(let [page-name (page-ref/get-page-name! (str (first (rest e))))
|
||||
page-name (common-util/page-name-sanity-lc page-name)]
|
||||
{:query (list 'page '?b page-name)
|
||||
:rules [:page]}))
|
||||
|
||||
(defn- build-page-ref
|
||||
[e]
|
||||
(let [page-name (-> (page-ref/get-page-name! e)
|
||||
(common-util/page-name-sanity-lc))
|
||||
page (ldb/get-page *current-db* page-name)]
|
||||
(when page
|
||||
{:query (list 'page-ref '?b (:db/id page))
|
||||
:rules [:page-ref]})))
|
||||
|
||||
(defn- build-self-ref
|
||||
[e]
|
||||
(let [page-name (-> (page-ref/get-page-name! e)
|
||||
(common-util/page-name-sanity-lc))
|
||||
page (ldb/get-page *current-db* page-name)]
|
||||
(when page
|
||||
{:query (list 'self-ref '?b (:db/id page))
|
||||
:rules [:self-ref]})))
|
||||
|
||||
(defn- build-block-content [e]
|
||||
{:query (list 'block-content '?b e)
|
||||
:rules [:block-content]})
|
||||
|
||||
(defn- datalog-clause?
|
||||
[e]
|
||||
(and
|
||||
(coll? e)
|
||||
(or
|
||||
(list? (first e))
|
||||
(and (>= (count e) 2)
|
||||
(or
|
||||
;; variable
|
||||
(string/starts-with? (str (first e)) "?")
|
||||
;; function
|
||||
(list? (first e)))))))
|
||||
|
||||
(defn build-query
|
||||
"This fn converts a form/list in a query e.g. `(operator arg1 arg2)` to its datalog
|
||||
equivalent. This fn is called recursively on sublists for boolean operators
|
||||
`and`, `or` and `not`. This fn should return a map with :query and :rules or nil.
|
||||
|
||||
Some bindings in this fn:
|
||||
|
||||
* e - the list being processed
|
||||
* fe - the query operator e.g. `property`"
|
||||
([e env]
|
||||
(build-query e (assoc env :vars (atom {})) 0))
|
||||
([e {:keys [form blocks? sample current-filter] :as env :or {blocks? (atom nil)}} level]
|
||||
; {:post [(or (nil? %) (map? %))]}
|
||||
(let [fe (first e)
|
||||
fe (when fe
|
||||
(cond
|
||||
(list? fe)
|
||||
fe
|
||||
(or (symbol? fe) (keyword? fe))
|
||||
(symbol (string/lower-case (name fe)))
|
||||
:else
|
||||
(string/lower-case (str fe))))
|
||||
page-ref? (page-ref/page-ref? e)]
|
||||
(when (or
|
||||
(contains? #{'between 'property 'private-property 'todo 'task 'priority 'page} fe)
|
||||
(and (not page-ref?) (string? e)))
|
||||
(reset! blocks? true))
|
||||
(cond
|
||||
(nil? e)
|
||||
nil
|
||||
|
||||
(datalog-clause? e)
|
||||
{:query [e]
|
||||
:rules []}
|
||||
|
||||
(and (= fe 'and) (every? page-ref/page-ref? (rest e)))
|
||||
(build-query (concat e [(cons 'or (rest e))]) env level)
|
||||
|
||||
page-ref?
|
||||
(if (or (= current-filter 'or) (= form e))
|
||||
(build-self-ref e)
|
||||
(build-page-ref e))
|
||||
|
||||
(string? e) ; block content full-text search, could be slow
|
||||
(build-block-content e)
|
||||
|
||||
(contains? #{'and 'or 'not} fe)
|
||||
(build-and-or-not e env level fe)
|
||||
|
||||
(= 'between fe)
|
||||
(build-between e)
|
||||
|
||||
(= 'property fe)
|
||||
(build-property e env)
|
||||
|
||||
(= 'private-property fe)
|
||||
(build-property e (assoc env :private-property? true))
|
||||
|
||||
;; task is the new name and todo is the old one
|
||||
(or (= 'todo fe) (= 'task fe))
|
||||
(build-task e)
|
||||
|
||||
(= 'priority fe)
|
||||
(build-priority e)
|
||||
|
||||
(= 'page fe)
|
||||
(build-page e)
|
||||
|
||||
(= 'sample fe)
|
||||
(build-sample e sample)
|
||||
|
||||
(= 'tags fe)
|
||||
(build-tags e)
|
||||
|
||||
:else
|
||||
nil))))
|
||||
|
||||
;; parse fns
|
||||
;; =========
|
||||
|
||||
(def pre-transform shared-query-dsl/pre-transform)
|
||||
|
||||
(defn- lvar? [x]
|
||||
(and (symbol? x) (= \? (first (name x)))))
|
||||
|
||||
(defn- collect-vars-by-polarity
|
||||
"Returns {:pos #{?vars} :neg #{?vars}}.
|
||||
Vars inside (not ...) are counted as negative."
|
||||
[form]
|
||||
(let [pos (volatile! #{})
|
||||
neg (volatile! #{})]
|
||||
(letfn [(walk* [x positive?]
|
||||
(cond
|
||||
(lvar? x)
|
||||
(vswap! (if positive? pos neg) conj x)
|
||||
|
||||
(and (seq? x) (= 'not (first x)))
|
||||
(doseq [c (rest x)] (walk* c false))
|
||||
|
||||
(sequential? x)
|
||||
(doseq [c x] (walk* c positive?))
|
||||
|
||||
(map? x)
|
||||
(do (doseq [k (keys x)] (walk* k positive?))
|
||||
(doseq [v (vals x)] (walk* v positive?)))
|
||||
|
||||
:else nil))]
|
||||
(walk* form true)
|
||||
{:pos @pos :neg @neg})))
|
||||
|
||||
(defn- add-bindings!
|
||||
[q]
|
||||
(let [{:keys [pos neg]} (collect-vars-by-polarity q)
|
||||
|
||||
appears? (fn [v] (or (contains? pos v) (contains? neg v)))
|
||||
needs-domain? (fn [v] (and (appears? v) (not (contains? pos v))))
|
||||
|
||||
b-need? (needs-domain? '?b)
|
||||
p-need? (needs-domain? '?p)
|
||||
|
||||
;; CASE 1: both needed → link them, do NOT enumerate all blocks
|
||||
bindings
|
||||
(cond
|
||||
(and b-need? p-need?)
|
||||
[['?b :block/page '?p]]
|
||||
|
||||
;; CASE 2: only ?b needed → last-resort domain (true global negation)
|
||||
b-need?
|
||||
[['?b :block/uuid]
|
||||
'[(missing? $ ?b :logseq.property/built-in?)]]
|
||||
|
||||
;; CASE 3: only ?p needed
|
||||
p-need?
|
||||
[['?p :block/name]]
|
||||
|
||||
;; CASE 4: both already positive → optional link (cheap + useful)
|
||||
(and (contains? pos '?b) (contains? pos '?p))
|
||||
[['?b :block/page '?p]]
|
||||
|
||||
:else
|
||||
nil)]
|
||||
(if (seq bindings)
|
||||
(concat bindings q) ;; IMPORTANT: bindings FIRST
|
||||
q)))
|
||||
|
||||
(def simplify-query shared-query-dsl/simplify-query)
|
||||
(def custom-readers shared-query-dsl/custom-readers)
|
||||
(defn parse
|
||||
[s db {:keys [cards?]}]
|
||||
(when (and (string? s)
|
||||
(not (string/blank? s)))
|
||||
(binding [*current-db* db]
|
||||
(let [s (if (= \# (first s)) (page-ref/->page-ref (subs s 1)) s)
|
||||
form (some->> s
|
||||
(pre-transform)
|
||||
(reader/read-string custom-readers))
|
||||
sort-by (atom nil)
|
||||
blocks? (atom nil)
|
||||
sample (atom nil)
|
||||
form (simplify-query form)
|
||||
{result :query rules :rules}
|
||||
(when form (build-query form {:form form
|
||||
:sort-by sort-by
|
||||
:blocks? blocks?
|
||||
:sample sample
|
||||
:cards? cards?}))
|
||||
result' (when (seq result)
|
||||
(let [key (if (coll? (first result))
|
||||
;; Only queries for this branch are not's like:
|
||||
;; [(not (page-ref ?b "page 2"))]
|
||||
(keyword (ffirst result))
|
||||
(keyword (first result)))]
|
||||
(add-bindings! (if (= key :and) (rest result) result))))
|
||||
extract-rules (fn [rules]
|
||||
(rules/extract-rules rules/db-query-dsl-rules rules {:deps rules/rules-dependencies}))
|
||||
rule-names (if (contains? (set rules) :page-ref)
|
||||
(conj (set rules) :self-ref)
|
||||
(set rules))
|
||||
rules' (extract-rules rule-names)]
|
||||
{:query result'
|
||||
:rules rules'
|
||||
:rule-names rule-names
|
||||
:sort-by @sort-by
|
||||
:blocks? (boolean @blocks?)
|
||||
:sample sample}))))
|
||||
|
||||
;; Main fns
|
||||
;; ========
|
||||
|
||||
(defn query-wrapper
|
||||
[where {:keys [blocks? block-attrs]}]
|
||||
(let [block-attrs (or block-attrs '[*])
|
||||
q (if blocks? ; FIXME: it doesn't need to be either blocks or pages
|
||||
`[:find (~'pull ~'?b ~block-attrs)
|
||||
:in ~'$ ~'%
|
||||
:where]
|
||||
'[:find (pull ?p [*])
|
||||
:in $ %
|
||||
:where])]
|
||||
(if (coll? (first where))
|
||||
(apply conj q where)
|
||||
(conj q where))))
|
||||
|
||||
(defn parse-query
|
||||
([q db] (parse-query q db {}))
|
||||
([q db options]
|
||||
(let [q' (resolve-dynamic-template q options)]
|
||||
(parse q' db options))))
|
||||
|
||||
(def ^:private query-result-watch-attrs
|
||||
#{:block/uuid :block/title :block/name :block/parent})
|
||||
|
||||
(def ^:private attr-watch-safe-rules
|
||||
#{:between :block-content :page})
|
||||
|
||||
(defn query-watch-dependencies
|
||||
"Return attribute-level dependencies for a DSL query when its rules are safe to inspect.
|
||||
|
||||
Queries that rely on dynamic class or property semantics remain opaque and keep the
|
||||
graph-level dependency until those semantics have their own invalidation keys."
|
||||
[query-string db options]
|
||||
(if (or (not (string? query-string))
|
||||
(string/blank? query-string)
|
||||
(common-util/wrapped-by-quotes? query-string))
|
||||
{:attrs #{} :opaque? true}
|
||||
(let [{query* :query :keys [rule-names rules]} (parse-query query-string db options)
|
||||
safe? (every? attr-watch-safe-rules rule-names)
|
||||
forms (tree-seq coll? seq [query* rules])
|
||||
attrs (into query-result-watch-attrs
|
||||
(keep (fn [form]
|
||||
(when (and (vector? form)
|
||||
(<= 2 (count form))
|
||||
(qualified-keyword? (second form)))
|
||||
(second form)))
|
||||
forms))]
|
||||
{:attrs attrs
|
||||
:opaque? (or (not safe?) (empty? query*))})))
|
||||
|
||||
(def db-block-attrs
|
||||
"Block attributes for db graph queries"
|
||||
;; only needs :db/id for query/view
|
||||
[:db/id])
|
||||
|
||||
(defn- sample-results
|
||||
[result sample]
|
||||
(if (and sample (pos-int? sample))
|
||||
(take sample (shuffle result))
|
||||
result))
|
||||
|
||||
(defn- with-raw-title
|
||||
[value]
|
||||
(if (and (map? value)
|
||||
(contains? value :block/title)
|
||||
(not (contains? value :block/raw-title)))
|
||||
(assoc value :block/raw-title (:block/title value))
|
||||
value))
|
||||
|
||||
(defn- query-result-tuples
|
||||
[result]
|
||||
(let [tuples (cond
|
||||
(contains? result :tuples)
|
||||
(:tuples result)
|
||||
|
||||
:else
|
||||
result)]
|
||||
(mapv (fn [tuple]
|
||||
(mapv with-raw-title
|
||||
(cond
|
||||
(vector? tuple)
|
||||
tuple
|
||||
|
||||
(map? tuple)
|
||||
[tuple]
|
||||
|
||||
(and (object? tuple) (number? (.-length ^js tuple)))
|
||||
(vec (array-seq tuple))
|
||||
|
||||
(seqable? tuple)
|
||||
(vec tuple)
|
||||
|
||||
:else
|
||||
[tuple])))
|
||||
tuples)))
|
||||
|
||||
(defn execute-query
|
||||
[query-string db {:keys [cards? block-attrs] :as opts}]
|
||||
(when (and (string? query-string) (not= "\"\"" query-string))
|
||||
(let [{query* :query :keys [rules sample]} (parse-query query-string db opts)
|
||||
query* (if cards?
|
||||
(let [card-id (:db/id (d/entity db :logseq.class/Card))]
|
||||
(common-util/concat-without-nil
|
||||
[['?b :block/tags card-id]]
|
||||
(if (coll? (first query*)) query* [query*])))
|
||||
query*)]
|
||||
(when-let [query' (some-> query* (query-wrapper {:blocks? true
|
||||
:block-attrs block-attrs}))]
|
||||
(-> (d/q query' db rules)
|
||||
query-result-tuples
|
||||
(sample-results (some-> sample deref)))))))
|
||||
|
||||
(defn execute-custom-query
|
||||
[query-m db {:keys [block-attrs]}]
|
||||
(when (seq (:query query-m))
|
||||
(let [query-string (resolve-dynamic-template (pr-str (:query query-m)) {})
|
||||
{query* :query :keys [blocks? rules]} (parse query-string db {})]
|
||||
(when-let [query' (some-> query* (query-wrapper {:blocks? blocks?
|
||||
:block-attrs block-attrs}))]
|
||||
(query-result-tuples (d/q query' db rules))))))
|
||||
|
||||
(comment
|
||||
(parse "(and [[foo]] [[bar]])" nil {}))
|
||||
582
src/main/frontend/worker/render_affected_keys.cljs
Normal file
582
src/main/frontend/worker/render_affected_keys.cljs
Normal file
@@ -0,0 +1,582 @@
|
||||
(ns frontend.worker.render-affected-keys
|
||||
"Derive explicit renderer resource invalidations from one transaction report."
|
||||
(:require [clojure.string :as string]
|
||||
[datascript.core :as d]))
|
||||
|
||||
(def ^:private property-metadata-attrs
|
||||
#{:db/cardinality
|
||||
:logseq.property/type
|
||||
:logseq.property/public?
|
||||
:logseq.property/built-in?
|
||||
:logseq.property/hide?
|
||||
:logseq.property/hide-empty-value
|
||||
:logseq.property/ui-position
|
||||
:logseq.property/view-context
|
||||
:logseq.property/scalar-default-value
|
||||
:logseq.property/default-value
|
||||
:logseq.property/classes
|
||||
:logseq.property.class/extends
|
||||
:logseq.property.class/properties})
|
||||
|
||||
(def ^:private page-identity-attrs
|
||||
#{:block/name :block/uuid})
|
||||
|
||||
(def ^:private visibility-attrs
|
||||
#{:block/closed-value-property
|
||||
:logseq.property/built-in?
|
||||
:logseq.property/deleted-at
|
||||
:logseq.property/hide?})
|
||||
|
||||
(def ^:private page-membership-attrs
|
||||
(into page-identity-attrs (conj visibility-attrs :block/tags)))
|
||||
|
||||
(def ^:private comments-attrs
|
||||
#{:block/order
|
||||
:block/tags
|
||||
:logseq.property.comments/blocks
|
||||
:logseq.property/deleted-at})
|
||||
|
||||
(def ^:private children-membership-attrs
|
||||
#{:block/closed-value-property
|
||||
:block/order
|
||||
:block/parent
|
||||
:logseq.property/created-from-property
|
||||
:logseq.property/deleted-at})
|
||||
|
||||
(def ^:private route-candidate-attrs
|
||||
#{:block/page
|
||||
:block/refs
|
||||
:block/tags
|
||||
:block/title
|
||||
:logseq.property/heading})
|
||||
|
||||
(def ^:private bidirectional-property-config-attrs
|
||||
#{:db/ident
|
||||
:db/valueType
|
||||
:logseq.property/classes
|
||||
:logseq.property/deleted-at})
|
||||
|
||||
(def ^:private bidirectional-class-config-attrs
|
||||
#{:block/created-at
|
||||
:block/tags
|
||||
:block/title
|
||||
:logseq.property.class/bidirectional-property-title
|
||||
:logseq.property.class/enable-bidirectional?
|
||||
:logseq.property/built-in?
|
||||
:logseq.property/deleted-at})
|
||||
|
||||
(defn- semantic-datoms
|
||||
[tx-data]
|
||||
(remove #(= :block/tx-id (:a %)) tx-data))
|
||||
|
||||
(defn- entity-at
|
||||
[db entity-id]
|
||||
(when db
|
||||
(d/entity db entity-id)))
|
||||
|
||||
(defn- entity-uuid-at
|
||||
[db entity-id]
|
||||
(:block/uuid (entity-at db entity-id)))
|
||||
|
||||
(defn- ref-uuid-at
|
||||
[db ref-id]
|
||||
(some-> (entity-at db ref-id) :block/uuid))
|
||||
|
||||
(defn- values
|
||||
[value]
|
||||
(cond
|
||||
(nil? value) []
|
||||
(and (coll? value) (not (map? value))) value
|
||||
:else [value]))
|
||||
|
||||
(defn- datom-entity-ids
|
||||
[datoms]
|
||||
(into #{} (map :e) datoms))
|
||||
|
||||
(defn- entity-datoms
|
||||
[datoms]
|
||||
(remove #(= :block/updated-at (:a %)) datoms))
|
||||
|
||||
(defn- tagged-with-ident?
|
||||
[entity ident]
|
||||
(some #(= ident (:db/ident %)) (values (:block/tags entity))))
|
||||
|
||||
(defn- page?
|
||||
[entity]
|
||||
(string? (:block/name entity)))
|
||||
|
||||
(defn- journal?
|
||||
[entity]
|
||||
(or (some? (:block/journal-day entity))
|
||||
(tagged-with-ident? entity :logseq.class/Journal)))
|
||||
|
||||
(defn- class-entity?
|
||||
[entity]
|
||||
(or (seq (:logseq.property.class/extends entity))
|
||||
(= "logseq.class" (some-> entity :db/ident namespace))
|
||||
(tagged-with-ident? entity :logseq.class/Tag)))
|
||||
|
||||
(defn- property-entity?
|
||||
[entity]
|
||||
(or (tagged-with-ident? entity :logseq.class/Property)
|
||||
(when-let [ident (:db/ident entity)]
|
||||
(and (qualified-keyword? ident)
|
||||
(string/includes? (namespace ident) ".property")))))
|
||||
|
||||
(defn- recycled?
|
||||
[entity]
|
||||
(loop [entity entity
|
||||
seen #{}]
|
||||
(let [entity-id (:db/id entity)]
|
||||
(cond
|
||||
(nil? entity) false
|
||||
(:logseq.property/deleted-at entity) true
|
||||
(or (nil? entity-id) (contains? seen entity-id)) false
|
||||
:else (recur (:block/parent entity) (conj seen entity-id))))))
|
||||
|
||||
(defn- entity-before-or-after?
|
||||
[pred db-before db-after entity-id]
|
||||
(or (pred (entity-at db-before entity-id))
|
||||
(pred (entity-at db-after entity-id))))
|
||||
|
||||
(defn- parent-uuid-at
|
||||
[db entity-id]
|
||||
(some-> (entity-at db entity-id) :block/parent :block/uuid))
|
||||
|
||||
(defn- children-keys
|
||||
[db-before db-after datoms]
|
||||
(let [entity-ids (into #{}
|
||||
(comp
|
||||
(filter #(contains? children-membership-attrs (:a %)))
|
||||
(map :e))
|
||||
datoms)]
|
||||
(into #{}
|
||||
(comp
|
||||
(mapcat (fn [entity-id]
|
||||
[(parent-uuid-at db-before entity-id)
|
||||
(parent-uuid-at db-after entity-id)]))
|
||||
(keep (fn [parent-uuid]
|
||||
(when (uuid? parent-uuid)
|
||||
[:children parent-uuid]))))
|
||||
entity-ids)))
|
||||
|
||||
(defn- route-candidate?
|
||||
[entity]
|
||||
(and (some? (:logseq.property/heading entity))
|
||||
(string? (:block/title entity))))
|
||||
|
||||
(defn- route-page-keys
|
||||
[db-before db-after datoms]
|
||||
(let [entity-ids (into #{}
|
||||
(comp
|
||||
(filter #(contains? route-candidate-attrs (:a %)))
|
||||
(map :e)
|
||||
(filter #(entity-before-or-after? route-candidate?
|
||||
db-before
|
||||
db-after
|
||||
%)))
|
||||
datoms)]
|
||||
(into #{}
|
||||
(comp
|
||||
(mapcat (fn [entity-id]
|
||||
[(some-> (entity-at db-before entity-id)
|
||||
:block/page
|
||||
:block/uuid)
|
||||
(some-> (entity-at db-after entity-id)
|
||||
:block/page
|
||||
:block/uuid)]))
|
||||
(keep (fn [page-uuid]
|
||||
(when (uuid? page-uuid)
|
||||
[:route-page page-uuid]))))
|
||||
entity-ids)))
|
||||
|
||||
(defn- entity-keys
|
||||
[db-before db-after entity-ids]
|
||||
(into #{}
|
||||
(comp
|
||||
(mapcat (fn [entity-id]
|
||||
[(entity-uuid-at db-before entity-id)
|
||||
(entity-uuid-at db-after entity-id)]))
|
||||
(keep (fn [entity-uuid]
|
||||
(when (uuid? entity-uuid)
|
||||
[:entity entity-uuid]))))
|
||||
entity-ids))
|
||||
|
||||
(defn- attribute-keys
|
||||
[datoms]
|
||||
(into #{}
|
||||
(mapcat (fn [datom]
|
||||
[[:attr (:a datom)]
|
||||
[:property-membership (:a datom)]]))
|
||||
datoms))
|
||||
|
||||
(defn- page-lookup-keys
|
||||
[datoms]
|
||||
(into #{}
|
||||
(keep (fn [datom]
|
||||
(when (and (contains? page-identity-attrs (:a datom))
|
||||
(or (uuid? (:v datom))
|
||||
(string? (:v datom))))
|
||||
[:page-lookup (:v datom)])))
|
||||
datoms))
|
||||
|
||||
(defn- page-membership-key
|
||||
[db-before db-after datoms]
|
||||
(when (some (fn [datom]
|
||||
(and (contains? page-membership-attrs (:a datom))
|
||||
(or (contains? page-identity-attrs (:a datom))
|
||||
(entity-before-or-after? page?
|
||||
db-before
|
||||
db-after
|
||||
(:e datom)))))
|
||||
datoms)
|
||||
#{[:page-membership]}))
|
||||
|
||||
(defn- journal-key
|
||||
[db-before db-after datoms]
|
||||
(when (some (fn [datom]
|
||||
(or (= :block/journal-day (:a datom))
|
||||
(and (contains? (conj visibility-attrs :block/tags :block/uuid)
|
||||
(:a datom))
|
||||
(entity-before-or-after? journal?
|
||||
db-before
|
||||
db-after
|
||||
(:e datom)))))
|
||||
datoms)
|
||||
#{[:journals]}))
|
||||
|
||||
(defn- recycle-key
|
||||
[datoms]
|
||||
(when (some #(= :logseq.property/deleted-at (:a %)) datoms)
|
||||
#{[:recycle-roots]}))
|
||||
|
||||
(defn- reaction-keys
|
||||
[db-before db-after entity-ids]
|
||||
(into #{}
|
||||
(comp
|
||||
(mapcat (fn [entity-id]
|
||||
[(some-> (entity-at db-before entity-id)
|
||||
:logseq.property.reaction/target
|
||||
:block/uuid)
|
||||
(some-> (entity-at db-after entity-id)
|
||||
:logseq.property.reaction/target
|
||||
:block/uuid)]))
|
||||
(keep (fn [target-uuid]
|
||||
(when (and (uuid? target-uuid)
|
||||
(d/entity db-after [:block/uuid target-uuid]))
|
||||
[:reactions target-uuid]))))
|
||||
entity-ids))
|
||||
|
||||
(defn- comments-keys
|
||||
[db-before db-after datoms]
|
||||
(into #{}
|
||||
(comp
|
||||
(filter #(contains? comments-attrs (:a %)))
|
||||
(map :e)
|
||||
(mapcat (fn [entity-id]
|
||||
(mapcat (fn [db]
|
||||
(let [comments-area (entity-at db entity-id)]
|
||||
(when (tagged-with-ident? comments-area :logseq.class/Comments)
|
||||
(keep (fn [target]
|
||||
(when-let [target-uuid (:block/uuid target)]
|
||||
[:comments target-uuid]))
|
||||
(values (:logseq.property.comments/blocks comments-area))))))
|
||||
[db-before db-after]))))
|
||||
datoms))
|
||||
|
||||
(defn- task-time-keys
|
||||
[db-before db-after entity-ids]
|
||||
(into #{}
|
||||
(comp
|
||||
(mapcat (fn [entity-id]
|
||||
[(some-> (entity-at db-before entity-id)
|
||||
:logseq.property.history/block
|
||||
:block/uuid)
|
||||
(some-> (entity-at db-after entity-id)
|
||||
:logseq.property.history/block
|
||||
:block/uuid)]))
|
||||
(keep (fn [block-uuid]
|
||||
(when (uuid? block-uuid)
|
||||
[:task-time block-uuid]))))
|
||||
entity-ids))
|
||||
|
||||
(defn- status-property?
|
||||
[db entity-id]
|
||||
(= :logseq.property/status (:db/ident (entity-at db entity-id))))
|
||||
|
||||
(defn- status-value?
|
||||
[db entity-id]
|
||||
(when db
|
||||
(or (if (get-in (d/schema db) [:logseq.property/status :db/index])
|
||||
(seq (d/datoms db :avet :logseq.property/status entity-id))
|
||||
(d/q '[:find ?owner .
|
||||
:in $ ?status
|
||||
:where [?owner :logseq.property/status ?status]]
|
||||
db entity-id))
|
||||
(= entity-id
|
||||
(some-> (d/entity db :logseq.property/status)
|
||||
:logseq.property/default-value
|
||||
:db/id)))))
|
||||
|
||||
(defn- class-has-status-property?
|
||||
[db class-id]
|
||||
(let [status-property-id (:db/id (d/entity db :logseq.property/status))]
|
||||
(loop [classes (keep #(entity-at db %) [class-id])
|
||||
seen #{}]
|
||||
(when-let [class (first classes)]
|
||||
(let [class-id (:db/id class)]
|
||||
(if (contains? seen class-id)
|
||||
(recur (rest classes) seen)
|
||||
(or (some #(= status-property-id (:db/id %))
|
||||
(values (:logseq.property.class/properties class)))
|
||||
(recur (concat (rest classes)
|
||||
(values (:logseq.property.class/extends class)))
|
||||
(conj seen class-id)))))))))
|
||||
|
||||
(defn- task-query-changed?
|
||||
[db-before db-after datoms]
|
||||
(some (fn [{:keys [e a v]}]
|
||||
(or (= :logseq.property/status a)
|
||||
(and (= :block/tags a)
|
||||
(or (class-has-status-property? db-before v)
|
||||
(class-has-status-property? db-after v)))
|
||||
(and (= :logseq.property.class/extends a)
|
||||
(or (class-has-status-property? db-before e)
|
||||
(class-has-status-property? db-after e)
|
||||
(class-has-status-property? db-before v)
|
||||
(class-has-status-property? db-after v)))
|
||||
(and (= :logseq.property.class/properties a)
|
||||
(or (status-property? db-before v)
|
||||
(status-property? db-after v)))
|
||||
(and (contains? #{:db/ident
|
||||
:logseq.property/default-value
|
||||
:logseq.property/public?}
|
||||
a)
|
||||
(or (status-property? db-before e)
|
||||
(status-property? db-after e)
|
||||
(status-property? db-before v)
|
||||
(status-property? db-after v)))
|
||||
(and (contains? #{:block/title :logseq.property/value} a)
|
||||
(or (status-value? db-before e)
|
||||
(status-value? db-after e)))))
|
||||
datoms))
|
||||
|
||||
(defn- task-entity?
|
||||
[db entity-id]
|
||||
(when db
|
||||
(or (seq (d/datoms db :eavt entity-id :logseq.property/status))
|
||||
(some #(class-has-status-property? db (:db/id %))
|
||||
(values (:block/tags (entity-at db entity-id)))))))
|
||||
|
||||
(defn- task-attribute-keys
|
||||
[db-before db-after datoms]
|
||||
(reduce-kv
|
||||
(fn [keys entity-id grouped-datoms]
|
||||
(if (or (task-entity? db-before entity-id)
|
||||
(task-entity? db-after entity-id))
|
||||
(into keys (map (fn [datom] [:task-attr (:a datom)])) grouped-datoms)
|
||||
keys))
|
||||
#{}
|
||||
(group-by :e datoms)))
|
||||
|
||||
(defn- display-property-keys
|
||||
[db-before db-after datoms]
|
||||
(into #{}
|
||||
(keep (fn [{:keys [e a]}]
|
||||
(when (or (contains? #{:block/tags
|
||||
:block/closed-value-property}
|
||||
a)
|
||||
(property-entity? (entity-at db-before a))
|
||||
(property-entity? (entity-at db-after a)))
|
||||
(when-let [block-uuid (or (entity-uuid-at db-after e)
|
||||
(entity-uuid-at db-before e))]
|
||||
[:display-properties block-uuid]))))
|
||||
datoms))
|
||||
|
||||
(defn- property-config-changed?
|
||||
[db-before db-after datoms]
|
||||
(some (fn [{:keys [e a]}]
|
||||
(and (contains? property-metadata-attrs a)
|
||||
(entity-before-or-after? property-entity?
|
||||
db-before db-after e)))
|
||||
datoms))
|
||||
|
||||
(defn- enabled-bidirectional-class-ids
|
||||
[source]
|
||||
(into #{}
|
||||
(keep (fn [class]
|
||||
(when (and (tagged-with-ident? class :logseq.class/Tag)
|
||||
(true? (:logseq.property.class/enable-bidirectional? class))
|
||||
(not (:logseq.property/built-in? class))
|
||||
(not (recycled? class)))
|
||||
(:db/id class))))
|
||||
(values (:block/tags source))))
|
||||
|
||||
(defn- bidirectional-property?
|
||||
[db attr enabled-class-ids]
|
||||
(when (and (qualified-keyword? attr)
|
||||
(string/includes? (namespace attr) ".property"))
|
||||
(let [property (entity-at db attr)
|
||||
property-class-ids (into #{} (keep :db/id)
|
||||
(values (:logseq.property/classes property)))]
|
||||
(and (= :db.type/ref (:db/valueType property))
|
||||
(not (recycled? property))
|
||||
(some property-class-ids enabled-class-ids)))))
|
||||
|
||||
(defn- bidirectional-target-uuids
|
||||
[db source-id]
|
||||
(let [source (entity-at db source-id)
|
||||
enabled-class-ids (enabled-bidirectional-class-ids source)]
|
||||
(when (and source
|
||||
(seq enabled-class-ids)
|
||||
(not (recycled? source))
|
||||
(not (tagged-with-ident? source :logseq.class/Tag))
|
||||
(not (tagged-with-ident? source :logseq.class/Property)))
|
||||
(into #{}
|
||||
(comp
|
||||
(filter (fn [[attr _]]
|
||||
(bidirectional-property? db attr enabled-class-ids)))
|
||||
(mapcat (comp values val))
|
||||
(keep (fn [target]
|
||||
(when (and (not= source-id (:db/id target))
|
||||
(not (:logseq.property/created-from-property target)))
|
||||
(:block/uuid target)))))
|
||||
source))))
|
||||
|
||||
(defn- source-ids-for-property
|
||||
[db property-id]
|
||||
(when-let [property-ident (:db/ident (entity-at db property-id))]
|
||||
(into #{} (map :e) (d/datoms db :aevt property-ident))))
|
||||
|
||||
(defn- source-ids-for-class
|
||||
[db class-id]
|
||||
(into #{} (map :e) (d/datoms db :avet :block/tags class-id)))
|
||||
|
||||
(defn- bidirectional-keys
|
||||
[db-before db-after datoms touched-entity-ids]
|
||||
(let [property-ids (into #{}
|
||||
(comp
|
||||
(filter #(contains? bidirectional-property-config-attrs (:a %)))
|
||||
(map :e)
|
||||
(filter #(or (property-entity? (entity-at db-before %))
|
||||
(property-entity? (entity-at db-after %)))))
|
||||
datoms)
|
||||
class-ids (into #{}
|
||||
(comp
|
||||
(filter #(contains? bidirectional-class-config-attrs (:a %)))
|
||||
(map :e)
|
||||
(filter #(or (class-entity? (entity-at db-before %))
|
||||
(class-entity? (entity-at db-after %)))))
|
||||
datoms)
|
||||
source-ids (into touched-entity-ids
|
||||
(concat
|
||||
(mapcat #(source-ids-for-property db-before %) property-ids)
|
||||
(mapcat #(source-ids-for-property db-after %) property-ids)
|
||||
(mapcat #(source-ids-for-class db-before %) class-ids)
|
||||
(mapcat #(source-ids-for-class db-after %) class-ids)))]
|
||||
(into #{}
|
||||
(comp
|
||||
(mapcat (fn [source-id]
|
||||
(concat (bidirectional-target-uuids db-before source-id)
|
||||
(bidirectional-target-uuids db-after source-id))))
|
||||
(keep (fn [target-uuid]
|
||||
(when (uuid? target-uuid)
|
||||
[:bidirectional target-uuid]))))
|
||||
source-ids)))
|
||||
|
||||
(defn- view-key-at
|
||||
[db entity-id]
|
||||
(let [view (entity-at db entity-id)
|
||||
owner-uuid (some-> view :logseq.property/view-for :block/uuid)
|
||||
feature-type (:logseq.property.view/feature-type view)]
|
||||
(when (and (uuid? owner-uuid) (keyword? feature-type))
|
||||
[:views owner-uuid feature-type])))
|
||||
|
||||
(defn- view-keys
|
||||
[db-before db-after entity-ids]
|
||||
(into #{}
|
||||
(mapcat (fn [entity-id]
|
||||
(keep identity [(view-key-at db-before entity-id)
|
||||
(view-key-at db-after entity-id)])))
|
||||
entity-ids))
|
||||
|
||||
(defn- class-membership-keys
|
||||
[db-before db-after datoms]
|
||||
(into #{}
|
||||
(comp
|
||||
(filter #(= :block/tags (:a %)))
|
||||
(mapcat (fn [datom]
|
||||
[(ref-uuid-at db-before (:v datom))
|
||||
(ref-uuid-at db-after (:v datom))]))
|
||||
(keep (fn [class-uuid]
|
||||
(when (uuid? class-uuid)
|
||||
[:class-membership class-uuid]))))
|
||||
datoms))
|
||||
|
||||
(defn- class-tree?
|
||||
[db-before db-after datoms]
|
||||
(some (fn [datom]
|
||||
(or (contains? #{:logseq.property.class/extends
|
||||
:logseq.property.class/properties}
|
||||
(:a datom))
|
||||
(and (contains? #{:block/tags :block/uuid :db/ident} (:a datom))
|
||||
(entity-before-or-after? class-entity?
|
||||
db-before
|
||||
db-after
|
||||
(:e datom)))))
|
||||
datoms))
|
||||
|
||||
(defn- ref-target-keys
|
||||
[db-before db-after datoms]
|
||||
(let [direct-target-uuids
|
||||
(mapcat (fn [datom]
|
||||
(when (= :block/refs (:a datom))
|
||||
[(ref-uuid-at db-before (:v datom))
|
||||
(ref-uuid-at db-after (:v datom))]))
|
||||
datoms)
|
||||
ref-block-uuids
|
||||
(mapcat (fn [datom]
|
||||
(mapcat (fn [db]
|
||||
(map :block/uuid
|
||||
(values (:block/refs (entity-at db (:e datom))))))
|
||||
[db-before db-after]))
|
||||
datoms)]
|
||||
(into #{}
|
||||
(keep (fn [target-uuid]
|
||||
(when (uuid? target-uuid)
|
||||
[:refs target-uuid])))
|
||||
(concat direct-target-uuids ref-block-uuids))))
|
||||
|
||||
(defn affected-keys
|
||||
"Return the exact renderer resource keys affected by `tx-report`."
|
||||
[{:keys [db-before db-after tx-data]}]
|
||||
(let [datoms (vec (semantic-datoms tx-data))
|
||||
touched-entity-ids (datom-entity-ids datoms)
|
||||
changed-entity-ids (datom-entity-ids (entity-datoms datoms))
|
||||
class-tree-changed? (class-tree? db-before db-after datoms)
|
||||
ref-scope-changed? (or class-tree-changed?
|
||||
(some #(= :block/alias (:a %)) datoms))]
|
||||
(into #{}
|
||||
(concat
|
||||
(entity-keys db-before db-after changed-entity-ids)
|
||||
(attribute-keys datoms)
|
||||
(children-keys db-before db-after datoms)
|
||||
(route-page-keys db-before db-after datoms)
|
||||
(page-lookup-keys datoms)
|
||||
(page-membership-key db-before db-after datoms)
|
||||
(journal-key db-before db-after datoms)
|
||||
(recycle-key datoms)
|
||||
(reaction-keys db-before db-after touched-entity-ids)
|
||||
(comments-keys db-before db-after datoms)
|
||||
(task-time-keys db-before db-after touched-entity-ids)
|
||||
(when (task-query-changed? db-before db-after datoms) [[:tasks]])
|
||||
(task-attribute-keys db-before db-after datoms)
|
||||
(display-property-keys db-before db-after datoms)
|
||||
(when (property-config-changed? db-before db-after datoms)
|
||||
[[:property-config]])
|
||||
(bidirectional-keys db-before db-after datoms touched-entity-ids)
|
||||
(view-keys db-before db-after touched-entity-ids)
|
||||
(class-membership-keys db-before db-after datoms)
|
||||
(when class-tree-changed? [[:class-tree]])
|
||||
(ref-target-keys db-before db-after datoms)
|
||||
(when ref-scope-changed? [[:ref-scope]])))))
|
||||
162
src/main/frontend/worker/render_delta.cljs
Normal file
162
src/main/frontend/worker/render_delta.cljs
Normal file
@@ -0,0 +1,162 @@
|
||||
(ns frontend.worker.render-delta
|
||||
"Builds the incremental render delta (block replacements, tombstones, and
|
||||
children patches) published to the renderer after each transaction."
|
||||
(:require [clojure.set :as set]
|
||||
[datascript.core :as d]))
|
||||
|
||||
(def ^:private membership-affecting-attrs
|
||||
#{:block/closed-value-property
|
||||
:block/order
|
||||
:block/parent
|
||||
:logseq.property/created-from-property
|
||||
:logseq.property/deleted-at})
|
||||
|
||||
(defn- fail!
|
||||
[message data]
|
||||
(throw (ex-info message data)))
|
||||
|
||||
(defn- valid-tx-id?
|
||||
[value]
|
||||
(and (integer? value) (not (neg? value))))
|
||||
|
||||
(defn- validate-blocks!
|
||||
[blocks]
|
||||
(when-not (map? blocks)
|
||||
(fail! "Invalid block replacements" {:blocks blocks}))
|
||||
(doseq [[block-uuid block] blocks]
|
||||
(when-not (uuid? block-uuid)
|
||||
(fail! "Invalid block UUID" {:block-uuid block-uuid}))
|
||||
(when-not (map? block)
|
||||
(fail! "Invalid block replacement"
|
||||
{:block-uuid block-uuid :block block}))
|
||||
(when-not (= block-uuid (:block/uuid block))
|
||||
(fail! "Block UUID does not match its key"
|
||||
{:block-uuid block-uuid
|
||||
:replacement-uuid (:block/uuid block)}))
|
||||
(when-not (valid-tx-id? (:block/tx-id block))
|
||||
(fail! "Invalid block transaction ID"
|
||||
{:block-uuid block-uuid
|
||||
:block-tx-id (:block/tx-id block)}))))
|
||||
|
||||
(defn- validate-deleted-block-uuids!
|
||||
[deleted-block-uuids]
|
||||
(when-not (set? deleted-block-uuids)
|
||||
(fail! "Invalid deleted block UUID set"
|
||||
{:deleted-block-uuids deleted-block-uuids}))
|
||||
(doseq [block-uuid deleted-block-uuids]
|
||||
(when-not (uuid? block-uuid)
|
||||
(fail! "Invalid deleted block UUID" {:block-uuid block-uuid}))))
|
||||
|
||||
(defn- validate-input!
|
||||
[{:keys [rev blocks deleted-block-uuids affected-keys tx-report]}]
|
||||
(when-not (valid-tx-id? rev)
|
||||
(fail! "Invalid renderer revision" {:rev rev}))
|
||||
(validate-blocks! blocks)
|
||||
(validate-deleted-block-uuids! deleted-block-uuids)
|
||||
(when-not (set? affected-keys)
|
||||
(fail! "Invalid affected key set" {:affected-keys affected-keys}))
|
||||
(when-not (and (map? tx-report)
|
||||
(:db-before tx-report)
|
||||
(:db-after tx-report)
|
||||
(sequential? (:tx-data tx-report)))
|
||||
(fail! "Invalid transaction report" {:tx-report tx-report}))
|
||||
(when-let [block-uuid (first (set/intersection (set (keys blocks))
|
||||
deleted-block-uuids))]
|
||||
(fail! "Block cannot be replaced and deleted"
|
||||
{:block-uuid block-uuid})))
|
||||
|
||||
(defn- structural-entity-ids
|
||||
[tx-data]
|
||||
(into #{}
|
||||
(keep (fn [datom]
|
||||
(when (contains? membership-affecting-attrs (:a datom))
|
||||
(:e datom))))
|
||||
tx-data))
|
||||
|
||||
(defn- membership-at
|
||||
[db entity-id]
|
||||
(when-let [entity (d/entity db entity-id)]
|
||||
(when-not (or (:block/closed-value-property entity)
|
||||
(:logseq.property/created-from-property entity)
|
||||
(:logseq.property/deleted-at entity))
|
||||
(when-let [parent (:block/parent entity)]
|
||||
(let [block-uuid (:block/uuid entity)
|
||||
parent-uuid (:block/uuid parent)
|
||||
order (:block/order entity)]
|
||||
(when (some? order)
|
||||
(when-not (uuid? block-uuid)
|
||||
(fail! "Invalid child UUID"
|
||||
{:entity-id entity-id :block-uuid block-uuid}))
|
||||
(when-not (uuid? parent-uuid)
|
||||
(fail! "Invalid parent UUID"
|
||||
{:entity-id entity-id :parent-uuid parent-uuid}))
|
||||
{:block-uuid block-uuid
|
||||
:parent-uuid parent-uuid
|
||||
:order order}))))))
|
||||
|
||||
(defn- append-membership-op
|
||||
[operations operation membership]
|
||||
(if membership
|
||||
(update-in operations
|
||||
[(:parent-uuid membership) operation]
|
||||
(fnil conj [])
|
||||
[(:block-uuid membership) (:order membership)])
|
||||
operations))
|
||||
|
||||
(defn- membership-operations
|
||||
[{:keys [db-before db-after tx-data]}]
|
||||
(reduce
|
||||
(fn [operations entity-id]
|
||||
(let [before (membership-at db-before entity-id)
|
||||
after (membership-at db-after entity-id)]
|
||||
(if (= before after)
|
||||
operations
|
||||
(-> operations
|
||||
(append-membership-op :remove before)
|
||||
(append-membership-op :upsert after)))))
|
||||
{}
|
||||
(structural-entity-ids tx-data)))
|
||||
|
||||
(defn- ordered-operations
|
||||
[operations]
|
||||
(->> operations
|
||||
(sort-by (juxt (comp str second) (comp str first)))
|
||||
vec))
|
||||
|
||||
(defn- parent-patch
|
||||
[base-rev rev db-after parent-uuid operations]
|
||||
(when (d/entity db-after [:block/uuid parent-uuid])
|
||||
{:base-rev base-rev
|
||||
:rev rev
|
||||
:remove (ordered-operations (:remove operations))
|
||||
:upsert (ordered-operations (:upsert operations))}))
|
||||
|
||||
(defn- build-children-patches
|
||||
[rev {:keys [db-before db-after] :as tx-report}]
|
||||
(let [base-rev (:max-tx db-before)]
|
||||
(reduce-kv
|
||||
(fn [patches parent-uuid operations]
|
||||
(if-let [patch (parent-patch base-rev rev db-after parent-uuid operations)]
|
||||
(assoc patches parent-uuid patch)
|
||||
patches))
|
||||
{}
|
||||
(membership-operations tx-report))))
|
||||
|
||||
(defn build
|
||||
"Build one renderer delta from complete block replacements and a transaction report."
|
||||
[{:keys [graph-id rev op-id blocks deleted-block-uuids affected-keys tx-report]
|
||||
:as input}]
|
||||
(validate-input! input)
|
||||
{:graph-id graph-id
|
||||
:rev rev
|
||||
:op-id op-id
|
||||
:blocks blocks
|
||||
:deleted (into {}
|
||||
(map (fn [block-uuid]
|
||||
(let [db-id (:e (first (d/datoms (:db-before tx-report)
|
||||
:avet :block/uuid block-uuid)))]
|
||||
[block-uuid (cond-> {:rev rev}
|
||||
db-id (assoc :db/id db-id))])))
|
||||
deleted-block-uuids)
|
||||
:children (build-children-patches rev tx-report)
|
||||
:affected-keys affected-keys})
|
||||
1218
src/main/frontend/worker/search.cljs
Normal file
1218
src/main/frontend/worker/search.cljs
Normal file
File diff suppressed because it is too large
Load Diff
106
src/main/frontend/worker/search_benchmark.cljs
Normal file
106
src/main/frontend/worker/search_benchmark.cljs
Normal file
@@ -0,0 +1,106 @@
|
||||
(ns frontend.worker.search-benchmark
|
||||
"Small benchmark helpers for comparing worker search result quality."
|
||||
(:require [promesa.core :as p]))
|
||||
|
||||
(defn- result-id
|
||||
[result]
|
||||
(if (map? result)
|
||||
(:id result)
|
||||
result))
|
||||
|
||||
(defn- hits-within
|
||||
[result-ids expected-ids k]
|
||||
(let [top-ids (set (take k result-ids))]
|
||||
(count (filter top-ids expected-ids))))
|
||||
|
||||
(defn score-results
|
||||
[results expected-ids top-k]
|
||||
(let [result-ids (mapv result-id results)
|
||||
expected-ids (vec expected-ids)
|
||||
expected-set (set expected-ids)
|
||||
matched-ids (filterv (set result-ids) expected-ids)
|
||||
hits-at-k (hits-within result-ids expected-ids top-k)
|
||||
precision-denominator (min top-k (count expected-ids))
|
||||
precision-at-k (if (pos? precision-denominator)
|
||||
(/ hits-at-k precision-denominator)
|
||||
0)
|
||||
recall (if (seq expected-ids)
|
||||
(/ (count matched-ids) (count expected-ids))
|
||||
0)
|
||||
recall-at-1 (if (seq expected-ids)
|
||||
(/ (hits-within result-ids expected-ids 1) (count expected-ids))
|
||||
0)
|
||||
recall-at-3 (if (seq expected-ids)
|
||||
(/ (hits-within result-ids expected-ids 3) (count expected-ids))
|
||||
0)
|
||||
recall-at-5 (if (seq expected-ids)
|
||||
(/ (hits-within result-ids expected-ids 5) (count expected-ids))
|
||||
0)
|
||||
first-match-rank (some (fn [[idx id]]
|
||||
(when (expected-set id)
|
||||
(inc idx)))
|
||||
(map-indexed vector result-ids))
|
||||
mrr (if first-match-rank
|
||||
(/ 1 first-match-rank)
|
||||
0)
|
||||
f1 (if (pos? (+ precision-at-k recall))
|
||||
(/ (* 2 precision-at-k recall)
|
||||
(+ precision-at-k recall))
|
||||
0)]
|
||||
{:precision-at-k precision-at-k
|
||||
:recall recall
|
||||
:recall-at-1 recall-at-1
|
||||
:recall-at-3 recall-at-3
|
||||
:recall-at-5 recall-at-5
|
||||
:mrr mrr
|
||||
:f1 f1
|
||||
:hits-at-k hits-at-k
|
||||
:matched-ids matched-ids
|
||||
:unmatched-expected-ids (filterv (complement (set matched-ids)) expected-ids)}))
|
||||
|
||||
(defn- run-backend-case
|
||||
[{search :search backend-id :id} {:keys [expected-ids expected-in-top-k] :as benchmark-case}]
|
||||
(let [start (.now js/Date)]
|
||||
(-> (search benchmark-case)
|
||||
(p/then (fn [results]
|
||||
(assoc (score-results results expected-ids (or expected-in-top-k 5))
|
||||
:case-id (:id benchmark-case)
|
||||
:backend-id backend-id
|
||||
:query (:query benchmark-case)
|
||||
:latency-ms (- (.now js/Date) start)
|
||||
:result-ids (mapv result-id results)))))))
|
||||
|
||||
(defn- avg
|
||||
[values]
|
||||
(let [values (vec values)]
|
||||
(if (seq values)
|
||||
(/ (reduce + values) (count values))
|
||||
0)))
|
||||
|
||||
(defn- summarize-backend
|
||||
[results]
|
||||
{:avg-precision-at-k (avg (map :precision-at-k results))
|
||||
:avg-recall (avg (map :recall results))
|
||||
:avg-recall-at-1 (avg (map :recall-at-1 results))
|
||||
:avg-recall-at-3 (avg (map :recall-at-3 results))
|
||||
:avg-recall-at-5 (avg (map :recall-at-5 results))
|
||||
:avg-mrr (avg (map :mrr results))
|
||||
:avg-f1 (avg (map :f1 results))
|
||||
:avg-latency-ms (avg (map :latency-ms results))})
|
||||
|
||||
(defn summarize-results
|
||||
[results]
|
||||
(->> results
|
||||
(group-by :backend-id)
|
||||
(map (fn [[backend-id backend-results]]
|
||||
[backend-id (summarize-backend backend-results)]))
|
||||
(into {})))
|
||||
|
||||
(defn run-benchmark
|
||||
[cases backends]
|
||||
(p/let [results (p/all
|
||||
(for [benchmark-case cases
|
||||
backend backends]
|
||||
(run-backend-case backend benchmark-case)))]
|
||||
{:results (vec results)
|
||||
:summary (summarize-results results)}))
|
||||
393
src/main/frontend/worker/shared_service.cljs
Normal file
393
src/main/frontend/worker/shared_service.cljs
Normal file
@@ -0,0 +1,393 @@
|
||||
(ns frontend.worker.shared-service
|
||||
"This allows multiple workers to share some resources (e.g. db access)"
|
||||
(:require [cljs-bean.core :as bean]
|
||||
[frontend.worker.platform :as platform]
|
||||
[goog.object :as gobj]
|
||||
[lambdaisland.glogi :as log]
|
||||
[logseq.common.util :as common-util]
|
||||
[logseq.db :as ldb]
|
||||
[promesa.core :as p]))
|
||||
|
||||
;; Idea and code copied from https://github.com/Matt-TOTW/shared-service/blob/master/src/sharedService.ts
|
||||
;; Related thread: https://github.com/rhashimoto/wa-sqlite/discussions/81
|
||||
|
||||
(log/set-level 'frontend.worker.shared-service :debug)
|
||||
|
||||
(defonce *master-client? (atom false))
|
||||
|
||||
(defonce *master-re-check-trigger (atom nil))
|
||||
|
||||
;;; common-channel - Communication related to master-client election.
|
||||
;;; client-channel - For API request-response data communication.
|
||||
;;; master-slave-channels - Registered slave channels for master, all the slave
|
||||
;;; channels need to be closed to not receive further
|
||||
;;; messages when the master has been changed to slave.
|
||||
(defonce *common-channel (atom nil))
|
||||
(defonce *client-channel (atom nil))
|
||||
(defonce *master-slave-channels (atom #{}))
|
||||
|
||||
;;; record channel-listener here, to able to remove old listener before we addEventListener new one
|
||||
(defonce *common-channel-listener (atom nil))
|
||||
(defonce *client-channel-listener (atom nil))
|
||||
|
||||
(defonce *current-request-id (volatile! 0))
|
||||
(defonce *requests-in-flight (volatile! (sorted-map))) ;sort by request-id
|
||||
;;; The unique identity of the context where `js/navigator.locks.request` is called
|
||||
(defonce *client-id (atom nil))
|
||||
(defonce *master-client-lock (atom nil))
|
||||
|
||||
(defn- node-runtime?
|
||||
[]
|
||||
(try
|
||||
(= :node (platform/env-flag (platform/current) :runtime))
|
||||
(catch :default _ false)))
|
||||
|
||||
(defn- next-request-id
|
||||
[]
|
||||
(vswap! *current-request-id inc))
|
||||
|
||||
(defn- release-master-client-lock!
|
||||
[]
|
||||
(when-let [d @*master-client-lock]
|
||||
(p/resolve! d)
|
||||
nil))
|
||||
|
||||
(defn- get-broadcast-channel-name [client-id service-name]
|
||||
(str client-id "-" service-name))
|
||||
|
||||
(defn- random-id
|
||||
[]
|
||||
(str (random-uuid)))
|
||||
|
||||
(defn- do-not-wait
|
||||
[promise]
|
||||
promise
|
||||
nil)
|
||||
|
||||
(defn- <get-client-id
|
||||
[]
|
||||
(let [id (random-id)]
|
||||
(p/let [client-id (js/navigator.locks.request id #js {:mode "exclusive"}
|
||||
(fn [_]
|
||||
(p/let [^js locks (js/navigator.locks.query)]
|
||||
(->> (.-held locks)
|
||||
(some #(when (= (.-name %) id) %))
|
||||
.-clientId))))]
|
||||
(assert (some? client-id))
|
||||
(do-not-wait
|
||||
(js/navigator.locks.request client-id #js {:mode "exclusive"}
|
||||
;; never release it
|
||||
(fn [_] (p/deferred))))
|
||||
(log/debug :client-id client-id)
|
||||
client-id)))
|
||||
|
||||
(defn- <ensure-client-id
|
||||
[]
|
||||
(or @*client-id
|
||||
(p/let [client-id (<get-client-id)]
|
||||
(reset! *client-id client-id))))
|
||||
|
||||
(defn- ensure-common-channel
|
||||
[service-name]
|
||||
(or @*common-channel
|
||||
(reset! *common-channel (js/BroadcastChannel. (str "shared-service-common-channel-" service-name)))))
|
||||
|
||||
(defn- ensure-client-channel
|
||||
[slave-client-id service-name]
|
||||
(or @*client-channel
|
||||
(reset! *client-channel (js/BroadcastChannel. (get-broadcast-channel-name slave-client-id service-name)))))
|
||||
|
||||
(defn- listen-common-channel
|
||||
[common-channel listener-fn]
|
||||
(when-let [old-listener @*common-channel-listener]
|
||||
(.removeEventListener common-channel "message" old-listener))
|
||||
(reset! *common-channel-listener listener-fn)
|
||||
(.addEventListener common-channel "message" listener-fn))
|
||||
|
||||
(defn- listen-client-channel
|
||||
[client-channel listener-fn]
|
||||
(when-let [old-listener @*client-channel-listener]
|
||||
(.removeEventListener client-channel "message" old-listener))
|
||||
(reset! *client-channel-listener listener-fn)
|
||||
(.addEventListener client-channel "message" listener-fn))
|
||||
|
||||
(defn- <apply-target-f!
|
||||
[target method args]
|
||||
(let [f (gobj/get target method)]
|
||||
(assert (some? f) {:method method})
|
||||
(apply f args)))
|
||||
|
||||
(defn- <check-master-or-slave-client!
|
||||
"Check if the current client is the master (otherwise, it is a slave)"
|
||||
[service-name <on-become-master <on-become-slave]
|
||||
(p/let [client-id (<ensure-client-id)]
|
||||
(do-not-wait
|
||||
(js/navigator.locks.request
|
||||
service-name #js {:mode "exclusive", :ifAvailable true}
|
||||
(fn [lock]
|
||||
(p/let [^js locks (js/navigator.locks.query)
|
||||
locked? (some #(when (and (= (.-name %) service-name)
|
||||
(= (.-clientId %) client-id))
|
||||
true)
|
||||
(.-held locks))]
|
||||
(cond
|
||||
(and locked? lock) ;become master
|
||||
(p/do!
|
||||
(reset! *master-client? true)
|
||||
(<on-become-master)
|
||||
(reset! *master-client-lock (p/deferred))
|
||||
;; Keep lock until context destroyed
|
||||
@*master-client-lock)
|
||||
|
||||
(and locked? (nil? lock)) ;already locked by this client, do nothing
|
||||
(assert (true? @*master-client?))
|
||||
|
||||
(not locked?) ;become slave
|
||||
(p/do!
|
||||
(reset! *master-client? false)
|
||||
(<on-become-slave)))))))))
|
||||
|
||||
(defn- clear-old-service!
|
||||
[]
|
||||
(release-master-client-lock!)
|
||||
(reset! *master-client? false)
|
||||
(let [channels (into @*master-slave-channels [@*common-channel @*client-channel])]
|
||||
(doseq [^js channel channels]
|
||||
(when channel
|
||||
(.close channel))))
|
||||
(reset! *common-channel nil)
|
||||
(reset! *client-channel nil)
|
||||
(reset! *master-slave-channels #{})
|
||||
(reset! *common-channel-listener nil)
|
||||
(reset! *client-channel-listener nil)
|
||||
(vreset! *requests-in-flight (sorted-map))
|
||||
(remove-watch *master-re-check-trigger :check-master))
|
||||
|
||||
(defn- on-response-handler
|
||||
[event]
|
||||
(let [{:keys [id type error result]} (bean/->clj (.-data event))]
|
||||
(when (identical? "response" type)
|
||||
(when-let [{:keys [resolve-fn reject-fn]} (get @*requests-in-flight id)]
|
||||
(vswap! *requests-in-flight dissoc id)
|
||||
(if error
|
||||
(do (log/error :error-process-request error)
|
||||
(reject-fn error))
|
||||
(resolve-fn result))))))
|
||||
|
||||
(defn- create-on-request-handler
|
||||
[client-channel target]
|
||||
(fn [event]
|
||||
(let [{:keys [type method args id]} (bean/->clj (.-data event))]
|
||||
(when (identical? "request" type)
|
||||
(p/let [[result error]
|
||||
(-> (p/then (<apply-target-f! target method args)
|
||||
(fn [res] [res nil]))
|
||||
(p/catch
|
||||
(fn [e] [nil (if (instance? js/Error e)
|
||||
(bean/->clj e)
|
||||
e)])))]
|
||||
(.postMessage client-channel (bean/->js
|
||||
{:id id
|
||||
:type "response"
|
||||
:result result
|
||||
:error error
|
||||
:method-key (first args)})))))))
|
||||
|
||||
(defn- <slave-registered-handler
|
||||
[service-name slave-client-id event *register-finish-promise?]
|
||||
(let [slave-client-id* (:slave-client-id event)]
|
||||
(when (= slave-client-id slave-client-id*)
|
||||
(p/let [^js locks (js/navigator.locks.query)
|
||||
already-watching?
|
||||
(some
|
||||
(fn [l] (and (= service-name (.-name l))
|
||||
(= slave-client-id (.-clientId l))))
|
||||
(.-pending locks))]
|
||||
(when-not already-watching? ;dont watch multiple times
|
||||
(do-not-wait
|
||||
(js/navigator.locks.request service-name #js {:mode "exclusive"}
|
||||
(fn [_lock]
|
||||
;; The master has gone, elect the new master
|
||||
(log/debug "master has gone" nil)
|
||||
(reset! *master-re-check-trigger :re-check)))))
|
||||
(p/resolve! @*register-finish-promise?)))))
|
||||
|
||||
(defn- <re-requests-in-flight-on-slave!
|
||||
[client-channel]
|
||||
(when (seq @*requests-in-flight)
|
||||
(log/debug "Requests were in flight when master changed. Requeuing..." (count @*requests-in-flight))
|
||||
(->>
|
||||
@*requests-in-flight
|
||||
(p/run!
|
||||
(fn [[id {:keys [method args _resolve-fn _reject-fn]}]]
|
||||
(.postMessage client-channel (bean/->js {:id id
|
||||
:type "request"
|
||||
:method method
|
||||
:args args})))))))
|
||||
|
||||
(defn- <re-requests-in-flight-on-master!
|
||||
[target]
|
||||
(when (seq @*requests-in-flight)
|
||||
(log/debug "Requests were in flight when tab became master. Requeuing..." (count @*requests-in-flight))
|
||||
(->>
|
||||
@*requests-in-flight
|
||||
(p/run!
|
||||
(fn [[id {:keys [method args resolve-fn reject-fn]}]]
|
||||
(->
|
||||
(p/let [result (<apply-target-f! target method args)]
|
||||
(resolve-fn result))
|
||||
(p/catch (fn [e]
|
||||
(log/error "Error processing request" e)
|
||||
(reject-fn e)))
|
||||
(p/finally (fn []
|
||||
(vswap! *requests-in-flight dissoc id)))))))))
|
||||
|
||||
(defn- <on-become-slave
|
||||
[slave-client-id service-name common-channel broadcast-data-types status-ready-promise]
|
||||
(let [client-channel (ensure-client-channel slave-client-id service-name)
|
||||
*register-finish-promise? (atom nil)
|
||||
<register #(do (.postMessage common-channel #js {:type "slave-register"
|
||||
:slave-client-id slave-client-id})
|
||||
(reset! *register-finish-promise? (p/deferred))
|
||||
@*register-finish-promise?)]
|
||||
(listen-client-channel client-channel on-response-handler)
|
||||
(listen-common-channel
|
||||
common-channel
|
||||
(fn [event]
|
||||
(let [{:keys [type data] :as event*} (bean/->clj (.-data event))]
|
||||
(if (contains? broadcast-data-types type)
|
||||
(.postMessage js/self data)
|
||||
(case type
|
||||
"master-changed"
|
||||
(p/do!
|
||||
(log/debug "master-client change detected. Re-registering..." nil)
|
||||
(<register)
|
||||
(<re-requests-in-flight-on-slave! client-channel))
|
||||
"slave-registered"
|
||||
(<slave-registered-handler service-name slave-client-id event* *register-finish-promise?)
|
||||
|
||||
"slave-register"
|
||||
(log/debug :ignored-event event*)
|
||||
|
||||
(log/error :unknown-event event*))))))
|
||||
(->
|
||||
(p/do!
|
||||
(<register)
|
||||
(p/resolve! status-ready-promise))
|
||||
(p/catch (fn [e]
|
||||
(log/error :on-become-slave e)
|
||||
(p/rejected e))))))
|
||||
|
||||
(defn- <on-become-master
|
||||
[master-client-id service-name common-channel target on-become-master-handler status-ready-deferred-p]
|
||||
(log/debug :become-master master-client-id :service service-name)
|
||||
(listen-common-channel
|
||||
common-channel
|
||||
(fn [event]
|
||||
(let [{:keys [slave-client-id type]} (bean/->clj (.-data event))]
|
||||
(when (= type "slave-register")
|
||||
(let [client-channel (js/BroadcastChannel. (get-broadcast-channel-name slave-client-id service-name))]
|
||||
(swap! *master-slave-channels conj client-channel)
|
||||
(do-not-wait
|
||||
(js/navigator.locks.request slave-client-id #js {:mode "exclusive"}
|
||||
(fn [_]
|
||||
(log/debug :slave-has-gone slave-client-id)
|
||||
(.close client-channel))))
|
||||
(listen-client-channel client-channel (create-on-request-handler client-channel target))
|
||||
(.postMessage common-channel (bean/->js {:type "slave-registered"
|
||||
:slave-client-id slave-client-id
|
||||
:master-client-id master-client-id
|
||||
:serviceName service-name})))))))
|
||||
(.postMessage common-channel #js {:type "master-changed"
|
||||
:master-client-id master-client-id
|
||||
:serviceName service-name})
|
||||
(->
|
||||
(p/do!
|
||||
(on-become-master-handler service-name)
|
||||
(<re-requests-in-flight-on-master! target))
|
||||
(p/finally
|
||||
(fn []
|
||||
(p/resolve! status-ready-deferred-p)))))
|
||||
|
||||
(defn <create-service
|
||||
"broadcast-data-types - For data matching these types,
|
||||
forward the data broadcast from the master client directly to the UI thread."
|
||||
[service-name target on-become-master-handler broadcast-data-types {:keys [import?]}]
|
||||
(clear-old-service!)
|
||||
(if (node-runtime?)
|
||||
(p/do!
|
||||
(reset! *master-client? true)
|
||||
(reset! *client-id "node")
|
||||
(p/let [status {:ready (p/deferred)}]
|
||||
(p/do!
|
||||
(on-become-master-handler service-name)
|
||||
(p/resolve! (:ready status)))
|
||||
{:proxy #js {"remoteInvoke"
|
||||
(fn [args]
|
||||
(<apply-target-f! target "remoteInvoke" args))}
|
||||
:status status
|
||||
:client-id @*client-id}))
|
||||
(do
|
||||
(when import? (reset! *master-client? true))
|
||||
(p/let [broadcast-data-types (set broadcast-data-types)
|
||||
status {:ready (p/deferred)}
|
||||
common-channel (ensure-common-channel service-name)
|
||||
client-id (<ensure-client-id)
|
||||
<check-master-slave-fn!
|
||||
(fn []
|
||||
(<check-master-or-slave-client!
|
||||
service-name
|
||||
#(<on-become-master
|
||||
client-id service-name common-channel target
|
||||
on-become-master-handler (:ready status))
|
||||
#(<on-become-slave
|
||||
client-id service-name common-channel broadcast-data-types (:ready status))))]
|
||||
(<check-master-slave-fn!)
|
||||
(log/info :shared-service/create-client {:service service-name
|
||||
:client-id client-id
|
||||
:import? import?})
|
||||
|
||||
(add-watch *master-re-check-trigger :check-master
|
||||
(fn [_ _ _ new-value]
|
||||
(when (= new-value :re-check)
|
||||
(p/do!
|
||||
(p/delay 100) ; why need delay here?
|
||||
(<check-master-slave-fn!)))))
|
||||
|
||||
{:proxy (js/Proxy. target
|
||||
#js {:get (fn [target method]
|
||||
(if (= "remoteInvoke" method)
|
||||
(fn [args]
|
||||
(cond
|
||||
@*master-client?
|
||||
(<apply-target-f! target method args)
|
||||
|
||||
:else
|
||||
(let [request-id (next-request-id)
|
||||
client-channel (ensure-client-channel client-id service-name)]
|
||||
(p/create
|
||||
(fn [resolve-fn reject-fn]
|
||||
(vswap! *requests-in-flight assoc request-id {:method method
|
||||
:args args
|
||||
:resolve-fn resolve-fn
|
||||
:reject-fn reject-fn})
|
||||
(.postMessage client-channel (bean/->js
|
||||
{:id request-id
|
||||
:type "request"
|
||||
:method method
|
||||
:args args})))))))
|
||||
(log/error :invalid-invoke-method method)))})
|
||||
:status status
|
||||
:client-id client-id}))))
|
||||
|
||||
(defn broadcast-to-clients!
|
||||
[type' data]
|
||||
(let [transit-payload (ldb/write-transit-str [type' data])]
|
||||
(if (node-runtime?)
|
||||
(platform/post-message! (platform/current) type' transit-payload)
|
||||
(do
|
||||
(when (exists? js/self) (.postMessage js/self transit-payload))
|
||||
(when-let [common-channel @*common-channel]
|
||||
(let [str-type' (common-util/keyword->string type')]
|
||||
(.postMessage common-channel #js {:type str-type'
|
||||
:data transit-payload})))))))
|
||||
148
src/main/frontend/worker/state.cljs
Normal file
148
src/main/frontend/worker/state.cljs
Normal file
@@ -0,0 +1,148 @@
|
||||
(ns frontend.worker.state
|
||||
"State hub for worker"
|
||||
(:require [frontend.worker.platform :as platform]
|
||||
[logseq.common.util :as common-util]
|
||||
[promesa.core :as p]))
|
||||
|
||||
(defonce *main-thread (atom nil))
|
||||
(defonce *deleted-block-uuid->db-id (atom {}))
|
||||
|
||||
(defn <invoke-main-thread
|
||||
[qkw & args]
|
||||
(if-let [main-thread @*main-thread]
|
||||
(apply main-thread qkw args)
|
||||
(p/rejected (ex-info "main thread is not available in db-worker"
|
||||
{:method qkw}))))
|
||||
|
||||
(defonce *state (atom {:db/latest-transact-time {}
|
||||
:worker/context {}
|
||||
|
||||
;; FIXME: this name :config is too general
|
||||
:config {}
|
||||
:git/current-repo nil
|
||||
|
||||
:auth/id-token nil
|
||||
:auth/access-token nil
|
||||
:auth/refresh-token nil
|
||||
:auth/oauth-token-url nil
|
||||
:auth/oauth-domain nil
|
||||
:auth/oauth-client-id nil
|
||||
|
||||
:user/info nil
|
||||
;; thread atoms, these atoms' value are syncing from ui-thread
|
||||
:thread-atom/online-event (atom nil)
|
||||
:thread-atom/search-input-idle-status (atom {})}))
|
||||
|
||||
(def ^:private db-sync-config-auth-keys
|
||||
#{:auth-token :oauth-token-url :oauth-domain :oauth-client-id})
|
||||
|
||||
(defn non-auth-db-sync-config
|
||||
[config]
|
||||
(apply dissoc (or config {}) db-sync-config-auth-keys))
|
||||
|
||||
(defonce *db-sync-config (atom {:ws-url nil}))
|
||||
(defonce *db-sync-client (atom nil))
|
||||
|
||||
(defonce *sqlite (atom nil))
|
||||
;; repo -> {:db conn :search conn :client-ops conn}
|
||||
(defonce *sqlite-conns (atom {}))
|
||||
;; repo -> platform vector search index
|
||||
(defonce *vector-indexes (atom {}))
|
||||
;; repo -> conn
|
||||
(defonce *datascript-conns (atom nil))
|
||||
|
||||
;; repo -> conn
|
||||
(defonce *client-ops-conns (atom nil))
|
||||
|
||||
;; repo -> pool
|
||||
(defonce *opfs-pools (atom nil))
|
||||
|
||||
;;; ================================================================
|
||||
(defn get-sqlite-conn
|
||||
([repo] (get-sqlite-conn repo :db))
|
||||
([repo which-db]
|
||||
(assert (contains? #{:db :search :client-ops} which-db) which-db)
|
||||
(get-in @*sqlite-conns [repo which-db])))
|
||||
|
||||
(defn get-vector-index
|
||||
[repo]
|
||||
(get @*vector-indexes repo))
|
||||
|
||||
(defn get-datascript-conn
|
||||
[repo]
|
||||
(get @*datascript-conns repo))
|
||||
|
||||
(defn get-client-ops-conn
|
||||
[repo]
|
||||
(get @*client-ops-conns repo))
|
||||
|
||||
(defn get-opfs-pool
|
||||
[repo]
|
||||
(get @*opfs-pools repo))
|
||||
|
||||
(defn set-db-latest-tx-time!
|
||||
[repo]
|
||||
(swap! *state assoc-in [:db/latest-transact-time repo] (common-util/time-ms)))
|
||||
|
||||
(defn get-context
|
||||
[]
|
||||
(:worker/context @*state))
|
||||
|
||||
(defn set-context!
|
||||
[context]
|
||||
(swap! *state assoc :worker/context context))
|
||||
|
||||
(defn update-context!
|
||||
[context]
|
||||
(swap! *state update :worker/context
|
||||
(fn [c]
|
||||
(merge c context))))
|
||||
|
||||
(defn get-current-repo
|
||||
[]
|
||||
(:git/current-repo @*state))
|
||||
|
||||
(defn set-new-state!
|
||||
[new-state]
|
||||
(swap! *state (fn [old-state]
|
||||
(merge old-state new-state))))
|
||||
|
||||
(defn get-id-token
|
||||
[]
|
||||
(:auth/id-token @*state))
|
||||
|
||||
(defn- node-runtime?
|
||||
[]
|
||||
(try
|
||||
(= :node (get-in (platform/current) [:env :runtime]))
|
||||
(catch :default _
|
||||
false)))
|
||||
|
||||
(defn- node-online?
|
||||
[]
|
||||
(try
|
||||
(let [online? (some-> js/globalThis .-navigator .-onLine)]
|
||||
(if (boolean? online?)
|
||||
online?
|
||||
true))
|
||||
(catch :default _
|
||||
true)))
|
||||
|
||||
(defn online?
|
||||
[]
|
||||
(if (node-runtime?)
|
||||
(node-online?)
|
||||
(not (false? @(:thread-atom/online-event @*state)))))
|
||||
|
||||
(comment
|
||||
(defn mobile?
|
||||
[]
|
||||
(:mobile? (get-context))))
|
||||
|
||||
;;; ========================== mobile log ======================================
|
||||
(defonce *log (atom []))
|
||||
(defn log-append!
|
||||
[record]
|
||||
(swap! *log conj record)
|
||||
(when (> (count @*log) 1000)
|
||||
(reset! *log (subvec @*log 800))))
|
||||
465
src/main/frontend/worker/sync.cljs
Normal file
465
src/main/frontend/worker/sync.cljs
Normal file
@@ -0,0 +1,465 @@
|
||||
(ns frontend.worker.sync
|
||||
"Sync client"
|
||||
(:require
|
||||
[frontend.worker.platform :as platform]
|
||||
[frontend.worker.shared-service :as shared-service]
|
||||
[frontend.worker.state :as worker-state]
|
||||
[frontend.worker.sync.apply-txs :as sync-apply]
|
||||
[frontend.worker.sync.assets :as sync-assets]
|
||||
[frontend.worker.sync.auth :as sync-auth]
|
||||
[frontend.worker.sync.client-op :as client-op]
|
||||
[frontend.worker.sync.handle-message :as sync-handle-message]
|
||||
[frontend.worker.sync.presence :as sync-presence]
|
||||
[frontend.worker.sync.transport :as sync-transport]
|
||||
[frontend.worker.sync.upload :as sync-upload]
|
||||
[frontend.worker.sync.util :as sync-util]
|
||||
[lambdaisland.glogi :as log]
|
||||
[logseq.common.util :as common-util]
|
||||
[logseq.db-sync.checksum :as sync-checksum]
|
||||
[promesa.core :as p]
|
||||
[logseq.common.config :as common-config]))
|
||||
|
||||
(def ^:private reconnect-base-delay-ms 1000)
|
||||
(def ^:private reconnect-max-delay-ms 30000)
|
||||
(def ^:private reconnect-jitter-ms 250)
|
||||
(def ^:private ws-stale-kill-interval-ms 60000)
|
||||
(def ^:private ws-stale-timeout-ms 600000)
|
||||
(def fail-fast sync-util/fail-fast)
|
||||
|
||||
(defonce *repo->latest-remote-tx sync-apply/*repo->latest-remote-tx)
|
||||
(defonce *repo->latest-remote-checksum sync-apply/*repo->latest-remote-checksum)
|
||||
(defonce *start-inflight-target (atom nil))
|
||||
|
||||
(defn- current-client
|
||||
[repo]
|
||||
(sync-presence/current-client worker-state/*db-sync-client repo))
|
||||
|
||||
(defn status
|
||||
[repo]
|
||||
(sync-presence/sync-counts
|
||||
{:get-datascript-conn worker-state/get-datascript-conn
|
||||
:get-client-ops-conn worker-state/get-client-ops-conn
|
||||
:get-pending-local-tx-count client-op/get-pending-local-tx-count
|
||||
:get-unpushed-asset-ops-count client-op/get-unpushed-asset-ops-count
|
||||
:get-missing-asset-upload-files sync-assets/get-missing-asset-upload-files
|
||||
:get-local-tx client-op/get-local-tx
|
||||
:get-local-checksum client-op/get-local-checksum
|
||||
:get-graph-uuid client-op/get-graph-uuid
|
||||
:latest-remote-tx @*repo->latest-remote-tx
|
||||
:latest-remote-checksum @*repo->latest-remote-checksum}
|
||||
repo))
|
||||
|
||||
(defn update-local-sync-checksum!
|
||||
[repo tx-report]
|
||||
(when (worker-state/get-client-ops-conn repo)
|
||||
(let [current-checksum (client-op/get-local-checksum repo)
|
||||
new-checksum (sync-checksum/update-checksum current-checksum tx-report)]
|
||||
(when (and (exists? js/process)
|
||||
(= "1" (aget (.-env js/process) "LOGSEQ_CHECKSUM_ASSERT")))
|
||||
(let [recomputed-checksum (sync-checksum/recompute-checksum (:db-after tx-report))]
|
||||
(when-not (= new-checksum recomputed-checksum)
|
||||
(let [{:keys [tx-meta tx-data]} tx-report]
|
||||
(log/error :db-sync/checksum-incremental-drift
|
||||
{:repo repo
|
||||
:current-checksum current-checksum
|
||||
:incremental-checksum new-checksum
|
||||
:recomputed-checksum recomputed-checksum
|
||||
:tx-meta tx-meta
|
||||
:tx-count (count tx-data)
|
||||
:tx-sample (take 30 tx-data)})
|
||||
(throw (ex-info "Incremental checksum drift"
|
||||
{:repo repo
|
||||
:current-checksum current-checksum
|
||||
:incremental-checksum new-checksum
|
||||
:recomputed-checksum recomputed-checksum
|
||||
:tx-meta tx-meta
|
||||
:tx-count (count tx-data)}))))))
|
||||
(client-op/update-local-checksum repo new-checksum))))
|
||||
|
||||
(defn- broadcast-rtc-state!
|
||||
[client]
|
||||
(when client
|
||||
(shared-service/broadcast-to-clients!
|
||||
:rtc-sync-state
|
||||
(sync-presence/rtc-state-payload status client))))
|
||||
|
||||
(defn- set-ws-state!
|
||||
[client ws-state]
|
||||
(sync-presence/set-ws-state! broadcast-rtc-state! client ws-state))
|
||||
|
||||
(defn- update-online-users!
|
||||
[client users]
|
||||
(sync-presence/update-online-users! broadcast-rtc-state! client users))
|
||||
|
||||
(defn- clear-inflight!
|
||||
[client]
|
||||
(when-let [*inflight (:inflight client)]
|
||||
(reset! *inflight [])))
|
||||
|
||||
(defn- ws-base-url
|
||||
[]
|
||||
(sync-auth/ws-base-url @worker-state/*db-sync-config))
|
||||
|
||||
(def auth-token sync-util/auth-token)
|
||||
|
||||
(def id-token-expired? sync-auth/id-token-expired?)
|
||||
|
||||
(def <resolve-ws-token sync-auth/<resolve-ws-token)
|
||||
|
||||
(defn- ensure-client-graph-uuid!
|
||||
[repo graph-id]
|
||||
(when (seq graph-id)
|
||||
(client-op/update-graph-uuid repo graph-id)))
|
||||
|
||||
(defn- client-op-ready?
|
||||
[repo]
|
||||
(and (some? (worker-state/get-client-ops-conn repo))
|
||||
(integer? (client-op/get-local-tx repo))))
|
||||
|
||||
(defn- reconnect-delay-ms
|
||||
[attempt]
|
||||
(sync-transport/reconnect-delay-ms
|
||||
attempt
|
||||
{:base-delay-ms reconnect-base-delay-ms
|
||||
:max-delay-ms reconnect-max-delay-ms
|
||||
:jitter-ms reconnect-jitter-ms}))
|
||||
|
||||
(defn- clear-reconnect-timer!
|
||||
[reconnect]
|
||||
(when-let [timer (:timer @reconnect)]
|
||||
(js/clearTimeout timer)
|
||||
(swap! reconnect assoc :timer nil)))
|
||||
|
||||
(defn- reset-reconnect!
|
||||
[client]
|
||||
(when-let [reconnect (:reconnect client)]
|
||||
(clear-reconnect-timer! reconnect)
|
||||
(swap! reconnect assoc :attempt 0)))
|
||||
|
||||
(defn- clear-stale-ws-loop-timer!
|
||||
[client]
|
||||
(when-let [*timer (:stale-kill-timer client)]
|
||||
(when-let [timer @*timer]
|
||||
(js/clearInterval timer)
|
||||
(reset! *timer nil))))
|
||||
|
||||
(defn- touch-last-ws-message!
|
||||
[client]
|
||||
(when-let [*ts (:last-ws-message-ts client)]
|
||||
(reset! *ts (common-util/time-ms))))
|
||||
|
||||
(defn- ready-state
|
||||
[ws]
|
||||
(sync-transport/ready-state ws))
|
||||
|
||||
(defn- ws-open?
|
||||
[ws]
|
||||
(sync-transport/ws-open? ws))
|
||||
|
||||
(defn- send!
|
||||
[ws message]
|
||||
(sync-transport/send! sync-transport/coerce-ws-client-message ws message))
|
||||
|
||||
(defn- enqueue-receive-message!
|
||||
[client task]
|
||||
(if-let [queue (:receive-queue client)]
|
||||
(swap! queue
|
||||
(fn [prev]
|
||||
(-> (or prev (p/resolved nil))
|
||||
;; Keep queue alive even if one message handler fails.
|
||||
(p/catch (fn [_] nil))
|
||||
(p/then (fn [_] (task)))
|
||||
(p/catch (fn [error]
|
||||
(sync-util/set-last-sync-error! client error)
|
||||
(log/error :db-sync/ws-handle-message-failed
|
||||
{:repo (:repo client)
|
||||
:error error}))))))
|
||||
(task)))
|
||||
|
||||
(defn update-presence!
|
||||
[editing-block-uuid]
|
||||
(when-let [client @worker-state/*db-sync-client]
|
||||
(when-let [ws (:ws client)]
|
||||
(send! ws {:type "presence"
|
||||
:editing-block-uuid editing-block-uuid}))))
|
||||
|
||||
(defn- enqueue-asset-task!
|
||||
[client task]
|
||||
(when-let [queue (:asset-queue client)]
|
||||
(swap! queue
|
||||
(fn [prev]
|
||||
(p/then prev (fn [_] (task)))))))
|
||||
|
||||
(defn- ensure-client-state!
|
||||
[repo]
|
||||
{:repo repo
|
||||
:send-queue (atom (p/resolved nil))
|
||||
:receive-queue (atom (p/resolved nil))
|
||||
:asset-queue (atom (p/resolved nil))
|
||||
:pending-pull-since (atom nil)
|
||||
:inflight (atom [])
|
||||
:upload-request (atom nil)
|
||||
:last-sync-error (atom nil)
|
||||
:reconnect (atom {:attempt 0 :timer nil})
|
||||
:stale-kill-timer (atom nil)
|
||||
:last-ws-message-ts (atom (common-util/time-ms))
|
||||
:online-users (atom [])
|
||||
:ws-state (atom :closed)})
|
||||
|
||||
(declare connect!)
|
||||
|
||||
(defn- schedule-reconnect!
|
||||
[repo client url reason]
|
||||
(when-let [reconnect (:reconnect client)]
|
||||
(let [{:keys [attempt timer]} @reconnect]
|
||||
(when (nil? timer)
|
||||
(let [delay (reconnect-delay-ms attempt)
|
||||
timeout-id (js/setTimeout
|
||||
(fn []
|
||||
(log/info :db-sync/ws-reconnect {:repo repo
|
||||
:db-sync-client-exists? (some? @worker-state/*db-sync-client)})
|
||||
(swap! reconnect assoc :timer nil)
|
||||
(when-let [current @worker-state/*db-sync-client]
|
||||
(when (and (= (:repo current) repo)
|
||||
(= (:graph-id current) (:graph-id client)))
|
||||
(-> (p/let [token (<resolve-ws-token)
|
||||
updated (connect! repo current url token)]
|
||||
(reset! worker-state/*db-sync-client updated))
|
||||
(p/catch (fn [error]
|
||||
(log/error :db-sync/ws-reconnect-failed {:repo repo :error error})
|
||||
(schedule-reconnect! repo current url :connect-failed)))))))
|
||||
delay)]
|
||||
(swap! reconnect assoc :timer timeout-id :attempt (inc attempt))
|
||||
(log/info :db-sync/ws-reconnect-scheduled
|
||||
{:repo repo :delay delay :attempt attempt :reason reason}))))))
|
||||
|
||||
(defn- attach-ws-handlers!
|
||||
[repo client ws url]
|
||||
(set! (.-onmessage ws)
|
||||
(fn [event]
|
||||
(touch-last-ws-message! client)
|
||||
(enqueue-receive-message! client
|
||||
(fn []
|
||||
(sync-handle-message/handle-message! repo client (.-data event))))))
|
||||
(set! (.-onerror ws) (fn [error] (log/error :db-sync/ws-error error)))
|
||||
(set! (.-onclose ws)
|
||||
(fn [_]
|
||||
(log/info :db-sync/ws-closed {:repo repo})
|
||||
(clear-stale-ws-loop-timer! client)
|
||||
(clear-inflight! client)
|
||||
(update-online-users! client [])
|
||||
(set-ws-state! client :closed)
|
||||
(schedule-reconnect! repo client url :close))))
|
||||
|
||||
(defn- detach-ws-handlers!
|
||||
[ws]
|
||||
(set! (.-onopen ws) nil)
|
||||
(set! (.-onmessage ws) nil)
|
||||
(set! (.-onerror ws) nil)
|
||||
(set! (.-onclose ws) nil))
|
||||
|
||||
(defn- close-stale-ws-loop
|
||||
[client ws url]
|
||||
(let [repo (:repo client)
|
||||
graph-id (:graph-id client)]
|
||||
(clear-stale-ws-loop-timer! client)
|
||||
(when-let [*timer (:stale-kill-timer client)]
|
||||
(let [timer (js/setInterval
|
||||
(fn []
|
||||
(when-let [current @worker-state/*db-sync-client]
|
||||
(when (and (= repo (:repo current))
|
||||
(= graph-id (:graph-id current))
|
||||
(identical? ws (:ws current)))
|
||||
(cond
|
||||
(ws-open? ws)
|
||||
(let [now (common-util/time-ms)
|
||||
last-ts (or (some-> (:last-ws-message-ts current) deref) now)
|
||||
stale-ms (- now last-ts)]
|
||||
(when (>= stale-ms ws-stale-timeout-ms)
|
||||
(log/warn :db-sync/ws-stale-timeout {:repo repo :stale-ms stale-ms})
|
||||
(try (.close ws) (catch :default _ nil))))
|
||||
|
||||
(contains? #{2 3} (ready-state ws))
|
||||
(do
|
||||
(log/warn :db-sync/ws-stale-closed {:repo repo :ready-state (ready-state ws)})
|
||||
(clear-stale-ws-loop-timer! current)
|
||||
(clear-inflight! current)
|
||||
(update-online-users! current [])
|
||||
(set-ws-state! current :closed)
|
||||
(schedule-reconnect! repo current url :stale-closed))))))
|
||||
ws-stale-kill-interval-ms)]
|
||||
(reset! *timer timer))))
|
||||
client)
|
||||
|
||||
(defn- stop-client!
|
||||
[client]
|
||||
(clear-stale-ws-loop-timer! client)
|
||||
(sync-apply/clear-upload-response-timeout! client)
|
||||
(when-let [reconnect (:reconnect client)]
|
||||
(clear-reconnect-timer! reconnect))
|
||||
(when-let [ws (:ws client)]
|
||||
(detach-ws-handlers! ws)
|
||||
(update-online-users! client [])
|
||||
(set-ws-state! client :closed)
|
||||
(try (.close ws) (catch :default _ nil))))
|
||||
|
||||
(defn- active-client-for?
|
||||
[client repo graph-id]
|
||||
(when (and client (= repo (:repo client)) (= graph-id (:graph-id client)))
|
||||
(let [ws (:ws client)
|
||||
ws-ready-state (when ws (ready-state ws))]
|
||||
(contains? #{0 1} ws-ready-state))))
|
||||
|
||||
(defn- connect!
|
||||
[repo client url token]
|
||||
(when (:ws client)
|
||||
(stop-client! client))
|
||||
(log/info :db-sync/connect! {:repo repo
|
||||
:token-exists? (some? (or token (auth-token)))})
|
||||
(when-let [token' (or token (auth-token))]
|
||||
(let [ws (platform/websocket-connect (platform/current) (sync-transport/append-token url token'))
|
||||
updated (assoc client :ws ws)]
|
||||
(attach-ws-handlers! repo updated ws url)
|
||||
(set! (.-onopen ws)
|
||||
(fn [_]
|
||||
(reset-reconnect! updated)
|
||||
(touch-last-ws-message! updated)
|
||||
(set-ws-state! updated :open)
|
||||
(sync-util/clear-last-sync-error! updated)
|
||||
(send! ws {:type "hello" :client repo})
|
||||
(sync-assets/enqueue-asset-sync!
|
||||
repo updated
|
||||
{:enqueue-asset-task-f enqueue-asset-task!
|
||||
:current-client-f current-client
|
||||
:broadcast-rtc-state!-f broadcast-rtc-state!
|
||||
:fail-fast-f fail-fast})))
|
||||
(close-stale-ws-loop updated ws url))))
|
||||
|
||||
(defn stop!
|
||||
[]
|
||||
(when-let [client @worker-state/*db-sync-client]
|
||||
(stop-client! client)
|
||||
(reset! worker-state/*db-sync-client nil))
|
||||
(p/resolved nil))
|
||||
|
||||
(declare list-remote-graphs!)
|
||||
|
||||
(defn- <resolve-start-graph-id
|
||||
[repo]
|
||||
(if-let [graph-id (sync-util/get-graph-id repo)]
|
||||
(p/resolved graph-id)
|
||||
(let [target-graph-name (some-> repo common-config/strip-leading-db-version-prefix)]
|
||||
(if-not (seq target-graph-name)
|
||||
(p/resolved nil)
|
||||
(p/let [remote-graphs (list-remote-graphs!)
|
||||
remote-graph-id (some (fn [{:keys [graph-name graph-id]}]
|
||||
(when (= target-graph-name graph-name)
|
||||
graph-id))
|
||||
remote-graphs)]
|
||||
(when (seq remote-graph-id)
|
||||
(ensure-client-graph-uuid! repo remote-graph-id)
|
||||
remote-graph-id))))))
|
||||
|
||||
(defn start!
|
||||
[repo]
|
||||
(let [base (ws-base-url)
|
||||
graph-id (sync-util/get-graph-id repo)
|
||||
start-target [repo graph-id]
|
||||
inflight-target @*start-inflight-target
|
||||
current @worker-state/*db-sync-client]
|
||||
(if-not (and (string? base) (seq base))
|
||||
(do
|
||||
(log/info :db-sync/start-skipped {:repo repo :graph-id graph-id :base base})
|
||||
(p/resolved nil))
|
||||
(p/let [graph-id (<resolve-start-graph-id repo)]
|
||||
(cond
|
||||
(not (seq graph-id))
|
||||
(do
|
||||
(log/info :db-sync/start-skipped {:repo repo :graph-id graph-id :base base})
|
||||
(p/resolved nil))
|
||||
|
||||
(not (client-op-ready? repo))
|
||||
(do
|
||||
(log/info :db-sync/start-skipped {:repo repo :graph-id graph-id :base base :reason :client-op-not-ready})
|
||||
(p/resolved nil))
|
||||
|
||||
(= start-target inflight-target)
|
||||
(p/resolved nil)
|
||||
|
||||
(active-client-for? current repo graph-id)
|
||||
(do
|
||||
(broadcast-rtc-state! current)
|
||||
(sync-apply/enqueue-flush-pending! repo current)
|
||||
(p/resolved nil))
|
||||
|
||||
:else
|
||||
(do
|
||||
(reset! *start-inflight-target start-target)
|
||||
(->
|
||||
(p/do!
|
||||
(stop!)
|
||||
(p/let [client (ensure-client-state! repo)
|
||||
url (sync-transport/format-ws-url base graph-id)
|
||||
_ (ensure-client-graph-uuid! repo graph-id)
|
||||
connected (assoc client :graph-id graph-id)
|
||||
token (<resolve-ws-token)
|
||||
connected (connect! repo connected url token)]
|
||||
(reset! worker-state/*db-sync-client connected)
|
||||
nil))
|
||||
(p/finally
|
||||
(fn []
|
||||
(when (= start-target @*start-inflight-target)
|
||||
(reset! *start-inflight-target nil)))))))))))
|
||||
|
||||
(defn enqueue-local-tx!
|
||||
[repo tx-report]
|
||||
(sync-apply/enqueue-local-tx! repo tx-report))
|
||||
|
||||
(defn handle-local-tx!
|
||||
[repo tx-report]
|
||||
(sync-apply/handle-local-tx! repo tx-report))
|
||||
|
||||
(defn request-asset-download!
|
||||
[repo asset-uuid]
|
||||
(sync-apply/request-asset-download! repo asset-uuid))
|
||||
|
||||
(defn download-missing-assets!
|
||||
[repo graph-id]
|
||||
(sync-assets/download-missing-remote-assets! repo graph-id))
|
||||
|
||||
(defn retry-asset-upload!
|
||||
[repo]
|
||||
(when-let [client (current-client repo)]
|
||||
(sync-assets/enqueue-asset-sync!
|
||||
repo client
|
||||
{:enqueue-asset-task-f enqueue-asset-task!
|
||||
:current-client-f current-client
|
||||
:broadcast-rtc-state!-f broadcast-rtc-state!
|
||||
:fail-fast-f fail-fast}))
|
||||
(p/resolved nil))
|
||||
|
||||
(defn rehydrate-large-titles-from-db!
|
||||
[repo graph-id]
|
||||
(sync-apply/rehydrate-large-titles-from-db! repo graph-id))
|
||||
|
||||
(defn upload-graph!
|
||||
[repo]
|
||||
(sync-upload/upload-graph! repo))
|
||||
|
||||
(defn create-remote-graph!
|
||||
[repo opts]
|
||||
(sync-upload/create-remote-graph! repo opts))
|
||||
|
||||
(def list-remote-graphs! sync-upload/list-remote-graphs!)
|
||||
|
||||
(defn stop-upload!
|
||||
[repo]
|
||||
(sync-apply/set-upload-stopped! repo true))
|
||||
|
||||
(defn resume-upload!
|
||||
[repo]
|
||||
(sync-apply/set-upload-stopped! repo false))
|
||||
|
||||
(defn upload-stopped?
|
||||
[repo]
|
||||
(sync-apply/upload-stopped? repo))
|
||||
1924
src/main/frontend/worker/sync/apply_txs.cljs
Normal file
1924
src/main/frontend/worker/sync/apply_txs.cljs
Normal file
File diff suppressed because it is too large
Load Diff
25
src/main/frontend/worker/sync/asset_db_listener.cljs
Normal file
25
src/main/frontend/worker/sync/asset_db_listener.cljs
Normal file
@@ -0,0 +1,25 @@
|
||||
(ns frontend.worker.sync.asset-db-listener
|
||||
"Listen asset-block changes in db, generate asset-sync operations"
|
||||
(:require [datascript.core :as d]
|
||||
[frontend.worker.sync.client-op :as client-op]
|
||||
[logseq.db :as ldb]))
|
||||
|
||||
(defn- asset-checksum?
|
||||
[a]
|
||||
(= :logseq.property.asset/checksum a))
|
||||
|
||||
(defn- datom=>op
|
||||
[db-after [e _a _v t _]]
|
||||
(let [ent-after (d/entity db-after e)]
|
||||
(when (ldb/asset? ent-after)
|
||||
[:update-asset t {:block-uuid (:block/uuid ent-after)}])))
|
||||
|
||||
(defn generate-asset-ops
|
||||
[repo {:keys [tx-data _tx-meta _db-before db-after]}]
|
||||
(when (client-op/rtc-db-graph? repo)
|
||||
(let [related-datoms (filter
|
||||
(fn [datom]
|
||||
(and (asset-checksum? (:a datom)) (:added datom)))
|
||||
tx-data)]
|
||||
(when-let [ops (not-empty (map #(datom=>op db-after %) related-datoms))]
|
||||
(client-op/add-asset-ops repo ops)))))
|
||||
507
src/main/frontend/worker/sync/assets.cljs
Normal file
507
src/main/frontend/worker/sync/assets.cljs
Normal file
@@ -0,0 +1,507 @@
|
||||
(ns frontend.worker.sync.assets
|
||||
"Asset sync helpers for db sync."
|
||||
(:require
|
||||
[datascript.core :as d]
|
||||
[frontend.common.crypt :as crypt]
|
||||
[frontend.worker.platform :as platform]
|
||||
[frontend.worker.shared-service :as shared-service]
|
||||
[frontend.worker.state :as worker-state]
|
||||
[frontend.worker.sync.auth :as sync-auth]
|
||||
[frontend.worker.sync.client-op :as client-op]
|
||||
[frontend.worker.sync.crypt :as sync-crypt]
|
||||
[frontend.worker.sync.large-title :as sync-large-title]
|
||||
[lambdaisland.glogi :as log]
|
||||
[logseq.common.config :as common-config]
|
||||
[logseq.common.util :as common-util]
|
||||
[logseq.db :as ldb]
|
||||
[promesa.core :as p]))
|
||||
|
||||
(def max-asset-size (* 100 1024 1024))
|
||||
|
||||
(defonce *repo->missing-asset-upload-files
|
||||
(atom {}))
|
||||
|
||||
(def ^:private remote-asset-download-parallelism 10)
|
||||
|
||||
(defn graph-aes-key
|
||||
[repo graph-id fail-fast-f]
|
||||
(if (sync-crypt/graph-e2ee? repo)
|
||||
(p/let [aes-key (sync-crypt/<ensure-graph-aes-key repo graph-id)
|
||||
_ (when (nil? aes-key)
|
||||
(fail-fast-f :db-sync/missing-field {:repo repo :field :aes-key}))]
|
||||
aes-key)
|
||||
(p/resolved nil)))
|
||||
|
||||
(defn- asset-file-name
|
||||
[asset-uuid asset-type]
|
||||
(str asset-uuid "." asset-type))
|
||||
|
||||
(defn- ->uint8
|
||||
[payload]
|
||||
(cond
|
||||
(instance? js/Uint8Array payload)
|
||||
payload
|
||||
|
||||
(instance? js/ArrayBuffer payload)
|
||||
(js/Uint8Array. payload)
|
||||
|
||||
(and (exists? js/ArrayBuffer)
|
||||
(.isView js/ArrayBuffer payload))
|
||||
(js/Uint8Array. (.-buffer payload) (.-byteOffset payload) (.-byteLength payload))
|
||||
|
||||
(array? payload)
|
||||
(js/Uint8Array. payload)
|
||||
|
||||
(sequential? payload)
|
||||
(js/Uint8Array. (clj->js payload))
|
||||
|
||||
(and (object? payload)
|
||||
(= "Buffer" (aget payload "type"))
|
||||
(array? (aget payload "data")))
|
||||
(js/Uint8Array. (aget payload "data"))
|
||||
|
||||
:else
|
||||
(throw (ex-info "unsupported binary payload"
|
||||
{:payload-type (str (type payload))}))))
|
||||
|
||||
(defn- payload-size
|
||||
[payload]
|
||||
(cond
|
||||
(string? payload) (count payload)
|
||||
(some? (.-byteLength payload)) (.-byteLength payload)
|
||||
(some? (.-length payload)) (.-length payload)
|
||||
:else 0))
|
||||
|
||||
(defn- notify-asset-progress!
|
||||
[repo asset-id direction loaded total]
|
||||
(shared-service/broadcast-to-clients!
|
||||
:rtc-asset-upload-download-progress
|
||||
{:repo repo
|
||||
:asset-id asset-id
|
||||
:progress {:direction direction
|
||||
:loaded loaded
|
||||
:total total}}))
|
||||
|
||||
(defn- missing-asset-upload-file
|
||||
[asset-id asset-type]
|
||||
{:asset-id asset-id
|
||||
:asset-type asset-type
|
||||
:file (str common-config/local-assets-dir "/" (asset-file-name asset-id asset-type))})
|
||||
|
||||
(defn- mark-missing-asset-upload-file!
|
||||
[repo asset-id asset-type]
|
||||
(swap! *repo->missing-asset-upload-files
|
||||
update repo
|
||||
(fn [files]
|
||||
(assoc (or files {})
|
||||
asset-id
|
||||
(missing-asset-upload-file asset-id asset-type))))
|
||||
nil)
|
||||
|
||||
(defn- clear-missing-asset-upload-file!
|
||||
[repo asset-id]
|
||||
(swap! *repo->missing-asset-upload-files
|
||||
(fn [repo->files]
|
||||
(let [files (dissoc (get repo->files repo) asset-id)]
|
||||
(if (seq files)
|
||||
(assoc repo->files repo files)
|
||||
(dissoc repo->files repo)))))
|
||||
nil)
|
||||
|
||||
(defn get-missing-asset-upload-files
|
||||
[repo]
|
||||
(->> (vals (get @*repo->missing-asset-upload-files repo))
|
||||
(sort-by :file)
|
||||
vec))
|
||||
|
||||
(defn clear-missing-asset-upload-files!
|
||||
[repo]
|
||||
(swap! *repo->missing-asset-upload-files dissoc repo)
|
||||
nil)
|
||||
|
||||
(defn- mark-asset-write-finish!
|
||||
[repo asset-id]
|
||||
(shared-service/broadcast-to-clients!
|
||||
:asset-file-write-finish
|
||||
{:repo repo
|
||||
:asset-id asset-id
|
||||
:ts (common-util/time-ms)}))
|
||||
|
||||
(defn- <read-asset-bytes
|
||||
[repo asset-id asset-type]
|
||||
(platform/asset-read-bytes! (platform/current)
|
||||
repo
|
||||
(asset-file-name asset-id asset-type)))
|
||||
|
||||
(defn- <write-asset-bytes!
|
||||
[repo asset-id asset-type payload]
|
||||
(p/let [_ (platform/asset-write-bytes! (platform/current)
|
||||
repo
|
||||
(asset-file-name asset-id asset-type)
|
||||
payload)]
|
||||
(mark-asset-write-finish! repo asset-id)
|
||||
nil))
|
||||
|
||||
(defn upload-remote-asset!
|
||||
[repo graph-id asset-uuid asset-type checksum]
|
||||
(let [base (sync-auth/http-base-url @worker-state/*db-sync-config)]
|
||||
(if (and (seq base) (seq graph-id) (seq asset-type) (seq checksum))
|
||||
(-> (p/let [aes-key (graph-aes-key
|
||||
repo graph-id
|
||||
(fn [tag data]
|
||||
(throw (ex-info (name tag) data))) )
|
||||
asset-id (str asset-uuid)
|
||||
put-url (sync-large-title/asset-url base graph-id asset-id asset-type)
|
||||
asset-bytes (->
|
||||
(<read-asset-bytes repo asset-id asset-type)
|
||||
(p/catch (fn [e]
|
||||
(log/error :read-asset-failed e)
|
||||
(mark-missing-asset-upload-file! repo asset-id asset-type)
|
||||
(throw (ex-info "read-asset failed"
|
||||
{:type :rtc.exception/read-asset-failed}
|
||||
e)))))
|
||||
_ (clear-missing-asset-upload-file! repo asset-id)
|
||||
asset-bytes (if aes-key (->uint8 asset-bytes) asset-bytes)
|
||||
payload (if (not aes-key)
|
||||
asset-bytes
|
||||
(p/let [encrypted-bytes (crypt/<encrypt-uint8array aes-key asset-bytes)]
|
||||
(ldb/write-transit-str encrypted-bytes)))
|
||||
total (payload-size payload)
|
||||
_ (notify-asset-progress! repo asset-id :upload 0 total)
|
||||
headers (merge (sync-auth/auth-headers (worker-state/get-id-token))
|
||||
{"x-amz-meta-checksum" checksum
|
||||
"x-amz-meta-type" asset-type})
|
||||
^js resp (js/fetch put-url
|
||||
(clj->js {:method "PUT"
|
||||
:headers headers
|
||||
:body payload}))
|
||||
status (.-status resp)
|
||||
_ (notify-asset-progress! repo asset-id :upload total total)]
|
||||
(when-not (.-ok resp)
|
||||
(throw (ex-info "upload-asset failed"
|
||||
{:type :rtc.exception/upload-asset-failed
|
||||
:data {:status status}})))
|
||||
nil)
|
||||
(p/catch
|
||||
(fn [e]
|
||||
(if (contains? #{:rtc.exception/read-asset-failed
|
||||
:rtc.exception/upload-asset-failed}
|
||||
(:type (ex-data e)))
|
||||
(p/rejected e)
|
||||
(p/rejected (ex-info "upload-asset failed"
|
||||
{:type :rtc.exception/upload-asset-failed}
|
||||
e))))))
|
||||
(p/rejected (ex-info "missing asset upload info"
|
||||
{:repo repo
|
||||
:asset-uuid asset-uuid
|
||||
:asset-type asset-type
|
||||
:checksum checksum
|
||||
:base base
|
||||
:graph-id graph-id})))))
|
||||
|
||||
(defn- drop-asset-op!
|
||||
[repo asset-uuid reason data current-client-f broadcast-rtc-state!-f]
|
||||
(log/warn :db-sync/drop-asset-op
|
||||
(merge data
|
||||
{:repo repo
|
||||
:asset-uuid asset-uuid
|
||||
:reason reason}))
|
||||
(clear-missing-asset-upload-file! repo (str asset-uuid))
|
||||
(client-op/remove-asset-op repo asset-uuid)
|
||||
(when-let [client (current-client-f repo)]
|
||||
(broadcast-rtc-state!-f client))
|
||||
(p/resolved nil))
|
||||
|
||||
(defn process-asset-op!
|
||||
[repo graph-id asset-op {:keys [current-client-f broadcast-rtc-state!-f fail-fast-f]}]
|
||||
(let [asset-uuid (:block/uuid asset-op)
|
||||
op-type (cond
|
||||
(contains? asset-op :update-asset) :update-asset
|
||||
(contains? asset-op :remove-asset) :remove-asset
|
||||
:else :unknown)]
|
||||
(when-not asset-uuid
|
||||
(fail-fast-f :db-sync/missing-field {:repo repo :field :asset-uuid :op op-type}))
|
||||
(cond
|
||||
(contains? asset-op :update-asset)
|
||||
(if-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(let [ent (d/entity @conn [:block/uuid asset-uuid])
|
||||
asset-type (:logseq.property.asset/type ent)
|
||||
checksum (:logseq.property.asset/checksum ent)
|
||||
size (:logseq.property.asset/size ent 0)]
|
||||
(cond
|
||||
(nil? ent)
|
||||
(drop-asset-op! repo asset-uuid :missing-asset-entity {:op :update-asset}
|
||||
current-client-f broadcast-rtc-state!-f)
|
||||
|
||||
(not (seq asset-type))
|
||||
(drop-asset-op! repo asset-uuid :missing-asset-type {:op :update-asset}
|
||||
current-client-f broadcast-rtc-state!-f)
|
||||
|
||||
(not (seq checksum))
|
||||
(drop-asset-op! repo asset-uuid :missing-checksum
|
||||
{:op :update-asset
|
||||
:asset-type asset-type}
|
||||
current-client-f broadcast-rtc-state!-f)
|
||||
|
||||
(> size max-asset-size)
|
||||
(do
|
||||
(log/info :db-sync/asset-too-large {:repo repo
|
||||
:asset-uuid asset-uuid
|
||||
:size size})
|
||||
(clear-missing-asset-upload-file! repo (str asset-uuid))
|
||||
(client-op/remove-asset-op repo asset-uuid)
|
||||
(when-let [client (current-client-f repo)]
|
||||
(broadcast-rtc-state!-f client))
|
||||
(p/resolved nil))
|
||||
|
||||
:else
|
||||
(-> (upload-remote-asset! repo graph-id asset-uuid asset-type checksum)
|
||||
(p/then (fn [_]
|
||||
(when (d/entity @conn [:block/uuid asset-uuid])
|
||||
(ldb/transact!
|
||||
conn
|
||||
[{:block/uuid asset-uuid
|
||||
:logseq.property.asset/remote-metadata {:checksum checksum :type asset-type}}]
|
||||
{:persist-op? true}))
|
||||
(client-op/remove-asset-op repo asset-uuid)
|
||||
(when-let [client (current-client-f repo)]
|
||||
(broadcast-rtc-state!-f client))))
|
||||
(p/catch (fn [e]
|
||||
(case (:type (ex-data e))
|
||||
:rtc.exception/read-asset-failed
|
||||
(when-let [client (current-client-f repo)]
|
||||
(broadcast-rtc-state!-f client))
|
||||
|
||||
:rtc.exception/upload-asset-failed
|
||||
nil
|
||||
|
||||
(log/error :db-sync/asset-upload-failed
|
||||
{:repo repo
|
||||
:asset-uuid asset-uuid
|
||||
:error e})))))))
|
||||
(fail-fast-f :db-sync/missing-db {:repo repo :op :process-asset-op}))
|
||||
|
||||
(contains? asset-op :remove-asset)
|
||||
(do
|
||||
(clear-missing-asset-upload-file! repo (str asset-uuid))
|
||||
(-> (client-op/remove-asset-op repo asset-uuid)
|
||||
(p/then (fn [_]
|
||||
(when-let [client (current-client-f repo)]
|
||||
(broadcast-rtc-state!-f client))))
|
||||
(p/catch (fn [e]
|
||||
(log/error :db-sync/asset-delete-failed
|
||||
{:repo repo
|
||||
:asset-uuid asset-uuid
|
||||
:error e})))))
|
||||
|
||||
:else
|
||||
(p/resolved nil))))
|
||||
|
||||
(defn process-asset-ops!
|
||||
[repo client {:keys [current-client-f broadcast-rtc-state!-f fail-fast-f]}]
|
||||
(let [graph-id (:graph-id client)
|
||||
asset-ops (not-empty (client-op/get-all-asset-ops repo))
|
||||
parallelism 10]
|
||||
(if (and (seq graph-id) asset-ops)
|
||||
(let [queue (atom (vec asset-ops))
|
||||
pop-queue! (fn []
|
||||
(let [selected (atom nil)]
|
||||
(swap! queue
|
||||
(fn [q]
|
||||
(if (seq q)
|
||||
(do
|
||||
(reset! selected (first q))
|
||||
(subvec q 1))
|
||||
q)))
|
||||
@selected))
|
||||
worker (fn worker []
|
||||
(if-let [asset-op (pop-queue!)]
|
||||
(-> (p/let [_ (process-asset-op! repo graph-id asset-op
|
||||
{:current-client-f current-client-f
|
||||
:broadcast-rtc-state!-f broadcast-rtc-state!-f
|
||||
:fail-fast-f fail-fast-f})]
|
||||
(worker))
|
||||
(p/catch (fn [e]
|
||||
(log/error :db-sync/process-asset-op-loop-failed
|
||||
{:repo repo
|
||||
:asset-op asset-op
|
||||
:error e}))))
|
||||
(p/resolved nil)))]
|
||||
(p/all (mapv (fn [_] (worker))
|
||||
(range (min parallelism (count asset-ops))))))
|
||||
(p/resolved nil))))
|
||||
|
||||
(defn enqueue-asset-sync!
|
||||
[repo client {:keys [enqueue-asset-task-f current-client-f broadcast-rtc-state!-f fail-fast-f]}]
|
||||
(enqueue-asset-task-f
|
||||
client
|
||||
#(process-asset-ops!
|
||||
repo client
|
||||
{:current-client-f current-client-f
|
||||
:broadcast-rtc-state!-f broadcast-rtc-state!-f
|
||||
:fail-fast-f fail-fast-f})))
|
||||
|
||||
(defn- parse-content-length
|
||||
[^js resp]
|
||||
(when-let [content-length (some-> (.-headers resp) (.get "content-length"))]
|
||||
(let [length (js/parseInt content-length 10)]
|
||||
(when (not (js/isNaN length))
|
||||
length))))
|
||||
|
||||
(defn download-remote-asset!
|
||||
[repo graph-id asset-uuid asset-type]
|
||||
(let [base (sync-auth/http-base-url @worker-state/*db-sync-config)]
|
||||
(if (and (seq base) (seq graph-id) (seq asset-type))
|
||||
(-> (p/let [aes-key (graph-aes-key
|
||||
repo graph-id
|
||||
(fn [tag data]
|
||||
(throw (ex-info (name tag) data))))
|
||||
asset-id (str asset-uuid)
|
||||
get-url (sync-large-title/asset-url base graph-id asset-id asset-type)
|
||||
headers (sync-auth/auth-headers (worker-state/get-id-token))
|
||||
request-opts (cond-> {:method "GET"}
|
||||
(seq headers) (assoc :headers headers))
|
||||
^js resp (js/fetch get-url
|
||||
(clj->js request-opts))
|
||||
status (.-status resp)
|
||||
_ (when-not (.-ok resp)
|
||||
(throw (ex-info "download asset failed"
|
||||
{:type :rtc.exception/download-asset-failed
|
||||
:data {:status status}})))
|
||||
total (or (parse-content-length resp) 0)
|
||||
_ (notify-asset-progress! repo asset-id :download 0 total)
|
||||
body (.arrayBuffer resp)
|
||||
body-size (.-byteLength body)
|
||||
total' (if (pos? total) total body-size)
|
||||
_ (notify-asset-progress! repo asset-id :download body-size total')
|
||||
asset-file
|
||||
(if (not aes-key)
|
||||
body
|
||||
(let [asset-file-untransited (ldb/read-transit-str (.decode (js/TextDecoder.) body))]
|
||||
(crypt/<decrypt-uint8array aes-key asset-file-untransited)))]
|
||||
(<write-asset-bytes! repo asset-id asset-type asset-file))
|
||||
(p/catch
|
||||
(fn [e]
|
||||
(if (= :rtc.exception/download-asset-failed (:type (ex-data e)))
|
||||
(p/rejected e)
|
||||
(p/rejected (ex-info "download asset failed"
|
||||
{:type :rtc.exception/download-asset-failed}
|
||||
e))))))
|
||||
(p/rejected (ex-info "missing asset download info"
|
||||
{:repo repo
|
||||
:asset-uuid asset-uuid
|
||||
:asset-type asset-type
|
||||
:base base
|
||||
:graph-id graph-id})))))
|
||||
|
||||
(defn log-request-asset-download-failed!
|
||||
[repo asset-uuid error]
|
||||
(log/error :db-sync/request-asset-download-failed
|
||||
{:repo repo
|
||||
:asset-uuid asset-uuid
|
||||
:error error}))
|
||||
|
||||
(defn request-asset-download!
|
||||
[repo asset-uuid {:keys [current-client-f enqueue-asset-task-f broadcast-rtc-state!-f]}]
|
||||
(when-let [client (current-client-f repo)]
|
||||
(when-let [graph-id (:graph-id client)]
|
||||
(enqueue-asset-task-f
|
||||
client
|
||||
#(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(when-let [ent (d/entity @conn [:block/uuid asset-uuid])]
|
||||
(let [asset-type (:logseq.property.asset/type ent)
|
||||
asset-id (str asset-uuid)
|
||||
should-download? (and (seq asset-type)
|
||||
(:logseq.property.asset/remote-metadata ent))]
|
||||
(-> (p/let [meta (when should-download?
|
||||
(platform/asset-stat (platform/current)
|
||||
repo
|
||||
(asset-file-name asset-id asset-type)))
|
||||
missing-local? (and should-download? (nil? meta))
|
||||
_ (when missing-local?
|
||||
(download-remote-asset! repo graph-id asset-uuid asset-type))
|
||||
_ (when missing-local?
|
||||
(client-op/remove-asset-op repo asset-uuid))
|
||||
_ (when missing-local?
|
||||
(broadcast-rtc-state!-f client))]
|
||||
nil)
|
||||
(p/catch (fn [e]
|
||||
(log-request-asset-download-failed! repo asset-uuid e)
|
||||
(p/rejected e)))))))))))
|
||||
|
||||
(defn- remote-asset-download-candidates
|
||||
[db]
|
||||
(->> (d/q '[:find ?e ?asset-uuid ?asset-type
|
||||
:where
|
||||
[?asset-class :db/ident :logseq.class/Asset]
|
||||
[?e :block/tags ?asset-class]
|
||||
[?e :block/uuid ?asset-uuid]
|
||||
[?e :logseq.property.asset/type ?asset-type]
|
||||
[?e :logseq.property.asset/remote-metadata]]
|
||||
db)
|
||||
(keep (fn [[e asset-uuid asset-type]]
|
||||
(let [ent (d/entity db e)]
|
||||
(when-not (seq (some-> (:logseq.property.asset/external-url ent) str))
|
||||
{:asset-uuid asset-uuid
|
||||
:asset-type asset-type}))))
|
||||
(sort-by (comp str :asset-uuid))))
|
||||
|
||||
(defn download-remote-assets-if-missing!
|
||||
[repo graph-id candidates]
|
||||
(let [candidates (->> candidates
|
||||
(filter (fn [{:keys [asset-uuid asset-type]}]
|
||||
(and asset-uuid (seq asset-type))))
|
||||
distinct
|
||||
(sort-by (juxt (comp str :asset-uuid) :asset-type)))
|
||||
current-platform (platform/current)
|
||||
queue (atom (vec candidates))
|
||||
result (atom {:total (count candidates)
|
||||
:downloaded 0
|
||||
:skipped-existing 0})
|
||||
pop-queue! (fn []
|
||||
(let [selected (atom nil)]
|
||||
(swap! queue
|
||||
(fn [q]
|
||||
(if (seq q)
|
||||
(do
|
||||
(reset! selected (first q))
|
||||
(subvec q 1))
|
||||
q)))
|
||||
@selected))
|
||||
worker (fn worker []
|
||||
(if-let [{:keys [asset-uuid asset-type]} (pop-queue!)]
|
||||
(let [asset-id (str asset-uuid)]
|
||||
(p/let [meta (platform/asset-stat current-platform
|
||||
repo
|
||||
(asset-file-name asset-id asset-type))
|
||||
_ (if meta
|
||||
(do
|
||||
(swap! result update :skipped-existing inc)
|
||||
nil)
|
||||
(p/let [_ (download-remote-asset! repo graph-id asset-uuid asset-type)]
|
||||
(swap! result update :downloaded inc)))]
|
||||
(worker)))
|
||||
(p/resolved nil)))]
|
||||
(p/let [_ (p/all (mapv (fn [_] (worker))
|
||||
(range (min remote-asset-download-parallelism
|
||||
(count candidates)))))]
|
||||
@result)))
|
||||
|
||||
(defn remote-asset-download-candidates-in-tx
|
||||
[db tx-data]
|
||||
(->> tx-data
|
||||
(keep (fn [d]
|
||||
(when (and (= (:a d) :logseq.property.asset/remote-metadata) (:added d))
|
||||
(when-let [asset (d/entity db (:e d))]
|
||||
{:asset-uuid (:block/uuid asset)
|
||||
:asset-type (:logseq.property.asset/type asset)}))))
|
||||
distinct))
|
||||
|
||||
(defn download-missing-remote-assets!
|
||||
[repo graph-id]
|
||||
(if-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(download-remote-assets-if-missing!
|
||||
repo graph-id (remote-asset-download-candidates @conn))
|
||||
(p/rejected (ex-info "datascript connection not found"
|
||||
{:repo repo
|
||||
:graph-id graph-id}))))
|
||||
109
src/main/frontend/worker/sync/auth.cljs
Normal file
109
src/main/frontend/worker/sync/auth.cljs
Normal file
@@ -0,0 +1,109 @@
|
||||
(ns frontend.worker.sync.auth
|
||||
"Auth and endpoint helpers for db sync."
|
||||
(:require [clojure.string :as string]
|
||||
[frontend.worker-common.util :as worker-util]
|
||||
[frontend.worker.state :as worker-state]
|
||||
[frontend.worker.sync.util :as sync-util]
|
||||
[logseq.common.util :as common-util]
|
||||
[promesa.core :as p]))
|
||||
|
||||
(defn ws-base-url
|
||||
[db-sync-config]
|
||||
(:ws-url db-sync-config))
|
||||
|
||||
(defn http-base-url
|
||||
[db-sync-config]
|
||||
(or (:http-base db-sync-config)
|
||||
(when-let [ws-url (ws-base-url db-sync-config)]
|
||||
(let [base (cond
|
||||
(string/starts-with? ws-url "wss://")
|
||||
(str "https://" (subs ws-url (count "wss://")))
|
||||
|
||||
(string/starts-with? ws-url "ws://")
|
||||
(str "http://" (subs ws-url (count "ws://")))
|
||||
|
||||
:else ws-url)]
|
||||
(string/replace base #"/sync/%s$" "")))))
|
||||
|
||||
(defn id-token-expired?
|
||||
[token]
|
||||
(if-not (string? token)
|
||||
true
|
||||
(try
|
||||
(let [exp-ms (some-> token worker-util/parse-jwt :exp (* 1000))]
|
||||
(or (not (number? exp-ms))
|
||||
(<= exp-ms (common-util/time-ms))))
|
||||
(catch :default _
|
||||
true))))
|
||||
|
||||
(defn oauth-token-url
|
||||
[state]
|
||||
(or (:auth/oauth-token-url state)
|
||||
(when-let [domain (not-empty (:auth/oauth-domain state))]
|
||||
(str "https://" domain "/oauth2/token"))))
|
||||
|
||||
(defn <refresh-id&access-token
|
||||
[]
|
||||
(let [state @worker-state/*state
|
||||
refresh-token (:auth/refresh-token state)
|
||||
token-url (oauth-token-url state)
|
||||
oauth-client-id (:auth/oauth-client-id state)]
|
||||
(when-not (seq refresh-token)
|
||||
(throw (ex-info "worker auth refresh requires refresh token"
|
||||
{:code :missing-refresh-token})))
|
||||
(when-not (seq token-url)
|
||||
(throw (ex-info "worker auth refresh requires oauth token url"
|
||||
{:code :missing-oauth-token-url})))
|
||||
(when-not (seq oauth-client-id)
|
||||
(throw (ex-info "worker auth refresh requires oauth client id"
|
||||
{:code :missing-oauth-client-id})))
|
||||
(let [form-data (js/URLSearchParams.)]
|
||||
(.set form-data "grant_type" "refresh_token")
|
||||
(.set form-data "client_id" oauth-client-id)
|
||||
(.set form-data "refresh_token" refresh-token)
|
||||
(p/let [resp (js/fetch token-url #js {:method "POST"
|
||||
:headers #js {"content-type" "application/x-www-form-urlencoded"}
|
||||
:body (.toString form-data)})
|
||||
text (.text resp)
|
||||
data (when (seq text)
|
||||
(js->clj (js/JSON.parse text) :keywordize-keys true))]
|
||||
(if (.-ok resp)
|
||||
{:id-token (:id_token data)
|
||||
:access-token (:access_token data)}
|
||||
(throw (ex-info "worker auth refresh failed"
|
||||
{:code :auth-refresh-failed
|
||||
:status (.-status resp)
|
||||
:token-url token-url
|
||||
:body data})))))))
|
||||
|
||||
(defn <resolve-ws-token
|
||||
[]
|
||||
(let [token (sync-util/auth-token)
|
||||
token-expired? (id-token-expired? token)]
|
||||
(if (and (not (sync-util/cli-node-owner?)) token-expired?)
|
||||
(p/let [{:keys [id-token access-token]} (<refresh-id&access-token)]
|
||||
(when-not (seq id-token)
|
||||
(throw (ex-info "worker auth refresh returned empty id-token"
|
||||
{:code :auth-refresh-empty-id-token})))
|
||||
(worker-state/set-new-state!
|
||||
(cond-> {:auth/id-token id-token}
|
||||
(seq access-token) (assoc :auth/access-token access-token)))
|
||||
id-token)
|
||||
(p/resolved token))))
|
||||
|
||||
(defn get-user-uuid
|
||||
[id-token]
|
||||
(some-> id-token
|
||||
worker-util/parse-jwt
|
||||
:sub))
|
||||
|
||||
(defn auth-headers
|
||||
[token]
|
||||
(when-let [token* token]
|
||||
{"authorization" (str "Bearer " token*)}))
|
||||
|
||||
(defn with-auth-headers
|
||||
[auth-headers-f opts]
|
||||
(if-let [auth (auth-headers-f)]
|
||||
(assoc opts :headers (merge (or (:headers opts) {}) auth))
|
||||
opts))
|
||||
670
src/main/frontend/worker/sync/client_op.cljs
Normal file
670
src/main/frontend/worker/sync/client_op.cljs
Normal file
@@ -0,0 +1,670 @@
|
||||
(ns frontend.worker.sync.client-op
|
||||
"Store client sync metadata and ops in sqlite tables.
|
||||
DataScript client-op storage is deprecated and unsupported."
|
||||
(:require [clojure.string :as string]
|
||||
[datascript.core :as d]
|
||||
[frontend.worker.state :as worker-state]
|
||||
[goog.object :as gobj]
|
||||
[lambdaisland.glogi :as log]
|
||||
[logseq.db.sqlite.util :as sqlite-util]
|
||||
[malli.core :as ma]
|
||||
[malli.transform :as mt]))
|
||||
|
||||
(def op-schema
|
||||
[:multi {:dispatch first}
|
||||
[:update-asset
|
||||
[:catn
|
||||
[:op :keyword]
|
||||
[:t :int]
|
||||
[:value [:map
|
||||
[:block-uuid :uuid]]]]]
|
||||
[:remove-asset
|
||||
[:catn
|
||||
[:op :keyword]
|
||||
[:t :int]
|
||||
[:value [:map
|
||||
[:block-uuid :uuid]]]]]])
|
||||
|
||||
(def ops-schema [:sequential op-schema])
|
||||
(def ops-coercer (ma/coercer ops-schema mt/json-transformer nil
|
||||
#(do (log/error ::bad-ops (:value %))
|
||||
(ma/-fail! ::ops-schema (select-keys % [:value])))))
|
||||
|
||||
(defonce *repo->pending-local-tx-count (atom {}))
|
||||
|
||||
(def ^:private sqlite-schema-ready-key "__logseq_client_ops_schema_ready_v2")
|
||||
(def ^:private sqlite-mode-key "__logseq_client_ops_sqlite_mode")
|
||||
(def ^:private sync-meta-table-sql
|
||||
"create table if not exists sync_meta (key text primary key, value text)")
|
||||
(def ^:private client-ops-table-sql
|
||||
(str "create table if not exists client_ops ("
|
||||
"id integer primary key autoincrement,"
|
||||
"kind text not null,"
|
||||
"created_at integer not null,"
|
||||
"tx_id text unique,"
|
||||
"pending integer not null default 0,"
|
||||
"failed integer not null default 0,"
|
||||
"outliner_op text,"
|
||||
"undo_redo text,"
|
||||
"forward_outliner_ops text,"
|
||||
"inverse_outliner_ops text,"
|
||||
"inferred_outliner_ops integer,"
|
||||
"normalized_tx_data text,"
|
||||
"reversed_tx_data text,"
|
||||
"asset_uuid text,"
|
||||
"asset_op text,"
|
||||
"asset_t integer,"
|
||||
"asset_value text"
|
||||
")"))
|
||||
(def ^:private pending-index-sql
|
||||
"create index if not exists idx_client_ops_pending_created on client_ops(kind, pending, created_at, id)")
|
||||
(def ^:private asset-index-sql
|
||||
"create index if not exists idx_client_ops_asset_uuid on client_ops(kind, asset_uuid)")
|
||||
(def ^:private sync-conflicts-table-sql
|
||||
(str "create table if not exists sync_conflicts ("
|
||||
"id integer primary key autoincrement,"
|
||||
"block_uuid text not null,"
|
||||
"attr text not null,"
|
||||
"value text not null,"
|
||||
"remote_t integer,"
|
||||
"created_at integer not null,"
|
||||
"unique(block_uuid, attr, value)"
|
||||
")"))
|
||||
(def ^:private sync-conflicts-block-index-sql
|
||||
"create index if not exists idx_sync_conflicts_block_uuid on sync_conflicts(block_uuid, created_at)")
|
||||
|
||||
(defn- client-ops-store
|
||||
[repo]
|
||||
(worker-state/get-client-ops-conn repo))
|
||||
|
||||
(declare ensure-sqlite-schema!)
|
||||
|
||||
(defn- detect-sqlite-mode
|
||||
[^js db]
|
||||
(or (gobj/get db sqlite-mode-key)
|
||||
(let [mode
|
||||
(cond
|
||||
(not db) nil
|
||||
(fn? (gobj/get db "prepare"))
|
||||
(try
|
||||
(let [^js stmt (.prepare db "select 1")]
|
||||
(try
|
||||
(if (fn? (gobj/get stmt "run"))
|
||||
:better-sqlite
|
||||
:sqlite-wasm)
|
||||
(finally
|
||||
(when (fn? (gobj/get stmt "finalize"))
|
||||
(.finalize stmt)))))
|
||||
(catch :default _
|
||||
:sqlite-wasm))
|
||||
(fn? (gobj/get db "exec")) :sqlite-wasm
|
||||
:else nil)]
|
||||
(when mode
|
||||
(try
|
||||
(gobj/set db sqlite-mode-key mode)
|
||||
(catch :default _
|
||||
nil)))
|
||||
mode)))
|
||||
|
||||
(defn- sqlite-db?
|
||||
[conn]
|
||||
(some? (detect-sqlite-mode conn)))
|
||||
|
||||
(defn- sqlite-store-or-throw
|
||||
[repo]
|
||||
(when-let [store (client-ops-store repo)]
|
||||
(if (sqlite-db? store)
|
||||
(do
|
||||
(ensure-sqlite-schema! store)
|
||||
store)
|
||||
(throw (ex-info "Legacy DataScript client-op storage is unsupported. Please back up the graph and re-download it."
|
||||
{:type :db-sync/legacy-client-ops-storage
|
||||
:repo repo})))))
|
||||
|
||||
(defn- parse-uuid-str
|
||||
[v]
|
||||
(when (string? v)
|
||||
(try
|
||||
(uuid v)
|
||||
(catch :default _
|
||||
nil))))
|
||||
|
||||
(defn- kw->str
|
||||
[v]
|
||||
(cond
|
||||
(keyword? v) (name v)
|
||||
(string? v) v
|
||||
:else nil))
|
||||
|
||||
(defn- str->kw
|
||||
[v]
|
||||
(when (string? v)
|
||||
(keyword v)))
|
||||
|
||||
(defn- qualified-kw->str
|
||||
[v]
|
||||
(cond
|
||||
(qualified-keyword? v) (subs (str v) 1)
|
||||
(keyword? v) (name v)
|
||||
(string? v) v
|
||||
:else nil))
|
||||
|
||||
(defn- str->qualified-kw
|
||||
[v]
|
||||
(when (string? v)
|
||||
(keyword v)))
|
||||
|
||||
(defn- bool->int [v] (if v 1 0))
|
||||
(defn- int->bool [v] (not (or (nil? v) (= 0 v) (= false v))))
|
||||
|
||||
(defn- normalize-op-entries
|
||||
[ops]
|
||||
(let [ops' (some-> ops seq vec)]
|
||||
(cond
|
||||
(nil? ops')
|
||||
nil
|
||||
|
||||
(and (keyword? (first ops'))
|
||||
(vector? (second ops')))
|
||||
[ops']
|
||||
|
||||
:else
|
||||
ops')))
|
||||
|
||||
(defn- sqlite-run!
|
||||
[^js db sql params]
|
||||
(case (detect-sqlite-mode db)
|
||||
:better-sqlite
|
||||
(let [^js stmt (.prepare db sql)
|
||||
run-fn (gobj/get stmt "run")]
|
||||
(if (seq params)
|
||||
(.apply run-fn stmt (to-array params))
|
||||
(.call run-fn stmt)))
|
||||
|
||||
:sqlite-wasm
|
||||
(.exec db #js {:sql sql
|
||||
:bind (into-array params)})
|
||||
|
||||
nil))
|
||||
|
||||
(defn- sqlite-rows
|
||||
[^js db sql params]
|
||||
(case (detect-sqlite-mode db)
|
||||
:better-sqlite
|
||||
(let [^js stmt (.prepare db sql)
|
||||
all-fn (gobj/get stmt "all")]
|
||||
(vec (if (seq params)
|
||||
(.apply all-fn stmt (to-array params))
|
||||
(.call all-fn stmt))))
|
||||
|
||||
:sqlite-wasm
|
||||
(let [^js result (.exec db #js {:sql sql
|
||||
:bind (into-array params)
|
||||
:rowMode "object"
|
||||
:returnValue "resultRows"})]
|
||||
(cond
|
||||
(nil? result) []
|
||||
(array? result) (vec result)
|
||||
(fn? (gobj/get result "toArray")) (vec (.toArray result))
|
||||
:else []))
|
||||
|
||||
[]))
|
||||
|
||||
(defn- sqlite-row
|
||||
[db sql params]
|
||||
(first (sqlite-rows db sql params)))
|
||||
|
||||
(defn- sqlite-with-tx!
|
||||
[^js db f]
|
||||
(case (detect-sqlite-mode db)
|
||||
:better-sqlite
|
||||
(let [tx-fn (.transaction db (fn [] (f db)))]
|
||||
(tx-fn))
|
||||
|
||||
:sqlite-wasm
|
||||
(if (fn? (gobj/get db "transaction"))
|
||||
(.transaction db (fn [tx] (f tx)))
|
||||
(f db))
|
||||
|
||||
(f db)))
|
||||
|
||||
(defn ensure-sqlite-schema!
|
||||
[db]
|
||||
(when (sqlite-db? db)
|
||||
(when-not (true? (gobj/get db sqlite-schema-ready-key))
|
||||
(sqlite-with-tx!
|
||||
db
|
||||
(fn [tx]
|
||||
(sqlite-run! tx sync-meta-table-sql [])
|
||||
(sqlite-run! tx client-ops-table-sql [])
|
||||
(sqlite-run! tx sync-conflicts-table-sql [])
|
||||
(sqlite-run! tx pending-index-sql [])
|
||||
(sqlite-run! tx asset-index-sql [])
|
||||
(sqlite-run! tx sync-conflicts-block-index-sql [])))
|
||||
(try
|
||||
(gobj/set db sqlite-schema-ready-key true)
|
||||
(catch :default _
|
||||
nil)))))
|
||||
|
||||
(defn- sqlite-get-meta
|
||||
[db k]
|
||||
(some-> (sqlite-row db "select value from sync_meta where key = ?" [(name k)])
|
||||
(aget "value")))
|
||||
|
||||
(defn- sqlite-set-meta!
|
||||
[db k v]
|
||||
(sqlite-run! db
|
||||
(str "insert into sync_meta (key, value) values (?, ?)"
|
||||
" on conflict(key) do update set value = excluded.value")
|
||||
[(name k) (str v)]))
|
||||
|
||||
(defn update-graph-uuid
|
||||
[repo graph-uuid]
|
||||
{:pre [(some? graph-uuid)]}
|
||||
(when-let [store (sqlite-store-or-throw repo)]
|
||||
(sqlite-set-meta! store :graph-uuid graph-uuid)))
|
||||
|
||||
(defn get-graph-uuid
|
||||
[repo]
|
||||
(when-let [store (sqlite-store-or-throw repo)]
|
||||
(sqlite-get-meta store :graph-uuid)))
|
||||
|
||||
(defn get-local-tx
|
||||
[repo]
|
||||
(when-let [store (sqlite-store-or-throw repo)]
|
||||
(when-let [result (sqlite-get-meta store :local-tx)]
|
||||
(js/parseInt result 10))))
|
||||
|
||||
(defn update-local-tx
|
||||
[repo t]
|
||||
{:pre [(and (integer? t) (>= t 0))]}
|
||||
(let [store (sqlite-store-or-throw repo)
|
||||
prev-t (get-local-tx repo)]
|
||||
(assert (some? store) repo)
|
||||
(when (and prev-t (< t prev-t))
|
||||
(throw (ex-info "local-tx should be monotonically increasing"
|
||||
{:repo repo
|
||||
:prev-t prev-t
|
||||
:new-t t})))
|
||||
(sqlite-set-meta! store :local-tx t)))
|
||||
|
||||
(defn reset-local-tx
|
||||
"Should be used only when uploading a graph"
|
||||
[repo]
|
||||
(let [store (sqlite-store-or-throw repo)]
|
||||
(assert (some? store) repo)
|
||||
(sqlite-set-meta! store :local-tx 0)))
|
||||
|
||||
(defn update-local-checksum
|
||||
[repo checksum]
|
||||
{:pre [(some? checksum)]}
|
||||
(let [store (sqlite-store-or-throw repo)]
|
||||
(assert (some? store) repo)
|
||||
(sqlite-set-meta! store :db-sync/checksum checksum)))
|
||||
|
||||
(defn get-pending-local-tx-count
|
||||
[repo]
|
||||
(if-let [cached (get @*repo->pending-local-tx-count repo)]
|
||||
cached
|
||||
(let [count' (if-let [store (sqlite-store-or-throw repo)]
|
||||
(or (some-> (sqlite-row store
|
||||
"select count(*) as c from client_ops where kind = 'tx' and pending = 1"
|
||||
[])
|
||||
(aget "c"))
|
||||
0)
|
||||
0)]
|
||||
(swap! *repo->pending-local-tx-count assoc repo count')
|
||||
count')))
|
||||
|
||||
(defn adjust-pending-local-tx-count!
|
||||
[repo delta]
|
||||
(swap! *repo->pending-local-tx-count
|
||||
(fn [m]
|
||||
(let [base (or (get m repo) 0)
|
||||
next (max 0 (+ base delta))]
|
||||
(assoc m repo next)))))
|
||||
|
||||
(defn get-local-checksum
|
||||
[repo]
|
||||
(let [store (sqlite-store-or-throw repo)]
|
||||
(assert (some? store) repo)
|
||||
(sqlite-get-meta store :db-sync/checksum)))
|
||||
|
||||
(defn rtc-db-graph?
|
||||
"Is RTC enabled"
|
||||
[repo]
|
||||
(or (exists? js/process)
|
||||
(some? (get-graph-uuid repo))))
|
||||
|
||||
(defn- row->pending-local-tx
|
||||
[row]
|
||||
(let [tx-id (parse-uuid-str (aget row "tx_id"))]
|
||||
(when tx-id
|
||||
{:tx-id tx-id
|
||||
:outliner-op (str->kw (aget row "outliner_op"))
|
||||
:forward-outliner-ops (or (normalize-op-entries
|
||||
(sqlite-util/read-transit-str (aget row "forward_outliner_ops")))
|
||||
[])
|
||||
:inverse-outliner-ops (or (normalize-op-entries
|
||||
(sqlite-util/read-transit-str (aget row "inverse_outliner_ops")))
|
||||
[])
|
||||
:inferred-outliner-ops? (int->bool (aget row "inferred_outliner_ops"))
|
||||
:db-sync/undo-redo (str->kw (aget row "undo_redo"))
|
||||
:tx (sqlite-util/read-transit-str (aget row "normalized_tx_data"))
|
||||
:reversed-tx (sqlite-util/read-transit-str (aget row "reversed_tx_data"))})))
|
||||
|
||||
(defn upsert-local-tx-entry!
|
||||
[repo {:keys [tx-id created-at pending? failed? outliner-op undo-redo
|
||||
forward-outliner-ops inverse-outliner-ops inferred-outliner-ops?
|
||||
normalized-tx-data reversed-tx-data]
|
||||
:or {pending? true failed? false}}]
|
||||
{:pre [(some? tx-id)]}
|
||||
(let [store (sqlite-store-or-throw repo)]
|
||||
(assert (some? store) repo)
|
||||
(let [tx-id-str (str tx-id)
|
||||
existing (sqlite-row store
|
||||
"select pending, created_at from client_ops where kind = 'tx' and tx_id = ?"
|
||||
[tx-id-str])
|
||||
should-inc-pending? (not= 1 (some-> existing (aget "pending")))
|
||||
forward-outliner-ops' (or (normalize-op-entries forward-outliner-ops) [])
|
||||
inverse-outliner-ops' (or (normalize-op-entries inverse-outliner-ops) [])
|
||||
created-at' (or (some-> existing (aget "created_at"))
|
||||
created-at
|
||||
(.now js/Date))]
|
||||
(sqlite-run! store
|
||||
(str "insert into client_ops ("
|
||||
"kind, created_at, tx_id, pending, failed, outliner_op, undo_redo, "
|
||||
"forward_outliner_ops, inverse_outliner_ops, inferred_outliner_ops, "
|
||||
"normalized_tx_data, reversed_tx_data"
|
||||
") values ('tx', ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)"
|
||||
" on conflict(tx_id) do update set "
|
||||
"created_at = excluded.created_at,"
|
||||
"pending = excluded.pending,"
|
||||
"failed = excluded.failed,"
|
||||
"outliner_op = excluded.outliner_op,"
|
||||
"undo_redo = excluded.undo_redo,"
|
||||
"forward_outliner_ops = excluded.forward_outliner_ops,"
|
||||
"inverse_outliner_ops = excluded.inverse_outliner_ops,"
|
||||
"inferred_outliner_ops = excluded.inferred_outliner_ops,"
|
||||
"normalized_tx_data = excluded.normalized_tx_data,"
|
||||
"reversed_tx_data = excluded.reversed_tx_data")
|
||||
[created-at'
|
||||
tx-id-str
|
||||
(bool->int pending?)
|
||||
(bool->int failed?)
|
||||
(kw->str outliner-op)
|
||||
(kw->str undo-redo)
|
||||
(sqlite-util/write-transit-str forward-outliner-ops')
|
||||
(sqlite-util/write-transit-str inverse-outliner-ops')
|
||||
(bool->int inferred-outliner-ops?)
|
||||
(sqlite-util/write-transit-str (or normalized-tx-data []))
|
||||
(sqlite-util/write-transit-str (or reversed-tx-data []))])
|
||||
{:tx-id tx-id
|
||||
:created-at created-at'
|
||||
:should-inc-pending? should-inc-pending?})))
|
||||
|
||||
(defn get-local-tx-entry
|
||||
[repo tx-id]
|
||||
(when (uuid? tx-id)
|
||||
(when-let [store (sqlite-store-or-throw repo)]
|
||||
(some-> (sqlite-row store
|
||||
(str "select tx_id, outliner_op, undo_redo, "
|
||||
"forward_outliner_ops, inverse_outliner_ops, inferred_outliner_ops, "
|
||||
"normalized_tx_data, reversed_tx_data "
|
||||
"from client_ops where kind = 'tx' and tx_id = ? limit 1")
|
||||
[(str tx-id)])
|
||||
(row->pending-local-tx)))))
|
||||
|
||||
(defn get-pending-local-txs
|
||||
[repo & {:keys [limit]}]
|
||||
(when-let [store (sqlite-store-or-throw repo)]
|
||||
(let [sql (str "select tx_id, outliner_op, undo_redo, "
|
||||
"forward_outliner_ops, inverse_outliner_ops, inferred_outliner_ops, "
|
||||
"normalized_tx_data, reversed_tx_data "
|
||||
"from client_ops where kind = 'tx' and pending = 1 "
|
||||
"order by created_at asc, id asc"
|
||||
(when (number? limit) " limit ?"))
|
||||
rows (sqlite-rows store sql (if (number? limit) [limit] []))]
|
||||
(->> rows
|
||||
(keep row->pending-local-tx)
|
||||
vec))))
|
||||
|
||||
(defn add-sync-conflicts!
|
||||
[repo conflicts]
|
||||
(when-let [store (sqlite-store-or-throw repo)]
|
||||
(let [now (.now js/Date)]
|
||||
(doseq [{:keys [block-uuid attr value remote-t]} conflicts]
|
||||
(when (and (uuid? block-uuid)
|
||||
(qualified-keyword? attr)
|
||||
(string? value))
|
||||
(let [attr-str (qualified-kw->str attr)]
|
||||
(sqlite-run! store
|
||||
"delete from sync_conflicts where block_uuid = ? and attr = ?"
|
||||
[(str block-uuid) attr-str])
|
||||
(when-not (string/blank? value)
|
||||
(sqlite-run! store
|
||||
(str "insert into sync_conflicts "
|
||||
"(block_uuid, attr, value, remote_t, created_at) "
|
||||
"values (?, ?, ?, ?, ?) "
|
||||
"on conflict(block_uuid, attr, value) do update set "
|
||||
"remote_t = excluded.remote_t, "
|
||||
"created_at = excluded.created_at")
|
||||
[(str block-uuid)
|
||||
attr-str
|
||||
value
|
||||
remote-t
|
||||
now]))))))))
|
||||
|
||||
(defn- sync-conflict-row->map
|
||||
[row]
|
||||
{:id (aget row "id")
|
||||
:block-uuid (parse-uuid-str (aget row "block_uuid"))
|
||||
:attr (str->qualified-kw (aget row "attr"))
|
||||
:value (aget row "value")
|
||||
:remote-t (aget row "remote_t")
|
||||
:created-at (aget row "created_at")})
|
||||
|
||||
(defn get-all-sync-conflicts
|
||||
[repo]
|
||||
(when-let [store (sqlite-store-or-throw repo)]
|
||||
(->> (sqlite-rows store
|
||||
(str "select id, block_uuid, attr, value, remote_t, created_at "
|
||||
"from sync_conflicts order by created_at desc, id desc")
|
||||
[])
|
||||
(map sync-conflict-row->map)
|
||||
(group-by :block-uuid))))
|
||||
|
||||
(defn get-sync-conflicts
|
||||
[repo block-uuid]
|
||||
(when (uuid? block-uuid)
|
||||
(when-let [store (sqlite-store-or-throw repo)]
|
||||
(->> (sqlite-rows store
|
||||
(str "select id, block_uuid, attr, value, remote_t, created_at "
|
||||
"from sync_conflicts where block_uuid = ? "
|
||||
"order by created_at desc, id desc")
|
||||
[(str block-uuid)])
|
||||
(mapv sync-conflict-row->map)))))
|
||||
|
||||
(defn clear-sync-conflicts!
|
||||
[repo block-uuid]
|
||||
(when (uuid? block-uuid)
|
||||
(when-let [store (sqlite-store-or-throw repo)]
|
||||
(sqlite-run! store
|
||||
"delete from sync_conflicts where block_uuid = ?"
|
||||
[(str block-uuid)]))))
|
||||
|
||||
(defn- pending-tx-id?
|
||||
[store tx-id]
|
||||
(let [row (sqlite-row store
|
||||
"select pending from client_ops where kind = 'tx' and tx_id = ?"
|
||||
[(str tx-id)])]
|
||||
(= 1 (some-> row (aget "pending")))))
|
||||
|
||||
(defn mark-pending-txs-false!
|
||||
[repo tx-ids]
|
||||
(when-let [store (sqlite-store-or-throw repo)]
|
||||
(let [tx-ids (->> tx-ids (filter uuid?) vec)
|
||||
pending-to-remove (->> tx-ids
|
||||
(filter (fn [tx-id]
|
||||
(pending-tx-id? store tx-id)))
|
||||
count)]
|
||||
(when (seq tx-ids)
|
||||
(doseq [tx-id tx-ids]
|
||||
(sqlite-run! store
|
||||
"update client_ops set pending = 0 where kind = 'tx' and tx_id = ?"
|
||||
[(str tx-id)])))
|
||||
pending-to-remove)))
|
||||
|
||||
(defn mark-failed-txs!
|
||||
[repo tx-ids]
|
||||
(when-let [store (sqlite-store-or-throw repo)]
|
||||
(let [tx-ids (->> tx-ids (filter uuid?) vec)
|
||||
pending-to-remove (->> tx-ids
|
||||
(filter (fn [tx-id]
|
||||
(pending-tx-id? store tx-id)))
|
||||
count)]
|
||||
(when (seq tx-ids)
|
||||
(doseq [tx-id tx-ids]
|
||||
(sqlite-run! store
|
||||
"update client_ops set pending = 0, failed = 1 where kind = 'tx' and tx_id = ?"
|
||||
[(str tx-id)])))
|
||||
pending-to-remove)))
|
||||
|
||||
(defn history-action-ops-by-tx-id
|
||||
[repo tx-id]
|
||||
(when-let [entry (get-local-tx-entry repo tx-id)]
|
||||
{:db-sync/forward-outliner-ops (some-> (:forward-outliner-ops entry) seq vec)
|
||||
:db-sync/inverse-outliner-ops (some-> (:inverse-outliner-ops entry) seq vec)}))
|
||||
|
||||
(defn- local-asset-op-map
|
||||
[op-type t value]
|
||||
(let [asset-uuid (:block-uuid value)]
|
||||
(case op-type
|
||||
:update-asset {:block/uuid asset-uuid
|
||||
:update-asset [:update-asset t value]}
|
||||
:remove-asset {:block/uuid asset-uuid
|
||||
:remove-asset [:remove-asset t value]}
|
||||
nil)))
|
||||
|
||||
(defn- sqlite-asset-op-by-uuid
|
||||
[store block-uuid]
|
||||
(when-let [row (sqlite-row store
|
||||
(str "select asset_uuid, asset_op, asset_t, asset_value "
|
||||
"from client_ops where kind = 'asset' and asset_uuid = ? limit 1")
|
||||
[(str block-uuid)])]
|
||||
(let [op-type (str->kw (aget row "asset_op"))
|
||||
t (aget row "asset_t")
|
||||
value (or (some-> (aget row "asset_value") sqlite-util/read-transit-str)
|
||||
{:block-uuid block-uuid})]
|
||||
(local-asset-op-map op-type t value))))
|
||||
|
||||
(defn- sqlite-upsert-asset-op!
|
||||
[store op-type t value]
|
||||
(let [block-uuid (:block-uuid value)]
|
||||
(sqlite-with-tx!
|
||||
store
|
||||
(fn [tx]
|
||||
(sqlite-run! tx "delete from client_ops where kind = 'asset' and asset_uuid = ?"
|
||||
[(str block-uuid)])
|
||||
(sqlite-run! tx
|
||||
(str "insert into client_ops ("
|
||||
"kind, created_at, asset_uuid, asset_op, asset_t, asset_value"
|
||||
") values ('asset', ?, ?, ?, ?, ?)")
|
||||
[(.now js/Date)
|
||||
(str block-uuid)
|
||||
(kw->str op-type)
|
||||
t
|
||||
(sqlite-util/write-transit-str value)])))))
|
||||
|
||||
;;; asset ops
|
||||
(defn add-asset-ops
|
||||
[repo asset-ops]
|
||||
(let [store (sqlite-store-or-throw repo)
|
||||
ops (ops-coercer asset-ops)]
|
||||
(assert (some? store) repo)
|
||||
(letfn [(already-removed? [remove-op t]
|
||||
(some-> remove-op second (> t)))
|
||||
(update-after-remove? [update-op t]
|
||||
(some-> update-op second (> t)))]
|
||||
(doseq [op ops]
|
||||
(let [[op-type t value] op
|
||||
{:keys [block-uuid]} value
|
||||
existing-op (sqlite-asset-op-by-uuid store block-uuid)]
|
||||
(case op-type
|
||||
:update-asset
|
||||
(let [remove-asset-op (:remove-asset existing-op)]
|
||||
(when-not (already-removed? remove-asset-op t)
|
||||
(sqlite-upsert-asset-op! store :update-asset t value)))
|
||||
|
||||
:remove-asset
|
||||
(let [update-asset-op (:update-asset existing-op)]
|
||||
(when-not (update-after-remove? update-asset-op t)
|
||||
(sqlite-upsert-asset-op! store :remove-asset t value)))
|
||||
|
||||
nil)))
|
||||
nil)))
|
||||
|
||||
(defn add-all-exists-asset-as-ops
|
||||
[repo]
|
||||
(let [conn (worker-state/get-datascript-conn repo)
|
||||
_ (assert (some? conn))
|
||||
asset-block-uuids (->> (d/datoms @conn :avet :logseq.property.asset/type)
|
||||
(keep (fn [d]
|
||||
(:block/uuid (d/entity @conn (:e d)))))
|
||||
distinct)
|
||||
ops (map (fn [block-uuid] [:update-asset 1 {:block-uuid block-uuid}])
|
||||
asset-block-uuids)]
|
||||
(add-asset-ops repo ops)))
|
||||
|
||||
(defn get-unpushed-asset-ops-count
|
||||
[repo]
|
||||
(when-let [store (sqlite-store-or-throw repo)]
|
||||
(or (some-> (sqlite-row store
|
||||
"select count(*) as c from client_ops where kind = 'asset'"
|
||||
[])
|
||||
(aget "c"))
|
||||
0)))
|
||||
|
||||
(defn get-all-asset-ops
|
||||
[repo]
|
||||
(when-let [store (sqlite-store-or-throw repo)]
|
||||
(->> (sqlite-rows store
|
||||
"select asset_op, asset_t, asset_value from client_ops where kind = 'asset' order by id asc"
|
||||
[])
|
||||
(keep (fn [row]
|
||||
(let [op-type (str->kw (aget row "asset_op"))
|
||||
t (aget row "asset_t")
|
||||
value (some-> (aget row "asset_value") sqlite-util/read-transit-str)]
|
||||
(when (and op-type (map? value) (:block-uuid value))
|
||||
(local-asset-op-map op-type t value)))))
|
||||
vec)))
|
||||
|
||||
(defn remove-asset-op
|
||||
[repo asset-uuid]
|
||||
(when-let [store (sqlite-store-or-throw repo)]
|
||||
(sqlite-run! store
|
||||
"delete from client_ops where kind = 'asset' and asset_uuid = ?"
|
||||
[(str asset-uuid)])))
|
||||
|
||||
(defn cleanup-finished-history-ops!
|
||||
[repo protected-tx-ids]
|
||||
(if-let [store (sqlite-store-or-throw repo)]
|
||||
(let [protected-tx-ids (set protected-tx-ids)
|
||||
tx-id-rows (sqlite-rows store
|
||||
(str "select tx_id from client_ops "
|
||||
"where kind = 'tx' and pending = 0 and tx_id is not null")
|
||||
[])
|
||||
removable-tx-ids (->> tx-id-rows
|
||||
(keep (fn [row]
|
||||
(let [tx-id (parse-uuid-str (aget row "tx_id"))]
|
||||
(when (and (uuid? tx-id)
|
||||
(not (contains? protected-tx-ids tx-id)))
|
||||
tx-id))))
|
||||
vec)]
|
||||
(when (seq removable-tx-ids)
|
||||
(doseq [tx-id removable-tx-ids]
|
||||
(sqlite-run! store
|
||||
"delete from client_ops where kind = 'tx' and tx_id = ?"
|
||||
[(str tx-id)])))
|
||||
(count removable-tx-ids))
|
||||
0))
|
||||
27
src/main/frontend/worker/sync/const.cljs
Normal file
27
src/main/frontend/worker/sync/const.cljs
Normal file
@@ -0,0 +1,27 @@
|
||||
(ns frontend.worker.sync.const
|
||||
"RTC constants"
|
||||
(:require [logseq.common.defkeywords :as common-def :refer [defkeywords]]
|
||||
[logseq.db.frontend.kv-entity :as kv-entity]
|
||||
[logseq.db.frontend.property :as db-property]))
|
||||
|
||||
(defkeywords
|
||||
:db-sync/invalid-e2ee-password
|
||||
{:doc "The supplied E2EE password cannot decrypt the current server private key."}
|
||||
:rtc/ignore-attr-when-syncing
|
||||
{:doc "keyword option for RTC. ignore this *attr* when syncing graph. Default false"}
|
||||
:rtc/ignore-entity-when-init-upload
|
||||
{:doc "keyword option for RTC. ignore this *entity* when initial uploading graph. Default false"})
|
||||
|
||||
(def ignore-attrs-when-syncing
|
||||
(into #{}
|
||||
(keep (fn [[kw config]] (when (get-in config [:rtc :rtc/ignore-attr-when-syncing]) kw)))
|
||||
db-property/built-in-properties))
|
||||
|
||||
(def ignore-entities-when-init-upload
|
||||
(into #{}
|
||||
(keep (fn [[kw config]] (when (get-in config [:rtc :rtc/ignore-entity-when-init-upload]) kw)))
|
||||
kv-entity/kv-entities))
|
||||
|
||||
(def encrypt-attr-set
|
||||
"block attributes that need to be encrypted"
|
||||
#{:block/title :block/name})
|
||||
909
src/main/frontend/worker/sync/crypt.cljs
Normal file
909
src/main/frontend/worker/sync/crypt.cljs
Normal file
@@ -0,0 +1,909 @@
|
||||
(ns frontend.worker.sync.crypt
|
||||
"E2EE helpers for db-sync."
|
||||
(:require [clojure.string :as string]
|
||||
[frontend.common.crypt :as crypt]
|
||||
[frontend.common.thread-api :refer [def-thread-api]]
|
||||
[frontend.worker-common.util :as worker-util]
|
||||
[frontend.worker.platform :as platform]
|
||||
[frontend.worker.state :as worker-state]
|
||||
[frontend.worker.sync.auth :as sync-auth]
|
||||
[frontend.worker.sync.const :as sync-const]
|
||||
[frontend.worker.ui-request :as ui-request]
|
||||
[lambdaisland.glogi :as log]
|
||||
[logseq.db :as ldb]
|
||||
[promesa.core :as p]
|
||||
[frontend.worker.sync.util :refer [fail-fast fetch-json coerce-http-request] :as sync-util]))
|
||||
|
||||
(defonce ^:private *graph->aes-key (atom {}))
|
||||
(defonce ^:private *user-rsa-key-pair-inflight (atom {}))
|
||||
(defonce ^:private *ensure-user-rsa-key-pair-inflight (atom {}))
|
||||
(defonce ^:private node-default-auth-file "~/logseq/auth.json")
|
||||
(defonce ^:private e2ee-password-secret-key "logseq-encrypted-password")
|
||||
(def ^:private invalid-transit ::invalid-transit)
|
||||
|
||||
(defn- runtime
|
||||
[platform']
|
||||
(get-in platform' [:env :runtime]))
|
||||
|
||||
(defn- read-transit-safe
|
||||
[value]
|
||||
(try
|
||||
(ldb/read-transit-str value)
|
||||
(catch :default _
|
||||
invalid-transit)))
|
||||
|
||||
(defn- browser-runtime?
|
||||
[platform']
|
||||
(= :browser (runtime platform')))
|
||||
|
||||
(defn- owner-source
|
||||
[platform']
|
||||
(get-in platform' [:env :owner-source]))
|
||||
|
||||
(defn- capacitor-runtime?
|
||||
[platform']
|
||||
(and (= :browser (runtime platform'))
|
||||
(= :capacitor (owner-source platform'))))
|
||||
|
||||
(defn- auth-file-path
|
||||
[]
|
||||
node-default-auth-file)
|
||||
|
||||
(defn- interactive-runtime?
|
||||
[]
|
||||
(let [env (:env (platform/current))
|
||||
runtime' (:runtime env)
|
||||
owner-source' (:owner-source env)]
|
||||
(or (= :browser runtime')
|
||||
(and (= :node runtime')
|
||||
(= :electron owner-source')))))
|
||||
|
||||
(defn- missing-e2ee-password-ex
|
||||
[data]
|
||||
(ex-info "missing-e2ee-password"
|
||||
(merge {:code :db-sync/missing-e2ee-password
|
||||
:field :e2ee-password}
|
||||
data)))
|
||||
|
||||
(defn- fail-missing-e2ee-password!
|
||||
[data]
|
||||
(fail-fast :db-sync/missing-e2ee-password
|
||||
(merge {:code :db-sync/missing-e2ee-password
|
||||
:field :e2ee-password}
|
||||
data)))
|
||||
|
||||
(defn- ensure-refresh-token!
|
||||
[refresh-token]
|
||||
(when-not (seq refresh-token)
|
||||
(fail-missing-e2ee-password! {:reason :missing-refresh-token
|
||||
:hint "Run logseq login first."})))
|
||||
|
||||
(def ^:private non-retriable-user-rsa-key-error-codes
|
||||
#{:ui-interaction-required
|
||||
:ui-request-cancelled
|
||||
:ui-request-rejected
|
||||
:ui-request-timeout})
|
||||
|
||||
(defn- user-rsa-key-cache-retryable-error?
|
||||
[error]
|
||||
(not (contains? non-retriable-user-rsa-key-error-codes
|
||||
(:code (ex-data error)))))
|
||||
|
||||
(defn- parse-auth-file
|
||||
[text]
|
||||
(when (seq text)
|
||||
(try
|
||||
(js->clj (js/JSON.parse text) :keywordize-keys true)
|
||||
(catch :default _
|
||||
invalid-transit))))
|
||||
|
||||
(defn- <read-refresh-token-from-auth-file
|
||||
[platform']
|
||||
(p/let [text (-> (platform/read-text! platform' (auth-file-path))
|
||||
(p/catch (fn [_]
|
||||
nil)))
|
||||
auth-data (parse-auth-file text)]
|
||||
(when (= invalid-transit auth-data)
|
||||
(fail-missing-e2ee-password! {:reason :invalid-auth-file
|
||||
:hint "Run logseq login first."}))
|
||||
(let [refresh-token (:refresh-token auth-data)]
|
||||
(ensure-refresh-token! refresh-token)
|
||||
refresh-token)))
|
||||
|
||||
(defn- <save-e2ee-password
|
||||
[password]
|
||||
(p/let [platform' (platform/current)
|
||||
refresh-token (if (browser-runtime? platform')
|
||||
(:auth/refresh-token @worker-state/*state)
|
||||
(<read-refresh-token-from-auth-file platform'))
|
||||
_ (ensure-refresh-token! refresh-token)
|
||||
result (crypt/<encrypt-text-by-text-password refresh-token password)
|
||||
text (ldb/write-transit-str result)
|
||||
native-saved? (if (capacitor-runtime? platform')
|
||||
(-> (ui-request/<request :native-save-e2ee-password
|
||||
{:key e2ee-password-secret-key
|
||||
:encrypted-text text})
|
||||
(p/then (fn [resp]
|
||||
(true? (:supported? resp))))
|
||||
(p/catch (fn [e]
|
||||
(log/warn :db-sync/save-e2ee-password-native-failed {:error e})
|
||||
false)))
|
||||
false)]
|
||||
(if native-saved?
|
||||
nil
|
||||
(platform/save-secret-text! platform' e2ee-password-secret-key text))))
|
||||
|
||||
(defn- <read-platform-e2ee-password-text
|
||||
[platform']
|
||||
(-> (platform/read-secret-text platform' e2ee-password-secret-key)
|
||||
(p/catch (fn [e]
|
||||
(log/warn :db-sync/read-e2ee-password-secret-failed {:error e})
|
||||
nil))))
|
||||
|
||||
(defn- <read-e2ee-password-text
|
||||
[refresh-token]
|
||||
(ensure-refresh-token! refresh-token)
|
||||
(p/let [platform' (platform/current)
|
||||
native-result (if (capacitor-runtime? platform')
|
||||
(-> (ui-request/<request :native-get-e2ee-password
|
||||
{:key e2ee-password-secret-key})
|
||||
(p/catch (fn [e]
|
||||
(log/warn :db-sync/read-e2ee-password-native-failed {:error e})
|
||||
{:supported? false})))
|
||||
{:supported? false})
|
||||
text (if (:supported? native-result)
|
||||
(:encrypted-text native-result)
|
||||
(<read-platform-e2ee-password-text platform'))]
|
||||
text))
|
||||
|
||||
(defn- <decrypt-e2ee-password-text
|
||||
[refresh-token text]
|
||||
(if-not (seq text)
|
||||
(p/rejected (missing-e2ee-password-ex {:reason :missing-persisted-password
|
||||
:hint "Provide --e2ee-password to persist it."}))
|
||||
(let [data (try
|
||||
(ldb/read-transit-str text)
|
||||
(catch :default _
|
||||
invalid-transit))]
|
||||
(when (= invalid-transit data)
|
||||
(fail-fast :db-sync/invalid-e2ee-password-payload
|
||||
{:field :e2ee-password
|
||||
:reason :invalid-transit-payload}))
|
||||
(crypt/<decrypt-text-by-text-password refresh-token data))))
|
||||
|
||||
(defn- <read-e2ee-password
|
||||
[refresh-token]
|
||||
(p/let [text (<read-e2ee-password-text refresh-token)]
|
||||
(<decrypt-e2ee-password-text refresh-token text)))
|
||||
|
||||
(defn- <clear-e2ee-password!
|
||||
[]
|
||||
(p/let [platform' (platform/current)
|
||||
native-deleted? (if (capacitor-runtime? platform')
|
||||
(-> (ui-request/<request :native-delete-e2ee-password
|
||||
{:key e2ee-password-secret-key})
|
||||
(p/then (fn [resp]
|
||||
(true? (:supported? resp))))
|
||||
(p/catch (fn [e]
|
||||
(log/warn :db-sync/delete-e2ee-password-native-failed {:error e})
|
||||
false)))
|
||||
false)
|
||||
_ (when-not native-deleted?
|
||||
(-> (platform/delete-secret-text! platform' e2ee-password-secret-key)
|
||||
(p/catch (fn [e]
|
||||
(log/warn :db-sync/delete-e2ee-password-secret-failed {:error e})
|
||||
nil))))]
|
||||
nil))
|
||||
|
||||
(defn e2ee-base
|
||||
[]
|
||||
(or (:http-base @worker-state/*db-sync-config)
|
||||
(when-let [ws-url (:ws-url @worker-state/*db-sync-config)]
|
||||
(let [base (cond
|
||||
(string/starts-with? ws-url "wss://")
|
||||
(str "https://" (subs ws-url (count "wss://")))
|
||||
|
||||
(string/starts-with? ws-url "ws://")
|
||||
(str "http://" (subs ws-url (count "ws://")))
|
||||
|
||||
:else ws-url)]
|
||||
(string/replace base #"/sync/%s$" "")))))
|
||||
|
||||
(defn graph-e2ee?
|
||||
[repo]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(ldb/get-graph-rtc-e2ee? @conn)))
|
||||
|
||||
(defn- get-user-uuid []
|
||||
(some-> (sync-util/auth-token) worker-util/parse-jwt :sub))
|
||||
|
||||
(defn- token->user-uuid
|
||||
[token]
|
||||
(some-> token worker-util/parse-jwt :sub))
|
||||
|
||||
(defn- <resolve-user-uuid
|
||||
[]
|
||||
(let [user-id (get-user-uuid)]
|
||||
(if (seq user-id)
|
||||
(p/resolved user-id)
|
||||
(-> (sync-auth/<resolve-ws-token)
|
||||
(p/then token->user-uuid)
|
||||
(p/catch (fn [_error]
|
||||
nil))))))
|
||||
|
||||
(defn- <get-item
|
||||
[k]
|
||||
(assert k)
|
||||
(p/let [r (platform/kv-get (platform/current) k)]
|
||||
(cond
|
||||
(instance? js/ArrayBuffer r) (js/Uint8Array. r)
|
||||
:else r)))
|
||||
|
||||
(defn- <set-item!
|
||||
[k value]
|
||||
(assert k)
|
||||
(platform/kv-set! (platform/current) k value))
|
||||
|
||||
(defn- <clear-item!
|
||||
[k]
|
||||
(assert k)
|
||||
(platform/kv-set! (platform/current) k nil))
|
||||
|
||||
(defn- graph-encrypted-aes-key-idb-key
|
||||
[graph-id]
|
||||
(str "rtc-encrypted-aes-key###" graph-id))
|
||||
|
||||
(defn- user-rsa-key-pair-idb-key
|
||||
[base user-id]
|
||||
(str "rtc-user-rsa-key-pair###" base "###" user-id))
|
||||
|
||||
(defn <fetch-user-rsa-key-pair-raw
|
||||
[base]
|
||||
(fetch-json (str base "/e2ee/user-keys")
|
||||
{:method "GET"}
|
||||
{:response-schema :e2ee/user-keys}))
|
||||
|
||||
(defn- user-rsa-key-pair-valid?
|
||||
[pair]
|
||||
(and (map? pair)
|
||||
(string? (:public-key pair))
|
||||
(string? (:encrypted-private-key pair))))
|
||||
|
||||
(defn- <set-user-rsa-key-pair-to-idb!
|
||||
[base user-id pair]
|
||||
(when (and (string? base)
|
||||
(string? user-id)
|
||||
(user-rsa-key-pair-valid? pair))
|
||||
(<set-item! (user-rsa-key-pair-idb-key base user-id)
|
||||
(ldb/write-transit-str pair)))
|
||||
pair)
|
||||
|
||||
(defn- <get-user-rsa-key-pair-from-idb
|
||||
[base user-id]
|
||||
(when (and (string? base) (string? user-id))
|
||||
(p/let [pair-str (<get-item (user-rsa-key-pair-idb-key base user-id))
|
||||
pair (ldb/read-transit-str pair-str)]
|
||||
(when (user-rsa-key-pair-valid? pair)
|
||||
pair))))
|
||||
|
||||
(defn- <clear-user-rsa-key-pair-cache!
|
||||
[base user-id]
|
||||
(let [k [base user-id]]
|
||||
(swap! *user-rsa-key-pair-inflight dissoc k)
|
||||
(when (and (string? base) (string? user-id))
|
||||
(<clear-item! (user-rsa-key-pair-idb-key base user-id)))))
|
||||
|
||||
(defn- <get-user-rsa-key-pair-raw
|
||||
[base]
|
||||
(p/let [user-id (<resolve-user-uuid)]
|
||||
(when-not (and (string? base) (string? user-id))
|
||||
(fail-fast :db-sync/missing-field {:base base :user-id user-id :field :user-rsa-key-pair}))
|
||||
(let [k [base user-id]]
|
||||
(if-let [inflight (get @*user-rsa-key-pair-inflight k)]
|
||||
inflight
|
||||
(let [task (-> (p/let [cached (<get-user-rsa-key-pair-from-idb base user-id)]
|
||||
(if cached
|
||||
cached
|
||||
(p/let [pair (<fetch-user-rsa-key-pair-raw base)]
|
||||
(if (user-rsa-key-pair-valid? pair)
|
||||
(p/let [_ (<set-user-rsa-key-pair-to-idb! base user-id pair)]
|
||||
pair)
|
||||
nil))))
|
||||
(p/finally (fn []
|
||||
(swap! *user-rsa-key-pair-inflight dissoc k))))]
|
||||
(swap! *user-rsa-key-pair-inflight assoc k task)
|
||||
task)))))
|
||||
|
||||
(defn <upload-user-rsa-key-pair!
|
||||
[base public-key encrypted-private-key]
|
||||
(let [body (coerce-http-request :e2ee/user-keys
|
||||
{:public-key public-key
|
||||
:encrypted-private-key encrypted-private-key})]
|
||||
(when (nil? body)
|
||||
(fail-fast :db-sync/invalid-field {:type :e2ee/user-keys :body body}))
|
||||
(p/let [pair (fetch-json (str base "/e2ee/user-keys")
|
||||
{:method "POST"
|
||||
:headers {"content-type" "application/json"}
|
||||
:body (js/JSON.stringify (clj->js body))}
|
||||
{:response-schema :e2ee/user-keys})
|
||||
user-id (<resolve-user-uuid)
|
||||
_ (<set-user-rsa-key-pair-to-idb! base user-id pair)]
|
||||
pair)))
|
||||
|
||||
(defn- <request-e2ee-password-from-ui
|
||||
[payload]
|
||||
(p/let [{:keys [password]} (ui-request/<request :request-e2ee-password
|
||||
payload
|
||||
{:hint "Provide e2ee-password to continue."})]
|
||||
(when-not (seq password)
|
||||
(fail-fast :db-sync/missing-e2ee-password {:field :e2ee-password
|
||||
:reason :empty-ui-password}))
|
||||
password))
|
||||
|
||||
(defn- <verify-e2ee-password
|
||||
[password encrypted-private-key-or-str]
|
||||
(when-not (seq password)
|
||||
(fail-missing-e2ee-password! {:reason :empty-password}))
|
||||
(p/let [encrypted-private-key (if (string? encrypted-private-key-or-str)
|
||||
(ldb/read-transit-str encrypted-private-key-or-str)
|
||||
encrypted-private-key-or-str)
|
||||
private-key (-> (crypt/<decrypt-private-key password encrypted-private-key)
|
||||
(p/catch (fn [error]
|
||||
(if (true? (:invalid-password? (ex-data error)))
|
||||
(p/rejected
|
||||
(ex-info "invalid-e2ee-password"
|
||||
{:code :db-sync/invalid-e2ee-password}
|
||||
error))
|
||||
(p/rejected error)))))]
|
||||
private-key))
|
||||
|
||||
(defn- <verify-and-save-e2ee-password!
|
||||
[password encrypted-private-key-or-str]
|
||||
(p/let [private-key (<verify-e2ee-password password encrypted-private-key-or-str)
|
||||
_ (<save-e2ee-password password)]
|
||||
private-key))
|
||||
|
||||
(defn- <verify-and-save-e2ee-password-from-server!
|
||||
[password]
|
||||
(let [base (e2ee-base)]
|
||||
(when-not (string? base)
|
||||
(fail-fast :db-sync/missing-field {:base base
|
||||
:field :e2ee-base}))
|
||||
(p/let [{:keys [encrypted-private-key]} (<fetch-user-rsa-key-pair-raw base)]
|
||||
(when-not (string? encrypted-private-key)
|
||||
(fail-fast :db-sync/missing-field {:base base
|
||||
:field :encrypted-private-key}))
|
||||
(<verify-and-save-e2ee-password! password encrypted-private-key))))
|
||||
|
||||
(defn- <generate-and-upload-user-rsa-key-pair!
|
||||
[base {:keys [password]}]
|
||||
(p/let [{:keys [publicKey privateKey]} (crypt/<generate-rsa-key-pair)
|
||||
password (cond
|
||||
(and (string? password) (seq password))
|
||||
password
|
||||
|
||||
(interactive-runtime?)
|
||||
(<request-e2ee-password-from-ui {:reason :generate-user-rsa-key-pair})
|
||||
|
||||
:else
|
||||
(fail-missing-e2ee-password! {:reason :missing-password-for-generate-user-rsa-key-pair
|
||||
:hint "Provide --e2ee-password when running sync ensure-keys --upload-keys."}))
|
||||
encrypted-private-key (crypt/<encrypt-private-key password privateKey)
|
||||
exported-public-key (crypt/<export-public-key publicKey)
|
||||
public-key-str (ldb/write-transit-str exported-public-key)
|
||||
encrypted-private-key-str (ldb/write-transit-str encrypted-private-key)]
|
||||
(p/let [_ (<save-e2ee-password password)
|
||||
_ (<upload-user-rsa-key-pair! base public-key-str encrypted-private-key-str)]
|
||||
{:public-key public-key-str
|
||||
:encrypted-private-key encrypted-private-key-str
|
||||
:password password})))
|
||||
|
||||
(defn- <ensure-user-rsa-key-pair-raw
|
||||
[base {:keys [ensure-server? server-rsa-keys-exists?] :as opts}]
|
||||
(p/let [existing (<get-user-rsa-key-pair-raw base)
|
||||
existing-valid? (user-rsa-key-pair-valid? existing)
|
||||
server-rsa-keys-exists?
|
||||
(cond
|
||||
(boolean? server-rsa-keys-exists?) server-rsa-keys-exists?
|
||||
(and ensure-server? existing-valid?)
|
||||
(p/let [server-pair (<fetch-user-rsa-key-pair-raw base)]
|
||||
(user-rsa-key-pair-valid? server-pair))
|
||||
:else nil)]
|
||||
(cond
|
||||
(and existing-valid? (not= false server-rsa-keys-exists?))
|
||||
existing
|
||||
|
||||
existing-valid?
|
||||
(p/let [_ (<upload-user-rsa-key-pair! base (:public-key existing) (:encrypted-private-key existing))]
|
||||
existing)
|
||||
|
||||
:else
|
||||
(<generate-and-upload-user-rsa-key-pair! base opts))))
|
||||
|
||||
(defn- <ensure-user-rsa-key-pair
|
||||
[base {:keys [password ensure-server? server-rsa-keys-exists?] :as opts}]
|
||||
(if (seq password)
|
||||
(<ensure-user-rsa-key-pair-raw base opts)
|
||||
(p/let [user-id (<resolve-user-uuid)]
|
||||
(when-not (and (string? base) (string? user-id))
|
||||
(fail-fast :db-sync/missing-field {:base base
|
||||
:user-id user-id
|
||||
:field :user-rsa-key-pair}))
|
||||
(let [k [base user-id ensure-server? server-rsa-keys-exists?]]
|
||||
(if-let [inflight (get @*ensure-user-rsa-key-pair-inflight k)]
|
||||
inflight
|
||||
(let [task (-> (<ensure-user-rsa-key-pair-raw base opts)
|
||||
(p/finally (fn []
|
||||
(swap! *ensure-user-rsa-key-pair-inflight dissoc k))))]
|
||||
(swap! *ensure-user-rsa-key-pair-inflight assoc k task)
|
||||
task))))))
|
||||
|
||||
(defn ensure-user-rsa-keys!
|
||||
([]
|
||||
(ensure-user-rsa-keys! nil))
|
||||
([opts]
|
||||
(let [base (e2ee-base)]
|
||||
(if (string? base)
|
||||
(<ensure-user-rsa-key-pair base opts)
|
||||
(do
|
||||
(log/info :db-sync/skip-ensure-user-rsa-keys {:reason :missing-e2ee-base})
|
||||
(p/resolved nil))))))
|
||||
|
||||
(defn- <decrypt-private-key
|
||||
([encrypted-private-key-str]
|
||||
(<decrypt-private-key encrypted-private-key-str nil))
|
||||
([encrypted-private-key-str {:keys [ui-password* save-ui-password?]
|
||||
:or {save-ui-password? true}}]
|
||||
(let [<decrypt-with-ui-request
|
||||
(fn [encrypted-private-key]
|
||||
(p/let [password (or (when (and ui-password* (seq @ui-password*))
|
||||
@ui-password*)
|
||||
(<request-e2ee-password-from-ui {:reason :decrypt-user-rsa-private-key}))
|
||||
_ (when ui-password*
|
||||
(reset! ui-password* password))
|
||||
private-key (<verify-e2ee-password password encrypted-private-key)
|
||||
_ (when save-ui-password?
|
||||
(<save-e2ee-password password))]
|
||||
private-key))
|
||||
|
||||
<decrypt-in-headless
|
||||
(fn [encrypted-private-key]
|
||||
(let [refresh-token (:auth/refresh-token @worker-state/*state)]
|
||||
(p/let [text (<read-e2ee-password-text refresh-token)]
|
||||
(if (seq text)
|
||||
(p/let [password (<decrypt-e2ee-password-text refresh-token text)]
|
||||
(when-not (seq password)
|
||||
(fail-missing-e2ee-password! {:reason :headless-empty-password
|
||||
:hint "Provide --e2ee-password to persist it."}))
|
||||
(<verify-e2ee-password password encrypted-private-key))
|
||||
(p/rejected (missing-e2ee-password-ex {:reason :missing-persisted-password
|
||||
:hint "Provide --e2ee-password to persist it."}))))))]
|
||||
(p/let [encrypted-private-key (ldb/read-transit-str encrypted-private-key-str)]
|
||||
(if (and ui-password* (seq @ui-password*))
|
||||
(<decrypt-with-ui-request encrypted-private-key)
|
||||
(-> (<decrypt-in-headless encrypted-private-key)
|
||||
(p/catch (fn [headless-error]
|
||||
(if-not (interactive-runtime?)
|
||||
(p/rejected headless-error)
|
||||
(<decrypt-with-ui-request encrypted-private-key))))))))))
|
||||
|
||||
(defn- <import-public-key
|
||||
[public-key-str]
|
||||
(p/let [exported (ldb/read-transit-str public-key-str)]
|
||||
(crypt/<import-public-key exported)))
|
||||
|
||||
(defn- <fetch-user-public-key-by-email
|
||||
[base email]
|
||||
(fetch-json (str base "/e2ee/user-public-key?email=" (js/encodeURIComponent email))
|
||||
{:method "GET"}
|
||||
{:response-schema :e2ee/user-public-key}))
|
||||
|
||||
(defn- <fetch-graph-encrypted-aes-key-raw
|
||||
[base graph-id]
|
||||
(fetch-json (str base "/e2ee/graphs/" graph-id "/aes-key")
|
||||
{:method "GET"}
|
||||
{:response-schema :e2ee/graph-aes-key}))
|
||||
|
||||
(defn- <fetch-graph-encrypted-aes-key
|
||||
[base graph-id]
|
||||
(when graph-id
|
||||
(p/let [resp (<fetch-graph-encrypted-aes-key-raw base graph-id)]
|
||||
(when-let [encrypted-aes-key (:encrypted-aes-key resp)]
|
||||
(ldb/read-transit-str encrypted-aes-key)))))
|
||||
|
||||
(defn- <upsert-graph-encrypted-aes-key!
|
||||
[base graph-id encrypted-aes-key]
|
||||
(let [body (coerce-http-request :e2ee/graph-aes-key
|
||||
{:encrypted-aes-key encrypted-aes-key})]
|
||||
(when (nil? body)
|
||||
(fail-fast :db-sync/invalid-field {:type :e2ee/graph-aes-key :body body}))
|
||||
(fetch-json (str base "/e2ee/graphs/" graph-id "/aes-key")
|
||||
{:method "POST"
|
||||
:headers {"content-type" "application/json"}
|
||||
:body (js/JSON.stringify (clj->js body))}
|
||||
{:response-schema :e2ee/graph-aes-key})))
|
||||
|
||||
(defn- <load-user-rsa-key-material
|
||||
[base user-id graph-id]
|
||||
(let [ui-password* (atom nil)]
|
||||
(letfn [(<load-once []
|
||||
(p/let [{:keys [public-key encrypted-private-key]} (<ensure-user-rsa-key-pair-raw base nil)
|
||||
_ (when-not (and (string? public-key) (string? encrypted-private-key))
|
||||
(fail-fast :db-sync/missing-field
|
||||
{:base base
|
||||
:user-id user-id
|
||||
:graph-id graph-id
|
||||
:field :user-rsa-key-pair}))
|
||||
public-key' (<import-public-key public-key)
|
||||
private-key' (<decrypt-private-key encrypted-private-key
|
||||
{:ui-password* ui-password*
|
||||
:save-ui-password? false})]
|
||||
{:public-key public-key'
|
||||
:private-key private-key'}))]
|
||||
(-> (<load-once)
|
||||
(p/catch (fn [error]
|
||||
(if-not (user-rsa-key-cache-retryable-error? error)
|
||||
(p/rejected error)
|
||||
(-> (p/let [_ (<clear-user-rsa-key-pair-cache! base user-id)]
|
||||
(<load-once))
|
||||
(p/catch (fn [retry-error]
|
||||
(log/warn :db-sync/user-rsa-key-cache-invalid
|
||||
{:base base
|
||||
:user-id user-id
|
||||
:graph-id graph-id
|
||||
:first-error error
|
||||
:retry-error retry-error})
|
||||
(throw retry-error)))))))
|
||||
(p/then (fn [key-material]
|
||||
(if-let [password (when (seq @ui-password*)
|
||||
@ui-password*)]
|
||||
(p/let [_ (<save-e2ee-password password)]
|
||||
key-material)
|
||||
key-material)))))))
|
||||
|
||||
(defn <preflight-upload-e2ee!
|
||||
[repo encrypted-graph?]
|
||||
(if-not (true? encrypted-graph?)
|
||||
(p/resolved nil)
|
||||
(let [base (e2ee-base)]
|
||||
(p/let [user-id (<resolve-user-uuid)]
|
||||
(when-not (and (string? base) (string? user-id))
|
||||
(fail-fast :db-sync/missing-field {:repo repo
|
||||
:base base
|
||||
:user-id user-id
|
||||
:field :user-rsa-key-pair}))
|
||||
(p/let [_ (<load-user-rsa-key-material base user-id nil)]
|
||||
nil)))))
|
||||
|
||||
(defn <ensure-graph-aes-key
|
||||
[repo graph-id]
|
||||
(if-not (graph-e2ee? repo)
|
||||
(p/resolved nil)
|
||||
(if-let [cached (get @*graph->aes-key graph-id)]
|
||||
(p/resolved cached)
|
||||
(let [base (e2ee-base)]
|
||||
(p/let [user-id (<resolve-user-uuid)]
|
||||
(when-not (and (string? base) (string? user-id))
|
||||
(fail-fast :db-sync/missing-field {:base base :user-id user-id :graph-id graph-id}))
|
||||
(p/let [{:keys [public-key private-key]} (<load-user-rsa-key-material base user-id graph-id)
|
||||
local-encrypted (when graph-id
|
||||
(<get-item (graph-encrypted-aes-key-idb-key graph-id)))
|
||||
remote-encrypted (when (and (nil? local-encrypted) graph-id)
|
||||
(<fetch-graph-encrypted-aes-key base graph-id))
|
||||
encrypted-aes-key (or local-encrypted remote-encrypted)
|
||||
aes-key (if encrypted-aes-key
|
||||
(-> (crypt/<decrypt-aes-key private-key encrypted-aes-key)
|
||||
(p/catch (fn [error]
|
||||
(if-not (and graph-id local-encrypted)
|
||||
(throw error)
|
||||
(let [aes-key-k (graph-encrypted-aes-key-idb-key graph-id)]
|
||||
(-> (p/let [_ (<clear-item! aes-key-k)
|
||||
refetched-encrypted (<fetch-graph-encrypted-aes-key base graph-id)]
|
||||
(if-not refetched-encrypted
|
||||
(throw error)
|
||||
(p/let [aes-key (crypt/<decrypt-aes-key private-key refetched-encrypted)
|
||||
_ (<set-item! aes-key-k refetched-encrypted)]
|
||||
aes-key)))
|
||||
(p/catch (fn [retry-error]
|
||||
(log/warn :db-sync/graph-aes-key-cache-invalid
|
||||
{:base base
|
||||
:user-id user-id
|
||||
:graph-id graph-id
|
||||
:first-error error
|
||||
:retry-error retry-error})
|
||||
(throw retry-error)))))))))
|
||||
(p/let [aes-key (crypt/<generate-aes-key)
|
||||
encrypted (crypt/<encrypt-aes-key public-key aes-key)
|
||||
encrypted-str (ldb/write-transit-str encrypted)
|
||||
_ (<upsert-graph-encrypted-aes-key! base graph-id encrypted-str)
|
||||
_ (<set-item! (graph-encrypted-aes-key-idb-key graph-id) encrypted)]
|
||||
aes-key))
|
||||
_ (when (and graph-id encrypted-aes-key (nil? local-encrypted))
|
||||
(<set-item! (graph-encrypted-aes-key-idb-key graph-id) encrypted-aes-key))]
|
||||
(swap! *graph->aes-key assoc graph-id aes-key)
|
||||
aes-key))))))
|
||||
|
||||
(defn <fetch-graph-aes-key-for-download
|
||||
[graph-id]
|
||||
(let [base (e2ee-base)
|
||||
aes-key-k (graph-encrypted-aes-key-idb-key graph-id)]
|
||||
(when-not (and (string? base) (string? graph-id))
|
||||
(fail-fast :db-sync/missing-field {:base base :graph-id graph-id}))
|
||||
(letfn [(<fetch-once [{:keys [public-key encrypted-private-key]}]
|
||||
(p/let [_ (<clear-item! aes-key-k)]
|
||||
(when-not (and (string? public-key) (string? encrypted-private-key))
|
||||
(fail-fast :db-sync/missing-field {:graph-id graph-id :field :user-rsa-key-pair}))
|
||||
(p/let [private-key (<decrypt-private-key encrypted-private-key)
|
||||
encrypted-aes-key (p/let [resp (<fetch-graph-encrypted-aes-key-raw base graph-id)]
|
||||
(when-let [encrypted-aes-key (:encrypted-aes-key resp)]
|
||||
(ldb/read-transit-str encrypted-aes-key)))]
|
||||
(if-not encrypted-aes-key
|
||||
(fail-fast :db-sync/missing-field {:graph-id graph-id :field :encrypted-aes-key})
|
||||
(<set-item! aes-key-k encrypted-aes-key))
|
||||
(p/let [aes-key (crypt/<decrypt-aes-key private-key encrypted-aes-key)]
|
||||
(swap! *graph->aes-key assoc graph-id aes-key)
|
||||
aes-key))))]
|
||||
(p/let [pair (<get-user-rsa-key-pair-raw base)]
|
||||
(-> (<fetch-once pair)
|
||||
(p/catch
|
||||
(fn [error]
|
||||
(let [user-id (get-user-uuid)]
|
||||
(if (and (= "decrypt-aes-key" (ex-message error))
|
||||
(string? user-id))
|
||||
(-> (p/let [_ (<clear-user-rsa-key-pair-cache! base user-id)
|
||||
refreshed-pair (<get-user-rsa-key-pair-raw base)]
|
||||
(<fetch-once refreshed-pair))
|
||||
(p/catch (fn [retry-error]
|
||||
(log/warn :db-sync/user-rsa-key-cache-invalid-on-download
|
||||
{:base base
|
||||
:user-id user-id
|
||||
:graph-id graph-id
|
||||
:first-error error
|
||||
:retry-error retry-error})
|
||||
(throw retry-error))))
|
||||
(throw error))))))))))
|
||||
|
||||
(defn <grant-graph-access!
|
||||
[repo graph-id target-email]
|
||||
(if-not (graph-e2ee? repo)
|
||||
(p/resolved nil)
|
||||
(let [base (e2ee-base)]
|
||||
(when-not (string? base)
|
||||
(fail-fast :db-sync/missing-field {:base base :graph-id graph-id}))
|
||||
(p/let [aes-key (<ensure-graph-aes-key repo graph-id)
|
||||
_ (when (nil? aes-key)
|
||||
(fail-fast :db-sync/missing-field {:repo repo :field :aes-key}))
|
||||
resp (<fetch-user-public-key-by-email base target-email)
|
||||
public-key-str (:public-key resp)]
|
||||
(if-not (string? public-key-str)
|
||||
(fail-fast :db-sync/missing-field {:repo repo :field :public-key :email target-email})
|
||||
(p/let [public-key (<import-public-key public-key-str)
|
||||
encrypted (crypt/<encrypt-aes-key public-key aes-key)
|
||||
encrypted-str (ldb/write-transit-str encrypted)
|
||||
body (coerce-http-request :e2ee/grant-access
|
||||
{:target-user-email+encrypted-aes-key-coll
|
||||
[{:email target-email
|
||||
:encrypted-aes-key encrypted-str}]})
|
||||
_ (when (nil? body)
|
||||
(fail-fast :db-sync/invalid-field {:type :e2ee/grant-access :body body}))
|
||||
_ (fetch-json (str base "/e2ee/graphs/" graph-id "/grant-access")
|
||||
{:method "POST"
|
||||
:headers {"content-type" "application/json"}
|
||||
:body (js/JSON.stringify (clj->js body))}
|
||||
{:response-schema :e2ee/grant-access})]
|
||||
nil))))))
|
||||
|
||||
(defn <encrypt-text-value
|
||||
[aes-key value]
|
||||
(assert (string? value) (str "encrypting value should be a string, value: " value))
|
||||
(p/let [encrypted (crypt/<encrypt-text aes-key (ldb/write-transit-str value))]
|
||||
(ldb/write-transit-str encrypted)))
|
||||
|
||||
(defn <decrypt-text-value
|
||||
[aes-key value]
|
||||
(assert (string? value) (str "encrypted value should be a string, value: " value))
|
||||
(let [decoded (read-transit-safe value)]
|
||||
(if (= decoded invalid-transit)
|
||||
(p/resolved value)
|
||||
(p/let [value (or (crypt/<decrypt-text-if-encrypted aes-key decoded)
|
||||
decoded)
|
||||
value' (if (string? value)
|
||||
(read-transit-safe value)
|
||||
value)]
|
||||
(if (= value' invalid-transit)
|
||||
value
|
||||
value')))))
|
||||
|
||||
(defn- encrypt-tx-item
|
||||
[aes-key item]
|
||||
(cond
|
||||
(and (vector? item) (<= 4 (count item)))
|
||||
(let [attr (nth item 2)
|
||||
v (nth item 3)]
|
||||
(if (contains? sync-const/encrypt-attr-set attr)
|
||||
(p/let [v' (<encrypt-text-value aes-key v)]
|
||||
(assoc item 3 v'))
|
||||
(p/resolved item)))
|
||||
|
||||
:else
|
||||
(p/resolved item)))
|
||||
|
||||
(defn- decrypt-tx-item
|
||||
[aes-key item]
|
||||
(cond
|
||||
(and (vector? item) (<= 4 (count item)))
|
||||
(let [attr (nth item 2)
|
||||
v (nth item 3)]
|
||||
(if (contains? sync-const/encrypt-attr-set attr)
|
||||
(p/let [v' (<decrypt-text-value aes-key v)]
|
||||
(assoc item 3 v'))
|
||||
(p/resolved item)))
|
||||
|
||||
:else
|
||||
(p/resolved item)))
|
||||
|
||||
(defn <encrypt-tx-data
|
||||
[aes-key tx-data]
|
||||
(p/let [items (p/all (mapv (fn [item] (encrypt-tx-item aes-key item)) tx-data))]
|
||||
items))
|
||||
|
||||
(defn <decrypt-tx-data
|
||||
[aes-key tx-data]
|
||||
(p/let [items (p/all (mapv (fn [item] (decrypt-tx-item aes-key item)) tx-data))]
|
||||
items))
|
||||
|
||||
(defn- <decrypt-datoms
|
||||
[aes-key data]
|
||||
(p/all
|
||||
(map
|
||||
(fn [[e a v t]]
|
||||
(if (contains? sync-const/encrypt-attr-set a)
|
||||
(p/let [v' (<decrypt-text-value aes-key v)]
|
||||
[e a v' t])
|
||||
[e a v t]))
|
||||
data)))
|
||||
|
||||
(defn- <decrypt-snapshot-row
|
||||
[aes-key row]
|
||||
(let [[addr raw-content raw-addresses] row
|
||||
data (ldb/read-transit-str raw-content)
|
||||
addresses (when raw-addresses
|
||||
(js/JSON.parse raw-addresses))]
|
||||
(if (map? data)
|
||||
(p/let [keys (:keys data)
|
||||
keys' (if (seq keys)
|
||||
(<decrypt-datoms aes-key (:keys data))
|
||||
keys)
|
||||
result (assoc data :keys keys')]
|
||||
[addr (ldb/write-transit-str (cond-> result
|
||||
(some? addresses)
|
||||
(assoc :addresses addresses)))
|
||||
raw-addresses])
|
||||
(p/let [result (p/all (map #(<decrypt-datoms aes-key %) data))]
|
||||
[addr (ldb/write-transit-str result) raw-addresses]))))
|
||||
|
||||
(defn <decrypt-snapshot-rows-batch
|
||||
[aes-key rows-batch]
|
||||
(p/all (map #(<decrypt-snapshot-row aes-key %) rows-batch)))
|
||||
|
||||
(defn <decrypt-snapshot-datoms-batch
|
||||
[aes-key datoms]
|
||||
(p/all
|
||||
(map (fn [{:keys [a v] :as datom}]
|
||||
(if (contains? sync-const/encrypt-attr-set a)
|
||||
(p/let [v' (<decrypt-text-value aes-key v)]
|
||||
(assoc datom :v v'))
|
||||
(p/resolved datom)))
|
||||
datoms)))
|
||||
|
||||
(defn <encrypt-datoms
|
||||
([aes-key datoms]
|
||||
(<encrypt-datoms aes-key datoms nil))
|
||||
([aes-key datoms progress-f]
|
||||
(let [batch-size 5000
|
||||
total-count (count datoms)
|
||||
batches (partition-all batch-size datoms)]
|
||||
(p/loop [remaining batches
|
||||
result []
|
||||
encrypted-count 0]
|
||||
(if (empty? remaining)
|
||||
result
|
||||
(p/let [batch (first remaining)
|
||||
encrypted (p/all (map (fn [datom]
|
||||
(if (contains? sync-const/encrypt-attr-set (:a datom))
|
||||
(p/let [v' (<encrypt-text-value aes-key (:v datom))]
|
||||
(assoc datom :v v'))
|
||||
(p/resolved datom)))
|
||||
batch))]
|
||||
(let [encrypted-count' (+ encrypted-count (count batch))]
|
||||
(when progress-f
|
||||
(progress-f encrypted-count' total-count))
|
||||
(p/recur (rest remaining) (into result encrypted) encrypted-count'))))))))
|
||||
|
||||
(defn- <re-encrypt-private-key
|
||||
[encrypted-private-key-str old-password new-password]
|
||||
(p/let [encrypted-private-key (ldb/read-transit-str encrypted-private-key-str)
|
||||
private-key (crypt/<decrypt-private-key old-password encrypted-private-key)
|
||||
new-encrypted-private-key (crypt/<encrypt-private-key new-password private-key)]
|
||||
(ldb/write-transit-str new-encrypted-private-key)))
|
||||
|
||||
(defn <change-e2ee-password!
|
||||
[_refresh-token user-uuid old-password new-password]
|
||||
(let [base (e2ee-base)]
|
||||
(when-not (string? base)
|
||||
(fail-fast :db-sync/missing-field {:base base :user-uuid user-uuid}))
|
||||
(p/let [{:keys [public-key encrypted-private-key]} (<get-user-rsa-key-pair-raw base)]
|
||||
(when-not (and (string? public-key) (string? encrypted-private-key))
|
||||
(fail-fast :db-sync/missing-field {:base base :user-uuid user-uuid :field :user-rsa-key-pair}))
|
||||
(p/let [encrypted-private-key' (<re-encrypt-private-key encrypted-private-key old-password new-password)
|
||||
_ (<upload-user-rsa-key-pair! base public-key encrypted-private-key')
|
||||
_ (<save-e2ee-password new-password)]
|
||||
nil))))
|
||||
|
||||
(defn cancel-ui-requests!
|
||||
[context]
|
||||
(ui-request/cancel-all! context))
|
||||
|
||||
(def-thread-api :thread-api/get-user-rsa-key-pair
|
||||
[_token _user-uuid]
|
||||
(let [base (e2ee-base)]
|
||||
(when-not (string? base)
|
||||
(fail-fast :db-sync/missing-field {:base base}))
|
||||
(p/let [{:keys [public-key encrypted-private-key]} (<get-user-rsa-key-pair-raw base)]
|
||||
(when (and public-key encrypted-private-key)
|
||||
{:public-key public-key
|
||||
:encrypted-private-key encrypted-private-key}))))
|
||||
|
||||
(def-thread-api :thread-api/init-user-rsa-key-pair
|
||||
[_token _refresh-token _user-uuid]
|
||||
(let [base (e2ee-base)]
|
||||
(when-not (string? base)
|
||||
(fail-fast :db-sync/missing-field {:base base}))
|
||||
(p/let [existing (<get-user-rsa-key-pair-raw base)]
|
||||
(when-not (and (string? (:public-key existing))
|
||||
(string? (:encrypted-private-key existing)))
|
||||
(p/let [{:keys [publicKey privateKey]} (crypt/<generate-rsa-key-pair)
|
||||
password (<request-e2ee-password-from-ui {:reason :init-user-rsa-key-pair})
|
||||
encrypted-private-key (crypt/<encrypt-private-key password privateKey)
|
||||
exported-public-key (crypt/<export-public-key publicKey)
|
||||
public-key-str (ldb/write-transit-str exported-public-key)
|
||||
encrypted-private-key-str (ldb/write-transit-str encrypted-private-key)
|
||||
_ (<upload-user-rsa-key-pair! base public-key-str encrypted-private-key-str)
|
||||
_ (<save-e2ee-password password)]
|
||||
nil)))))
|
||||
|
||||
(def-thread-api :thread-api/reset-user-rsa-key-pair
|
||||
[_token _refresh-token _user-uuid new-password]
|
||||
(p/let [{:keys [publicKey privateKey]} (crypt/<generate-rsa-key-pair)
|
||||
encrypted-private-key (crypt/<encrypt-private-key new-password privateKey)
|
||||
exported-public-key (crypt/<export-public-key publicKey)
|
||||
public-key-str (ldb/write-transit-str exported-public-key)
|
||||
encrypted-private-key-str (ldb/write-transit-str encrypted-private-key)
|
||||
base (e2ee-base)]
|
||||
(when-not (string? base)
|
||||
(fail-fast :db-sync/missing-field {:base base}))
|
||||
(p/let [_ (<upload-user-rsa-key-pair! base public-key-str encrypted-private-key-str)
|
||||
_ (<save-e2ee-password new-password)]
|
||||
nil)))
|
||||
|
||||
(def-thread-api :thread-api/change-e2ee-password
|
||||
[_token refresh-token user-uuid old-password new-password]
|
||||
(<change-e2ee-password! refresh-token user-uuid old-password new-password))
|
||||
|
||||
(def-thread-api :thread-api/verify-and-save-e2ee-password
|
||||
[_refresh-token password]
|
||||
(p/let [_ (<verify-and-save-e2ee-password-from-server! password)]
|
||||
nil))
|
||||
|
||||
(def-thread-api :thread-api/get-e2ee-password
|
||||
[refresh-token]
|
||||
(p/let [password (<read-e2ee-password refresh-token)]
|
||||
{:password password}))
|
||||
|
||||
(def-thread-api :thread-api/save-e2ee-password
|
||||
[password]
|
||||
(<save-e2ee-password password))
|
||||
|
||||
(def-thread-api :thread-api/clear-e2ee-password
|
||||
[]
|
||||
(<clear-e2ee-password!))
|
||||
576
src/main/frontend/worker/sync/download.cljs
Normal file
576
src/main/frontend/worker/sync/download.cljs
Normal file
@@ -0,0 +1,576 @@
|
||||
(ns frontend.worker.sync.download
|
||||
"Download helpers for graph snapshots."
|
||||
(:require
|
||||
[datascript.core :as d]
|
||||
[frontend.common.thread-api :as thread-api]
|
||||
[frontend.worker-common.util :as worker-util]
|
||||
[frontend.worker.platform :as platform]
|
||||
[frontend.worker.search :as search]
|
||||
[frontend.worker.shared-service :as shared-service]
|
||||
[frontend.worker.state :as worker-state]
|
||||
[frontend.worker.sync.auth :as sync-auth]
|
||||
[frontend.worker.sync.client-op :as client-op]
|
||||
[frontend.worker.sync.crypt :as sync-crypt]
|
||||
[frontend.worker.sync.log-and-state :as rtc-log-and-state]
|
||||
[frontend.worker.sync.temp-sqlite :as sync-temp-sqlite]
|
||||
[frontend.worker.sync.util :refer [fail-fast] :as sync-util]
|
||||
[lambdaisland.glogi :as log]
|
||||
[logseq.db-sync.snapshot :as snapshot]
|
||||
[logseq.db.common.sqlite :as common-sqlite]
|
||||
[logseq.db.frontend.schema :as db-schema]
|
||||
[promesa.core :as p]
|
||||
[logseq.db :as ldb]))
|
||||
|
||||
(defn- ->uint8 [data]
|
||||
(cond
|
||||
(instance? js/Uint8Array data) data
|
||||
(instance? js/ArrayBuffer data) (js/Uint8Array. data)
|
||||
(string? data) (.encode (js/TextEncoder.) data)
|
||||
:else (js/Uint8Array. data)))
|
||||
|
||||
(defn- gzip-bytes?
|
||||
[^js payload]
|
||||
(and (some? payload)
|
||||
(>= (.-byteLength payload) 2)
|
||||
(= 31 (aget payload 0))
|
||||
(= 139 (aget payload 1))))
|
||||
|
||||
(defn- bytes->stream
|
||||
[^js payload]
|
||||
(js/ReadableStream.
|
||||
#js {:start (fn [controller]
|
||||
(.enqueue controller payload)
|
||||
(.close controller))}))
|
||||
|
||||
(defn- <decompress-gzip-bytes
|
||||
[^js payload]
|
||||
(if (exists? js/DecompressionStream)
|
||||
(p/let [stream (bytes->stream payload)
|
||||
decompressed (.pipeThrough stream (js/DecompressionStream. "gzip"))
|
||||
resp (js/Response. decompressed)
|
||||
buf (.arrayBuffer resp)]
|
||||
(->uint8 buf))
|
||||
(p/rejected (ex-info "gzip decompression not supported"
|
||||
{:type :db-sync/decompression-not-supported}))))
|
||||
|
||||
(defn- <snapshot-response-bytes
|
||||
[^js resp]
|
||||
(p/let [buf (.arrayBuffer resp)
|
||||
chunk (->uint8 buf)]
|
||||
(if (gzip-bytes? chunk)
|
||||
(<decompress-gzip-bytes chunk)
|
||||
chunk)))
|
||||
|
||||
(defn- <stream-starts-with-gzip?
|
||||
[^js stream]
|
||||
(let [reader (.getReader stream)]
|
||||
(-> (.read reader)
|
||||
(p/then (fn [result]
|
||||
(if (.-done result)
|
||||
false
|
||||
(gzip-bytes? (->uint8 (.-value result))))))
|
||||
(p/catch (fn [_] false))
|
||||
(p/finally (fn []
|
||||
(try
|
||||
(.releaseLock reader)
|
||||
(catch :default _)))))))
|
||||
|
||||
(defn- <response-body-stream
|
||||
[^js resp]
|
||||
(let [body (.-body resp)
|
||||
encoding (some-> resp .-headers (.get "content-encoding"))]
|
||||
(cond
|
||||
(nil? body)
|
||||
(p/resolved nil)
|
||||
|
||||
;; Never trust `content-encoding` alone.
|
||||
;; Some runtimes (e.g. Node/undici fetch) may auto-decompress body while
|
||||
;; still exposing `content-encoding: gzip` in headers.
|
||||
;; We only stream-decompress when the first bytes are actual gzip magic.
|
||||
(and (= "gzip" encoding)
|
||||
(exists? js/DecompressionStream)
|
||||
(fn? (.-tee body)))
|
||||
(let [branches (.tee body)
|
||||
probe (aget branches 0)
|
||||
payload (aget branches 1)]
|
||||
(-> (<stream-starts-with-gzip? probe)
|
||||
(p/then (fn [gzip?]
|
||||
(if gzip?
|
||||
(.pipeThrough payload (js/DecompressionStream. "gzip"))
|
||||
payload)))
|
||||
;; If probing fails, keep original payload stream.
|
||||
(p/catch (fn [_] payload))))
|
||||
|
||||
;; If we cannot safely probe (no tee support), do not guess.
|
||||
;; Fall back to the arrayBuffer path where we inspect magic bytes first.
|
||||
(= "gzip" encoding)
|
||||
(p/resolved nil)
|
||||
|
||||
:else
|
||||
(p/resolved body))))
|
||||
|
||||
(defn- <flush-row-batches!
|
||||
[rows batch-size on-batch]
|
||||
(p/loop [remaining rows]
|
||||
(if (>= (count remaining) batch-size)
|
||||
(let [batch (subvec remaining 0 batch-size)
|
||||
rest-rows (subvec remaining batch-size)]
|
||||
(p/let [_ (on-batch batch)]
|
||||
(p/recur rest-rows)))
|
||||
remaining)))
|
||||
|
||||
(defn- <stream-snapshot-row-batches!
|
||||
[^js resp batch-size on-batch]
|
||||
(p/let [stream (<response-body-stream resp)]
|
||||
(if stream
|
||||
(let [reader (.getReader stream)]
|
||||
(p/loop [buffer nil
|
||||
pending []]
|
||||
(p/let [result (.read reader)]
|
||||
(if (.-done result)
|
||||
(let [pending (if (and buffer (pos? (.-byteLength buffer)))
|
||||
(into pending (snapshot/finalize-framed-buffer buffer))
|
||||
pending)]
|
||||
(if (seq pending)
|
||||
(p/let [_ (on-batch pending)]
|
||||
{:chunk-count 1})
|
||||
{:chunk-count 0}))
|
||||
(let [{rows :rows next-buffer :buffer} (snapshot/parse-framed-chunk buffer (->uint8 (.-value result)))
|
||||
pending (into pending rows)]
|
||||
(p/let [pending (<flush-row-batches! pending batch-size on-batch)]
|
||||
(p/recur next-buffer pending)))))))
|
||||
(p/let [snapshot-bytes (<snapshot-response-bytes resp)
|
||||
rows (vec (snapshot/finalize-framed-buffer snapshot-bytes))]
|
||||
(if (seq rows)
|
||||
(p/let [_ (on-batch rows)]
|
||||
{:chunk-count 1})
|
||||
{:chunk-count 0})))))
|
||||
|
||||
(defn- with-auth-headers
|
||||
[opts]
|
||||
(sync-auth/with-auth-headers
|
||||
#(sync-auth/auth-headers (worker-state/get-id-token))
|
||||
opts))
|
||||
|
||||
(defn- fetch-json
|
||||
[url opts schema]
|
||||
(sync-util/fetch-json url opts {:response-schema schema}))
|
||||
|
||||
(defonce ^:private *import-state (atom nil))
|
||||
(def ^:private snapshot-import-datoms-batch-size 10000)
|
||||
|
||||
(defn complete-datoms-import!
|
||||
[repo graph-id remote-tx]
|
||||
(-> (p/do!
|
||||
(when-let [search-db (worker-state/get-sqlite-conn repo :search)]
|
||||
(search/truncate-table! search-db))
|
||||
(rtc-log-and-state/rtc-log :rtc.log/download
|
||||
{:sub-type :download-progress
|
||||
:graph-uuid graph-id
|
||||
:message "Saving data to DB"})
|
||||
(->
|
||||
(if-let [rehydrate-f (@thread-api/*thread-apis :thread-api/db-sync-rehydrate-large-titles)]
|
||||
(rehydrate-f repo graph-id)
|
||||
(fail-fast :db-sync/missing-field {:field :thread-api/db-sync-rehydrate-large-titles}))
|
||||
(p/catch (fn [error]
|
||||
(log/error ::rehydrate-large-title-failed error))))
|
||||
(rtc-log-and-state/rtc-log :rtc.log/download
|
||||
{:sub-type :download-completed
|
||||
:graph-uuid graph-id
|
||||
:message "Graph is ready!"})
|
||||
(when-let [^js db (worker-state/get-sqlite-conn repo :db)]
|
||||
(.exec db "PRAGMA wal_checkpoint(TRUNCATE)"))
|
||||
(client-op/update-local-tx repo remote-tx)
|
||||
(shared-service/broadcast-to-clients! :add-repo {:repo repo}))
|
||||
(p/catch (fn [error]
|
||||
(js/console.error error)))))
|
||||
|
||||
(defn- require-thread-api-f!
|
||||
[k]
|
||||
(if-let [f (@thread-api/*thread-apis k)]
|
||||
f
|
||||
(fail-fast :db-sync/missing-field {:field k})))
|
||||
|
||||
(defn- stale-import-ex-info
|
||||
[repo graph-id import-id]
|
||||
(ex-info "stale db sync import"
|
||||
{:type :db-sync/stale-import
|
||||
:repo repo
|
||||
:graph-id graph-id
|
||||
:import-id import-id}))
|
||||
|
||||
(defn- import-temp-pool-name
|
||||
[repo]
|
||||
(worker-util/get-pool-name (str "download-import-" repo)))
|
||||
|
||||
(defn- close-import-state!
|
||||
[{:keys [rows-db rows-pool]}]
|
||||
(when rows-db
|
||||
(try
|
||||
(.close rows-db)
|
||||
(catch :default _)))
|
||||
(when rows-pool
|
||||
(-> (platform/remove-storage-pool! (platform/current) rows-pool)
|
||||
(p/catch (fn [_] nil)))))
|
||||
|
||||
(defn close-import-state-for-repo!
|
||||
[repo]
|
||||
(when-let [state @*import-state]
|
||||
(when (= repo (:repo state))
|
||||
(close-import-state! state)
|
||||
(reset! *import-state nil))))
|
||||
|
||||
(defn- clear-import-state!
|
||||
[import-id]
|
||||
(when-let [state @*import-state]
|
||||
(when (= import-id (:import-id state))
|
||||
(close-import-state! state)
|
||||
(reset! *import-state nil))))
|
||||
|
||||
(defn- require-import-state!
|
||||
[repo graph-id import-id]
|
||||
(let [state @*import-state]
|
||||
(when-not (and state
|
||||
(= import-id (:import-id state))
|
||||
(or (nil? repo) (= repo (:repo state)))
|
||||
(= graph-id (:graph-id state)))
|
||||
(throw (stale-import-ex-info repo graph-id import-id)))
|
||||
state))
|
||||
|
||||
(defn- upsert-addr-content!
|
||||
[^js db data]
|
||||
(.transaction
|
||||
db
|
||||
(fn [tx]
|
||||
(doseq [item data]
|
||||
(.exec tx #js {:sql "INSERT INTO kvs (addr, content, addresses) values ($addr, $content, $addresses) on conflict(addr) do update set content = $content, addresses = $addresses"
|
||||
:bind item})))))
|
||||
|
||||
(defn import-rows-batch!
|
||||
[{:keys [rows-db]} rows]
|
||||
(when-not rows-db
|
||||
(throw (ex-info "missing import rows db"
|
||||
{:type :db-sync/missing-field
|
||||
:field :rows-db})))
|
||||
(let [data (map (fn [[addr content addresses]]
|
||||
#js {:$addr addr
|
||||
:$content content
|
||||
:$addresses addresses})
|
||||
rows)]
|
||||
(upsert-addr-content! rows-db data))
|
||||
(count rows))
|
||||
|
||||
(defn- <create-import-temp-db!
|
||||
[repo]
|
||||
(if-let [sqlite @worker-state/*sqlite]
|
||||
(let [current-platform (platform/current)
|
||||
pool-name (import-temp-pool-name repo)]
|
||||
(p/let [pool (platform/install-storage-pool current-platform sqlite pool-name)
|
||||
path (platform/resolve-db-path current-platform pool-name pool "/download-import.sqlite")
|
||||
db (platform/sqlite-open current-platform
|
||||
{:sqlite sqlite
|
||||
:pool pool
|
||||
:path path
|
||||
:mode "c"})]
|
||||
(common-sqlite/create-kvs-table! db)
|
||||
{:rows-db db
|
||||
:rows-path path
|
||||
:rows-pool pool}))
|
||||
(fail-fast :db-sync/missing-field {:repo repo :field :sqlite})))
|
||||
|
||||
(defn- <ensure-import-rows-db!
|
||||
[{:keys [import-id repo rows-db] :as state}]
|
||||
(if rows-db
|
||||
(p/resolved state)
|
||||
(p/let [{:keys [rows-db rows-path rows-pool]} (<create-import-temp-db! repo)]
|
||||
(swap! *import-state
|
||||
(fn [current]
|
||||
(if (= import-id (:import-id current))
|
||||
(assoc current
|
||||
:rows-db rows-db
|
||||
:rows-path rows-path
|
||||
:rows-pool rows-pool)
|
||||
current)))
|
||||
(assoc state
|
||||
:rows-db rows-db
|
||||
:rows-path rows-path
|
||||
:rows-pool rows-pool))))
|
||||
|
||||
(defn- datom->tx
|
||||
[{:keys [e a v]}]
|
||||
[:db/add e a v])
|
||||
|
||||
(def ^:private snapshot-local-only-attrs
|
||||
#{:block/tx-id})
|
||||
|
||||
(defn- import-datoms-batch!
|
||||
[conn aes-key graph-e2ee? datoms]
|
||||
(p/let [datoms-batch (if graph-e2ee?
|
||||
(sync-crypt/<decrypt-snapshot-datoms-batch aes-key datoms)
|
||||
datoms)
|
||||
datoms-batch (remove #(contains? snapshot-local-only-attrs (:a %))
|
||||
datoms-batch)
|
||||
block-eids (into #{}
|
||||
(comp (filter #(= :block/uuid (:a %)))
|
||||
(map :e))
|
||||
datoms-batch)
|
||||
schema-tx-data (into [] (comp (filter #(= "db" (namespace (:a %))))
|
||||
(map datom->tx))
|
||||
datoms-batch)
|
||||
regular-tx-data (into [] (comp (remove #(= "db" (namespace (:a %))))
|
||||
(map datom->tx))
|
||||
datoms-batch)
|
||||
tx-id (inc (:max-tx @conn))
|
||||
tx-data (into (into schema-tx-data regular-tx-data)
|
||||
(map (fn [block-eid]
|
||||
[:db/add block-eid :block/tx-id tx-id]))
|
||||
block-eids)]
|
||||
(when (seq tx-data)
|
||||
(d/transact! conn tx-data {:sync-download-graph? true}))))
|
||||
|
||||
(defn- schema-datom?
|
||||
[ident-eids schema-version-eid datom]
|
||||
(or (= schema-version-eid (:e datom))
|
||||
(and (contains? ident-eids (:e datom))
|
||||
(or (= :db/ident (:a datom))
|
||||
(= "db" (namespace (:a datom)))))))
|
||||
|
||||
(defn snapshot-datoms-in-import-order
|
||||
[conn]
|
||||
(let [db @conn
|
||||
schema-version-eid (some-> (d/entity db :logseq.kv/schema-version) :db/id)
|
||||
ident-eids (into #{}
|
||||
(map :e)
|
||||
(d/datoms db :avet :db/ident))
|
||||
schema-datom?* #(schema-datom? ident-eids schema-version-eid %)
|
||||
ordered-datoms (fn [pred]
|
||||
(sequence
|
||||
(comp (filter pred)
|
||||
(map #(select-keys % [:e :a :v])))
|
||||
(d/datoms db :eavt)))]
|
||||
(concat (ordered-datoms schema-datom?*)
|
||||
(ordered-datoms #(not (schema-datom?* %))))))
|
||||
|
||||
(defn- take-import-datoms-batch
|
||||
[datoms batch-size]
|
||||
(loop [batch (transient [])
|
||||
remaining (seq datoms)
|
||||
n 0]
|
||||
(if (or (nil? remaining)
|
||||
(>= n batch-size))
|
||||
[(persistent! batch) remaining]
|
||||
(recur (conj! batch (first remaining))
|
||||
(next remaining)
|
||||
(inc n)))))
|
||||
|
||||
(defn- <yield-next-tick
|
||||
[]
|
||||
(js/Promise. (fn [resolve] (js/setTimeout resolve 0))))
|
||||
|
||||
(defn- log-import-progress!
|
||||
[graph-id import-id datoms-count]
|
||||
(when (pos? datoms-count)
|
||||
(let [{:keys [imported-datoms total-datoms]}
|
||||
(swap! *import-state
|
||||
(fn [state]
|
||||
(if (= import-id (:import-id state))
|
||||
(update state :imported-datoms (fnil + 0) datoms-count)
|
||||
state)))]
|
||||
(rtc-log-and-state/rtc-log :rtc.log/download
|
||||
{:sub-type :download-progress
|
||||
:graph-uuid graph-id
|
||||
:message (if (some? total-datoms)
|
||||
(str "Importing data " imported-datoms "/" total-datoms)
|
||||
(str "Importing data " imported-datoms))}))))
|
||||
|
||||
(defn- <replay-imported-rows!
|
||||
[{:keys [conn rows-db aes-key graph-e2ee? graph-id import-id]}]
|
||||
(if (nil? rows-db)
|
||||
(p/resolved nil)
|
||||
(let [source-storage (sync-temp-sqlite/new-temp-sqlite-storage rows-db)
|
||||
source-conn (common-sqlite/get-storage-conn source-storage db-schema/schema)]
|
||||
(p/loop [remaining (seq (snapshot-datoms-in-import-order source-conn))]
|
||||
(if (seq remaining)
|
||||
(let [[batch remaining'] (take-import-datoms-batch remaining snapshot-import-datoms-batch-size)]
|
||||
(p/let [_ (import-datoms-batch! conn aes-key graph-e2ee? batch)
|
||||
_ (log-import-progress! graph-id import-id (count batch))
|
||||
_ (<yield-next-tick)]
|
||||
(p/recur remaining')))
|
||||
(p/resolved nil))))))
|
||||
|
||||
(defn prepare-import!
|
||||
[repo reset? graph-id graph-e2ee? & [total-datoms]]
|
||||
(let [graph-e2ee? (if (nil? graph-e2ee?) true (true? graph-e2ee?))]
|
||||
(-> (p/let [close-db-f (require-thread-api-f! :thread-api/db-sync-close-db)
|
||||
unlink-db-f (require-thread-api-f! :thread-api/unsafe-unlink-db)
|
||||
recreate-lock-f (require-thread-api-f! :thread-api/db-sync-recreate-lock)
|
||||
invalidate-search-db-f (require-thread-api-f! :thread-api/db-sync-invalidate-search-db)
|
||||
create-or-open-db-f (require-thread-api-f! :thread-api/create-or-open-db)
|
||||
_ (when-let [state @*import-state]
|
||||
(close-import-state! state)
|
||||
(close-db-f (:repo state)))
|
||||
_ (reset! *import-state nil)
|
||||
_ (when reset? (close-db-f repo))
|
||||
_ (when reset? (unlink-db-f repo))
|
||||
_ (when reset? (recreate-lock-f repo))
|
||||
_ (when reset? (invalidate-search-db-f repo))
|
||||
import-id (str (random-uuid))
|
||||
aes-key (when graph-e2ee?
|
||||
(sync-crypt/<fetch-graph-aes-key-for-download graph-id))
|
||||
_ (when (and graph-e2ee? (nil? aes-key))
|
||||
(fail-fast :db-sync/missing-field {:repo repo :field :aes-key}))
|
||||
_ (create-or-open-db-f repo {:close-other-db? true
|
||||
:sync-download-graph? true})
|
||||
conn (worker-state/get-datascript-conn repo)
|
||||
_ (when-not conn
|
||||
(fail-fast :db-sync/missing-field {:repo repo :field :datascript-conn}))]
|
||||
(reset! *import-state {:aes-key aes-key
|
||||
:conn conn
|
||||
:graph-e2ee? graph-e2ee?
|
||||
:graph-id graph-id
|
||||
:import-id import-id
|
||||
:imported-datoms 0
|
||||
:rows-db nil
|
||||
:rows-imported? false
|
||||
:rows-path nil
|
||||
:rows-pool nil
|
||||
:repo repo
|
||||
:total-datoms total-datoms})
|
||||
{:import-id import-id})
|
||||
(p/catch (fn [error]
|
||||
(reset! *import-state nil)
|
||||
(throw error))))))
|
||||
|
||||
(defn import-rows-chunk!
|
||||
[rows graph-id import-id]
|
||||
(-> (p/let [state (require-import-state! nil graph-id import-id)
|
||||
state (<ensure-import-rows-db! state)
|
||||
_ (import-rows-batch! state rows)
|
||||
_ (swap! *import-state
|
||||
(fn [current]
|
||||
(if (= import-id (:import-id current))
|
||||
(assoc current :rows-imported? true)
|
||||
current)))]
|
||||
true)
|
||||
(p/catch (fn [error]
|
||||
(when-not (= :db-sync/stale-import (:type (ex-data error)))
|
||||
(clear-import-state! import-id))
|
||||
(throw error)))))
|
||||
|
||||
(defn finalize-import!
|
||||
[repo graph-id remote-tx import-id]
|
||||
(-> (p/let [state (require-import-state! repo graph-id import-id)
|
||||
_ (when (:rows-imported? state)
|
||||
(<replay-imported-rows! state))
|
||||
result (complete-datoms-import! repo graph-id remote-tx)
|
||||
_ (clear-import-state! import-id)]
|
||||
result)
|
||||
(p/catch (fn [error]
|
||||
(when-not (= :db-sync/stale-import (:type (ex-data error)))
|
||||
(clear-import-state! import-id))
|
||||
(throw error)))))
|
||||
|
||||
(defn- set-graph-sync-metadata!
|
||||
[conn graph-id graph-e2ee?]
|
||||
(assert (uuid? graph-id))
|
||||
(ldb/transact! conn [(ldb/kv :logseq.kv/graph-uuid graph-id)
|
||||
(ldb/kv :logseq.kv/graph-remote? true)
|
||||
(ldb/kv :logseq.kv/graph-rtc-e2ee? (true? graph-e2ee?))]
|
||||
{:persist-op? false}))
|
||||
|
||||
(defn download-graph-by-id!
|
||||
[repo graph-id graph-e2ee?]
|
||||
(let [base (sync-auth/http-base-url @worker-state/*db-sync-config)]
|
||||
(if (and (seq repo) (seq graph-id) (seq base))
|
||||
(let [stage* (atom :init)
|
||||
import-id* (atom nil)
|
||||
log-f (fn [payload]
|
||||
(rtc-log-and-state/rtc-log :rtc.log/download payload))]
|
||||
(-> (p/let [_ (log-f {:sub-type :download-progress
|
||||
:graph-uuid graph-id
|
||||
:message "Preparing graph snapshot download"})
|
||||
_ (reset! stage* :fetch-pull)
|
||||
pull-resp (fetch-json (str base "/sync/" graph-id "/pull")
|
||||
{:method "GET"}
|
||||
:sync/pull)
|
||||
remote-tx (:t pull-resp)
|
||||
_ (when-not (integer? remote-tx)
|
||||
(throw (ex-info "non-integer remote-tx when downloading graph"
|
||||
{:repo repo
|
||||
:remote-tx remote-tx})))
|
||||
_ (reset! stage* :fetch-snapshot-download)
|
||||
snapshot-resp (fetch-json (str base "/sync/" graph-id "/snapshot/download")
|
||||
{:method "GET"}
|
||||
:sync/snapshot-download)
|
||||
_ (when graph-e2ee?
|
||||
(reset! stage* :prepare-e2ee)
|
||||
(sync-crypt/<fetch-graph-aes-key-for-download graph-id))
|
||||
_ (reset! stage* :fetch-snapshot-stream)
|
||||
resp (js/fetch (:url snapshot-resp)
|
||||
(clj->js (with-auth-headers {:method "GET"})))
|
||||
_ (log-f {:sub-type :download-progress
|
||||
:graph-uuid graph-id
|
||||
:message "Start downloading graph snapshot"})]
|
||||
(when-not (.-ok resp)
|
||||
(throw (ex-info "snapshot download failed"
|
||||
{:repo repo
|
||||
:status (.-status resp)})))
|
||||
(let [ensure-import! (fn []
|
||||
(if-let [import-id @import-id*]
|
||||
(p/resolved import-id)
|
||||
(p/let [_ (reset! stage* :prepare-import)
|
||||
{:keys [import-id]} (prepare-import! repo true graph-id graph-e2ee?)]
|
||||
(reset! import-id* import-id)
|
||||
import-id)))]
|
||||
(p/let [_ (do
|
||||
(reset! stage* :stream-snapshot)
|
||||
(<stream-snapshot-row-batches!
|
||||
resp
|
||||
25000
|
||||
(fn [rows]
|
||||
(p/let [import-id (ensure-import!)]
|
||||
(import-rows-chunk! rows graph-id import-id)))))
|
||||
_ (log-f {:sub-type :download-completed
|
||||
:graph-uuid graph-id
|
||||
:message "Graph snapshot downloaded"})
|
||||
_ (when-let [import-id @import-id*]
|
||||
(reset! stage* :finalize-import)
|
||||
(finalize-import! repo graph-id remote-tx import-id))]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(set-graph-sync-metadata! conn (uuid graph-id) graph-e2ee?))
|
||||
{:repo repo
|
||||
:graph-id graph-id
|
||||
:remote-tx remote-tx
|
||||
:graph-e2ee? graph-e2ee?})))
|
||||
(p/catch (fn [error]
|
||||
(when-let [import-id @import-id*]
|
||||
(clear-import-state! import-id))
|
||||
(log-f {:sub-type :download-completed
|
||||
:graph-uuid graph-id
|
||||
:message "Graph snapshot download failed"})
|
||||
(log/error :db-sync/download-graph-by-id-failed
|
||||
{:repo repo
|
||||
:graph-id graph-id
|
||||
:graph-e2ee? graph-e2ee?
|
||||
:stage @stage*
|
||||
:error error
|
||||
:error-stack (when (instance? js/Error error)
|
||||
(.-stack error))
|
||||
:error-cause (when (instance? js/Error error)
|
||||
(some-> (.-cause error) (.-message)))})
|
||||
(throw (ex-info "db-sync download failed"
|
||||
{:repo repo
|
||||
:graph-id graph-id
|
||||
:graph-e2ee? graph-e2ee?
|
||||
:stage @stage*
|
||||
:code (:code (ex-data error))
|
||||
:error-message (or (ex-message error)
|
||||
(when (instance? js/Error error)
|
||||
(.-message error)))
|
||||
:error-cause (when (instance? js/Error error)
|
||||
(some-> (.-cause error) (.-message)))}
|
||||
error))))))
|
||||
(p/rejected (ex-info "db-sync missing graph download info"
|
||||
{:repo repo
|
||||
:graph-id graph-id
|
||||
:base base})))))
|
||||
391
src/main/frontend/worker/sync/handle_message.cljs
Normal file
391
src/main/frontend/worker/sync/handle_message.cljs
Normal file
@@ -0,0 +1,391 @@
|
||||
(ns frontend.worker.sync.handle-message
|
||||
"WebSocket message handlers for db sync."
|
||||
(:require [frontend.worker.shared-service :as shared-service]
|
||||
[frontend.worker.state :as worker-state]
|
||||
[frontend.worker.sync.apply-txs :as sync-apply]
|
||||
[frontend.worker.sync.assets :as sync-assets]
|
||||
[frontend.worker.sync.auth :as sync-auth]
|
||||
[frontend.worker.sync.client-op :as client-op]
|
||||
[frontend.worker.sync.crypt :as sync-crypt]
|
||||
[frontend.worker.sync.log-and-state :as sync-log-state]
|
||||
[frontend.worker.sync.presence :as sync-presence]
|
||||
[frontend.worker.sync.transport :as sync-transport]
|
||||
[frontend.worker.sync.util :as sync-util]
|
||||
[lambdaisland.glogi :as log]
|
||||
[promesa.core :as p]
|
||||
[frontend.worker-common.util :as worker-util]))
|
||||
|
||||
(defn- fail-fast
|
||||
[tag data]
|
||||
(log/error tag data)
|
||||
(throw (ex-info (name tag) data)))
|
||||
|
||||
(defn- sync-counts
|
||||
[repo]
|
||||
(sync-presence/sync-counts
|
||||
{:get-datascript-conn worker-state/get-datascript-conn
|
||||
:get-client-ops-conn worker-state/get-client-ops-conn
|
||||
:get-pending-local-tx-count client-op/get-pending-local-tx-count
|
||||
:get-unpushed-asset-ops-count client-op/get-unpushed-asset-ops-count
|
||||
:get-missing-asset-upload-files sync-assets/get-missing-asset-upload-files
|
||||
:get-local-tx client-op/get-local-tx
|
||||
:get-local-checksum client-op/get-local-checksum
|
||||
:get-graph-uuid client-op/get-graph-uuid
|
||||
:latest-remote-tx @sync-apply/*repo->latest-remote-tx
|
||||
:latest-remote-checksum @sync-apply/*repo->latest-remote-checksum}
|
||||
repo))
|
||||
|
||||
(defn- broadcast-rtc-state!
|
||||
[client]
|
||||
(when client
|
||||
(shared-service/broadcast-to-clients!
|
||||
:rtc-sync-state
|
||||
(sync-presence/rtc-state-payload sync-counts client))))
|
||||
|
||||
(defn- update-online-users!
|
||||
[client users]
|
||||
(sync-presence/update-online-users! broadcast-rtc-state! client users))
|
||||
|
||||
(defn- update-user-presence!
|
||||
[client user-id* editing-block-uuid]
|
||||
(sync-presence/update-user-presence! broadcast-rtc-state! client user-id* editing-block-uuid))
|
||||
|
||||
(defn- get-user-uuid
|
||||
[]
|
||||
(sync-auth/get-user-uuid (worker-state/get-id-token)))
|
||||
|
||||
(defn- send!
|
||||
[ws message]
|
||||
(sync-transport/send! sync-transport/coerce-ws-client-message ws message))
|
||||
|
||||
(defn- ws-open?
|
||||
[ws]
|
||||
(sync-transport/ws-open? ws))
|
||||
|
||||
(defn- enqueue-asset-task!
|
||||
[client task]
|
||||
(when-let [queue (:asset-queue client)]
|
||||
(swap! queue
|
||||
(fn [prev]
|
||||
(p/then prev (fn [_] (task)))))))
|
||||
|
||||
(defn- enqueue-send-task!
|
||||
[client task]
|
||||
(if-let [queue (:send-queue client)]
|
||||
(swap! queue
|
||||
(fn [prev]
|
||||
(-> (or prev (p/resolved nil))
|
||||
(p/catch (fn [_] nil))
|
||||
(p/then (fn [_] (task)))
|
||||
(p/catch (fn [error]
|
||||
(log/error :db-sync/send-queue-task-failed
|
||||
{:repo (:repo client)
|
||||
:error error}))))))
|
||||
(task)))
|
||||
|
||||
(defn- current-client
|
||||
[repo]
|
||||
(sync-presence/current-client worker-state/*db-sync-client repo))
|
||||
|
||||
(defn- require-number
|
||||
[value context]
|
||||
(when-not (number? value)
|
||||
(fail-fast :db-sync/invalid-field (assoc context :value value))))
|
||||
|
||||
(defn- require-non-negative
|
||||
[value context]
|
||||
(require-number value context)
|
||||
(when (neg? value)
|
||||
(fail-fast :db-sync/invalid-field (assoc context :value value))))
|
||||
|
||||
(defn- require-seq
|
||||
[value context]
|
||||
(when-not (sequential? value)
|
||||
(fail-fast :db-sync/invalid-field (assoc context :value value))))
|
||||
|
||||
(defn- require-uuid
|
||||
[value context]
|
||||
(when-not (uuid? value)
|
||||
(fail-fast :db-sync/invalid-field (assoc context :value value))))
|
||||
|
||||
(defn- parse-transit
|
||||
[value context]
|
||||
(sync-transport/parse-transit fail-fast value context))
|
||||
|
||||
(defn- request-pull!
|
||||
[client since]
|
||||
(when (and (:ws client) (ws-open? (:ws client)))
|
||||
(enqueue-send-task!
|
||||
client
|
||||
(fn []
|
||||
(when (and (:ws client) (ws-open? (:ws client)))
|
||||
(if-let [*pending (:pending-pull-since client)]
|
||||
(let [pending @*pending]
|
||||
(when (or (nil? pending) (< since pending))
|
||||
(reset! *pending since)
|
||||
(send! (:ws client) {:type "pull" :since since})))
|
||||
(send! (:ws client) {:type "pull" :since since})))))))
|
||||
|
||||
(defn- clear-pending-pull!
|
||||
[client]
|
||||
(when-let [*pending (:pending-pull-since client)]
|
||||
(reset! *pending nil)))
|
||||
|
||||
(defn- pending-local-tx?
|
||||
[repo]
|
||||
(pos? (or (client-op/get-pending-local-tx-count repo) 0)))
|
||||
|
||||
(defn- synced-checksum-ready?
|
||||
[repo client local-t remote-t]
|
||||
(and (= local-t remote-t)
|
||||
(not (pending-local-tx? repo))
|
||||
(empty? @(:inflight client))))
|
||||
|
||||
(defn- checksum-compare-ready?
|
||||
[repo client local-t remote-t]
|
||||
(and (synced-checksum-ready? repo client local-t remote-t)
|
||||
(string? (client-op/get-local-checksum repo))))
|
||||
|
||||
(defn- verify-sync-checksum!
|
||||
[repo client local-tx remote-tx remote-checksum context]
|
||||
(when worker-util/dev-or-test?
|
||||
(when (and (string? remote-checksum)
|
||||
(checksum-compare-ready? repo client local-tx remote-tx))
|
||||
(let [local-checksum (client-op/get-local-checksum repo)]
|
||||
(when-not (= local-checksum remote-checksum)
|
||||
(let [mismatch-data (merge context
|
||||
{:type :db-sync/checksum-mismatch
|
||||
:repo repo
|
||||
:message-type (:type context)
|
||||
:local-tx local-tx
|
||||
:remote-tx remote-tx
|
||||
:local-checksum local-checksum
|
||||
:remote-checksum remote-checksum})]
|
||||
(sync-log-state/rtc-log :rtc.log/checksum-mismatch mismatch-data)
|
||||
(log/warn :db-sync/checksum-mismatch mismatch-data)))))))
|
||||
|
||||
(defn- handle-tx-reject!
|
||||
[repo client message local-tx]
|
||||
(sync-apply/clear-upload-response-timeout! client)
|
||||
(let [reason (:reason message)
|
||||
remote-tx (:t message)
|
||||
success-tx-ids (:success-tx-ids message)
|
||||
failed-tx-id (:failed-tx-id message)
|
||||
missing-block-uuids (:missing-block-uuids message)]
|
||||
(when (nil? reason)
|
||||
(fail-fast :db-sync/missing-field
|
||||
{:repo repo :type "tx/reject" :field :reason}))
|
||||
(when (contains? message :t)
|
||||
(require-non-negative remote-tx {:repo repo :type "tx/reject"}))
|
||||
(when (contains? message :success-tx-ids)
|
||||
(require-seq success-tx-ids {:repo repo :type "tx/reject" :field :success-tx-ids})
|
||||
(doseq [tx-id success-tx-ids]
|
||||
(require-uuid tx-id {:repo repo :type "tx/reject" :field :success-tx-ids})))
|
||||
(when (contains? message :failed-tx-id)
|
||||
(require-uuid failed-tx-id {:repo repo :type "tx/reject" :field :failed-tx-id}))
|
||||
(when (contains? message :missing-block-uuids)
|
||||
(require-seq missing-block-uuids {:repo repo :type "tx/reject" :field :missing-block-uuids})
|
||||
(doseq [block-uuid missing-block-uuids]
|
||||
(require-uuid block-uuid {:repo repo :type "tx/reject" :field :missing-block-uuids})))
|
||||
(case reason
|
||||
"stale"
|
||||
(request-pull! client local-tx)
|
||||
|
||||
(let [inflight @(:inflight client)
|
||||
inflight-set (set inflight)
|
||||
successful-tx-ids (->> (or success-tx-ids [])
|
||||
(filter inflight-set)
|
||||
vec)
|
||||
failed-tx-id (when (and failed-tx-id (contains? inflight-set failed-tx-id))
|
||||
failed-tx-id)
|
||||
data (when-let [raw-data (:data message)]
|
||||
(parse-transit raw-data
|
||||
{:repo repo
|
||||
:type "tx/reject"
|
||||
:reason reason
|
||||
:field :data}))
|
||||
rejected-data (cond-> {:type :db-sync/tx-rejected
|
||||
:repo repo
|
||||
:message-type "tx/reject"
|
||||
:reason reason}
|
||||
(contains? message :t) (assoc :t remote-tx)
|
||||
(seq successful-tx-ids) (assoc :success-tx-ids successful-tx-ids)
|
||||
(some? failed-tx-id) (assoc :failed-tx-id failed-tx-id)
|
||||
(seq missing-block-uuids) (assoc :missing-block-uuids (vec missing-block-uuids))
|
||||
(some? data) (assoc :data data))]
|
||||
(if (or (contains? message :success-tx-ids)
|
||||
(contains? message :failed-tx-id))
|
||||
(do
|
||||
(sync-apply/mark-pending-txs-false! repo successful-tx-ids)
|
||||
(when failed-tx-id
|
||||
(sync-apply/rollback-and-mark-failed-txs! repo [failed-tx-id])))
|
||||
;; Backward compatibility for older servers without per-tx reject metadata.
|
||||
(sync-apply/rollback-and-mark-failed-txs! repo inflight))
|
||||
(reset! (:inflight client) [])
|
||||
(broadcast-rtc-state! client)
|
||||
(sync-log-state/rtc-log :rtc.log/tx-rejected rejected-data)
|
||||
(fail-fast :db-sync/tx-rejected
|
||||
rejected-data)))))
|
||||
|
||||
(defn- handle-hello!
|
||||
[repo client local-tx remote-tx remote-checksum]
|
||||
(require-non-negative remote-tx {:repo repo :type "hello"})
|
||||
(verify-sync-checksum! repo client local-tx remote-tx remote-checksum {:type "hello"})
|
||||
(broadcast-rtc-state! client)
|
||||
(when (> remote-tx local-tx)
|
||||
(request-pull! client local-tx))
|
||||
(sync-assets/enqueue-asset-sync!
|
||||
repo client
|
||||
{:enqueue-asset-task-f enqueue-asset-task!
|
||||
:current-client-f current-client
|
||||
:broadcast-rtc-state!-f broadcast-rtc-state!
|
||||
:fail-fast-f fail-fast})
|
||||
(log/info :db-sync/handle-hello
|
||||
{:empty-inflight? (empty? @(:inflight client))
|
||||
:online? (worker-state/online?)
|
||||
:ws-open? (when-let [ws (:ws client)]
|
||||
(ws-open? ws))
|
||||
:pending-txs-count (count (sync-apply/pending-txs repo {:limit 50}))})
|
||||
(sync-apply/enqueue-flush-pending! repo client))
|
||||
|
||||
(defn- handle-online-users!
|
||||
[repo client message]
|
||||
(let [users (:online-users message)]
|
||||
(when (and (some? users) (not (sequential? users)))
|
||||
(fail-fast :db-sync/invalid-field
|
||||
{:repo repo :type "online-users" :field :online-users}))
|
||||
(update-online-users! client (or users []))))
|
||||
|
||||
(defn- handle-presence!
|
||||
[client message]
|
||||
(let [{:keys [user-id editing-block-uuid]} message]
|
||||
(when-not (= (get-user-uuid) user-id)
|
||||
(update-user-presence! client user-id editing-block-uuid))))
|
||||
|
||||
(defn- handle-tx-batch-ok!
|
||||
[repo client remote-tx remote-checksum]
|
||||
(require-non-negative remote-tx {:repo repo :type "tx/batch/ok"})
|
||||
(sync-apply/ack-upload-response! repo client)
|
||||
(let [current-local-tx (client-op/get-local-tx repo)
|
||||
next-local-tx (max current-local-tx remote-tx)]
|
||||
(client-op/update-local-tx repo next-local-tx)
|
||||
(sync-util/clear-last-sync-error! client)
|
||||
(sync-apply/mark-pending-txs-false! repo @(:inflight client))
|
||||
(reset! (:inflight client) [])
|
||||
(broadcast-rtc-state! client)
|
||||
(verify-sync-checksum! repo client next-local-tx remote-tx remote-checksum {:type "tx/batch/ok"})
|
||||
(sync-apply/enqueue-flush-pending! repo client)))
|
||||
|
||||
(defn- update-latest-remote-state!
|
||||
[repo message]
|
||||
(let [message-type (:type message)
|
||||
remote-tx (:t message)
|
||||
remote-checksum (:checksum message)
|
||||
has-checksum? (contains? message :checksum)
|
||||
latest-remote-tx (get @sync-apply/*repo->latest-remote-tx repo)
|
||||
authoritative? (contains? #{"hello" "changed"} message-type)
|
||||
stale-remote-tx? (and (number? remote-tx)
|
||||
(number? latest-remote-tx)
|
||||
(< remote-tx latest-remote-tx)
|
||||
(not authoritative?))]
|
||||
(when (number? remote-tx)
|
||||
(if authoritative?
|
||||
(swap! sync-apply/*repo->latest-remote-tx assoc repo remote-tx)
|
||||
(swap! sync-apply/*repo->latest-remote-tx
|
||||
update repo
|
||||
(fn [prev]
|
||||
(if (number? prev)
|
||||
(max prev remote-tx)
|
||||
remote-tx)))))
|
||||
(when (and has-checksum? (not stale-remote-tx?))
|
||||
(swap! sync-apply/*repo->latest-remote-checksum assoc repo remote-checksum))
|
||||
{:stale-remote-tx? stale-remote-tx?
|
||||
:latest-remote-tx-before latest-remote-tx}))
|
||||
|
||||
(declare handle-pull-ok! handle-changed!)
|
||||
|
||||
(defn- validate-local-tx!
|
||||
[repo message local-tx]
|
||||
(let [message-type (:type message)]
|
||||
(when (contains? #{"hello" "tx/batch/ok" "pull/ok" "changed" "tx/reject"} message-type)
|
||||
(let [validate? (and (integer? local-tx) (>= local-tx 0))]
|
||||
(when-not validate?
|
||||
(throw (ex-info "Invalid local tx"
|
||||
{:repo repo
|
||||
:message-type message-type
|
||||
:local-tx local-tx})))))))
|
||||
(defn handle-message!
|
||||
[repo client raw]
|
||||
(let [message (-> raw
|
||||
sync-transport/parse-message
|
||||
sync-transport/coerce-ws-server-message)]
|
||||
(when-not (map? message)
|
||||
(fail-fast :db-sync/response-parse-failed {:repo repo :raw raw}))
|
||||
(let [local-tx (client-op/get-local-tx repo)
|
||||
remote-tx (:t message)
|
||||
remote-checksum (:checksum message)]
|
||||
(validate-local-tx! repo message local-tx)
|
||||
(update-latest-remote-state! repo message)
|
||||
(case (:type message)
|
||||
"hello" (handle-hello! repo client local-tx remote-tx remote-checksum)
|
||||
"online-users" (handle-online-users! repo client message)
|
||||
"presence" (handle-presence! client message)
|
||||
"tx/batch/ok" (handle-tx-batch-ok! repo client remote-tx remote-checksum)
|
||||
"pull/ok" (handle-pull-ok! repo client local-tx remote-tx remote-checksum message)
|
||||
"changed" (handle-changed! repo client local-tx remote-tx)
|
||||
"tx/reject" (handle-tx-reject! repo client message local-tx)
|
||||
"pong" nil
|
||||
(fail-fast :db-sync/invalid-field
|
||||
{:repo repo :type (:type message)})))))
|
||||
|
||||
(defn- handle-pull-ok!
|
||||
[repo client local-tx remote-tx remote-checksum message]
|
||||
(clear-pending-pull! client)
|
||||
;; (log/info ::handle-pull-ok! {:repo repo
|
||||
;; :remote-tx remote-tx
|
||||
;; :local-tx local-tx})
|
||||
(when (> remote-tx local-tx)
|
||||
(let [txs (:txs message)]
|
||||
(require-non-negative remote-tx {:repo repo :type "pull/ok"})
|
||||
(require-seq txs {:repo repo :type "pull/ok" :field :txs})
|
||||
(let [remote-txs (mapv (fn [data]
|
||||
{:t (:t data)
|
||||
:outliner-op (:outliner-op data)
|
||||
:tx-data (parse-transit (:tx data) {:repo repo :type "pull/ok"})})
|
||||
txs)]
|
||||
;; (log/info ::handle-pull-remote-txs-count {:count (count remote-txs)})
|
||||
(when (seq remote-txs)
|
||||
(->
|
||||
(p/let [graph-e2ee? (sync-crypt/graph-e2ee? repo)
|
||||
;; _ (log/info ::handle-pull-request-aes-key {})
|
||||
aes-key (sync-crypt/<ensure-graph-aes-key repo (:graph-id client))
|
||||
;; _ (when (some? aes-key)
|
||||
;; (log/info ::handle-pull-request-aes-key-success {}))
|
||||
_ (when (and graph-e2ee? (nil? aes-key))
|
||||
(fail-fast :db-sync/missing-field {:repo repo :field :aes-key}))
|
||||
remote-txs* (if aes-key
|
||||
(p/all (mapv (fn [{:keys [tx-data] :as remote-tx}]
|
||||
(p/let [tx-data* (sync-crypt/<decrypt-tx-data aes-key tx-data)]
|
||||
(assoc remote-tx :tx-data tx-data*)))
|
||||
remote-txs))
|
||||
(p/resolved remote-txs))
|
||||
_ (try
|
||||
(sync-apply/apply-remote-txs! repo client remote-txs*)
|
||||
(catch :default e
|
||||
(log/error ::apply-remote-tx e)
|
||||
(throw e)))]
|
||||
(client-op/update-local-tx repo remote-tx)
|
||||
(broadcast-rtc-state! client)
|
||||
(verify-sync-checksum! repo client remote-tx remote-tx remote-checksum {:type "pull/ok"})
|
||||
(sync-apply/enqueue-flush-pending! repo client))
|
||||
(p/then (fn [_]
|
||||
(sync-util/clear-last-sync-error! client)))
|
||||
(p/catch (fn [error]
|
||||
(sync-util/set-last-sync-error! client error)))))))))
|
||||
|
||||
(defn- handle-changed!
|
||||
[repo client local-tx remote-tx]
|
||||
(require-non-negative remote-tx {:repo repo :type "changed"})
|
||||
(broadcast-rtc-state! client)
|
||||
(when (< local-tx remote-tx)
|
||||
(request-pull! client local-tx)))
|
||||
267
src/main/frontend/worker/sync/large_title.cljs
Normal file
267
src/main/frontend/worker/sync/large_title.cljs
Normal file
@@ -0,0 +1,267 @@
|
||||
(ns frontend.worker.sync.large-title
|
||||
"Large title offload and rehydration helpers for db sync."
|
||||
(:require [datascript.core :as d]
|
||||
[logseq.db :as ldb]
|
||||
[promesa.core :as p]
|
||||
[frontend.worker.sync.util :refer [get-graph-id]]))
|
||||
|
||||
(def large-title-byte-limit 4096)
|
||||
(def large-title-asset-type "txt")
|
||||
(def large-title-object-attr :logseq.property.sync/large-title-object)
|
||||
(def text-encoder (js/TextEncoder.))
|
||||
(def text-decoder (js/TextDecoder.))
|
||||
|
||||
(defn utf8-byte-length
|
||||
[value]
|
||||
(when (string? value)
|
||||
(.-length (.encode text-encoder value))))
|
||||
|
||||
(defn large-title?
|
||||
[value]
|
||||
(when-let [byte-length (utf8-byte-length value)]
|
||||
(> byte-length large-title-byte-limit)))
|
||||
|
||||
(defn large-title-datom?
|
||||
[datom]
|
||||
(and (= :block/title (:a datom))
|
||||
(string? (:v datom))
|
||||
(large-title? (:v datom))))
|
||||
|
||||
(defn assoc-datom-value
|
||||
[datom new-value]
|
||||
(let [[op e a _v & others] datom]
|
||||
(into [op e a new-value] others)))
|
||||
|
||||
(defn large-title-object
|
||||
[asset-uuid asset-type]
|
||||
{:asset-uuid asset-uuid
|
||||
:asset-type asset-type})
|
||||
|
||||
(defn large-title-object?
|
||||
[value]
|
||||
(and (map? value)
|
||||
(string? (:asset-uuid value))
|
||||
(string? (:asset-type value))))
|
||||
|
||||
(defn- large-title-object-datoms
|
||||
[db]
|
||||
(if (get-in (:schema db) [large-title-object-attr :db/index])
|
||||
(d/datoms db :avet large-title-object-attr)
|
||||
(filter #(= large-title-object-attr (:a %))
|
||||
(d/datoms db :eavt))))
|
||||
|
||||
(defn- find-large-title-object-eid
|
||||
[db obj]
|
||||
(some (fn [datom]
|
||||
(when (= obj (:v datom))
|
||||
(:e datom)))
|
||||
(large-title-object-datoms db)))
|
||||
|
||||
(defn- resolve-large-title-item-eid
|
||||
[db {:keys [e obj]}]
|
||||
(or (when (number? e)
|
||||
e)
|
||||
(some-> (d/entity db e) :db/id)
|
||||
(find-large-title-object-eid db obj)))
|
||||
|
||||
(defn asset-url
|
||||
[base graph-id asset-uuid asset-type]
|
||||
(str base "/assets/" graph-id "/" asset-uuid "." asset-type))
|
||||
|
||||
(defn upload-large-title!
|
||||
[{:keys [repo
|
||||
graph-id
|
||||
title
|
||||
aes-key
|
||||
http-base
|
||||
auth-headers
|
||||
fail-fast-f
|
||||
encrypt-text-value-f]}]
|
||||
(when-not (seq http-base)
|
||||
(fail-fast-f :db-sync/missing-field {:repo repo :field :http-base}))
|
||||
(when-not (seq graph-id)
|
||||
(fail-fast-f :db-sync/missing-field {:repo repo :field :graph-id}))
|
||||
(let [asset-uuid (str (random-uuid))
|
||||
asset-type large-title-asset-type
|
||||
url (asset-url http-base graph-id asset-uuid asset-type)]
|
||||
(p/let [payload (if aes-key
|
||||
(p/let [payload-str (encrypt-text-value-f aes-key title)]
|
||||
(.encode text-encoder payload-str))
|
||||
(p/resolved title))
|
||||
headers (merge {"content-type" "text/plain; charset=utf-8"
|
||||
"x-amz-meta-type" asset-type}
|
||||
auth-headers)
|
||||
resp (js/fetch url #js {:method "PUT"
|
||||
:headers (clj->js headers)
|
||||
:body payload})]
|
||||
(if (.-ok resp)
|
||||
(large-title-object asset-uuid asset-type)
|
||||
(fail-fast-f :db-sync/large-title-upload-failed
|
||||
{:repo repo :status (.-status resp)})))))
|
||||
|
||||
(defn download-large-title!
|
||||
[{:keys [repo
|
||||
graph-id
|
||||
obj
|
||||
aes-key
|
||||
http-base
|
||||
auth-headers
|
||||
fail-fast-f
|
||||
decrypt-text-value-f]}]
|
||||
(when-not (seq http-base)
|
||||
(fail-fast-f :db-sync/missing-field {:repo repo :field :http-base}))
|
||||
(when-not (seq graph-id)
|
||||
(fail-fast-f :db-sync/missing-field {:repo repo :field :graph-id}))
|
||||
(let [url (asset-url http-base graph-id (:asset-uuid obj) (:asset-type obj))]
|
||||
(p/let [resp (js/fetch url #js {:method "GET"
|
||||
:headers (clj->js auth-headers)})]
|
||||
(when-not (.-ok resp)
|
||||
(fail-fast-f :db-sync/large-title-download-failed
|
||||
{:repo repo :status (.-status resp)}))
|
||||
(p/let [buf (.arrayBuffer resp)
|
||||
payload (js/Uint8Array. buf)
|
||||
payload-str (.decode text-decoder payload)
|
||||
data (if aes-key
|
||||
(-> (decrypt-text-value-f aes-key payload-str)
|
||||
(p/catch (fn [_] payload-str)))
|
||||
(p/resolved payload-str))]
|
||||
data))))
|
||||
|
||||
(defn offload-large-titles
|
||||
[tx-data {:keys [repo graph-id upload-fn aes-key]}]
|
||||
(p/loop [remaining tx-data
|
||||
acc []]
|
||||
(if (empty? remaining)
|
||||
acc
|
||||
(let [item (first remaining)]
|
||||
(if (and (vector? item)
|
||||
(= :db/add (nth item 0 nil))
|
||||
(= :block/title (nth item 2 nil))
|
||||
(string? (nth item 3 nil))
|
||||
(large-title? (nth item 3 nil)))
|
||||
(let [title (nth item 3)]
|
||||
(p/let [obj (upload-fn repo graph-id title aes-key)
|
||||
placeholder (assoc-datom-value item "")]
|
||||
(p/recur (rest remaining)
|
||||
(conj acc placeholder
|
||||
[:db/add (nth item 1) large-title-object-attr obj]))))
|
||||
(p/recur (rest remaining) (conj acc item)))))))
|
||||
|
||||
(defn rehydrate-large-titles!
|
||||
[repo {:keys [graph-id
|
||||
download-fn
|
||||
aes-key
|
||||
tx-data
|
||||
conn
|
||||
get-conn-f
|
||||
graph-e2ee?-f
|
||||
ensure-graph-aes-key-f
|
||||
fail-fast-f]}]
|
||||
(when-let [conn* (or conn (get-conn-f repo))]
|
||||
(let [graph-id* (or graph-id (get-graph-id repo))
|
||||
items (if (some? tx-data)
|
||||
(->> tx-data
|
||||
(keep (fn [item]
|
||||
(when (and (vector? item)
|
||||
(= :db/add (nth item 0))
|
||||
(= large-title-object-attr (nth item 2))
|
||||
(large-title-object? (nth item 3)))
|
||||
{:e (nth item 1)
|
||||
:obj (nth item 3)})))
|
||||
(distinct))
|
||||
(->> (large-title-object-datoms @conn*)
|
||||
(keep (fn [datom]
|
||||
(let [obj (:v datom)]
|
||||
(when (large-title-object? obj)
|
||||
{:e (:e datom)
|
||||
:obj obj}))))
|
||||
(distinct)))]
|
||||
(when (seq items)
|
||||
(p/let [aes-key* (or aes-key
|
||||
(when (graph-e2ee?-f repo)
|
||||
(ensure-graph-aes-key-f repo graph-id*)))
|
||||
_ (when (and (graph-e2ee?-f repo) (nil? aes-key*))
|
||||
(fail-fast-f :db-sync/missing-field {:repo repo :field :aes-key}))]
|
||||
(p/all
|
||||
(mapv (fn [{:keys [e obj]}]
|
||||
(let [eid (resolve-large-title-item-eid @conn* {:e e :obj obj})]
|
||||
(when-not eid
|
||||
(fail-fast-f :db-sync/large-title-entity-missing
|
||||
{:repo repo :e e :obj obj}))
|
||||
(p/let [title (download-fn repo graph-id* obj aes-key*)]
|
||||
(ldb/transact! conn*
|
||||
[[:db/add eid :block/title title]]
|
||||
{:rtc-tx? true
|
||||
:persist-op? false
|
||||
:op :large-title-rehydrate}))))
|
||||
items)))))))
|
||||
|
||||
(defn offload-large-titles-in-datoms-batch
|
||||
([repo graph-id datoms aes-key upload-fn]
|
||||
(offload-large-titles-in-datoms-batch
|
||||
repo graph-id datoms aes-key upload-fn
|
||||
(into #{}
|
||||
(keep (fn [datom]
|
||||
(when (large-title-datom? datom)
|
||||
(:e datom))))
|
||||
datoms)))
|
||||
([repo graph-id datoms aes-key upload-fn offloaded-title-eids]
|
||||
(p/loop [remaining datoms
|
||||
acc []]
|
||||
(if (empty? remaining)
|
||||
acc
|
||||
(let [datom (first remaining)]
|
||||
(cond
|
||||
(large-title-datom? datom)
|
||||
(p/let [obj (upload-fn repo graph-id (:v datom) aes-key)]
|
||||
(p/recur (rest remaining)
|
||||
(conj acc
|
||||
(assoc datom :v "")
|
||||
(assoc datom :a large-title-object-attr :v obj))))
|
||||
|
||||
(and (= large-title-object-attr (:a datom))
|
||||
(contains? offloaded-title-eids (:e datom)))
|
||||
(p/recur (rest remaining) acc)
|
||||
|
||||
:else
|
||||
(p/recur (rest remaining) (conj acc datom))))))))
|
||||
|
||||
(defn take-upload-datoms-batch
|
||||
[datoms batch-size]
|
||||
(loop [batch (transient [])
|
||||
remaining (seq datoms)
|
||||
n 0]
|
||||
(if (or (nil? remaining) (>= n batch-size))
|
||||
[(persistent! batch) remaining]
|
||||
(recur (conj! batch (first remaining))
|
||||
(next remaining)
|
||||
(inc n)))))
|
||||
|
||||
(defn datom->tx
|
||||
[datom]
|
||||
[:db/add (:e datom) (:a datom) (:v datom)])
|
||||
|
||||
(defn process-upload-datoms-in-batches!
|
||||
[datoms {:keys [batch-size process-batch-f progress-f]
|
||||
:or {batch-size 100000}}]
|
||||
(let [total-count (count datoms)]
|
||||
(p/loop [remaining (seq datoms)
|
||||
processed 0]
|
||||
(if (seq remaining)
|
||||
(let [[batch remaining'] (take-upload-datoms-batch remaining batch-size)
|
||||
processed' (+ processed (count batch))]
|
||||
(p/let [_ (process-batch-f batch)]
|
||||
(when progress-f
|
||||
(progress-f processed' total-count))
|
||||
(p/let [_ (js/Promise. (fn [resolve] (js/setTimeout resolve 0)))]
|
||||
(p/recur remaining' processed'))))
|
||||
nil))))
|
||||
|
||||
(defn rehydrate-large-titles-from-db!
|
||||
[repo graph-id {:keys [get-conn-f rehydrate-large-titles!-f]}]
|
||||
(when-let [conn (get-conn-f repo)]
|
||||
(let [tx-data (mapv (fn [datom]
|
||||
[:db/add (:e datom) large-title-object-attr (:v datom)])
|
||||
(large-title-object-datoms @conn))]
|
||||
(when (seq tx-data)
|
||||
(rehydrate-large-titles!-f repo {:tx-data tx-data :graph-id graph-id})))))
|
||||
41
src/main/frontend/worker/sync/log_and_state.cljs
Normal file
41
src/main/frontend/worker/sync/log_and_state.cljs
Normal file
@@ -0,0 +1,41 @@
|
||||
(ns frontend.worker.sync.log-and-state
|
||||
"Fns to generate rtc related logs"
|
||||
(:require [frontend.worker.shared-service :as shared-service]
|
||||
[logseq.common.defkeywords :refer [defkeywords]]
|
||||
[malli.core :as ma]))
|
||||
|
||||
(def ^:private *rtc-log (atom nil))
|
||||
|
||||
(def ^:private rtc-log-type-schema
|
||||
(vec
|
||||
(concat
|
||||
[:enum]
|
||||
(take-nth
|
||||
2
|
||||
(defkeywords
|
||||
:rtc.log/upload {:doc "rtc log type for upload-graph."}
|
||||
:rtc.log/download {:doc "rtc log type for upload-graph."}
|
||||
:rtc.log/checksum-mismatch {:doc "local/remote checksum mismatch detected"}
|
||||
:rtc.log/tx-rejected {:doc "tx/reject received from server"}
|
||||
:rtc.asset.log/upload-assets {:doc "upload local assets to remote"}
|
||||
:rtc.asset.log/download-assets {:doc "download assets from remote"}
|
||||
:rtc.asset.log/remove-assets {:doc "remove remote assets"}
|
||||
:rtc.asset.log/asset-too-large {:doc "asset is too large to upload"}
|
||||
:rtc.asset.log/initial-download-missing-assets {:doc "download assets if not exists in rtc-asset-sync initial phase"})))))
|
||||
|
||||
(def ^:private rtc-log-type-validator (ma/validator rtc-log-type-schema))
|
||||
|
||||
(defn rtc-log
|
||||
[type m]
|
||||
{:pre [(map? m) (rtc-log-type-validator type)]}
|
||||
(reset! *rtc-log (assoc m :type type :created-at (js/Date.)))
|
||||
nil)
|
||||
|
||||
;;; subscribe-logs, push to frontend
|
||||
;;; TODO: refactor background log subscription
|
||||
(defn- subscribe-logs
|
||||
[]
|
||||
(remove-watch *rtc-log :subscribe-logs)
|
||||
(add-watch *rtc-log :subscribe-logs
|
||||
(fn [_ _ _ n] (when n (shared-service/broadcast-to-clients! :rtc-log n)))))
|
||||
(subscribe-logs)
|
||||
120
src/main/frontend/worker/sync/presence.cljs
Normal file
120
src/main/frontend/worker/sync/presence.cljs
Normal file
@@ -0,0 +1,120 @@
|
||||
(ns frontend.worker.sync.presence
|
||||
"Presence and rtc state helpers for db sync."
|
||||
(:require [logseq.common.util :as common-util]
|
||||
[frontend.worker.state :as worker-state]))
|
||||
|
||||
(defn current-client
|
||||
[db-sync-client repo]
|
||||
(let [client @db-sync-client]
|
||||
(when (= repo (:repo client))
|
||||
client)))
|
||||
|
||||
(defn client-ops-conn
|
||||
[get-client-ops-conn repo]
|
||||
(get-client-ops-conn repo))
|
||||
|
||||
(defn sync-counts
|
||||
[{:keys [get-datascript-conn
|
||||
get-pending-local-tx-count
|
||||
get-unpushed-asset-ops-count
|
||||
get-missing-asset-upload-files
|
||||
get-local-tx
|
||||
get-local-checksum
|
||||
get-graph-uuid
|
||||
latest-remote-tx
|
||||
latest-remote-checksum]}
|
||||
repo]
|
||||
(when (get-datascript-conn repo)
|
||||
(let [pending-local (if get-pending-local-tx-count
|
||||
(get-pending-local-tx-count repo)
|
||||
0)
|
||||
pending-asset (get-unpushed-asset-ops-count repo)
|
||||
missing-asset-upload-files (if get-missing-asset-upload-files
|
||||
(get-missing-asset-upload-files repo)
|
||||
[])
|
||||
local-tx (get-local-tx repo)
|
||||
remote-tx (get latest-remote-tx repo)
|
||||
local-checksum (when get-local-checksum
|
||||
(get-local-checksum repo))
|
||||
remote-checksum (get latest-remote-checksum repo)
|
||||
pending-server (when (and (number? local-tx) (number? remote-tx))
|
||||
(max 0 (- remote-tx local-tx)))
|
||||
graph-uuid (get-graph-uuid repo)
|
||||
client (current-client worker-state/*db-sync-client repo)
|
||||
ws-url (:ws-url @worker-state/*db-sync-config)
|
||||
ws-state (or (some-> client :ws-state deref)
|
||||
(if (seq ws-url) :stopped :inactive))
|
||||
last-error (some-> client :last-sync-error deref)]
|
||||
{:repo repo
|
||||
:graph-id graph-uuid
|
||||
:pending-local pending-local
|
||||
:pending-asset pending-asset
|
||||
:missing-asset-upload-files missing-asset-upload-files
|
||||
:pending-server pending-server
|
||||
:local-tx local-tx
|
||||
:remote-tx remote-tx
|
||||
:local-checksum local-checksum
|
||||
:remote-checksum remote-checksum
|
||||
:ws-state ws-state
|
||||
:last-error last-error})))
|
||||
|
||||
(defn normalize-online-users
|
||||
[users]
|
||||
(->> users
|
||||
(keep (fn [{:keys [user-id email username name]}]
|
||||
(when (string? user-id)
|
||||
(let [display-name (or username name user-id)]
|
||||
(cond-> {:user/uuid user-id
|
||||
:user/name display-name}
|
||||
(string? email) (assoc :user/email email))))))
|
||||
(common-util/distinct-by :user/uuid)
|
||||
(vec)))
|
||||
|
||||
(defn rtc-state-payload
|
||||
[sync-counts-f client]
|
||||
(let [repo (:repo client)
|
||||
ws-state @(:ws-state client)
|
||||
online-users @(:online-users client)
|
||||
{:keys [pending-local pending-asset missing-asset-upload-files pending-server
|
||||
local-tx remote-tx local-checksum remote-checksum graph-id]}
|
||||
(sync-counts-f repo)]
|
||||
{:rtc-state {:ws-state ws-state}
|
||||
:rtc-lock (= :open ws-state)
|
||||
:online-users (or online-users [])
|
||||
:unpushed-block-update-count (or pending-local 0)
|
||||
:pending-asset-ops-count (or pending-asset 0)
|
||||
:missing-asset-upload-files (or missing-asset-upload-files [])
|
||||
:missing-asset-upload-files-count (count missing-asset-upload-files)
|
||||
:pending-server-ops-count (or pending-server 0)
|
||||
:local-tx local-tx
|
||||
:remote-tx remote-tx
|
||||
:local-checksum local-checksum
|
||||
:remote-checksum remote-checksum
|
||||
:graph-uuid graph-id}))
|
||||
|
||||
(defn set-ws-state!
|
||||
[broadcast-f client ws-state]
|
||||
(when-let [*ws-state (:ws-state client)]
|
||||
(reset! *ws-state ws-state)
|
||||
(broadcast-f client)))
|
||||
|
||||
(defn update-online-users!
|
||||
[broadcast-f client users]
|
||||
(when-let [*online-users (:online-users client)]
|
||||
(let [users' (normalize-online-users users)]
|
||||
(when (not= users' @*online-users)
|
||||
(reset! *online-users users')
|
||||
(broadcast-f client)))))
|
||||
|
||||
(defn update-user-presence!
|
||||
[broadcast-f client user-id* editing-block-uuid]
|
||||
(when (and user-id* editing-block-uuid)
|
||||
(when-let [*online-users (:online-users client)]
|
||||
(swap! *online-users
|
||||
(fn [users]
|
||||
(mapv (fn [user]
|
||||
(if (= user-id* (:user/uuid user))
|
||||
(assoc user :user/editing-block-uuid editing-block-uuid)
|
||||
user))
|
||||
users)))
|
||||
(broadcast-f client))))
|
||||
92
src/main/frontend/worker/sync/temp_sqlite.cljs
Normal file
92
src/main/frontend/worker/sync/temp_sqlite.cljs
Normal file
@@ -0,0 +1,92 @@
|
||||
(ns frontend.worker.sync.temp-sqlite
|
||||
"Temporary sqlite helpers for db sync uploads."
|
||||
(:require [cljs-bean.core :as bean]
|
||||
[datascript.core :as d]
|
||||
[datascript.storage :refer [IStorage]]
|
||||
[logseq.db.common.sqlite :as common-sqlite]
|
||||
[logseq.db.sqlite.util :as sqlite-util]
|
||||
[promesa.core :as p]
|
||||
[frontend.worker-common.util :as worker-util]
|
||||
[frontend.worker.platform :as platform]
|
||||
[frontend.worker.state :as worker-state]
|
||||
[frontend.worker.sync.util :refer [fail-fast]]))
|
||||
|
||||
(def upload-temp-pool-name (worker-util/get-pool-name "upload-temp"))
|
||||
|
||||
(defn- upsert-addr-content!
|
||||
[^js db data]
|
||||
(.transaction
|
||||
db
|
||||
(fn [tx]
|
||||
(doseq [item data]
|
||||
(.exec tx #js {:sql (str "INSERT INTO kvs (addr, content, addresses) "
|
||||
"values ($addr, $content, $addresses) "
|
||||
"on conflict(addr) do update set content = $content, addresses = $addresses")
|
||||
:bind item})))))
|
||||
|
||||
(defn- restore-data-from-addr
|
||||
[^js db addr]
|
||||
(when-let [result (-> (.exec db #js {:sql "select content, addresses from kvs where addr = ?"
|
||||
:bind #js [addr]
|
||||
:rowMode "array"})
|
||||
first)]
|
||||
(let [[content addresses] (bean/->clj result)
|
||||
addresses (when addresses (js/JSON.parse addresses))
|
||||
data (sqlite-util/read-transit-str content)]
|
||||
(if (and addresses (map? data))
|
||||
(assoc data :addresses addresses)
|
||||
data))))
|
||||
|
||||
(defn new-temp-sqlite-storage
|
||||
[^js db]
|
||||
(reify IStorage
|
||||
(-store [_ addr+data-seq _delete-addrs]
|
||||
(let [data (map
|
||||
(fn [[addr data]]
|
||||
(let [data' (if (map? data) (dissoc data :addresses) data)
|
||||
addresses (when (map? data)
|
||||
(when-let [addresses (:addresses data)]
|
||||
(js/JSON.stringify (bean/->js addresses))))]
|
||||
#js {:$addr addr
|
||||
:$content (sqlite-util/write-transit-str data')
|
||||
:$addresses addresses}))
|
||||
addr+data-seq)]
|
||||
(upsert-addr-content! db data)))
|
||||
(-restore [_ addr]
|
||||
(restore-data-from-addr db addr))))
|
||||
|
||||
(defn <create-temp-sqlite-db!
|
||||
[]
|
||||
(if-let [sqlite @worker-state/*sqlite]
|
||||
(let [current-platform (platform/current)]
|
||||
(p/let [pool (platform/install-storage-pool current-platform sqlite upload-temp-pool-name)
|
||||
path (platform/resolve-db-path current-platform upload-temp-pool-name pool "/upload.sqlite")
|
||||
db (platform/sqlite-open current-platform
|
||||
{:sqlite sqlite
|
||||
:pool pool
|
||||
:path path
|
||||
:mode "c"})]
|
||||
(common-sqlite/create-kvs-table! db)
|
||||
{:db db
|
||||
:pool pool
|
||||
:path path}))
|
||||
(fail-fast :db-sync/missing-field {:field :sqlite})))
|
||||
|
||||
(defn <create-temp-sqlite-conn
|
||||
[schema datoms]
|
||||
(p/let [{:keys [db path pool]} (<create-temp-sqlite-db!)
|
||||
storage (new-temp-sqlite-storage db)
|
||||
conn (d/conn-from-datoms datoms schema {:storage storage})]
|
||||
{:db db
|
||||
:conn conn
|
||||
:pool pool
|
||||
:path path}))
|
||||
|
||||
(defn cleanup-temp-sqlite!
|
||||
[{:keys [db conn pool]}]
|
||||
(when conn
|
||||
(reset! conn nil))
|
||||
(when db
|
||||
(.close db))
|
||||
(when pool
|
||||
(platform/remove-storage-pool! (platform/current) pool)))
|
||||
112
src/main/frontend/worker/sync/transport.cljs
Normal file
112
src/main/frontend/worker/sync/transport.cljs
Normal file
@@ -0,0 +1,112 @@
|
||||
(ns frontend.worker.sync.transport
|
||||
"Transport and message-shaping helpers for db sync."
|
||||
(:require
|
||||
[clojure.string :as string]
|
||||
[lambdaisland.glogi :as log]
|
||||
[logseq.db-sync.malli-schema :as db-sync-schema]
|
||||
[logseq.db.sqlite.util :as sqlite-util]))
|
||||
|
||||
(def invalid-coerce ::invalid-coerce)
|
||||
|
||||
(defn format-ws-url
|
||||
[base graph-id]
|
||||
(cond
|
||||
(string/includes? base "%s")
|
||||
(string/replace base "%s" graph-id)
|
||||
|
||||
(string/ends-with? base "/")
|
||||
(str base graph-id)
|
||||
|
||||
:else
|
||||
(str base "/" graph-id)))
|
||||
|
||||
(defn append-token
|
||||
[url token]
|
||||
(if (string? token)
|
||||
(let [separator (if (string/includes? url "?") "&" "?")]
|
||||
(str url separator "token=" (js/encodeURIComponent token)))
|
||||
url))
|
||||
|
||||
(defn ready-state
|
||||
[ws]
|
||||
(.-readyState ws))
|
||||
|
||||
(defn ws-open?
|
||||
[ws]
|
||||
(= 1 (ready-state ws)))
|
||||
|
||||
(defn coerce
|
||||
[coercer value context]
|
||||
(try
|
||||
(coercer value)
|
||||
(catch :default e
|
||||
(log/error :db-sync/malli-coerce-failed (merge context {:error e :value value}))
|
||||
invalid-coerce)))
|
||||
|
||||
(defn coerce-ws-client-message
|
||||
[message]
|
||||
(when message
|
||||
(let [coerced (coerce db-sync-schema/ws-client-message-coercer message {:schema :ws/client})]
|
||||
(when-not (= coerced invalid-coerce)
|
||||
coerced))))
|
||||
|
||||
(defn coerce-ws-server-message
|
||||
[message]
|
||||
(when message
|
||||
(letfn [(uuid-like->string [value]
|
||||
(cond
|
||||
(uuid? value) (str value)
|
||||
(and (map? value) (string? (:uuid value))) (:uuid value)
|
||||
:else value))
|
||||
(normalize-legacy-tx-reject [m]
|
||||
(if (= "tx/reject" (:type m))
|
||||
(cond-> m
|
||||
(contains? m :failed-tx-id) (update :failed-tx-id uuid-like->string)
|
||||
(contains? m :success-tx-ids) (update :success-tx-ids
|
||||
(fn [ids]
|
||||
(mapv uuid-like->string (or ids []))))
|
||||
(contains? m :missing-block-uuids) (update :missing-block-uuids
|
||||
(fn [ids]
|
||||
(mapv uuid-like->string (or ids [])))))
|
||||
m))]
|
||||
(let [message* (normalize-legacy-tx-reject message)
|
||||
coerced (coerce db-sync-schema/ws-server-message-coercer message* {:schema :ws/server})]
|
||||
(when-not (= coerced invalid-coerce)
|
||||
coerced)))))
|
||||
|
||||
(defn parse-transit
|
||||
[fail-fast-f value context]
|
||||
(try
|
||||
(sqlite-util/read-transit-str value)
|
||||
(catch :default e
|
||||
(fail-fast-f :db-sync/response-parse-failed (assoc context :error e)))))
|
||||
|
||||
(defn reconnect-delay-ms
|
||||
[attempt {:keys [base-delay-ms max-delay-ms jitter-ms]}]
|
||||
(let [exp (js/Math.pow 2 attempt)
|
||||
delay (min max-delay-ms (* base-delay-ms exp))
|
||||
jitter (rand-int jitter-ms)]
|
||||
(+ delay jitter)))
|
||||
|
||||
(defn parse-message
|
||||
[raw]
|
||||
(try
|
||||
(js->clj (js/JSON.parse raw) :keywordize-keys true)
|
||||
(catch :default _
|
||||
nil)))
|
||||
|
||||
(defn send!
|
||||
[coerce-ws-client-message-f ws message]
|
||||
(when (ws-open? ws)
|
||||
(if-let [coerced (coerce-ws-client-message-f message)]
|
||||
(let [message* (if (= "tx/batch" (:type coerced))
|
||||
(update coerced :txs
|
||||
(fn [txs]
|
||||
(mapv (fn [tx-entry]
|
||||
(if-let [tx-id (:tx-id tx-entry)]
|
||||
(assoc tx-entry :tx-id (str tx-id))
|
||||
tx-entry))
|
||||
txs)))
|
||||
coerced)]
|
||||
(.send ws (js/JSON.stringify (clj->js message*))))
|
||||
(log/error :db-sync/ws-request-invalid {:message message}))))
|
||||
428
src/main/frontend/worker/sync/upload.cljs
Normal file
428
src/main/frontend/worker/sync/upload.cljs
Normal file
@@ -0,0 +1,428 @@
|
||||
(ns frontend.worker.sync.upload
|
||||
"Snapshot upload helpers for db sync."
|
||||
(:require
|
||||
[cljs-bean.core :as bean]
|
||||
[datascript.core :as d]
|
||||
[frontend.worker-common.util :as worker-util]
|
||||
[frontend.worker.state :as worker-state]
|
||||
[frontend.worker.sync.apply-txs :as sync-apply]
|
||||
[frontend.worker.sync.auth :as sync-auth]
|
||||
[frontend.worker.sync.client-op :as client-op]
|
||||
[frontend.worker.sync.crypt :as sync-crypt]
|
||||
[frontend.worker.sync.large-title :as sync-large-title]
|
||||
[frontend.worker.sync.temp-sqlite :as sync-temp-sqlite]
|
||||
[frontend.worker.sync.util :refer [coerce-http-request fail-fast fetch-json] :as sync-util]
|
||||
[logseq.common.config :as common-config]
|
||||
[logseq.db :as ldb]
|
||||
[logseq.db-sync.checksum :as sync-checksum]
|
||||
[logseq.db.sqlite.util :as sqlite-util]
|
||||
[promesa.core :as p]))
|
||||
|
||||
(def upload-kvs-batch-size 500)
|
||||
(def upload-prepare-datoms-batch-size 100000)
|
||||
(def snapshot-upload-max-bytes 1000000)
|
||||
(def snapshot-frame-header-bytes 4)
|
||||
(def ignored-oversized-upload-attrs #{:logseq.property.tldraw/page})
|
||||
(def snapshot-local-only-attrs #{:block/tx-id})
|
||||
(def snapshot-content-type "application/transit+json")
|
||||
(def snapshot-content-encoding "gzip")
|
||||
(def snapshot-text-encoder (js/TextEncoder.))
|
||||
|
||||
(defn- http-base-url
|
||||
[]
|
||||
(sync-auth/http-base-url @worker-state/*db-sync-config))
|
||||
|
||||
(defn- ensure-client-graph-uuid!
|
||||
[repo graph-id]
|
||||
(when (seq graph-id)
|
||||
(client-op/update-graph-uuid repo graph-id)))
|
||||
|
||||
(defn fetch-kvs-rows
|
||||
[db last-addr limit]
|
||||
(.exec db #js {:sql "select addr, content, addresses from kvs where addr > ? order by addr asc limit ?"
|
||||
:bind #js [last-addr limit]
|
||||
:rowMode "array"}))
|
||||
|
||||
(defn count-kvs-rows
|
||||
[db]
|
||||
(when-let [result (-> (.exec db #js {:sql "select count(*) from kvs"
|
||||
:rowMode "array"})
|
||||
first)]
|
||||
(first (bean/->clj result))))
|
||||
|
||||
(defn normalize-snapshot-rows
|
||||
[rows]
|
||||
(mapv (fn [row] (vec row)) (array-seq rows)))
|
||||
|
||||
(defn encode-snapshot-rows
|
||||
[rows]
|
||||
(.encode snapshot-text-encoder (sqlite-util/write-transit-str rows)))
|
||||
|
||||
(defn- datom-value-byte-length
|
||||
[value]
|
||||
(.-byteLength ^js (.encode snapshot-text-encoder (sqlite-util/write-transit-str value))))
|
||||
|
||||
(defn- drop-oversized-upload-datoms
|
||||
[datoms]
|
||||
(let [threshold (- snapshot-upload-max-bytes snapshot-frame-header-bytes)]
|
||||
(reduce (fn [{:keys [kept dropped]} datom]
|
||||
(let [attr (:a datom)
|
||||
size (when (contains? ignored-oversized-upload-attrs attr)
|
||||
(datom-value-byte-length (:v datom)))]
|
||||
(if (and size (> size threshold))
|
||||
{:kept kept
|
||||
:dropped (conj dropped {:a attr
|
||||
:e (:e datom)
|
||||
:bytes size})}
|
||||
{:kept (conj kept datom)
|
||||
:dropped dropped})))
|
||||
{:kept []
|
||||
:dropped []}
|
||||
datoms)))
|
||||
|
||||
(defn- snapshot-rows-byte-length
|
||||
[rows]
|
||||
(+ snapshot-frame-header-bytes
|
||||
(.-byteLength ^js (encode-snapshot-rows rows))))
|
||||
|
||||
(defn- max-prefix-rows-within-bytes
|
||||
[rows max-bytes]
|
||||
(let [rows-count (count rows)]
|
||||
(loop [low 1
|
||||
high rows-count
|
||||
best 0]
|
||||
(if (> low high)
|
||||
best
|
||||
(let [mid (quot (+ low high) 2)
|
||||
rows' (subvec rows 0 mid)
|
||||
size (snapshot-rows-byte-length rows')]
|
||||
(if (<= size max-bytes)
|
||||
(recur (inc mid) high mid)
|
||||
(recur low (dec mid) best)))))))
|
||||
|
||||
(defn- split-snapshot-rows-by-max-bytes
|
||||
[rows max-bytes]
|
||||
(loop [remaining rows
|
||||
batches []]
|
||||
(if (empty? remaining)
|
||||
batches
|
||||
(let [prefix-count (max-prefix-rows-within-bytes remaining max-bytes)]
|
||||
(if (pos? prefix-count)
|
||||
(let [batch (subvec remaining 0 prefix-count)
|
||||
remaining' (subvec remaining prefix-count)]
|
||||
(recur remaining' (conj batches batch)))
|
||||
(let [row (first remaining)
|
||||
row-size (snapshot-rows-byte-length [row])]
|
||||
(fail-fast :db-sync/snapshot-row-too-large
|
||||
{:max-bytes max-bytes
|
||||
:row-size row-size
|
||||
:addr (first row)})))))))
|
||||
|
||||
(defn frame-bytes
|
||||
[^js data]
|
||||
(let [len (.-byteLength data)
|
||||
out (js/Uint8Array. (+ 4 len))
|
||||
view (js/DataView. (.-buffer out))]
|
||||
(.setUint32 view 0 len false)
|
||||
(.set out data 4)
|
||||
out))
|
||||
|
||||
(defn maybe-compress-stream
|
||||
[stream]
|
||||
(if (exists? js/CompressionStream)
|
||||
(.pipeThrough stream (js/CompressionStream. "gzip"))
|
||||
stream))
|
||||
|
||||
(defn <buffer-stream
|
||||
[stream]
|
||||
(p/let [resp (js/Response. stream)
|
||||
buf (.arrayBuffer resp)]
|
||||
buf))
|
||||
|
||||
(defn <snapshot-upload-body
|
||||
[rows]
|
||||
(let [frame (frame-bytes (encode-snapshot-rows rows))
|
||||
stream (js/ReadableStream.
|
||||
#js {:start (fn [controller]
|
||||
(.enqueue controller frame)
|
||||
(.close controller))})
|
||||
use-compression? (exists? js/CompressionStream)
|
||||
body (if use-compression? (maybe-compress-stream stream) stream)]
|
||||
(if use-compression?
|
||||
(p/let [buf (<buffer-stream body)]
|
||||
{:body buf :encoding snapshot-content-encoding})
|
||||
(p/resolved {:body frame :encoding nil}))))
|
||||
|
||||
(defn- snapshot-upload-url
|
||||
[base graph-id reset? finished? checksum]
|
||||
(str base "/sync/" graph-id "/snapshot/upload?reset="
|
||||
(if reset? "true" "false")
|
||||
"&finished="
|
||||
(if finished? "true" "false")
|
||||
(when finished?
|
||||
(str "&checksum=" (js/encodeURIComponent checksum)))))
|
||||
|
||||
(defn- <upload-snapshot-rows-batches!
|
||||
[rows-batches {:keys [base graph-id first-batch? finished? checksum auth-fetch-f]}]
|
||||
(p/loop [remaining rows-batches
|
||||
first-request? first-batch?]
|
||||
(if-let [rows-batch (first remaining)]
|
||||
(let [last-request? (nil? (next remaining))
|
||||
finished-request? (and finished? last-request?)
|
||||
upload-url (snapshot-upload-url base graph-id first-request? finished-request? checksum)]
|
||||
(p/let [{:keys [body encoding]} (<snapshot-upload-body rows-batch)
|
||||
headers (cond-> {"content-type" snapshot-content-type}
|
||||
(string? encoding) (assoc "content-encoding" encoding))
|
||||
_ (auth-fetch-f upload-url headers body)]
|
||||
(p/recur (next remaining) false)))
|
||||
nil)))
|
||||
(defn <prepare-upload-temp-sqlite!
|
||||
[repo graph-id source-conn aes-key update-progress]
|
||||
(p/let [temp (sync-temp-sqlite/<create-temp-sqlite-conn (d/schema @source-conn) [])
|
||||
datoms (remove #(contains? snapshot-local-only-attrs (:a %))
|
||||
(d/datoms @source-conn :eavt))
|
||||
large-title-eids (into #{}
|
||||
(keep (fn [datom]
|
||||
(when (sync-large-title/large-title-datom? datom)
|
||||
(:e datom))))
|
||||
datoms)
|
||||
_ (sync-large-title/process-upload-datoms-in-batches!
|
||||
datoms
|
||||
{:batch-size upload-prepare-datoms-batch-size
|
||||
:process-batch-f
|
||||
(fn [batch]
|
||||
(p/let [datoms* (sync-large-title/offload-large-titles-in-datoms-batch
|
||||
repo graph-id batch aes-key
|
||||
sync-apply/upload-large-title! large-title-eids)
|
||||
{:keys [kept dropped]} (drop-oversized-upload-datoms datoms*)
|
||||
_ (when (seq dropped)
|
||||
(prn :db-sync/drop-oversized-upload-datoms
|
||||
{:repo repo
|
||||
:count (count dropped)
|
||||
:attrs (vec (distinct (map :a dropped)))
|
||||
:max-bytes (apply max (map :bytes dropped))}))
|
||||
encrypted-datoms (if aes-key
|
||||
(sync-crypt/<encrypt-datoms aes-key kept)
|
||||
kept)
|
||||
tx-data (mapv sync-large-title/datom->tx encrypted-datoms)]
|
||||
(d/transact! (:conn temp) tx-data {:initial-db? true})
|
||||
nil))
|
||||
:progress-f
|
||||
(fn [processed total]
|
||||
(update-progress {:sub-type :upload-progress
|
||||
:message (if aes-key
|
||||
(str "Encrypting " processed "/" total)
|
||||
(str "Preparing " processed "/" total))}))})]
|
||||
temp))
|
||||
|
||||
(defn- normalize-graph-e2ee?
|
||||
[graph-e2ee?]
|
||||
(if (nil? graph-e2ee?)
|
||||
true
|
||||
(true? graph-e2ee?)))
|
||||
|
||||
(defn- graph-id->uuid
|
||||
[repo graph-id]
|
||||
(when-not (seq graph-id)
|
||||
(fail-fast :db-sync/missing-field {:repo repo :field :graph-id}))
|
||||
(try
|
||||
(uuid graph-id)
|
||||
(catch :default e
|
||||
(fail-fast :db-sync/invalid-field {:repo repo
|
||||
:field :graph-id
|
||||
:value graph-id
|
||||
:error e}))))
|
||||
|
||||
(defn- set-graph-sync-metadata!
|
||||
[repo graph-id graph-e2ee?]
|
||||
(when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(ldb/transact! conn [(ldb/kv :logseq.kv/graph-uuid (graph-id->uuid repo graph-id))
|
||||
(ldb/kv :logseq.kv/graph-remote? true)
|
||||
(ldb/kv :logseq.kv/graph-rtc-e2ee? (true? graph-e2ee?))]
|
||||
{:outliner-op :set-kvs})))
|
||||
|
||||
(defn- persist-upload-graph-identity!
|
||||
[repo graph-id graph-e2ee?]
|
||||
(let [graph-id (some-> graph-id str)
|
||||
graph-e2ee? (normalize-graph-e2ee? graph-e2ee?)]
|
||||
(when-not (seq graph-id)
|
||||
(fail-fast :db-sync/missing-field {:repo repo :field :graph-id}))
|
||||
(set-graph-sync-metadata! repo graph-id graph-e2ee?)
|
||||
(ensure-client-graph-uuid! repo graph-id)
|
||||
{:graph-id graph-id
|
||||
:graph-e2ee? graph-e2ee?}))
|
||||
|
||||
(defn- <create-remote-graph-aux!
|
||||
[repo {:keys [graph-e2ee? graph-ready-for-use?]}]
|
||||
(let [base (http-base-url)
|
||||
graph-name (some-> repo common-config/strip-leading-db-version-prefix)
|
||||
schema-version (some-> (worker-state/get-datascript-conn repo)
|
||||
deref
|
||||
ldb/get-graph-schema-version
|
||||
:major
|
||||
str)
|
||||
graph-e2ee? (normalize-graph-e2ee? graph-e2ee?)]
|
||||
(cond
|
||||
(not (seq base))
|
||||
(fail-fast :db-sync/missing-field {:repo repo :field :http-base})
|
||||
|
||||
(not (seq graph-name))
|
||||
(fail-fast :db-sync/missing-field {:repo repo :field :graph-name})
|
||||
|
||||
:else
|
||||
(do
|
||||
(sync-util/require-auth-token! {:repo repo :field :auth-token})
|
||||
(p/let [_ (when graph-e2ee?
|
||||
(sync-crypt/ensure-user-rsa-keys! {:ensure-server? true}))
|
||||
body (coerce-http-request :graphs/create
|
||||
{:graph-name graph-name
|
||||
:schema-version schema-version
|
||||
:graph-e2ee? graph-e2ee?
|
||||
:graph-ready-for-use? (not= false graph-ready-for-use?)})
|
||||
_ (when (nil? body)
|
||||
(fail-fast :db-sync/invalid-field {:repo repo
|
||||
:field :create-graph-body}))
|
||||
result (fetch-json (str base "/graphs")
|
||||
{:method "POST"
|
||||
:headers {"content-type" "application/json"}
|
||||
:body (js/JSON.stringify (clj->js body))}
|
||||
{:response-schema :graphs/create})
|
||||
graph-id (:graph-id result)
|
||||
graph-e2ee? (normalize-graph-e2ee? (if (contains? result :graph-e2ee?)
|
||||
(:graph-e2ee? result)
|
||||
graph-e2ee?))]
|
||||
(when-not (seq graph-id)
|
||||
(fail-fast :db-sync/missing-field {:repo repo
|
||||
:field :graph-id
|
||||
:op :create-graph}))
|
||||
(persist-upload-graph-identity! repo graph-id graph-e2ee?)
|
||||
{:graph-id graph-id
|
||||
:graph-e2ee? graph-e2ee?})))))
|
||||
|
||||
(defn list-remote-graphs!
|
||||
[]
|
||||
(let [base (sync-auth/http-base-url @worker-state/*db-sync-config)]
|
||||
(if-not (seq base)
|
||||
(p/resolved [])
|
||||
(do
|
||||
(sync-util/require-auth-token! {:op :list-remote-graphs})
|
||||
(p/let [resp (fetch-json (str base "/graphs")
|
||||
{:method "GET"}
|
||||
{:response-schema :graphs/list})]
|
||||
(vec (or (:graphs resp) [])))))))
|
||||
|
||||
(defn- fail-upload-graph-already-exists!
|
||||
[repo {:keys [graph-id graph-name]}]
|
||||
(throw (ex-info "remote graph already exists; delete it before uploading again"
|
||||
{:code :db-sync/graph-already-exists
|
||||
:repo repo
|
||||
:graph-id graph-id
|
||||
:graph-name graph-name})))
|
||||
|
||||
(defn- remote-graph-matches-upload-target?
|
||||
[target-graph-name {:keys [graph-name]}]
|
||||
(= target-graph-name graph-name))
|
||||
|
||||
(defn create-remote-graph!
|
||||
[repo {:keys [graph-e2ee? graph-ready-for-use?]}]
|
||||
(let [target-graph-name (some-> repo common-config/strip-leading-db-version-prefix)]
|
||||
(cond
|
||||
(not (seq target-graph-name))
|
||||
(fail-fast :db-sync/missing-field {:repo repo :field :graph-name})
|
||||
|
||||
:else
|
||||
(p/let [remote-graphs (list-remote-graphs!)
|
||||
matching-graphs (filterv (partial remote-graph-matches-upload-target?
|
||||
target-graph-name)
|
||||
remote-graphs)]
|
||||
(cond
|
||||
(> (count matching-graphs) 1)
|
||||
(fail-fast :db-sync/ambiguous-graph-match {:repo repo
|
||||
:graph-name target-graph-name
|
||||
:match-count (count matching-graphs)})
|
||||
|
||||
(= 1 (count matching-graphs))
|
||||
(fail-upload-graph-already-exists! repo {:graph-name target-graph-name})
|
||||
|
||||
:else
|
||||
(p/let [_ (sync-crypt/<preflight-upload-e2ee! repo graph-e2ee?)]
|
||||
(<create-remote-graph-aux! repo {:graph-e2ee? graph-e2ee?
|
||||
:graph-ready-for-use? graph-ready-for-use?})))))))
|
||||
|
||||
(defn upload-graph!
|
||||
[repo]
|
||||
(let [base (http-base-url)
|
||||
update-progress (fn [payload]
|
||||
(worker-util/post-message :rtc-log
|
||||
(merge {:type :rtc.log/upload}
|
||||
payload)))]
|
||||
(if-not (seq base)
|
||||
(p/rejected (ex-info "db-sync missing base"
|
||||
{:repo repo :base base}))
|
||||
(if-let [source-conn (worker-state/get-datascript-conn repo)]
|
||||
(p/let [graph-e2ee? (normalize-graph-e2ee? (sync-crypt/graph-e2ee? repo))
|
||||
{:keys [graph-id]} (create-remote-graph! repo {:graph-e2ee? graph-e2ee?
|
||||
:graph-ready-for-use? false})]
|
||||
(p/let [aes-key (when graph-e2ee?
|
||||
(sync-crypt/<ensure-graph-aes-key repo graph-id))
|
||||
_ (when (and graph-e2ee? (nil? aes-key))
|
||||
(fail-fast :db-sync/missing-field {:repo repo :field :aes-key}))]
|
||||
(let [snapshot-checksum (sync-checksum/recompute-checksum @source-conn)]
|
||||
(client-op/update-local-checksum repo snapshot-checksum)
|
||||
(p/let [_ (update-progress {:sub-type :upload-progress
|
||||
:message (if graph-e2ee? "Encrypting..." "Preparing...")})
|
||||
{:keys [db] :as temp} (<prepare-upload-temp-sqlite!
|
||||
repo graph-id source-conn aes-key update-progress)
|
||||
total-rows (count-kvs-rows db)]
|
||||
(-> (p/loop [last-addr -1
|
||||
first-batch? true
|
||||
loaded 0]
|
||||
(let [rows (fetch-kvs-rows db last-addr upload-kvs-batch-size)]
|
||||
(if (empty? rows)
|
||||
(do
|
||||
(sync-apply/clear-pending-txs! repo)
|
||||
(client-op/reset-local-tx repo)
|
||||
(client-op/add-all-exists-asset-as-ops repo)
|
||||
(update-progress {:sub-type :upload-completed
|
||||
:message "Graph upload finished!"})
|
||||
{:graph-id graph-id})
|
||||
(let [max-addr (apply max (map first rows))
|
||||
rows* (normalize-snapshot-rows rows)
|
||||
loaded' (+ loaded (count rows*))
|
||||
finished? (= loaded' total-rows)
|
||||
row-batches (split-snapshot-rows-by-max-bytes rows* snapshot-upload-max-bytes)
|
||||
batch-payloads
|
||||
(mapv (fn [rows-batch]
|
||||
{:rows (count rows-batch)
|
||||
:payload-bytes (snapshot-rows-byte-length rows-batch)})
|
||||
row-batches)]
|
||||
(prn :db-sync/upload-kvs-batch
|
||||
{:total-kvs-rows total-rows
|
||||
:fetched-kvs-rows (count rows*)
|
||||
:upload-kvs-batch-size upload-kvs-batch-size
|
||||
:split-batch-count (count row-batches)
|
||||
:split-batches batch-payloads
|
||||
:max-request-bytes snapshot-upload-max-bytes})
|
||||
(p/let [_ (<upload-snapshot-rows-batches!
|
||||
row-batches
|
||||
{:base base
|
||||
:graph-id graph-id
|
||||
:first-batch? first-batch?
|
||||
:finished? finished?
|
||||
:checksum snapshot-checksum
|
||||
:auth-fetch-f
|
||||
(fn [upload-url headers body]
|
||||
(fetch-json
|
||||
upload-url
|
||||
{:method "POST"
|
||||
:headers headers
|
||||
:body body}
|
||||
{:response-schema :sync/snapshot-upload}))})]
|
||||
(update-progress {:sub-type :upload-progress
|
||||
:message (str "Uploading " loaded' "/" total-rows)})
|
||||
(p/recur max-addr false loaded'))))))
|
||||
(p/finally
|
||||
(fn []
|
||||
(sync-temp-sqlite/cleanup-temp-sqlite! temp))))))))
|
||||
(p/rejected (ex-info "db-sync missing datascript conn"
|
||||
{:repo repo}))))))
|
||||
138
src/main/frontend/worker/sync/util.cljs
Normal file
138
src/main/frontend/worker/sync/util.cljs
Normal file
@@ -0,0 +1,138 @@
|
||||
(ns frontend.worker.sync.util
|
||||
"Helpers for sync"
|
||||
(:require [lambdaisland.glogi :as log]
|
||||
[frontend.worker.platform :as platform]
|
||||
[frontend.worker.state :as worker-state]
|
||||
[logseq.db :as ldb]
|
||||
[frontend.worker.sync.client-op :as client-op]
|
||||
[logseq.common.util :as common-util]
|
||||
[logseq.common.version :as build-version]
|
||||
[logseq.db-sync.malli-schema :as db-sync-schema]
|
||||
[promesa.core :as p]))
|
||||
|
||||
(defn fail-fast [tag data]
|
||||
(log/error tag data)
|
||||
(throw (ex-info (name tag) data)))
|
||||
|
||||
(defn cli-node-owner?
|
||||
[]
|
||||
(try
|
||||
(let [env (:env (platform/current))]
|
||||
(and (= :node (:runtime env))
|
||||
(= :cli (:owner-source env))))
|
||||
(catch :default _ false)))
|
||||
|
||||
(defn auth-token
|
||||
[]
|
||||
(let [state @worker-state/*state]
|
||||
(or (:auth/id-token state)
|
||||
(:auth/access-token state))))
|
||||
|
||||
(defn get-graph-id
|
||||
[repo]
|
||||
(or (when-let [conn (worker-state/get-datascript-conn repo)]
|
||||
(let [db @conn
|
||||
graph-uuid (ldb/get-graph-rtc-uuid db)]
|
||||
(when graph-uuid
|
||||
(str graph-uuid))))
|
||||
(some-> (client-op/get-graph-uuid repo) str)))
|
||||
|
||||
(defn require-auth-token!
|
||||
[context]
|
||||
(when-not (seq (auth-token))
|
||||
(fail-fast :db-sync/missing-field (assoc context :field :auth-token))))
|
||||
|
||||
(defn- ex-message->code
|
||||
[message]
|
||||
(when (and (string? message)
|
||||
(re-matches #"[a-zA-Z0-9._/\-]+" message))
|
||||
(keyword message)))
|
||||
|
||||
(defn- error->diagnostic
|
||||
[error]
|
||||
(let [data (or (ex-data error) {})
|
||||
code (or (:code data)
|
||||
(ex-message->code (ex-message error))
|
||||
:exception)]
|
||||
{:code code
|
||||
:message (or (ex-message error) (str error))
|
||||
:at (common-util/time-ms)
|
||||
:data (when (seq data) data)}))
|
||||
|
||||
(defn set-last-sync-error!
|
||||
[client error]
|
||||
(when-let [*last-error (:last-sync-error client)]
|
||||
(reset! *last-error (error->diagnostic error))))
|
||||
|
||||
(defn clear-last-sync-error!
|
||||
[client]
|
||||
(when-let [*last-error (:last-sync-error client)]
|
||||
(reset! *last-error nil)))
|
||||
|
||||
(def ^:private invalid-coerce ::invalid-coerce)
|
||||
|
||||
(defn coerce
|
||||
[coercer value context]
|
||||
(try
|
||||
(coercer value)
|
||||
(catch :default e
|
||||
(log/error :db-sync/malli-coerce-failed (merge context {:error e :value value}))
|
||||
invalid-coerce)))
|
||||
|
||||
(defn- with-client-revision
|
||||
[schema-key body]
|
||||
(cond-> body
|
||||
(and (= :sync/tx-batch schema-key)
|
||||
(map? body)
|
||||
(not (contains? body :client-revision)))
|
||||
(assoc :client-revision (build-version/revision))))
|
||||
|
||||
(defn coerce-http-request [schema-key body]
|
||||
(if-let [coercer (get db-sync-schema/http-request-coercers schema-key)]
|
||||
(let [coerced (coerce coercer (with-client-revision schema-key body) {:schema schema-key :dir :request})]
|
||||
(when-not (= coerced invalid-coerce)
|
||||
coerced))
|
||||
body))
|
||||
|
||||
(defn coerce-http-response [schema-key body]
|
||||
(if-let [coercer (get db-sync-schema/http-response-coercers schema-key)]
|
||||
(let [coerced (coerce coercer body {:schema schema-key :dir :response})]
|
||||
(when-not (= coerced invalid-coerce)
|
||||
coerced))
|
||||
body))
|
||||
|
||||
(defn- auth-headers []
|
||||
(let [token (auth-token)]
|
||||
(when (nil? token)
|
||||
(throw (ex-info "Empty token" {})))
|
||||
{"authorization" (str "Bearer " token)}))
|
||||
|
||||
(defn- with-auth-headers [opts]
|
||||
(if-let [auth (auth-headers)]
|
||||
(assoc opts :headers (merge (or (:headers opts) {}) auth))
|
||||
opts))
|
||||
|
||||
(defn fetch-json
|
||||
[url opts {:keys [response-schema error-schema] :or {error-schema :error}}]
|
||||
(p/let [resp (js/fetch url (clj->js (with-auth-headers opts)))
|
||||
text (.text resp)
|
||||
data (when (seq text) (js/JSON.parse text))]
|
||||
(if (.-ok resp)
|
||||
(let [body (js->clj data :keywordize-keys true)
|
||||
body (if response-schema
|
||||
(coerce-http-response response-schema body)
|
||||
body)]
|
||||
(if (or (nil? response-schema) body)
|
||||
body
|
||||
(throw (ex-info "db-sync invalid response"
|
||||
{:status (.-status resp)
|
||||
:url url
|
||||
:body body}))))
|
||||
(let [body (when data (js->clj data :keywordize-keys true))
|
||||
body (if error-schema
|
||||
(coerce-http-response error-schema body)
|
||||
body)]
|
||||
(throw (ex-info "db-sync request failed"
|
||||
{:status (.-status resp)
|
||||
:url url
|
||||
:body body}))))))
|
||||
12
src/main/frontend/worker/thread_atom.cljs
Normal file
12
src/main/frontend/worker/thread_atom.cljs
Normal file
@@ -0,0 +1,12 @@
|
||||
(ns frontend.worker.thread-atom
|
||||
"atoms from ui-thread"
|
||||
(:require [frontend.common.thread-api :as thread-api :refer [def-thread-api]]
|
||||
[frontend.worker.state :as worker-state]))
|
||||
|
||||
(def-thread-api :thread-api/update-thread-atom
|
||||
[atom-key new-value]
|
||||
(assert (and (keyword? atom-key)
|
||||
(identical? "thread-atom" (namespace atom-key))))
|
||||
(when-let [a (get @worker-state/*state atom-key)]
|
||||
(reset! a new-value)
|
||||
nil))
|
||||
175
src/main/frontend/worker/ui_request.cljs
Normal file
175
src/main/frontend/worker/ui_request.cljs
Normal file
@@ -0,0 +1,175 @@
|
||||
(ns frontend.worker.ui-request
|
||||
"UI request/response manager for worker-side interactive flows."
|
||||
(:require [frontend.common.thread-api :refer [def-thread-api]]
|
||||
[frontend.worker.platform :as platform]
|
||||
[lambdaisland.glogi :as log]
|
||||
[promesa.core :as p]))
|
||||
|
||||
(defonce ^:private *ui-requests-in-flight (atom {}))
|
||||
|
||||
(def ^:private default-timeout-ms 60000)
|
||||
|
||||
(defn- interactive-runtime?
|
||||
[]
|
||||
(let [env (:env (platform/current))
|
||||
runtime (:runtime env)
|
||||
owner-source (:owner-source env)]
|
||||
(or (= :browser runtime)
|
||||
(and (= :node runtime)
|
||||
(= :electron owner-source)))))
|
||||
|
||||
(defn- ui-interaction-required-error
|
||||
[action hint]
|
||||
(ex-info "ui-interaction-required"
|
||||
(cond-> {:code :ui-interaction-required
|
||||
:action action}
|
||||
(seq hint) (assoc :hint hint))))
|
||||
|
||||
(defn- normalize-timeout-ms
|
||||
[timeout-ms]
|
||||
(if (and (number? timeout-ms) (pos? timeout-ms))
|
||||
timeout-ms
|
||||
default-timeout-ms))
|
||||
|
||||
(defn- take-request!
|
||||
[request-id]
|
||||
(let [request (get @*ui-requests-in-flight request-id)]
|
||||
(when request
|
||||
(swap! *ui-requests-in-flight dissoc request-id)
|
||||
request)))
|
||||
|
||||
(defn- timeout-error
|
||||
[request-id action timeout-ms]
|
||||
(ex-info "ui-request-timeout"
|
||||
{:code :ui-request-timeout
|
||||
:request-id request-id
|
||||
:action action
|
||||
:timeout-ms timeout-ms}))
|
||||
|
||||
(defn- cancel-error
|
||||
[request-id action context]
|
||||
(ex-info "ui-request-cancelled"
|
||||
{:code :ui-request-cancelled
|
||||
:request-id request-id
|
||||
:action action
|
||||
:context context}))
|
||||
|
||||
(defn- reject-error
|
||||
[request-id action error]
|
||||
(let [data (ex-data error)
|
||||
message (or (ex-message error) "ui-request-rejected")]
|
||||
(ex-info message
|
||||
(merge {:code :ui-request-rejected
|
||||
:request-id request-id
|
||||
:action action}
|
||||
(when (seq data)
|
||||
{:data data})))))
|
||||
|
||||
(defn- ->rejectable-error
|
||||
[request-id action error]
|
||||
(cond
|
||||
(instance? cljs.core.ExceptionInfo error)
|
||||
(reject-error request-id action error)
|
||||
|
||||
(instance? js/Error error)
|
||||
(reject-error request-id action error)
|
||||
|
||||
(map? error)
|
||||
(let [message (or (:message error) "ui-request-rejected")
|
||||
data (dissoc error :message)]
|
||||
(ex-info message
|
||||
(merge {:code :ui-request-rejected
|
||||
:request-id request-id
|
||||
:action action}
|
||||
(when (seq data)
|
||||
{:data data}))))
|
||||
|
||||
(string? error)
|
||||
(ex-info error
|
||||
{:code :ui-request-rejected
|
||||
:request-id request-id
|
||||
:action action})
|
||||
|
||||
:else
|
||||
(ex-info "ui-request-rejected"
|
||||
{:code :ui-request-rejected
|
||||
:request-id request-id
|
||||
:action action
|
||||
:error error})))
|
||||
|
||||
(defn <request
|
||||
([action payload]
|
||||
(<request action payload nil))
|
||||
([action payload {:keys [timeout-ms hint]}]
|
||||
(if-not (interactive-runtime?)
|
||||
(p/rejected (ui-interaction-required-error action hint))
|
||||
(let [request-id (str (random-uuid))
|
||||
timeout-ms (normalize-timeout-ms timeout-ms)
|
||||
deferred (p/deferred)
|
||||
timeout-id (js/setTimeout
|
||||
(fn []
|
||||
(when-let [{:keys [deferred action timeout-ms]} (take-request! request-id)]
|
||||
(p/reject! deferred (timeout-error request-id action timeout-ms))))
|
||||
timeout-ms)]
|
||||
(swap! *ui-requests-in-flight assoc request-id
|
||||
{:request-id request-id
|
||||
:action action
|
||||
:deferred deferred
|
||||
:timeout-id timeout-id
|
||||
:timeout-ms timeout-ms})
|
||||
(try
|
||||
(platform/post-message! (platform/current)
|
||||
:db-worker/ui-request
|
||||
{:request-id request-id
|
||||
:action action
|
||||
:payload payload
|
||||
:timeout-ms timeout-ms})
|
||||
(catch :default error
|
||||
(when-let [{:keys [deferred timeout-id action]} (take-request! request-id)]
|
||||
(js/clearTimeout timeout-id)
|
||||
(p/reject! deferred (reject-error request-id action error)))))
|
||||
deferred))))
|
||||
|
||||
(defn resolve-request!
|
||||
[request-id result]
|
||||
(if-let [{:keys [deferred timeout-id]} (take-request! request-id)]
|
||||
(do
|
||||
(js/clearTimeout timeout-id)
|
||||
(p/resolve! deferred result)
|
||||
{:ok true})
|
||||
(do
|
||||
(log/warn :db-worker/ui-request-missing-resolve {:request-id request-id})
|
||||
{:ok false :reason :request-not-found :request-id request-id})))
|
||||
|
||||
(defn reject-request!
|
||||
[request-id error]
|
||||
(if-let [{:keys [deferred timeout-id action]} (take-request! request-id)]
|
||||
(do
|
||||
(js/clearTimeout timeout-id)
|
||||
(p/reject! deferred (->rejectable-error request-id action error))
|
||||
{:ok true})
|
||||
(do
|
||||
(log/warn :db-worker/ui-request-missing-reject {:request-id request-id
|
||||
:error error})
|
||||
{:ok false :reason :request-not-found :request-id request-id})))
|
||||
|
||||
(defn cancel-all!
|
||||
[context]
|
||||
(let [requests (vals @*ui-requests-in-flight)]
|
||||
(reset! *ui-requests-in-flight {})
|
||||
(doseq [{:keys [request-id deferred timeout-id action]} requests]
|
||||
(js/clearTimeout timeout-id)
|
||||
(p/reject! deferred (cancel-error request-id action context)))
|
||||
{:ok true :cancelled (count requests)}))
|
||||
|
||||
(def-thread-api :thread-api/resolve-ui-request
|
||||
[request-id result]
|
||||
(resolve-request! request-id result))
|
||||
|
||||
(def-thread-api :thread-api/reject-ui-request
|
||||
[request-id error]
|
||||
(reject-request! request-id error))
|
||||
|
||||
(def-thread-api :thread-api/cancel-ui-requests
|
||||
[context]
|
||||
(cancel-all! context))
|
||||
368
src/main/frontend/worker/undo_redo.cljs
Normal file
368
src/main/frontend/worker/undo_redo.cljs
Normal file
@@ -0,0 +1,368 @@
|
||||
(ns frontend.worker.undo-redo
|
||||
"Undo redo new implementation"
|
||||
(:require [datascript.core :as d]
|
||||
[frontend.worker.state :as worker-state]
|
||||
[frontend.worker.sync.client-op :as client-op]
|
||||
[lambdaisland.glogi :as log]
|
||||
[logseq.common.defkeywords :refer [defkeywords]]
|
||||
[malli.core :as m]
|
||||
[malli.util :as mu]))
|
||||
|
||||
(defkeywords
|
||||
::record-editor-info {:doc "record current editor and cursor"}
|
||||
::db-transact {:doc "db tx"}
|
||||
::ui-state {:doc "ui state such as route && sidebar blocks"})
|
||||
|
||||
(defonce *apply-history-action! (atom nil))
|
||||
|
||||
;; TODO: add other UI states such as `::ui-updates`.
|
||||
(comment
|
||||
;; TODO: convert it to a qualified-keyword
|
||||
(sr/defkeyword :gen-undo-ops?
|
||||
"tx-meta option, generate undo ops from tx-data when true (default true)"))
|
||||
|
||||
(def ^:private selection-editor-info-schema
|
||||
[:map
|
||||
[:selected-block-uuids [:sequential :uuid]]
|
||||
[:selection-direction {:optional true} [:maybe [:enum :up :down]]]])
|
||||
|
||||
(def ^:private editor-cursor-info-schema
|
||||
[:map
|
||||
[:block-uuid :uuid]
|
||||
[:container-id [:or :int [:enum :unknown-container]]]
|
||||
[:start-pos [:maybe :int]]
|
||||
[:end-pos [:maybe :int]]
|
||||
[:selected-block-uuids {:optional true} [:sequential :uuid]]
|
||||
[:selection-direction {:optional true} [:maybe [:enum :up :down]]]])
|
||||
|
||||
(def ^:private undo-op-item-schema
|
||||
(mu/closed-schema
|
||||
[:multi {:dispatch first}
|
||||
[::db-transact
|
||||
[:cat :keyword
|
||||
[:map
|
||||
[:tx-meta [:map {:closed false}
|
||||
[:outliner-op :keyword]]]
|
||||
[:added-ids [:set :int]]
|
||||
[:retracted-ids [:set :int]]
|
||||
[:db-sync/tx-id {:optional true} :uuid]
|
||||
[:db-sync/forward-outliner-ops {:optional true}
|
||||
[:maybe [:sequential :any]]]
|
||||
[:db-sync/inverse-outliner-ops {:optional true}
|
||||
[:maybe [:sequential :any]]]]]]
|
||||
|
||||
[::record-editor-info
|
||||
[:cat :keyword
|
||||
[:or
|
||||
editor-cursor-info-schema
|
||||
selection-editor-info-schema]]]
|
||||
|
||||
[::ui-state
|
||||
[:cat :keyword :string]]]))
|
||||
|
||||
(def ^:private undo-op-validator (m/validator [:sequential undo-op-item-schema]))
|
||||
|
||||
(defonce max-stack-length 250)
|
||||
(defonce *undo-ops (atom {}))
|
||||
(defonce *redo-ops (atom {}))
|
||||
(defonce *pending-editor-info (atom {}))
|
||||
|
||||
(defn clear-history!
|
||||
[repo]
|
||||
(swap! *undo-ops assoc repo [])
|
||||
(swap! *redo-ops assoc repo [])
|
||||
(swap! *pending-editor-info dissoc repo))
|
||||
|
||||
(defn set-pending-editor-info!
|
||||
[repo editor-info]
|
||||
(if editor-info
|
||||
(swap! *pending-editor-info assoc repo editor-info)
|
||||
(swap! *pending-editor-info dissoc repo)))
|
||||
|
||||
(defn- take-pending-editor-info!
|
||||
[repo]
|
||||
(let [editor-info (get @*pending-editor-info repo)]
|
||||
(swap! *pending-editor-info dissoc repo)
|
||||
editor-info))
|
||||
|
||||
(defn- conj-op
|
||||
[col op]
|
||||
(let [result (conj (if (empty? col) [] col) op)]
|
||||
(if (>= (count result) max-stack-length)
|
||||
(subvec result 0 (/ max-stack-length 2))
|
||||
result)))
|
||||
|
||||
(defn- pop-stack
|
||||
[stack]
|
||||
(when (seq stack)
|
||||
[(last stack) (pop stack)]))
|
||||
|
||||
(defn- push-undo-op
|
||||
[repo op]
|
||||
(assert (undo-op-validator op) {:op op})
|
||||
(swap! *undo-ops update repo conj-op op))
|
||||
|
||||
(defn- push-redo-op
|
||||
[repo op]
|
||||
(assert (undo-op-validator op) {:op op})
|
||||
(swap! *redo-ops update repo conj-op op))
|
||||
|
||||
(defn- pop-undo-op
|
||||
[repo]
|
||||
(let [undo-stack (get @*undo-ops repo)
|
||||
[op undo-stack*] (pop-stack undo-stack)]
|
||||
(swap! *undo-ops assoc repo undo-stack*)
|
||||
op))
|
||||
|
||||
(defn- pop-redo-op
|
||||
[repo]
|
||||
(let [redo-stack (get @*redo-ops repo)
|
||||
[op redo-stack*] (pop-stack redo-stack)]
|
||||
(swap! *redo-ops assoc repo redo-stack*)
|
||||
op))
|
||||
|
||||
(defn- empty-undo-stack?
|
||||
[repo]
|
||||
(empty? (get @*undo-ops repo)))
|
||||
|
||||
(defn- empty-redo-stack?
|
||||
[repo]
|
||||
(empty? (get @*redo-ops repo)))
|
||||
|
||||
(defn- undo-redo-action-meta
|
||||
[{:keys [tx-meta]
|
||||
source-tx-id :db-sync/tx-id}
|
||||
undo?]
|
||||
(-> tx-meta
|
||||
(dissoc :db-sync/tx-id)
|
||||
(assoc
|
||||
:gen-undo-ops? false
|
||||
:persist-op? true
|
||||
:undo? undo?
|
||||
:redo? (not undo?)
|
||||
:db-sync/source-tx-id source-tx-id)))
|
||||
|
||||
(defn- rebind-op-db-sync-tx-id
|
||||
[op history-tx-id]
|
||||
(if (uuid? history-tx-id)
|
||||
(mapv (fn [item]
|
||||
(if (= ::db-transact (first item))
|
||||
[::db-transact (assoc (second item) :db-sync/tx-id history-tx-id)]
|
||||
item))
|
||||
op)
|
||||
op))
|
||||
|
||||
(defn- skippable-worker-error?
|
||||
[error]
|
||||
(= :invalid-history-action-ops (:reason (ex-data error))))
|
||||
|
||||
(defn- skippable-worker-result?
|
||||
[undo? {:keys [reason]}]
|
||||
(if undo?
|
||||
(contains? #{:invalid-history-action-ops
|
||||
:invalid-history-action-tx
|
||||
:unsupported-history-action}
|
||||
reason)
|
||||
(contains? #{:invalid-history-action-ops}
|
||||
reason)))
|
||||
|
||||
(defn- expected-invalid-history-action-reason?
|
||||
[reason]
|
||||
(contains? #{:invalid-history-action-ops
|
||||
:invalid-history-action-tx}
|
||||
reason))
|
||||
|
||||
(declare undo-redo-aux)
|
||||
|
||||
(defn- empty-stack-result
|
||||
[undo?]
|
||||
(if undo? ::empty-undo-stack ::empty-redo-stack))
|
||||
|
||||
(defn- push-opposite-op!
|
||||
[repo undo? op]
|
||||
(let [sanitize-db-transact
|
||||
(fn [data]
|
||||
;; Keep undo/redo history op-only. Drop any legacy/raw tx payloads.
|
||||
(dissoc data
|
||||
:tx
|
||||
:tx-data
|
||||
:reversed-tx
|
||||
:reversed-tx-data
|
||||
:db-sync/normalized-tx-data
|
||||
:db-sync/reversed-tx-data))
|
||||
op' (mapv (fn [item]
|
||||
(if (= ::db-transact (first item))
|
||||
[::db-transact (sanitize-db-transact (second item))]
|
||||
item))
|
||||
op)]
|
||||
((if undo? push-redo-op push-undo-op) repo op')))
|
||||
|
||||
(defn- undo-redo-result
|
||||
[repo conn undo? op op']
|
||||
(push-opposite-op! repo undo? op')
|
||||
(let [editor-cursors (->> (filter #(= ::record-editor-info (first %)) op)
|
||||
(map second))
|
||||
cursor (if undo?
|
||||
(first editor-cursors)
|
||||
(or (last editor-cursors) (first editor-cursors)))
|
||||
block-content (when-let [block-uuid (:block-uuid cursor)]
|
||||
(:block/title (d/entity @conn [:block/uuid block-uuid])))]
|
||||
{:undo? undo?
|
||||
:editor-cursors editor-cursors
|
||||
:block-content block-content}))
|
||||
|
||||
(defn- skip-op-and-recur
|
||||
[repo undo?]
|
||||
(undo-redo-aux repo undo?))
|
||||
|
||||
(defn- apply-history-action
|
||||
[repo conn undo? op tx-meta' tx-id]
|
||||
(if-let [apply-action @*apply-history-action!]
|
||||
(try
|
||||
(let [worker-result (apply-action repo tx-id undo? tx-meta')]
|
||||
(cond
|
||||
(:applied? worker-result)
|
||||
(undo-redo-result repo conn undo? op
|
||||
(if undo?
|
||||
op
|
||||
(rebind-op-db-sync-tx-id op (:history-tx-id worker-result))))
|
||||
|
||||
(skippable-worker-result? undo? worker-result)
|
||||
(skip-op-and-recur repo undo?)
|
||||
|
||||
:else
|
||||
(do
|
||||
(when-not (expected-invalid-history-action-reason? (:reason worker-result))
|
||||
(log/error ::undo-redo-worker-action-unavailable
|
||||
{:undo? undo?
|
||||
:repo repo
|
||||
:tx-id tx-id
|
||||
:result worker-result}))
|
||||
(clear-history! repo)
|
||||
(empty-stack-result undo?))))
|
||||
(catch :default e
|
||||
(if (skippable-worker-error? e)
|
||||
(skip-op-and-recur repo undo?)
|
||||
(do
|
||||
(log/error ::undo-redo-worker-failed e)
|
||||
(clear-history! repo)
|
||||
(throw e)))))
|
||||
(do
|
||||
(log/error ::undo-redo-worker-action-unavailable
|
||||
{:undo? undo?
|
||||
:repo repo
|
||||
:tx-id tx-id
|
||||
:tx-meta tx-meta'
|
||||
:reason :missing-apply-history-action})
|
||||
(clear-history! repo)
|
||||
(empty-stack-result undo?))))
|
||||
|
||||
(defn- process-db-op
|
||||
[repo conn undo? op]
|
||||
(when-let [data (some #(when (= ::db-transact (first %))
|
||||
(second %))
|
||||
op)]
|
||||
(let [tx-id (:db-sync/tx-id data)
|
||||
tx-meta' (merge (undo-redo-action-meta data undo?)
|
||||
(select-keys data [:db-sync/forward-outliner-ops
|
||||
:db-sync/inverse-outliner-ops]))]
|
||||
(apply-history-action repo conn undo? op tx-meta' tx-id))))
|
||||
|
||||
(defn- undo-redo-aux
|
||||
[repo undo?]
|
||||
(if-let [op (not-empty ((if undo? pop-undo-op pop-redo-op) repo))]
|
||||
(if (= ::ui-state (ffirst op))
|
||||
(do
|
||||
(push-opposite-op! repo undo? op)
|
||||
{:undo? undo?
|
||||
:ui-state-str (second (first op))})
|
||||
(process-db-op repo (worker-state/get-datascript-conn repo) undo? op))
|
||||
(when ((if undo? empty-undo-stack? empty-redo-stack?) repo)
|
||||
(empty-stack-result undo?))))
|
||||
|
||||
(defn undo
|
||||
[repo]
|
||||
(undo-redo-aux repo true))
|
||||
|
||||
(defn redo
|
||||
[repo]
|
||||
(undo-redo-aux repo false))
|
||||
|
||||
(defn record-editor-info!
|
||||
[repo editor-info]
|
||||
(when editor-info
|
||||
(swap! *undo-ops
|
||||
update repo
|
||||
(fn [stack]
|
||||
(if (seq stack)
|
||||
(update stack (dec (count stack))
|
||||
(fn [op]
|
||||
(conj (vec op) [::record-editor-info editor-info])))
|
||||
stack)))))
|
||||
|
||||
(defn record-ui-state!
|
||||
[repo ui-state-str]
|
||||
(when ui-state-str
|
||||
(push-undo-op repo [[::ui-state ui-state-str]])))
|
||||
|
||||
(defn- pending-history-action-ops
|
||||
[repo tx-id]
|
||||
(when (uuid? tx-id)
|
||||
(client-op/history-action-ops-by-tx-id repo tx-id)))
|
||||
|
||||
(defn gen-undo-ops!
|
||||
[repo {:keys [tx-data tx-meta db-after db-before]} tx-id
|
||||
{:keys [apply-history-action!]}]
|
||||
(when (nil? @*apply-history-action!)
|
||||
(reset! *apply-history-action! apply-history-action!))
|
||||
(let [{:keys [outliner-op local-tx?]} tx-meta
|
||||
{:db-sync/keys [forward-outliner-ops inverse-outliner-ops]} (pending-history-action-ops repo tx-id)]
|
||||
(when (and
|
||||
(true? local-tx?)
|
||||
outliner-op
|
||||
(not (false? (:gen-undo-ops? tx-meta)))
|
||||
(not (:create-today-journal? tx-meta))
|
||||
(not (contains? #{:create-view} (:source-outliner-op tx-meta))))
|
||||
(let [all-ids (distinct (map :e tx-data))
|
||||
retracted-ids (set
|
||||
(filter
|
||||
(fn [id] (and (nil? (d/entity db-after id)) (d/entity db-before id)))
|
||||
all-ids))
|
||||
added-ids (set
|
||||
(filter
|
||||
(fn [id] (and (nil? (d/entity db-before id)) (d/entity db-after id)))
|
||||
all-ids))
|
||||
editor-info (or (:undo-redo/editor-info tx-meta)
|
||||
(take-pending-editor-info! repo))
|
||||
|
||||
data (cond-> {:db-sync/tx-id tx-id
|
||||
:tx-meta (dissoc tx-meta :outliner-ops)
|
||||
:added-ids added-ids
|
||||
:retracted-ids retracted-ids
|
||||
:db-sync/forward-outliner-ops forward-outliner-ops
|
||||
:db-sync/inverse-outliner-ops inverse-outliner-ops})
|
||||
op (->> [(when editor-info [::record-editor-info editor-info])
|
||||
[::db-transact data]]
|
||||
(remove nil?)
|
||||
vec)]
|
||||
;; A new local action invalidates redo history.
|
||||
(swap! *redo-ops assoc repo [])
|
||||
(push-undo-op repo op)))))
|
||||
|
||||
(defn get-debug-state
|
||||
[repo]
|
||||
{:undo-ops (get @*undo-ops repo [])
|
||||
:redo-ops (get @*redo-ops repo [])
|
||||
:pending-editor-info (get @*pending-editor-info repo)})
|
||||
|
||||
(defn referenced-history-tx-ids
|
||||
[repo]
|
||||
(->> (concat (get @*undo-ops repo [])
|
||||
(get @*redo-ops repo []))
|
||||
(mapcat identity)
|
||||
(keep (fn [item]
|
||||
(when (= ::db-transact (first item))
|
||||
(let [tx-id (:db-sync/tx-id (second item))]
|
||||
(when (uuid? tx-id)
|
||||
tx-id)))))
|
||||
set))
|
||||
Reference in New Issue
Block a user