From 565c2114be551ec3491e30a780a8485a97fee7d4 Mon Sep 17 00:00:00 2001 From: Dasemu Date: Wed, 26 Aug 2026 14:59:17 +0200 Subject: [PATCH] Fase 8 (1/N): delete the worker-side remote sync protocol Deletes frontend.worker.sync/* wholesale (apply_txs, asset_db_listener, assets, auth, client_op, const, crypt, download, handle_message, large_title, log_and_state, presence, temp_sqlite, transport, upload, util), worker/sync.cljs, worker/handler/sync.cljs, and worker/ui_request.cljs -- the remote CRDT sync protocol and its E2EE password-request plumbing, both made obsolete by the server-client daemon architecture built in Fases 1-7. Deviates from the plan's KEEP list on sync/presence.cljs and sync/transport.cljs: neither has any caller left once the rest of the cluster is gone (confirmed by grep), because Fase 4's WS resume-by-revision work already built its own self-contained module (db_worker_node_ws.cljs) instead of adopting these as the plan assumed it would. This touched far more than a mechanical deletion: - frontend.worker.sync.client-op wasn't sync-only. Its client_ops SQLite table is also the idempotency marker for db_core.cljs's built-in-property repair migration and the forward/inverse-outliner- ops relay undo/redo reads back through history-action-ops-by-tx-id. Trimmed (not deleted) into frontend.worker.local-tx-log, keeping only the tx-entry/local-tx functions those two callers need and dropping the genuinely sync-only surface (pending-upload counts, checksums, graph-uuid, sync-conflict tracking, asset-op queues). - frontend.worker.sync.apply-txs's apply-history-action! looked sync-specific (it lived next to the remote-tx-apply/rebase machinery) but turned out to be the *only* implementation ever registered for worker-undo-redo/*apply-history-action! -- undo_redo.cljs calls it on every db-transact undo/redo, local edits included, not just remote-origin ones. Deleting it outright would have silently broken undo/redo app-wide the next time anyone hit Cmd-Z. Ported the general-purpose slice (replaying a recorded entry's forward/inverse outliner ops against the current db state, plus the raw-tx-data fallback for edits that bypass the structured outliner-op layer) into a new frontend.worker.undo-redo.replay, along with persist-local-tx! (derive history ops on every local commit, stash them in local-tx-log, hand off to gen-undo-ops!) -- dropping only the remote-rebase-specific rest (CRDT conflict resolution, upload-queue bookkeeping). Wired into db_listener.cljs as a renamed :persist-local-tx handler (was :db-sync, a name that stopped meaning anything once sync was gone). Caught by running the full existing undo_redo_test.cljs suite (30 deftests written for the old mechanism) against the new module after fixing its test harness to use the real db_listener.cljs dispatch instead of a hand-rolled listener -- all 29 tests port over passing with no behavior change, which is the actual evidence this preserves undo/redo correctness rather than just compiling. - db_core.cljs's own 8 :thread-api/db-sync-* handlers (remote-graph- download import, close-db/invalidate-search-db/recreate-lock sync-specific variants) are deleted along with their sync-crypt/ sync-download calls; :thread-api/unsafe-unlink-db, :close-db, and :release-access-handles keep their real (non-sync) bodies. db_worker_node.cljs's non-repo-methods set drops from 22 to 7 entries (the 15 removed were all e2ee/db-sync/ui-request keywords backed by deleted files). - worker/handler/export.cljs's :thread-api/recompute-checksum-diagnostics (and worker/db/validate.cljs's backing recompute-checksum-diagnostics, which pulled in logseq-db-sync.checksum) compared a local checksum against a remote one that no longer exists -- deleted outright, not ported, since there's nothing left to diff against. - worker/handler/block.cljs's :block.temp/sync-conflicts metadata (backed by the deleted client-op/get-all-sync-conflicts) is gone; its client-side consumer (a retry-upload/clear-conflicts UI in components/block.cljs) is dead code now and still needs a follow-up pass -- flagging here since worker-side cleanup alone can't remove it without breaking that UI's thread-api calls at runtime. Verified: app/electron/db-worker-node/mobile all compile clean. Full worker test suite green (db_core_test 131, db_listener_test 11, db_worker_test 8, db_worker_node_test 59, db_worker_node_lock_test 10, local_tx_log_test 4, undo_redo_test 29, subs_test 50, subs_loader_test 2, config_test 6 -- 0 failures across all of them). The entire src/test/frontend/worker/sync/ test directory (7 files) and db_sync_test.cljs/db_sync_sim_test.cljs/node_sync_test.cljs (all testing only-deleted namespaces) are deleted wholesale rather than ported. Known follow-up, not yet done: the client-side (frontend.handler.*, frontend.components.*) RTC/E2EE/db-sync UI and its dead thread-api call sites (components/block.cljs, components/repo.cljs, components/settings.cljs, handler/user.cljs, handler/assets.cljs, db/restore.cljs, handler/common/developer.cljs, and the handler/db-based/{sync,rtc-flows,rtc-background-tasks}.cljs + handler/events/rtc.cljs + components/rtc/* + db/rtc/* files themselves) -- a separate commit. Co-Authored-By: Claude Sonnet 5 --- src/main/frontend/worker/db/validate.cljs | 11 - src/main/frontend/worker/db_core.cljs | 129 +- src/main/frontend/worker/db_listener.cljs | 15 +- src/main/frontend/worker/db_worker_node.cljs | 18 +- src/main/frontend/worker/handler/block.cljs | 17 +- src/main/frontend/worker/handler/export.cljs | 19 - src/main/frontend/worker/handler/sync.cljs | 104 - src/main/frontend/worker/local_tx_log.cljs | 347 + src/main/frontend/worker/sync.cljs | 465 - src/main/frontend/worker/sync/apply_txs.cljs | 1924 ---- .../worker/sync/asset_db_listener.cljs | 25 - src/main/frontend/worker/sync/assets.cljs | 507 -- src/main/frontend/worker/sync/auth.cljs | 109 - src/main/frontend/worker/sync/client_op.cljs | 670 -- src/main/frontend/worker/sync/const.cljs | 27 - src/main/frontend/worker/sync/crypt.cljs | 909 -- src/main/frontend/worker/sync/download.cljs | 576 -- .../frontend/worker/sync/handle_message.cljs | 391 - .../frontend/worker/sync/large_title.cljs | 267 - .../frontend/worker/sync/log_and_state.cljs | 41 - src/main/frontend/worker/sync/presence.cljs | 120 - .../frontend/worker/sync/temp_sqlite.cljs | 92 - src/main/frontend/worker/sync/transport.cljs | 112 - src/main/frontend/worker/sync/upload.cljs | 428 - src/main/frontend/worker/sync/util.cljs | 138 - src/main/frontend/worker/ui_request.cljs | 175 - src/main/frontend/worker/undo_redo.cljs | 4 +- .../frontend/worker/undo_redo/replay.cljs | 547 ++ src/test/frontend/worker/db_core_test.cljs | 255 +- .../frontend/worker/db_listener_test.cljs | 90 +- .../frontend/worker/db_sync_sim_test.cljs | 3051 ------- src/test/frontend/worker/db_sync_test.cljs | 7843 ----------------- .../frontend/worker/db_worker_node_test.cljs | 68 - src/test/frontend/worker/db_worker_test.cljs | 535 +- ...nt_op_test.cljs => local_tx_log_test.cljs} | 70 +- src/test/frontend/worker/node_sync_test.cljs | 69 - .../frontend/worker/sync/assets_test.cljs | 336 - src/test/frontend/worker/sync/crypt_test.cljs | 1355 --- .../frontend/worker/sync/download_test.cljs | 111 - .../frontend/worker/sync/restart_test.cljs | 186 - .../frontend/worker/sync/upload_test.cljs | 269 - src/test/frontend/worker/sync/util_test.cljs | 24 - src/test/frontend/worker/undo_redo_test.cljs | 22 +- 43 files changed, 1011 insertions(+), 21460 deletions(-) delete mode 100644 src/main/frontend/worker/handler/sync.cljs create mode 100644 src/main/frontend/worker/local_tx_log.cljs delete mode 100644 src/main/frontend/worker/sync.cljs delete mode 100644 src/main/frontend/worker/sync/apply_txs.cljs delete mode 100644 src/main/frontend/worker/sync/asset_db_listener.cljs delete mode 100644 src/main/frontend/worker/sync/assets.cljs delete mode 100644 src/main/frontend/worker/sync/auth.cljs delete mode 100644 src/main/frontend/worker/sync/client_op.cljs delete mode 100644 src/main/frontend/worker/sync/const.cljs delete mode 100644 src/main/frontend/worker/sync/crypt.cljs delete mode 100644 src/main/frontend/worker/sync/download.cljs delete mode 100644 src/main/frontend/worker/sync/handle_message.cljs delete mode 100644 src/main/frontend/worker/sync/large_title.cljs delete mode 100644 src/main/frontend/worker/sync/log_and_state.cljs delete mode 100644 src/main/frontend/worker/sync/presence.cljs delete mode 100644 src/main/frontend/worker/sync/temp_sqlite.cljs delete mode 100644 src/main/frontend/worker/sync/transport.cljs delete mode 100644 src/main/frontend/worker/sync/upload.cljs delete mode 100644 src/main/frontend/worker/sync/util.cljs delete mode 100644 src/main/frontend/worker/ui_request.cljs create mode 100644 src/main/frontend/worker/undo_redo/replay.cljs delete mode 100644 src/test/frontend/worker/db_sync_sim_test.cljs delete mode 100644 src/test/frontend/worker/db_sync_test.cljs rename src/test/frontend/worker/{sync/client_op_test.cljs => local_tx_log_test.cljs} (62%) delete mode 100644 src/test/frontend/worker/node_sync_test.cljs delete mode 100644 src/test/frontend/worker/sync/assets_test.cljs delete mode 100644 src/test/frontend/worker/sync/crypt_test.cljs delete mode 100644 src/test/frontend/worker/sync/download_test.cljs delete mode 100644 src/test/frontend/worker/sync/restart_test.cljs delete mode 100644 src/test/frontend/worker/sync/upload_test.cljs delete mode 100644 src/test/frontend/worker/sync/util_test.cljs diff --git a/src/main/frontend/worker/db/validate.cljs b/src/main/frontend/worker/db/validate.cljs index 7a83fd3..5ff38e1 100644 --- a/src/main/frontend/worker/db/validate.cljs +++ b/src/main/frontend/worker/db/validate.cljs @@ -6,7 +6,6 @@ [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])) @@ -326,13 +325,3 @@ (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})) diff --git a/src/main/frontend/worker/db_core.cljs b/src/main/frontend/worker/db_core.cljs index 5876ec4..c37bfa8 100644 --- a/src/main/frontend/worker/db_core.cljs +++ b/src/main/frontend/worker/db_core.cljs @@ -24,7 +24,6 @@ [frontend.worker.handler.query] [frontend.worker.handler.render-resource.engine] [frontend.worker.handler.search :as search-handler] - [frontend.worker.handler.sync] [frontend.worker.handler.transaction :as transaction-handler] [frontend.worker.handler.undo-redo] [frontend.worker.handler.view] @@ -34,10 +33,7 @@ [frontend.worker.search :as search] [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] + [frontend.worker.local-tx-log :as local-tx-log] [frontend.worker.thread-atom] [frontend.worker.undo-redo :as worker-undo-redo] [goog.functions :as gfun] @@ -364,7 +360,6 @@ (checkpoint-db! repo db) (checkpoint-db! repo search) (checkpoint-db! repo client-ops) - (sync-download/close-import-state-for-repo! repo) (when-let [timer (get @*client-ops-cleanup-timers repo)] (js/clearInterval timer)) (swap! *client-ops-cleanup-timers dissoc repo) @@ -375,7 +370,7 @@ (swap! *vector-indexes dissoc repo) (swap! *datascript-conns dissoc repo) (swap! *client-ops-conns dissoc repo) - (swap! client-op/*repo->pending-local-tx-count dissoc repo) + (swap! local-tx-log/*repo->pending-local-tx-count dissoc repo) (search-handler/clear-search-index-builds! repo) (when db (.close db)) (when search (.close search)) @@ -396,27 +391,6 @@ (let [{:keys [db search client-ops]} (get @*sqlite-conns repo)] (close-db-aux! repo db search client-ops))) -(defn- datoms debug-transit-raw)))] (when creating-remote-graph? (when (and (worker-state/get-sqlite-conn repo :client-ops) - (nil? (client-op/get-local-tx repo))) - (client-op/update-local-tx repo 0))) + (nil? (local-tx-log/get-local-tx repo))) + (local-tx-log/update-local-tx repo 0))) (when-not (worker-state/get-sqlite-conn repo) (p/let [[db search-db client-ops-db vector-index] (get-dbs repo) dbs (cond-> [db search-db] @@ -656,30 +625,26 @@ (swap! *datascript-conns assoc repo conn) (swap! *client-ops-conns assoc repo client-ops-conn) (when-not @*publishing? - (client-op/ensure-sqlite-schema! client-ops-db)) + (local-tx-log/ensure-sqlite-schema! client-ops-db)) (when creating-remote-graph? - (when (nil? (client-op/get-local-tx repo)) - (client-op/update-local-tx repo 0))) + (when (nil? (local-tx-log/get-local-tx repo)) + (local-tx-log/update-local-tx repo 0))) (ensure-client-ops-cleanup-timer! repo) - (let [initial-tx-report (when-not (or initial-data-exists? - (seq datoms) - sync-download-graph?) - (let [config (resolve-initial-config config) - initial-data (sqlite-create-graph/build-db-initial-data - config (select-keys opts [:import-type :graph-git-sha :creating-remote-graph?]))] - (bootstrap-transact! conn initial-data)))] + (do + (when-not (or initial-data-exists? + (seq datoms) + sync-download-graph?) + (let [config (resolve-initial-config config) + initial-data (sqlite-create-graph/build-db-initial-data + config (select-keys opts [:import-type :graph-git-sha :creating-remote-graph?]))] + (bootstrap-transact! conn initial-data))) (when-not sync-download-graph? (let [migrate-result (db-migrate/migrate conn)] - (if migrate-result - (handle-migrate-result-local-txs! repo migrate-result) - (maybe-enqueue-built-in-sync-repair! repo conn migrate-result initial-data-exists?))) + (maybe-enqueue-built-in-sync-repair! repo conn migrate-result initial-data-exists?)) (transaction-handler/maybe-run-recycle-gc! conn)) (ensure-canonical-revisions! conn) - (when initial-tx-report - (db-sync/handle-local-tx! repo initial-tx-report)) - (db-listener/listen-db-changes! repo conn) nil)))))) @@ -713,19 +678,7 @@ [] (init-sqlite-module!)) -(defn- db-sync-dbs-open? - [repo] - (and (some? (worker-state/get-datascript-conn repo)) - (some? (worker-state/get-client-ops-conn repo)))) - (declare start-db!) -(def-thread-api :thread-api/db-sync-start - [repo] - (if (db-sync-dbs-open? repo) - (db-sync/start! repo) - (p/do! - (start-db! repo {:close-other-db? false}) - (db-sync/start! repo)))) ;; [graph service] (defonce *service (atom [])) @@ -772,54 +725,17 @@ (def-thread-api :thread-api/unsafe-unlink-db [repo] (p/let [pool (string [:sync-db-changes - :sync-conflicts-updated :notification :log - :add-repo - :rtc-log - :rtc-sync-state]))) + :add-repo]))) (defn- (assoc block @@ -448,23 +447,21 @@ :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))) + (contains? commented-block-uuids (str 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?] + [result db 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 + (update :block #(assoc-block-metadata db 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 + (mapv #(assoc-block-metadata db commented-block-uuids now-ms render-data? %) children))))) @@ -485,14 +482,12 @@ (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 + db commented-block-uuids now-ms (true? (get-in request [:opts :render-data?])) (true? (get-in request [:opts :root-render-data?]))))) requests diff --git a/src/main/frontend/worker/handler/export.cljs b/src/main/frontend/worker/handler/export.cljs index c337c6a..c27b0fa 100644 --- a/src/main/frontend/worker/handler/export.cljs +++ b/src/main/frontend/worker/handler/export.cljs @@ -5,8 +5,6 @@ [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])) @@ -41,23 +39,6 @@ (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 diff --git a/src/main/frontend/worker/handler/sync.cljs b/src/main/frontend/worker/handler/sync.cljs deleted file mode 100644 index ed01527..0000000 --- a/src/main/frontend/worker/handler/sync.cljs +++ /dev/null @@ -1,104 +0,0 @@ -(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/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)") + +(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- 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 pending-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 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- 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 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 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 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)) diff --git a/src/main/frontend/worker/sync.cljs b/src/main/frontend/worker/sync.cljs deleted file mode 100644 index 576bbc9..0000000 --- a/src/main/frontend/worker/sync.cljs +++ /dev/null @@ -1,465 +0,0 @@ -(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 (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 ( (: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- 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 ( - (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 (latest-remote-tx (atom {})) -(defonce *repo->latest-remote-checksum (atom {})) -;; Debug-only gate to reproduce one-way sync: -;; still pull/rebase remote txs, but skip local tx batch uploads. -(defonce *repo->upload-stopped? (atom {})) - -(def ^:private max-remote-apply-snapshot-retries 3) -(def ^:private remote-apply-snapshot-retry-delay-ms 50) -(def ^:private upload-response-timeout-ms (* 2 60 1000)) -(def ^:private max-upload-request-datoms 5000) -(defonce ^:private *repo->large-upload-progress (atom {})) - -(defn set-upload-stopped! - [repo stopped?] - (swap! *repo->upload-stopped? assoc repo (boolean stopped?)) - (boolean stopped?)) - -(defn upload-stopped? - [repo] - (true? (get @*repo->upload-stopped? repo))) - -(declare enqueue-asset-task! - apply-remote-txs! - cap-upload-request-tx-entries - commit-large-upload-progress! - ref-attr? - resolve-temp-id - tx-temp-id->uuid - reverse-local-txs! - rebase-local-txs! - repair-applied-txs! - handle-local-tx!) - -(defn- current-client [repo] - (sync-presence/current-client worker-state/*db-sync-client repo)) - -(defn- client-ops-conn [repo] - (sync-presence/client-ops-conn worker-state/get-client-ops-conn repo)) - -(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 @*repo->latest-remote-tx - :latest-remote-checksum @*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)))) - -(def reverse-data-ignored-attrs - #{:block/tx-id}) - -(def rtc-ignored-attrs - (set/union - reverse-data-ignored-attrs - rtc-const/ignore-attrs-when-syncing - rtc-const/ignore-entities-when-init-upload - #{:block/pre-block?})) - -(defn- remove-ignored-attrs [tx-data] - (remove (fn [d] (contains? rtc-ignored-attrs (:a d))) tx-data)) - -(defn- normalize-tx-data [db-after db-before tx-data] - (->> tx-data - remove-ignored-attrs - (db-normalize/normalize-tx-data db-after db-before) - (remove (fn [[_op e]] - (contains? rtc-const/ignore-entities-when-init-upload e))))) - -(declare replay-canonical-outliner-op! - invalid-rebase-op!) - -(defn reverse-tx-data [db-before db-after tx-data] - (->> tx-data - reverse - (keep (fn [[e a v t added]] - (let [reversed-datom (d/datom e a v t (not added))] - ;; trick: reverse the order of `db-before` and `db-after` - (db-normalize/normalize-datom db-before db-after reversed-datom)))) - (db-normalize/replace-attr-retract-with-retract-entity-v2 db-after) - db-normalize/reorder-retract-entity)) - -(defn normalize-rebased-pending-tx - [{:keys [db-before db-after tx-data]}] - {:normalized-tx-data (normalize-tx-data db-after db-before tx-data) - :reversed-datoms (reverse-tx-data db-before db-after tx-data)}) - -(defn- auth-headers [] - (sync-auth/auth-headers (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- ws-ready-state - [ws] - (when ws - (.-readyState ws))) - -(defn- outliner-op->string - [op] - (cond - (keyword? op) (name op) - (some? op) (str op) - :else nil)) - -(defn- report-upload-response-timeout! - [client request] - (let [repo (:repo client) - ws (:ws client) - online? (worker-state/online?) - ws-open-state? (ws-open? ws)] - (when (and online? ws-open-state?) - (let [elapsed-ms (- (common-util/time-ms) (:sent-at request)) - outliner-ops (mapv outliner-op->string (:outliner-ops request)) - outliner-op-tag (when (seq outliner-ops) - (string/join "," outliner-ops)) - data (cond-> {:source "db-sync" - :operation "upload-tx-batch" - :repo repo - :graph-id (:graph-id client) - :timeout-ms upload-response-timeout-ms - :elapsed-ms elapsed-ms - :tx-count (count (:tx-ids request)) - :t-before (:t-before request) - :latest-remote-tx (get @*repo->latest-remote-tx repo) - :current-local-tx (client-op/get-local-tx repo) - :online? online? - :ws-open? ws-open-state? - :ws-ready-state (ws-ready-state ws)} - outliner-op-tag - (assoc :outliner-op outliner-op-tag))] - (log/error :db-sync/upload-response-timeout - (assoc data :tx-ids (:tx-ids request))) - (try - (platform/post-message! - (platform/current) - :capture-error - {:error (ex-info "Sync upload request did not get response" data) - :payload data - :extra (cond-> {:tx-ids (mapv str (:tx-ids request))} - (seq outliner-ops) - (assoc :outliner-ops outliner-ops))}) - (catch :default report-error - (log/error :db-sync/report-upload-response-timeout-failed - {:repo repo - :error report-error}))))))) - -(defn clear-upload-response-timeout! - [client] - (when-let [*upload-request (:upload-request client)] - (let [request @*upload-request] - (when-let [timer (:timer request)] - (js/clearTimeout timer)) - (reset! *upload-request nil) - (some-> request (dissoc :timer))))) - -(defn- start-upload-response-timeout! - [client request] - (when-let [*upload-request (:upload-request client)] - (when-not (:timer @*upload-request) - (let [request' (assoc request :sent-at (common-util/time-ms)) - timer (js/setTimeout - (fn [] - (when (= request' (dissoc @*upload-request :timer)) - (reset! *upload-request nil) - (report-upload-response-timeout! client request'))) - upload-response-timeout-ms)] - (reset! *upload-request (assoc request' :timer timer)))))) - -(defn ack-upload-response! - [repo client] - (when-let [request (clear-upload-response-timeout! client)] - (commit-large-upload-progress! repo (:large-upload-progress request)))) - -(defn upload-large-title! [repo graph-id title aes-key] - (sync-large-title/upload-large-title! - {:repo repo - :graph-id graph-id - :title title - :aes-key aes-key - :http-base (sync-auth/http-base-url @worker-state/*db-sync-config) - :auth-headers (auth-headers) - :fail-fast-f fail-fast - :encrypt-text-value-f sync-crypt/> tx-data - (mapv (fn [item] - (if (and (vector? item) (= 5 (count item))) - (let [[op e a v _t] item] - [op e a v]) - item))) - db-normalize/reorder-retract-entity)) - -(defn- inferred-outliner-ops? - [tx-meta] - (and (nil? (:outliner-ops tx-meta)) - (not (:undo? tx-meta)) - (not (:redo? tx-meta)) - (not= :batch-import-edn (:outliner-op tx-meta)))) - -(defn- tx-meta-outliner-op - [tx-meta] - (or (:outliner-op tx-meta) - (when (:db-migrate? tx-meta) - :db-migrate))) - -(defn- apply-tx-meta - [remote-tx] - (let [outliner-op (:outliner-op remote-tx)] - (cond-> {:transact-remote? true - :persist-op? false - :t (:t remote-tx)} - outliner-op - (assoc :outliner-op outliner-op) - (= outliner-op :db-migrate) - (assoc :db-migrate? true - :skip-validate-db? true)))) - -(declare apply-history-action!) - -(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 (and goog.DEBUG (:perf-id data)) - (log/info :db-worker/outliner-op-perf data))) - -(defn- persist-local-tx! - [repo {:keys [db-before db-after tx-data tx-meta] :as tx-report} normalized-tx-data reversed-datoms] - (when (client-ops-conn repo) - (let [started-at (perf-time-ms) - tx-id (or (:db-sync/tx-id tx-meta) (random-uuid)) - now (.now js/Date) - outliner-op (tx-meta-outliner-op tx-meta) - {:keys [forward-outliner-ops inverse-outliner-ops]} - (derive-history-outliner-ops db-before db-after tx-data tx-meta) - history-at (perf-time-ms) - inferred-outliner-ops?' (inferred-outliner-ops? tx-meta) - {:keys [should-inc-pending?]} - (client-op/upsert-local-tx-entry! - repo - {:tx-id tx-id - :created-at now - :pending? true - :failed? false - :outliner-op outliner-op - :undo-redo (cond - (:undo? tx-meta) :undo - (:redo? tx-meta) :redo - :else :none) - :forward-outliner-ops forward-outliner-ops - :inverse-outliner-ops inverse-outliner-ops - :inferred-outliner-ops? inferred-outliner-ops?' - :normalized-tx-data normalized-tx-data - :reversed-tx-data reversed-datoms}) - upsert-at (perf-time-ms)] - ;; (prn :debug :forward-outliner-ops) - ;; (cljs.pprint/pprint forward-outliner-ops) - ;; (prn :debug :inverse-outliner-ops) - ;; (cljs.pprint/pprint inverse-outliner-ops) - (worker-undo-redo/gen-undo-ops! repo tx-report tx-id - {:apply-history-action! apply-history-action!}) - (let [undo-at (perf-time-ms)] - (when should-inc-pending? - (client-op/adjust-pending-local-tx-count! repo 1) - (when-let [client (current-client repo)] - (broadcast-rtc-state! client))) - (log-outliner-op-perf! - {:stage :persist-local-tx - :perf-id (:ui/perf-id tx-meta) - :outliner-op outliner-op - :tx-count (count tx-data) - :normalized-tx-count (count normalized-tx-data) - :history-ms (- history-at started-at) - :upsert-ms (- upsert-at history-at) - :undo-ms (- undo-at upsert-at) - :pending-ms (- (perf-time-ms) undo-at) - :total-ms (- (perf-time-ms) started-at)}) - tx-id)))) - -(defn- tx-item-block-uuid - [db v] - (cond - (uuid? v) - v - - (and (vector? v) (= :block/uuid (first v)) (uuid? (second v))) - (second v) - - (number? v) - (some-> (d/entity db v) :block/uuid) - - :else - nil)) - -(defn- tx-item-entity - [item] - (if (vector? item) - (second item) - (:e item))) - -(defn- tx-item-attr - [item] - (if (vector? item) - (nth item 2 nil) - (:a item))) - -(defn- tx-item-add? - [item] - (if (vector? item) - (= :db/add (first item)) - (true? (:added item)))) - -(defn- tx-item-retract? - [item] - (if (vector? item) - (= :db/retract (first item)) - (false? (:added item)))) - -(defn- block-uuid-lookup-ref-value - [v] - (when (and (vector? v) - (= :block/uuid (first v)) - (uuid? (second v))) - (second v))) - -(defn- tx-item-ref-block-uuids - [item] - (when (vector? item) - (keep block-uuid-lookup-ref-value - [(second item) (nth item 3 nil)]))) - -(defn- tx-data-has-block-uuid-ref? - [tx-data] - (boolean - (some (fn [item] - (seq (tx-item-ref-block-uuids item))) - tx-data))) - -(defn- tx-item-retract-entity-block-uuid - [item] - (when (and (vector? item) - (contains? #{:db/retractEntity :db.fn/retractEntity} (first item))) - (block-uuid-lookup-ref-value (second item)))) - -(defn- remote-txs-retract-entity-block-uuid-suffixes - [remote-txs] - (-> (reduce (fn [{:keys [deleted-block-uuids suffixes]} remote-tx] - (let [deleted-block-uuids' (into deleted-block-uuids - (keep tx-item-retract-entity-block-uuid) - (:tx-data remote-tx))] - {:deleted-block-uuids deleted-block-uuids' - :suffixes (conj suffixes deleted-block-uuids')})) - {:deleted-block-uuids #{} - :suffixes '()} - (reverse remote-txs)) - :suffixes - vec)) - -(defn- tx-item-missing-deleted-block-ref? - [db deleted-block-uuids item] - (some (fn [block-uuid] - (and (contains? deleted-block-uuids block-uuid) - (nil? (d/entity db [:block/uuid block-uuid])))) - (tx-item-ref-block-uuids item))) - -(defn- tx-item-missing-block-ref? - [db created-block-uuids item] - (some (fn [block-uuid] - (and (not (contains? created-block-uuids block-uuid)) - (nil? (d/entity db [:block/uuid block-uuid])))) - (tx-item-ref-block-uuids item))) - -(defn- tx-item-entity-block-uuid - ([db item] - (tx-item-entity-block-uuid db {} item)) - ([db temp-id->uuid item] - (when (vector? item) - (or (get temp-id->uuid (second item)) - (tx-item-block-uuid db (second item)))))) - -(defn- drop-stale-deleted-block-ref-ops - [db deleted-block-uuids tx-data] - (let [temp-id->uuid (tx-temp-id->uuid tx-data) - stale-entity-block-uuids (->> tx-data - (keep (fn [item] - (when (tx-item-missing-deleted-block-ref? - db deleted-block-uuids item) - (tx-item-entity-block-uuid db temp-id->uuid item)))) - set)] - (remove (fn [item] - (contains? stale-entity-block-uuids - (tx-item-entity-block-uuid db temp-id->uuid item))) - tx-data))) - -(defn- drop-missing-block-ref-ops - [db tx-data] - (let [temp-id->uuid (tx-temp-id->uuid tx-data) - created-block-uuids (set (vals temp-id->uuid)) - stale-entity-block-uuids (->> tx-data - (keep (fn [item] - (when (tx-item-missing-block-ref? - db created-block-uuids item) - (tx-item-entity-block-uuid db temp-id->uuid item)))) - set)] - (remove (fn [item] - (or (tx-item-missing-block-ref? db created-block-uuids item) - (contains? stale-entity-block-uuids - (tx-item-entity-block-uuid db temp-id->uuid item)))) - tx-data))) - -(defn- drop-local-reversal-stale-target-ops - [db-before-local-reversal db tx-data] - (let [recreated-eids (->> tx-data - (filter #(and (tx-item-add? %) - (= :block/uuid (tx-item-attr %)))) - (map tx-item-entity) - set)] - (remove (fn [item] - (let [eid (tx-item-entity item)] - (and (number? eid) - (not (contains? recreated-eids eid)) - (:block/uuid (d/entity db-before-local-reversal eid)) - (nil? (:block/uuid (d/entity db eid)))))) - tx-data))) - -(defn- drop-stale-adds-after-remote-entity-delete - [tx-data] - (let [deleted-eids (->> tx-data - (filter #(and (tx-item-retract? %) - (= :block/uuid (tx-item-attr %)))) - (map tx-item-entity) - set) - recreated-eids (->> tx-data - (filter #(and (tx-item-add? %) - (= :block/uuid (tx-item-attr %)))) - (map tx-item-entity) - set) - stale-eids (set/difference deleted-eids recreated-eids)] - (remove (fn [item] - (and (tx-item-add? item) - (contains? stale-eids (tx-item-entity item)))) - tx-data))) - -(defn- remote-txs-db-migrate? - [remote-txs] - (some #(= :db-migrate (:outliner-op %)) remote-txs)) - -(defn- upload-tempid? - [value] - (or (and (integer? value) (neg? value)) - (string? value))) - -(defn- upload-tx-item-tempids - [db item] - (cond - (and (map? item) (upload-tempid? (:db/id item))) - #{(:db/id item)} - - (and (vector? item) - (contains? #{:db/add :db/retract :db/cas :db.fn/cas} (first item)) - (<= 4 (count item))) - (let [[_op entity attr value] item] - (cond-> #{} - (upload-tempid? entity) - (conj entity) - (and db - (ref-attr? db attr) - (upload-tempid? value)) - (conj value))) - - (and (vector? item) - (contains? #{:db/retractEntity :db.fn/retractEntity} (first item)) - (= 2 (count item)) - (upload-tempid? (second item))) - #{(second item)} - - :else - #{})) - -(defn- merge-upload-tx-ranges - [ranges] - (loop [remaining (sort-by first ranges) - merged []] - (if-let [[start end] (first remaining)] - (if-let [[prev-start prev-end] (peek merged)] - (if (<= start prev-end) - (recur (next remaining) - (conj (pop merged) [prev-start (max prev-end end)])) - (recur (next remaining) - (conj merged [start end]))) - (recur (next remaining) [[start end]])) - merged))) - -(defn- upload-tempid-range-by-start - [db tx-data] - (let [ranges-by-tempid - (reduce-kv - (fn [acc idx item] - (reduce (fn [acc* tempid] - (update acc* tempid - (fn [[start end]] - [(if (some? start) (min start idx) idx) - (if (some? end) (max end idx) idx)]))) - acc - (upload-tx-item-tempids db item))) - {} - tx-data)] - (into {} (map (fn [[start end]] [start end]) - (merge-upload-tx-ranges (vals ranges-by-tempid)))))) - -(defn- next-upload-tx-group - [tx-data range-by-start idx] - (if-let [end (get range-by-start idx)] - [(inc end) (subvec tx-data idx (inc end))] - [(inc idx) [(nth tx-data idx)]])) - -(defn- next-large-upload-request-chunk - [db tx-data start] - (let [range-by-start (upload-tempid-range-by-start db tx-data) - total (count tx-data)] - (loop [idx start - chunk []] - (if (< idx total) - (let [[next-idx group] (next-upload-tx-group tx-data range-by-start idx) - next-count (+ (count chunk) (count group))] - (if (and (seq chunk) - (> next-count max-upload-request-datoms)) - {:chunk chunk - :next-index idx} - (recur next-idx (into chunk group)))) - {:chunk chunk - :next-index total})))) - -(defn prepare-upload-tx-entries - ([conn pending] - (prepare-upload-tx-entries nil conn pending)) - ([repo conn pending] - (let [entries (mapv (fn [{:keys [tx-id tx outliner-op]}] - {:tx-id tx-id - :outliner-op outliner-op - :tx-data (vec tx)}) - pending) - empty-tx-ids (->> entries - (filter (comp empty? :tx-data)) - (mapv :tx-id)) - drop-txs (->> entries - (filter (comp empty? :tx-data)) - (mapv (fn [{:keys [tx-id outliner-op]}] - {:tx-id tx-id - :outliner-op outliner-op - :reason :empty-tx-data}))) - tx-entries (filterv (comp seq :tx-data) entries)] - {:tx-entries (if repo - (cap-upload-request-tx-entries repo (some-> conn deref) tx-entries) - tx-entries) - :drop-tx-ids empty-tx-ids - :drop-txs drop-txs}))) - -(defn- large-upload-progress-key - [repo tx-id] - [repo tx-id]) - -(defn- clear-large-upload-progress! - [repo tx-ids] - (let [progress-keys (->> tx-ids - (filter some?) - (map #(large-upload-progress-key repo %)) - seq)] - (when progress-keys - (swap! *repo->large-upload-progress - (fn [progress] - (apply dissoc progress progress-keys)))))) - -(defn- large-upload-request-entry - [repo db {:keys [tx-id tx-data] :as entry}] - (let [total (count tx-data) - progress-key (large-upload-progress-key repo tx-id) - progress-start (get @*repo->large-upload-progress progress-key 0) - start (if (< progress-start total) progress-start 0) - {:keys [chunk next-index]} (next-large-upload-request-chunk db tx-data start) - final? (>= next-index total)] - (log/info :db-sync/large-upload-request-chunk - {:repo repo - :tx-id tx-id - :start start - :end next-index - :total total - :final? final?}) - (cond-> (assoc entry - :tx-data chunk - :large-upload-original-tx-id tx-id - :large-upload-next-index next-index - :large-upload-final? final?) - (not final?) (dissoc :tx-id)))) - -(defn- cap-upload-request-tx-entries - [repo db tx-entries] - (loop [remaining tx-entries - result [] - datom-count 0] - (if-let [{:keys [tx-data] :as entry} (first remaining)] - (let [entry-datom-count (count tx-data) - next-datom-count (+ datom-count entry-datom-count)] - (cond - (and (empty? result) (> entry-datom-count max-upload-request-datoms)) - [(large-upload-request-entry repo db entry)] - - (> next-datom-count max-upload-request-datoms) - result - - :else - (recur (next remaining) - (conj result entry) - next-datom-count))) - result))) - -(defn- commit-large-upload-progress! - [repo tx-entries] - (doseq [{:keys [large-upload-original-tx-id - large-upload-next-index - large-upload-final?]} tx-entries] - (when large-upload-original-tx-id - (let [progress-key (large-upload-progress-key repo large-upload-original-tx-id)] - (if large-upload-final? - (swap! *repo->large-upload-progress dissoc progress-key) - (swap! *repo->large-upload-progress assoc progress-key large-upload-next-index)))))) - -(defn- large-upload-progress - [tx-entries] - (->> tx-entries - (keep (fn [{:keys [large-upload-original-tx-id - large-upload-next-index - large-upload-final?]}] - (when large-upload-original-tx-id - {:large-upload-original-tx-id large-upload-original-tx-id - :large-upload-next-index large-upload-next-index - :large-upload-final? large-upload-final?}))) - vec)) - -(defn pending-txs - [repo & {:keys [limit]}] - (client-op/get-pending-local-txs repo :limit limit)) - -(defn- pending-tx-by-id - [repo tx-id] - (client-op/get-local-tx-entry repo tx-id)) - -(defn mark-pending-txs-false! - [repo tx-ids] - (when (seq tx-ids) - (clear-large-upload-progress! repo tx-ids) - (when-let [pending-to-remove (client-op/mark-pending-txs-false! repo tx-ids)] - (when (pos? pending-to-remove) - (client-op/adjust-pending-local-tx-count! repo (- pending-to-remove))) - (when-let [client (current-client repo)] - (broadcast-rtc-state! client))))) - -(defn mark-failed-txs! - [repo tx-ids] - (when (seq tx-ids) - (clear-large-upload-progress! repo tx-ids) - (when-let [pending-to-remove (client-op/mark-failed-txs! repo tx-ids)] - (when (pos? pending-to-remove) - (client-op/adjust-pending-local-tx-count! repo (- pending-to-remove))) - (when-let [client (current-client repo)] - (broadcast-rtc-state! client))))) - -(defn- local-tx-has-replay-data? - [local-tx] - (or (seq (:tx local-tx)) - (seq (:reversed-tx local-tx)) - (seq (:forward-outliner-ops local-tx)) - (seq (:inverse-outliner-ops local-tx)))) - -(defn rollback-and-mark-failed-txs! - [repo tx-ids] - (let [rejected-tx-ids (->> tx-ids (filter uuid?) set)] - (when (seq rejected-tx-ids) - (when-let [conn (worker-state/get-datascript-conn repo)] - (let [pending (pending-txs repo) - rejected-and-after (->> pending - (drop-while #(not (contains? rejected-tx-ids (:tx-id %)))) - vec)] - (when (seq rejected-and-after) - (let [rebase-db-before @conn - rebase-txs (->> rejected-and-after - (remove #(contains? rejected-tx-ids (:tx-id %))) - vec) - *rebase-tx-reports (atom []) - *rebase-results (atom [])] - (try - (let [tx-report (ldb/batch-transact-with-temp-conn! - conn - {:rtc-tx? true - :tx-reject-rollback? true} - (fn [conn] - (reverse-local-txs! conn rejected-and-after) - (reset! *rebase-results - (rebase-local-txs! repo conn rebase-txs rebase-db-before))) - {:listen-db - (fn [{:keys [tx-meta tx-data] :as tx-report}] - (when (and (= :rebase (:outliner-op tx-meta)) - (:db-sync/rebased-local? tx-meta) - (seq tx-data)) - (swap! *rebase-tx-reports conj tx-report)))})] - (doseq [tx-report @*rebase-tx-reports] - (handle-local-tx! repo tx-report)) - (repair-applied-txs! conn tx-report) - (let [replay-tx-ids (->> rebase-txs - (filter local-tx-has-replay-data?) - (map :tx-id) - set) - stale-tx-ids (->> @*rebase-results - (filter (fn [{:keys [status]}] - (contains? #{:failed :no-op} status))) - (keep :tx-id) - (filter replay-tx-ids) - distinct - vec)] - (mark-pending-txs-false! repo stale-tx-ids))) - (finally - (reset! *rebase-tx-reports nil) - (reset! *rebase-results nil) - (worker-undo-redo/clear-history! repo))))))) - (mark-failed-txs! repo tx-ids)))) - -(defn clear-pending-txs! - [repo] - (mark-pending-txs-false! repo (mapv :tx-id (pending-txs repo)))) - -(declare expected-stale-rebase-error? - history-action-error-reason) - -(defn- expected-history-action-error-reason? - [reason] - (contains? #{:invalid-history-action-ops - :invalid-history-action-tx} - reason)) - -(defn- inline-history-action - [tx-meta] - (let [forward-outliner-ops (or (:db-sync/forward-outliner-ops tx-meta) - (:forward-outliner-ops tx-meta)) - inverse-outliner-ops (or (:db-sync/inverse-outliner-ops tx-meta) - (:inverse-outliner-ops tx-meta))] - (when (and (seq forward-outliner-ops) (seq inverse-outliner-ops)) - {:outliner-op (:outliner-op tx-meta) - :forward-outliner-ops forward-outliner-ops - :inverse-outliner-ops inverse-outliner-ops}))) - -(defn ^:large-vars/cleanup-todo apply-history-action! - [repo tx-id undo? tx-meta] - (if-let [conn (worker-state/get-datascript-conn repo)] - (if-let [action (or (pending-tx-by-id repo tx-id) - (inline-history-action tx-meta))] - (if (= :fix (:outliner-op action)) - {:applied? false - :reason :unsupported-history-action - :action action} - (let [{:keys [tx reversed-tx forward-outliner-ops inverse-outliner-ops]} action - ops (->> (if undo? inverse-outliner-ops forward-outliner-ops) - (filter (fn [op-entry] - (and (sequential? op-entry) - (contains? op-construct/semantic-outliner-ops - (first op-entry))))) - seq) - tx-data (-> (if undo? reversed-tx tx) - normalize-tx-data-for-rebase) - ops' (if (seq ops) - ops - [[:transact [tx-data nil]]]) - history-tx-id (let [provided-history-tx-id (:db-sync/tx-id tx-meta)] - (if (and (uuid? provided-history-tx-id) - (not= provided-history-tx-id tx-id)) - provided-history-tx-id - (random-uuid))) - tx-meta' (cond-> {:outliner-op (:outliner-op action) - :local-tx? true - :gen-undo-ops? false - :persist-op? true - :undo? undo? - :redo? (:redo? tx-meta) - :db-sync/tx-id history-tx-id - :db-sync/source-tx-id (or (:db-sync/source-tx-id tx-meta) - tx-id) - :db-sync/forward-outliner-ops (if undo? - (:inverse-outliner-ops action) - (:forward-outliner-ops action)) - :db-sync/inverse-outliner-ops (if undo? - (:forward-outliner-ops action) - (:inverse-outliner-ops action))})] - ;; (prn :debug :undo? undo? :ops) - ;; (cljs.pprint/pprint ops') - ;; (cljs.pprint/pprint (select-keys action [:tx-id :outliner-op :forward-outliner-ops :inverse-outliner-ops])) - ;; (prn :debug :tx-meta) - ;; (cljs.pprint/pprint tx-meta) - (if (seq ops') - (try - (when (seq ops) - (op-construct/assert-no-numeric-entity-ids! @conn ops :history-action-ops)) - (ldb/batch-transact-with-temp-conn! - conn - tx-meta' - (fn [conn] - (doseq [op ops'] - (replay-canonical-outliner-op! conn op nil)))) - {:applied? true - :history-tx-id history-tx-id} - (catch :default e - (let [reason (history-action-error-reason e)] - (when-not (expected-history-action-error-reason? reason) - (log/error ::undo-redo-failed e)) - {:applied? false - :reason reason - :action action}))) - {:applied? false :reason :unsupported-history-action - :action action}))) - {:applied? false - :reason :missing-history-action - :tx-id tx-id}) - (fail-fast :db-sync/missing-db {:repo repo - :op :apply-history-action}))) - -(defn flush-pending! - [repo client] - (let [inflight @(:inflight client) - local-tx (client-op/get-local-tx repo) - remote-tx (get @*repo->latest-remote-tx repo) - conn (worker-state/get-datascript-conn repo) - ws (:ws client) - ws-open-state? (when ws (ws-open? ws)) - online? (worker-state/online?) - upload-stopped-state? (upload-stopped? repo) - pending-count (client-op/get-pending-local-tx-count repo) - ready? (and conn - (= local-tx remote-tx) - (empty? inflight) - ws-open-state? - online? - (not upload-stopped-state?))] - (when (and (pos? (or pending-count 0)) - (not ready?)) - (log/info :db-sync/flush-pending-skipped - {:repo repo - :pending-local-tx-count pending-count - :has-db? (some? conn) - :local-tx local-tx - :remote-tx remote-tx - :inflight-count (count inflight) - :ws-open? ws-open-state? - :ws-ready-state (ws-ready-state ws) - :online? online? - :upload-stopped? upload-stopped-state?})) - (when ready? - (let [batch (pending-txs repo {:limit 50})] - (when (seq batch) - (let [{:keys [tx-entries drop-tx-ids drop-txs]} (prepare-upload-tx-entries repo conn batch)] - (when (seq drop-tx-ids) - (log/info :db-sync/drop-tx-ids {:tx-ids drop-tx-ids - :drops drop-txs}) - (mark-pending-txs-false! repo drop-tx-ids)) - (-> (p/let [aes-key (when (and (seq tx-entries) (sync-crypt/graph-e2ee? repo)) - (sync-crypt/ {:tx (sqlite-util/write-transit-str tx-data)} - tx-id - (assoc :tx-id (str tx-id)) - outliner-op - (assoc :outliner-op outliner-op))) - tx-entries*) - tx-ids (into [] (keep :tx-id) tx-entries)] - (when (seq tx-entries) - (reset! (:inflight client) tx-ids) - (p/do! - (send! ws {:type "tx/batch" - :client-revision (build-version/revision) - :t-before local-tx - :txs payload}) - (start-upload-response-timeout! - client - {:tx-ids tx-ids - :outliner-ops (->> tx-entries - (keep :outliner-op) - distinct - vec) - :large-upload-progress (large-upload-progress tx-entries*) - :t-before local-tx})))) - (p/catch (fn [error] - (sync-util/set-last-sync-error! client error) - (log/error :db-sync/flush-pending-failed - {:repo repo - :error error})))))))))) - -(defn enqueue-flush-pending! - [repo client] - (if-let [send-queue (:send-queue client)] - (swap! send-queue - (fn [prev] - (-> (or prev (p/resolved nil)) - (p/catch (fn [_] nil)) - (p/then (fn [_] - (flush-pending! repo client))) - (p/catch (fn [error] - (log/error :db-sync/flush-pending-queue-failed - {:repo repo - :error error})))))) - (flush-pending! repo client))) - -(defn- block-ref? - [v] - (or (number? v) - (and (vector? v) - (= :block/uuid (first v)) - (uuid? (second v))))) - -(defn- block-entity - [db ref] - (when (block-ref? ref) - (d/entity db ref))) - -(defn- block-entity-ref - [entity] - (if-let [block-uuid (:block/uuid entity)] - [:block/uuid block-uuid] - (:db/id entity))) - -(defn- block-descendants - [entity] - (letfn [(collect [block] - (mapcat (fn [child] - (cons child (collect child))) - (sort-by :block/order - (entity-plus/lookup-kv-then-entity block :block/_raw-parent))))] - (collect entity))) - -(defn- retract-entity-op? - [item] - (and (vector? item) - (contains? #{:db/retractEntity :db.fn/retractEntity} (first item)))) - -(defn- expand-block-retracts-to-descendants - [db tx-data] - (let [explicit-retracts (->> tx-data - (keep (fn [item] - (when (and (retract-entity-op? item) - (block-ref? (second item))) - (some-> (block-entity db (second item)) :db/id)))) - set)] - (mapcat - (fn [item] - (if (and (retract-entity-op? item) - (block-ref? (second item)) - (block-entity db (second item))) - (let [root (block-entity db (second item))] - (concat (->> (block-descendants root) - (remove #(contains? explicit-retracts (:db/id %))) - (map (fn [entity] - [:db/retractEntity (block-entity-ref entity)]))) - [item])) - [item])) - tx-data))) - -(defn- reverse-history-action! - [conn local-tx] - (if-let [tx-data (seq (:reversed-tx local-tx))] - (let [db @conn - tx-data' (cond->> (some->> tx-data - (map (partial resolve-temp-id db)) - normalize-tx-data-for-rebase) - (= :insert-blocks (:outliner-op local-tx)) - (expand-block-retracts-to-descendants db))] - (ldb/transact! conn - tx-data' - {:outliner-op (:outliner-op local-tx) - :reverse? true - :skip-validate-db? true})) - ;; Built-in sync repair :fix rows are idempotent and can be queued without - ;; reverse data; normal user edits must still carry reverse tx-data. - (when-not (= :fix (:outliner-op local-tx)) - (invalid-rebase-op! :reverse-history-action - {:reason :missing-reversed-tx-data - :tx-id (:tx-id local-tx) - :outliner-op (:outliner-op local-tx)})))) - -(defn- replace-uuid-str-with-eid - [db v] - (if (and (string? v) (common-util/uuid-string? v)) - (if-let [entity (d/entity db [:block/uuid (uuid v)])] - (:db/id entity) - v) - v)) - -(defn- ref-attr? - [db attr] - (= :db.type/ref - (or (get-in (d/schema db) [attr :db/valueType]) - (:db/valueType (d/entity db attr))))) - -(defn- resolve-temp-id - [db datom-v] - (if (and (= (count datom-v) 5) - (= (first datom-v) :db/add)) - (let [[op e a v t] datom-v - e' (replace-uuid-str-with-eid db e) - v' (if (ref-attr? db a) - (replace-uuid-str-with-eid db v) - v)] - [op e' a v' t]) - datom-v)) - -(def sync-conflict-attrs - #{:block/title}) - -(defn- tx-item-components - [item] - (when (and (vector? item) (>= (count item) 4)) - (let [[op e a v] item] - (when (and (contains? #{:db/add :db/retract} op) - (contains? sync-conflict-attrs a)) - {:op op - :e e - :a a - :v v})))) - -(defn- tx-entity-uuid - [db temp-id->uuid e] - (cond - (uuid? e) e - - (and (string? e) (common-util/uuid-string? e)) (uuid e) - - (and (vector? e) - (= :block/uuid (first e)) - (uuid? (second e))) (second e) - - (and (number? e) (contains? temp-id->uuid e)) (get temp-id->uuid e) - - :else (some-> (d/entity db e) :block/uuid))) - -(defn- tx-item-created-block-uuid-entry - [item] - (let [vector-add? (and (vector? item) - (= :db/add (first item))) - datom-add? (and (not (vector? item)) - (:added item))] - (when (or vector-add? datom-add?) - (let [e (if vector-add? (second item) (:e item)) - a (if vector-add? (nth item 2 nil) (:a item)) - v (if vector-add? (nth item 3 nil) (:v item))] - (when (and (= :block/uuid a) - (or (number? e) - (string? e)) - (uuid? v)) - [e v]))))) - -(defn- tx-temp-id->uuid - [tx-data] - (->> tx-data - (keep tx-item-created-block-uuid-entry) - (into {}))) - -(defn- local-conflict-block-uuids - [db local-txs] - (->> local-txs - (mapcat :tx) - (keep tx-item-components) - (keep (fn [{:keys [e]}] - (tx-entity-uuid db {} e))) - set)) - -(defn- remote-sync-conflicts - [db local-txs remote-txs] - (let [local-block-uuids (local-conflict-block-uuids db local-txs)] - (when (seq local-block-uuids) - (->> remote-txs - (mapcat (fn [{:keys [tx-data t]}] - (let [temp-id->uuid (tx-temp-id->uuid tx-data)] - (keep (fn [item] - (when-let [{:keys [op e a v]} (tx-item-components item)] - (when (and (= :db/add op) (string? v)) - (when-let [block-uuid (tx-entity-uuid db temp-id->uuid e)] - (let [current-value (some-> (d/entity db [:block/uuid block-uuid]) a)] - (when (and (contains? local-block-uuids block-uuid) - (not= current-value v)) - {:block-uuid block-uuid - :attr a - :value v - :remote-t t})))))) - tx-data)))) - distinct - vec)))) - -(defn- broadcast-sync-conflicts! - [repo conflicts] - (doseq [block-uuid (distinct (map :block-uuid conflicts))] - (shared-service/broadcast-to-clients! - :sync-conflicts-updated - {:repo repo - :block-uuid block-uuid - :conflicts (client-op/get-sync-conflicts repo block-uuid)}))) - -(defn- transact-remote-txs! - [conn remote-txs & {:keys [db-before-local-reversal]}] - (let [deleted-block-uuid-suffixes (remote-txs-retract-entity-block-uuid-suffixes remote-txs)] - (loop [remaining remote-txs - deleted-block-uuid-suffixes deleted-block-uuid-suffixes - results []] - (let [db @conn] - (if-let [remote-tx (first remaining)] - (let [deleted-block-uuids (first deleted-block-uuid-suffixes) - tx-data (some->> (:tx-data remote-tx) - (map (partial resolve-temp-id db)) - (tx-sanitize/sanitize-tx db) - drop-stale-adds-after-remote-entity-delete) - tx-data (cond->> tx-data - (seq deleted-block-uuids) - (drop-stale-deleted-block-ref-ops db deleted-block-uuids) - - (tx-data-has-block-uuid-ref? tx-data) - (drop-missing-block-ref-ops db)) - tx-data (cond->> tx-data - db-before-local-reversal - (drop-local-reversal-stale-target-ops db-before-local-reversal db)) - tx-data (seq tx-data) - tx-meta (apply-tx-meta remote-tx) - report (ldb/transact! conn tx-data tx-meta) - results' (cond-> results - tx-data - (conj {:tx-data tx-data - :report report}))] - (recur (next remaining) - (next deleted-block-uuid-suffixes) - results')) - results))))) - -(defn reverse-local-txs! - [conn local-txs] - (doall - (->> local-txs - reverse - (map-indexed - (fn [index local-tx] - (try - (reverse-history-action! conn local-tx) - (catch :default e - (if (expected-stale-rebase-error? e) - (do - (log/debug :db-sync/skip-stale-reverse-local-tx - {:index index - :tx-id (:tx-id local-tx) - :outliner-op (:outliner-op local-tx) - :error e}) - {:tx-id (:tx-id local-tx) - :status :failed}) - (do - (log/error ::reverse-local-tx-error - {:index index - :local-tx local-tx - :local-txs local-txs}) - (throw e))))))) - (keep identity) - vec))) - -(defn- invalid-rebase-op! - [op data] - (throw (ex-info "invalid rebase op" (assoc data :op op)))) - -(defn- expected-stale-rebase-error? - [error] - (let [data (ex-data error)] - (or (= "invalid rebase op" (ex-message error)) - (= :entity-id/missing (:error data)) - (and (= :transact/unique (:error data)) - (= :block/uuid (:attribute data)))))) - -(defn- history-action-error-reason - [error] - (let [message (ex-message error)] - (if (or (= "invalid rebase op" message) - (= "Non-transact outliner ops contain numeric entity ids" message)) - :invalid-history-action-ops - :error))) - -(defn- replay-entity-id-value - [db v] - (cond - (number? v) - v - - (uuid? v) - (some-> (d/entity db [:block/uuid v]) :db/id) - - (or (vector? v) (qualified-keyword? v)) - (some-> (d/entity db v) :db/id) - - :else - v)) - -(defn- replay-entity-id-coll - [db ids] - (mapv #(or (replay-entity-id-value db %) %) ids)) - -(defn- rebase-find-existing-left-sibling - [current-db target] - (loop [sibling (ldb/get-left-sibling target)] - (if (nil? sibling) - nil - (if-let [current-sibling (and sibling (d/entity current-db [:block/uuid (:block/uuid sibling)]))] - current-sibling - (recur (ldb/get-left-sibling sibling)))))) - -(defn- rebase-target-ref - [target-id] - (cond - (and (vector? target-id) - (= :block/uuid (first target-id)) - (uuid? (second target-id))) - target-id - - (uuid? target-id) - [:block/uuid target-id] - - (and (map? target-id) (uuid? (:block/uuid target-id))) - [:block/uuid (:block/uuid target-id)] - - :else - target-id)) - -(defn- rebase-resolve-target-and-sibling - [current-db rebase-db-before target-id sibling?] - (let [target-ref (rebase-target-ref target-id) - target (d/entity current-db target-ref) - target-before (when rebase-db-before - (d/entity rebase-db-before target-ref)) - parent-before (when rebase-db-before - (:block/parent (d/entity rebase-db-before target-ref)))] - (cond - target - [target sibling?] - - (and target-before parent-before sibling?) - (if-let [left-sibling (rebase-find-existing-left-sibling current-db target-before)] - [left-sibling true] - (when-let [parent (d/entity current-db [:block/uuid (:block/uuid parent-before)])] - [parent false])) - - :else - nil))) - -(defn- template-parent-ref - [parent] - (cond - (and (vector? parent) (= :block/uuid (first parent))) - parent - - (uuid? parent) - [:block/uuid parent] - - (and (map? parent) (uuid? (:block/uuid parent))) - [:block/uuid (:block/uuid parent)] - - :else - parent)) - -(defn- sanitize-template-block - [current-db rebase-db-before block] - (let [m (into {} block) - block-id (:db/id m) - block-uuid (or (:block/uuid m) - (when (number? block-id) - (or (some-> rebase-db-before (d/entity block-id) :block/uuid) - (some-> (d/entity current-db block-id) :block/uuid))) - (when (and (vector? block-id) - (= :block/uuid (first block-id)) - (uuid? (second block-id))) - (second block-id)))] - (cond-> (-> m - (dissoc :db/id :block/order :block/page :block/tx-id) - (update :block/parent template-parent-ref)) - (uuid? block-uuid) - (assoc :block/uuid block-uuid)))) - -(defn- ^:large-vars/cleanup-todo replay-canonical-outliner-op! - [conn [op args] rebase-db-before] - (case op - :save-block - (let [[block opts] args - db @conn - block-uuid (:block/uuid block) - block-ent (when block-uuid - (d/entity db [:block/uuid block-uuid])) - block-base (dissoc block :db/id :block/order) - block' (merge block-base - (op-construct/rewrite-block-title-with-retracted-refs db block-base))] - (when (nil? block-ent) - (invalid-rebase-op! op {:args args - :reason :missing-block})) - (outliner-core/save-block! conn block' opts)) - - :insert-blocks - (let [[blocks target-id opts] args - db @conn - [target sibling?] (rebase-resolve-target-and-sibling db rebase-db-before target-id (:sibling? opts))] - (when-not (and target (seq blocks)) - (invalid-rebase-op! op {:args args})) - (outliner-core/insert-blocks! conn - (mapv #(op-construct/rewrite-block-title-with-retracted-refs db %) blocks) - target - (assoc opts :sibling? sibling?))) - - :apply-template - (let [[template-id target-id opts] args - template-id' (replay-entity-id-value @conn template-id) - target-id' (replay-entity-id-value @conn target-id) - [target sibling?] (rebase-resolve-target-and-sibling @conn rebase-db-before target-id' (:sibling? opts))] - (when-not (and template-id' (d/entity @conn template-id') target) - (invalid-rebase-op! op {:args args - :reason :missing-template-or-target-block})) - (let [template-uuid (:block/uuid (d/entity @conn template-id')) - target-uuid (:block/uuid target)] - (when-not (and (uuid? template-uuid) (uuid? target-uuid)) - (invalid-rebase-op! op {:args args - :reason :missing-template-or-target-uuid})) - (let [replace-empty-target? (:replace-empty-target? opts) - template-blocks' (some->> (:template-blocks opts) - (map-indexed - (fn [idx block] - (let [block' (sanitize-template-block @conn rebase-db-before block) - block'' (if (and replace-empty-target? - (zero? idx) - (nil? (:block/uuid block'))) - ;; Keep replace-empty-target replay consistent with - ;; initial apply-template payload where the first - ;; block uuid is the target uuid. - (assoc block' :block/uuid target-uuid) - block')] - (when (:block/uuid block'') - block'')))) - (remove nil?) - seq - vec) - opts' (cond-> (-> opts - (assoc :sibling? sibling?) - (dissoc :template-blocks)) - template-blocks' - (assoc :template-blocks template-blocks'))] - (outliner-op/apply-ops! - conn - [[:apply-template [template-uuid - target-uuid - opts']]] - {:gen-undo-ops? false})))) - - :move-blocks - (let [[ids target-id opts] args - ids' (replay-entity-id-coll @conn ids) - target-id' (replay-entity-id-value @conn target-id) - blocks (keep #(d/entity @conn %) ids') - [target sibling?] (rebase-resolve-target-and-sibling @conn rebase-db-before target-id' (:sibling? opts))] - (when (or (empty? blocks) (nil? target)) - (invalid-rebase-op! op {:args args})) - (when (seq blocks) - (outliner-core/move-blocks! conn blocks target (assoc opts :sibling? sibling?)))) - - :move-blocks-up-down - (let [[ids up?] args - ids' (replay-entity-id-coll @conn ids) - blocks (keep #(d/entity @conn %) ids')] - (when (seq blocks) - (outliner-core/move-blocks-up-down! conn blocks up?))) - - :indent-outdent-blocks - (let [[ids indent? opts] args - ids' (replay-entity-id-coll @conn ids) - blocks (keep #(d/entity @conn %) ids')] - (when (empty? blocks) - (invalid-rebase-op! op {:args args})) - (when (seq blocks) - (outliner-core/indent-outdent-blocks! conn blocks indent? opts))) - - :delete-blocks - (let [[ids opts] args - ids' (replay-entity-id-coll @conn ids) - blocks (keep #(d/entity @conn %) ids')] - ;; Keep delete replay idempotent under concurrent edits where blocks may already - ;; be gone, but still leave a debug breadcrumb for malformed/missing targets. - (when (empty? blocks) - (log/debug :db-sync/drop-delete-blocks-replay - {:args args})) - (when (seq blocks) - (outliner-core/delete-blocks! conn blocks opts))) - - :create-page - (let [[title opts] args - page-uuid (:uuid opts) - existing-page (or (when (uuid? page-uuid) - (d/entity @conn [:block/uuid page-uuid])) - (ldb/get-page @conn title))] - (if (and existing-page - (not (ldb/recycled? existing-page))) - [(:block/title existing-page) (:block/uuid existing-page)] - (outliner-page/create! conn title opts))) - - :delete-page - (let [[page-uuid opts] args] - (outliner-page/delete! conn page-uuid opts)) - - :upsert-property - (apply outliner-property/upsert-property! conn args) - - :restore-recycled - (let [[root-id] args - root-ref (cond - (and (vector? root-id) - (= :block/uuid (first root-id))) - root-id - - (uuid? root-id) - [:block/uuid root-id] - - :else - root-id) - root (d/entity @conn root-ref) - tx-data (when root - (seq (outliner-recycle/restore-tx-data @conn root)))] - (when-not tx-data - (invalid-rebase-op! op {:args args - :reason :invalid-restore-target})) - (ldb/transact! conn tx-data - {:outliner-op :restore-recycled})) - - :recycle-delete-permanently - (let [[root-id] args - root-ref (cond - (and (vector? root-id) - (= :block/uuid (first root-id))) - root-id - - (uuid? root-id) - [:block/uuid root-id] - - :else - root-id) - root (d/entity @conn root-ref) - tx-data (when root - (seq (outliner-recycle/permanently-delete-tx-data @conn root)))] - ;; Keep replay idempotent under concurrent edits where the recycled root may - ;; already be permanently removed by a preceding remote tx. - (when (seq tx-data) - (ldb/transact! conn tx-data - {:outliner-op :recycle-delete-permanently}))) - - (let [[tx-data tx-meta] args - tx-data (expand-block-retracts-to-descendants @conn tx-data)] - (when-let [tx-data (seq tx-data)] - (ldb/transact! conn tx-data tx-meta))))) - -(defn- rebase-local-op! - [_repo conn local-tx rebase-db-before] - (if (= :fix (:outliner-op local-tx)) - {:tx-id (:tx-id local-tx) - :status :kept} - (let [{:keys [forward-ops inverse-ops]} (rebase-history-ops local-tx) - tx-meta {:outliner-op :rebase - :original-outliner-op (:outliner-op local-tx) - :db-sync/rebased-local? true - ;; Keep stable tx-id across rebases so one logical pending op - ;; doesn't fan out into duplicated pending rows. - :db-sync/tx-id (:tx-id local-tx) - :db-sync/forward-outliner-ops forward-ops - :db-sync/inverse-outliner-ops inverse-ops} - forward-ops' (if (seq forward-ops) - forward-ops - (let [tx-data (-> (:tx local-tx) normalize-tx-data-for-rebase)] - [[:transact [tx-data (assoc tx-meta - :db-sync/suppress-stale-rebase-transact-failed-log? - true)]]]))] - (try - (let [rebase-tx-report - (ldb/batch-transact-with-temp-conn! - conn - tx-meta - (fn [conn] - (doseq [op forward-ops'] - (replay-canonical-outliner-op! conn op rebase-db-before)))) - status (if rebase-tx-report :rebased :no-op)] - {:tx-id (:tx-id local-tx) - :status status}) - (catch :default error - (let [drop-log {:tx-id (:tx-id local-tx) - :outliner-op (:outliner-op local-tx) - :undo? (:undo? local-tx) - :redo? (:redo? local-tx) - :error error}] - (when-not (expected-stale-rebase-error? error) - (log/warn :db-sync/drop-op-driven-pending-tx drop-log)) - {:tx-id (:tx-id local-tx) - :status :failed})))))) - -(defn- rebase-local-txs! - [repo conn local-txs rebase-db-before] - (mapv (fn [local-tx] - (rebase-local-op! repo conn local-tx rebase-db-before)) - local-txs)) - -(defn- fix-tx! - [conn rebase-tx-report tx-meta] - (sync-order/fix-duplicate-orders! conn - (:tx-data rebase-tx-report) - tx-meta)) - -(defn- sync-fix-tx-meta - [] - {:outliner-op :fix - :gen-undo-ops? false - :db-sync/tx-id (random-uuid)}) - -(defn- repair-applied-txs! - [conn tx-report] - (when (seq (:tx-data tx-report)) - (fix-tx! conn tx-report (sync-fix-tx-meta)))) - -(defn- pending-tx-ids - [local-txs] - (mapv :tx-id local-txs)) - -(defn- pending-tx-snapshot-changed? - [repo local-txs] - (not= (pending-tx-ids local-txs) - (pending-tx-ids (pending-txs repo)))) - -(defn- fail-if-pending-tx-snapshot-changed! - [repo local-txs] - (when (pending-tx-snapshot-changed? repo local-txs) - (throw (ex-info "pending local tx snapshot changed during remote apply" - {:code :pending-tx-snapshot-changed - :repo repo - :local-tx-ids (pending-tx-ids local-txs) - :current-local-tx-ids (pending-tx-ids (pending-txs repo))})))) - -(defn- apply-remote-tx-with-local-changes! - [{:keys [repo conn local-txs remote-txs db-migrate? skip-final-validate?]}] - (let [tx-meta (cond-> {:rtc-tx? true - :with-local-changes? true} - db-migrate? - (assoc :db-migrate? true - :outliner-op :db-migrate) - skip-final-validate? - (assoc :skip-validate-db? true)) - *rebase-tx-reports (atom []) - *rebase-results (atom []) - *remote-tx-results (atom []) - rebase-db-before @conn - conflicts (remote-sync-conflicts rebase-db-before local-txs remote-txs)] - (try - (when (seq conflicts) - (client-op/add-sync-conflicts! repo conflicts) - (broadcast-sync-conflicts! repo conflicts)) - (let [tx-report (ldb/batch-transact-with-temp-conn! - conn - tx-meta - (fn [conn] - (reverse-local-txs! conn local-txs) - - (reset! *remote-tx-results - (transact-remote-txs! conn remote-txs - :db-before-local-reversal rebase-db-before)) - - (reset! *rebase-results - (rebase-local-txs! repo conn local-txs rebase-db-before))) - - {:listen-db (fn [{:keys [tx-meta tx-data] :as tx-report}] - (when (and (= :rebase (:outliner-op tx-meta)) - (:db-sync/rebased-local? tx-meta) - (seq tx-data)) - (swap! *rebase-tx-reports conj tx-report))) - :before-commit #(fail-if-pending-tx-snapshot-changed! repo local-txs)})] - (doseq [tx-report @*rebase-tx-reports] - (handle-local-tx! repo tx-report)) - - (repair-applied-txs! conn tx-report) - ;; Mark only explicitly stale rebases as non-pending. - ;; Do not infer stale via tx-id set-diff, which can hide still-valid - ;; pending txs that should wait for server ack/reject. - (let [stale-tx-ids (->> @*rebase-results - (filter (fn [{:keys [status]}] - (contains? #{:failed :no-op} status))) - (keep :tx-id) - distinct - vec)] - (mark-pending-txs-false! repo stale-tx-ids)) - {:remote-asset-tx-data (mapcat (comp :tx-data :report) @*remote-tx-results)}) - - (catch :default e - (js/console.error e) - (throw e)) - (finally - (reset! *rebase-tx-reports nil) - (reset! *rebase-results nil) - (worker-undo-redo/clear-history! repo))))) - -(defn- apply-remote-tx-without-local-changes! - [{:keys [repo conn local-txs remote-txs db-migrate? skip-final-validate?]}] - (let [remote-tx-results (atom []) - tx-report (ldb/batch-transact-with-temp-conn! - conn - (cond-> {:rtc-tx? true - :without-local-changes? true} - db-migrate? - (assoc :db-migrate? true - :outliner-op :db-migrate) - skip-final-validate? - (assoc :skip-validate-db? true)) - (fn [conn] - (reset! remote-tx-results - (transact-remote-txs! conn remote-txs))) - {:before-commit #(fail-if-pending-tx-snapshot-changed! repo local-txs)})] - (repair-applied-txs! conn tx-report) - {:remote-asset-tx-data (mapcat (comp :tx-data :report) @remote-tx-results)})) - -(defn- report-apply-remote-txs-error! - [error {:keys [has-local-changes? remote-txs local-txs]}] - (try - (platform/post-message! - (platform/current) - :capture-error - (cond-> {:error (js/Error. "Sync apply remote txs failed") - :payload {:source "db-sync" - :operation "apply-remote-txs" - :has-local-changes? has-local-changes? - :remote-tx-count (count remote-txs) - :local-tx-count (count local-txs)}} - (ex-data error) - (assoc :extra {:error-data (ex-data error)}))) - (catch :default report-error - (log/error :db-sync/report-apply-remote-txs-error-failed - {:error report-error})))) - -(defn- eager-remote-asset-download-owner? - [] - (contains? #{:cli :electron} - (try - (platform/env-flag (platform/current) :owner-source) - (catch :default _ - nil)))) - -(defn- download-missing-remote-assets-for-owner! - [repo client remote-tx-data] - (when (and (:graph-id client) - (eager-remote-asset-download-owner?)) - (let [candidates (some-> (worker-state/get-datascript-conn repo) - deref - (sync-assets/remote-asset-download-candidates-in-tx remote-tx-data))] - (when (seq candidates) - (sync-assets/download-remote-assets-if-missing! repo (:graph-id client) candidates))))) - -(defn- finish-apply-remote-txs! - [repo client remote-tx-data remote-asset-tx-data] - (when-let [*inflight (:inflight client)] - (reset! *inflight [])) - - (p/let [_ (when-let [result (rehydrate-large-titles! repo {:tx-data remote-tx-data - :graph-id (:graph-id client)})] - (p/catch result - (fn [error] - (log/error :db-sync/large-title-rehydrate-failed - {:repo repo :error error})))) - _ (download-missing-remote-assets-for-owner! repo client remote-asset-tx-data)] - nil)) - -(defn- 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))))) diff --git a/src/main/frontend/worker/sync/assets.cljs b/src/main/frontend/worker/sync/assets.cljs deleted file mode 100644 index ea954f8..0000000 --- a/src/main/frontend/worker/sync/assets.cljs +++ /dev/null @@ -1,507 +0,0 @@ -(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/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- (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 (-> - (uint8 asset-bytes) asset-bytes) - payload (if (not aes-key) - asset-bytes - (p/let [encrypted-bytes (crypt/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/ (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})))) diff --git a/src/main/frontend/worker/sync/auth.cljs b/src/main/frontend/worker/sync/auth.cljs deleted file mode 100644 index 2f5b0a0..0000000 --- a/src/main/frontend/worker/sync/auth.cljs +++ /dev/null @@ -1,109 +0,0 @@ -(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 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 {: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)) diff --git a/src/main/frontend/worker/sync/client_op.cljs b/src/main/frontend/worker/sync/client_op.cljs deleted file mode 100644 index b32becb..0000000 --- a/src/main/frontend/worker/sync/client_op.cljs +++ /dev/null @@ -1,670 +0,0 @@ -(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)) diff --git a/src/main/frontend/worker/sync/const.cljs b/src/main/frontend/worker/sync/const.cljs deleted file mode 100644 index 679f7db..0000000 --- a/src/main/frontend/worker/sync/const.cljs +++ /dev/null @@ -1,27 +0,0 @@ -(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}) diff --git a/src/main/frontend/worker/sync/crypt.cljs b/src/main/frontend/worker/sync/crypt.cljs deleted file mode 100644 index 82d5645..0000000 --- a/src/main/frontend/worker/sync/crypt.cljs +++ /dev/null @@ -1,909 +0,0 @@ -(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- (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- (ui-request/ (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- (ui-request/ (ui-request/ (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- (sync-auth/user-uuid) - (p/catch (fn [_error] - nil)))))) - -(defn- (p/let [cached (js body))} - {:response-schema :e2ee/user-keys}) - user-id ( (crypt/ ( (js body))} - {:response-schema :e2ee/graph-aes-key}))) - -(defn- ( (p/let [_ (aes-key graph-id)] - (p/resolved cached) - (let [base (e2ee-base)] - (p/let [user-id ( (crypt/ (p/let [_ (aes-key assoc graph-id aes-key) - aes-key)))))) - -(defn aes-key assoc graph-id aes-key) - aes-key))))] - (p/let [pair ( ( (p/let [_ (js body))} - {:response-schema :e2ee/grant-access})] - nil)))))) - -(defn result - (some? addresses) - (assoc :addresses addresses))) - raw-addresses]) - (p/let [result (p/all (map #(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- 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- uint8 buf)] - (if (gzip-bytes? chunk) - ( (.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- 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)] - (-> (= (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- uint8 (.-value result))) - pending (into pending rows)] - (p/let [pending ( (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- 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/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- (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/ (p/let [state (require-import-state! nil graph-id import-id) - state ( (p/let [state (require-import-state! repo graph-id import-id) - _ (when (:rows-imported? state) - ( (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/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) - ( (.-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}))))) diff --git a/src/main/frontend/worker/sync/handle_message.cljs b/src/main/frontend/worker/sync/handle_message.cljs deleted file mode 100644 index 0ad5095..0000000 --- a/src/main/frontend/worker/sync/handle_message.cljs +++ /dev/null @@ -1,391 +0,0 @@ -(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/ 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}))))) diff --git a/src/main/frontend/worker/sync/log_and_state.cljs b/src/main/frontend/worker/sync/log_and_state.cljs deleted file mode 100644 index e9d3845..0000000 --- a/src/main/frontend/worker/sync/log_and_state.cljs +++ /dev/null @@ -1,41 +0,0 @@ -(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) diff --git a/src/main/frontend/worker/sync/presence.cljs b/src/main/frontend/worker/sync/presence.cljs deleted file mode 100644 index f73c6a7..0000000 --- a/src/main/frontend/worker/sync/presence.cljs +++ /dev/null @@ -1,120 +0,0 @@ -(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)))) diff --git a/src/main/frontend/worker/sync/temp_sqlite.cljs b/src/main/frontend/worker/sync/temp_sqlite.cljs deleted file mode 100644 index 684cec2..0000000 --- a/src/main/frontend/worker/sync/temp_sqlite.cljs +++ /dev/null @@ -1,92 +0,0 @@ -(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 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})))) diff --git a/src/main/frontend/worker/sync/upload.cljs b/src/main/frontend/worker/sync/upload.cljs deleted file mode 100644 index b511afd..0000000 --- a/src/main/frontend/worker/sync/upload.cljs +++ /dev/null @@ -1,428 +0,0 @@ -(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 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- 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/ (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 [_ ( (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})))))) diff --git a/src/main/frontend/worker/ui_request.cljs b/src/main/frontend/worker/ui_request.cljs deleted file mode 100644 index 70c9858..0000000 --- a/src/main/frontend/worker/ui_request.cljs +++ /dev/null @@ -1,175 +0,0 @@ -(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 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)) diff --git a/src/main/frontend/worker/undo_redo.cljs b/src/main/frontend/worker/undo_redo.cljs index 8d84bc8..d460dc0 100644 --- a/src/main/frontend/worker/undo_redo.cljs +++ b/src/main/frontend/worker/undo_redo.cljs @@ -2,7 +2,7 @@ "Undo redo new implementation" (:require [datascript.core :as d] [frontend.worker.state :as worker-state] - [frontend.worker.sync.client-op :as client-op] + [frontend.worker.local-tx-log :as local-tx-log] [lambdaisland.glogi :as log] [logseq.common.defkeywords :refer [defkeywords]] [malli.core :as m] @@ -308,7 +308,7 @@ (defn- pending-history-action-ops [repo tx-id] (when (uuid? tx-id) - (client-op/history-action-ops-by-tx-id repo tx-id))) + (local-tx-log/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 diff --git a/src/main/frontend/worker/undo_redo/replay.cljs b/src/main/frontend/worker/undo_redo/replay.cljs new file mode 100644 index 0000000..2d21841 --- /dev/null +++ b/src/main/frontend/worker/undo_redo/replay.cljs @@ -0,0 +1,547 @@ +(ns frontend.worker.undo-redo.replay + "Local undo/redo history recording and replay. + + Ported from the now-deleted frontend.worker.sync.apply-txs (Fase 8 in + docs/agent-guide), which mixed this together with the remote-sync tx + upload/apply protocol. This is the part that survives: every local + outliner edit gets its forward/inverse outliner ops derived and stashed in + frontend.worker.local-tx-log (keyed by tx-id) via persist-local-tx!, then + immediately read back and pushed onto the in-memory undo/redo stack by + worker-undo-redo/gen-undo-ops! -- the local-tx-log row is a short-lived + relay, not a source of truth (the undo-stack entry embeds the ops + directly), so it's safe for db_core.cljs's periodic + cleanup-finished-history-ops! to reclaim it later. apply-history-action! is + the reverse direction: it's what actually runs when the user hits + undo/redo, replaying an entry's forward or inverse outliner ops (or, for + edits that bypassed the structured outliner-op layer entirely, a raw + normalized/reversed tx-data fallback) against the *current* db state -- + this is registered as worker-undo-redo/*apply-history-action!, the + extension point undo_redo.cljs calls on every undo/redo." + (:require [datascript.core :as d] + [frontend.worker.local-tx-log :as local-tx-log] + [frontend.worker.state :as worker-state] + [frontend.worker.undo-redo :as worker-undo-redo] + [lambdaisland.glogi :as log] + [logseq.db :as ldb] + [logseq.db.common.entity-plus :as entity-plus] + [logseq.db.common.normalize :as db-normalize] + [logseq.outliner.core :as outliner-core] + [logseq.outliner.op :as outliner-op] + [logseq.outliner.op.construct :as op-construct] + [logseq.outliner.page :as outliner-page] + [logseq.outliner.property :as outliner-property] + [logseq.outliner.recycle :as outliner-recycle])) + +;; ---- recording: derive + stash + push onto the undo stack ---- + +(defn- tx-meta-outliner-op + [tx-meta] + (or (:outliner-op tx-meta) + (when (:db-migrate? tx-meta) + :db-migrate))) + +(defn- inferred-outliner-ops? + [tx-meta] + (and (nil? (:outliner-ops tx-meta)) + (not (:undo? tx-meta)) + (not (:redo? tx-meta)) + (not= :batch-import-edn (:outliner-op tx-meta)))) + +(defn- normalize-tx-data [db-after db-before tx-data] + (db-normalize/normalize-tx-data db-after db-before tx-data)) + +(defn- reverse-tx-data [db-before db-after tx-data] + (->> tx-data + reverse + (keep (fn [[e a v t added]] + (let [reversed-datom (d/datom e a v t (not added))] + ;; trick: reverse the order of `db-before` and `db-after` + (db-normalize/normalize-datom db-before db-after reversed-datom)))) + (db-normalize/replace-attr-retract-with-retract-entity-v2 db-after) + db-normalize/reorder-retract-entity)) + +(declare apply-history-action!) + +(defn persist-local-tx! + "Runs on every committed local tx (see db_listener.cljs's :persist-local-tx + handler): derives this tx's forward/inverse outliner ops, stashes them in + local-tx-log keyed by tx-id, then hands off to gen-undo-ops! to push the + undo-stack entry (and, the first time, register apply-history-action! as + the default replay implementation -- same lazy-registration pattern the + deleted sync code used). A no-op when the graph has no client-ops conn + open (e.g. :publishing)." + [repo {:keys [db-before db-after tx-data tx-meta] :as tx-report}] + (when (and (worker-state/get-client-ops-conn repo) + (:persist-op? tx-meta true)) + (let [tx-id (or (:db-sync/tx-id tx-meta) (random-uuid)) + outliner-op (tx-meta-outliner-op tx-meta) + {:keys [forward-outliner-ops inverse-outliner-ops]} + (op-construct/derive-history-outliner-ops db-before db-after tx-data tx-meta) + normalized-tx-data (normalize-tx-data db-after db-before tx-data) + reversed-datoms (reverse-tx-data db-before db-after tx-data)] + (local-tx-log/upsert-local-tx-entry! + repo + {:tx-id tx-id + :created-at (.now js/Date) + ;; No upload queue to mark this false later -- write it already + ;; settled so db_core.cljs's periodic cleanup-finished-history-ops! + ;; (which only reclaims pending = 0 rows, protecting whatever the + ;; live undo/redo stack still references) is the sole garbage + ;; collector for this table. + :pending? false + :failed? false + :outliner-op outliner-op + :undo-redo (cond + (:undo? tx-meta) :undo + (:redo? tx-meta) :redo + :else :none) + :forward-outliner-ops forward-outliner-ops + :inverse-outliner-ops inverse-outliner-ops + :inferred-outliner-ops? (inferred-outliner-ops? tx-meta) + :normalized-tx-data normalized-tx-data + :reversed-tx-data reversed-datoms}) + (worker-undo-redo/gen-undo-ops! repo tx-report tx-id + {:apply-history-action! apply-history-action!}) + tx-id))) + +;; ---- replay: apply a recorded entry's ops against the current db ---- + +(defn- inline-history-action + [tx-meta] + (let [forward-outliner-ops (or (:db-sync/forward-outliner-ops tx-meta) + (:forward-outliner-ops tx-meta)) + inverse-outliner-ops (or (:db-sync/inverse-outliner-ops tx-meta) + (:inverse-outliner-ops tx-meta))] + (when (and (seq forward-outliner-ops) (seq inverse-outliner-ops)) + {:outliner-op (:outliner-op tx-meta) + :forward-outliner-ops forward-outliner-ops + :inverse-outliner-ops inverse-outliner-ops}))) + +(defn- normalize-tx-data-for-rebase + [tx-data] + (some->> tx-data + (mapv (fn [item] + (if (and (vector? item) (= 5 (count item))) + (let [[op e a v _t] item] + [op e a v]) + item))) + db-normalize/reorder-retract-entity)) + +(defn- expected-history-action-error-reason? + [reason] + (contains? #{:invalid-history-action-ops + :invalid-history-action-tx} + reason)) + +(defn- history-action-error-reason + [error] + (let [message (ex-message error)] + (if (or (= "invalid rebase op" message) + (= "Non-transact outliner ops contain numeric entity ids" message)) + :invalid-history-action-ops + :error))) + +(defn- invalid-rebase-op! + [op data] + (throw (ex-info "invalid rebase op" (assoc data :op op)))) + +(defn- replay-entity-id-value + [db v] + (cond + (number? v) + v + + (uuid? v) + (some-> (d/entity db [:block/uuid v]) :db/id) + + (or (vector? v) (qualified-keyword? v)) + (some-> (d/entity db v) :db/id) + + :else + v)) + +(defn- replay-entity-id-coll + [db ids] + (mapv #(or (replay-entity-id-value db %) %) ids)) + +(defn- rebase-find-existing-left-sibling + [current-db target] + (loop [sibling (ldb/get-left-sibling target)] + (if (nil? sibling) + nil + (if-let [current-sibling (and sibling (d/entity current-db [:block/uuid (:block/uuid sibling)]))] + current-sibling + (recur (ldb/get-left-sibling sibling)))))) + +(defn- rebase-target-ref + [target-id] + (cond + (and (vector? target-id) + (= :block/uuid (first target-id)) + (uuid? (second target-id))) + target-id + + (uuid? target-id) + [:block/uuid target-id] + + (and (map? target-id) (uuid? (:block/uuid target-id))) + [:block/uuid (:block/uuid target-id)] + + :else + target-id)) + +(defn- rebase-resolve-target-and-sibling + [current-db rebase-db-before target-id sibling?] + (let [target-ref (rebase-target-ref target-id) + target (d/entity current-db target-ref) + target-before (when rebase-db-before + (d/entity rebase-db-before target-ref)) + parent-before (when rebase-db-before + (:block/parent (d/entity rebase-db-before target-ref)))] + (cond + target + [target sibling?] + + (and target-before parent-before sibling?) + (if-let [left-sibling (rebase-find-existing-left-sibling current-db target-before)] + [left-sibling true] + (when-let [parent (d/entity current-db [:block/uuid (:block/uuid parent-before)])] + [parent false])) + + :else + nil))) + +(defn- template-parent-ref + [parent] + (cond + (and (vector? parent) (= :block/uuid (first parent))) + parent + + (uuid? parent) + [:block/uuid parent] + + (and (map? parent) (uuid? (:block/uuid parent))) + [:block/uuid (:block/uuid parent)] + + :else + parent)) + +(defn- sanitize-template-block + [current-db rebase-db-before block] + (let [m (into {} block) + block-id (:db/id m) + block-uuid (or (:block/uuid m) + (when (number? block-id) + (or (some-> rebase-db-before (d/entity block-id) :block/uuid) + (some-> (d/entity current-db block-id) :block/uuid))) + (when (and (vector? block-id) + (= :block/uuid (first block-id)) + (uuid? (second block-id))) + (second block-id)))] + (cond-> (-> m + (dissoc :db/id :block/order :block/page :block/tx-id) + (update :block/parent template-parent-ref)) + (uuid? block-uuid) + (assoc :block/uuid block-uuid)))) + +(defn- block-ref? + [v] + (or (number? v) + (and (vector? v) + (= :block/uuid (first v)) + (uuid? (second v))))) + +(defn- block-entity + [db ref] + (when (block-ref? ref) + (d/entity db ref))) + +(defn- block-entity-ref + [entity] + (if-let [block-uuid (:block/uuid entity)] + [:block/uuid block-uuid] + (:db/id entity))) + +(defn- block-descendants + [entity] + (letfn [(collect [block] + (mapcat (fn [child] + (cons child (collect child))) + (sort-by :block/order + (entity-plus/lookup-kv-then-entity block :block/_raw-parent))))] + (collect entity))) + +(defn- retract-entity-op? + [item] + (and (vector? item) + (contains? #{:db/retractEntity :db.fn/retractEntity} (first item)))) + +(defn- expand-block-retracts-to-descendants + [db tx-data] + (let [explicit-retracts (->> tx-data + (keep (fn [item] + (when (and (retract-entity-op? item) + (block-ref? (second item))) + (some-> (block-entity db (second item)) :db/id)))) + set)] + (mapcat + (fn [item] + (if (and (retract-entity-op? item) + (block-ref? (second item)) + (block-entity db (second item))) + (let [root (block-entity db (second item))] + (concat (->> (block-descendants root) + (remove #(contains? explicit-retracts (:db/id %))) + (map (fn [entity] + [:db/retractEntity (block-entity-ref entity)]))) + [item])) + [item])) + tx-data))) + +(defn- ^:large-vars/cleanup-todo replay-canonical-outliner-op! + [conn [op args] rebase-db-before] + (case op + :save-block + (let [[block opts] args + db @conn + block-uuid (:block/uuid block) + block-ent (when block-uuid + (d/entity db [:block/uuid block-uuid])) + block-base (dissoc block :db/id :block/order) + block' (merge block-base + (op-construct/rewrite-block-title-with-retracted-refs db block-base))] + (when (nil? block-ent) + (invalid-rebase-op! op {:args args + :reason :missing-block})) + (outliner-core/save-block! conn block' opts)) + + :insert-blocks + (let [[blocks target-id opts] args + db @conn + [target sibling?] (rebase-resolve-target-and-sibling db rebase-db-before target-id (:sibling? opts))] + (when-not (and target (seq blocks)) + (invalid-rebase-op! op {:args args})) + (outliner-core/insert-blocks! conn + (mapv #(op-construct/rewrite-block-title-with-retracted-refs db %) blocks) + target + (assoc opts :sibling? sibling?))) + + :apply-template + (let [[template-id target-id opts] args + template-id' (replay-entity-id-value @conn template-id) + target-id' (replay-entity-id-value @conn target-id) + [target sibling?] (rebase-resolve-target-and-sibling @conn rebase-db-before target-id' (:sibling? opts))] + (when-not (and template-id' (d/entity @conn template-id') target) + (invalid-rebase-op! op {:args args + :reason :missing-template-or-target-block})) + (let [template-uuid (:block/uuid (d/entity @conn template-id')) + target-uuid (:block/uuid target)] + (when-not (and (uuid? template-uuid) (uuid? target-uuid)) + (invalid-rebase-op! op {:args args + :reason :missing-template-or-target-uuid})) + (let [replace-empty-target? (:replace-empty-target? opts) + template-blocks' (some->> (:template-blocks opts) + (map-indexed + (fn [idx block] + (let [block' (sanitize-template-block @conn rebase-db-before block) + block'' (if (and replace-empty-target? + (zero? idx) + (nil? (:block/uuid block'))) + ;; Keep replace-empty-target replay consistent with + ;; initial apply-template payload where the first + ;; block uuid is the target uuid. + (assoc block' :block/uuid target-uuid) + block')] + (when (:block/uuid block'') + block'')))) + (remove nil?) + seq + vec) + opts' (cond-> (-> opts + (assoc :sibling? sibling?) + (dissoc :template-blocks)) + template-blocks' + (assoc :template-blocks template-blocks'))] + (outliner-op/apply-ops! + conn + [[:apply-template [template-uuid + target-uuid + opts']]] + {:gen-undo-ops? false})))) + + :move-blocks + (let [[ids target-id opts] args + ids' (replay-entity-id-coll @conn ids) + target-id' (replay-entity-id-value @conn target-id) + blocks (keep #(d/entity @conn %) ids') + [target sibling?] (rebase-resolve-target-and-sibling @conn rebase-db-before target-id' (:sibling? opts))] + (when (or (empty? blocks) (nil? target)) + (invalid-rebase-op! op {:args args})) + (when (seq blocks) + (outliner-core/move-blocks! conn blocks target (assoc opts :sibling? sibling?)))) + + :move-blocks-up-down + (let [[ids up?] args + ids' (replay-entity-id-coll @conn ids) + blocks (keep #(d/entity @conn %) ids')] + (when (seq blocks) + (outliner-core/move-blocks-up-down! conn blocks up?))) + + :indent-outdent-blocks + (let [[ids indent? opts] args + ids' (replay-entity-id-coll @conn ids) + blocks (keep #(d/entity @conn %) ids')] + (when (empty? blocks) + (invalid-rebase-op! op {:args args})) + (when (seq blocks) + (outliner-core/indent-outdent-blocks! conn blocks indent? opts))) + + :delete-blocks + (let [[ids opts] args + ids' (replay-entity-id-coll @conn ids) + blocks (keep #(d/entity @conn %) ids')] + ;; Keep delete replay idempotent under concurrent edits where blocks may already + ;; be gone, but still leave a debug breadcrumb for malformed/missing targets. + (when (empty? blocks) + (log/debug :undo-redo/drop-delete-blocks-replay + {:args args})) + (when (seq blocks) + (outliner-core/delete-blocks! conn blocks opts))) + + :create-page + (let [[title opts] args + page-uuid (:uuid opts) + existing-page (or (when (uuid? page-uuid) + (d/entity @conn [:block/uuid page-uuid])) + (ldb/get-page @conn title))] + (if (and existing-page + (not (ldb/recycled? existing-page))) + [(:block/title existing-page) (:block/uuid existing-page)] + (outliner-page/create! conn title opts))) + + :delete-page + (let [[page-uuid opts] args] + (outliner-page/delete! conn page-uuid opts)) + + :upsert-property + (apply outliner-property/upsert-property! conn args) + + :restore-recycled + (let [[root-id] args + root-ref (cond + (and (vector? root-id) + (= :block/uuid (first root-id))) + root-id + + (uuid? root-id) + [:block/uuid root-id] + + :else + root-id) + root (d/entity @conn root-ref) + tx-data (when root + (seq (outliner-recycle/restore-tx-data @conn root)))] + (when-not tx-data + (invalid-rebase-op! op {:args args + :reason :invalid-restore-target})) + (ldb/transact! conn tx-data + {:outliner-op :restore-recycled})) + + :recycle-delete-permanently + (let [[root-id] args + root-ref (cond + (and (vector? root-id) + (= :block/uuid (first root-id))) + root-id + + (uuid? root-id) + [:block/uuid root-id] + + :else + root-id) + root (d/entity @conn root-ref) + tx-data (when root + (seq (outliner-recycle/permanently-delete-tx-data @conn root)))] + ;; Keep replay idempotent under concurrent edits where the recycled root may + ;; already be permanently removed by a preceding tx. + (when (seq tx-data) + (ldb/transact! conn tx-data + {:outliner-op :recycle-delete-permanently}))) + + (let [[tx-data tx-meta] args + tx-data (expand-block-retracts-to-descendants @conn tx-data)] + (when-let [tx-data (seq tx-data)] + (ldb/transact! conn tx-data tx-meta))))) + +(defn ^:large-vars/cleanup-todo apply-history-action! + "The default worker-undo-redo/*apply-history-action! implementation: + replays a recorded entry's forward or inverse outliner ops (undo? + selects which) against the *current* db state, since it may have moved + on since the entry was recorded." + [repo tx-id undo? tx-meta] + (if-let [conn (worker-state/get-datascript-conn repo)] + (if-let [action (or (local-tx-log/get-local-tx-entry repo tx-id) + (inline-history-action tx-meta))] + (if (= :fix (:outliner-op action)) + {:applied? false + :reason :unsupported-history-action + :action action} + (let [{:keys [tx reversed-tx forward-outliner-ops inverse-outliner-ops]} action + ops (->> (if undo? inverse-outliner-ops forward-outliner-ops) + (filter (fn [op-entry] + (and (sequential? op-entry) + (contains? op-construct/semantic-outliner-ops + (first op-entry))))) + seq) + tx-data (-> (if undo? reversed-tx tx) + normalize-tx-data-for-rebase) + ops' (if (seq ops) + ops + [[:transact [tx-data nil]]]) + history-tx-id (let [provided-history-tx-id (:db-sync/tx-id tx-meta)] + (if (and (uuid? provided-history-tx-id) + (not= provided-history-tx-id tx-id)) + provided-history-tx-id + (random-uuid))) + tx-meta' (cond-> {:outliner-op (:outliner-op action) + :local-tx? true + :gen-undo-ops? false + :persist-op? true + :undo? undo? + :redo? (:redo? tx-meta) + :db-sync/tx-id history-tx-id + :db-sync/source-tx-id (or (:db-sync/source-tx-id tx-meta) + tx-id) + :db-sync/forward-outliner-ops (if undo? + (:inverse-outliner-ops action) + (:forward-outliner-ops action)) + :db-sync/inverse-outliner-ops (if undo? + (:forward-outliner-ops action) + (:inverse-outliner-ops action))})] + (if (seq ops') + (try + (when (seq ops) + (op-construct/assert-no-numeric-entity-ids! @conn ops :history-action-ops)) + (ldb/batch-transact-with-temp-conn! + conn + tx-meta' + (fn [conn] + (doseq [op ops'] + (replay-canonical-outliner-op! conn op nil)))) + {:applied? true + :history-tx-id history-tx-id} + (catch :default e + (let [reason (history-action-error-reason e)] + (when-not (expected-history-action-error-reason? reason) + (log/error ::undo-redo-failed e)) + {:applied? false + :reason reason + :action action}))) + {:applied? false :reason :unsupported-history-action + :action action}))) + {:applied? false + :reason :missing-history-action + :tx-id tx-id}) + (let [data {:repo repo :op :apply-history-action}] + (log/error :undo-redo/missing-db data) + (throw (ex-info "missing-db" data))))) diff --git a/src/test/frontend/worker/db_core_test.cljs b/src/test/frontend/worker/db_core_test.cljs index bd13fe7..404181b 100644 --- a/src/test/frontend/worker/db_core_test.cljs +++ b/src/test/frontend/worker/db_core_test.cljs @@ -21,10 +21,8 @@ [frontend.worker.query-dsl :as worker-query-dsl] [frontend.worker.search :as search] [frontend.worker.shared-service :as shared-service] + [frontend.worker.local-tx-log :as local-tx-log] [frontend.worker.state :as worker-state] - [frontend.worker.sync :as db-sync] - [frontend.worker.sync.client-op :as client-op] - [frontend.worker.sync.download :as sync-download] [frontend.worker.undo-redo :as worker-undo-redo] [goog.object :as gobj] [logseq.common.config :as common-config] @@ -51,13 +49,7 @@ (def ^:private expected-db-core-thread-apis (into #{} (concat - [:thread-api/list-db :thread-api/init :thread-api/set-db-sync-config :thread-api/get-db-sync-config :thread-api/get-key-value - :thread-api/db-sync-status :thread-api/db-sync-start :thread-api/db-sync-stop :thread-api/db-sync-update-presence - :thread-api/db-sync-request-asset-download :thread-api/db-sync-grant-graph-access :thread-api/db-sync-ensure-user-rsa-keys - :thread-api/db-sync-list-remote-graphs :thread-api/db-sync-upload-graph :thread-api/db-sync-create-remote-graph - :thread-api/db-sync-stop-upload :thread-api/db-sync-resume-upload :thread-api/db-sync-upload-stopped? - :thread-api/db-sync-get-all-block-conflicts :thread-api/db-sync-clear-block-conflicts - :thread-api/db-sync-download-graph-by-id + [:thread-api/list-db :thread-api/init :thread-api/get-key-value :thread-api/create-or-open-db :thread-api/q :thread-api/datoms :thread-api/pull :thread-api/task-spent-time :thread-api/get-blocks :thread-api/get-block-refs :thread-api/get-block-source :thread-api/get-block-parents :thread-api/set-context :thread-api/transact :thread-api/undo-redo-set-pending-editor-info @@ -66,9 +58,7 @@ :thread-api/build-publishing-html :thread-api/reset-db :thread-api/get-file-content :thread-api/get-all-properties :thread-api/get-date-scheduled-or-deadlines :thread-api/unsafe-unlink-db :thread-api/close-db - :thread-api/db-sync-close-db :thread-api/db-sync-invalidate-search-db :thread-api/db-sync-recreate-lock - :thread-api/db-sync-rehydrate-large-titles :thread-api/db-sync-import-prepare :thread-api/db-sync-import-rows-chunk - :thread-api/db-sync-import-finalize :thread-api/release-access-handles :thread-api/db-exists + :thread-api/release-access-handles :thread-api/db-exists :thread-api/export-db-binary :thread-api/import-file-graph :thread-api/export-client-ops-db-binary :thread-api/backup-db-sqlite :thread-api/import-db-binary :thread-api/search-blocks :thread-api/search-upsert-blocks :thread-api/search-delete-blocks @@ -76,7 +66,7 @@ :thread-api/search-build-pages-indice :thread-api/apply-outliner-ops :thread-api/sync-app-state :thread-api/markdown-mirror-set-enabled :thread-api/markdown-mirror-flush :thread-api/markdown-mirror-regenerate :thread-api/export-get-debug-datoms :thread-api/export-get-all-page->content :thread-api/validate-db - :thread-api/recompute-checksum-diagnostics :thread-api/export-edn :thread-api/import-edn + :thread-api/export-edn :thread-api/import-edn :thread-api/get-fsrs-due-card-block-ids :thread-api/get-view-data :thread-api/get-class-objects :thread-api/validate-block-tag :thread-api/convert-tag-to-page @@ -434,7 +424,6 @@ (platform/set-platform! platform') (p/with-redefs [shared-service/*master-client? (atom true) - db-sync/handle-local-tx! (fn [& _] nil) shared-service/broadcast-to-clients! (fn [& args] (swap! broadcasts conj args)) db-listener/listen-db-changes! @@ -477,17 +466,6 @@ (is false (str error)))) (p/finally done)))) -(deftest db-core-registers-db-sync-thread-apis - (let [api-map @thread-api/*thread-apis] - (is (contains? api-map :thread-api/set-db-sync-config)) - (is (contains? api-map :thread-api/db-sync-start)) - (is (contains? api-map :thread-api/db-sync-stop)) - (is (contains? api-map :thread-api/db-sync-update-presence)) - (is (contains? api-map :thread-api/db-sync-request-asset-download)) - (is (contains? api-map :thread-api/db-sync-grant-graph-access)) - (is (contains? api-map :thread-api/db-sync-ensure-user-rsa-keys)) - (is (contains? api-map :thread-api/db-sync-upload-graph)))) - (deftest resolve-initial-config-falls-back-to-template-config-test (let [resolve-initial-config #'db-core/resolve-initial-config template-config (rc/inline "templates/config.edn")] @@ -532,53 +510,6 @@ (is false (str "expected import to succeed with active pool, got " error)))))))) (p/finally done)))) -(deftest set-db-sync-config-keeps-only-non-auth-fields-test - (let [set-config! (get @thread-api/*thread-apis :thread-api/set-db-sync-config) - get-config (get @thread-api/*thread-apis :thread-api/get-db-sync-config) - state-prev @worker-state/*state - config-prev @worker-state/*db-sync-config] - (try - (reset! worker-state/*state (assoc state-prev - :auth/id-token "existing-id-token" - :auth/oauth-token-url "https://existing.example.com/oauth2/token" - :auth/oauth-domain "existing.example.com" - :auth/oauth-client-id "existing-client-id")) - (set-config! {:ws-url "wss://example.com/sync/%s" - :http-base "https://example.com" - :enabled? true - :auth-token "id-token-from-config" - :oauth-token-url "https://auth.example.com/oauth2/token" - :oauth-domain "auth.example.com" - :oauth-client-id "worker-client-id"}) - (is (= {:ws-url "wss://example.com/sync/%s" - :http-base "https://example.com" - :enabled? true} - @worker-state/*db-sync-config)) - (is (= {:ws-url "wss://example.com/sync/%s" - :http-base "https://example.com" - :enabled? true} - (get-config))) - (is (= "existing-id-token" (:auth/id-token @worker-state/*state))) - (is (= "https://existing.example.com/oauth2/token" - (:auth/oauth-token-url @worker-state/*state))) - (is (= "existing.example.com" (:auth/oauth-domain @worker-state/*state))) - (is (= "existing-client-id" (:auth/oauth-client-id @worker-state/*state))) - (finally - (reset! worker-state/*state state-prev) - (reset! worker-state/*db-sync-config config-prev))))) - -(deftest get-db-sync-config-strips-auth-fields-test - (let [get-config (get @thread-api/*thread-apis :thread-api/get-db-sync-config) - config-prev @worker-state/*db-sync-config] - (try - (reset! worker-state/*db-sync-config {:ws-url "wss://example.com/sync/%s" - :auth-token "leaked-token" - :oauth-client-id "leaked-client"}) - (is (= {:ws-url "wss://example.com/sync/%s"} - (get-config))) - (finally - (reset! worker-state/*db-sync-config config-prev))))) - (deftest init-service-does-not-close-db-when-graph-unchanged (async done (let [service {:status {:ready (p/resolved true)} @@ -605,24 +536,6 @@ (reset! *service old-service) (done)))))))) -(deftest handle-migrate-result-local-txs-enqueues-upgrade-reports-test - (let [conn (d/create-conn db-schema/schema) - migration-tx-report {:tx-data [[:db/add 1 :block/title "Migrated"]] - :db-before @conn - :db-after @conn - :tx-meta {:db-migrate? true}} - handled-reports (atom [])] - (with-redefs [db-sync/handle-local-tx! (fn [repo tx-report] - (swap! handled-reports conj - {:repo repo - :tx-report tx-report}))] - (#'db-core/handle-migrate-result-local-txs! - test-repo - {:upgrade-result-coll [migration-tx-report]}) - (is (= [{:repo test-repo - :tx-report migration-tx-report}] - @handled-reports))))) - (deftest built-in-sync-repair-tx-data-covers-65-26-through-65-28-test (let [tx-data (#'db-core/built-in-sync-repair-tx-data) tx-data-again (#'db-core/built-in-sync-repair-tx-data) @@ -663,12 +576,12 @@ (deftest enqueue-built-in-sync-repair-queues-pending-fix-once-test (let [upserts (atom []) count-adjustments (atom [])] - (with-redefs [client-op/get-local-tx-entry (fn [_repo _tx-id] nil) - client-op/upsert-local-tx-entry! (fn [repo entry] + (with-redefs [local-tx-log/get-local-tx-entry (fn [_repo _tx-id] nil) + local-tx-log/upsert-local-tx-entry! (fn [repo entry] (swap! upserts conj {:repo repo :entry entry}) {:should-inc-pending? true}) - client-op/adjust-pending-local-tx-count! (fn [repo delta] + local-tx-log/adjust-pending-local-tx-count! (fn [repo delta] (swap! count-adjustments conj [repo delta]))] (#'db-core/enqueue-built-in-sync-repair! test-repo) (let [{:keys [repo entry]} (first @upserts)] @@ -683,10 +596,10 @@ (reset! upserts []) (reset! count-adjustments []) - (with-redefs [client-op/get-local-tx-entry (fn [_repo _tx-id] {:tx-id (random-uuid)}) - client-op/upsert-local-tx-entry! (fn [_repo _entry] + (with-redefs [local-tx-log/get-local-tx-entry (fn [_repo _tx-id] {:tx-id (random-uuid)}) + local-tx-log/upsert-local-tx-entry! (fn [_repo _entry] (swap! upserts conj :unexpected)) - client-op/adjust-pending-local-tx-count! (fn [_repo _delta] + local-tx-log/adjust-pending-local-tx-count! (fn [_repo _delta] (swap! count-adjustments conj :unexpected))] (#'db-core/enqueue-built-in-sync-repair! test-repo) (is (empty? @upserts)) @@ -700,12 +613,12 @@ :kv/value true}]) (d/transact! local-conn [{:db/ident :logseq.kv/graph-remote? :kv/value false}]) - (with-redefs [client-op/get-local-tx-entry (fn [_repo _tx-id] nil) - client-op/upsert-local-tx-entry! (fn [repo entry] + (with-redefs [local-tx-log/get-local-tx-entry (fn [_repo _tx-id] nil) + local-tx-log/upsert-local-tx-entry! (fn [repo entry] (swap! upserts conj {:repo repo :entry entry}) {:should-inc-pending? false}) - client-op/adjust-pending-local-tx-count! (fn [_repo _delta] nil)] + local-tx-log/adjust-pending-local-tx-count! (fn [_repo _delta] nil)] (#'db-core/maybe-enqueue-built-in-sync-repair! test-repo remote-conn nil true) (is (= 1 (count @upserts))) @@ -1237,68 +1150,27 @@ (is (= "Alpha" (vector-embedding-title {:title "Alpha"}))))) -(deftest release-access-handles-clears-active-import-state-test +(deftest close-db-closes-all-conns-and-pauses-pool-test (restoring-worker-state (fn [] - (let [release-access-handles! (get @thread-api/*thread-apis :thread-api/release-access-handles) - *import-state @#'sync-download/*import-state - import-state-prev @*import-state - closed (atom []) + (let [closed (atom []) removed-pools (atom []) pause-calls (atom 0)] - (try - (platform/set-platform! (build-test-platform {:remove-vfs! (fn [pool] - (swap! removed-pools conj pool) - (p/resolved nil))})) - (reset! worker-state/*opfs-pools {test-repo #js {:pauseVfs (fn [] (swap! pause-calls inc))}}) - (reset! *import-state {:repo test-repo - :graph-id "graph-1" - :import-id "import-1" - :rows-db #js {:close (fn [] (swap! closed conj :rows-db))} - :rows-pool :rows-pool}) + (platform/set-platform! (build-test-platform {:remove-vfs! (fn [pool] + (swap! removed-pools conj pool) + (p/resolved nil))})) + (reset! worker-state/*sqlite-conns + {test-repo {:db (fake-db {:close-calls closed :close-label :db}) + :search (fake-db {:close-calls closed :close-label :search}) + :client-ops (fake-db {:close-calls closed :close-label :client-ops})}}) + (reset! worker-state/*datascript-conns {test-repo :datascript}) + (reset! worker-state/*client-ops-conns {test-repo :client-ops}) + (reset! worker-state/*opfs-pools {test-repo #js {:pauseVfs (fn [] (swap! pause-calls inc))}}) - (release-access-handles! test-repo) + (db-core/close-db! test-repo) - (is (nil? @*import-state)) - (is (= [:rows-db] @closed)) - (is (= [:rows-pool] @removed-pools)) - (is (= 1 @pause-calls)) - (finally - (reset! *import-state import-state-prev))))))) - -(deftest close-db-clears-active-import-state-test - (restoring-worker-state - (fn [] - (let [*import-state @#'sync-download/*import-state - import-state-prev @*import-state - closed (atom []) - removed-pools (atom []) - pause-calls (atom 0)] - (try - (platform/set-platform! (build-test-platform {:remove-vfs! (fn [pool] - (swap! removed-pools conj pool) - (p/resolved nil))})) - (reset! worker-state/*sqlite-conns - {test-repo {:db (fake-db {:close-calls closed :close-label :db}) - :search (fake-db {:close-calls closed :close-label :search}) - :client-ops (fake-db {:close-calls closed :close-label :client-ops})}}) - (reset! worker-state/*datascript-conns {test-repo :datascript}) - (reset! worker-state/*client-ops-conns {test-repo :client-ops}) - (reset! worker-state/*opfs-pools {test-repo #js {:pauseVfs (fn [] (swap! pause-calls inc))}}) - (reset! *import-state {:repo test-repo - :graph-id "graph-1" - :import-id "import-1" - :rows-db #js {:close (fn [] (swap! closed conj :rows-db))} - :rows-pool :rows-pool}) - - (db-core/close-db! test-repo) - - (is (nil? @*import-state)) - (is (= #{:rows-db :db :search :client-ops} (set @closed))) - (is (= [:rows-pool] @removed-pools)) - (is (= 1 @pause-calls)) - (finally - (reset! *import-state import-state-prev))))))) + (is (= #{:db :search :client-ops} (set @closed))) + (is (= 1 @pause-calls)))))) ;; ---- ->uint8array tests ---- @@ -1612,25 +1484,6 @@ ;; ---- checksum-diagnostics tests ---- -(deftest checksum-diagnostics-returns-local-and-remote - (restoring-worker-state - (fn [] - (let [checksum-diagnostics #'worker-export-handler/checksum-diagnostics] - (with-redefs [client-op/get-local-checksum (fn [_] "local-checksum-123") - db-sync/*repo->latest-remote-checksum (atom {test-repo "remote-checksum-456"})] - (is (= {:local-checksum "local-checksum-123" - :remote-checksum "remote-checksum-456"} - (checksum-diagnostics test-repo)))))))) - -(deftest checksum-diagnostics-handles-missing-remote - (restoring-worker-state - (fn [] - (let [checksum-diagnostics #'worker-export-handler/checksum-diagnostics] - (with-redefs [client-op/get-local-checksum (fn [_] "local-checksum-123") - db-sync/*repo->latest-remote-checksum (atom {})] - (is (= {:local-checksum "local-checksum-123" - :remote-checksum nil} - (checksum-diagnostics test-repo)))))))) ;; ---- get-all-page-titles tests ---- @@ -1687,12 +1540,9 @@ (let [types db-core/broadcast-data-types] (is (set? types)) (is (contains? types "sync-db-changes")) - (is (contains? types "sync-conflicts-updated")) (is (contains? types "notification")) (is (contains? types "log")) - (is (contains? types "add-repo")) - (is (contains? types "rtc-log")) - (is (contains? types "rtc-sync-state")))) + (is (contains? types "add-repo")))) ;; ---- init-core! tests ---- @@ -2314,8 +2164,7 @@ first :block)] (is (contains? hydrated :block.temp/display-properties)) - (is (contains? hydrated :block.temp/task-spent-time)) - (is (contains? hydrated :block.temp/sync-conflicts)))))))) + (is (contains? hydrated :block.temp/task-spent-time)))))))) (deftest get-blocks-includes-render-critical-property-data (restoring-worker-state @@ -2580,9 +2429,7 @@ (reset! worker-state/*datascript-conns {test-repo conn}) (ldb/register-transact-pipeline-fn! worker-pipeline/transact-pipeline) (p/with-redefs - [db-sync/update-local-sync-checksum! (fn [& _] nil) - db-sync/handle-local-tx! (fn [& _] nil) - shared-service/broadcast-to-clients! + [shared-service/broadcast-to-clients! (fn [event payload] (when (= :sync-db-changes event) (swap! renderer-payloads conj payload)))] @@ -3314,42 +3161,6 @@ (is (empty? missing) (str "Missing thread apis: " missing)) (is (empty? non-functions) (str "Non-function thread apis: " non-functions)))) -(deftest db-sync-get-all-block-conflicts-thread-api-is-explicit-and-fail-fast-test - (restoring-worker-state - (fn [] - (let [repo "graph-a" - block-uuid (random-uuid) - conflicts [{:block-uuid block-uuid - :value "remote"}] - api (get @thread-api/*thread-apis - :thread-api/db-sync-get-all-block-conflicts)] - (is (nil? (get @thread-api/*thread-apis - :thread-api/db-sync-get-block-conflicts)) - "Per-block reads must not coexist with graph hydration.") - (is (fn? api) - "The restore path needs one explicit worker API for graph conflict hydration.") - (when (fn? api) - (let [calls (atom [])] - (with-redefs [client-op/get-all-sync-conflicts - (fn [repo'] - (swap! calls conj repo') - {block-uuid conflicts})] - (is (= {(str block-uuid) conflicts} - (api repo)) - "The API returns a graph snapshot keyed for direct renderer-state replacement.")) - (is (= [repo] @calls))) - (with-redefs [client-op/get-all-sync-conflicts (constantly nil)] - (let [error (try - (api repo) - nil - (catch :default error - error))] - (is (instance? js/Error error) - "A missing client-op store must fail instead of looking like an empty graph.") - (is (= {:repo repo - :conflicts nil} - (ex-data error)))))))))) - (deftest worker-export-replaces-block-refs-with-worker-db-test (let [conn (d/create-conn db-schema/schema) page-id -1 @@ -3413,9 +3224,7 @@ (reset! worker-state/*datascript-conns {test-repo dest-conn}) (ldb/register-transact-pipeline-fn! worker-pipeline/transact-pipeline) (try - (with-redefs [db-sync/update-local-sync-checksum! (fn [& _] nil) - db-sync/handle-local-tx! (fn [& _] nil) - shared-service/broadcast-to-clients! + (with-redefs [shared-service/broadcast-to-clients! (fn [event payload] (when (= :sync-db-changes event) (swap! renderer-payloads conj payload)))] diff --git a/src/test/frontend/worker/db_listener_test.cljs b/src/test/frontend/worker/db_listener_test.cljs index d4c62f0..3b0157e 100644 --- a/src/test/frontend/worker/db_listener_test.cljs +++ b/src/test/frontend/worker/db_listener_test.cljs @@ -7,7 +7,6 @@ [frontend.worker.platform :as platform] [frontend.worker.render-delta :as render-delta] [frontend.worker.shared-service :as shared-service] - [frontend.worker.sync :as db-sync] [logseq.db :as ldb] [logseq.db.test.helper :as db-test] [promesa.core :as p])) @@ -78,25 +77,6 @@ (is (= [["repo" nil tx-report {:defer? true}]] @calls)))) -(deftest db-listener-persists-local-tx-before-broadcasting-ui-refresh-test - (let [conn (db-test/create-conn) - calls (atom [])] - (with-redefs [db-sync/update-local-sync-checksum! (fn [& _] nil) - db-sync/handle-local-tx! (fn [& _] - (swap! calls conj :persist-local-tx)) - worker-pipeline/invoke-hooks (fn [_conn tx-report _context] - {:tx-report tx-report}) - render-delta/build (fn [_input] - (swap! calls conj :build-ui-refresh) - {:rev 1}) - shared-service/broadcast-to-clients! (fn [event _payload] - (when (= :sync-db-changes event) - (swap! calls conj :broadcast-ui-refresh)))] - (db-listener/listen-db-changes! "repo" conn :handler-keys [:sync-db-to-main-thread :db-sync]) - (d/transact! conn [{:db/id -1 :block/title "b1"}] {:local-tx? true})) - (is (= [:persist-local-tx :build-ui-refresh :broadcast-ui-refresh] @calls) - "UI refresh work must wait until the local tx has been persisted."))) - (deftest db-listener-builds-one-render-delta-for-origin-and-broadcast-test (let [repo "repo" conn (db-test/create-conn) @@ -115,9 +95,7 @@ post-pipeline-report (atom nil) build-inputs (atom []) broadcast-payloads (atom [])] - (with-redefs [db-sync/update-local-sync-checksum! (fn [& _] nil) - db-sync/handle-local-tx! (fn [& _] nil) - worker-pipeline/invoke-hooks + (with-redefs [worker-pipeline/invoke-hooks (fn [_conn tx-report _context] (let [block-id (some (fn [datom] (when (and (:added datom) @@ -138,7 +116,7 @@ (when (= :sync-db-changes event) (swap! broadcast-payloads conj payload)))] (db-listener/listen-db-changes! repo conn - :handler-keys [:sync-db-to-main-thread :db-sync]) + :handler-keys [:sync-db-to-main-thread]) (d/transact! conn [{:db/id -1 :block/uuid block-uuid @@ -249,9 +227,7 @@ (let [conn (db-test/create-conn) build-inputs (atom []) broadcast-payloads (atom [])] - (with-redefs [db-sync/update-local-sync-checksum! (fn [& _] nil) - db-sync/handle-local-tx! (fn [& _] nil) - worker-pipeline/invoke-hooks + (with-redefs [worker-pipeline/invoke-hooks (fn [_conn tx-report _context] {:tx-report tx-report}) render-delta/build @@ -263,7 +239,7 @@ (when (= :sync-db-changes event) (swap! broadcast-payloads conj payload)))] (db-listener/listen-db-changes! "repo" conn - :handler-keys [:sync-db-to-main-thread :db-sync]) + :handler-keys [:sync-db-to-main-thread]) (d/transact! conn [{:db/id -1 :block/title "downloaded"}] tx-meta)) @@ -287,9 +263,7 @@ (fn [tx-report] (swap! formal-pipeline-calls conj tx-report) (worker-pipeline/transact-pipeline tx-report))) - (with-redefs [db-sync/update-local-sync-checksum! (fn [& _] nil) - db-sync/handle-local-tx! (fn [& _] nil) - markdown-mirror/ (p/with-redefs - [db-sync/update-local-sync-checksum! (fn [& _] nil) - worker-pipeline/invoke-hooks + [worker-pipeline/invoke-hooks (fn [_conn tx-report _context] {:tx-report tx-report}) render-delta/build (constantly {:rev 1}) diff --git a/src/test/frontend/worker/db_sync_sim_test.cljs b/src/test/frontend/worker/db_sync_sim_test.cljs deleted file mode 100644 index 84048c2..0000000 --- a/src/test/frontend/worker/db_sync_sim_test.cljs +++ /dev/null @@ -1,3051 +0,0 @@ -(ns frontend.worker.db-sync-sim-test - (:require [cljs.test :refer [deftest is testing use-fixtures]] - [clojure.data :as data] - [clojure.set :as set] - [clojure.string :as string] - [datascript.core :as d] - [frontend.db.conn :as db-conn] - [frontend.state :as state] - [frontend.test.noise :as test-noise] - [frontend.worker.handler.page :as worker-page] - [frontend.worker.state :as worker-state] - [frontend.worker.sync :as db-sync] - [frontend.worker.sync.apply-txs :as sync-apply] - [frontend.worker.sync.client-op :as client-op] - [frontend.worker.undo-redo :as undo-redo] - [logseq.db :as ldb] - [logseq.db-sync.checksum :as sync-checksum] - [logseq.db.common.normalize :as db-normalize] - [logseq.db.test.helper :as db-test] - [logseq.outliner.core :as outliner-core] - [logseq.outliner.op :as outliner-op] - [promesa.core :as p])) - -(def ^:private repo-a "db-sync-sim-repo-a") -(def ^:private repo-b "db-sync-sim-repo-b") -(def ^:private repo-c "db-sync-sim-repo-c") -(def ^:private base-page-title "Home") -(def ^:private default-seed 1337) - -(use-fixtures :once (test-noise/mute-console-fixture ::db-sync-sim-test)) - -(defn- new-client-ops-db - [] - (let [Database (js/require "better-sqlite3") - db (new Database ":memory:")] - (client-op/ensure-sqlite-schema! db) - db)) - -(defn- env-seed [] - (try - (when (exists? js/process) - (when-let [raw (.. js/process -env -DB_SYNC_SIM_SEED)] - (let [parsed (js/parseInt raw 10)] - (when-not (js/isNaN parsed) parsed)))) - (catch :default _ nil))) - -(defn- make-rng [seed] - (let [state (atom seed)] - (fn [] - (let [next (mod (+ (* 1664525 @state) 1013904223) 4294967296)] - (reset! state next) - (/ next 4294967296))))) - -(defn- rand-int! [rng n] - (int (js/Math.floor (* (rng) n)))) - -(defn- rand-nth! [rng coll] - (when (seq coll) - (nth coll (rand-int! rng (count coll))))) - -(defn- byte->hex [n] - (let [s (.toString n 16)] - (if (= 1 (count s)) - (str "0" s) - s))) - -(defn- rng-uuid [rng] - (let [payload (vec (repeatedly 16 #(rand-int! rng 256))) - payload (-> payload - (assoc 6 (bit-or 0x40 (bit-and (nth payload 6) 0x0f))) - (assoc 8 (bit-or 0x80 (bit-and (nth payload 8) 0x3f)))) - hexes (map byte->hex payload) - uuid-str (str (apply str (take 4 hexes)) "-" - (apply str (take 2 (drop 4 hexes))) "-" - (apply str (take 2 (drop 6 hexes))) "-" - (apply str (take 2 (drop 8 hexes))) "-" - (apply str (drop 10 hexes)))] - (uuid uuid-str))) - -(defn- record-meta! [history meta] - (swap! history conj (assoc meta :type :meta))) - -(defn- report-history! [seed history extra] - (prn :db-sync-sim-repro (cond-> {:seed seed :history @history} - extra (assoc :extra extra)))) - -(defn- install-invalid-tx-repro! - [seed history] - (let [prev @ldb/*transact-invalid-callback - repro (atom nil) - handler (fn [tx-report errors] - (let [payload {:type :invalid-tx - :tx-meta (:tx-meta tx-report) - :tx-data (:tx-data tx-report) - :errors errors}] - (reset! repro payload) - (report-history! seed history payload)))] - (reset! ldb/*transact-invalid-callback handler) - {:repro repro - :restore (fn [] (reset! ldb/*transact-invalid-callback prev))})) - -(declare op-runs assert-synced-attrs! assert-no-invalid-tx! active-block-uuids block-attr-map checksum-entity-map run-ops!) - -(deftest ^:long rng-uuid-deterministic-test - (testing "rng-uuid produces stable sequences for the same seed" - (let [rng-a (make-rng 42) - rng-b (make-rng 42) - rng-c (make-rng 43) - seq-a (repeatedly 3 #(rng-uuid rng-a)) - seq-b (repeatedly 3 #(rng-uuid rng-b)) - seq-c (repeatedly 3 #(rng-uuid rng-c))] - (is (= seq-a seq-b)) - (is (not= seq-a seq-c))))) - -(deftest ^:long invalid-tx-repro-callback-test - (testing "invalid tx callback captures sim repro payload" - (let [seed 7 - history (atom [{:type :op :op :create-page}]) - tx-report {:tx-meta {:db-sync-sim true} - :tx-data [[:db/add 1 :block/title "oops"]]} - errors [{:entity-map {:block/title "oops"} - :errors {:block/page ["missing required key"]}}] - {:keys [repro restore]} (install-invalid-tx-repro! seed history)] - (try - ((deref ldb/*transact-invalid-callback) tx-report errors) - (is (= {:type :invalid-tx - :tx-meta {:db-sync-sim true} - :tx-data [[:db/add 1 :block/title "oops"]] - :errors errors} - @repro)) - (finally - (restore)))))) - -(defn- with-test-repos - [repo->conns f] - (let [worker-db-prev @worker-state/*datascript-conns - ops-prev @worker-state/*client-ops-conns - db-prev @db-conn/conns - apply-history-action-prev @undo-redo/*apply-history-action! - listeners (atom [])] - (reset! worker-state/*datascript-conns (into {} (map (fn [[repo {:keys [conn]}]] - [repo conn]) - repo->conns))) - (reset! db-conn/conns (into {} (map (fn [[repo {:keys [conn]}]] - [repo conn]) - repo->conns))) - (reset! worker-state/*client-ops-conns (into {} (map (fn [[repo {:keys [ops-conn]}]] - [repo ops-conn]) - repo->conns))) - (doseq [[repo _] repo->conns] - (undo-redo/clear-history! repo)) - (reset! undo-redo/*apply-history-action! sync-apply/apply-history-action!) - (doseq [[repo {:keys [conn ops-conn]}] repo->conns] - (when ops-conn - (let [key (keyword "db-sync-sim" repo)] - (d/listen! conn key - (fn [tx-report] - (let [tx-report' (-> tx-report - (assoc-in [:tx-meta :client-id] (:client-id (state/get-state))) - (update-in [:tx-meta :local-tx?] - (fn [local-tx?] - (if (nil? local-tx?) - true - local-tx?))))] - (db-sync/enqueue-local-tx! repo tx-report')))) - (swap! listeners conj [conn key])))) - (try - (f) - (finally - (doseq [[conn key] @listeners] - (d/unlisten! conn key)) - (doseq [[_ {:keys [ops-conn]}] repo->conns] - (when (fn? (some-> ops-conn .-close)) - (.close ops-conn))) - (reset! worker-state/*datascript-conns worker-db-prev) - (reset! worker-state/*client-ops-conns ops-prev) - (reset! db-conn/conns db-prev) - (doseq [[repo _] repo->conns] - (undo-redo/clear-history! repo)) - (reset! undo-redo/*undo-ops {}) - (reset! undo-redo/*redo-ops {}) - (reset! undo-redo/*apply-history-action! apply-history-action-prev))))) - -(defn- make-client [repo] - {:repo repo - :graph-id nil - :asset-queue (atom (p/resolved nil)) - :inflight (atom [])}) - -(defn- page? [ent] - (ldb/page? ent)) - -(defn- ensure-base-page! [conn base-uuid] - (when-not (d/entity @conn [:block/uuid base-uuid]) - (worker-page/create! conn base-page-title :uuid base-uuid))) - -(defn- create-page! [conn title uuid] - ;; (prn :debug :create-page :title title :uuid uuid) - (worker-page/create! conn title :uuid uuid)) - -(defn- delete-page! [conn uuid] - ;; (prn :debug :delete-page :title (:block/title (d/entity @conn [:block/uuid uuid])) :uuid uuid) - (worker-page/delete! conn uuid)) - -(defn- create-block! [conn parent title uuid] - ;; (prn :debug :create-block :parent (:db/id parent) (:block/uuid parent) :parent-title (:block/title parent) :title title :uuid uuid) - (outliner-core/insert-blocks! conn - [{:block/title title - :block/uuid uuid}] - parent - {:sibling? false - :keep-uuid? true})) - -(defn- update-title! [conn uuid new-title] - ;; (prn :debug :update-title uuid :from (:block/title (d/entity @conn [:block/uuid uuid])) :to new-title) - (outliner-core/save-block! conn - {:block/uuid uuid - :block/title new-title})) - -(defn- move-block! [conn block parent] - (let [block (d/entity @conn [:block/uuid (:block/uuid block)]) - parent (d/entity @conn [:block/uuid (:block/uuid parent)])] - (when (and block parent) - ;; (prn :debug :move (:db/id block) (:block/uuid block) (:block/title block) - ;; :to (:db/id parent) (:block/uuid parent) (:block/title parent)) - (outliner-core/move-blocks! conn [block] parent {:sibling? false})))) - -(defn- delete-block! [conn uuid] - (when-let [block (d/entity @conn [:block/uuid uuid])] - ;; (prn :debug :delete-block! (:db/id block) (:block/uuid block) (:block/title block)) - (outliner-core/delete-blocks! conn [block] {}))) - -(defn- block-id->uuid - [db block-id] - (cond - (uuid? block-id) - block-id - - (and (vector? block-id) (= :block/uuid (first block-id))) - (second block-id) - - (number? block-id) - (or (some-> (d/entity db block-id) :block/uuid) - block-id) - - :else - block-id)) - -(defn- property-id->ident - [db property-id] - (cond - (qualified-keyword? property-id) - property-id - - (number? property-id) - (or (some-> (d/entity db property-id) :db/ident) - property-id) - - :else - property-id)) - -(defn- normalize-op-block-ids - [db [op args :as op-entry]] - (let [id (fn [v] (block-id->uuid db v)) - property-id (fn [v] (property-id->ident db v)) - ids (fn [vs] (mapv id vs))] - (case op - :save-block - (let [[block opts] args - block' (cond-> block - (and (map? block) - (uuid? (:db/id block))) - ((fn [m] - (cond-> (dissoc m :db/id) - (nil? (:block/uuid m)) - (assoc :block/uuid (:db/id m))))) - (and (map? block) - (nil? (:block/uuid block)) - (number? (:db/id block))) - (assoc :block/uuid (id (:db/id block))))] - [op [block' opts]]) - - :insert-blocks - [op [(first args) (id (second args)) (nth args 2)]] - - :apply-template - [op [(id (first args)) (id (second args)) (nth args 2)]] - - :delete-blocks - [op [(ids (first args)) (second args)]] - - :move-blocks - [op [(ids (first args)) (id (second args)) (nth args 2)]] - - :move-blocks-up-down - [op [(ids (first args)) (second args)]] - - :indent-outdent-blocks - [op [(ids (first args)) (second args) (nth args 2)]] - - :set-block-property - [op [(id (first args)) (property-id (second args)) (nth args 2)]] - - :remove-block-property - [op [(id (first args)) (property-id (second args))]] - - :delete-property-value - [op [(id (first args)) (property-id (second args)) (nth args 2)]] - - :create-property-text-block - [op [(some-> (first args) id) (property-id (second args)) (nth args 2) (nth args 3)]] - - :batch-set-property - [op [(ids (first args)) (property-id (second args)) (nth args 2) (nth args 3)]] - - :batch-remove-property - [op [(ids (first args)) (property-id (second args))]] - - :batch-delete-property-value - [op [(ids (first args)) (property-id (second args)) (nth args 2)]] - - :class-add-property - [op [(id (first args)) (property-id (second args))]] - - :class-remove-property - [op [(id (first args)) (property-id (second args))]] - - :upsert-property - [op [(some-> (first args) property-id) (second args) (nth args 2)]] - - :upsert-closed-value - [op [(property-id (first args)) (second args)]] - - :delete-closed-value - [op [(property-id (first args)) (id (second args))]] - - :add-existing-values-to-closed-values - [op [(property-id (first args)) (second args)]] - - op-entry))) - -(defn- apply-ops! - [conn ops opts] - (outliner-op/apply-ops! conn - (mapv #(normalize-op-block-ids @conn %) ops) - opts)) - -(defn- existing-entities - [db uuids] - (->> uuids - (keep (fn [uuid] (d/entity db [:block/uuid uuid]))))) - -(defn- existing-blocks - [db uuids] - (->> (existing-entities db uuids) - (remove page?))) - -(defn- make-server [] - (atom {:t 0 - :txs [] - :conn (db-test/create-conn)})) - -(defn- server-pull [server since] - (let [{:keys [txs]} @server] - (->> (filter (fn [{:keys [t]}] (> t since)) txs) - (mapv :tx)))) - -(defn- server-upload! [server t-before tx-entries] - (let [accepted? (atom false)] - (swap! server - (fn [{:keys [t] :as state}] - (if (not= t t-before) - state - (do - (reset! accepted? true) - (reduce - (fn [{:keys [t txs conn] :as state} tx-entry] - (let [tx-data (:tx-data tx-entry) - {:keys [db-before db-after tx-data]} - (try - (ldb/transact! conn tx-data {:op :apply-client-tx}) - (catch :default error - (let [missing-entity-id (some-> (ex-data error) :entity-id) - same-entity-txs - (when missing-entity-id - (->> tx-entries - (keep-indexed - (fn [idx entry] - (let [entry-tx (:tx-data entry) - touches? (some #(or (= missing-entity-id (second %)) - (= missing-entity-id (nth % 3 nil))) - entry-tx)] - (when touches? - {:idx idx - :tx-id (:tx-id entry) - :outliner-op (:outliner-op entry) - :tx-data entry-tx})))) - vec))] - (throw (ex-info "server upload transact failed" - {:type :db-sync-sim/server-upload-transact-failed - :t-before t-before - :server-t t - :missing-entity-id missing-entity-id - :matching-entries same-entity-txs - :tx-entry tx-entry - :tx-data tx-data} - error))))) - normalized-data (->> tx-data - (db-normalize/normalize-tx-data db-after db-before)) - next-t (inc t)] - (assoc state :t next-t :txs (conj txs {:t next-t :tx normalized-data})))) - state - tx-entries))))) - {:accepted? @accepted? - :t (:t @server)})) - -(defn- build-upload-plan [conn pending] - (#'sync-apply/prepare-upload-tx-entries conn pending)) - -(defn- sync-client! [server {:keys [repo conn client online?]}] - (when online? - (let [progress? (atom false) - local-tx (or (client-op/get-local-tx repo) 0) - server-t (:t @server)] - (when (< local-tx server-t) - (let [txs (server-pull server local-tx)] - (#'sync-apply/apply-remote-txs! - repo - client - (mapv (fn [tx-data] - {:tx-data tx-data}) - txs)) - (client-op/update-local-tx repo server-t) - (reset! progress? true))) - (let [pending (#'sync-apply/pending-txs repo) - local-tx' (or (client-op/get-local-tx repo) 0) - server-t' (:t @server)] - (when (and (seq pending) (= local-tx' server-t')) - (let [{:keys [tx-entries drop-tx-ids]} (build-upload-plan conn pending)] - (when (seq drop-tx-ids) - (#'sync-apply/mark-pending-txs-false! repo drop-tx-ids) - (reset! progress? true)) - ;; (prn :debug :upload :repo repo :tx-entries tx-entries) - (if (seq tx-entries) - (let [{:keys [accepted? t]} (server-upload! server local-tx' tx-entries) - tx-ids (mapv :tx-id tx-entries)] - (when accepted? - (#'sync-apply/mark-pending-txs-false! repo tx-ids) - (when (seq tx-ids) - (client-op/update-local-tx repo t) - (reset! progress? true)))) - nil)))) - @progress?))) - -(defn- active-block-uuids - [db] - (->> (d/datoms db :avet :block/uuid) - (keep (fn [datom] - (let [ent (d/entity db (:e datom))] - (when (and ent - (not (ldb/built-in? ent)) - (nil? (:logseq.property/deleted-at ent)) - (or (ldb/page? ent) - (:block/page ent))) - (:v datom))))) - set)) - -(defn- sync-loop! [server clients] - (loop [i 0] - (when (< i 32) - (let [progress? (atom false)] - (doseq [client clients] - (when (sync-client! server client) - (reset! progress? true))) - (when @progress? - (recur (inc i)))))) - (let [conns (keep (fn [c] (when (:online? c) (:conn c))) clients)] - (when (seq conns) - (let [online-clients (filter :online? clients) - client-block-uuids (mapv (fn [c] - (let [uuids (active-block-uuids @(:conn c))] - {:repo (:repo c) - :uuids uuids - :datoms-count (count uuids)})) - online-clients) - server-uuids (active-block-uuids @(get @server :conn)) - server-checksum (sync-checksum/recompute-checksum @(get @server :conn)) - client-sync-states (mapv (fn [c] - {:repo (:repo c) - :pending-count (count (#'sync-apply/pending-txs (:repo c))) - :local-tx (client-op/get-local-tx (:repo c)) - :server-t (:t @server)}) - online-clients) - checksum-states (mapv (fn [c] - {:repo (:repo c) - :checksum (sync-checksum/recompute-checksum @(:conn c))}) - online-clients) - base-uuids (:uuids (first client-block-uuids)) - block-counts (map :datoms-count client-block-uuids) - block-uuid-diffs (mapv (fn [{:keys [repo uuids]}] - {:repo repo - :missing-count (count (set/difference base-uuids uuids)) - :extra-count (count (set/difference uuids base-uuids)) - :missing-sample (->> (set/difference base-uuids uuids) - (take 5) - vec) - :extra-sample (->> (set/difference uuids base-uuids) - (take 5) - vec)}) - client-block-uuids)] - (when-not (= (count (distinct block-counts)) 1) - (throw (ex-info "blocks count not equal after sync" - {:block-counts block-counts - :clients (mapv #(select-keys % [:repo :datoms-count]) client-block-uuids) - :checksums checksum-states - :sync-states client-sync-states - :server {:datoms-count (count server-uuids) - :checksum server-checksum - :missing-from-a (->> (set/difference base-uuids server-uuids) - (take 5) - vec) - :extra-vs-a (->> (set/difference server-uuids base-uuids) - (take 5) - vec)} - :block-uuid-diffs block-uuid-diffs}))) - (when-not (= 1 (count (distinct (conj (map :checksum checksum-states) server-checksum)))) - (let [client-attrs (mapv (fn [c] - {:repo (:repo c) - :attrs (block-attr-map @(:conn c))}) - online-clients) - base-attrs (:attrs (first client-attrs)) - server-attrs (block-attr-map @(get @server :conn)) - attr-diffs (mapv (fn [{:keys [repo attrs]}] - (let [[missing extra] (data/diff base-attrs attrs)] - {:repo repo - :missing-sample (some->> missing (take 5) vec) - :extra-sample (some->> extra (take 5) vec)})) - client-attrs) - [server-missing server-extra] (data/diff base-attrs server-attrs) - client-checksum-maps (mapv (fn [c] - {:repo (:repo c) - :attrs (checksum-entity-map @(:conn c))}) - online-clients) - base-checksum-attrs (:attrs (first client-checksum-maps)) - server-checksum-attrs (checksum-entity-map @(get @server :conn)) - checksum-attr-diffs (mapv (fn [{:keys [repo attrs]}] - (let [[missing extra] (data/diff base-checksum-attrs attrs)] - {:repo repo - :missing-sample (some->> missing (take 5) vec) - :extra-sample (some->> extra (take 5) vec)})) - client-checksum-maps) - [server-checksum-missing server-checksum-extra] (data/diff base-checksum-attrs server-checksum-attrs)] - (throw (ex-info "checksums not equal after sync" - {:checksums checksum-states - :sync-states client-sync-states - :attr-diffs attr-diffs - :checksum-attr-diffs checksum-attr-diffs - :server {:checksum server-checksum - :missing-sample (some->> server-missing (take 5) vec) - :extra-sample (some->> server-extra (take 5) vec) - :checksum-missing-sample (some->> server-checksum-missing (take 5) vec) - :checksum-extra-sample (some->> server-checksum-extra (take 5) vec)}})))))))) - -(defn- sync-until-idle! - [server clients max-rounds] - (loop [i 0] - (if (< i max-rounds) - (let [progress? (atom false)] - (doseq [client clients] - (when (sync-client! server client) - (reset! progress? true))) - (if @progress? - (recur (inc i)) - i)) - i))) - -(deftest ^:long sync-loop-all-offline-no-error-test - (testing "sync-loop tolerates all clients offline" - (let [server (make-server) - conn (db-test/create-conn) - client (make-client repo-a) - clients [{:repo repo-a :conn conn :client client :online? false}]] - (is (nil? (sync-loop! server clients)))))) - -(deftest ^:long two-clients-initial-sync-keeps-shared-base-page-test - (testing "initial sync keeps the shared base page on both clients" - (let [seed (or (env-seed) default-seed) - rng (make-rng seed) - gen-uuid #(rng-uuid rng) - base-uuid (gen-uuid) - conn-a (db-test/create-conn) - conn-b (db-test/create-conn) - ops-a (new-client-ops-db) - ops-b (new-client-ops-db) - client-a (make-client repo-a) - client-b (make-client repo-b) - server (make-server)] - (with-test-repos {repo-a {:conn conn-a :ops-conn ops-a} - repo-b {:conn conn-b :ops-conn ops-b}} - (fn [] - (reset! db-sync/*repo->latest-remote-tx {}) - (doseq [conn [conn-a conn-b]] - (ensure-base-page! conn base-uuid)) - (doseq [repo [repo-a repo-b]] - (client-op/update-local-tx repo 0)) - (let [base-a (d/entity @conn-a [:block/uuid base-uuid]) - parent-uuid (gen-uuid) - child-uuid (gen-uuid) - target-uuid (gen-uuid) - clients [{:repo repo-a :conn conn-a :client client-a :online? true :gen-uuid gen-uuid} - {:repo repo-b :conn conn-b :client client-b :online? true :gen-uuid gen-uuid}]] - (create-block! conn-a base-a "seed-parent" parent-uuid) - (let [parent (d/entity @conn-a [:block/uuid parent-uuid])] - (create-block! conn-a parent "seed-child" child-uuid)) - (create-block! conn-a base-a "" target-uuid) - (sync-until-idle! server clients 64) - (let [base-b (d/entity @conn-b [:block/uuid base-uuid])] - (is (some? base-b)) - (is (ldb/page? base-b)) - (is (nil? (:logseq.property/deleted-at base-b)))))))))) - -(deftest ^:long recycled-entities-are-excluded-from-sim-comparison-test - (testing "deleted blocks are excluded from active sync comparison" - (let [base-uuid (random-uuid) - block-uuid (random-uuid) - conn (db-test/create-conn)] - (ensure-base-page! conn base-uuid) - (let [base-page (d/entity @conn [:block/uuid base-uuid])] - (create-block! conn base-page "to recycle" block-uuid) - (delete-block! conn block-uuid) - (is (not (contains? (active-block-uuids @conn) block-uuid))) - (is (not (contains? (block-attr-map @conn) block-uuid))))))) - -(deftest ^:long uploaded-pending-txs-are-cleared-in-sim-test - (testing "sim upload removes acked pending txs so later rebases don't reverse stale creates" - (let [base-uuid (random-uuid) - block-uuid (random-uuid) - conn (db-test/create-conn) - ops-conn (new-client-ops-db) - client (make-client repo-a) - server (make-server)] - (with-test-repos {repo-a {:conn conn :ops-conn ops-conn}} - (fn [] - (reset! db-sync/*repo->latest-remote-tx {}) - (client-op/update-local-tx repo-a 0) - (ensure-base-page! conn base-uuid) - (let [base-page (d/entity @conn [:block/uuid base-uuid])] - (create-block! conn base-page "synced block" block-uuid) - (is (seq (#'sync-apply/pending-txs repo-a))) - (is (true? (sync-client! server {:repo repo-a - :conn conn - :client client - :online? true}))) - (is (empty? (#'sync-apply/pending-txs repo-a))) - (is (= (:t @server) (client-op/get-local-tx repo-a))) - (is (some? (d/entity @(get @server :conn) [:block/uuid block-uuid]))))))))) - -(defn- db-issues [db] - (let [blocks (->> (d/q '[:find [?e ...] - :where - [?e :block/uuid] - [?e :block/page]] - db) - (map (fn [e] (d/entity db e))))] - (concat - (for [ent blocks - :let [parent (:block/parent ent)] - :when (nil? parent)] - {:type :missing-parent :uuid (:block/uuid ent)}) - (for [ent blocks - :let [page (:block/page ent)] - :when (nil? page)] - {:type :missing-page :uuid (:block/uuid ent)}) - (for [ent blocks - :let [parent (:block/parent ent) - page (:block/page ent) - expected-page (when parent - (if (page? parent) parent (:block/page parent)))] - :when (and parent page expected-page (not= (:block/uuid expected-page) - (:block/uuid page)))] - {:type :page-mismatch :uuid (:block/uuid ent)}) - (for [ent blocks - :when (let [start (:block/uuid ent)] - (loop [current ent - seen #{start} - steps 0] - (cond - (>= steps 200) true - (nil? (:block/parent current)) false - :else (let [next-ent (:block/parent current) - next-uuid (:block/uuid next-ent)] - (if (contains? seen next-uuid) - true - (recur next-ent (conj seen next-uuid) (inc steps)))))))] - {:type :cycle :uuid (:block/uuid ent)})))) - -(defn- block-attr-map [db] - (->> (d/q '[:find [?e ...] - :where - [?e :block/uuid]] - db) - (map (fn [e] - (let [ent (d/entity db e) - parent (:block/parent ent) - page (:block/page ent)] - (when (and ent - (not (ldb/built-in? ent)) - (nil? (:logseq.property/deleted-at ent)) - (or (ldb/page? ent) - page)) - [(:block/uuid ent) - {:block/page? (boolean (ldb/page? ent)) - :block/title (:block/title ent) - :block/order (:block/order ent) - :block/parent (when parent (:block/uuid parent)) - :block/page (when page (:block/uuid page)) - :logseq.property/deleted-at (:logseq.property/deleted-at ent)}])))) - (remove nil?) - (into {}))) - -(defn- checksum-entity-map - [db] - (->> (d/q '[:find [?e ...] - :where - [?e :block/uuid]] - db) - (map (fn [e] - (let [ent (d/entity db e) - parent (:block/parent ent) - page (:block/page ent)] - [(:block/uuid ent) - {:block/title (:block/title ent) - :block/name (:block/name ent) - :block/parent (when parent (:block/uuid parent)) - :block/page (when page (:block/uuid page))}]))) - (into {}))) - -(def ^:private sim-default-property-title "Sim Default Property") -(def ^:private sim-default-property-schema - {:logseq.property/type :default - :db/cardinality :db.cardinality/one}) - -(defn- find-property-by-title - [db title] - (some->> (d/q '[:find [?e ...] - :in $ ?title - :where - [?e :block/title ?title] - [?e :block/tags :logseq.class/Property]] - db title) - first - (d/entity db))) - -(defn- ensure-property! - [conn title schema] - (or (find-property-by-title @conn title) - (do - (apply-ops! - conn - [[:upsert-property [nil schema {:property-name title}]]] - {}) - (find-property-by-title @conn title)))) - -(defn- user-classes - [db] - (->> (d/q '[:find [?e ...] - :where - [?e :block/tags :logseq.class/Tag] - [?e :block/uuid]] - db) - (map (fn [e] (d/entity db e))) - (remove ldb/built-in?))) - -(defn- ensure-class! - [rng conn] - (or (rand-nth! rng (vec (user-classes @conn))) - (let [title (str "Class-" (rand-int! rng 1000000)) - class-uuid (rng-uuid rng)] - (worker-page/create! conn title :uuid class-uuid :class? true) - (d/entity @conn [:block/uuid class-uuid])))) - -(defn- op-create-page! [rng conn state {:keys [gen-uuid]}] - (let [uuid ((or gen-uuid random-uuid)) - title (str "Page-" (rand-int! rng 1000000))] - (create-page! conn title uuid) - (swap! state update :pages conj uuid) - {:op :create-page :uuid uuid :title title})) - -(defn- op-delete-page! [rng conn base-uuid state] - (let [db @conn - pages (->> (existing-entities db (:pages @state)) - (remove #(= (:block/uuid %) base-uuid))) - page (rand-nth! rng (vec pages))] - (when page - (delete-page! conn (:block/uuid page)) - (swap! state update :pages disj (:block/uuid page)) - {:op :delete-page :uuid (:block/uuid page)}))) - -(defn- op-create-block! [rng conn state base-uuid {:keys [gen-uuid]}] - (let [db @conn - pages (concat (existing-entities db (:pages @state)) - (keep (fn [uuid] - (when (= uuid base-uuid) - (d/entity db [:block/uuid uuid]))) - [base-uuid])) - blocks (existing-blocks db (:blocks @state)) - parents (concat pages blocks) - parent (rand-nth! rng (vec parents))] - (when (and parent (:block/uuid parent) - (or (ldb/page? parent) - (:block/page parent))) - (let [parent-uuid (:block/uuid parent) - parent (d/entity db [:block/uuid parent-uuid])] - (when parent - (let [uuid ((or gen-uuid random-uuid))] - (create-block! conn parent "" uuid) - (swap! state update :blocks conj uuid) - {:op :create-block :uuid uuid :parent parent-uuid})))))) - -(defn- ensure-random-block! - [rng conn state base-uuid gen-uuid] - (or (rand-nth! rng (vec (existing-blocks @conn (:blocks @state)))) - (when-let [result (op-create-block! rng conn state base-uuid {:gen-uuid gen-uuid})] - (d/entity @conn [:block/uuid (:uuid result)])))) - -(defn- op-update-title! [rng conn state _base-uuid] - (let [db @conn - ents (existing-entities db (:blocks @state)) - ent (rand-nth! rng (vec ents)) - block (d/entity db [:block/uuid (:block/uuid ent)])] - (when (and block (not (ldb/page? block))) - (let [uuid (:block/uuid block) - new-title (str "title-" (:db/id block))] - (update-title! conn uuid new-title) - {:op :update-title :uuid uuid :title new-title})))) - -(defn- op-save-block! [rng conn state base-uuid] - (when-let [result (op-update-title! rng conn state base-uuid)] - (assoc result :op :save-block))) - -(defn- op-insert-blocks! [rng conn state base-uuid {:keys [gen-uuid]}] - (when-let [result (op-create-block! rng conn state base-uuid {:gen-uuid gen-uuid})] - (assoc result :op :insert-blocks))) - -(defn- op-move-block! [rng conn state base-uuid] - (let [db @conn - block (rand-nth! rng (vec (existing-blocks db (:blocks @state)))) - parents (concat (existing-entities db (:pages @state)) - (existing-blocks db (:blocks @state)) - (keep (fn [uuid] - (when (= uuid base-uuid) - (d/entity db [:block/uuid uuid]))) - [base-uuid])) - parent (rand-nth! rng (vec parents))] - (when (and block parent - (not= (:block/uuid block) (:block/uuid parent))) - (move-block! conn block parent) - {:op :move-block - :uuid (:block/uuid block) - :parent (:block/uuid parent)}))) - -(defn- op-move-blocks! [rng conn state base-uuid] - (when-let [result (op-move-block! rng conn state base-uuid)] - (assoc result :op :move-blocks))) - -(defn- op-move-blocks-up-down! [rng conn state] - (let [db @conn - block (rand-nth! rng (vec (existing-blocks db (:blocks @state)))) - up? (zero? (rand-int! rng 2))] - (when block - (try - (outliner-core/move-blocks-up-down! conn [block] up?) - {:op :move-blocks-up-down - :uuid (:block/uuid block) - :up? up?} - (catch :default _ - nil))))) - -(defn- op-indent-outdent-blocks! [rng conn state] - (let [db @conn - blocks (vec (existing-blocks db (:blocks @state))) - indent? (zero? (rand-int! rng 2)) - candidates (if indent? - ;; Indent requires a left sibling. - (filter (fn [b] - (some? (ldb/get-left-sibling b))) - blocks) - ;; Outdent through outliner-core uses sibling move to parent. - ;; Parent without parent triggers "not-allowed-move-block-page". - ;; Avoid picking top-level page children for this op. - (filter (fn [b] - (let [parent (:block/parent b)] - (and parent (:block/parent parent)))) - blocks)) - block (rand-nth! rng (vec candidates))] - (when block - (try - (outliner-core/indent-outdent-blocks! conn [block] indent? {}) - {:op :indent-outdent-blocks - :uuid (:block/uuid block) - :indent? indent?} - (catch :default _ - nil))))) - -(defn- op-delete-block! [rng conn state] - (let [db @conn - block (rand-nth! rng (vec (existing-blocks db (:blocks @state))))] - (when (and block (d/entity @conn [:block/uuid (:block/uuid block)])) - (delete-block! conn (:block/uuid block)) - (swap! state update :blocks disj (:block/uuid block)) - {:op :delete-block :uuid (:block/uuid block)}))) - -(defn- op-delete-blocks! [rng conn state] - (when-let [result (op-delete-block! rng conn state)] - (assoc result :op :delete-blocks))) - -(defn- op-rename-page! [rng conn state base-uuid] - (let [db @conn - pages (->> (existing-entities db (:pages @state)) - (remove #(= (:block/uuid %) base-uuid))) - page (rand-nth! rng (vec pages))] - (when page - (let [page-uuid (:block/uuid page) - new-title (str "Renamed-" (rand-int! rng 1000000))] - (try - (outliner-core/save-block! conn {:block/uuid page-uuid - :block/title new-title}) - {:op :rename-page - :uuid page-uuid - :title new-title} - (catch :default _ - nil)))))) - -(defn- op-toggle-reaction! [rng conn state] - (let [db @conn - block (rand-nth! rng (vec (existing-blocks db (:blocks @state))))] - (when block - (let [block-uuid (:block/uuid block)] - (try - (apply-ops! conn [[:toggle-reaction [block-uuid "+1" nil]]] {}) - {:op :toggle-reaction - :uuid block-uuid - :emoji "+1"} - (catch :default _ - nil)))))) - -(defn- op-transact! [rng conn state] - (let [db @conn - block (rand-nth! rng (vec (existing-blocks db (:blocks @state))))] - (when block - (let [uuid (:block/uuid block) - new-title (str "tx-title-" (rand-int! rng 1000000))] - (ldb/transact! conn [[:db/add [:block/uuid uuid] :block/title new-title]]) - {:op :transact - :uuid uuid - :title new-title})))) - -(defn- op-upsert-property! [_rng conn] - (let [title sim-default-property-title - schema sim-default-property-schema - existing (find-property-by-title @conn title)] - (apply-ops! - conn - [[:upsert-property [(or (:db/ident existing) nil) - schema - {:property-name title}]]] - {}) - (when-let [property (find-property-by-title @conn title)] - {:op :upsert-property - :property (:db/ident property)}))) - -(defn- pick-settable-property-input - [rng conn property value-prefix] - (let [property (d/entity @conn (:db/id property)) - closed-values (vec (:block/_closed-value-property property))] - (if (seq closed-values) - {:value (:db/id (rand-nth! rng closed-values)) - :options {:entity-id? true}} - {:value (str value-prefix "-" (rand-int! rng 1000000)) - :options {}}))) - -(defn- op-set-block-property! [rng conn state base-uuid gen-uuid] - (when-let [block (ensure-random-block! rng conn state base-uuid gen-uuid)] - (when-let [property (ensure-property! conn sim-default-property-title sim-default-property-schema)] - (let [{:keys [value]} (pick-settable-property-input rng conn property "prop-value")] - (try - (apply-ops! - conn - [[:set-block-property [(:db/id block) (:db/ident property) value]]] - {}) - {:op :set-block-property - :uuid (:block/uuid block) - :property (:db/ident property) - :value value} - (catch :default _ - nil)))))) - -(defn- op-remove-block-property! [rng conn state base-uuid gen-uuid] - (when-let [block (ensure-random-block! rng conn state base-uuid gen-uuid)] - (when-let [property (ensure-property! conn sim-default-property-title sim-default-property-schema)] - (let [{:keys [value]} (pick-settable-property-input rng conn property "remove-prop")] - (try - (apply-ops! - conn - [[:set-block-property [(:db/id block) (:db/ident property) value]]] - {}) - (apply-ops! - conn - [[:remove-block-property [(:db/id block) (:db/ident property)]]] - {}) - {:op :remove-block-property - :uuid (:block/uuid block) - :property (:db/ident property)} - (catch :default _ - nil)))))) - -(defn- create-property-text-block-with-uuid! - [conn property-id value value-uuid] - (apply-ops! - conn - [[:create-property-text-block [nil property-id value {:new-block-id value-uuid}]]] - {}) - (when (d/entity @conn [:block/uuid value-uuid]) - value-uuid)) - -(defn- op-create-property-text-block! [rng conn] - (when-let [property (ensure-property! conn sim-default-property-title sim-default-property-schema)] - (let [value (str "value-block-" (rand-int! rng 1000000))] - (try - (let [value-uuid (create-property-text-block-with-uuid! - conn - (:db/id property) - value - (rng-uuid rng))] - {:op :create-property-text-block - :property (:db/ident property) - :value-uuid value-uuid}) - (catch :default _ - nil))))) - -(defn- op-batch-set-property! [rng conn state base-uuid gen-uuid] - (when-let [property (ensure-property! conn sim-default-property-title sim-default-property-schema)] - (let [blocks (->> (repeatedly 2 #(ensure-random-block! rng conn state base-uuid gen-uuid)) - (remove nil?) - distinct - vec)] - (when (seq blocks) - (let [block-ids (mapv :db/id blocks) - {:keys [value options]} (pick-settable-property-input rng conn property "batch-prop")] - (try - (apply-ops! - conn - [[:batch-set-property [block-ids (:db/ident property) value options]]] - {}) - {:op :batch-set-property - :blocks (mapv :block/uuid blocks) - :property (:db/ident property)} - (catch :default _ - nil))))))) - -(defn- op-batch-remove-property! [rng conn state base-uuid gen-uuid] - (when-let [property (ensure-property! conn sim-default-property-title sim-default-property-schema)] - (let [base-page (d/entity @conn [:block/uuid base-uuid])] - (when base-page - (let [new-block (fn [] - (let [uuid ((or gen-uuid random-uuid)) - title (str "batch-remove-" (rand-int! rng 1000000))] - (create-block! conn base-page title uuid) - (swap! state update :blocks conj uuid) - (d/entity @conn [:block/uuid uuid]))) - blocks (->> (repeatedly 2 new-block) - (remove nil?) - vec)] - (when (seq blocks) - (let [block-ids (mapv :db/id blocks) - {:keys [value options]} (pick-settable-property-input rng conn property "to-remove")] - (try - (apply-ops! - conn - [[:batch-set-property [block-ids (:db/ident property) value options]]] - {}) - (apply-ops! - conn - [[:batch-remove-property [block-ids (:db/ident property)]]] - {}) - {:op :batch-remove-property - :blocks (mapv :block/uuid blocks) - :property (:db/ident property)} - (catch :default _ - nil))))))))) - -(defn- op-class-add-property! [rng conn] - (when-let [class (ensure-class! rng conn)] - (when-let [property (ensure-property! conn sim-default-property-title sim-default-property-schema)] - (try - (apply-ops! - conn - [[:class-add-property [(:db/id class) (:db/ident property)]]] - {}) - {:op :class-add-property - :class (:block/uuid class) - :property (:db/ident property)} - (catch :default _ - nil))))) - -(defn- op-class-remove-property! [rng conn] - (when-let [class (ensure-class! rng conn)] - (when-let [property (ensure-property! conn sim-default-property-title sim-default-property-schema)] - (try - (apply-ops! - conn - [[:class-add-property [(:db/id class) (:db/ident property)]]] - {}) - (apply-ops! - conn - [[:class-remove-property [(:db/id class) (:db/ident property)]]] - {}) - {:op :class-remove-property - :class (:block/uuid class) - :property (:db/ident property)} - (catch :default _ - nil))))) - -(defn- op-upsert-closed-value! [rng conn] - (when-let [property (ensure-property! conn sim-default-property-title sim-default-property-schema)] - (let [value (str "choice-" (rand-int! rng 1000000))] - (try - (apply-ops! - conn - [[:upsert-closed-value [(:db/id property) {:value value}]]] - {}) - {:op :upsert-closed-value - :property (:db/ident property) - :value value} - (catch :default _ - nil))))) - -(defn- op-delete-closed-value! [rng conn] - (when-let [property (ensure-property! conn sim-default-property-title sim-default-property-schema)] - (let [value (str "delete-choice-" (rand-int! rng 1000000))] - (try - (apply-ops! - conn - [[:upsert-closed-value [(:db/id property) {:value value}]]] - {}) - (when-let [value-block (first (:block/_closed-value-property (d/entity @conn (:db/id property))))] - (apply-ops! - conn - [[:delete-closed-value [(:db/id property) (:db/id value-block)]]] - {}) - {:op :delete-closed-value - :property (:db/ident property) - :value-id (:db/id value-block)}) - (catch :default _ - nil))))) - -(defn- op-add-existing-values-to-closed-values! [rng conn] - (when-let [property (ensure-property! conn sim-default-property-title sim-default-property-schema)] - (try - (let [value-a (str "existing-a-" (rand-int! rng 1000000)) - value-b (str "existing-b-" (rand-int! rng 1000000)) - uuid-a (create-property-text-block-with-uuid! - conn - (:db/id property) - value-a - (rng-uuid rng)) - uuid-b (create-property-text-block-with-uuid! - conn - (:db/id property) - value-b - (rng-uuid rng)) - uuids (vec (remove nil? [uuid-a uuid-b]))] - (when (seq uuids) - (apply-ops! - conn - [[:add-existing-values-to-closed-values [(:db/id property) uuids]]] - {}) - {:op :add-existing-values-to-closed-values - :property (:db/ident property) - :uuids uuids})) - (catch :default _ - nil)))) - -(defn- op-delete-property-value! [rng conn state base-uuid gen-uuid] - (when-let [class (ensure-class! rng conn)] - (when-let [block (ensure-random-block! rng conn state base-uuid gen-uuid)] - (try - (apply-ops! - conn - [[:set-block-property [(:db/id block) :block/tags (:db/id class)]]] - {}) - (apply-ops! - conn - [[:delete-property-value [(:db/id block) :block/tags (:db/id class)]]] - {}) - {:op :delete-property-value - :uuid (:block/uuid block) - :class (:block/uuid class)} - (catch :default _ - nil))))) - -(defn- op-batch-delete-property-value! [rng conn state base-uuid gen-uuid] - (when-let [class (ensure-class! rng conn)] - (let [blocks (->> (repeatedly 2 #(ensure-random-block! rng conn state base-uuid gen-uuid)) - (remove nil?) - distinct - vec)] - (when (seq blocks) - (let [block-ids (mapv :db/id blocks)] - (try - (apply-ops! - conn - [[:batch-set-property [block-ids :block/tags (:db/id class) {}]]] - {}) - (apply-ops! - conn - [[:batch-delete-property-value [block-ids :block/tags (:db/id class)]]] - {}) - {:op :batch-delete-property-value - :blocks (mapv :block/uuid blocks) - :class (:block/uuid class)} - (catch :default _ - nil))))))) - -(defn- block-and-descendant-uuids - [db block] - (->> (cons (:db/id block) (ldb/get-block-full-children-ids db (:db/id block))) - (keep (fn [id] - (:block/uuid (d/entity db id)))) - set)) - -(defn- block-tree-preorder - [root] - (letfn [(walk [node] - (cons node - (mapcat walk (ldb/sort-by-order (:block/_parent node)))))] - (walk root))) - -(defn- random-copied-block-tree - [rng source] - (let [nodes (vec (block-tree-preorder source)) - max-size (max 1 (min 12 (count nodes))) - size (+ 1 (rand-int! rng max-size)) - nodes' (subvec nodes 0 size) - uuid-map (into {} - (map (fn [node] - [(:block/uuid node) (rng-uuid rng)]) - nodes')) - copied (mapv (fn [node] - (let [old-uuid (:block/uuid node) - new-uuid (get uuid-map old-uuid) - parent-uuid (some-> node :block/parent :block/uuid)] - (cond-> {:block/uuid new-uuid - :block/title (or (:block/title node) "")} - (contains? uuid-map parent-uuid) - (assoc :block/parent [:block/uuid (get uuid-map parent-uuid)])))) - nodes')] - copied)) - -(defn- op-copy-paste-block-tree-into-empty-target! - [rng conn state _base-uuid] - (let [db @conn - sources (->> (existing-blocks db (:blocks @state)) - (filter (fn [block] - (seq (ldb/sort-by-order (:block/_parent block)))))) - source (rand-nth! rng (vec sources))] - (when source - (let [source-uuid (:block/uuid source) - source-page-uuid (:block/uuid (:block/page source)) - source-descendants (block-and-descendant-uuids db source) - targets (->> (existing-blocks db (:blocks @state)) - (remove (fn [target] - (contains? source-descendants (:block/uuid target)))) - (filter (fn [target] - (and (= source-page-uuid - (:block/uuid (:block/page target))) - (string/blank? (or (:block/title target) "")) - (empty? (:block/_parent target)))))) - target (rand-nth! rng (vec targets))] - (when target - (let [target-uuid (:block/uuid target) - copied-tree (random-copied-block-tree rng source)] - (when (seq copied-tree) - ;; Simulate "copy + paste tree into empty target block" using - ;; replace-empty-target paste semantics. - (apply-ops! - conn - [[:insert-blocks [copied-tree - (:db/id target) - {:sibling? true - :outliner-op :paste - :replace-empty-target? true}]]] - {}) - {:op :copy-paste-block-tree-into-empty-target - :uuid source-uuid - :target target-uuid - :copied-size (count copied-tree)}))))))) - -(defn- op-cut-paste-block-with-child! [rng conn state _base-uuid] - (let [db @conn - sources (->> (existing-blocks db (:blocks @state)) - (filter (fn [block] - (seq (ldb/sort-by-order (:block/_parent block)))))) - source (rand-nth! rng (vec sources))] - (when source - (let [source-uuid (:block/uuid source) - source-page-uuid (:block/uuid (:block/page source)) - source-descendants (block-and-descendant-uuids db source) - targets (->> (existing-blocks db (:blocks @state)) - (remove (fn [target] - (contains? source-descendants (:block/uuid target)))) - (filter (fn [target] - (and (= source-page-uuid - (:block/uuid (:block/page target))) - (string/blank? (or (:block/title target) "")) - (empty? (:block/_parent target)))))) - target (rand-nth! rng (vec targets))] - (when target - (let [target-uuid (:block/uuid target) - direct-children (ldb/sort-by-order (:block/_parent source))] - (when (seq direct-children) - ;; Simulate "cut + paste into empty target block" in a single outliner - ;; transaction to avoid intermediate sync states. - (apply-ops! - conn - [[:move-blocks [[(:db/id source)] (:db/id target) {:sibling? true}]] - [:delete-blocks [[(:db/id target)] {}]]] - {}) - ;; The emptied target is now recycled, so keep it in state; active op - ;; pickers filter recycled entities from the DB directly. - {:op :cut-paste-block-with-child - :uuid source-uuid - :target target-uuid - :children (mapv :block/uuid direct-children)}))))))) - -(defn- op-undo! [_rng repo] - (when repo - (let [result (undo-redo/undo repo)] - (when (not= :frontend.worker.undo-redo/empty-undo-stack result) - {:op :undo})))) - -(defn- op-redo! [_rng repo] - (when repo - (let [result (undo-redo/redo repo)] - (when (not= :frontend.worker.undo-redo/empty-redo-stack result) - {:op :redo})))) - -(def ^:private op-table - [{:name :create-page :weight 6 :f op-create-page!} - {:name :rename-page :weight 2 :f op-rename-page!} - {:name :delete-page :weight 10 :f op-delete-page!} - {:name :save-block :weight 4 :f op-save-block!} - {:name :upsert-property :weight 2 :f op-upsert-property!} - {:name :set-block-property :weight 3 :f op-set-block-property!} - {:name :remove-block-property :weight 2 :f op-remove-block-property!} - {:name :delete-property-value :weight 1 :f op-delete-property-value!} - {:name :create-property-text-block :weight 2 :f op-create-property-text-block!} - {:name :batch-set-property :weight 2 :f op-batch-set-property!} - {:name :batch-remove-property :weight 2 :f op-batch-remove-property!} - {:name :batch-delete-property-value :weight 1 :f op-batch-delete-property-value!} - {:name :class-add-property :weight 1 :f op-class-add-property!} - {:name :class-remove-property :weight 1 :f op-class-remove-property!} - {:name :upsert-closed-value :weight 1 :f op-upsert-closed-value!} - {:name :delete-closed-value :weight 1 :f op-delete-closed-value!} - {:name :add-existing-values-to-closed-values :weight 1 :f op-add-existing-values-to-closed-values!} - {:name :insert-blocks :weight 10 :f op-insert-blocks!} - {:name :delete-blocks :weight 4 :f op-delete-blocks!} - {:name :move-blocks :weight 6 :f op-move-blocks!} - {:name :move-blocks-up-down :weight 3 :f op-move-blocks-up-down!} - {:name :indent-outdent-blocks :weight 3 :f op-indent-outdent-blocks!} - {:name :toggle-reaction :weight 2 :f op-toggle-reaction!} - {:name :transact :weight 3 :f op-transact!} - {:name :undo :weight 10 :f op-undo!} - {:name :redo :weight 10 :f op-redo!} - {:name :create-block :weight 10 :f op-create-block!} - {:name :move-block :weight 6 :f op-move-block!} - {:name :copy-paste-block-tree-into-empty-target :weight 4 :f op-copy-paste-block-tree-into-empty-target!} - {:name :cut-paste-block-with-child :weight 4 :f op-cut-paste-block-with-child!} - {:name :delete-block :weight 4 :f op-delete-block!} - {:name :update-title :weight 8 :f op-update-title!}]) - -(def ^:private required-core-outliner-op-names - #{:save-block - :insert-blocks - :delete-blocks - :move-blocks - :move-blocks-up-down - :indent-outdent-blocks - :upsert-property - :set-block-property - :remove-block-property - :delete-property-value - :create-property-text-block - :batch-set-property - :batch-remove-property - :batch-delete-property-value - :class-add-property - :class-remove-property - :upsert-closed-value - :delete-closed-value - :add-existing-values-to-closed-values - :create-page - :rename-page - :delete-page - :toggle-reaction - :transact}) - -(def ^:private local-undo-redo-run-count 1000) -(def ^:private local-undo-redo-full-cycle-runs 5) -(def ^:private local-undo-redo-coverage-ops - (set/union required-core-outliner-op-names #{:undo :redo})) -(def ^:private local-undo-redo-op-weights - {:create-page 6 - :rename-page 2 - :delete-page 10 - :save-block 4 - :upsert-property 2 - :set-block-property 3 - :remove-block-property 2 - :delete-property-value 1 - :create-property-text-block 2 - :batch-set-property 2 - :batch-remove-property 2 - :batch-delete-property-value 1 - :class-add-property 1 - :class-remove-property 1 - :upsert-closed-value 1 - :delete-closed-value 1 - :add-existing-values-to-closed-values 1 - :insert-blocks 10 - :delete-blocks 4 - :move-blocks 6 - :move-blocks-up-down 3 - :indent-outdent-blocks 10 - :toggle-reaction 2 - :transact 3 - :undo 10 - :redo 10}) - -(def ^:private local-undo-redo-cycle-op-weights - {:create-block 14 - :delete-block 10 - :move-block 8 - :indent-outdent-blocks 3 - :move-blocks-up-down 3 - :update-title 8 - :undo 12 - :redo 12}) - -(defn- build-weighted-op-table - [required-ops op-weights label] - (let [label (name label) - registered-ops (set (map :name op-table)) - configured-ops (set (keys op-weights)) - missing-op-defs (set/difference required-ops registered-ops) - missing-weights (set/difference required-ops configured-ops) - extra-weights (set/difference configured-ops required-ops) - invalid-weights (->> op-weights - (keep (fn [[op-name weight]] - (when (or (not (number? weight)) - (<= weight 0)) - op-name))) - set)] - (when (seq missing-op-defs) - (throw (ex-info (str "missing sim op definitions for weighted " label " op table") - {:label label - :missing-op-defs missing-op-defs}))) - (when (seq missing-weights) - (throw (ex-info (str "missing weighted " label " op weights") - {:label label - :missing-weights missing-weights}))) - (when (seq extra-weights) - (throw (ex-info (str "unexpected weighted " label " op weights") - {:label label - :extra-weights extra-weights}))) - (when (seq invalid-weights) - (throw (ex-info (str "invalid weighted " label " op weights") - {:label label - :invalid-weights invalid-weights}))) - (->> op-table - (filter (fn [item] (contains? required-ops (:name item)))) - (mapv (fn [item] - (assoc item :weight (get op-weights (:name item)))))))) - -(defn- op-count - [history op] - (count (filter #(= op (:op %)) @history))) - -(defn- prime-op-context! - [rng client history op & {:keys [op-table-override]}] - (let [setup-run! (fn [setup-op & {:keys [times] :or {times 1}}] - (dotimes [_ times] - (run-ops! rng - client - 1 - history - {:pick-op-opts {:enable-ops #{setup-op}} - :op-table-override op-table-override - :context {:phase :prime - :target op - :setup-op setup-op}})))] - (case op - (:delete-page :rename-page) - (setup-run! :create-page) - - (:save-block - :delete-blocks - :move-blocks - :toggle-reaction - :transact) - (setup-run! :insert-blocks :times 2) - - (:move-blocks-up-down :indent-outdent-blocks) - (setup-run! :insert-blocks :times 4) - - (:set-block-property - :remove-block-property - :delete-property-value - :create-property-text-block - :batch-set-property - :batch-remove-property - :batch-delete-property-value) - (do - (setup-run! :insert-blocks :times 2) - (setup-run! :upsert-property)) - - (:class-add-property :class-remove-property) - (do - (setup-run! :insert-blocks) - (setup-run! :upsert-property)) - - (:upsert-closed-value :delete-closed-value) - (setup-run! :upsert-property) - - :add-existing-values-to-closed-values - (do - (setup-run! :upsert-property) - (setup-run! :create-property-text-block :times 2)) - - :undo - (setup-run! :insert-blocks :times 2) - - :redo - (do - (setup-run! :insert-blocks :times 2) - (setup-run! :undo)) - - nil))) - -(defn- ensure-op-recorded! - [rng client history op max-attempts & {:keys [op-table-override]}] - (loop [attempt 0] - (let [before (op-count history op)] - (prime-op-context! rng client history op :op-table-override op-table-override) - (run-ops! rng - client - 1 - history - {:pick-op-opts {:enable-ops #{op}} - :op-table-override op-table-override - :context {:phase :ensure-op - :target op - :attempt attempt}}) - (let [after (op-count history op)] - (if (> after before) - true - (if (< attempt max-attempts) - (recur (inc attempt)) - false)))))) - -(defn- pick-op [rng {:keys [disable-ops enable-ops op-table-override]}] - (let [selected-op-table (or op-table-override op-table) - op-table' (cond->> selected-op-table - (seq enable-ops) - (filter (fn [item] (contains? enable-ops (:name item)))) - - (seq disable-ops) - (remove (fn [item] (contains? disable-ops (:name item))))) - op-table' (vec op-table')] - (when (empty? op-table') - (throw (ex-info "No available sim ops after filtering" - {:enable-ops enable-ops - :disable-ops disable-ops}))) - (let [total (reduce + (map :weight op-table')) - target (rand-int! rng total)] - (loop [remaining target - [op & rest-ops] op-table'] - (if (nil? op) - (first op-table') - (let [weight (:weight op)] - (if (< remaining weight) - op - (recur (- remaining weight) rest-ops)))))))) - -(defn- run-ops! - [rng {:keys [repo conn base-uuid state gen-uuid]} steps history & {:keys [pick-op-opts context op-table-override]}] - (dotimes [step steps] - (let [{:keys [f name]} (pick-op rng (assoc (or pick-op-opts {}) :op-table-override op-table-override)) - ;; _ (prn :debug :client (:repo client) :name name) - result (case name - :create-page (f rng conn state {:gen-uuid gen-uuid}) - :rename-page (f rng conn state base-uuid) - :delete-page (f rng conn base-uuid state) - :save-block (f rng conn state base-uuid) - :upsert-property (f rng conn) - :set-block-property (f rng conn state base-uuid gen-uuid) - :remove-block-property (f rng conn state base-uuid gen-uuid) - :delete-property-value (f rng conn state base-uuid gen-uuid) - :create-property-text-block (f rng conn) - :batch-set-property (f rng conn state base-uuid gen-uuid) - :batch-remove-property (f rng conn state base-uuid gen-uuid) - :batch-delete-property-value (f rng conn state base-uuid gen-uuid) - :class-add-property (f rng conn) - :class-remove-property (f rng conn) - :upsert-closed-value (f rng conn) - :delete-closed-value (f rng conn) - :add-existing-values-to-closed-values (f rng conn) - :insert-blocks (f rng conn state base-uuid {:gen-uuid gen-uuid}) - :delete-blocks (f rng conn state) - :move-blocks (f rng conn state base-uuid) - :move-blocks-up-down (f rng conn state) - :indent-outdent-blocks (f rng conn state) - :toggle-reaction (f rng conn state) - :transact (f rng conn state) - :undo (f rng repo) - :redo (f rng repo) - :create-block (f rng conn state base-uuid {:gen-uuid gen-uuid}) - :update-title (f rng conn state base-uuid) - :move-block (f rng conn state base-uuid) - :copy-paste-block-tree-into-empty-target (f rng conn state base-uuid) - :cut-paste-block-with-child (f rng conn state base-uuid) - :delete-block (f rng conn state) - (f rng conn))] - (when result - (swap! history conj (cond-> (assoc result :type :op :step step) - repo (assoc :repo repo) - context (assoc :context context))))))) - -(deftest ^:long two-clients-online-offline-sim-test - (testing "db-sync convergence with online/offline client and random ops" - (prn :debug "run two-clients-online-offline-sim-test") - (let [seed (or (env-seed) default-seed) - rng (make-rng seed) - gen-uuid #(rng-uuid rng) - base-uuid (gen-uuid) - conn-a (db-test/create-conn) - ops-a (new-client-ops-db) - client-a (make-client repo-a) - server (make-server) - history (atom []) - state-a (atom {:pages #{base-uuid} :blocks #{}})] - (with-test-repos {repo-a {:conn conn-a :ops-conn ops-a}} - (fn [] - (let [{:keys [_repro restore]} (install-invalid-tx-repro! seed history)] - (try - (reset! db-sync/*repo->latest-remote-tx {}) - (record-meta! history {:seed seed :base-uuid base-uuid}) - (ensure-base-page! conn-a base-uuid) - (client-op/update-local-tx repo-a 0) - (let [clients [{:repo repo-a :conn conn-a :client client-a :online? true :gen-uuid gen-uuid}]] - (prn :debug :phase-a) - ;; Phase A: online - (dotimes [_ 500] - (let [client (first clients)] - (run-ops! rng (assoc client :base-uuid base-uuid :state state-a) - 1 - history - {:pick-op-opts {:disable-ops #{:undo :redo}} - :context {:phase :phase-a}}) - (sync-loop! server clients))) - - ;; Phase B: offline - (prn :debug :phase-b-offline) - (let [clients-a [{:repo repo-a :conn conn-a :client client-a :online? false}]] - (dotimes [_ 500] - (run-ops! rng {:repo repo-a :conn conn-a :base-uuid base-uuid :state state-a :gen-uuid gen-uuid} - 1 - history - {:pick-op-opts {:disable-ops #{:undo :redo}} - :context {:phase :phase-b-offline}}) - (sync-loop! server clients-a))) - - ;; Phase C: reconnect - (prn :debug :phase-c-reconnect) - (sync-loop! server clients) - - ;; Final sync - (prn :debug :final-sync) - (sync-loop! server clients) - - (let [issues-a (db-issues @conn-a)] - (when (seq issues-a) - (report-history! seed history {:type :db-issues :repo repo-a :issues issues-a})) - (is (empty? issues-a) (str "db A issues seed=" seed " " (pr-str issues-a)))) - - (let [attrs-a (block-attr-map @conn-a)] - (is (seq attrs-a) - (str "db empty seed=" seed " history=" (count @history))))) - (finally - (restore))))))))) - -(deftest ^:long ^:large-vars/cleanup-todo two-clients-offline-concurrent-undo-redo-merge-sim-test - (testing "client B keeps anchor blocks/titles after reconnect while client A does heavy undo/redo" - (let [seed (or (env-seed) default-seed) - rng (make-rng seed) - gen-uuid #(rng-uuid rng) - base-uuid (gen-uuid) - conn-a (db-test/create-conn) - conn-b (db-test/create-conn) - ops-a (new-client-ops-db) - ops-b (new-client-ops-db) - client-a (make-client repo-a) - client-b (make-client repo-b) - server (make-server) - history (atom []) - state-a (atom {:pages #{base-uuid} :blocks #{}}) - state-b (atom {:pages #{base-uuid} :blocks #{}})] - (with-test-repos {repo-a {:conn conn-a :ops-conn ops-a} - repo-b {:conn conn-b :ops-conn ops-b}} - (fn [] - (let [{:keys [repro restore]} (install-invalid-tx-repro! seed history) - listener-a ::checksum-sync-a - listener-b ::checksum-sync-b - update-local-checksum! - (fn [repo conn listener-key] - (d/listen! conn listener-key - (fn [tx-report] - (when-not (:batch-tx? @conn) - (when (seq (:tx-data tx-report)) - (db-sync/update-local-sync-checksum! repo tx-report))))))] - (update-local-checksum! repo-a conn-a listener-a) - (update-local-checksum! repo-b conn-b listener-b) - (try - (reset! db-sync/*repo->latest-remote-tx {}) - (record-meta! history {:seed seed :base-uuid base-uuid}) - (doseq [conn [conn-a conn-b]] - (ensure-base-page! conn base-uuid)) - (doseq [repo [repo-a repo-b]] - (client-op/update-local-tx repo 0)) - (client-op/update-local-checksum repo-a (sync-checksum/recompute-checksum @conn-a)) - (client-op/update-local-checksum repo-b (sync-checksum/recompute-checksum @conn-b)) - - ;; Seed stable anchors (non-empty titles) that A won't touch. - (let [base-a (d/entity @conn-a [:block/uuid base-uuid]) - anchor-uuids (vec - (for [i (range 10)] - (let [u (gen-uuid)] - (create-block! conn-a base-a (str "anchor-" i) u) - u))) - clients-online [{:repo repo-a :conn conn-a :client client-a :online? true :gen-uuid gen-uuid} - {:repo repo-b :conn conn-b :client client-b :online? true :gen-uuid gen-uuid}] - clients-a-only [{:repo repo-a :conn conn-a :client client-a :online? true :gen-uuid gen-uuid} - {:repo repo-b :conn conn-b :client client-b :online? false :gen-uuid gen-uuid}]] - (sync-loop! server clients-online) - - ;; A online: heavy add/remove/cut-paste + undo/redo while B offline. - (let [a-parent (gen-uuid) - a-child (gen-uuid) - a-target (gen-uuid) - base-a (d/entity @conn-a [:block/uuid base-uuid])] - (create-block! conn-a base-a "a-parent" a-parent) - (create-block! conn-a (d/entity @conn-a [:block/uuid a-parent]) "a-child" a-child) - (create-block! conn-a base-a "" a-target) - (swap! state-a update :blocks into #{a-parent a-child a-target})) - - ;; B local workspace (separate from anchors). - (let [b-parent (gen-uuid) - b-child (gen-uuid) - b-target (gen-uuid) - base-b (d/entity @conn-b [:block/uuid base-uuid])] - (create-block! conn-b base-b "b-parent" b-parent) - (create-block! conn-b (d/entity @conn-b [:block/uuid b-parent]) "b-child" b-child) - (create-block! conn-b base-b "" b-target) - (swap! state-b update :blocks into #{b-parent b-child b-target})) - - (dotimes [_ op-runs] - (run-ops! rng {:repo repo-a - :conn conn-a - :base-uuid base-uuid - :state state-a - :gen-uuid gen-uuid} - 1 - history - {:pick-op-opts {:enable-ops #{:undo - :redo - :create-block - :delete-block - :cut-paste-block-with-child}} - :context {:phase :a-online-b-offline}}) - (sync-loop! server clients-a-only)) - - ;; B offline: local edits to anchors + local block ops. - (dotimes [i op-runs] - (when-let [anchor-uuid (rand-nth! rng anchor-uuids)] - (when-let [ent (d/entity @conn-b [:block/uuid anchor-uuid])] - (let [new-title (str "b-local-" i)] - (update-title! conn-b anchor-uuid new-title) - (swap! history conj {:type :op - :op :update-title - :repo repo-b - :uuid anchor-uuid - :title new-title - :step i - :anchor-existed? (some? ent) - :context {:phase :b-offline-local-anchor-edit}})))) - (run-ops! rng {:repo repo-b - :conn conn-b - :base-uuid base-uuid - :state state-b - :gen-uuid gen-uuid} - 1 - history - {:pick-op-opts {:enable-ops #{:undo - :redo - :create-block - :delete-block - :cut-paste-block-with-child}} - :context {:phase :b-offline-local-ops}})) - - ;; Reconnect and merge (large backlogs need many rounds). - (let [rounds (sync-until-idle! server clients-online 300)] - (is (< rounds 300) - (str "sync did not become idle seed=" seed " rounds=" rounds))) - - (let [issues-a (db-issues @conn-a) - issues-b (db-issues @conn-b) - attrs-a (block-attr-map @conn-a) - attrs-b (block-attr-map @conn-b)] - (is (empty? issues-a) (str "db A issues seed=" seed " " (pr-str issues-a))) - (is (empty? issues-b) (str "db B issues seed=" seed " " (pr-str issues-b))) - (assert-synced-attrs! seed history attrs-a attrs-b attrs-b) - (is (= (sync-checksum/recompute-checksum @conn-a) - (client-op/get-local-checksum repo-a))) - (is (= (sync-checksum/recompute-checksum @conn-b) - (client-op/get-local-checksum repo-b))) - (doseq [anchor-uuid anchor-uuids] - (let [ent-a (d/entity @conn-a [:block/uuid anchor-uuid]) - ent-b (d/entity @conn-b [:block/uuid anchor-uuid])] - (is (some? ent-a) (str "anchor missing in A seed=" seed " uuid=" anchor-uuid)) - (is (some? ent-b) (str "anchor missing in B seed=" seed " uuid=" anchor-uuid)) - (is (not (string/blank? (or (:block/title ent-a) ""))) (str "anchor title blank in A seed=" seed " uuid=" anchor-uuid)) - (is (not (string/blank? (or (:block/title ent-b) ""))) (str "anchor title blank in B seed=" seed " uuid=" anchor-uuid)))) - (assert-no-invalid-tx! seed history repro))) - (finally - (d/unlisten! conn-a listener-a) - (d/unlisten! conn-b listener-b) - (restore))))))))) - -(deftest ^:long two-clients-rebase-keeps-local-title-after-reverse-tx-test - (testing "two clients keep local title after reverse tx with newer tx id" - (let [base-uuid (uuid "11111111-1111-1111-1111-111111111111") - block-uuid (uuid "22222222-2222-2222-2222-222222222222") - conn-a (db-test/create-conn) - conn-b (db-test/create-conn) - ops-a (new-client-ops-db) - ops-b (new-client-ops-db) - client-a (make-client repo-a) - client-b (make-client repo-b) - server (make-server)] - (with-test-repos {repo-a {:conn conn-a :ops-conn ops-a} - repo-b {:conn conn-b :ops-conn ops-b}} - (fn [] - (let [listener-a ::checksum-sync-a - listener-b ::checksum-sync-b - update-local-checksum! - (fn [repo conn] - (d/listen! conn (if (= repo repo-a) listener-a listener-b) - (fn [tx-report] - (when-not (:batch-tx? @conn) - (when (seq (:tx-data tx-report)) - (db-sync/update-local-sync-checksum! repo tx-report))))))] - (update-local-checksum! repo-a conn-a) - (update-local-checksum! repo-b conn-b) - (try - (reset! db-sync/*repo->latest-remote-tx {}) - (client-op/update-local-tx repo-a 0) - (client-op/update-local-tx repo-b 0) - (client-op/update-local-checksum repo-a (sync-checksum/recompute-checksum @conn-a)) - (client-op/update-local-checksum repo-b (sync-checksum/recompute-checksum @conn-b)) - (ensure-base-page! conn-a base-uuid) - (let [base (d/entity @conn-a [:block/uuid base-uuid])] - (create-block! conn-a base "before" block-uuid)) - (sync-loop! server [{:repo repo-a :conn conn-a :client client-a :online? true}]) - (sync-loop! server [{:repo repo-b :conn conn-b :client client-b :online? true}]) - (is (= "before" (:block/title (d/entity @conn-b [:block/uuid block-uuid])))) - (update-title! conn-a block-uuid "test") - (is (seq (#'sync-apply/pending-txs repo-a))) - (d/transact! conn-b [[:db/add [:block/uuid block-uuid] :block/updated-at 1710000000000]]) - (sync-loop! server [{:repo repo-b :conn conn-b :client client-b :online? true}]) - (sync-loop! server [{:repo repo-a :conn conn-a :client client-a :online? true}]) - (is (= "test" (:block/title (d/entity @conn-a [:block/uuid block-uuid])))) - (is (= (sync-checksum/recompute-checksum @conn-a) - (client-op/get-local-checksum repo-a))) - (is (= (sync-checksum/recompute-checksum @conn-b) - (client-op/get-local-checksum repo-b))) - (finally - (d/unlisten! conn-a listener-a) - (d/unlisten! conn-b listener-b))))))))) - -(deftest ^:long undo-redo-indent-sequence-does-not-produce-invalid-entity-test - (testing "undo/redo of add-1 add-2 indent-2 should remain valid after another undo" - (let [seed 20260321 - base-uuid (uuid "61111111-1111-1111-1111-111111111111") - block-1-uuid (uuid "62222222-2222-2222-2222-222222222222") - block-2-uuid (uuid "63333333-3333-3333-3333-333333333333") - conn-a (db-test/create-conn-with-blocks - {:pages-and-blocks [{:page {:block/title base-page-title - :block/uuid base-uuid} - :blocks []}]}) - ops-a (new-client-ops-db) - history (atom [])] - (with-test-repos {repo-a {:conn conn-a :ops-conn ops-a}} - (fn [] - (let [{:keys [repro restore]} (install-invalid-tx-repro! seed history)] - (try - (reset! db-sync/*repo->latest-remote-tx {}) - (client-op/update-local-tx repo-a 0) - (let [base-page (d/entity @conn-a [:block/uuid base-uuid]) - tx-meta {:client-id "db-sync-sim-client" - :local-tx? true}] - (apply-ops! conn-a - [[:insert-blocks [[{:block/uuid block-1-uuid - :block/title ""}] - (:db/id base-page) - {:sibling? false - :keep-uuid? true}]]] - tx-meta) - (apply-ops! conn-a - [[:save-block [{:block/uuid block-1-uuid - :block/title "1"} - nil]]] - tx-meta) - (let [block-1 (d/entity @conn-a [:block/uuid block-1-uuid])] - (apply-ops! conn-a - [[:insert-blocks [[{:block/uuid block-2-uuid - :block/title ""}] - (:db/id block-1) - {:sibling? true - :keep-uuid? true}]]] - tx-meta)) - (apply-ops! conn-a - [[:save-block [{:block/uuid block-2-uuid - :block/title "2"} - nil]]] - tx-meta) - (let [block-2 (d/entity @conn-a [:block/uuid block-2-uuid])] - (apply-ops! conn-a - [[:indent-outdent-blocks [[(:db/id block-2)] true {}]]] - tx-meta)) - (loop [undo-count 0] - (if (= :frontend.worker.undo-redo/empty-undo-stack - (undo-redo/undo repo-a)) - (do - (is (pos? undo-count)) - (loop [redo-count 0] - (if (= :frontend.worker.undo-redo/empty-redo-stack - (undo-redo/redo repo-a)) - (is (= undo-count redo-count)) - (recur (inc redo-count))))) - (recur (inc undo-count)))) - (let [block-2-after-redo (d/entity @conn-a [:block/uuid block-2-uuid])] - (is (some? block-2-after-redo)) - (is (= block-1-uuid - (-> block-2-after-redo :block/parent :block/uuid)))) - (is (not= :frontend.worker.undo-redo/empty-undo-stack - (undo-redo/undo repo-a))) - (let [block-2 (d/entity @conn-a [:block/uuid block-2-uuid])] - (is (some? block-2)) - (is (= base-uuid (-> block-2 :block/page :block/uuid))) - (is (= base-uuid (-> block-2 :block/parent :block/uuid)))) - (is (nil? @repro) - (str "unexpected invalid tx payload: " (pr-str @repro)))) - (finally - (restore))))))))) - -(deftest ^:long two-clients-undo-skips-conflicted-move-but-keeps-db-valid-test - (testing "undo skips a conflicted move while syncing the remaining safe history" - (let [base-uuid (uuid "31111111-1111-1111-1111-111111111111") - parent-a-uuid (uuid "32222222-2222-2222-2222-222222222222") - parent-b-uuid (uuid "33333333-3333-3333-3333-333333333333") - child-uuid (uuid "34444444-4444-4444-4444-444444444444") - conn-a (db-test/create-conn) - conn-b (db-test/create-conn) - ops-a (new-client-ops-db) - ops-b (new-client-ops-db) - client-a (make-client repo-a) - client-b (make-client repo-b) - server (make-server) - seed 20260311 - history (atom [])] - (with-test-repos {repo-a {:conn conn-a :ops-conn ops-a} - repo-b {:conn conn-b :ops-conn ops-b}} - (fn [] - (let [{:keys [repro restore]} (install-invalid-tx-repro! seed history)] - (try - (reset! db-sync/*repo->latest-remote-tx {}) - (client-op/update-local-tx repo-a 0) - (client-op/update-local-tx repo-b 0) - (ensure-base-page! conn-a base-uuid) - (let [base-a (d/entity @conn-a [:block/uuid base-uuid])] - (create-block! conn-a base-a "parent-a" parent-a-uuid) - (create-block! conn-a base-a "parent-b" parent-b-uuid) - (let [parent-a (d/entity @conn-a [:block/uuid parent-a-uuid])] - (create-block! conn-a parent-a "seed-child" child-uuid))) - (sync-until-idle! server [{:repo repo-a :conn conn-a :client client-a :online? true} - {:repo repo-b :conn conn-b :client client-b :online? true}] - 20) - - (update-title! conn-a child-uuid "local-title") - (move-block! conn-a - {:block/uuid child-uuid} - {:block/uuid parent-b-uuid}) - (sync-until-idle! server [{:repo repo-a :conn conn-a :client client-a :online? true} - {:repo repo-b :conn conn-b :client client-b :online? true}] - 50) - - (delete-block! conn-b parent-a-uuid) - (sync-until-idle! server [{:repo repo-a :conn conn-a :client client-a :online? true} - {:repo repo-b :conn conn-b :client client-b :online? true}] - 50) - - (is (not= :frontend.worker.undo-redo/empty-undo-stack - (undo-redo/undo repo-a))) - - (let [rounds (sync-until-idle! server [{:repo repo-a :conn conn-a :client client-a :online? true} - {:repo repo-b :conn conn-b :client client-b :online? true}] - 50) - child-a (d/entity @conn-a [:block/uuid child-uuid]) - child-b (d/entity @conn-b [:block/uuid child-uuid]) - attrs-a (block-attr-map @conn-a) - attrs-b (block-attr-map @conn-b) - issues-a (db-issues @conn-a) - issues-b (db-issues @conn-b)] - (is (< rounds 50) (str "sync did not become idle rounds=" rounds)) - (is (= "seed-child" (:block/title child-a))) - (is (= "seed-child" (:block/title child-b))) - (is (= parent-b-uuid - (:block/uuid (:block/parent child-a)))) - (is (= parent-b-uuid - (:block/uuid (:block/parent child-b)))) - (is (empty? issues-a) (str "db A issues " (pr-str issues-a))) - (is (empty? issues-b) (str "db B issues " (pr-str issues-b))) - (assert-synced-attrs! seed history attrs-a attrs-b attrs-b) - (assert-no-invalid-tx! seed history repro)) - (finally - (restore))))))))) - -(deftest ^:long two-clients-syncs-undo-of-new-block-test - (testing "undoing a newly created block syncs the retractEntity to other clients" - (let [base-uuid (uuid "51111111-1111-1111-1111-111111111111") - block-uuid (uuid "52222222-2222-2222-2222-222222222222") - conn-a (db-test/create-conn) - conn-b (db-test/create-conn) - ops-a (new-client-ops-db) - ops-b (new-client-ops-db) - client-a (make-client repo-a) - client-b (make-client repo-b) - server (make-server)] - (with-test-repos {repo-a {:conn conn-a :ops-conn ops-a} - repo-b {:conn conn-b :ops-conn ops-b}} - (fn [] - (reset! db-sync/*repo->latest-remote-tx {}) - (doseq [repo [repo-a repo-b]] - (client-op/update-local-tx repo 0)) - (ensure-base-page! conn-a base-uuid) - (sync-loop! server [{:repo repo-a :conn conn-a :client client-a :online? true} - {:repo repo-b :conn conn-b :client client-b :online? true}]) - (let [base-a (d/entity @conn-a [:block/uuid base-uuid])] - (create-block! conn-a base-a "temp" block-uuid)) - (sync-loop! server [{:repo repo-a :conn conn-a :client client-a :online? true} - {:repo repo-b :conn conn-b :client client-b :online? true}]) - (is (some? (d/entity @conn-a [:block/uuid block-uuid]))) - (is (some? (d/entity @conn-b [:block/uuid block-uuid]))) - (is (not= :frontend.worker.undo-redo/empty-undo-stack - (undo-redo/undo repo-a))) - (let [pending (#'sync-apply/pending-txs repo-a) - retract-block? (fn [item] - (= [:db/retractEntity [:block/uuid block-uuid]] - (take 2 item)))] - (is (seq pending)) - (is (some (fn [{:keys [tx]}] - (some retract-block? tx)) - pending))) - (sync-loop! server [{:repo repo-a :conn conn-a :client client-a :online? true} - {:repo repo-b :conn conn-b :client client-b :online? true}]) - (is (nil? (d/entity @conn-a [:block/uuid block-uuid]))) - (is (nil? (d/entity @conn-b [:block/uuid block-uuid]))) - (is (nil? (d/entity @(get @server :conn) [:block/uuid block-uuid])))))))) - -(defonce op-runs 200) - -(defn- undo-all! - [repo max-steps] - (loop [steps 0] - (when (>= steps max-steps) - (throw (ex-info "undo-all exceeded max steps" - {:repo repo - :max-steps max-steps}))) - (let [result (undo-redo/undo repo)] - (if (= :frontend.worker.undo-redo/empty-undo-stack result) - steps - (recur (inc steps)))))) - -(defn- redo-all! - [repo max-steps] - (loop [steps 0] - (when (>= steps max-steps) - (throw (ex-info "redo-all exceeded max steps" - {:repo repo - :max-steps max-steps}))) - (let [result (undo-redo/redo repo)] - (if (= :frontend.worker.undo-redo/empty-redo-stack result) - steps - (recur (inc steps)))))) - -(deftest ^:long two-clients-offline-insert-delete-indent-undo-redo-keeps-checksum-cache-aligned-test - (testing "both clients offline insert/delete/indent/outdent + undo-all/redo-all keep cached checksums aligned after reconnect" - (let [seed (or (env-seed) default-seed) - rng (make-rng seed) - gen-uuid #(rng-uuid rng) - base-uuid (gen-uuid) - conn-a (db-test/create-conn) - conn-b (db-test/create-conn) - ops-a (new-client-ops-db) - ops-b (new-client-ops-db) - client-a (make-client repo-a) - client-b (make-client repo-b) - server (make-server)] - (with-test-repos {repo-a {:conn conn-a :ops-conn ops-a} - repo-b {:conn conn-b :ops-conn ops-b}} - (fn [] - (let [listener-a ::checksum-sync-a - listener-b ::checksum-sync-b - update-local-checksum! - (fn [repo conn listener-key] - (d/listen! conn listener-key - (fn [tx-report] - (when-not (:batch-tx? @conn) - (when (seq (:tx-data tx-report)) - (db-sync/update-local-sync-checksum! repo tx-report))))) - nil) - run-offline-seq! - (fn [repo conn label-prefix] - (let [base (d/entity @conn [:block/uuid base-uuid]) - p1 (gen-uuid) - child (gen-uuid) - temp (gen-uuid)] - (create-block! conn base (str label-prefix "-p1") p1) - (create-block! conn (d/entity @conn [:block/uuid p1]) (str label-prefix "-child") child) - (outliner-core/indent-outdent-blocks! conn [(d/entity @conn [:block/uuid child])] false {}) - (outliner-core/indent-outdent-blocks! conn [(d/entity @conn [:block/uuid child])] true {}) - (create-block! conn base (str label-prefix "-temp") temp) - (delete-block! conn temp) - (undo-all! repo 256) - (redo-all! repo 256)))] - (update-local-checksum! repo-a conn-a listener-a) - (update-local-checksum! repo-b conn-b listener-b) - (try - (reset! db-sync/*repo->latest-remote-tx {}) - (doseq [repo [repo-a repo-b]] - (client-op/update-local-tx repo 0)) - (ensure-base-page! conn-a base-uuid) - (sync-loop! server [{:repo repo-a :conn conn-a :client client-a :online? true} - {:repo repo-b :conn conn-b :client client-b :online? true}]) - (client-op/update-local-checksum repo-a (sync-checksum/recompute-checksum @conn-a)) - (client-op/update-local-checksum repo-b (sync-checksum/recompute-checksum @conn-b)) - - (run-offline-seq! repo-a conn-a "a") - (run-offline-seq! repo-b conn-b "b") - - (let [rounds (sync-until-idle! server [{:repo repo-a :conn conn-a :client client-a :online? true} - {:repo repo-b :conn conn-b :client client-b :online? true}] - 300)] - (is (< rounds 300))) - - (let [checksum-a (sync-checksum/recompute-checksum @conn-a) - checksum-b (sync-checksum/recompute-checksum @conn-b) - cached-a (client-op/get-local-checksum repo-a) - cached-b (client-op/get-local-checksum repo-b)] - (is (= checksum-a checksum-b)) - (is (= checksum-a cached-a)) - (is (= checksum-b cached-b))) - (finally - (d/unlisten! conn-a listener-a) - (d/unlisten! conn-b listener-b))))))))) - -(deftest ^:long two-clients-empty-child-undo-redo-reconnect-keeps-checksum-cache-aligned-test - (testing "A online add empty child; B offline add empty child + undo/redo; reconnect keeps checksum cache aligned" - (let [base-uuid (uuid "81111111-1111-1111-1111-111111111111") - root-uuid (uuid "82222222-2222-2222-2222-222222222222") - child-a-uuid (uuid "83333333-3333-3333-3333-333333333333") - child-b-uuid (uuid "84444444-4444-4444-4444-444444444444") - conn-a (db-test/create-conn) - conn-b (db-test/create-conn) - ops-a (new-client-ops-db) - ops-b (new-client-ops-db) - client-a (make-client repo-a) - client-b (make-client repo-b) - server (make-server)] - (with-test-repos {repo-a {:conn conn-a :ops-conn ops-a} - repo-b {:conn conn-b :ops-conn ops-b}} - (fn [] - (let [listener-a ::checksum-sync-a - listener-b ::checksum-sync-b - update-local-checksum! - (fn [repo conn listener-key] - (d/listen! conn listener-key - (fn [tx-report] - (when-not (:batch-tx? @conn) - (when (seq (:tx-data tx-report)) - (db-sync/update-local-sync-checksum! repo tx-report))))) - nil)] - (update-local-checksum! repo-a conn-a listener-a) - (update-local-checksum! repo-b conn-b listener-b) - (try - (reset! db-sync/*repo->latest-remote-tx {}) - (doseq [repo [repo-a repo-b]] - (client-op/update-local-tx repo 0)) - - ;; Both clients start with one shared block. - (ensure-base-page! conn-a base-uuid) - (let [base-a (d/entity @conn-a [:block/uuid base-uuid])] - (create-block! conn-a base-a "1" root-uuid)) - - (sync-until-idle! server [{:repo repo-a :conn conn-a :client client-a :online? true} - {:repo repo-b :conn conn-b :client client-b :online? true}] - 128) - (client-op/update-local-checksum repo-a (sync-checksum/recompute-checksum @conn-a)) - (client-op/update-local-checksum repo-b (sync-checksum/recompute-checksum @conn-b)) - - ;; A stays online and adds an empty child under block 1. - (create-block! conn-a (d/entity @conn-a [:block/uuid root-uuid]) "" child-a-uuid) - (sync-until-idle! server [{:repo repo-a :conn conn-a :client client-a :online? true} - {:repo repo-b :conn conn-b :client client-b :online? false}] - 128) - - ;; B offline adds an empty child under block 1, then undo + redo. - (create-block! conn-b (d/entity @conn-b [:block/uuid root-uuid]) "" child-b-uuid) - (is (not= :frontend.worker.undo-redo/empty-undo-stack - (undo-redo/undo repo-b))) - (is (not= :frontend.worker.undo-redo/empty-redo-stack - (undo-redo/redo repo-b))) - - ;; B reconnects. - (let [rounds (sync-until-idle! server [{:repo repo-a :conn conn-a :client client-a :online? true} - {:repo repo-b :conn conn-b :client client-b :online? true}] - 300)] - (is (< rounds 300))) - - (let [checksum-a (sync-checksum/recompute-checksum @conn-a) - checksum-b (sync-checksum/recompute-checksum @conn-b) - checksum-server (sync-checksum/recompute-checksum @(get @server :conn)) - cached-a (client-op/get-local-checksum repo-a) - cached-b (client-op/get-local-checksum repo-b)] - (is (= checksum-a checksum-b)) - (is (= checksum-a checksum-server)) - (is (= checksum-a cached-a)) - (is (= checksum-b cached-b))) - (finally - (d/unlisten! conn-a listener-a) - (d/unlisten! conn-b listener-b))))))))) - -(deftest ^:long ^:large-vars/cleanup-todo all-core-outliner-ops-local-undo-redo-random-sim-test - (testing "local randomized stress simulation runs weighted ops and keeps undo-all/redo-all roundtrips valid" - (let [seed (or (env-seed) default-seed) - rng (make-rng seed) - gen-uuid #(rng-uuid rng) - coverage-ops local-undo-redo-coverage-ops - coverage-op-table (build-weighted-op-table coverage-ops local-undo-redo-op-weights :coverage) - cycle-ops (set (keys local-undo-redo-cycle-op-weights)) - cycle-op-table (build-weighted-op-table cycle-ops local-undo-redo-cycle-op-weights :cycle) - base-uuid (gen-uuid) - conn (db-test/create-conn) - ops-conn (new-client-ops-db) - history (atom []) - state (atom {:pages #{base-uuid} :blocks #{}}) - client-context {:repo repo-a - :conn conn - :base-uuid base-uuid - :state state - :gen-uuid gen-uuid}] - (with-test-repos {repo-a {:conn conn :ops-conn ops-conn}} - (fn [] - (let [{:keys [repro restore]} (install-invalid-tx-repro! seed history)] - (try - (reset! db-sync/*repo->latest-remote-tx {}) - (record-meta! history {:seed seed - :base-uuid base-uuid - :phase :local-undo-redo-stress - :run-count local-undo-redo-run-count - :full-cycle-runs local-undo-redo-full-cycle-runs}) - (ensure-base-page! conn base-uuid) - (client-op/update-local-tx repo-a 0) - - ;; Random warmup to provide realistic, non-trivial local history. - (run-ops! rng client-context 50 history - {:pick-op-opts {:enable-ops coverage-ops - :disable-ops #{:undo :redo}} - :op-table-override coverage-op-table - :context {:phase :warmup}}) - - ;; Guarantee every required op is actually exercised at least once. - (doseq [op (sort coverage-ops)] - (let [executed? (or (pos? (op-count history op)) - (ensure-op-recorded! rng - client-context - history - op - 120 - :op-table-override coverage-op-table))] - (is executed? - (str "failed to execute op=" op " seed=" seed)))) - - ;; Keep all-core coverage checks separate from full undo-all/redo-all cycles. - (let [issues (db-issues @conn)] - (is (empty? issues) - (str "db issues before cycle stress seed=" seed " " (pr-str issues)))) - (assert-no-invalid-tx! seed history repro) - (undo-redo/clear-history! repo-a) - - ;; Long weighted random stress run on undo-safe operation families. - (run-ops! rng client-context local-undo-redo-run-count history - {:pick-op-opts {:enable-ops cycle-ops} - :op-table-override cycle-op-table - :context {:phase :cycle-stress}}) - - ;; Ensure at least one concrete undoable change before undo-all cycles. - (is (ensure-op-recorded! rng - client-context - history - :create-block - 120 - :op-table-override cycle-op-table) - (str "failed to prepare undo stack seed=" seed)) - - (let [max-stack-steps (+ (* 2 local-undo-redo-run-count) 5000)] - (dotimes [cycle-idx local-undo-redo-full-cycle-runs] - (let [undo-steps (undo-all! repo-a max-stack-steps) - issues-after-undo (db-issues @conn)] - (is (pos? undo-steps) - (str "expected undo steps cycle=" cycle-idx " seed=" seed)) - (is (empty? issues-after-undo) - (str "db issues after undo-all cycle=" cycle-idx " seed=" seed - " " (pr-str issues-after-undo))) - (assert-no-invalid-tx! seed history repro) - (let [redo-steps (redo-all! repo-a max-stack-steps) - issues-after-redo (db-issues @conn) - attrs-after-redo (block-attr-map @conn)] - (is (pos? redo-steps) - (str "expected redo steps cycle=" cycle-idx " seed=" seed)) - (is (empty? issues-after-redo) - (str "db issues after redo-all cycle=" cycle-idx " seed=" seed - " " (pr-str issues-after-redo))) - (is (seq attrs-after-redo) - (str "db should not be empty after redo-all cycle=" cycle-idx - " seed=" seed)) - (assert-no-invalid-tx! seed history repro))))) - - (let [issues (db-issues @conn)] - (is (empty? issues) - (str "db issues seed=" seed " " (pr-str issues)))) - (assert-no-invalid-tx! seed history repro) - (finally - (restore))))))))) - -(defn- run-random-ops! - [rng server clients repo->state base-uuid history run-ops-opts steps] - (dotimes [_ steps] - (let [client (rand-nth! rng clients) - state (get repo->state (:repo client))] - (run-ops! rng (assoc client :base-uuid base-uuid :state state) 1 history run-ops-opts) - (sync-loop! server clients)))) - -(defn- run-local-ops! - [rng conn base-uuid state history run-ops-opts steps gen-uuid] - (dotimes [_ steps] - (run-ops! rng {:conn conn :base-uuid base-uuid :state state :gen-uuid gen-uuid} 1 history run-ops-opts))) - -(defn- assert-synced-attrs! - [seed history attrs-a attrs-b attrs-c] - (when-not (= attrs-a attrs-b) - (let [[a b] (take 2 (data/diff attrs-a attrs-b))] - (prn :debug :diff :attrs-a a :attrs-b b))) - (when-not (= attrs-a attrs-c) - (let [[a c] (take 2 (data/diff attrs-a attrs-c))] - (prn :debug :diff :attrs-a a :attrs-c c))) - (when (or (not= attrs-a attrs-b) (not= attrs-a attrs-c)) - (report-history! seed history {:type :attrs-mismatch})) - (is (= attrs-a attrs-b) - (str "db mismatch A/B seed=" seed - " a=" (count attrs-a) - " b=" (count attrs-b) - " history=" (count @history))) - (is (= attrs-a attrs-c) - (str "db mismatch A/C seed=" seed - " a=" (count attrs-a) - " c=" (count attrs-c) - " history=" (count @history)))) - -(defn- assert-no-invalid-tx! - [seed history repro] - (when-let [payload @repro] - (report-history! seed history {:type :unexpected-invalid-tx - :tx-meta (:tx-meta payload) - :errors (:errors payload)})) - (is (nil? @repro) - (str "unexpected invalid tx seed=" seed - " tx-meta=" (pr-str (:tx-meta @repro)) - " errors=" (pr-str (:errors @repro))))) - -(defn- assert-checksum-cache-aligned! - [seed _history server repo+conn] - (let [states (mapv (fn [{:keys [repo conn]}] - {:repo repo - :full (sync-checksum/recompute-checksum @conn) - :cached (client-op/get-local-checksum repo)}) - repo+conn) - full-checksums (mapv :full states) - server-checksum (sync-checksum/recompute-checksum @(get @server :conn))] - (when-not (and (= 1 (count (distinct full-checksums))) - (every? (fn [{:keys [full cached]}] (= full cached)) states) - (= (first full-checksums) server-checksum)) - (prn :db-sync-sim-checksum-cache-mismatch - {:seed seed - :states states - :server-checksum server-checksum})) - (is (= 1 (count (distinct full-checksums))) - (str "full checksums diverged seed=" seed - " states=" (pr-str states))) - (doseq [{:keys [repo full cached]} states] - (is (= full cached) - (str "cached checksum mismatch seed=" seed - " repo=" repo - " full=" full - " cached=" cached))) - (is (= (first full-checksums) server-checksum) - (str "server checksum mismatch seed=" seed - " server=" server-checksum - " client-full=" (first full-checksums))))) - -(deftest ^:long two-clients-online-sim-test - (testing "db-sync convergence with two online clients" - (let [seed (or (env-seed) default-seed) - rng (make-rng seed) - gen-uuid #(rng-uuid rng) - base-uuid (gen-uuid) - conn-a (db-test/create-conn) - conn-b (db-test/create-conn) - ops-a (new-client-ops-db) - ops-b (new-client-ops-db) - client-a (make-client repo-a) - client-b (make-client repo-b) - server (make-server) - history (atom []) - state-a (atom {:pages #{base-uuid} :blocks #{}}) - state-b (atom {:pages #{base-uuid} :blocks #{}}) - repo->state {repo-a state-a - repo-b state-b}] - (with-test-repos {repo-a {:conn conn-a :ops-conn ops-a} - repo-b {:conn conn-b :ops-conn ops-b}} - (fn [] - (let [{:keys [_repro restore]} (install-invalid-tx-repro! seed history)] - (try - (reset! db-sync/*repo->latest-remote-tx {}) - (record-meta! history {:seed seed :base-uuid base-uuid}) - (doseq [conn [conn-a conn-b]] - (ensure-base-page! conn base-uuid)) - (doseq [repo [repo-a repo-b]] - (client-op/update-local-tx repo 0)) - (let [clients [{:repo repo-a :conn conn-a :client client-a :online? true :gen-uuid gen-uuid} - {:repo repo-b :conn conn-b :client client-b :online? true :gen-uuid gen-uuid}]] - (prn :debug :phase-a) - (run-random-ops! rng server clients repo->state base-uuid history - {:pick-op-opts {:disable-ops #{:undo :redo}} - :context {:phase :phase-a}} - op-runs) - (prn :debug :final-sync) - (sync-loop! server clients) - (let [issues-a (db-issues @conn-a) - issues-b (db-issues @conn-b)] - (when (seq issues-a) - (report-history! seed history {:type :db-issues :repo repo-a :issues issues-a})) - (when (seq issues-b) - (report-history! seed history {:type :db-issues :repo repo-b :issues issues-b})) - (is (empty? issues-a) (str "db A issues seed=" seed " " (pr-str issues-a))) - (is (empty? issues-b) (str "db B issues seed=" seed " " (pr-str issues-b)))) - (let [attrs-a (block-attr-map @conn-a) - attrs-b (block-attr-map @conn-b)] - (assert-synced-attrs! seed history attrs-a attrs-b attrs-b))) - (finally - (restore))))))))) - -(deftest ^:long ^:fix-me two-clients-cut-paste-random-sim-test - (testing "db-sync convergence under random cut-paste with child operations" - (let [seed (or (env-seed) default-seed) - rng (make-rng seed) - gen-uuid #(rng-uuid rng) - cut-paste-runs (min op-runs 80) - base-uuid (gen-uuid) - conn-a (db-test/create-conn) - conn-b (db-test/create-conn) - ops-a (new-client-ops-db) - ops-b (new-client-ops-db) - client-a (make-client repo-a) - client-b (make-client repo-b) - server (make-server) - history (atom []) - state-a (atom {:pages #{base-uuid} :blocks #{}})] - (with-test-repos {repo-a {:conn conn-a :ops-conn ops-a} - repo-b {:conn conn-b :ops-conn ops-b}} - (fn [] - (let [{:keys [repro restore]} (install-invalid-tx-repro! seed history)] - (try - (reset! db-sync/*repo->latest-remote-tx {}) - (record-meta! history {:seed seed :base-uuid base-uuid}) - (doseq [conn [conn-a conn-b]] - (ensure-base-page! conn base-uuid)) - (doseq [repo [repo-a repo-b]] - (client-op/update-local-tx repo 0)) - (let [clients [{:repo repo-a :conn conn-a :client client-a :online? true :gen-uuid gen-uuid} - {:repo repo-b :conn conn-b :client client-b :online? true :gen-uuid gen-uuid}] - base-a (d/entity @conn-a [:block/uuid base-uuid]) - parent-uuid (gen-uuid) - child-uuid (gen-uuid) - target-uuid (gen-uuid)] - (create-block! conn-a base-a "seed-parent" parent-uuid) - (let [parent (d/entity @conn-a [:block/uuid parent-uuid])] - (create-block! conn-a parent "seed-child" child-uuid)) - (create-block! conn-a base-a "" target-uuid) - (swap! state-a update :blocks into #{parent-uuid child-uuid target-uuid}) - - (dotimes [_ cut-paste-runs] - (run-ops! rng {:repo repo-a - :conn conn-a - :base-uuid base-uuid - :state state-a - :gen-uuid gen-uuid} - 1 - history - {:pick-op-opts {:enable-ops #{:cut-paste-block-with-child - :create-block - :move-block}} - :context {:phase :cut-paste-random}}) - (sync-loop! server clients)) - (sync-loop! server clients) - - (let [issues-a (db-issues @conn-a) - issues-b (db-issues @conn-b) - attrs-a (block-attr-map @conn-a) - attrs-b (block-attr-map @conn-b) - cut-paste-ops (filter #(= :cut-paste-block-with-child (:op %)) @history)] - (is (seq cut-paste-ops) - (str "expected cut-paste ops seed=" seed " history=" (count @history))) - (is (empty? issues-a) (str "db A issues seed=" seed " " (pr-str issues-a))) - (is (empty? issues-b) (str "db B issues seed=" seed " " (pr-str issues-b))) - (assert-synced-attrs! seed history attrs-a attrs-b attrs-b) - (assert-no-invalid-tx! seed history repro))) - (finally - (restore))))))))) - -(deftest ^:long two-clients-undo-redo-add-remove-cut-paste-random-sim-test - (testing "db-sync convergence under undo/redo with add/remove/cut-paste operations" - (let [seed (or (env-seed) default-seed) - rng (make-rng seed) - gen-uuid #(rng-uuid rng) - base-uuid (gen-uuid) - conn-a (db-test/create-conn) - conn-b (db-test/create-conn) - ops-a (new-client-ops-db) - ops-b (new-client-ops-db) - client-a (make-client repo-a) - client-b (make-client repo-b) - server (make-server) - history (atom []) - state-a (atom {:pages #{base-uuid} :blocks #{}})] - (with-test-repos {repo-a {:conn conn-a :ops-conn ops-a} - repo-b {:conn conn-b :ops-conn ops-b}} - (fn [] - (let [{:keys [repro restore]} (install-invalid-tx-repro! seed history)] - (try - (reset! db-sync/*repo->latest-remote-tx {}) - (record-meta! history {:seed seed :base-uuid base-uuid}) - (doseq [conn [conn-a conn-b]] - (ensure-base-page! conn base-uuid)) - (doseq [repo [repo-a repo-b]] - (client-op/update-local-tx repo 0)) - (let [clients [{:repo repo-a :conn conn-a :client client-a :online? true :gen-uuid gen-uuid} - {:repo repo-b :conn conn-b :client client-b :online? true :gen-uuid gen-uuid}] - base-a (d/entity @conn-a [:block/uuid base-uuid]) - parent-uuid (gen-uuid) - child-uuid (gen-uuid) - target-uuid (gen-uuid)] - (create-block! conn-a base-a "seed-parent" parent-uuid) - (let [parent (d/entity @conn-a [:block/uuid parent-uuid])] - (create-block! conn-a parent "seed-child" child-uuid)) - (create-block! conn-a base-a "" target-uuid) - (swap! state-a update :blocks into #{parent-uuid child-uuid target-uuid}) - - (try - (sync-loop! server clients) - (catch :default e - (report-history! seed history {:type :sync-loop-error - :phase :undo-redo-add-remove-cut-paste-initial-sync - :error (ex-data e)}) - (throw e))) - - (dotimes [_ op-runs] - (run-ops! rng {:repo repo-a - :conn conn-a - :base-uuid base-uuid - :state state-a - :gen-uuid gen-uuid} - 1 - history - {:pick-op-opts {:enable-ops #{:undo - :redo - :create-block - :delete-block - :cut-paste-block-with-child}} - :context {:phase :undo-redo-add-remove-cut-paste}}) - (try - (sync-loop! server clients) - (catch :default e - (report-history! seed history {:type :sync-loop-error - :phase :undo-redo-add-remove-cut-paste - :error (ex-data e)}) - (throw e)))) - (try - (sync-loop! server clients) - (catch :default e - (report-history! seed history {:type :sync-loop-error - :phase :undo-redo-add-remove-cut-paste-final - :error (ex-data e)}) - (throw e))) - - (let [issues-a (db-issues @conn-a) - issues-b (db-issues @conn-b) - attrs-a (block-attr-map @conn-a) - attrs-b (block-attr-map @conn-b) - undo-redo-ops (filter #(contains? #{:undo :redo} (:op %)) @history)] - (is (seq undo-redo-ops) - (str "expected undo/redo ops seed=" seed " history=" (count @history))) - (is (empty? issues-a) (str "db A issues seed=" seed " " (pr-str issues-a))) - (is (empty? issues-b) (str "db B issues seed=" seed " " (pr-str issues-b))) - (assert-synced-attrs! seed history attrs-a attrs-b attrs-b) - (assert-no-invalid-tx! seed history repro))) - (finally - (restore))))))))) - -(deftest ^:long ^:large-vars/cleanup-todo two-clients-online-add-vs-delete-with-undo-redo-random-sim-test - (testing "both online: client A adds blocks while client B deletes with random undo/redo" - (let [seed (or (env-seed) default-seed) - rng (make-rng seed) - gen-uuid #(rng-uuid rng) - scenario-runs op-runs - base-uuid (gen-uuid) - conn-a (db-test/create-conn) - conn-b (db-test/create-conn) - ops-a (new-client-ops-db) - ops-b (new-client-ops-db) - client-a (make-client repo-a) - client-b (make-client repo-b) - server (make-server) - history (atom []) - state-a (atom {:pages #{base-uuid} :blocks #{}}) - state-b (atom {:pages #{base-uuid} :blocks #{}}) - ops #{:create-block :delete-blocks :delete-block :indent-outdent-blocks :undo :redo} - op-weights {:create-block 16 - :delete-block 10 - :delete-blocks 10 - :indent-outdent-blocks 10 - :undo 8 - :redo 8} - a-op-table (build-weighted-op-table ops op-weights :a-add-undo-redo) - b-op-table (build-weighted-op-table ops op-weights :b-delete-undo-redo)] - (with-test-repos {repo-a {:conn conn-a :ops-conn ops-a} - repo-b {:conn conn-b :ops-conn ops-b}} - (fn [] - (let [{:keys [repro restore]} (install-invalid-tx-repro! seed history) - clients [{:repo repo-a :conn conn-a :client client-a :online? true :gen-uuid gen-uuid} - {:repo repo-b :conn conn-b :client client-b :online? true :gen-uuid gen-uuid}] - refresh-state! (fn [state conn] - (let [db @conn - block-uuids (->> (active-block-uuids db) - (remove (fn [uuid] - (some-> (d/entity db [:block/uuid uuid]) - ldb/page?))) - set)] - (swap! state assoc :pages #{base-uuid} - :blocks block-uuids)))] - (try - (reset! db-sync/*repo->latest-remote-tx {}) - (record-meta! history {:seed seed - :base-uuid base-uuid - :phase :two-clients-online-add-vs-delete - :scenario-runs scenario-runs}) - (doseq [conn [conn-a conn-b]] - (ensure-base-page! conn base-uuid)) - (doseq [repo [repo-a repo-b]] - (client-op/update-local-tx repo 0)) - - ;; Bootstrap one local block on A so B has a known deletion target after initial sync. - (let [base-a (d/entity @conn-a [:block/uuid base-uuid]) - seed-uuid (gen-uuid)] - (create-block! conn-a base-a "seed" seed-uuid) - (swap! state-a update :blocks conj seed-uuid)) - (sync-loop! server clients) - (refresh-state! state-a conn-a) - (refresh-state! state-b conn-b) - - (dotimes [i scenario-runs] - (run-ops! rng {:repo repo-a - :conn conn-a - :base-uuid base-uuid - :state state-a - :gen-uuid gen-uuid} - 1 - history - {:op-table-override a-op-table - :context {:phase :a-add-undo-redo :iter i}}) - (sync-loop! server clients) - (refresh-state! state-a conn-a) - (refresh-state! state-b conn-b) - - (run-ops! rng {:repo repo-b - :conn conn-b - :base-uuid base-uuid - :state state-b - :gen-uuid gen-uuid} - 1 - history - {:op-table-override b-op-table - :context {:phase :b-delete-undo-redo :iter i}}) - (sync-loop! server clients) - (refresh-state! state-a conn-a) - (refresh-state! state-b conn-b)) - - (sync-loop! server clients) - (let [issues-a (db-issues @conn-a) - issues-b (db-issues @conn-b) - attrs-a (block-attr-map @conn-a) - attrs-b (block-attr-map @conn-b) - create-count (op-count history :create-block) - delete-count (+ (op-count history :delete-block) - (op-count history :delete-blocks))] - (is (pos? create-count) - (str "expected create-block ops seed=" seed " history=" (count @history))) - (is (pos? delete-count) - (str "expected delete ops seed=" seed " history=" (count @history))) - (is (empty? issues-a) (str "db A issues seed=" seed " " (pr-str issues-a))) - (is (empty? issues-b) (str "db B issues seed=" seed " " (pr-str issues-b))) - (assert-synced-attrs! seed history attrs-a attrs-b attrs-b) - (assert-no-invalid-tx! seed history repro)) - (finally - (restore))))))))) - -(deftest ^:long ^:large-vars/cleanup-todo two-clients-a-wins-b-overlap-rebase-3-tries-test - (testing "three deterministic tries: B rebases pending deletes while applying overlapping remote slices" - (doseq [seed [301 302 303]] - (let [rng (make-rng seed) - gen-uuid #(rng-uuid rng) - scenario-runs 90 - base-uuid (gen-uuid) - conn-a (db-test/create-conn) - conn-b (db-test/create-conn) - ops-a (new-client-ops-db) - ops-b (new-client-ops-db) - client-a (make-client repo-a) - client-b (make-client repo-b) - server (make-server) - history (atom []) - state-a (atom {:pages #{base-uuid} :blocks #{}}) - state-b (atom {:pages #{base-uuid} :blocks #{}}) - a-ops #{:create-block - :delete-block - :move-block - :indent-outdent-blocks - :copy-paste-block-tree-into-empty-target - :undo - :redo} - a-op-weights {:create-block 18 - :delete-block 10 - :move-block 10 - :indent-outdent-blocks 10 - :copy-paste-block-tree-into-empty-target 8 - :undo 8 - :redo 8} - b-ops #{:delete-block :delete-blocks} - b-op-weights {:delete-block 14 - :delete-blocks 14} - a-op-table (build-weighted-op-table a-ops a-op-weights :a-overlap-rebase) - b-op-table (build-weighted-op-table b-ops b-op-weights :b-overlap-rebase) - overlap-apply-count (atom 0) - b-rebase-with-pending (atom 0)] - (with-test-repos {repo-a {:conn conn-a :ops-conn ops-a} - repo-b {:conn conn-b :ops-conn ops-b}} - (fn [] - (let [{:keys [repro restore]} (install-invalid-tx-repro! seed history) - refresh-state! (fn [state conn] - (let [db @conn - block-uuids (->> (active-block-uuids db) - (remove (fn [uuid] - (some-> (d/entity db [:block/uuid uuid]) - ldb/page?))) - set)] - (swap! state assoc :pages #{base-uuid} - :blocks block-uuids))) - sync-a-then-overlap-b! - (fn [iter-idx] - (sync-client! server {:repo repo-a - :conn conn-a - :client client-a - :online? true - :gen-uuid gen-uuid}) - (let [local-tx-b (or (client-op/get-local-tx repo-b) 0) - server-t (:t @server)] - (when (< local-tx-b server-t) - (let [pending-before (boolean (seq (#'sync-apply/pending-txs repo-b))) - remote-txs (mapv (fn [tx-data] {:tx-data tx-data}) - (server-pull server local-tx-b)) - slices (if (<= (count remote-txs) 1) - [remote-txs] - (let [split (+ 1 (rand-int! rng (dec (count remote-txs)))) - left (subvec remote-txs 0 split) - ;; Intentional overlap to mimic duplicated/out-of-order pulls. - right (subvec remote-txs (max 0 (dec split)))] - [left right]))] - (when pending-before - (swap! b-rebase-with-pending inc)) - (doseq [slice slices] - (when (seq slice) - (try - (#'sync-apply/apply-remote-txs! repo-b client-b slice) - (catch :default e - (report-history! seed history - {:type :b-overlap-apply-remote-failed - :iter iter-idx - :slice-size (count slice) - :local-tx local-tx-b - :server-t server-t - :pending-before pending-before - :error (ex-data e)}) - (throw e))))) - (when (> (count slices) 1) - (swap! overlap-apply-count inc)) - (client-op/update-local-tx repo-b server-t)))) - (refresh-state! state-a conn-a) - (refresh-state! state-b conn-b))] - (try - (reset! db-sync/*repo->latest-remote-tx {}) - (record-meta! history {:seed seed - :base-uuid base-uuid - :phase :a-wins-b-overlap-rebase - :scenario-runs scenario-runs}) - (doseq [conn [conn-a conn-b]] - (ensure-base-page! conn base-uuid)) - (doseq [repo [repo-a repo-b]] - (client-op/update-local-tx repo 0)) - - (let [base-a (d/entity @conn-a [:block/uuid base-uuid])] - (dotimes [i 10] - (let [seed-block-uuid (gen-uuid)] - (create-block! conn-a base-a (str "seed-overlap-" i) seed-block-uuid) - (swap! state-a update :blocks conj seed-block-uuid)))) - - (sync-a-then-overlap-b! -1) - - (dotimes [i scenario-runs] - (run-ops! rng {:repo repo-a - :conn conn-a - :base-uuid base-uuid - :state state-a - :gen-uuid gen-uuid} - 1 - history - {:op-table-override a-op-table - :context {:phase :a-overlap-op :iter i}}) - (run-ops! rng {:repo repo-b - :conn conn-b - :base-uuid base-uuid - :state state-b - :gen-uuid gen-uuid} - 1 - history - {:op-table-override b-op-table - :context {:phase :b-delete-op :iter i}}) - (sync-a-then-overlap-b! i)) - - (sync-a-then-overlap-b! scenario-runs) - - (let [issues-a (db-issues @conn-a) - issues-b (db-issues @conn-b) - checksum-a (sync-checksum/recompute-checksum @conn-a) - checksum-server (sync-checksum/recompute-checksum @(get @server :conn))] - (is (empty? issues-a) (str "db A issues seed=" seed " " (pr-str issues-a))) - (is (empty? issues-b) (str "db B issues seed=" seed " " (pr-str issues-b))) - (is (= checksum-a checksum-server) - (str "winner/server checksum mismatch seed=" seed - " a=" checksum-a - " server=" checksum-server)) - (is (pos? @b-rebase-with-pending) - (str "expected rebases with pending deletes seed=" seed)) - (is (pos? @overlap-apply-count) - (str "expected overlapping apply-remote slices seed=" seed)) - (assert-no-invalid-tx! seed history repro)) - (finally - (restore)))))))))) - -(deftest ^:long ^:large-vars/cleanup-todo three-clients-single-repo-sim-test - (testing "db-sync convergence with three clients sharing one repo" - (let [seed (or (env-seed) default-seed) - rng (make-rng seed) - gen-uuid #(rng-uuid rng) - base-uuid (gen-uuid) - conn-a (db-test/create-conn) - conn-b (db-test/create-conn) - conn-c (db-test/create-conn) - ops-a (new-client-ops-db) - ops-b (new-client-ops-db) - ops-c (new-client-ops-db) - client-a (make-client repo-a) - client-b (make-client repo-b) - client-c (make-client repo-c) - server (make-server) - history (atom []) - state-a (atom {:pages #{base-uuid} :blocks #{}}) - state-b (atom {:pages #{base-uuid} :blocks #{}}) - state-c (atom {:pages #{base-uuid} :blocks #{}}) - repo->state {repo-a state-a - repo-b state-b - repo-c state-c}] - (with-test-repos {repo-a {:conn conn-a :ops-conn ops-a} - repo-b {:conn conn-b :ops-conn ops-b} - repo-c {:conn conn-c :ops-conn ops-c}} - (fn [] - (let [listener-a ::checksum-sync-a - listener-b ::checksum-sync-b - listener-c ::checksum-sync-c - update-local-checksum! - (fn [repo conn listener-key] - (d/listen! conn listener-key - (fn [tx-report] - (when-not (:batch-tx? @conn) - (when (seq (:tx-data tx-report)) - (db-sync/update-local-sync-checksum! repo tx-report))))) - nil) - {:keys [restore]} (install-invalid-tx-repro! seed history)] - (update-local-checksum! repo-a conn-a listener-a) - (update-local-checksum! repo-b conn-b listener-b) - (update-local-checksum! repo-c conn-c listener-c) - (try - (reset! db-sync/*repo->latest-remote-tx {}) - (record-meta! history {:seed seed :base-uuid base-uuid}) - (doseq [conn [conn-a conn-b conn-c]] - (ensure-base-page! conn base-uuid)) - (doseq [repo [repo-a repo-b repo-c]] - (client-op/update-local-tx repo 0)) - (client-op/update-local-checksum repo-a (sync-checksum/recompute-checksum @conn-a)) - (client-op/update-local-checksum repo-b (sync-checksum/recompute-checksum @conn-b)) - (client-op/update-local-checksum repo-c (sync-checksum/recompute-checksum @conn-c)) - (let [clients [{:repo repo-a :conn conn-a :client client-a :online? true :gen-uuid gen-uuid} - {:repo repo-b :conn conn-b :client client-b :online? true :gen-uuid gen-uuid} - {:repo repo-c :conn conn-c :client client-c :online? true :gen-uuid gen-uuid}] - ;; run-ops-opts {:pick-op-opts {:disable-ops #{:move-block}}} - run-ops-opts {:pick-op-opts {:disable-ops #{:undo :redo}}}] - (letfn [(sync-or-report! [phase] - (try - (sync-loop! server clients) - (catch :default e - (report-history! seed history - (merge {:type :sync-loop-error - :phase phase} - (ex-data e))) - (throw e))))] - (prn :debug :phase-a) - ;; Phase A: all online - (run-random-ops! rng server clients repo->state base-uuid history - (assoc run-ops-opts :context {:phase :phase-a}) - op-runs) - - ;; Phase B: C offline, A/B online - (prn :debug :phase-b-c-offline) - (let [clients-phase-b [{:repo repo-a :conn conn-a :client client-a :online? true} - {:repo repo-b :conn conn-b :client client-b :online? true} - {:repo repo-c :conn conn-c :client client-c :online? false}]] - (run-random-ops! rng server - (subvec (vec (mapv #(assoc % :gen-uuid gen-uuid) clients-phase-b)) 0 2) - repo->state - base-uuid - history - (assoc run-ops-opts :context {:phase :phase-b-ab-online}) - op-runs) - (run-local-ops! rng conn-c base-uuid state-c history - (assoc run-ops-opts :context {:phase :phase-b-c-offline}) - op-runs - gen-uuid)) - - ;; Phase C: reconnect C - (prn :debug :phase-c-reconnect) - (sync-or-report! :phase-c-reconnect) - - ;; Phase D: A offline, B/C online - (prn :debug :phase-d-a-offline) - (let [clients-phase-d [{:repo repo-a :conn conn-a :client client-a :online? false} - {:repo repo-b :conn conn-b :client client-b :online? true} - {:repo repo-c :conn conn-c :client client-c :online? true}]] - (run-random-ops! rng server - (subvec (vec (mapv #(assoc % :gen-uuid gen-uuid) clients-phase-d)) 1 3) - repo->state - base-uuid - history - (assoc run-ops-opts :context {:phase :phase-d-bc-online}) - op-runs) - (run-local-ops! rng conn-a base-uuid state-a history - (assoc run-ops-opts :context {:phase :phase-d-a-offline}) - op-runs - gen-uuid)) - - ;; Final sync - (prn :debug :final-sync) - (sync-or-report! :final-sync) - - (let [issues-a (db-issues @conn-a) - issues-b (db-issues @conn-b) - issues-c (db-issues @conn-c)] - (when (seq issues-a) - (report-history! seed history {:type :db-issues :repo repo-a :issues issues-a})) - (when (seq issues-b) - (report-history! seed history {:type :db-issues :repo repo-b :issues issues-b})) - (when (seq issues-c) - (report-history! seed history {:type :db-issues :repo repo-c :issues issues-c})) - (is (empty? issues-a) (str "db A issues seed=" seed " " (pr-str issues-a))) - (is (empty? issues-b) (str "db B issues seed=" seed " " (pr-str issues-b))) - (is (empty? issues-c) (str "db C issues seed=" seed " " (pr-str issues-c)))) - - (let [attrs-a (block-attr-map @conn-a) - attrs-b (block-attr-map @conn-b) - attrs-c (block-attr-map @conn-c)] - (assert-synced-attrs! seed history attrs-a attrs-b attrs-c)) - (assert-checksum-cache-aligned! - seed - history - server - [{:repo repo-a :conn conn-a} - {:repo repo-b :conn conn-b} - {:repo repo-c :conn conn-c}]))) - (finally - (restore) - (d/unlisten! conn-a listener-a) - (d/unlisten! conn-b listener-b) - (d/unlisten! conn-c listener-c))))))))) diff --git a/src/test/frontend/worker/db_sync_test.cljs b/src/test/frontend/worker/db_sync_test.cljs deleted file mode 100644 index bee975f..0000000 --- a/src/test/frontend/worker/db_sync_test.cljs +++ /dev/null @@ -1,7843 +0,0 @@ -(ns frontend.worker.db-sync-test - (:require - [cljs.test :refer [async deftest is testing use-fixtures]] - [clojure.set :as set] - [clojure.string :as string] - [datascript.conn :as dc] - [datascript.core :as d] - [frontend.common.crypt :as crypt] - [frontend.test.noise :as test-noise] - [frontend.worker.db-listener :as db-listener] - [frontend.worker-common.util :as worker-util] - [frontend.worker.handler.page :as worker-page] - [frontend.worker.pipeline :as worker-pipeline] - [frontend.worker.platform :as platform] - [frontend.worker.shared-service :as shared-service] - [frontend.worker.state :as worker-state] - [frontend.worker.sync :as db-sync] - [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.handle-message :as sync-handle-message] - [frontend.worker.sync.large-title :as sync-large-title] - [frontend.worker.sync.log-and-state :as sync-log-state] - [frontend.worker.sync.presence :as sync-presence] - [frontend.worker.sync.temp-sqlite :as sync-temp-sqlite] - [frontend.worker.sync.transport :as sync-transport] - [frontend.worker.sync.util :as sync-util] - [frontend.worker.undo-redo :as undo-redo] - [logseq.common.config :as common-config] - [logseq.common.util :as common-util] - [logseq.common.util.page-ref :as page-ref] - [logseq.db :as ldb] - [logseq.db-sync.checksum :as sync-checksum] - [logseq.db-sync.storage :as sync-storage] - [logseq.db-sync.worker.handler.sync :as sync-handler] - [logseq.db-sync.worker.ws :as ws] - [logseq.db.common.delete-blocks :as delete-blocks] - [logseq.db.common.normalize :as db-normalize] - [logseq.db.frontend.schema :as db-schema] - [logseq.db.frontend.validate :as db-validate] - [logseq.db.sqlite.util :as sqlite-util] - [logseq.db.test.helper :as db-test] - [logseq.outliner.core :as outliner-core] - [logseq.outliner.op :as outliner-op] - [logseq.outliner.page :as outliner-page] - [logseq.outliner.property :as outliner-property] - [logseq.outliner.recycle :as outliner-recycle] - [promesa.core :as p])) - -(def ^:private test-repo "test-db-sync-repo") -(def ^:private local-tx-meta - {:client-id "test-client" - :local-tx? true}) - -(defn- test-sync-client - [] - {:repo test-repo - :graph-id "graph-1"}) - -(def ^:private recycle-built-in-props - #{:logseq.property.recycle/original-parent - :logseq.property.recycle/original-page - :logseq.property.recycle/original-order}) - -(defn- with-silenced-console-error - "Silences expected error logging without swallowing thrown exceptions." - [f] - (let [original-console-error (.-error js/console)] - (aset js/console "error" (fn [& _] nil)) - (try - (f) - (finally - (aset js/console "error" original-console-error))))) - -(def ^:private *logseq-db-hooks (atom nil)) - -(def reset-logseq-db-hooks-fixture - {:before - (fn [] - (reset! *logseq-db-hooks - {:transact-fn @ldb/*transact-fn - :transact-pipeline-fn @ldb/*transact-pipeline-fn - :transact-invalid-callback @ldb/*transact-invalid-callback}) - (reset! ldb/*transact-fn nil) - (reset! ldb/*transact-pipeline-fn nil) - (reset! ldb/*transact-invalid-callback nil)) - :after - (fn [] - (let [{:keys [transact-fn transact-pipeline-fn transact-invalid-callback]} @*logseq-db-hooks] - (reset! ldb/*transact-fn transact-fn) - (reset! ldb/*transact-pipeline-fn transact-pipeline-fn) - (reset! ldb/*transact-invalid-callback transact-invalid-callback) - (reset! *logseq-db-hooks nil)))}) - -(use-fixtures :once (test-noise/mute-console-fixture ::db-sync-test)) -(use-fixtures :each reset-logseq-db-hooks-fixture) - -(defn- js-row - [m] - (let [row (js-obj)] - (doseq [[k v] m] - (aset row (name k) v)) - row)) - -(defn- js-rows - [rows] - (into-array (map js-row rows))) - -(defn- make-storage-sql - [] - (let [state (atom {:kvs {} - :tx-log {} - :meta {}}) - sql (doto (js-obj) - (aset "exec" - (fn [sql & args] - (cond - (or (string/includes? sql "create table") - (string/includes? sql "alter table") - (string/includes? sql "select 1 from")) - #js [] - - (string/includes? sql "delete from kvs") - (do - (swap! state assoc :kvs {}) - nil) - - (string/includes? sql "delete from tx_log") - (do - (swap! state assoc :tx-log {}) - nil) - - (string/includes? sql "delete from sync_meta") - (do - (swap! state assoc :meta {}) - nil) - - (or (string/includes? sql "insert into kvs") - (string/includes? sql "insert or replace into kvs")) - (do - (doseq [[addr content addresses] (partition 3 args)] - (swap! state assoc-in [:kvs addr] - {:addr addr - :content content - :addresses addresses})) - nil) - - (string/includes? sql "select content, addresses from kvs where addr = ?") - (if-let [{:keys [content addresses]} (get-in @state [:kvs (first args)])] - (js-rows [{:content content - :addresses addresses}]) - (js-rows [])) - - (string/includes? sql "insert into tx_log") - (let [[t tx created-at outliner-op] args] - (swap! state assoc-in [:tx-log t] - {:t t - :tx tx - :created-at created-at - :outliner-op outliner-op}) - nil) - - (string/includes? sql "select t, tx, outliner_op from tx_log") - (let [since (first args) - rows (->> (:tx-log @state) - vals - (filter (fn [row] (> (:t row) since))) - (sort-by :t) - (map (fn [row] - {:t (:t row) - :tx (:tx row) - :outliner_op (:outliner-op row)})))] - (js-rows rows)) - - (string/includes? sql "insert into sync_meta") - (let [[k v] args] - (swap! state assoc-in [:meta k] v) - nil) - - (string/includes? sql "select value from sync_meta") - (if-let [value (get-in @state [:meta (first args)])] - (js-rows [{:value value}]) - (js-rows [])) - - :else - #js []))))] - {:state state - :sql sql})) - -(defn- kvs-rows - [storage-state] - (->> (:kvs @storage-state) - vals - (sort-by :addr) - (mapv (fn [{:keys [addr content addresses]}] - [addr content addresses])))) - -(defn- non-recycle-validation-entities - [validation] - (->> (:errors validation) - (map :entity) - (remove (fn [entity] - (contains? recycle-built-in-props (:db/ident entity)))))) - -(defn- new-client-ops-db - [] - (let [Database (js/require "better-sqlite3") - db (new Database ":memory:")] - (client-op/ensure-sqlite-schema! db) - db)) - -(defn- sqlite-get-row - [^js db sql & args] - (let [^js stmt (.prepare db sql)] - (if (seq args) - (.apply (.-get stmt) stmt (to-array args)) - (.get stmt)))) - -(defn- client-op-tx-row - [db tx-id] - (sqlite-get-row db - (str "select tx_id, pending, failed, created_at " - "from client_ops where kind = 'tx' and tx_id = ? limit 1") - (str tx-id))) - -(defn- sync-conflict-rows - [db block-uuid] - (try - (let [^js db db - ^js stmt (.prepare db (str "select block_uuid, attr, value " - "from sync_conflicts where block_uuid = ? " - "order by id asc"))] - (->> (.all stmt (str block-uuid)) - (mapv (fn [row] - {:block-uuid (aget row "block_uuid") - :attr (aget row "attr") - :value (aget row "value")})))) - (catch :default _ - []))) - -(defn- seed-client-op-txs! - [repo txs] - (doseq [tx txs] - (client-op/upsert-local-tx-entry! - repo - {:tx-id (:db-sync/tx-id tx) - :created-at (:db-sync/created-at tx) - :pending? (if (contains? tx :db-sync/pending?) (:db-sync/pending? tx) true) - :failed? (if (contains? tx :db-sync/failed?) (:db-sync/failed? tx) false) - :outliner-op (:db-sync/outliner-op tx) - :undo-redo (:db-sync/undo-redo? tx) - :forward-outliner-ops (or (:db-sync/forward-outliner-ops tx) []) - :inverse-outliner-ops (or (:db-sync/inverse-outliner-ops tx) []) - :inferred-outliner-ops? (:db-sync/inferred-outliner-ops? tx) - :normalized-tx-data (or (:db-sync/normalized-tx-data tx) []) - :reversed-tx-data (or (:db-sync/reversed-tx-data tx) [])}))) - -(defn- promise-like? - [result] - (or (p/promise? result) - (and (some? result) - (fn? (.-then result))))) - -(def ^:private remote-apply-test-settle-ms 500) - -(declare minimal-platform) - -(defn- with-datascript-conns - [db-conn ops-conn f] - (let [db-prev @worker-state/*datascript-conns - ops-prev @worker-state/*client-ops-conns] - (swap! client-op/*repo->pending-local-tx-count dissoc test-repo) - (reset! worker-state/*datascript-conns {test-repo db-conn}) - (reset! worker-state/*client-ops-conns {test-repo ops-conn}) - (undo-redo/clear-history! test-repo) - ;; Keep sync-message tests deterministic under strict local-tx validation. - (when (and ops-conn (nil? (client-op/get-local-tx test-repo))) - (client-op/update-local-tx test-repo 0)) - (when ops-conn - (d/listen! db-conn ::listen-db - (fn [tx-report] - (db-sync/enqueue-local-tx! test-repo tx-report)))) - (let [result (f) - cleanup (fn [] - (when ops-conn - (d/unlisten! db-conn ::listen-db)) - (undo-redo/clear-history! test-repo) - (swap! client-op/*repo->pending-local-tx-count dissoc test-repo) - (reset! worker-state/*datascript-conns db-prev) - (reset! worker-state/*client-ops-conns ops-prev))] - (if (promise-like? result) - (.finally (js/Promise.resolve result) cleanup) - (do - (cleanup) - result))))) - -(defn- setup-parent-child - [] - (let [conn (db-test/create-conn-with-blocks - {:pages-and-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "parent" - :build/children [{:block/title "child 1"} - {:block/title "child 2"} - {:block/title "child 3"}]}]}]}) - client-ops-conn (new-client-ops-db) - parent (db-test/find-block-by-content @conn "parent") - child1 (db-test/find-block-by-content @conn "child 1") - child2 (db-test/find-block-by-content @conn "child 2") - child3 (db-test/find-block-by-content @conn "child 3")] - {:conn conn - :client-ops-conn client-ops-conn - :parent parent - :child1 child1 - :child2 child2 - :child3 child3})) - -(defn- setup-two-parents - [] - (let [conn (db-test/create-conn-with-blocks - {:pages-and-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "parent a" - :build/children [{:block/title "a child 1"} - {:block/title "a child 2"}]} - {:block/title "parent b" - :build/children [{:block/title "b child 1"} - {:block/title "b child 2"}]}]}]}) - client-ops-conn (new-client-ops-db)] - {:conn conn - :client-ops-conn client-ops-conn - :parent-a (db-test/find-block-by-content @conn "parent a") - :parent-b (db-test/find-block-by-content @conn "parent b") - :a-child-1 (db-test/find-block-by-content @conn "a child 1") - :b-child-1 (db-test/find-block-by-content @conn "b child 1")})) - -(defn- block-id->uuid - [db block-id] - (cond - (uuid? block-id) - block-id - - (and (vector? block-id) (= :block/uuid (first block-id))) - (second block-id) - - (number? block-id) - (or (some-> (d/entity db block-id) :block/uuid) - block-id) - - :else - block-id)) - -(defn- property-id->ident - [db property-id] - (cond - (qualified-keyword? property-id) - property-id - - (number? property-id) - (or (some-> (d/entity db property-id) :db/ident) - property-id) - - :else - property-id)) - -(defn- normalize-op-block-ids - [db [op args :as op-entry]] - (let [id (fn [v] (block-id->uuid db v)) - property-id (fn [v] (property-id->ident db v)) - ids (fn [vs] (mapv id vs))] - (case op - :save-block - (let [[block opts] args - block' (cond-> block - (and (map? block) - (uuid? (:db/id block))) - ((fn [m] - (cond-> (dissoc m :db/id) - (nil? (:block/uuid m)) - (assoc :block/uuid (:db/id m))))) - (and (map? block) - (nil? (:block/uuid block)) - (number? (:db/id block))) - (assoc :block/uuid (id (:db/id block))))] - [op [block' opts]]) - - :insert-blocks - [op [(first args) (id (second args)) (nth args 2)]] - - :apply-template - [op [(id (first args)) (id (second args)) (nth args 2)]] - - :delete-blocks - [op [(ids (first args)) (second args)]] - - :move-blocks - [op [(ids (first args)) (id (second args)) (nth args 2)]] - - :move-blocks-up-down - [op [(ids (first args)) (second args)]] - - :indent-outdent-blocks - [op [(ids (first args)) (second args) (nth args 2)]] - - :set-block-property - [op [(id (first args)) (property-id (second args)) (nth args 2)]] - - :remove-block-property - [op [(id (first args)) (property-id (second args))]] - - :delete-property-value - [op [(id (first args)) (property-id (second args)) (nth args 2)]] - - :create-property-text-block - [op [(some-> (first args) id) (property-id (second args)) (nth args 2) (nth args 3)]] - - :batch-set-property - [op [(ids (first args)) (property-id (second args)) (nth args 2) (nth args 3)]] - - :batch-remove-property - [op [(ids (first args)) (property-id (second args))]] - - :batch-delete-property-value - [op [(ids (first args)) (property-id (second args)) (nth args 2)]] - - :class-add-property - [op [(id (first args)) (property-id (second args))]] - - :class-remove-property - [op [(id (first args)) (property-id (second args))]] - - :upsert-property - [op [(some-> (first args) property-id) (second args) (nth args 2)]] - - :upsert-closed-value - [op [(property-id (first args)) (second args)]] - - :delete-closed-value - [op [(property-id (first args)) (id (second args))]] - - :add-existing-values-to-closed-values - [op [(property-id (first args)) (second args)]] - - op-entry))) - -(defn- apply-ops! - [conn ops opts] - (outliner-op/apply-ops! conn - (mapv #(normalize-op-block-ids @conn %) ops) - opts)) - -(deftest resolve-ws-token-refreshes-when-token-expired-test - (async done - (let [fetch-calls (atom []) - main-thread-calls (atom 0) - main-thread-prev @worker-state/*main-thread - worker-state-prev @worker-state/*state - sync-config-prev @worker-state/*db-sync-config - fetch-prev js/fetch] - (reset! worker-state/*db-sync-config {:feature-flags {:worker-auth-refresh? true}}) - (reset! worker-state/*state (assoc worker-state-prev - :auth/id-token "expired-token" - :auth/refresh-token "refresh-token" - :auth/oauth-token-url "https://auth.example.com/oauth2/token" - :auth/oauth-client-id "worker-client-id")) - (reset! worker-state/*main-thread - (fn [qkw & _args] - (when (= qkw :thread-api/ensure-id&access-token) - (swap! main-thread-calls inc)) - (p/resolved {:id-token "legacy-token"}))) - (set! js/fetch - (fn [url opts] - (swap! fetch-calls conj {:url url :opts opts}) - (let [resp (js-obj)] - (aset resp "ok" true) - (aset resp "status" 200) - (aset resp "text" - (fn [] - (p/resolved "{\"id_token\":\"fresh-worker-token\",\"access_token\":\"fresh-worker-access-token\"}"))) - (p/resolved resp)))) - (with-redefs [sync-util/auth-token (fn [] "expired-token") - sync-auth/id-token-expired? (fn [_token] true)] - (-> (#'db-sync/ (#'db-sync/js {:type "presence" - :user-id "u1" - :editing-block-uuid "block-self"}))] - (with-redefs [worker-state/get-id-token (fn [] "token") - worker-util/parse-jwt (fn [_] {:sub "u1"}) - client-op/get-local-tx (fn [_repo] 0) - shared-service/broadcast-to-clients! (fn [topic payload] - (swap! broadcasts conj {:topic topic :payload payload}))] - (sync-handle-message/handle-message! test-repo client raw-message) - (is (= [{:user/uuid "u1" :user/name "Alice"} - {:user/uuid "u2" :user/name "Bob"}] - @(:online-users client))) - (is (empty? @broadcasts))))) - -(deftest presence-message-updates-other-user-test - (let [client {:repo test-repo - :online-users (atom [{:user/uuid "u1" :user/name "Alice"} - {:user/uuid "u2" :user/name "Bob"}]) - :ws-state (atom :open)} - broadcasts (atom []) - raw-message (js/JSON.stringify - (clj->js {:type "presence" - :user-id "u2" - :editing-block-uuid "block-2"}))] - (with-redefs [worker-state/get-id-token (fn [] "token") - worker-util/parse-jwt (fn [_] {:sub "u1"}) - client-op/get-local-tx (fn [_repo] 0) - shared-service/broadcast-to-clients! (fn [topic payload] - (swap! broadcasts conj {:topic topic :payload payload}))] - (sync-handle-message/handle-message! test-repo client raw-message) - (is (= [{:user/uuid "u1" :user/name "Alice"} - {:user/uuid "u2" :user/name "Bob" :user/editing-block-uuid "block-2"}] - @(:online-users client))) - (is (= 1 (count @broadcasts)))))) - -(deftest ws-send-tx-batch-serializes-tx-id-as-uuid-string-test - (let [sent-raw (atom nil) - ws (doto (js-obj) - (aset "readyState" 1) - (aset "send" (fn [raw] - (reset! sent-raw raw)))) - tx-id (str (random-uuid))] - (sync-transport/send! sync-transport/coerce-ws-client-message - ws - {:type "tx/batch" - :t-before 99 - :txs [{:tx "[]" - :tx-id tx-id - :outliner-op :move-blocks}]}) - (let [payload (js->clj (js/JSON.parse @sent-raw) :keywordize-keys true) - payload-tx-id (get-in payload [:txs 0 :tx-id])] - (is (= "tx/batch" (:type payload))) - (is (= tx-id payload-tx-id)) - (is (string? payload-tx-id))))) - -(deftest coerce-ws-server-message-accepts-legacy-tx-reject-shape-test - (testing "legacy tx/reject with error-detail and UUID-object ids should coerce" - (let [failed-tx-id (random-uuid) - success-tx-id (random-uuid) - coerced (sync-transport/coerce-ws-server-message - {:type "tx/reject" - :reason "db transact failed" - :t 1392 - :error-detail "legacy server detail" - :failed-tx-id {:uuid (str failed-tx-id)} - :success-tx-ids [{:uuid (str success-tx-id)}]})] - (is (= "tx/reject" (:type coerced))) - (is (= "legacy server detail" (:error-detail coerced))) - (is (= failed-tx-id (:failed-tx-id coerced))) - (is (= [success-tx-id] (:success-tx-ids coerced)))))) - -(deftest flush-pending-honors-stop-upload-debug-flag-test - (testing "when stop-upload debug flag is enabled, flush-pending should skip preparing/sending tx batches" - (let [{:keys [conn client-ops-conn child1]} (setup-parent-child) - tx-id (random-uuid) - prepare-calls (atom 0) - send-calls (atom 0) - client {:repo test-repo - :graph-id "graph-1" - :inflight (atom []) - :ws (doto (js-obj) - (aset "readyState" 1) - (aset "send" (fn [_raw] (swap! send-calls inc))))}] - (with-datascript-conns conn client-ops-conn - (fn [] - (reset! sync-apply/*repo->latest-remote-tx {test-repo 0}) - (client-op/update-local-tx test-repo 0) - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id tx-id - :db-sync/pending? true - :db-sync/created-at 1 - :db-sync/outliner-op :save-block - :db-sync/normalized-tx-data - [[:db/add [:block/uuid (:block/uuid child1)] - :block/title - "pending upload debug gate test"]]}]) - (with-redefs [worker-state/online? (constantly true) - sync-apply/prepare-upload-tx-entries - (fn [& _args] - (swap! prepare-calls inc) - {:tx-entries [] - :drop-tx-ids []})] - (#'sync-apply/set-upload-stopped! test-repo true) - (#'sync-apply/flush-pending! test-repo client) - (is (= 0 @prepare-calls)) - (is (= 0 @send-calls)) - - (#'sync-apply/set-upload-stopped! test-repo false) - (#'sync-apply/flush-pending! test-repo client) - (is (= 1 @prepare-calls)) - (is (= 0 @send-calls))) - (#'sync-apply/set-upload-stopped! test-repo false)))))) - -(deftest flush-pending-splits-large-upload-request-test - (async done - (let [{:keys [conn client-ops-conn child1]} (setup-parent-child) - tx-id (random-uuid) - split-tempid "large-upload-request-split" - tx-data (vec (concat - (repeat 4999 [:db/add [:block/uuid (:block/uuid child1)] - :block/title - "large upload request split"]) - [[:db/add split-tempid :block/uuid (random-uuid)] - [:db/add split-tempid :block/title "grouped split tail"]])) - sent (atom []) - client {:repo test-repo - :graph-id "graph-1" - :inflight (atom []) - :upload-request (atom nil) - :ws (doto (js-obj) - (aset "readyState" 1) - (aset "send" (fn [raw] - (swap! sent conj - (js->clj (js/JSON.parse raw) - :keywordize-keys true)))))}] - (-> (with-datascript-conns - conn - client-ops-conn - (fn [] - (-> (p/with-redefs [worker-state/online? (constantly true) - sync-crypt/graph-e2ee? (constantly false)] - (reset! sync-apply/*repo->latest-remote-tx {test-repo 0}) - (client-op/update-local-tx test-repo 0) - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id tx-id - :db-sync/pending? true - :db-sync/created-at 1 - :db-sync/outliner-op :insert-blocks - :db-sync/normalized-tx-data tx-data}]) - (p/let [_ (#'sync-apply/flush-pending! test-repo client) - _ (let [payload (first @sent) - tx-entry (first (:txs payload)) - uploaded-tx (sqlite-util/read-transit-str (:tx tx-entry))] - (is (= "tx/batch" (:type payload))) - (is (nil? (:tx-id tx-entry))) - (is (= 4999 (count uploaded-tx))) - (is (= [] @(:inflight client))) - (sync-apply/ack-upload-response! test-repo client) - (reset! sync-apply/*repo->latest-remote-tx {test-repo 1}) - (client-op/update-local-tx test-repo 1) - (#'sync-apply/flush-pending! test-repo client))] - (let [payload (second @sent) - tx-entry (first (:txs payload)) - uploaded-tx (sqlite-util/read-transit-str (:tx tx-entry))] - (is (= "tx/batch" (:type payload))) - (is (= (str tx-id) (:tx-id tx-entry))) - (is (= 2 (count uploaded-tx))) - (is (= [tx-id] @(:inflight client)))))) - (p/catch (fn [error] - (is nil (str error))))))) - (p/finally done))))) - -(deftest flush-pending-retries-large-upload-chunk-until-server-ack-test - (async done - (let [{:keys [conn client-ops-conn child1]} (setup-parent-child) - tx-id (random-uuid) - tx-data (vec (concat - (repeat 5000 [:db/add [:block/uuid (:block/uuid child1)] - :block/title - "large upload retry split"]) - [[:db/add [:block/uuid (:block/uuid child1)] - :block/title - "large upload retry tail"]])) - sent (atom []) - client {:repo test-repo - :graph-id "graph-1" - :inflight (atom []) - :upload-request (atom nil) - :ws (doto (js-obj) - (aset "readyState" 1) - (aset "send" (fn [raw] - (swap! sent conj - (js->clj (js/JSON.parse raw) - :keywordize-keys true)))))}] - (-> (with-datascript-conns - conn - client-ops-conn - (fn [] - (-> (p/with-redefs [worker-state/online? (constantly true) - sync-crypt/graph-e2ee? (constantly false)] - (reset! sync-apply/*repo->latest-remote-tx {test-repo 0}) - (client-op/update-local-tx test-repo 0) - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id tx-id - :db-sync/pending? true - :db-sync/created-at 1 - :db-sync/outliner-op :insert-blocks - :db-sync/normalized-tx-data tx-data}]) - (p/let [_ (#'sync-apply/flush-pending! test-repo client) - _ (#'sync-apply/flush-pending! test-repo client)] - (is (= 2 (count @sent))) - (doseq [payload @sent] - (let [tx-entry (first (:txs payload)) - uploaded-tx (sqlite-util/read-transit-str (:tx tx-entry))] - (is (= "tx/batch" (:type payload))) - (is (nil? (:tx-id tx-entry))) - (is (= 5000 (count uploaded-tx))))))) - (p/catch (fn [error] - (is nil (str error))))))) - (p/finally done))))) - -(deftest flush-pending-splits-large-upload-request-with-dependent-blocks-test - (async done - (let [{:keys [conn client-ops-conn child1]} (setup-parent-child) - tx-id (random-uuid) - parent-uuid (random-uuid) - child-uuid (random-uuid) - parent-tempid "large-upload-parent" - child-tempid "large-upload-child" - parent-tx [[:db/add parent-tempid :block/uuid parent-uuid] - [:db/add parent-tempid :block/title "split parent"] - [:db/add parent-tempid :block/page [:block/uuid (:block/uuid child1)]] - [:db/add parent-tempid :block/parent [:block/uuid (:block/uuid child1)]] - [:db/add parent-tempid :block/order "a0"] - [:db/add parent-tempid :block/created-at 1] - [:db/add parent-tempid :block/updated-at 1]] - child-tx [[:db/add child-tempid :block/uuid child-uuid] - [:db/add child-tempid :block/title "split child"] - [:db/add child-tempid :block/page [:block/uuid (:block/uuid child1)]] - [:db/add child-tempid :block/parent [:block/uuid parent-uuid]] - [:db/add child-tempid :block/order "a1"] - [:db/add child-tempid :block/created-at 2] - [:db/add child-tempid :block/updated-at 2]] - tx-data (vec (concat - (repeat 4993 [:db/add [:block/uuid (:block/uuid child1)] - :block/title - "large upload dependency split"]) - parent-tx - child-tx)) - sent (atom []) - client {:repo test-repo - :graph-id "graph-1" - :inflight (atom []) - :upload-request (atom nil) - :ws (doto (js-obj) - (aset "readyState" 1) - (aset "send" (fn [raw] - (swap! sent conj - (js->clj (js/JSON.parse raw) - :keywordize-keys true)))))}] - (-> (with-datascript-conns - conn - client-ops-conn - (fn [] - (-> (p/with-redefs [worker-state/online? (constantly true) - sync-crypt/graph-e2ee? (constantly false)] - (reset! sync-apply/*repo->latest-remote-tx {test-repo 0}) - (client-op/update-local-tx test-repo 0) - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id tx-id - :db-sync/pending? true - :db-sync/created-at 1 - :db-sync/outliner-op :insert-blocks - :db-sync/normalized-tx-data tx-data}]) - (p/let [_ (#'sync-apply/flush-pending! test-repo client) - first-uploaded-tx (let [payload (first @sent) - tx-entry (first (:txs payload))] - (is (= "tx/batch" (:type payload))) - (is (nil? (:tx-id tx-entry))) - (sqlite-util/read-transit-str (:tx tx-entry))) - _ (do - (is (= 5000 (count first-uploaded-tx))) - (is (= parent-tx (subvec first-uploaded-tx 4993 5000))) - (sync-apply/ack-upload-response! test-repo client) - (reset! sync-apply/*repo->latest-remote-tx {test-repo 1}) - (client-op/update-local-tx test-repo 1) - (#'sync-apply/flush-pending! test-repo client))] - (let [payload (second @sent) - tx-entry (first (:txs payload)) - second-uploaded-tx (sqlite-util/read-transit-str (:tx tx-entry))] - (is (= "tx/batch" (:type payload))) - (is (= (str tx-id) (:tx-id tx-entry))) - (is (= child-tx second-uploaded-tx)) - (is (= tx-data (vec (concat first-uploaded-tx second-uploaded-tx)))) - (is (= [tx-id] @(:inflight client)))))) - (p/catch (fn [error] - (is nil (str error))))))) - (p/finally done))))) - -(deftest flush-pending-does-not-overgroup-existing-lookup-refs-test - (async done - (let [{:keys [conn client-ops-conn child1]} (setup-parent-child) - tx-id (random-uuid) - tx-data (vec (repeat 5001 [:db/add [:block/uuid (:block/uuid child1)] - :block/title - "large upload existing lookup split"])) - sent (atom []) - client {:repo test-repo - :graph-id "graph-1" - :inflight (atom []) - :upload-request (atom nil) - :ws (doto (js-obj) - (aset "readyState" 1) - (aset "send" (fn [raw] - (swap! sent conj - (js->clj (js/JSON.parse raw) - :keywordize-keys true)))))}] - (-> (with-datascript-conns - conn - client-ops-conn - (fn [] - (-> (p/with-redefs [worker-state/online? (constantly true) - sync-crypt/graph-e2ee? (constantly false)] - (reset! sync-apply/*repo->latest-remote-tx {test-repo 0}) - (client-op/update-local-tx test-repo 0) - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id tx-id - :db-sync/pending? true - :db-sync/created-at 1 - :db-sync/outliner-op :save-block - :db-sync/normalized-tx-data tx-data}]) - (p/let [_ (#'sync-apply/flush-pending! test-repo client) - first-uploaded-tx (let [payload (first @sent) - tx-entry (first (:txs payload))] - (is (= "tx/batch" (:type payload))) - (is (nil? (:tx-id tx-entry))) - (sqlite-util/read-transit-str (:tx tx-entry))) - _ (do - (is (= 5000 (count first-uploaded-tx))) - (sync-apply/ack-upload-response! test-repo client) - (reset! sync-apply/*repo->latest-remote-tx {test-repo 1}) - (client-op/update-local-tx test-repo 1) - (#'sync-apply/flush-pending! test-repo client))] - (let [payload (second @sent) - tx-entry (first (:txs payload)) - second-uploaded-tx (sqlite-util/read-transit-str (:tx tx-entry))] - (is (= "tx/batch" (:type payload))) - (is (= (str tx-id) (:tx-id tx-entry))) - (is (= 1 (count second-uploaded-tx))) - (is (= tx-data (vec (concat first-uploaded-tx second-uploaded-tx)))) - (is (= [tx-id] @(:inflight client)))))) - (p/catch (fn [error] - (is nil (str error))))))) - (p/finally done))))) - -(deftest flush-pending-splits-large-delete-upload-request-test - (async done - (let [{:keys [conn client-ops-conn child1]} (setup-parent-child) - tx-id (random-uuid) - tx-data (vec (repeat 5001 [:db/retractEntity [:block/uuid (:block/uuid child1)]])) - sent (atom []) - client {:repo test-repo - :graph-id "graph-1" - :inflight (atom []) - :upload-request (atom nil) - :ws (doto (js-obj) - (aset "readyState" 1) - (aset "send" (fn [raw] - (swap! sent conj - (js->clj (js/JSON.parse raw) - :keywordize-keys true)))))}] - (-> (with-datascript-conns - conn - client-ops-conn - (fn [] - (-> (p/with-redefs [worker-state/online? (constantly true) - sync-crypt/graph-e2ee? (constantly false)] - (reset! sync-apply/*repo->latest-remote-tx {test-repo 0}) - (client-op/update-local-tx test-repo 0) - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id tx-id - :db-sync/pending? true - :db-sync/created-at 1 - :db-sync/outliner-op :delete-blocks - :db-sync/normalized-tx-data tx-data}]) - (p/let [_ (#'sync-apply/flush-pending! test-repo client) - first-uploaded-tx (let [payload (first @sent) - tx-entry (first (:txs payload))] - (is (= "tx/batch" (:type payload))) - (is (nil? (:tx-id tx-entry))) - (sqlite-util/read-transit-str (:tx tx-entry))) - _ (do - (is (= 5000 (count first-uploaded-tx))) - (sync-apply/ack-upload-response! test-repo client) - (reset! sync-apply/*repo->latest-remote-tx {test-repo 1}) - (client-op/update-local-tx test-repo 1) - (#'sync-apply/flush-pending! test-repo client))] - (let [payload (second @sent) - tx-entry (first (:txs payload)) - second-uploaded-tx (sqlite-util/read-transit-str (:tx tx-entry))] - (is (= "tx/batch" (:type payload))) - (is (= (str tx-id) (:tx-id tx-entry))) - (is (= 1 (count second-uploaded-tx))) - (is (= tx-data (vec (concat first-uploaded-tx second-uploaded-tx)))) - (is (= [tx-id] @(:inflight client)))))) - (p/catch (fn [error] - (is nil (str error))))))) - (p/finally done))))) - -(deftest flush-pending-keeps-oversized-tempid-group-in-one-request-test - (async done - (let [{:keys [conn client-ops-conn]} (setup-parent-child) - tx-id (random-uuid) - tempid "oversized-tempid-group" - tx-data (mapv (fn [idx] - [:db/add tempid (keyword "large-upload.group" (str "attr-" idx)) idx]) - (range 5001)) - sent (atom []) - client {:repo test-repo - :graph-id "graph-1" - :inflight (atom []) - :upload-request (atom nil) - :ws (doto (js-obj) - (aset "readyState" 1) - (aset "send" (fn [raw] - (swap! sent conj - (js->clj (js/JSON.parse raw) - :keywordize-keys true)))))}] - (-> (with-datascript-conns - conn - client-ops-conn - (fn [] - (-> (p/with-redefs [worker-state/online? (constantly true) - sync-crypt/graph-e2ee? (constantly false)] - (reset! sync-apply/*repo->latest-remote-tx {test-repo 0}) - (client-op/update-local-tx test-repo 0) - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id tx-id - :db-sync/pending? true - :db-sync/created-at 1 - :db-sync/outliner-op :insert-blocks - :db-sync/normalized-tx-data tx-data}]) - (p/let [_ (#'sync-apply/flush-pending! test-repo client)] - (let [payload (first @sent) - tx-entry (first (:txs payload)) - uploaded-tx (sqlite-util/read-transit-str (:tx tx-entry))] - (is (= 1 (count @sent))) - (is (= "tx/batch" (:type payload))) - (is (= (str tx-id) (:tx-id tx-entry))) - (is (= 5001 (count uploaded-tx))) - (is (= tx-data uploaded-tx)) - (is (= [tx-id] @(:inflight client)))))) - (p/catch (fn [error] - (is nil (str error))))))) - (p/finally done))))) - -(deftest flush-pending-reports-upload-response-timeout-test - (async done - (let [{:keys [conn client-ops-conn child1]} (setup-parent-child) - tx-id (random-uuid) - sent (atom []) - events (atom []) - timeout-callback (atom nil) - timeout-ms (atom nil) - original-set-timeout js/setTimeout - original-clear-timeout js/clearTimeout - platform-prev (try - (platform/current) - (catch :default _ nil)) - client {:repo test-repo - :graph-id "graph-1" - :inflight (atom []) - :upload-request (atom nil) - :ws (doto (js-obj) - (aset "readyState" 1) - (aset "send" (fn [raw] - (swap! sent conj - (js->clj (js/JSON.parse raw) - :keywordize-keys true)))))} - test-platform (assoc-in (minimal-platform :browser) - [:broadcast :post-message!] - (fn [type payload] - (swap! events conj [type payload])))] - (set! js/setTimeout - (fn [f ms] - (reset! timeout-callback f) - (reset! timeout-ms ms) - :upload-timeout)) - (set! js/clearTimeout (fn [& _] nil)) - (platform/set-platform! test-platform) - (with-datascript-conns - conn - client-ops-conn - (fn [] - (-> (p/with-redefs [worker-state/online? (constantly true) - sync-crypt/graph-e2ee? (constantly false)] - (reset! sync-apply/*repo->latest-remote-tx {test-repo 0}) - (client-op/update-local-tx test-repo 0) - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id tx-id - :db-sync/pending? true - :db-sync/created-at 1 - :db-sync/outliner-op :save-block - :db-sync/normalized-tx-data - [[:db/add [:block/uuid (:block/uuid child1)] - :block/title - "pending upload timeout report"]]}]) - (p/let [_ (#'sync-apply/flush-pending! test-repo client)] - (is (= "tx/batch" (:type (first @sent)))) - (is (= [tx-id] @(:inflight client))) - (is (= (* 2 60 1000) @timeout-ms)) - (is (fn? @timeout-callback)) - (@timeout-callback) - (is (= 1 (count @events))) - (let [[type payload] (first @events)] - (is (= :capture-error type)) - (is (= "db-sync" (get-in payload [:payload :source]))) - (is (= "upload-tx-batch" (get-in payload [:payload :operation]))) - (is (= test-repo (get-in payload [:payload :repo]))) - (is (= "graph-1" (get-in payload [:payload :graph-id]))) - (is (= 1 (get-in payload [:payload :tx-count]))) - (is (= "save-block" (get-in payload [:payload :outliner-op]))) - (is (= (* 2 60 1000) (get-in payload [:payload :timeout-ms]))) - (is (= [(str tx-id)] (get-in payload [:extra :tx-ids]))) - (is (= ["save-block"] (get-in payload [:extra :outliner-ops]))) - (is (= "Sync upload request did not get response" - (ex-message (:error payload))))) - (reset! events []) - (aset (:ws client) "readyState" 3) - (#'sync-apply/start-upload-response-timeout! - client - {:tx-ids [tx-id] - :outliner-ops [:save-block] - :t-before 0}) - (@timeout-callback) - (is (empty? @events)))) - (p/catch (fn [error] - (is nil (str error)))) - (p/finally - (fn [] - (sync-apply/mark-pending-txs-false! test-repo [tx-id]) - (set! js/setTimeout original-set-timeout) - (set! js/clearTimeout original-clear-timeout) - (if platform-prev - (platform/set-platform! platform-prev) - (platform/set-platform! (minimal-platform :browser))) - (done))))))))) - -(deftest start-active-client-flushes-pending-local-txs-test - (async done - (let [{:keys [conn client-ops-conn child1]} (setup-parent-child) - repo (str test-repo "-active-client-" (random-uuid)) - tx-id (random-uuid) - sent (atom []) - broadcasts (atom 0) - latest-prev @db-sync/*repo->latest-remote-tx - get-datascript-conn worker-state/get-datascript-conn - get-client-ops-conn worker-state/get-client-ops-conn - client {:repo repo - :graph-id "graph-1" - :ws (doto (js-obj) - (aset "readyState" 1) - (aset "send" (fn [raw] - (swap! sent conj - (js->clj (js/JSON.parse raw) - :keywordize-keys true))))) - :ws-state (atom :open) - :inflight (atom []) - :send-queue (atom (p/resolved nil)) - :receive-queue (atom (p/resolved nil)) - :asset-queue (atom (p/resolved nil)) - :pending-pull-since (atom nil) - :online-users (atom []) - :reconnect (atom {:attempt 0 :timer nil}) - :stale-kill-timer (atom nil) - :last-ws-message-ts (atom (common-util/time-ms)) - :last-sync-error (atom nil)} - client-atom (atom client) - config-atom (atom {:ws-url "wss://sync.example.test/sync/%s"})] - (swap! client-op/*repo->pending-local-tx-count dissoc repo) - (undo-redo/clear-history! repo) - (swap! db-sync/*repo->latest-remote-tx assoc repo 0) - (-> (p/with-redefs [worker-state/*db-sync-client client-atom - worker-state/*db-sync-config config-atom - worker-state/get-datascript-conn - (fn [repo'] - (if (= repo repo') - conn - (get-datascript-conn repo'))) - worker-state/get-client-ops-conn - (fn [repo'] - (if (= repo repo') - client-ops-conn - (get-client-ops-conn repo'))) - sync-util/get-graph-id (fn [_repo] "graph-1") - sync-crypt/graph-e2ee? (constantly false) - worker-state/online? (constantly true) - shared-service/broadcast-to-clients! (fn [& _] - (swap! broadcasts inc))] - (client-op/update-local-tx repo 0) - (seed-client-op-txs! - repo - [{:db-sync/tx-id tx-id - :db-sync/pending? true - :db-sync/created-at 1 - :db-sync/outliner-op :save-block - :db-sync/normalized-tx-data - [[:db/add [:block/uuid (:block/uuid child1)] - :block/title - "pending active client flush"]]}]) - (p/let [_ (db-sync/start! repo) - _ @(:send-queue client)] - (is (= 1 @broadcasts)) - (is (= 0 (client-op/get-local-tx repo))) - (is (= 0 (get @db-sync/*repo->latest-remote-tx repo))) - (is (= [tx-id] - (mapv :tx-id (#'sync-apply/pending-txs repo)))) - (is (nil? @(:last-sync-error client))) - (is (= "tx/batch" (:type (first @sent)))) - (is (= [(str tx-id)] - (mapv :tx-id (:txs (first @sent))))) - (is (= [tx-id] @(:inflight client))))) - (p/catch (fn [error] - (is nil (str error)))) - (p/finally (fn [] - (undo-redo/clear-history! repo) - (swap! client-op/*repo->pending-local-tx-count dissoc repo) - (reset! db-sync/*repo->latest-remote-tx latest-prev) - (done))))))) - -(deftest receive-queue-failure-updates-last-sync-error-test - (async done - (let [repo "receive-queue-last-sync-error-test" - client {:repo repo - :graph-id "graph-1" - :receive-queue (atom (p/resolved nil)) - :last-sync-error (atom nil)} - captured-error (atom nil) - rejected-error (ex-info "tx-rejected" - {:type :db-sync/tx-rejected - :reason "db transact failed"}) - set-last-sync-error! sync-util/set-last-sync-error!] - (-> (p/with-redefs [sync-util/set-last-sync-error! - (fn [client' error'] - (set-last-sync-error! client' error') - (when (identical? client client') - (reset! captured-error @(:last-sync-error client'))))] - (#'db-sync/enqueue-receive-message! - client - (fn [] - (throw rejected-error)))) - (p/then (fn [_] - (let [last-error @captured-error] - (is (= :tx-rejected (:code last-error))) - (is (= "tx-rejected" (:message last-error))) - (is (= :db-sync/tx-rejected - (get-in last-error [:data :type]))) - (is (= "db transact failed" - (get-in last-error [:data :reason])))))) - (p/catch (fn [caught-error] - (is nil (str caught-error)))) - (p/finally done))))) - -(deftest temp-conn-batch-preserves-cardinality-one-schema-test - (testing "temp conn batch emits replacement retractions for cardinality-one attrs" - (let [{:keys [conn child1]} (setup-parent-child) - child-uuid (:block/uuid child1)] - (ldb/batch-transact-with-temp-conn! - conn - {} - (fn [temp-conn] - (ldb/transact! temp-conn [[:db/add [:block/uuid child-uuid] :block/order "a-test"]]))) - (let [child-after (d/entity @conn [:block/uuid child-uuid]) - validation (db-validate/validate-local-db! @conn)] - (is (= "a-test" (:block/order child-after))) - (is (empty? (:errors validation)) - (str (:errors validation))))))) - -(deftest prepare-upload-tx-entries-drops-empty-txs-test - (testing "empty tx rows should be dropped from upload batch" - (let [{:keys [conn client-ops-conn child1]} (setup-parent-child) - empty-tx-id (random-uuid) - valid-tx-id (random-uuid)] - (with-datascript-conns conn client-ops-conn - (fn [] - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id empty-tx-id - :db-sync/pending? true - :db-sync/created-at 1 - :db-sync/outliner-op :transact - :db-sync/normalized-tx-data []} - {:db-sync/tx-id valid-tx-id - :db-sync/pending? true - :db-sync/created-at 2 - :db-sync/outliner-op :save-block - :db-sync/normalized-tx-data - [[:db/add [:block/uuid (:block/uuid child1)] - :block/title - "valid-title"]]}]) - (let [pending (#'sync-apply/pending-txs test-repo) - {:keys [tx-entries drop-tx-ids drop-txs]} - (sync-apply/prepare-upload-tx-entries conn pending)] - (is (= [empty-tx-id] drop-tx-ids)) - (is (= [{:tx-id empty-tx-id - :outliner-op :transact - :reason :empty-tx-data}] - drop-txs)) - (is (= [valid-tx-id] (mapv :tx-id tx-entries))))))))) - -(defn- large-block-insert-upload-tx - [page-uuid parent-uuid block-count] - (vec - (mapcat (fn [idx] - (let [block-uuid (random-uuid) - eid (str block-uuid)] - [[:db/add eid :block/uuid block-uuid idx] - [:db/add eid :block/title (str "large-client-block-" idx) idx] - [:db/add eid :block/page [:block/uuid page-uuid] idx] - [:db/add eid :block/parent [:block/uuid parent-uuid] idx] - [:db/add eid :block/order "a0" idx] - [:db/add eid :block/created-at idx idx] - [:db/add eid :block/updated-at idx idx]])) - (range block-count)))) - -(deftest prepare-upload-tx-entries-keeps-large-client-op-test - (testing "large pending upload ops should stay intact for server-side chunking" - (let [{:keys [conn client-ops-conn parent]} (setup-parent-child) - tx-id (random-uuid) - page-uuid (:block/uuid (:block/page parent)) - parent-uuid (:block/uuid parent) - tx-data (large-block-insert-upload-tx page-uuid parent-uuid 120)] - (with-datascript-conns conn client-ops-conn - (fn [] - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id tx-id - :db-sync/pending? true - :db-sync/created-at 1 - :db-sync/outliner-op :insert-blocks - :db-sync/normalized-tx-data tx-data}]) - (let [pending (#'sync-apply/pending-txs test-repo) - {:keys [tx-entries drop-tx-ids]} - (sync-apply/prepare-upload-tx-entries conn pending)] - (is (empty? drop-tx-ids)) - (is (= 1 (count tx-entries))) - (is (= tx-id (:tx-id (first tx-entries)))) - (is (= tx-data (:tx-data (first tx-entries)))))))))) - -(deftest sync-counts-counts-only-true-pending-local-ops-test - (testing "pending-local should count only rows with :db-sync/pending? true" - (let [{:keys [conn client-ops-conn]} (setup-parent-child)] - (with-datascript-conns conn client-ops-conn - (fn [] - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id (random-uuid) - :db-sync/created-at 1 - :db-sync/pending? false} - {:db-sync/tx-id (random-uuid) - :db-sync/created-at 2 - :db-sync/pending? false} - {:db-sync/tx-id (random-uuid) - :db-sync/created-at 3 - :db-sync/pending? true}]) - (let [counts (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-local-tx (constantly 0) - :get-graph-uuid (constantly nil) - :latest-remote-tx {}} - test-repo)] - (is (= 1 (:pending-local counts))))))))) - -(deftest sync-counts-reports-stored-local-checksum-test - (testing "sync status reports stored local checksum without recomputing from client db" - (doseq [cached-checksum ["stale" nil]] - (let [counts (sync-presence/sync-counts - {:get-datascript-conn (constantly :conn) - :get-pending-local-tx-count (constantly 0) - :get-unpushed-asset-ops-count (constantly 0) - :get-local-tx (constantly 42) - :get-local-checksum (constantly cached-checksum) - :get-graph-uuid (constantly "graph-1") - :latest-remote-tx {test-repo 42} - :latest-remote-checksum {test-repo "fresh"}} - test-repo) - payload (sync-presence/rtc-state-payload - (constantly counts) - {:repo test-repo - :ws-state (atom :open) - :online-users (atom [])})] - (is (= cached-checksum (:local-checksum counts))) - (is (= "graph-1" (:graph-id counts))) - (is (= "graph-1" (:graph-uuid payload))))))) - -(deftest pull-ok-with-older-remote-tx-is-ignored-test - (testing "pull/ok with remote tx behind local tx does not apply stale tx data" - (let [{:keys [conn client-ops-conn parent]} (setup-parent-child) - parent-id (:db/id parent) - stale-tx (sqlite-util/write-transit-str [[:db/add parent-id :block/title "stale-title"]]) - raw-message (js/JSON.stringify - (clj->js {:type "pull/ok" - :t 4 - :checksum "ignored" - :txs [{:t 4 :tx stale-tx}]})) - latest-prev @db-sync/*repo->latest-remote-tx - client {:repo test-repo - :graph-id "graph-1" - :inflight (atom []) - :online-users (atom []) - :ws-state (atom :open)}] - (with-datascript-conns conn client-ops-conn - (fn [] - (reset! db-sync/*repo->latest-remote-tx {}) - (try - (client-op/update-local-tx test-repo 5) - (sync-handle-message/handle-message! test-repo client raw-message) - (let [parent' (d/entity @conn parent-id)] - (is (= "parent" (:block/title parent'))) - (is (= 5 (client-op/get-local-tx test-repo)))) - (finally - (reset! db-sync/*repo->latest-remote-tx latest-prev)))))))) - -(deftest pull-ok-out-of-order-stale-response-is-ignored-test - (testing "late stale pull/ok should not overwrite a newer already-applied tx" - (async done - (let [{:keys [conn client-ops-conn parent]} (setup-parent-child) - parent-id (:db/id parent) - new-tx (sqlite-util/write-transit-str [[:db/add parent-id :block/title "remote-new-title"]]) - stale-tx (sqlite-util/write-transit-str [[:db/add parent-id :block/title "stale-title"]]) - new-checksum (-> (d/with @conn [[:db/add parent-id :block/title "remote-new-title"]]) - :db-after - sync-checksum/recompute-checksum) - raw-new (js/JSON.stringify - (clj->js {:type "pull/ok" - :t 2 - :checksum new-checksum - :txs [{:t 2 :tx new-tx}]})) - raw-stale (js/JSON.stringify - (clj->js {:type "pull/ok" - :t 1 - :checksum "ignored" - :txs [{:t 1 :tx stale-tx}]})) - latest-prev @db-sync/*repo->latest-remote-tx - client {:repo test-repo - :graph-id "graph-1" - :inflight (atom []) - :online-users (atom []) - :ws-state (atom :open)}] - (reset! db-sync/*repo->latest-remote-tx {}) - (with-datascript-conns conn client-ops-conn - (fn [] - (-> (p/let [_ (sync-handle-message/handle-message! test-repo client raw-new) - _ (sync-handle-message/handle-message! test-repo client raw-stale) - parent' (d/entity @conn parent-id)] - (is (= "remote-new-title" (:block/title parent'))) - (is (= 2 (client-op/get-local-tx test-repo)))) - (p/finally (fn [] - (reset! db-sync/*repo->latest-remote-tx latest-prev) - (done)))))))))) - -(deftest pull-ok-does-not-anchor-remote-checksum-before-verify-test - (testing "pull/ok compares the incrementally updated local checksum instead of anchoring the remote checksum" - (async done - (let [{:keys [conn client-ops-conn parent]} (setup-parent-child) - parent-id (:db/id parent) - remote-tx-data [[:db/add parent-id :block/title "remote-checksum-anchor"]] - local-checksum-after-remote (-> (d/with @conn remote-tx-data) - :db-after - sync-checksum/recompute-checksum) - remote-checksum "bad-remote-checksum" - raw-message (js/JSON.stringify - (clj->js {:type "pull/ok" - :t 1 - :checksum remote-checksum - :txs [{:t 1 - :tx (sqlite-util/write-transit-str remote-tx-data)}]})) - latest-prev @db-sync/*repo->latest-remote-tx - client {:repo test-repo - :graph-id "graph-1" - :inflight (atom []) - :online-users (atom []) - :ws-state (atom :open)} - *captured (atom nil)] - (with-datascript-conns conn client-ops-conn - (fn [] - (reset! db-sync/*repo->latest-remote-tx {}) - (client-op/update-local-checksum test-repo (sync-checksum/recompute-checksum @conn)) - (d/listen! conn ::pull-ok-checksum - (fn [tx-report] - (when (and (seq (:tx-data tx-report)) - (not (:batch-tx? @conn))) - (db-sync/update-local-sync-checksum! test-repo tx-report)))) - (p/with-redefs [sync-log-state/rtc-log (fn [type payload] - (reset! *captured {:type type - :payload payload}))] - (-> (p/let [_ (sync-handle-message/handle-message! test-repo client raw-message) - parent' (d/entity @conn parent-id)] - (is (= "remote-checksum-anchor" (:block/title parent'))) - (is (= 1 (client-op/get-local-tx test-repo))) - (is (= local-checksum-after-remote (client-op/get-local-checksum test-repo))) - (is (= :rtc.log/checksum-mismatch (:type @*captured))) - (is (= local-checksum-after-remote - (get-in @*captured [:payload :local-checksum]))) - (is (= remote-checksum (get-in @*captured [:payload :remote-checksum])))) - (p/finally (fn [] - (d/unlisten! conn ::pull-ok-checksum) - (reset! db-sync/*repo->latest-remote-tx latest-prev) - (done))))))))))) - -(deftest tx-reject-db-transact-failed-surfaces-rejected-tx-test - (testing "tx/reject with db transact failed includes parsed rejected tx and emits rtc-log" - (let [rejected-tx {:tx (sqlite-util/write-transit-str [[:db/add [:block/uuid (random-uuid)] :block/title "bad"]]) - :outliner-op :save-block} - *captured (atom nil) - raw-message (js/JSON.stringify - (clj->js {:type "tx/reject" - :reason "db transact failed" - :t 3 - :data (sqlite-util/write-transit-str rejected-tx)})) - client {:repo test-repo - :graph-id "graph-1" - :inflight (atom []) - :online-users (atom []) - :ws-state (atom :open)}] - (with-redefs [client-op/get-local-tx (constantly 0) - sync-handle-message/sync-counts (constantly {})] - (with-redefs [sync-log-state/rtc-log (fn [type payload] - (reset! *captured {:type type - :payload payload}))] - (try - (with-silenced-console-error - #(sync-handle-message/handle-message! test-repo client raw-message)) - (is false "expected tx/reject to fail-fast with rejected tx details") - (catch :default error - (let [data (ex-data error) - captured @*captured] - (is (= :db-sync/tx-rejected (:type data))) - (is (= "db transact failed" (:reason data))) - (is (= rejected-tx (:data data))) - (is (= :rtc.log/tx-rejected (:type captured))) - (is (= :db-sync/tx-rejected (-> captured :payload :type))) - (is (= rejected-tx (-> captured :payload :data))))))))))) - -(deftest tx-reject-db-transact-failed-marks-inflight-op-failed-test - (testing "non-stale tx/reject should mark inflight ops failed and clear pending state" - (let [{:keys [conn client-ops-conn]} (setup-parent-child) - tx-id (random-uuid) - raw-message (js/JSON.stringify - (clj->js {:type "tx/reject" - :reason "db transact failed" - :t 3 - :data (sqlite-util/write-transit-str - {:tx (sqlite-util/write-transit-str [[:db/add [:block/uuid (random-uuid)] - :block/title - "bad"]]) - :outliner-op :save-block})})) - client {:repo test-repo - :graph-id "graph-1" - :inflight (atom [tx-id]) - :online-users (atom []) - :ws-state (atom :open)}] - (with-datascript-conns conn client-ops-conn - (fn [] - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id tx-id - :db-sync/created-at 1 - :db-sync/pending? true}]) - (with-redefs [client-op/get-local-tx (constantly 0)] - (let [error (try - (with-silenced-console-error - #(sync-handle-message/handle-message! test-repo client raw-message)) - nil - (catch :default e - e)) - ent (client-op-tx-row client-ops-conn tx-id)] - (is (some? error)) - (is (= :db-sync/tx-rejected - (:type (ex-data error)))) - (is (= "db transact failed" - (:reason (ex-data error)))) - (is (= [] @(:inflight client))) - (is (= 0 (aget ent "pending"))) - (is (= 1 (aget ent "failed")))))))))) - -(deftest tx-reject-db-transact-failed-rolls-back-rejected-local-delete-test - (testing "a rejected local tx should not stay applied after it is marked failed" - (let [{:keys [conn client-ops-conn child1]} (setup-parent-child) - child-uuid (:block/uuid child1) - child-title (:block/title child1)] - (with-datascript-conns conn client-ops-conn - (fn [] - (outliner-core/delete-blocks! conn [child1] {}) - (let [tx-id (:tx-id (first (#'sync-apply/pending-txs test-repo))) - raw-message (js/JSON.stringify - (clj->js {:type "tx/reject" - :reason "db transact failed" - :t 3 - :failed-tx-id (str tx-id)})) - client {:repo test-repo - :graph-id "graph-1" - :inflight (atom [tx-id]) - :online-users (atom []) - :ws-state (atom :open)}] - (is (nil? (d/entity @conn [:block/uuid child-uuid]))) - (with-redefs [client-op/get-local-tx (constantly 0)] - (let [error (try - (with-silenced-console-error - #(sync-handle-message/handle-message! test-repo client raw-message)) - nil - (catch :default e - e)) - ent (client-op-tx-row client-ops-conn tx-id) - child' (d/entity @conn [:block/uuid child-uuid])] - (is (some? error)) - (is (= :db-sync/tx-rejected - (:type (ex-data error)))) - (is (= [] @(:inflight client))) - (is (= 0 (aget ent "pending"))) - (is (= 1 (aget ent "failed"))) - (is (= child-title (:block/title child'))))))))))) - -(deftest tx-reject-db-transact-failed-keeps-checksum-aligned-test - (testing "a rejected local rollback should update the stored checksum incrementally" - (let [{:keys [conn client-ops-conn child1]} (setup-parent-child) - child-uuid (:block/uuid child1)] - (with-datascript-conns conn client-ops-conn - (fn [] - (client-op/update-local-checksum test-repo (sync-checksum/recompute-checksum @conn)) - (db-listener/listen-db-changes! test-repo conn :handler-keys [:checksum-test]) - (outliner-core/delete-blocks! conn [child1] {}) - (let [tx-id (:tx-id (first (#'sync-apply/pending-txs test-repo))) - checksum-after-delete (client-op/get-local-checksum test-repo) - raw-message (js/JSON.stringify - (clj->js {:type "tx/reject" - :reason "db transact failed" - :t 3 - :failed-tx-id (str tx-id)})) - client {:repo test-repo - :graph-id "graph-1" - :inflight (atom [tx-id]) - :online-users (atom []) - :ws-state (atom :open)}] - (is (nil? (d/entity @conn [:block/uuid child-uuid]))) - (is (= (sync-checksum/recompute-checksum @conn) - checksum-after-delete)) - (with-redefs [client-op/get-local-tx (constantly 0)] - (let [error (try - (with-silenced-console-error - #(sync-handle-message/handle-message! test-repo client raw-message)) - nil - (catch :default e - e))] - (is (some? error)) - (is (= :db-sync/tx-rejected - (:type (ex-data error)))) - (is (= (sync-checksum/recompute-checksum @conn) - (client-op/get-local-checksum test-repo))))))))))) - -(deftest tx-reject-db-transact-failed-rolls-back-property-value-delete-test - (testing "a rejected delete restores generated property value children" - (let [property-value-uuid (random-uuid) - conn (db-test/create-conn-with-blocks - {:properties {:user.property/cli-http-prop {:logseq.property/type :default}} - :pages-and-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "parent" - :build/properties - {:user.property/cli-http-prop - {:build/property-value :block - :block/title "property value" - :block/uuid property-value-uuid - :build/keep-uuid? true}}}]}]}) - client-ops-conn (new-client-ops-db) - parent (db-test/find-block-by-content @conn "parent") - parent-uuid (:block/uuid parent)] - (with-datascript-conns conn client-ops-conn - (fn [] - (client-op/update-local-checksum test-repo (sync-checksum/recompute-checksum @conn)) - (db-listener/listen-db-changes! test-repo conn :handler-keys [:checksum-test]) - (outliner-core/delete-blocks! conn [parent] {}) - (let [tx-id (:tx-id (first (#'sync-apply/pending-txs test-repo))) - raw-message (js/JSON.stringify - (clj->js {:type "tx/reject" - :reason "db transact failed" - :t 3 - :failed-tx-id (str tx-id)})) - client {:repo test-repo - :graph-id "graph-1" - :inflight (atom [tx-id]) - :online-users (atom []) - :ws-state (atom :open)}] - (is (nil? (d/entity @conn [:block/uuid parent-uuid]))) - (is (nil? (d/entity @conn [:block/uuid property-value-uuid]))) - (with-redefs [client-op/get-local-tx (constantly 0)] - (let [error (try - (with-silenced-console-error - #(sync-handle-message/handle-message! test-repo client raw-message)) - nil - (catch :default e - e)) - restored-parent (d/entity @conn [:block/uuid parent-uuid]) - restored-property-value (d/entity @conn [:block/uuid property-value-uuid])] - (is (some? error)) - (is (= :db-sync/tx-rejected - (:type (ex-data error)))) - (is (some? restored-parent)) - (is (= (:db/id restored-parent) - (:db/id (:block/parent restored-property-value)))) - (is (= (sync-checksum/recompute-checksum @conn) - (client-op/get-local-checksum test-repo))))))))))) - -(deftest tx-reject-db-transact-failed-rebase-keeps-checksum-aligned-test - (testing "rollback plus rebase of later pending txs should keep the stored checksum aligned" - (let [{:keys [conn client-ops-conn parent-a a-child-1 b-child-1]} (setup-two-parents) - deleted-uuid (:block/uuid a-child-1)] - (with-datascript-conns conn client-ops-conn - (fn [] - (client-op/update-local-checksum test-repo (sync-checksum/recompute-checksum @conn)) - (db-listener/listen-db-changes! test-repo conn :handler-keys [:checksum-test]) - (outliner-core/delete-blocks! conn [a-child-1] {}) - (outliner-core/move-blocks! conn [b-child-1] parent-a {:sibling? false}) - (let [pending (#'sync-apply/pending-txs test-repo) - delete-tx-id (:tx-id (first pending)) - raw-message (js/JSON.stringify - (clj->js {:type "tx/reject" - :reason "db transact failed" - :t 3 - :failed-tx-id (str delete-tx-id)})) - client {:repo test-repo - :graph-id "graph-1" - :inflight (atom (mapv :tx-id pending)) - :online-users (atom []) - :ws-state (atom :open)}] - (is (nil? (d/entity @conn [:block/uuid deleted-uuid]))) - (is (= (sync-checksum/recompute-checksum @conn) - (client-op/get-local-checksum test-repo))) - (with-redefs [client-op/get-local-tx (constantly 0)] - (let [error (try - (with-silenced-console-error - #(sync-handle-message/handle-message! test-repo client raw-message)) - nil - (catch :default e - e))] - (is (some? error)) - (is (= :db-sync/tx-rejected - (:type (ex-data error)))) - (is (= (sync-checksum/recompute-checksum @conn) - (client-op/get-local-checksum test-repo))) - (is (= (:block/uuid parent-a) - (:block/uuid (:block/parent (d/entity @conn (:db/id b-child-1)))))) - (is (some? (d/entity @conn [:block/uuid deleted-uuid]))))))))))) - -(deftest tx-reject-db-transact-failed-selectively-updates-inflight-ops-test - (testing "tx/reject should mark success txs as non-pending and failed tx as failed, leaving later inflight pending" - (let [{:keys [conn client-ops-conn]} (setup-parent-child) - success-tx-id (random-uuid) - failed-tx-id (random-uuid) - untouched-tx-id (random-uuid) - raw-message (js/JSON.stringify - (clj->js {:type "tx/reject" - :reason "db transact failed" - :t 3 - :success-tx-ids [(str success-tx-id)] - :failed-tx-id (str failed-tx-id)})) - client {:repo test-repo - :graph-id "graph-1" - :inflight (atom [success-tx-id failed-tx-id untouched-tx-id]) - :online-users (atom []) - :ws-state (atom :open)}] - (with-datascript-conns conn client-ops-conn - (fn [] - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id success-tx-id - :db-sync/created-at 1 - :db-sync/pending? true} - {:db-sync/tx-id failed-tx-id - :db-sync/created-at 2 - :db-sync/pending? true} - {:db-sync/tx-id untouched-tx-id - :db-sync/created-at 3 - :db-sync/pending? true}]) - (with-redefs [client-op/get-local-tx (constantly 0)] - (let [error (try - (with-silenced-console-error - #(sync-handle-message/handle-message! test-repo client raw-message)) - nil - (catch :default e - e)) - success-ent (client-op-tx-row client-ops-conn success-tx-id) - failed-ent (client-op-tx-row client-ops-conn failed-tx-id) - untouched-ent (client-op-tx-row client-ops-conn untouched-tx-id)] - (is (some? error)) - (is (= :db-sync/tx-rejected - (:type (ex-data error)))) - (is (= "db transact failed" - (:reason (ex-data error)))) - (is (= [] @(:inflight client))) - (is (= 0 (aget success-ent "pending"))) - (is (not= 1 (aget success-ent "failed"))) - (is (= 0 (aget failed-ent "pending"))) - (is (= 1 (aget failed-ent "failed"))) - (is (= 1 (aget untouched-ent "pending"))) - (is (not= 1 (aget untouched-ent "failed")))))))))) - -(deftest tx-reject-missing-blocks-marks-failed-tx-failed-test - (testing "tx/reject with missing block ids should fail the rejected tx" - (let [{:keys [conn client-ops-conn parent]} (setup-parent-child) - failed-tx-id (random-uuid) - missing-uuid (:block/uuid parent) - raw-message (js/JSON.stringify - (clj->js {:type "tx/reject" - :reason "db transact failed" - :t 0 - :failed-tx-id (str failed-tx-id) - :missing-block-uuids [(str missing-uuid)]})) - client {:repo test-repo - :graph-id "graph-1" - :inflight (atom [failed-tx-id]) - :online-users (atom []) - :ws-state (atom :open)}] - (with-datascript-conns - conn client-ops-conn - (fn [] - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id failed-tx-id - :db-sync/created-at 1 - :db-sync/pending? true - :db-sync/outliner-op :save-block - :db-sync/normalized-tx-data [[:db/add [:block/uuid missing-uuid] :block/title "local title"]]}]) - (with-redefs [client-op/get-local-tx (constantly 0)] - (let [error (try - (with-silenced-console-error - #(sync-handle-message/handle-message! test-repo client raw-message)) - nil - (catch :default e - e)) - failed-ent (client-op-tx-row client-ops-conn failed-tx-id) - {:keys [tx-entries]} (#'sync-apply/prepare-upload-tx-entries - conn - (#'sync-apply/pending-txs test-repo))] - (is (some? error)) - (is (= :db-sync/tx-rejected (:type (ex-data error)))) - (is (= [missing-uuid] (:missing-block-uuids (ex-data error)))) - (is (= [] @(:inflight client))) - (is (= 0 (aget failed-ent "pending"))) - (is (= 1 (aget failed-ent "failed"))) - (is (empty? tx-entries))))))))) - -(deftest tx-reject-stale-keeps-inflight-op-pending-test - (testing "stale tx/reject should keep inflight ops pending for retry" - (async done - (let [{:keys [conn client-ops-conn]} (setup-parent-child) - tx-id (random-uuid) - *sent (atom []) - ws (doto (js-obj) - (aset "readyState" 1) - (aset "send" (fn [raw] - (swap! *sent conj (js->clj (js/JSON.parse raw) :keywordize-keys true))))) - raw-message (js/JSON.stringify - (clj->js {:type "tx/reject" - :reason "stale" - :t 3})) - client {:repo test-repo - :graph-id "graph-1" - :ws ws - :send-queue (atom (p/resolved nil)) - :inflight (atom [tx-id]) - :online-users (atom []) - :ws-state (atom :open)}] - (with-datascript-conns conn client-ops-conn - (fn [] - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id tx-id - :db-sync/created-at 1 - :db-sync/pending? true}]) - (with-redefs [client-op/get-local-tx (constantly 0)] - (sync-handle-message/handle-message! test-repo client raw-message) - (-> @(:send-queue client) - (p/then (fn [_] - (let [ent (client-op-tx-row client-ops-conn tx-id)] - (is (= [{:type "pull" :since 0}] @*sent)) - (is (= [tx-id] @(:inflight client))) - (is (= 1 (aget ent "pending"))) - (is (not= 1 (aget ent "failed")))))) - (p/finally (fn [] (done))))))))))) - -(deftest tx-reject-stale-dedupes-pull-request-test - (testing "repeated stale tx/reject should not send duplicated pull requests" - (async done - (let [*sent (atom []) - ws (doto (js-obj) - (aset "readyState" 1) - (aset "send" (fn [raw] - (swap! *sent conj (js->clj (js/JSON.parse raw) :keywordize-keys true))))) - raw-message (js/JSON.stringify - (clj->js {:type "tx/reject" - :reason "stale" - :t 3})) - client {:repo test-repo - :graph-id "graph-1" - :ws ws - :send-queue (atom (p/resolved nil)) - :pending-pull-since (atom nil) - :inflight (atom []) - :online-users (atom []) - :ws-state (atom :open)}] - (with-redefs [client-op/get-local-tx (constantly 0)] - (sync-handle-message/handle-message! test-repo client raw-message) - (sync-handle-message/handle-message! test-repo client raw-message) - (-> @(:send-queue client) - (p/then (fn [_] - (is (= [{:type "pull" :since 0}] @*sent)) - (is (= 0 @(:pending-pull-since client))))) - (p/finally (fn [] (done))))))))) - -(deftest changed-message-dedupes-pull-request-test - (testing "repeated changed should not send duplicated pull requests" - (async done - (let [*sent (atom []) - ws (doto (js-obj) - (aset "readyState" 1) - (aset "send" (fn [raw] - (swap! *sent conj (js->clj (js/JSON.parse raw) :keywordize-keys true))))) - raw-message (js/JSON.stringify - (clj->js {:type "changed" - :t 10})) - client {:repo test-repo - :graph-id "graph-1" - :ws ws - :send-queue (atom (p/resolved nil)) - :pending-pull-since (atom nil) - :inflight (atom []) - :online-users (atom []) - :ws-state (atom :open)}] - (with-redefs [client-op/get-local-tx (constantly 3)] - (sync-handle-message/handle-message! test-repo client raw-message) - (sync-handle-message/handle-message! test-repo client raw-message) - (-> @(:send-queue client) - (p/then (fn [_] - (is (= [{:type "pull" :since 3}] @*sent)) - (is (= 3 @(:pending-pull-since client))))) - (p/finally (fn [] (done))))))))) - -(deftest pull-ok-clears-pending-pull-request-marker-test - (testing "pull/ok clears pending pull marker so future changed can request next pull" - (let [raw-message (js/JSON.stringify - (clj->js {:type "pull/ok" - :t 4 - :txs []})) - client {:repo test-repo - :graph-id "graph-1" - :ws #js {} - :pending-pull-since (atom 3) - :inflight (atom []) - :online-users (atom []) - :ws-state (atom :open)}] - (with-redefs [client-op/get-local-tx (constantly 3) - client-op/update-local-tx (fn [_repo _t] nil) - sync-apply/flush-pending! (fn [& _] nil)] - (sync-handle-message/handle-message! test-repo client raw-message) - (is (nil? @(:pending-pull-since client))))))) - -(deftest hello-checksum-mismatch-logs-warning-test - (testing "hello with matching t but mismatched checksum logs warning without throwing" - (let [{:keys [conn client-ops-conn]} (setup-parent-child) - latest-prev @db-sync/*repo->latest-remote-tx - raw-message (js/JSON.stringify - (clj->js {:type "hello" - :t 0 - :checksum "bad-checksum"})) - client {:repo test-repo - :graph-id "graph-1" - :inflight (atom []) - :online-users (atom []) - :ws-state (atom :open)}] - (with-datascript-conns conn client-ops-conn - (fn [] - (reset! db-sync/*repo->latest-remote-tx {}) - (with-redefs [sync-apply/flush-pending! (fn [& _] nil) - sync-assets/enqueue-asset-sync! (fn [& _] nil)] - (try - (is (= :ok - (try - (sync-handle-message/handle-message! test-repo client raw-message) - :ok - (catch :default _error - :thrown)))) - (finally - (reset! db-sync/*repo->latest-remote-tx latest-prev))))))))) - -(deftest hello-checksum-mismatch-logs-warning-for-e2ee-test - (testing "e2ee graphs also log warning on checksum mismatch without throwing" - (let [{:keys [conn client-ops-conn]} (setup-parent-child) - latest-prev @db-sync/*repo->latest-remote-tx - raw-message (js/JSON.stringify - (clj->js {:type "hello" - :t 0 - :checksum "bad-checksum"})) - client {:repo test-repo - :graph-id "graph-1" - :inflight (atom []) - :online-users (atom []) - :ws-state (atom :open)}] - (with-datascript-conns conn client-ops-conn - (fn [] - (reset! db-sync/*repo->latest-remote-tx {}) - (with-redefs [sync-apply/flush-pending! (fn [& _] nil) - sync-assets/enqueue-asset-sync! (fn [& _] nil) - sync-crypt/graph-e2ee? (constantly true)] - (try - (is (= :ok - (try - (sync-handle-message/handle-message! test-repo client raw-message) - :ok - (catch :default _error - :thrown)))) - (finally - (reset! db-sync/*repo->latest-remote-tx latest-prev))))))))) - -(deftest hello-without-checksum-is-accepted-test - (testing "legacy hello without checksum is accepted" - (let [{:keys [conn client-ops-conn]} (setup-parent-child) - latest-prev @db-sync/*repo->latest-remote-tx - raw-message (js/JSON.stringify - (clj->js {:type "hello" - :t 0})) - client {:repo test-repo - :graph-id "graph-1" - :inflight (atom []) - :online-users (atom []) - :ws-state (atom :open)}] - (with-datascript-conns conn client-ops-conn - (fn [] - (reset! db-sync/*repo->latest-remote-tx {}) - (with-redefs [sync-apply/flush-pending! (fn [& _] nil) - sync-assets/enqueue-asset-sync! (fn [& _] nil)] - (sync-handle-message/handle-message! test-repo client raw-message) - (is (= 0 (get @db-sync/*repo->latest-remote-tx test-repo))) - (reset! db-sync/*repo->latest-remote-tx latest-prev))))))) - -(deftest pull-ok-without-checksum-is-accepted-test - (testing "legacy pull/ok without checksum is accepted" - (async done - (let [{:keys [conn client-ops-conn parent]} (setup-parent-child) - parent-id (:db/id parent) - new-tx (sqlite-util/write-transit-str [[:db/add parent-id :block/title "remote-new-title"]]) - raw-message (js/JSON.stringify - (clj->js {:type "pull/ok" - :t 2 - :txs [{:t 2 :tx new-tx}]})) - latest-prev @db-sync/*repo->latest-remote-tx - client {:repo test-repo - :graph-id "graph-1" - :inflight (atom []) - :online-users (atom []) - :ws-state (atom :open)}] - (reset! db-sync/*repo->latest-remote-tx {}) - (with-datascript-conns conn client-ops-conn - (fn [] - (-> (p/let [_ (sync-handle-message/handle-message! test-repo client raw-message) - parent' (d/entity @conn parent-id)] - (is (= "remote-new-title" (:block/title parent'))) - (is (= 2 (client-op/get-local-tx test-repo)))) - (p/finally (fn [] - (reset! db-sync/*repo->latest-remote-tx latest-prev) - (done)))))))))) - -(deftest pull-ok-batched-txs-preserve-tempid-boundaries-test - (testing "pull/ok applies tx batches without cross-tx tempid collisions" - (let [{:keys [conn client-ops-conn parent]} (setup-parent-child) - page-uuid (:block/uuid (:block/page parent)) - block-uuid-a (random-uuid) - block-uuid-b (random-uuid) - now 1760000000000 - tx-a [[:db/add -1 :block/uuid block-uuid-a] - [:db/add -1 :block/title "remote-a"] - [:db/add -1 :block/parent [:block/uuid page-uuid]] - [:db/add -1 :block/page [:block/uuid page-uuid]] - [:db/add -1 :block/order 1] - [:db/add -1 :block/updated-at now] - [:db/add -1 :block/created-at now]] - tx-b [[:db/add -1 :block/uuid block-uuid-b] - [:db/add -1 :block/title "remote-b"] - [:db/add -1 :block/parent [:block/uuid page-uuid]] - [:db/add -1 :block/page [:block/uuid page-uuid]] - [:db/add -1 :block/order 2] - [:db/add -1 :block/updated-at now] - [:db/add -1 :block/created-at now]]] - (with-datascript-conns conn client-ops-conn - (fn [] - (is (nil? (try - (#'sync-apply/apply-remote-txs! test-repo nil [{:tx-data tx-a} - {:tx-data tx-b}]) - nil - (catch :default e - e))))))))) - -(deftest apply-remote-txs-updates-journal-title-format-test - (testing "remote journal title format changes apply without blocking sync" - (let [conn (db-test/create-conn-with-blocks - {:pages-and-blocks [{:page {:build/journal 20250314}}]}) - client-ops-conn (new-client-ops-db) - journal (db-test/find-journal-by-journal-day @conn 20250314) - tx-id-before (:block/tx-id journal) - journal-class (d/entity @conn :logseq.class/Journal) - title-format "EEE, dd.MM.yyyy" - title "Fri, 14.03.2025"] - (reset! ldb/*transact-pipeline-fn worker-pipeline/transact-pipeline) - (with-datascript-conns conn client-ops-conn - (fn [] - (#'sync-apply/apply-remote-txs! - test-repo - nil - [{:tx-data [[:db/add (:db/id journal-class) - :logseq.property.journal/title-format title-format] - [:db/add (:db/id journal) :block/title title]]}]) - (is (= title-format - (:logseq.property.journal/title-format - (d/entity @conn :logseq.class/Journal)))) - (is (= title - (:block/title - (db-test/find-journal-by-journal-day @conn 20250314)))) - (is (not= tx-id-before - (:block/tx-id - (db-test/find-journal-by-journal-day @conn 20250314))))))))) - -(deftest apply-remote-txs-applies-db-migration-entry-test - (testing "pulled db migration txs apply with migration transact semantics" - (let [conn (db-test/create-conn) - client-ops-conn (new-client-ops-db) - block-uuid (random-uuid) - tx-data [[:db/add -1 :block/uuid block-uuid] - [:db/add -1 :block/title "remote-migration-only"]] - tx-metas (atom [])] - (with-datascript-conns conn client-ops-conn - (fn [] - (d/listen! conn ::capture-remote-db-migrate-tx-meta - (fn [tx-report] - (swap! tx-metas conj (:tx-meta tx-report)))) - (try - (#'sync-apply/apply-remote-txs! test-repo nil [{:tx-data tx-data - :outliner-op :db-migrate}]) - (finally - (d/unlisten! conn ::capture-remote-db-migrate-tx-meta))) - (is (some (fn [tx-meta] - (and (:db-migrate? tx-meta) - (:skip-validate-db? tx-meta))) - @tx-metas)) - (is (= "remote-migration-only" - (:block/title (first (d/q '[:find [(pull ?e [:block/title]) ...] - :where [?e :block/title "remote-migration-only"]] - @conn)))))))))) - -(defn- remote-asset-tx-data - [asset-uuid page-uuid title] - [[:db/add -1 :block/uuid asset-uuid] - [:db/add -1 :block/title title] - [:db/add -1 :block/parent [:block/uuid page-uuid]] - [:db/add -1 :block/page [:block/uuid page-uuid]] - [:db/add -1 :block/order "a0"] - [:db/add -1 :block/created-at 1760000000000] - [:db/add -1 :block/updated-at 1760000000000] - [:db/add -1 :block/tags :logseq.class/Asset] - [:db/add -1 :logseq.property.asset/type "png"] - [:db/add -1 :logseq.property.asset/size 42] - [:db/add -1 :logseq.property.asset/checksum "remote-checksum"] - [:db/add -1 :logseq.property.asset/remote-metadata {:checksum "remote-checksum" - :type "png"}]]) - -(defn- minimal-platform - [owner-source] - {:env {:runtime (if (= :browser owner-source) :browser :node) - :owner-source owner-source} - :storage {} - :kv {} - :broadcast {} - :websocket {} - :crypto {} - :timers {} - :sqlite {}}) - -(defn- apply-remote-asset-tx-with-owner-source - [owner-source calls] - (let [{:keys [conn client-ops-conn parent]} (setup-parent-child) - page-uuid (:block/uuid (:block/page parent)) - asset-uuid (random-uuid) - title (str "remote-" (name owner-source) "-asset.png") - client (test-sync-client)] - (platform/set-platform! (minimal-platform owner-source)) - (with-datascript-conns - conn - client-ops-conn - (fn [] - (p/with-redefs [sync-assets/download-missing-remote-assets! - (fn [& _args] - (throw (ex-info "incremental sync should not scan all assets" {}))) - sync-assets/download-remote-assets-if-missing! - (fn [repo graph-id candidates] - (swap! calls conj [owner-source repo graph-id (mapv :asset-type candidates)]) - (p/resolved {:total 1 - :downloaded 1 - :skipped-existing 0}))] - (p/let [_ (#'sync-apply/apply-remote-txs! - test-repo client [{:tx-data (remote-asset-tx-data asset-uuid page-uuid title)}])] - (is (= title (:block/title (d/entity @conn [:block/uuid asset-uuid])))))))))) - -(deftest apply-remote-txs-downloads-missing-assets-for-cli-and-desktop-test - (async done - (let [platform-prev (try - (platform/current) - (catch :default _ nil)) - calls (atom [])] - (-> (p/let [_ (apply-remote-asset-tx-with-owner-source :cli calls) - _ (apply-remote-asset-tx-with-owner-source :electron calls)] - (is (some #{[:cli test-repo "graph-1" ["png"]]} @calls)) - (is (some #{[:electron test-repo "graph-1" ["png"]]} @calls))) - (p/catch (fn [error] - (is false (str "unexpected error: " error)))) - (p/finally - (fn [] - (when platform-prev - (platform/set-platform! platform-prev)) - (done))))))) - -(deftest apply-remote-txs-keeps-browser-assets-lazy-test - (async done - (let [{:keys [conn client-ops-conn parent]} (setup-parent-child) - page-uuid (:block/uuid (:block/page parent)) - asset-uuid (random-uuid) - title "remote-browser-asset.png" - client (test-sync-client) - calls (atom []) - platform-prev (try - (platform/current) - (catch :default _ nil))] - (platform/set-platform! (minimal-platform :browser)) - (-> (with-datascript-conns - conn - client-ops-conn - (fn [] - (p/with-redefs [sync-assets/download-missing-remote-assets! - (fn [& _args] - (throw (ex-info "browser sync should not eagerly download assets" {}))) - sync-assets/download-remote-assets-if-missing! - (fn [repo graph-id candidates] - (swap! calls conj [repo graph-id candidates]) - (p/resolved {:total 1 - :downloaded 1 - :skipped-existing 0}))] - (p/let [_ (#'sync-apply/apply-remote-txs! - test-repo client [{:tx-data (remote-asset-tx-data asset-uuid page-uuid title)}])] - (is (= title (:block/title (d/entity @conn [:block/uuid asset-uuid])))))))) - (p/then (fn [_] - (is (= [] @calls)))) - (p/catch (fn [error] - (is false (str "unexpected error: " error)))) - (p/finally - (fn [] - (when platform-prev - (platform/set-platform! platform-prev)) - (done))))))) - -(deftest apply-remote-txs-preserves-many-page-property-values-test - (testing "remote txs keep both values when a new page-many property is created and then assigned twice" - (let [graph {:pages-and-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "remote object"}]}]} - conn-a (db-test/create-conn-with-blocks graph) - conn-b (d/conn-from-db @conn-a) - client-ops-conn (new-client-ops-db) - remote-txs (atom []) - property-id :plugin.property._test_plugin/x7] - (d/listen! conn-b ::capture-remote-many-page-property - (fn [tx-report] - (swap! remote-txs conj - {:tx-data (db-normalize/normalize-tx-data - (:db-after tx-report) - (:db-before tx-report) - (:tx-data tx-report)) - :outliner-op (get-in tx-report [:tx-meta :outliner-op])}))) - (try - (let [block-id (:db/id (db-test/find-block-by-content @conn-b "remote object"))] - (outliner-property/upsert-property! conn-b property-id - {:logseq.property/type :page - :db/cardinality :db.cardinality/many} - {:property-name "x7"}) - (outliner-property/set-block-property! conn-b block-id property-id "Page y") - (outliner-property/set-block-property! conn-b block-id property-id "Page z")) - (with-datascript-conns conn-a client-ops-conn - (fn [] - (#'sync-apply/apply-remote-txs! test-repo nil @remote-txs) - (let [block' (db-test/find-block-by-content @conn-a "remote object")] - (is (= #{"page y" "page z"} - (set (map :block/name (:plugin.property._test_plugin/x7 block')))))))) - (finally - (d/unlisten! conn-b ::capture-remote-many-page-property)))))) - -(deftest batch-transact-preserves-many-page-property-values-test - (testing "temp conn batch keeps both values when a new page-many property is created and then assigned twice" - (let [conn (db-test/create-conn-with-blocks - {:pages-and-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "remote object"}]}]}) - block-id (:db/id (db-test/find-block-by-content @conn "remote object")) - property-id :plugin.property._test_plugin/x7] - (ldb/batch-transact-with-temp-conn! - conn - {} - (fn [temp-conn] - (outliner-property/upsert-property! temp-conn property-id - {:logseq.property/type :page - :db/cardinality :db.cardinality/many} - {:property-name "x7"}) - (outliner-property/set-block-property! temp-conn block-id property-id "Page y") - (outliner-property/set-block-property! temp-conn block-id property-id "Page z"))) - (let [block' (db-test/find-block-by-content @conn "remote object")] - (is (= #{"page y" "page z"} - (set (map :block/name (:plugin.property._test_plugin/x7 block'))))))))) - -(deftest batch-transact-preserves-tag-many-page-property-values-test - (testing "temp conn batch keeps tag property values when a new many page property is upserted first" - (let [conn (db-test/create-conn-with-blocks - {:pages-and-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "remote object"}]}]}) - property-id :plugin.property._test_plugin/x7] - (ldb/batch-transact-with-temp-conn! - conn - {} - (fn [temp-conn] - (outliner-property/upsert-property! temp-conn property-id - {:logseq.property/type :page - :db/cardinality :db.cardinality/many} - {:property-name "x7"}) - (outliner-page/create! temp-conn "Tag x" {:class? true}) - (let [tag-id (:db/id (ldb/get-page @temp-conn "Tag x"))] - (outliner-property/set-block-property! temp-conn tag-id property-id "Page y") - (outliner-property/set-block-property! temp-conn tag-id property-id "Page z")))) - (let [tag' (ldb/get-page @conn "Tag x")] - (is (ldb/class? tag')) - (is (= #{"page y" "page z"} - (set (map :block/name (:plugin.property._test_plugin/x7 tag'))))))))) - -(deftest replace-attr-retract-with-retract-entity-preserves-input-order-test - (testing "temp batch replay transform keeps property schema datoms before later value datoms" - (let [conn (db-test/create-conn-with-blocks - {:pages-and-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "remote object"}]}]}) - block-id (:db/id (db-test/find-block-by-content @conn "remote object")) - property-id :plugin.property._test_plugin/x7 - temp-conn (d/conn-from-db @conn) - *batch-tx-data (volatile! [])] - (swap! temp-conn assoc - :skip-store? true - :batch-tx? true) - (d/listen! temp-conn ::capture-temp-batch - (fn [{:keys [tx-data]}] - (vswap! *batch-tx-data into tx-data))) - (try - (outliner-property/upsert-property! temp-conn property-id - {:logseq.property/type :page - :db/cardinality :db.cardinality/many} - {:property-name "x7"}) - (outliner-property/set-block-property! temp-conn block-id property-id "Page y") - (outliner-property/set-block-property! temp-conn block-id property-id "Page z") - (let [tx-data @*batch-tx-data - tx-data' (db-normalize/replace-attr-retract-with-retract-entity @temp-conn tx-data) - schema-index (first (keep-indexed - (fn [idx d] - (when (and (= :db/ident (:a d)) - (= property-id (:v d))) - idx)) - tx-data')) - value-index (first (keep-indexed - (fn [idx d] - (when (and (= block-id (:e d)) - (= property-id (:a d)) - (:added d)) - idx)) - tx-data'))] - (is (number? schema-index)) - (is (number? value-index)) - (is (< schema-index value-index))) - (finally - (d/unlisten! temp-conn ::capture-temp-batch)))))) - -(deftest local-checksum-matches-recompute-after-post-pipeline-update-test - (testing "stored checksum matches recompute when updated from post-pipeline tx report" - (let [{:keys [conn client-ops-conn parent]} (setup-parent-child)] - (with-datascript-conns conn client-ops-conn - (fn [] - (let [page-id (:db/id (:block/page parent)) - parent-id (:db/id parent) - block-uuid (random-uuid) - now 1773661308002 - tx-report* (d/with @conn [[:db/add -1 :block/uuid block-uuid] - [:db/add -1 :block/title "Checksum Block"] - [:db/add -1 :block/parent parent-id] - [:db/add -1 :block/page page-id] - [:db/add -1 :block/order "a0"] - [:db/add -1 :block/created-at now] - [:db/add -1 :block/updated-at now]] - {:outliner-op :insert-blocks}) - tx-report (worker-pipeline/transact-pipeline tx-report*)] - (db-sync/update-local-sync-checksum! test-repo tx-report) - (is (= (client-op/get-local-checksum test-repo) - (sync-checksum/recompute-checksum (:db-after tx-report)))))))))) - -(deftest local-checksum-listener-updates-in-release-mode-test - (testing "db-worker-node release keeps the stored checksum aligned incrementally" - (let [{:keys [conn client-ops-conn parent]} (setup-parent-child)] - (with-datascript-conns conn client-ops-conn - (fn [] - (client-op/update-local-checksum test-repo (sync-checksum/recompute-checksum @conn)) - (with-redefs [worker-util/dev-or-test? false] - (db-listener/listen-db-changes! test-repo conn :handler-keys [:checksum-test]) - (d/transact! conn [[:db/add (:db/id parent) :block/title "Release checksum block"]]) - (is (= (sync-checksum/recompute-checksum @conn) - (client-op/get-local-checksum test-repo))))))))) - -(deftest local-checksum-ignores-aborted-batch-transact-test - (testing "an aborted batch transaction must not advance the stored checksum" - (let [{:keys [conn client-ops-conn parent]} (setup-parent-child)] - (with-datascript-conns conn client-ops-conn - (fn [] - (client-op/update-local-checksum test-repo (sync-checksum/recompute-checksum @conn)) - (db-listener/listen-db-changes! test-repo conn :handler-keys [:checksum-test]) - (let [checksum-before (client-op/get-local-checksum test-repo) - title-before (:block/title parent)] - (is (thrown? js/Error - (ldb/batch-transact! - conn - {:outliner-op :checksum-abort-test} - (fn [conn] - (ldb/transact! conn [[:db/add (:db/id parent) - :block/title - "aborted batch title"]]) - (throw (js/Error. "abort checksum batch")))))) - (is (= title-before (:block/title (d/entity @conn (:db/id parent))))) - (is (= (sync-checksum/recompute-checksum @conn) - checksum-before - (client-op/get-local-checksum test-repo))) - (ldb/batch-transact! - conn - {:outliner-op :checksum-commit-test} - (fn [conn] - (ldb/transact! conn [[:db/add (:db/id parent) - :block/title - "committed batch title"]]))) - (is (= (sync-checksum/recompute-checksum @conn) - (client-op/get-local-checksum test-repo))))))))) - -(deftest local-checksum-updates-for-final-batch-report-with-batch-flag-test - (testing "a committed final batch tx report must update checksum even if the conn batch flag is still set" - (let [{:keys [conn client-ops-conn parent]} (setup-parent-child)] - (with-datascript-conns conn client-ops-conn - (fn [] - (client-op/update-local-checksum test-repo (sync-checksum/recompute-checksum @conn)) - (db-listener/listen-db-changes! test-repo conn :handler-keys [:checksum-test]) - (try - (swap! conn assoc :batch-tx? true) - (d/transact! conn - [[:db/add (:db/id parent) - :block/title - "final batch report title"]] - {:outliner-op :checksum-final-batch-test - :batch-final-tx-report? true}) - (finally - (swap! conn dissoc :batch-tx?))) - (is (= (sync-checksum/recompute-checksum @conn) - (client-op/get-local-checksum test-repo)))))))) - -(deftest local-checksum-updates-non-batch-report-with-stale-batch-flag-test - (testing "a non-batch tx report must not be skipped because conn batch state is stale" - (let [{:keys [conn client-ops-conn parent]} (setup-parent-child)] - (with-datascript-conns conn client-ops-conn - (fn [] - (client-op/update-local-checksum test-repo (sync-checksum/recompute-checksum @conn)) - (db-listener/listen-db-changes! test-repo conn :handler-keys [:checksum-test]) - (try - (swap! conn assoc :batch-tx? true) - (d/transact! conn - [[:db/add (:db/id parent) - :block/title - "non-batch tx while stale batch flag is set"]] - {:outliner-op :checksum-stale-batch-flag-test}) - (finally - (swap! conn dissoc :batch-tx?))) - (is (= (sync-checksum/recompute-checksum @conn) - (client-op/get-local-checksum test-repo)))))))) - -(deftest local-checksum-updates-ldb-non-batch-report-with-stale-batch-flag-test - (testing "ldb/transact! must not tag non-batch reports from stale conn batch state" - (let [{:keys [conn client-ops-conn parent]} (setup-parent-child)] - (with-datascript-conns conn client-ops-conn - (fn [] - (client-op/update-local-checksum test-repo (sync-checksum/recompute-checksum @conn)) - (db-listener/listen-db-changes! test-repo conn :handler-keys [:checksum-test]) - (try - (swap! conn assoc :batch-tx? true) - (ldb/transact! conn - [[:db/add (:db/id parent) - :block/title - "ldb non-batch tx while stale batch flag is set"]] - {:outliner-op :checksum-ldb-stale-batch-flag-test}) - (finally - (swap! conn dissoc :batch-tx?))) - (is (= (sync-checksum/recompute-checksum @conn) - (client-op/get-local-checksum test-repo)))))))) - -(deftest batch-transact-tags-inner-tx-reports-test - (testing "inner batch reports carry stable metadata independent from mutable conn state" - (let [{:keys [conn parent]} (setup-parent-child) - captured (atom [])] - (with-datascript-conns conn nil - (fn [] - (d/listen! conn ::capture-batch-tx-meta - (fn [tx-report] - (swap! captured conj (:tx-meta tx-report)))) - (try - (ldb/batch-transact! - conn - {:outliner-op :checksum-batch-final-test} - (fn [conn] - (ldb/transact! conn - [[:db/add (:db/id parent) - :block/title - "inner batch report title"]] - {:outliner-op :checksum-inner-batch-test}))) - (finally - (d/unlisten! conn ::capture-batch-tx-meta))) - (let [[inner final] @captured] - (is (:batch-tx-report? inner)) - (is (not (:batch-final-tx-report? inner))) - (is (:batch-final-tx-report? final)) - (is (not (:batch-tx-report? final))))))))) - -(deftest remote-batch-drops-follow-up-ops-for-stale-created-block-test - (testing "remote txs later in the same batch should not apply ops for an entity dropped as stale" - (let [{:keys [conn client-ops-conn parent]} (setup-parent-child) - page-id (:db/id (:block/page parent)) - missing-parent-uuid (random-uuid) - stale-child-uuid (random-uuid) - now 1783110501711 - client (test-sync-client) - remote-txs [{:t 1 - :outliner-op :insert-blocks - :tx-data [[:db/add "stale-child" :block/uuid stale-child-uuid] - [:db/add "stale-child" :block/title "stale child"] - [:db/add "stale-child" :block/parent [:block/uuid missing-parent-uuid]] - [:db/add "stale-child" :block/page page-id] - [:db/add "stale-child" :block/order "a0"] - [:db/add "stale-child" :block/created-at now] - [:db/add "stale-child" :block/updated-at now]]} - {:t 2 - :outliner-op :save-block - :tx-data [[:db/add [:block/uuid stale-child-uuid] - :block/title - "stale child update"]]}]] - (with-datascript-conns conn client-ops-conn - (fn [] - (client-op/update-local-checksum test-repo (sync-checksum/recompute-checksum @conn)) - (with-silenced-console-error - (fn [] - (is (= :ok - (try - (sync-apply/apply-remote-txs! test-repo client remote-txs) - :ok - (catch :default _error - :thrown)))))) - (is (nil? (d/entity @conn [:block/uuid stale-child-uuid]))) - (is (= (sync-checksum/recompute-checksum @conn) - (client-op/get-local-checksum test-repo)))))))) - -(deftest first-local-block-after-upload-keeps-server-checksum-in-sync-test - (testing "the first local block tx after upload keeps server and client checksums equal" - (let [{:keys [conn client-ops-conn parent]} (setup-parent-child) - server-conn (d/conn-from-db @conn)] - (with-datascript-conns conn client-ops-conn - (fn [] - (let [parent-id (:db/id parent) - block-uuid (random-uuid)] - (outliner-core/insert-blocks! conn - [{:block/title "Uploaded graph block" - :block/uuid block-uuid}] - (d/entity @conn parent-id) - {:sibling? false - :keep-uuid? true}) - (let [tx-entries (->> (#'sync-apply/pending-txs test-repo) - (mapv (fn [{:keys [tx outliner-op]}] - {:tx (sqlite-util/write-transit-str - (->> tx - (db-normalize/remove-retract-entity-ref @conn) - distinct - vec)) - :outliner-op outliner-op})))] - (doseq [tx-entry tx-entries] - (#'sync-handler/apply-tx-entry! server-conn tx-entry)) - (is (= (sync-checksum/recompute-checksum @conn) - (sync-checksum/recompute-checksum @server-conn)))))))))) - -(deftest first-page-and-block-after-upload-keeps-server-checksum-in-sync-test - (testing "creating the first page and first block after upload keeps server and client checksums equal" - (let [conn (db-test/create-conn) - client-ops-conn (new-client-ops-db) - server-conn (d/conn-from-db @conn) - page-uuid (random-uuid) - block-uuid (random-uuid)] - (with-datascript-conns conn client-ops-conn - (fn [] - (worker-page/create! conn "Fresh Sync Page" :uuid page-uuid) - (outliner-core/insert-blocks! conn - [{:block/title "Fresh graph block" - :block/uuid block-uuid}] - (d/entity @conn [:block/uuid page-uuid]) - {:sibling? false - :keep-uuid? true}) - (let [tx-entries (->> (#'sync-apply/pending-txs test-repo) - (mapv (fn [{:keys [tx outliner-op]}] - {:tx (sqlite-util/write-transit-str - (->> tx - (db-normalize/remove-retract-entity-ref @conn) - distinct - vec)) - :outliner-op outliner-op})))] - (doseq [tx-entry tx-entries] - (#'sync-handler/apply-tx-entry! server-conn tx-entry)) - (is (= (sync-checksum/recompute-checksum @conn) - (sync-checksum/recompute-checksum @server-conn))))))))) - -(deftest snapshot-roundtrip-first-page-and-block-after-upload-keeps-server-checksum-in-sync-test - (testing "freshly uploaded graph storage roundtrip keeps the first page/block tx in sync" - (let [base-conn (db-test/create-conn) - local-storage (make-storage-sql) - server-storage (make-storage-sql) - local-conn (d/conn-from-datoms (d/datoms @base-conn :eavt) - (d/schema @base-conn) - {:storage (sync-storage/new-sqlite-storage (:sql local-storage))}) - client-ops-conn (new-client-ops-db) - _ (#'sync-handler/import-snapshot-rows! (:sql server-storage) "kvs" (kvs-rows (:state local-storage))) - server-conn (sync-storage/open-conn (:sql server-storage)) - page-uuid (random-uuid) - block-uuid (random-uuid) - server-self #js {:sql (:sql server-storage) - :conn server-conn - :schema-ready true}] - (with-datascript-conns local-conn client-ops-conn - (fn [] - (worker-page/create! local-conn "Fresh Sync Page" :uuid page-uuid) - (outliner-core/insert-blocks! local-conn - [{:block/title "Fresh graph block" - :block/uuid block-uuid}] - (d/entity @local-conn [:block/uuid page-uuid]) - {:sibling? false - :keep-uuid? true}) - (let [sanitize-tx (fn [tx] - (->> tx - (db-normalize/remove-retract-entity-ref @local-conn) - distinct - vec)) - tx-entries (mapv (fn [{:keys [tx outliner-op]}] - {:tx (sqlite-util/write-transit-str (sanitize-tx tx)) - :outliner-op outliner-op}) - (#'sync-apply/pending-txs test-repo)) - response (with-redefs [ws/broadcast! (fn [& _] nil)] - (sync-handler/handle-tx-batch! server-self nil tx-entries 0))] - (is (= "tx/batch/ok" (:type response))) - (is (= (sync-checksum/recompute-checksum @local-conn) - (sync-checksum/recompute-checksum @server-conn))))))))) - -(deftest reaction-add-enqueues-pending-sync-tx-test - (testing "adding a reaction should enqueue tx for db-sync" - (let [{:keys [conn client-ops-conn parent]} (setup-parent-child)] - (with-datascript-conns conn client-ops-conn - (fn [] - (apply-ops! conn - [[:toggle-reaction [(:block/uuid parent) "+1" nil]]] - local-tx-meta) - (let [pending (#'sync-apply/pending-txs test-repo) - txs (mapcat :tx pending)] - (is (seq pending)) - (is (= :toggle-reaction (:outliner-op (first pending)))) - (is (some (fn [tx] - (and (vector? tx) - (= :db/add (first tx)) - (= :logseq.property.reaction/emoji-id (nth tx 2 nil)) - (= "+1" (nth tx 3 nil)))) - txs)))))))) - -(deftest db-migration-tx-enqueues-db-migrate-pending-op-test - (testing "db migration txs keep a sync-visible marker" - (let [conn (db-test/create-conn) - client-ops-conn (new-client-ops-db) - block-uuid (random-uuid)] - (with-datascript-conns conn client-ops-conn - (fn [] - (ldb/transact! conn - [[:db/add -1 :block/uuid block-uuid] - [:db/add -1 :block/title "migration-only"]] - {:db-migrate? true - :skip-validate-db? true}) - (let [pending (#'sync-apply/pending-txs test-repo)] - (is (= 1 (count pending))) - (is (= :db-migrate (:outliner-op (first pending)))))))))) - -(deftest rename-page-enqueues-canonical-save-block-pending-op-test - (testing "rename-page is persisted as canonical save-block op" - (let [{:keys [conn client-ops-conn]} (setup-parent-child) - page-uuid (random-uuid)] - (with-datascript-conns conn client-ops-conn - (fn [] - (worker-page/create! conn "Rename Me" :uuid page-uuid) - (apply-ops! conn - [[:rename-page [page-uuid "Renamed"]]] - local-tx-meta) - (let [{:keys [forward-outliner-ops]} (last (#'sync-apply/pending-txs test-repo))] - (is (= :save-block (ffirst forward-outliner-ops))) - (is (= {:block/uuid page-uuid - :block/title "Renamed"} - (first (second (first forward-outliner-ops))))))))))) - -(deftest move-blocks-up-down-enqueues-canonical-move-blocks-pending-op-test - (testing "move-blocks-up-down is persisted as semantic move-blocks-up-down op" - (let [{:keys [conn client-ops-conn child2]} (setup-parent-child)] - (with-datascript-conns conn client-ops-conn - (fn [] - (apply-ops! conn - [[:move-blocks-up-down [[(:db/id child2)] true]]] - local-tx-meta) - (let [{:keys [forward-outliner-ops]} (first (#'sync-apply/pending-txs test-repo)) - [op [ids up?]] (first forward-outliner-ops)] - (is (= :move-blocks-up-down op)) - (is (seq ids)) - (is (= true up?)))))))) - -(deftest indent-outdent-enqueues-canonical-move-blocks-pending-op-test - (testing "indent-outdent-blocks is persisted as canonical move-blocks op" - (let [{:keys [conn client-ops-conn child2]} (setup-parent-child)] - (with-datascript-conns conn client-ops-conn - (fn [] - (apply-ops! conn - [[:indent-outdent-blocks [[(:db/id child2)] true {}]]] - local-tx-meta) - (let [{:keys [forward-outliner-ops]} (first (#'sync-apply/pending-txs test-repo)) - [_ [_ target-id opts]] (first forward-outliner-ops)] - (is (= :move-blocks (ffirst forward-outliner-ops))) - (is (some? target-id)) - (is (contains? opts :sibling?)) - (is (nil? (:source-op opts))))))))) - -(deftest indent-outdent-direct-outdent-last-child-builds-forward-and-inverse-move-history-test - (testing "direct outdent on last child builds concrete move forward/inverse ops with ui outliner-op metadata" - (let [{:keys [conn client-ops-conn parent child2 child3]} (setup-parent-child) - tx-meta (assoc local-tx-meta :outliner-op :move-blocks)] - (with-datascript-conns conn client-ops-conn - (fn [] - (apply-ops! conn - [[:indent-outdent-blocks [[(:db/id child3)] false {:parent-original nil - :logical-outdenting? nil}]]] - tx-meta) - (let [source-row (first (#'sync-apply/pending-txs test-repo)) - forward-ops (:forward-outliner-ops source-row) - inverse-ops (:inverse-outliner-ops source-row)] - (is (= :move-blocks (ffirst forward-ops))) - (is (= [(:block/uuid child3)] - (get-in forward-ops [0 1 0]))) - (is (= (:block/uuid parent) - (get-in forward-ops [0 1 1]))) - (is (= true (get-in forward-ops [0 1 2 :sibling?]))) - (is (= :move-blocks (ffirst inverse-ops))) - (is (= [(:block/uuid child3)] - (get-in inverse-ops [0 1 0]))) - (is (= (:block/uuid child2) - (get-in inverse-ops [0 1 1]))) - (is (= true (get-in inverse-ops [0 1 2 :sibling?]))))))))) - -(deftest indent-outdent-direct-outdent-with-right-sibling-persists-semantic-move-history-test - (testing "direct outdent with right siblings persists concrete semantic move forward/inverse ops" - (let [{:keys [conn client-ops-conn parent child1 child2]} (setup-parent-child) - tx-meta (assoc local-tx-meta :outliner-op :move-blocks)] - (with-datascript-conns conn client-ops-conn - (fn [] - (apply-ops! conn - [[:indent-outdent-blocks [[(:db/id child2)] false {:parent-original nil - :logical-outdenting? nil}]]] - tx-meta) - (let [source-row (first (#'sync-apply/pending-txs test-repo)) - forward-ops (:forward-outliner-ops source-row) - inverse-ops (:inverse-outliner-ops source-row)] - (is (= :move-blocks (ffirst forward-ops))) - (is (= [(:block/uuid child2)] - (get-in forward-ops [0 1 0]))) - (is (= (:block/uuid parent) - (get-in forward-ops [0 1 1]))) - (is (= true (get-in forward-ops [0 1 2 :sibling?]))) - (is (= :move-blocks (ffirst inverse-ops))) - (is (= [(:block/uuid child2)] - (get-in inverse-ops [0 1 0]))) - (is (= (:block/uuid child1) - (get-in inverse-ops [0 1 1]))) - (is (= true (get-in inverse-ops [0 1 2 :sibling?]))))))))) - -(deftest indent-outdent-direct-outdent-undo-restores-right-sibling-parent-test - (testing "undo after direct outdent restores right sibling parent to original parent" - (let [{:keys [conn client-ops-conn parent child2 child3]} (setup-parent-child) - parent-uuid (:block/uuid parent) - child2-uuid (:block/uuid child2) - child3-uuid (:block/uuid child3)] - (with-datascript-conns conn client-ops-conn - (fn [] - (apply-ops! conn - [[:indent-outdent-blocks [[(:db/id child2)] false {:parent-original nil - :logical-outdenting? nil}]]] - local-tx-meta) - (let [source-row (first (#'sync-apply/pending-txs test-repo)) - source-tx-id (:tx-id source-row) - child3-after-outdent (d/entity @conn [:block/uuid child3-uuid])] - (is (= child2-uuid - (:block/uuid (:block/parent child3-after-outdent)))) - (let [undo-result (#'sync-apply/apply-history-action! test-repo source-tx-id true {}) - child2-after-undo (d/entity @conn [:block/uuid child2-uuid]) - child3-after-undo (d/entity @conn [:block/uuid child3-uuid])] - (is (= true (:applied? undo-result))) - (is (= parent-uuid - (:block/uuid (:block/parent child2-after-undo)))) - (is (= parent-uuid - (:block/uuid (:block/parent child3-after-undo))))))))))) - -(deftest indent-outdent-undo-enqueues-concrete-move-blocks-history-test - (testing "indent-outdent outdent-path persists concrete semantic move history and undo/redo replays without invalid entities" - (let [{:keys [conn client-ops-conn child2]} (setup-parent-child) - prev-invalid-callback @ldb/*transact-invalid-callback - invalid-payload* (atom nil)] - (with-datascript-conns conn client-ops-conn - (fn [] - (reset! ldb/*transact-invalid-callback - (fn [tx-report errors] - (reset! invalid-payload* {:tx-meta (:tx-meta tx-report) - :errors errors}))) - (try - (apply-ops! conn - [[:indent-outdent-blocks [[(:db/id child2)] false {:parent-original nil - :logical-outdenting? nil}]]] - local-tx-meta) - (let [source-row (first (#'sync-apply/pending-txs test-repo)) - source-tx-id (:tx-id source-row) - undo-result (#'sync-apply/apply-history-action! test-repo source-tx-id true {}) - redo-result (#'sync-apply/apply-history-action! test-repo source-tx-id false {})] - (is (= :move-blocks (ffirst (:forward-outliner-ops source-row)))) - (is (= true (:applied? undo-result))) - (is (= true (:applied? redo-result))) - (is (nil? @invalid-payload*)) - (is (= "child 2" (:block/title (d/entity @conn (:db/id child2)))))) - (finally - (reset! ldb/*transact-invalid-callback prev-invalid-callback)))))))) - -(deftest enqueue-local-tx-preserves-existing-tx-id-test - (testing "local tx persistence reuses tx-id already attached to tx-meta" - (let [{:keys [conn client-ops-conn child1]} (setup-parent-child) - tx-id (random-uuid) - tx-report (d/with @conn - [[:db/add (:db/id child1) :block/title "stable tx id"]] - (assoc local-tx-meta - :db-sync/tx-id tx-id - :outliner-op :save-block))] - (with-datascript-conns conn client-ops-conn - (fn [] - (db-sync/enqueue-local-tx! test-repo tx-report) - (let [{persisted-tx-id :tx-id} (first (#'sync-apply/pending-txs test-repo))] - (is (= tx-id persisted-tx-id)))))))) - -(deftest handle-local-tx-enqueues-asset-op-for-local-asset-checksum-test - (testing "local asset checksum transactions should create pending asset upload ops" - (let [{:keys [conn client-ops-conn]} (setup-parent-child) - asset-uuid (random-uuid) - tx-report (d/with @conn - [{:block/uuid asset-uuid - :block/title "asset.png" - :logseq.property.asset/type "png" - :logseq.property.asset/checksum "sha-256-value"}] - (assoc local-tx-meta :outliner-op :save-block))] - (with-datascript-conns conn client-ops-conn - (fn [] - (sync-apply/handle-local-tx! test-repo tx-report) - (let [asset-op (first (client-op/get-all-asset-ops test-repo))] - (is (= 1 (client-op/get-unpushed-asset-ops-count test-repo))) - (is (= asset-uuid (get-in asset-op [:update-asset 2 :block-uuid]))) - (is (= :update-asset (first (:update-asset asset-op)))))))))) - -(defn- process-pending-asset-op! - [asset-uuid] - (client-op/add-asset-ops test-repo [[:update-asset 10 {:block-uuid asset-uuid}]]) - (let [fail-fast-called? (atom false) - broadcast-count (atom 0) - asset-op (first (client-op/get-all-asset-ops test-repo))] - (#'sync-assets/process-asset-op! - test-repo - "graph-id" - asset-op - {:current-client-f (constantly {:repo test-repo}) - :broadcast-rtc-state!-f (fn [_client] (swap! broadcast-count inc)) - :fail-fast-f (fn [tag data] - (reset! fail-fast-called? true) - (throw (ex-info (name tag) data)))}) - {:fail-fast-called? @fail-fast-called? - :broadcast-count @broadcast-count - :pending-count (client-op/get-unpushed-asset-ops-count test-repo)})) - -(deftest process-asset-op-drops-update-when-asset-entity-is-missing-test - (testing "stale asset upload ops should not block sync when the entity no longer exists" - (let [{:keys [conn client-ops-conn]} (setup-parent-child) - asset-uuid (random-uuid)] - (with-datascript-conns - conn - client-ops-conn - (fn [] - (let [result (process-pending-asset-op! asset-uuid)] - (is (false? (:fail-fast-called? result))) - (is (= 1 (:broadcast-count result))) - (is (= 0 (:pending-count result))))))))) - -(deftest process-asset-op-drops-update-when-asset-type-is-missing-test - (testing "asset upload ops should be dropped when the entity is missing asset type" - (let [{:keys [conn client-ops-conn]} (setup-parent-child) - asset-uuid (random-uuid)] - (d/transact! conn [{:block/uuid asset-uuid - :block/title "asset-without-type" - :logseq.property.asset/checksum "sha-256-value"}]) - (with-datascript-conns - conn - client-ops-conn - (fn [] - (let [result (process-pending-asset-op! asset-uuid)] - (is (false? (:fail-fast-called? result))) - (is (= 1 (:broadcast-count result))) - (is (= 0 (:pending-count result))))))))) - -(deftest process-asset-op-drops-update-when-asset-checksum-is-missing-test - (testing "asset upload ops should be dropped when the entity is missing checksum" - (let [{:keys [conn client-ops-conn]} (setup-parent-child) - asset-uuid (random-uuid)] - (d/transact! conn [{:block/uuid asset-uuid - :block/title "asset.png" - :logseq.property.asset/type "png"}]) - (with-datascript-conns - conn - client-ops-conn - (fn [] - (let [result (process-pending-asset-op! asset-uuid)] - (is (false? (:fail-fast-called? result))) - (is (= 1 (:broadcast-count result))) - (is (= 0 (:pending-count result))))))))) - -(deftest process-asset-op-drops-update-when-required-asset-attributes-are-blank-test - (testing "asset upload ops should be dropped when required attributes are blank" - (let [{:keys [conn client-ops-conn]} (setup-parent-child) - asset-uuid (random-uuid)] - (d/transact! conn [{:block/uuid asset-uuid - :block/title "asset.png" - :logseq.property.asset/type "png" - :logseq.property.asset/checksum ""}]) - (with-datascript-conns - conn - client-ops-conn - (fn [] - (let [result (process-pending-asset-op! asset-uuid)] - (is (false? (:fail-fast-called? result))) - (is (= 1 (:broadcast-count result))) - (is (= 0 (:pending-count result))))))))) - -(deftest process-asset-ops-retries-missing-file-without-blocking-later-ops-test - (async done - (let [{:keys [conn client-ops-conn]} (setup-parent-child) - repo (str test-repo "-asset-retry") - missing-asset-uuid (random-uuid) - later-asset-uuid (random-uuid) - read-error (ex-info "read-asset failed" - {:type :rtc.exception/read-asset-failed}) - restored? (atom false) - upload-calls (atom []) - broadcast-count (atom 0) - get-datascript-conn worker-state/get-datascript-conn - get-client-ops-conn worker-state/get-client-ops-conn] - (d/transact! conn [{:block/uuid missing-asset-uuid - :block/title "missing.pdf" - :logseq.property.asset/type "pdf" - :logseq.property.asset/checksum "missing-sha-256" - :block/tags #{:logseq.class/Asset}} - {:block/uuid later-asset-uuid - :block/title "later.pdf" - :logseq.property.asset/type "pdf" - :logseq.property.asset/checksum "later-sha-256" - :block/tags #{:logseq.class/Asset}}]) - (letfn [(process-asset-ops! [] - (#'sync-assets/process-asset-ops! - repo - {:graph-id "graph-id"} - {:current-client-f (constantly {:repo repo}) - :broadcast-rtc-state!-f (fn [_client] (swap! broadcast-count inc)) - :fail-fast-f (fn [tag data] - (throw (ex-info (name tag) data)))}))] - (-> (p/with-redefs [worker-state/get-datascript-conn - (fn [repo*] - (if (= repo repo*) - conn - (get-datascript-conn repo*))) - worker-state/get-client-ops-conn - (fn [repo*] - (if (= repo repo*) - client-ops-conn - (get-client-ops-conn repo*))) - sync-assets/upload-remote-asset! - (fn [_repo _graph-id asset-uuid _asset-type _checksum] - (swap! upload-calls conj asset-uuid) - (if (and (= missing-asset-uuid asset-uuid) - (not @restored?)) - (p/rejected read-error) - (p/resolved nil))) - ldb/transact! - (fn [conn* tx-data _tx-meta] - (d/transact! conn* tx-data))] - (client-op/add-asset-ops repo [[:update-asset 10 {:block-uuid missing-asset-uuid}] - [:update-asset 11 {:block-uuid later-asset-uuid}]]) - (p/let [_ (process-asset-ops!) - pending-after-missing (client-op/get-unpushed-asset-ops-count repo) - later-remote-metadata (:logseq.property.asset/remote-metadata - (d/entity @conn [:block/uuid later-asset-uuid])) - _ (reset! restored? true) - _ (process-asset-ops!) - pending-after-retry (client-op/get-unpushed-asset-ops-count repo)] - {:pending-after-missing pending-after-missing - :later-remote-metadata later-remote-metadata - :pending-after-retry pending-after-retry})) - (p/then - (fn [{:keys [pending-after-missing later-remote-metadata pending-after-retry]}] - (is (= [missing-asset-uuid later-asset-uuid missing-asset-uuid] @upload-calls)) - (is (= 1 pending-after-missing)) - (is (= {:checksum "later-sha-256" :type "pdf"} later-remote-metadata)) - (is (= 0 pending-after-retry)) - (is (= {:checksum "missing-sha-256" :type "pdf"} - (:logseq.property.asset/remote-metadata - (d/entity @conn [:block/uuid missing-asset-uuid])))) - (is (= 3 @broadcast-count)))) - (p/catch - (fn [error] - (is false (str "unexpected error: " error)))) - (p/finally done)))))) - -(deftest apply-history-action-does-not-reuse-original-tx-id-test - (testing "undo/redo history actions should not overwrite the original pending tx row" - (let [{:keys [conn client-ops-conn child1]} (setup-parent-child) - child-uuid (:block/uuid child1)] - (with-datascript-conns conn client-ops-conn - (fn [] - (apply-ops! conn - [[:save-block [{:block/uuid child-uuid - :block/title "hello"} nil]]] - local-tx-meta) - (let [{:keys [tx-id]} (first (#'sync-apply/pending-txs test-repo))] - (let [{:keys [applied? history-tx-id]} (#'sync-apply/apply-history-action! test-repo - tx-id - true - {:db-sync/tx-id tx-id})] - (is (= true applied?)) - (is (uuid? history-tx-id)) - (is (not= tx-id history-tx-id))) - (let [pending (#'sync-apply/pending-txs test-repo)] - (is (= 2 (count pending))) - (is (= 2 (count (distinct (map :tx-id pending))))) - (is (= "hello" - (get-in (#'sync-apply/pending-tx-by-id test-repo tx-id) - [:forward-outliner-ops 0 1 0 :block/title])))))))))) - -(deftest apply-history-action-preserves-source-forward-inverse-ops-test - (testing "undo/redo history actions should preserve source forward/inverse ops and create new tx rows" - (let [{:keys [conn client-ops-conn child1]} (setup-parent-child) - child-uuid (:block/uuid child1)] - (with-datascript-conns conn client-ops-conn - (fn [] - (apply-ops! conn - [[:save-block [{:block/uuid child-uuid - :block/title "hello"} nil]]] - local-tx-meta) - (let [{source-tx-id :tx-id} (first (#'sync-apply/pending-txs test-repo))] - (let [{undo-applied? :applied? - undo-history-tx-id :history-tx-id} - (#'sync-apply/apply-history-action! test-repo - source-tx-id - true - {})] - (is (= true undo-applied?)) - (is (uuid? undo-history-tx-id)) - (is (not= source-tx-id undo-history-tx-id))) - (let [source-pending (#'sync-apply/pending-tx-by-id test-repo source-tx-id) - pending-after-undo (#'sync-apply/pending-txs test-repo) - undo-pending (first (filter #(not= source-tx-id (:tx-id %)) pending-after-undo))] - (is (= 2 (count pending-after-undo))) - (is (some? undo-pending)) - (is (= "hello" - (get-in source-pending [:forward-outliner-ops 0 1 0 :block/title]))) - (is (= "child 1" - (get-in source-pending [:inverse-outliner-ops 0 1 0 :block/title]))) - (is (= "child 1" - (get-in undo-pending [:forward-outliner-ops 0 1 0 :block/title]))) - (is (= "hello" - (get-in undo-pending [:inverse-outliner-ops 0 1 0 :block/title])))) - (let [{redo-applied? :applied? - redo-history-tx-id :history-tx-id} - (#'sync-apply/apply-history-action! test-repo - source-tx-id - false - {})] - (is (= true redo-applied?)) - (is (uuid? redo-history-tx-id)) - (is (not= source-tx-id redo-history-tx-id))) - (let [source-pending (#'sync-apply/pending-tx-by-id test-repo source-tx-id) - pending-after-redo (#'sync-apply/pending-txs test-repo) - new-tx-ids (set (map :tx-id pending-after-redo))] - (is (= 3 (count pending-after-redo))) - (is (= 3 (count new-tx-ids))) - (is (contains? new-tx-ids source-tx-id)) - (is (= "hello" - (get-in source-pending [:forward-outliner-ops 0 1 0 :block/title]))) - (is (= "child 1" - (get-in source-pending [:inverse-outliner-ops 0 1 0 :block/title])))))))))) - -(deftest apply-history-action-semantic-op-must-not-fallback-to-raw-tx-test - (testing "semantic history action should not fallback to raw tx replay" - (let [{:keys [conn client-ops-conn child1]} (setup-parent-child) - tx-id (random-uuid) - child-uuid (:block/uuid child1) - before-title (:block/title (d/entity @conn (:db/id child1))) - missing-uuid (random-uuid) - raw-title "raw fallback title" - tx-data [[:db/add [:block/uuid child-uuid] :block/title raw-title]]] - (with-datascript-conns conn client-ops-conn - (fn [] - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id tx-id - :db-sync/pending? true - :db-sync/created-at (.now js/Date) - :db-sync/outliner-op :save-block - :db-sync/forward-outliner-ops [[:save-block [{:block/uuid missing-uuid - :block/title "broken semantic"} {}]]] - :db-sync/normalized-tx-data tx-data - :db-sync/reversed-tx-data []}]) - (let [result (#'sync-apply/apply-history-action! test-repo tx-id false {})] - (is (= false (:applied? result))) - (is (= :invalid-history-action-ops - (:reason result)))) - (is (= before-title - (:block/title (d/entity @conn [:block/uuid child-uuid]))))))))) - -(deftest apply-history-action-inline-semantic-op-rejects-numeric-ref-ids-test - (testing "inline semantic history action should reject stale numeric ref ids before replay" - (let [{:keys [conn client-ops-conn child1]} (setup-parent-child) - tx-id (random-uuid) - child-uuid (:block/uuid child1) - stale-ref-id 99999999] - (with-datascript-conns conn client-ops-conn - (fn [] - (let [result (#'sync-apply/apply-history-action! - test-repo - tx-id - false - {:outliner-op :save-block - :db-sync/forward-outliner-ops [[:save-block [{:block/uuid child-uuid - :block/tags #{stale-ref-id}} - {}]]] - :db-sync/inverse-outliner-ops [[:save-block [{:block/uuid child-uuid - :block/title "child 1"} - {}]]]})] - (is (= false (:applied? result))) - (is (= :invalid-history-action-ops - (:reason result))))))))) - -(deftest apply-history-action-redo-invalid-insert-conflict-skips-fail-fast-test - (testing "redo conflict on stale insert target should return error result without fail-fast logger" - (let [{:keys [conn client-ops-conn]} (setup-parent-child) - tx-id (random-uuid) - missing-parent-uuid (random-uuid) - inserted-uuid (random-uuid)] - (with-datascript-conns conn client-ops-conn - (fn [] - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id tx-id - :db-sync/pending? true - :db-sync/created-at (.now js/Date) - :db-sync/outliner-op :insert-blocks - :db-sync/forward-outliner-ops [[:insert-blocks [[{:block/uuid inserted-uuid - :block/title "" - :block/parent [:block/uuid missing-parent-uuid]} - [:block/uuid missing-parent-uuid] - {:sibling? false - :keep-uuid? true}]]]] - :db-sync/normalized-tx-data [] - :db-sync/reversed-tx-data []}]) - (with-redefs [sync-util/fail-fast (fn [_tag data] - (throw (ex-info "fail-fast-called" data)))] - (let [result (#'sync-apply/apply-history-action! test-repo tx-id false {})] - (is (= false (:applied? result))) - (is (= :invalid-history-action-ops - (:reason result))) - (is (= :insert-blocks - (get-in result [:action :outliner-op])))))))))) - -(deftest apply-history-action-save-block-ignores-stale-db-id-when-uuid-exists-test - (testing "semantic save-block replay should resolve by uuid and ignore stale db/id" - (let [{:keys [conn client-ops-conn child1]} (setup-parent-child) - tx-id (random-uuid) - child-uuid (:block/uuid child1) - stale-db-id 99999999 - new-title "semantic replay with stale db id"] - (with-datascript-conns conn client-ops-conn - (fn [] - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id tx-id - :db-sync/pending? true - :db-sync/created-at (.now js/Date) - :db-sync/outliner-op :save-block - :db-sync/forward-outliner-ops [[:save-block [{:db/id stale-db-id - :block/uuid child-uuid - :block/title new-title} - {}]]] - :db-sync/normalized-tx-data [] - :db-sync/reversed-tx-data []}]) - (let [result (#'sync-apply/apply-history-action! test-repo tx-id false {})] - (is (= true (:applied? result))) - (is (= new-title - (:block/title (d/entity @conn [:block/uuid child-uuid])))))))))) - -(deftest reverse-local-txs-uses-reversed-tx-data-test - (testing "rebase reverse uses reversed tx-data even when semantic inverse ops are missing" - (let [{:keys [conn client-ops-conn child1]} (setup-parent-child) - tx-id (random-uuid) - child-id (:db/id child1) - child-uuid (:block/uuid child1) - local-tx {:tx-id tx-id - :outliner-op :save-block - :forward-outliner-ops [[:save-block [{:block/uuid (random-uuid) - :block/title "value"} {}]]] - :inverse-outliner-ops nil - :reversed-tx [[:db/add child-id :block/title "raw reverse"]]}] - (with-datascript-conns conn client-ops-conn - (fn [] - (let [reports (#'sync-apply/reverse-local-txs! conn [local-tx])] - (is (= 1 (count reports))) - (is (= "raw reverse" - (:block/title (d/entity @conn [:block/uuid child-uuid])))))))))) - -(deftest reverse-local-txs-keeps-order-add-for-restored-entity-test - (testing "reverse should keep :db/add :block/order when restoring a deleted block" - (let [{:keys [conn client-ops-conn parent]} (setup-parent-child) - tx-id (random-uuid) - restored-id 999999 - restored-uuid (random-uuid) - now (.now js/Date) - parent-id (:db/id parent) - local-tx {:tx-id tx-id - :outliner-op :delete-block - :reversed-tx [[:db/add restored-id :block/uuid restored-uuid] - [:db/add restored-id :block/title "reverse-restored"] - [:db/add restored-id :block/created-at now] - [:db/add restored-id :block/updated-at now] - [:db/add restored-id :block/page parent-id] - [:db/add restored-id :block/parent parent-id] - [:db/add restored-id :block/order "a0"]]}] - (with-datascript-conns conn client-ops-conn - (fn [] - (is (nil? (d/entity @conn [:block/uuid restored-uuid]))) - (let [reports (#'sync-apply/reverse-local-txs! conn [local-tx]) - restored (d/entity @conn [:block/uuid restored-uuid])] - (is (= 1 (count reports))) - (is (= "reverse-restored" (:block/title restored))) - (is (= "a0" (:block/order restored))))))))) - -(deftest reverse-local-txs-resolves-existing-uuid-string-temp-id-test - (testing "reverse should resolve uuid-string temp ids to existing entities" - (let [{:keys [conn client-ops-conn child1]} (setup-parent-child) - tx-id (random-uuid) - child-uuid (:block/uuid child1) - child-temp-id (str child-uuid) - local-tx {:tx-id tx-id - :outliner-op :delete-blocks - :reversed-tx [[:db/add child-temp-id :block/uuid child-uuid 536880744] - [:db/add child-temp-id :block/title "reverse existing" 536880744]]}] - (with-datascript-conns conn client-ops-conn - (fn [] - (let [reports (#'sync-apply/reverse-local-txs! conn [local-tx]) - child' (d/entity @conn [:block/uuid child-uuid])] - (is (= 1 (count reports))) - (is (= (:db/id child1) (:db/id child'))) - (is (= "reverse existing" (:block/title child'))))))))) - -(deftest reverse-local-txs-drops-stale-duplicate-block-uuid-reverse-test - (testing "stale reverse tx-data should not abort when a block uuid is already owned" - (let [{:keys [conn client-ops-conn child1 child2]} (setup-parent-child) - tx-id (random-uuid) - stale-uuid (:block/uuid child1) - duplicate-uuid (:block/uuid child2) - local-tx {:tx-id tx-id - :outliner-op :insert-blocks - :forward-outliner-ops [[:insert-blocks [[{:block/uuid stale-uuid - :block/title "stale forward"}] - duplicate-uuid - {:keep-uuid? true}]]] - :inverse-outliner-ops [] - :reversed-tx [[:db/add [:block/uuid stale-uuid] - :block/uuid - duplicate-uuid]]}] - (with-datascript-conns conn client-ops-conn - (fn [] - (with-silenced-console-error - (fn [] - (let [reports (#'sync-apply/reverse-local-txs! conn [local-tx])] - (is (= [{:tx-id tx-id :status :failed}] reports)) - (is (= stale-uuid - (:block/uuid (d/entity @conn (:db/id child1))))) - (is (= duplicate-uuid - (:block/uuid (d/entity @conn (:db/id child2))))))))))))) - -(deftest reverse-local-txs-skips-validation-for-rebase-intermediate-state-test - (testing "reverse tx application should not validate the temporary pre-rebase state" - (let [{:keys [conn client-ops-conn parent child1]} (setup-parent-child) - tx-id (random-uuid) - child-id (:db/id child1)] - (d/transact! conn [[:db/add child-id :logseq.property/created-by-ref (:db/id parent)]]) - (with-datascript-conns conn client-ops-conn - (fn [] - (with-silenced-console-error - (fn [] - (let [reports (#'sync-apply/reverse-local-txs! - conn - [{:tx-id tx-id - :outliner-op :insert-blocks - :reversed-tx [[:db/retract child-id - :block/title - "child 1"]]}])] - (is (= 1 (count reports))) - (is (nil? (:block/title (d/entity @conn child-id)))))))))))) - -(deftest apply-remote-txs-reverses-parent-insert-with-existing-child-without-orphaning-test - (testing "reversing a queued parent insert should not leave existing children without a parent" - (let [{:keys [conn client-ops-conn parent child1]} (setup-parent-child) - page-uuid (:block/uuid (:block/page parent)) - target-uuid (:block/uuid parent) - remote-block-id (:db/id child1) - inserted-parent-uuid (random-uuid) - inserted-child-uuid (random-uuid)] - (d/transact! - conn - [[:db/add "queued-parent" :block/uuid inserted-parent-uuid] - [:db/add "queued-parent" :block/title "queued parent"] - [:db/add "queued-parent" :block/page [:block/uuid page-uuid]] - [:db/add "queued-parent" :block/parent [:block/uuid target-uuid]] - [:db/add "queued-parent" :block/order "b1X"] - [:db/add "queued-parent" :block/created-at 1] - [:db/add "queued-parent" :block/updated-at 1] - [:db/add "queued-child" :block/uuid inserted-child-uuid] - [:db/add "queued-child" :block/title "queued child"] - [:db/add "queued-child" :block/page [:block/uuid page-uuid]] - [:db/add "queued-child" :block/parent "queued-parent"] - [:db/add "queued-child" :block/order "b1Y"] - [:db/add "queued-child" :block/created-at 1] - [:db/add "queued-child" :block/updated-at 1]]) - (with-datascript-conns conn client-ops-conn - (fn [] - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id (random-uuid) - :db-sync/pending? true - :db-sync/created-at 1 - :db-sync/outliner-op :insert-blocks - :db-sync/forward-outliner-ops [[:insert-blocks [[{:block/uuid inserted-parent-uuid - :block/title "queued parent"}] - target-uuid - {:sibling? false - :keep-uuid? true}]]] - :db-sync/reversed-tx-data [[:db/retractEntity [:block/uuid inserted-parent-uuid]]]}]) - (let [pending-before (first (#'sync-apply/pending-txs test-repo))] - (is (= :insert-blocks (:outliner-op pending-before))) - (is (seq (:forward-outliner-ops pending-before))) - (is (some #(= [:db/retractEntity [:block/uuid inserted-parent-uuid]] %) - (:reversed-tx pending-before)))) - (let [result (try - (#'sync-apply/apply-remote-txs! - test-repo - nil - [{:tx-data [[:db/add remote-block-id - :block/title - "remote while nested insert pending"]]}]) - nil - (catch :default error - error))] - (is (nil? result)) - (let [inserted-parent (d/entity @conn [:block/uuid inserted-parent-uuid]) - inserted-child (d/entity @conn [:block/uuid inserted-child-uuid]) - validation (db-validate/validate-local-db! @conn)] - (is (= "queued parent" (:block/title inserted-parent))) - (when inserted-child - (is (some? (:block/parent inserted-child))) - (is (some? (:block/page inserted-child)))) - (is (empty? (non-recycle-validation-entities validation)) - (str (:errors validation)))))))))) - -(deftest apply-remote-txs-drops-stale-save-block-reverse-test - (testing "stale pending save-block reverse should not abort remote apply" - (let [{:keys [conn client-ops-conn parent]} (setup-parent-child) - tx-id (random-uuid) - missing-uuid (random-uuid) - parent-uuid (:block/uuid parent)] - (with-datascript-conns conn client-ops-conn - (fn [] - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id tx-id - :db-sync/outliner-op :save-block - :db-sync/forward-outliner-ops [[:save-block [{:block/uuid missing-uuid - :block/title "stale forward"} {}]]] - :db-sync/inverse-outliner-ops [[:save-block [{:block/uuid missing-uuid - :block/title "stale reverse"} {}]]] - :db-sync/normalized-tx-data [[:db/add [:block/uuid missing-uuid] :block/title "stale forward"]] - :db-sync/reversed-tx-data [[:db/add [:block/uuid missing-uuid] :block/title "stale reverse"]]}]) - (#'sync-apply/apply-remote-tx! - test-repo - nil - [[:db/add [:block/uuid parent-uuid] :block/title "remote parent"]]) - (let [row (client-op-tx-row client-ops-conn tx-id)] - (is (= "remote parent" (:block/title (d/entity @conn [:block/uuid parent-uuid])))) - (is (= 0 (aget row "pending"))))))))) - -(deftest enqueue-local-tx-keeps-mixed-semantic-forward-outliner-ops-test - (testing "mixed semantic outliner ops stay semantic and preserve op ordering" - (let [{:keys [conn client-ops-conn child2]} (setup-parent-child) - block-id (:db/id child2) - block-uuid (:block/uuid child2) - tx-report (d/with @conn - [[:db/add block-id :block/title "mixed fallback"]] - (assoc local-tx-meta - :outliner-op :save-block - :outliner-ops [[:save-block [{:block/uuid block-uuid - :block/title "mixed fallback"} {}]] - [:indent-outdent-blocks [[block-id] - false - {:parent-original nil - :logical-outdenting? nil}]]]))] - (with-datascript-conns conn client-ops-conn - (fn [] - (db-sync/enqueue-local-tx! test-repo tx-report) - (let [{:keys [forward-outliner-ops]} (first (#'sync-apply/pending-txs test-repo))] - (is (= :save-block (ffirst forward-outliner-ops))) - (is (= :indent-outdent-blocks (first (second forward-outliner-ops)))) - (is (= [block-uuid] - (get-in forward-outliner-ops [1 1 0]))))))))) - -(deftest apply-history-action-undo-delete-blocks-noops-when-target-missing-test - (testing "undo delete-blocks should no-op when the target block is already missing" - (let [{:keys [conn client-ops-conn child1]} (setup-parent-child) - tx-id (random-uuid) - child-uuid (:block/uuid child1) - missing-uuid (random-uuid)] - (with-datascript-conns conn client-ops-conn - (fn [] - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id tx-id - :db-sync/pending? true - :db-sync/created-at (.now js/Date) - :db-sync/outliner-op :delete-blocks - :db-sync/forward-outliner-ops - [[:save-block [{:block/uuid child-uuid - :block/title "semantic source"} nil]]] - :db-sync/inverse-outliner-ops - [[:delete-blocks [[[:block/uuid missing-uuid]] {}]]] - :db-sync/normalized-tx-data [] - :db-sync/reversed-tx-data []}]) - (is (= true - (:applied? (#'sync-apply/apply-history-action! test-repo tx-id true {})))) - (is (some? (d/entity @conn [:block/uuid child-uuid])))))))) - -(deftest enqueue-local-tx-persists-semantic-undo-ops-test - (testing "undo local tx persists explicit semantic forward and inverse ops" - (let [{:keys [conn client-ops-conn child1]} (setup-parent-child) - tx-id (random-uuid) - forward-ops [[:save-block [{:block/uuid (:block/uuid child1) - :block/title "undo value"} {}]]] - inverse-ops [[:save-block [{:block/uuid (:block/uuid child1) - :block/title "child 1"} {}]]] - tx-report (d/with @conn - [[:db/add (:db/id child1) :block/title "undo value"]] - (assoc local-tx-meta - :db-sync/tx-id tx-id - :db-sync/forward-outliner-ops forward-ops - :db-sync/inverse-outliner-ops inverse-ops - :outliner-op :save-block - :undo? true - :gen-undo-ops? false))] - (with-datascript-conns conn client-ops-conn - (fn [] - (db-sync/enqueue-local-tx! test-repo tx-report) - (let [pending (first (#'sync-apply/pending-txs test-repo)) - raw-pending (client-op/get-local-tx-entry test-repo tx-id)] - (is (= tx-id (:tx-id pending))) - (is (= forward-ops (:forward-outliner-ops pending))) - (is (= forward-ops (:forward-outliner-ops raw-pending))) - (is (= inverse-ops (:inverse-outliner-ops raw-pending))))))))) - -(deftest direct-outliner-page-delete-persists-delete-page-outliner-op-test - (testing "direct outliner-page/delete! still persists singleton delete-page forward-outliner-ops" - (let [conn (db-test/create-conn-with-blocks - {:pages-and-blocks [{:page {:block/title "Delete Me"}}]}) - client-ops-conn (new-client-ops-db) - page (db-test/find-page-by-title @conn "Delete Me")] - (with-datascript-conns conn client-ops-conn - (fn [] - (outliner-page/delete! conn (:block/uuid page) {}) - (let [{:keys [forward-outliner-ops inverse-outliner-ops]} (first (#'sync-apply/pending-txs test-repo))] - (is (= :delete-page (ffirst forward-outliner-ops))) - (is (= (:block/uuid page) - (get-in forward-outliner-ops [0 1 0]))) - (is (seq inverse-outliner-ops)))))))) - -(deftest delete-page-rewrites-node-refs-and-semantic-undo-redo-test - (testing "moving a page to recycle rewrites node refs and semantic undo/redo restores and reapplies them" - (let [conn (db-test/create-conn-with-blocks - {:pages-and-blocks [{:page {:block/title "Delete Me"}} - {:page {:block/title "Ref Page"} - :blocks [{:block/title "seed"}]}]}) - client-ops-conn (new-client-ops-db) - page (db-test/find-page-by-title @conn "Delete Me") - page-id (:db/id page) - page-uuid (:block/uuid page) - ref-block (db-test/find-block-by-content @conn "seed") - ref-block-uuid (:block/uuid ref-block) - node-ref-content (str "ref " (page-ref/->page-ref page-uuid)) - title-content "ref Delete Me"] - (with-datascript-conns conn client-ops-conn - (fn [] - (ldb/transact! conn [{:db/id (:db/id ref-block) - :block/title node-ref-content - :block/refs #{page-id}}]) - (outliner-page/delete! conn page-uuid {}) - (let [{:keys [tx-id forward-outliner-ops inverse-outliner-ops]} - (->> (#'sync-apply/pending-txs test-repo) - (filter #(= :delete-page (:outliner-op %))) - last)] - (is (= :delete-page (ffirst forward-outliner-ops))) - (is (some (fn [[op [block]]] - (and (= :save-block op) - (= ref-block-uuid (:block/uuid block)) - (= title-content (:block/title block)))) - forward-outliner-ops)) - (is (some (fn [[op [target-page-uuid]]] - (and (= :restore-recycled op) - (= page-uuid target-page-uuid))) - inverse-outliner-ops)) - (is (some (fn [[op [block]]] - (and (= :save-block op) - (= ref-block-uuid (:block/uuid block)) - (= node-ref-content (:block/title block)))) - inverse-outliner-ops)) - (is (= title-content - (:block/raw-title (d/entity @conn [:block/uuid ref-block-uuid])))) - (is (not (contains? (set (map :db/id (:block/refs (d/entity @conn [:block/uuid ref-block-uuid])))) - page-id))) - (is (= true - (:applied? (#'sync-apply/apply-history-action! test-repo tx-id true {})))) - (is (= node-ref-content - (:block/raw-title (d/entity @conn [:block/uuid ref-block-uuid])))) - (is (contains? (set (map :db/id (:block/refs (d/entity @conn [:block/uuid ref-block-uuid])))) - page-id)) - (is (nil? (:logseq.property/deleted-at (d/entity @conn [:block/uuid page-uuid])))) - (is (= true - (:applied? (#'sync-apply/apply-history-action! test-repo tx-id false {})))) - (is (= title-content - (:block/raw-title (d/entity @conn [:block/uuid ref-block-uuid])))) - (is (not (contains? (set (map :db/id (:block/refs (d/entity @conn [:block/uuid ref-block-uuid])))) - page-id))) - (is (integer? (:logseq.property/deleted-at (d/entity @conn [:block/uuid page-uuid])))))))))) - -(deftest direct-outliner-property-set-persists-set-block-property-outliner-op-test - (testing "direct outliner-property/set-block-property! persists tx without semantic property forward ops" - (let [graph {:properties {:p2 {:logseq.property/type :default}} - :pages-and-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "local object"}]}]} - conn (db-test/create-conn-with-blocks graph) - client-ops-conn (new-client-ops-db) - block (db-test/find-block-by-content @conn "local object") - property-id :user.property/p2] - (with-datascript-conns conn client-ops-conn - (fn [] - (outliner-property/set-block-property! conn - [:block/uuid (:block/uuid block)] - property-id - "local value") - (let [pending (#'sync-apply/pending-txs test-repo) - property-tx (some (fn [tx] - (when (= :set-block-property (:outliner-op tx)) - tx)) - pending)] - (is (seq pending)) - (is (some? property-tx)) - (is (= [] (:forward-outliner-ops property-tx))))))))) - -(deftest rebase-replays-direct-set-block-property-without-semantic-ops-test - (testing "rebase should keep direct set-block-property value when pending tx has no semantic ops" - (let [graph {:properties {:p2 {:logseq.property/type :default}} - :pages-and-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "local object"}]}]} - conn-a (db-test/create-conn-with-blocks graph) - conn-b (d/conn-from-db @conn-a) - client-ops-conn (new-client-ops-db) - remote-tx (atom nil)] - (d/listen! conn-b ::capture-rebase-direct-property-set - (fn [tx-report] - (when-not @remote-tx - (reset! remote-tx - (db-normalize/normalize-tx-data - (:db-after tx-report) - (:db-before tx-report) - (:tx-data tx-report)))))) - (try - (with-datascript-conns conn-a client-ops-conn - (fn [] - (let [local-block (db-test/find-block-by-content @conn-a "local object") - block-uuid (:block/uuid local-block) - property-id :user.property/p2] - (outliner-property/set-block-property! conn-a - [:block/uuid block-uuid] - property-id - "local value") - (let [pending-before (first (#'sync-apply/pending-txs test-repo)) - tx-id (:tx-id pending-before)] - (is (some? pending-before)) - (is (= :set-block-property (:outliner-op pending-before))) - (is (= [] (:forward-outliner-ops pending-before))) - (outliner-core/save-block! conn-b - {:block/uuid block-uuid - :block/title "remote title"} - {}) - (#'sync-apply/apply-remote-tx! test-repo nil @remote-tx) - (let [block-after (d/entity @conn-a [:block/uuid block-uuid]) - property-value (:user.property/p2 block-after) - pending-after (#'sync-apply/pending-tx-by-id test-repo tx-id)] - (is (= "remote title" (:block/title block-after))) - (is (= "local value" - (if (map? property-value) - (:block/title property-value) - property-value))) - (is (some? pending-after))))))) - (finally - (d/unlisten! conn-b ::capture-rebase-direct-property-set)))))) - -(deftest canonical-set-block-property-rewrites-ref-values-to-stable-refs-test - (testing "ref-valued set-block-property no longer persists semantic forward ops" - (let [graph {:properties {:x7 {:logseq.property/type :page - :db/cardinality :db.cardinality/many}} - :pages-and-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "local object"}]}]} - conn (db-test/create-conn-with-blocks graph) - client-ops-conn (new-client-ops-db) - block (db-test/find-block-by-content @conn "local object") - property-id :user.property/x7] - (with-datascript-conns conn client-ops-conn - (fn [] - (outliner-page/create! conn "Page y" {}) - (let [page-y (db-test/find-page-by-title @conn "Page y")] - (outliner-property/set-block-property! conn - [:block/uuid (:block/uuid block)] - property-id - (:db/id page-y)) - (let [pending (#'sync-apply/pending-txs test-repo) - property-tx (some (fn [{:keys [forward-outliner-ops]}] - (when (= :set-block-property (ffirst forward-outliner-ops)) - forward-outliner-ops)) - pending)] - (is (nil? property-tx))))))))) - -(deftest canonical-batch-set-property-rewrites-ref-values-to-stable-refs-test - (testing "ref-valued batch-set-property no longer persists semantic forward ops" - (let [graph {:properties {:x7 {:logseq.property/type :page - :db/cardinality :db.cardinality/many}} - :pages-and-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "local object 1"} - {:block/title "local object 2"}]}]} - conn (db-test/create-conn-with-blocks graph) - client-ops-conn (new-client-ops-db) - block-1 (db-test/find-block-by-content @conn "local object 1") - block-2 (db-test/find-block-by-content @conn "local object 2") - property-id :user.property/x7] - (with-datascript-conns conn client-ops-conn - (fn [] - (outliner-page/create! conn "Page y" {}) - (let [page-y (db-test/find-page-by-title @conn "Page y")] - (apply-ops! conn - [[:batch-set-property [[(:db/id block-1) - (:db/id block-2)] - property-id - (:db/id page-y) - {}]]] - {}) - (let [pending (#'sync-apply/pending-txs test-repo) - property-tx (some (fn [{:keys [forward-outliner-ops]}] - (when (= :batch-set-property (ffirst forward-outliner-ops)) - forward-outliner-ops)) - pending)] - (is (nil? property-tx))))))))) - -(deftest apply-history-action-replays-batch-set-property-from-tx-data-with-lookup-refs-test - (testing "apply-history-action should replay batch-set-property from tx-data when semantic op carries lookup refs" - (let [graph {:properties {:x7 {:logseq.property/type :page - :db/cardinality :db.cardinality/many}} - :pages-and-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "local object"}]}]} - conn (db-test/create-conn-with-blocks graph) - client-ops-conn (new-client-ops-db) - property-id :user.property/x7] - (with-datascript-conns conn client-ops-conn - (fn [] - (outliner-page/create! conn "Page y" {}) - (let [block (db-test/find-block-by-content @conn "local object") - page-y (db-test/find-page-by-title @conn "Page y") - block-ref [:block/uuid (:block/uuid block)] - page-y-ref [:block/uuid (:block/uuid page-y)] - action-tx-id (random-uuid)] - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id action-tx-id - :db-sync/pending? true - :db-sync/forward-outliner-ops - [[:batch-set-property [[block-ref] - property-id - page-y-ref - {:entity-id? true}]]] - :db-sync/inverse-outliner-ops - [[:batch-remove-property [[block-ref] property-id]]] - :db-sync/normalized-tx-data [[:db/add block-ref property-id page-y-ref]] - :db-sync/reversed-tx-data [[:db/retract block-ref property-id page-y-ref]]}]) - (is (= true - (:applied? (#'sync-apply/apply-history-action! test-repo action-tx-id false {})))) - (is (= #{"page y"} - (set (map :block/name (:user.property/x7 (d/entity @conn block-ref)))))) - (is (= true - (:applied? (#'sync-apply/apply-history-action! test-repo action-tx-id true {})))) - (is (empty? (:user.property/x7 (d/entity @conn block-ref)))))))))) - -(deftest apply-history-action-replays-batch-set-property-from-tx-data-with-raw-uuid-ids-test - (testing "apply-history-action should replay batch-set-property from tx-data with raw uuid block ids" - (let [graph {:properties {:heading {:db/ident :logseq.property/heading - :logseq.property/type :number - :db/cardinality :db.cardinality/one}} - :pages-and-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "local object"}]}]} - conn (db-test/create-conn-with-blocks graph) - client-ops-conn (new-client-ops-db)] - (with-datascript-conns conn client-ops-conn - (fn [] - (let [block (db-test/find-block-by-content @conn "local object") - block-uuid (:block/uuid block) - block-ref [:block/uuid block-uuid] - action-tx-id (random-uuid)] - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id action-tx-id - :db-sync/pending? true - :db-sync/forward-outliner-ops - [[:batch-set-property [[block-uuid] - :logseq.property/heading - 2 - nil]]] - :db-sync/inverse-outliner-ops - [[:batch-remove-property [[block-ref] :logseq.property/heading]]] - :db-sync/normalized-tx-data [[:db/add block-ref :logseq.property/heading 2]] - :db-sync/reversed-tx-data [[:db/retract block-ref :logseq.property/heading 2]]}]) - (is (= true - (:applied? (#'sync-apply/apply-history-action! test-repo action-tx-id false {})))) - (is (= 2 - (:logseq.property/heading (d/entity @conn block-ref)))) - (is (= true - (:applied? (#'sync-apply/apply-history-action! test-repo action-tx-id true {})))) - (is (nil? (:logseq.property/heading (d/entity @conn block-ref)))))))))) - -(deftest apply-history-action-redo-replays-batch-set-property-with-raw-uuid-ids-test - (testing "redo should replay batch-set-property from raw tx-data when semantic op stores raw uuid block ids" - (let [graph {:properties {:heading {:db/ident :logseq.property/heading - :logseq.property/type :number - :db/cardinality :db.cardinality/one}} - :pages-and-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "local object"}]}]} - conn (db-test/create-conn-with-blocks graph) - client-ops-conn (new-client-ops-db)] - (with-datascript-conns conn client-ops-conn - (fn [] - (let [block (db-test/find-block-by-content @conn "local object") - block-uuid (:block/uuid block) - block-ref [:block/uuid block-uuid] - action-tx-id (random-uuid) - tx-data [[:db/add block-ref :logseq.property/heading 2]] - reversed-tx-data [[:db/retract block-ref :logseq.property/heading 2]]] - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id action-tx-id - :db-sync/pending? true - :db-sync/forward-outliner-ops - [[:batch-set-property [[block-uuid] - :logseq.property/heading - 2 - nil]]] - :db-sync/inverse-outliner-ops - [[:batch-remove-property [[block-ref] - :logseq.property/heading]]] - :db-sync/normalized-tx-data tx-data - :db-sync/reversed-tx-data reversed-tx-data}]) - (is (= true - (:applied? (#'sync-apply/apply-history-action! test-repo action-tx-id false {})))) - (is (= 2 - (:logseq.property/heading (d/entity @conn block-ref)))) - (is (= true - (:applied? (#'sync-apply/apply-history-action! test-repo action-tx-id true {})))) - (is (nil? (:logseq.property/heading (d/entity @conn block-ref)))))))))) - -(deftest apply-history-action-replays-set-block-property-from-tx-data-with-lookup-refs-test - (testing "apply-history-action should replay set-block-property from tx-data when semantic op carries lookup refs" - (let [graph {:properties {:x7 {:logseq.property/type :page - :db/cardinality :db.cardinality/many}} - :pages-and-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "local object"}]}]} - conn (db-test/create-conn-with-blocks graph) - client-ops-conn (new-client-ops-db) - property-id :user.property/x7] - (with-datascript-conns conn client-ops-conn - (fn [] - (outliner-page/create! conn "Page y" {}) - (let [block (db-test/find-block-by-content @conn "local object") - page-y (db-test/find-page-by-title @conn "Page y") - block-ref [:block/uuid (:block/uuid block)] - page-y-ref [:block/uuid (:block/uuid page-y)] - action-tx-id (random-uuid)] - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id action-tx-id - :db-sync/pending? true - :db-sync/forward-outliner-ops - [[:set-block-property [block-ref property-id page-y-ref]]] - :db-sync/inverse-outliner-ops - [[:remove-block-property [block-ref property-id]]] - :db-sync/normalized-tx-data [[:db/add block-ref property-id page-y-ref]] - :db-sync/reversed-tx-data [[:db/retract block-ref property-id page-y-ref]]}]) - (is (= true - (:applied? (#'sync-apply/apply-history-action! test-repo action-tx-id false {})))) - (is (= #{"page y"} - (set (map :block/name (:user.property/x7 (d/entity @conn block-ref)))))) - (is (= true - (:applied? (#'sync-apply/apply-history-action! test-repo action-tx-id true {})))) - (is (empty? (:user.property/x7 (d/entity @conn block-ref)))))))))) - -(deftest apply-history-action-skips-sync-fix-pending-tx-test - (testing "sync maintenance fix txs are not replayed through undo/redo" - (let [{:keys [conn client-ops-conn]} (setup-parent-child) - tx-id (random-uuid) - missing-block-ref [:block/uuid (random-uuid)]] - (with-datascript-conns conn client-ops-conn - (fn [] - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id tx-id - :db-sync/outliner-op :fix - :db-sync/pending? true - :db-sync/normalized-tx-data [[:db/add missing-block-ref :block/title "missing"]] - :db-sync/reversed-tx-data [[:db/retract missing-block-ref :block/title "missing"]]}]) - (let [result (#'sync-apply/apply-history-action! test-repo tx-id true {})] - (is (false? (:applied? result))) - (is (= :unsupported-history-action (:reason result))))))))) - -(deftest replay-recycle-delete-permanently-removes-recycled-page-test - (testing "replay should permanently delete a recycled page subtree" - (let [conn (db-test/create-conn-with-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "child 1"}]}]) - page (db-test/find-page-by-title @conn "page 1") - child (db-test/find-block-by-content @conn "child 1") - page-uuid (:block/uuid page) - child-uuid (:block/uuid child)] - (outliner-page/delete! conn page-uuid {}) - (is (true? (ldb/recycled? (d/entity @conn [:block/uuid page-uuid])))) - (is (some? (#'sync-apply/replay-canonical-outliner-op! - conn - [:recycle-delete-permanently [[:block/uuid page-uuid]]] - nil))) - (is (nil? (d/entity @conn [:block/uuid page-uuid]))) - (is (nil? (d/entity @conn [:block/uuid child-uuid])))))) - -(deftest replay-recycle-delete-permanently-removes-recycled-block-test - (testing "replay should permanently delete a recycled block subtree" - (let [conn (db-test/create-conn-with-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "parent" - :build/children [{:block/title "child"}]}]}]) - parent (db-test/find-block-by-content @conn "parent") - child (db-test/find-block-by-content @conn "child") - parent-uuid (:block/uuid parent) - child-uuid (:block/uuid child)] - (ldb/transact! conn - (outliner-recycle/recycle-blocks-tx-data @conn [parent] {}) - {:outliner-op :delete-blocks}) - (is (true? (ldb/recycled? (d/entity @conn [:block/uuid parent-uuid])))) - (is (some? (#'sync-apply/replay-canonical-outliner-op! - conn - [:recycle-delete-permanently [[:block/uuid parent-uuid]]] - nil))) - (is (nil? (d/entity @conn [:block/uuid parent-uuid]))) - (is (nil? (d/entity @conn [:block/uuid child-uuid])))))) - -(deftest replay-recycle-delete-permanently-missing-root-is-idempotent-test - (testing "replay should no-op when recycled root has already been removed" - (let [conn (db-test/create-conn-with-blocks - [{:page {:block/title "page 1"}}]) - missing-uuid (random-uuid)] - (is (nil? (#'sync-apply/replay-canonical-outliner-op! - conn - [:recycle-delete-permanently [[:block/uuid missing-uuid]]] - nil)))))) - -(deftest apply-history-action-replays-set-block-property-from-tx-data-with-raw-uuid-id-test - (testing "apply-history-action should replay set-block-property from tx-data with raw block uuid ids" - (let [graph {:classes {:tag1 {}} - :pages-and-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "local object"}]}]} - conn (db-test/create-conn-with-blocks graph) - client-ops-conn (new-client-ops-db)] - (with-datascript-conns conn client-ops-conn - (fn [] - (let [block (db-test/find-block-by-content @conn "local object") - block-uuid (:block/uuid block) - block-ref [:block/uuid block-uuid] - tag-id (:db/id (d/entity @conn :user.class/tag1)) - tag-uuid (:block/uuid (d/entity @conn tag-id)) - action-tx-id (random-uuid)] - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id action-tx-id - :db-sync/pending? true - :db-sync/forward-outliner-ops - [[:set-block-property [block-uuid - :block/tags - [:block/uuid tag-uuid]]]] - :db-sync/inverse-outliner-ops - [[:remove-block-property [block-ref :block/tags]]] - :db-sync/normalized-tx-data [[:db/add block-ref :block/tags [:block/uuid tag-uuid]]] - :db-sync/reversed-tx-data [[:db/retract block-ref :block/tags [:block/uuid tag-uuid]]]}]) - (is (= true - (:applied? (#'sync-apply/apply-history-action! test-repo action-tx-id false {})))) - (is (= #{tag-id} - (set (map :db/id (:block/tags (d/entity @conn block-ref)))))) - (is (= true - (:applied? (#'sync-apply/apply-history-action! test-repo action-tx-id true {})))) - (is (empty? (:block/tags (d/entity @conn block-ref)))))))))) - -(deftest apply-history-action-redo-replays-set-block-tags-with-raw-uuid-id-test - (testing "redo should replay set-block-property from raw tx-data with raw block uuid ids for tags" - (let [graph {:classes {:tag1 {}} - :pages-and-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "local object"}]}]} - conn (db-test/create-conn-with-blocks graph) - client-ops-conn (new-client-ops-db)] - (with-datascript-conns conn client-ops-conn - (fn [] - (let [block (db-test/find-block-by-content @conn "local object") - block-uuid (:block/uuid block) - block-ref [:block/uuid block-uuid] - tag (d/entity @conn :user.class/tag1) - tag-uuid (:block/uuid tag) - action-tx-id (random-uuid) - tx-data [[:db/add block-ref :block/tags [:block/uuid tag-uuid]]] - reversed-tx-data [[:db/retract block-ref :block/tags [:block/uuid tag-uuid]]]] - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id action-tx-id - :db-sync/pending? true - :db-sync/forward-outliner-ops - [[:set-block-property [block-uuid - :block/tags - [:block/uuid tag-uuid]]]] - :db-sync/inverse-outliner-ops - [[:remove-block-property [block-ref :block/tags]]] - :db-sync/normalized-tx-data tx-data - :db-sync/reversed-tx-data reversed-tx-data}]) - (is (= true - (:applied? (#'sync-apply/apply-history-action! test-repo action-tx-id false {})))) - (is (= #{(:db/id tag)} - (set (map :db/id (:block/tags (d/entity @conn block-ref)))))) - (is (= true - (:applied? (#'sync-apply/apply-history-action! test-repo action-tx-id true {})))) - (is (empty? (:block/tags (d/entity @conn block-ref)))))))))) - -(deftest apply-history-action-redo-replays-insert-blocks-test - (testing "apply-history-action should redo an inserted block from semantic history" - (let [{:keys [conn client-ops-conn parent]} (setup-parent-child) - requested-uuid (random-uuid)] - (with-datascript-conns conn client-ops-conn - (fn [] - (apply-ops! conn - [[:insert-blocks [[{:block/title "history insert" - :block/uuid requested-uuid}] - (:db/id parent) - {:sibling? false}]]] - local-tx-meta) - (let [pending (first (#'sync-apply/pending-txs test-repo)) - inserted (db-test/find-block-by-content @conn "history insert") - inserted-uuid (:block/uuid inserted) - {:keys [tx-id]} pending] - (is (= inserted-uuid - (get-in pending [:forward-outliner-ops 0 1 0 0 :block/uuid]))) - (is (= inserted-uuid - (get-in pending [:inverse-outliner-ops 0 1 0 0]))) - (is (= true - (:applied? (#'sync-apply/apply-history-action! test-repo tx-id true {})))) - (is (nil? (d/entity @conn [:block/uuid inserted-uuid]))) - (is (= true - (:applied? (#'sync-apply/apply-history-action! test-repo tx-id false {})))) - (let [inserted* (d/entity @conn [:block/uuid inserted-uuid])] - (is (some? inserted*)) - (is (= "history insert" (:block/title inserted*))) - (is (= (:block/uuid parent) - (some-> inserted* :block/parent :block/uuid)))))))))) - -(deftest apply-history-action-redo-replays-save-block-test - (testing "apply-history-action should redo an inline block edit from semantic history" - (let [{:keys [conn client-ops-conn child1]} (setup-parent-child) - child-uuid (:block/uuid child1)] - (with-datascript-conns conn client-ops-conn - (fn [] - (apply-ops! conn - [[:save-block [{:block/uuid child-uuid - :block/title "child 1 inline edit"} {}]]] - local-tx-meta) - (let [{:keys [tx-id]} (first (#'sync-apply/pending-txs test-repo))] - (is (= true - (:applied? (#'sync-apply/apply-history-action! test-repo tx-id true {})))) - (is (= "child 1" - (:block/title (d/entity @conn [:block/uuid child-uuid])))) - (is (= true - (:applied? (#'sync-apply/apply-history-action! test-repo tx-id false {})))) - (is (= "child 1 inline edit" - (:block/title (d/entity @conn [:block/uuid child-uuid])))))))))) - -(deftest apply-history-action-redo-rejects-save-block-with-late-created-query-ref-test - (testing "redo should reject save-block when a referenced query block does not exist yet" - (let [conn (db-test/create-conn-with-blocks - {:pages-and-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "source"}]}]}) - client-ops-conn (new-client-ops-db) - tx-id (random-uuid) - query-block-uuid (random-uuid)] - (with-datascript-conns conn client-ops-conn - (fn [] - (let [source (db-test/find-block-by-content @conn "source") - source-uuid (:block/uuid source) - source-page-uuid (:block/uuid (:block/page source))] - (is (some? (d/entity @conn [:block/uuid source-uuid]))) - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id tx-id - :db-sync/pending? true - :db-sync/created-at (.now js/Date) - :db-sync/outliner-op :save-block - :db-sync/forward-outliner-ops - [[:save-block [{:block/uuid source-uuid - :logseq.property/query [:block/uuid query-block-uuid]} - nil]] - [:save-block [{:block/uuid query-block-uuid - :block/title "" - :block/parent [:block/uuid source-page-uuid] - :block/page [:block/uuid source-page-uuid] - :block/order "a0"} - nil]]] - :db-sync/inverse-outliner-ops - [[:remove-block-property [source-uuid - :logseq.property/query]] - [:delete-blocks [[[:block/uuid query-block-uuid]] - {}]]] - :db-sync/normalized-tx-data [] - :db-sync/reversed-tx-data []}]) - (let [result (#'sync-apply/apply-history-action! test-repo tx-id false {}) - error (get result :error)] - (is (= false (:applied? result))) - (is (= :error (:reason result))) - (is (nil? error)) - (is (nil? (d/entity @conn [:block/uuid query-block-uuid]))) - (is (nil? (some-> (d/entity @conn [:block/uuid source-uuid]) - :logseq.property/query)))))))))) - -(deftest replay-save-block-missing-block-is-invalid-test - (testing "replay save-block should reject missing block even when parent/page attrs are present" - (let [conn (db-test/create-conn-with-blocks - {:pages-and-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "seed"}]}]}) - seed (db-test/find-block-by-content @conn "seed") - page-uuid (:block/uuid (:block/page seed)) - block-uuid (random-uuid)] - (is (thrown? js/Error - (with-silenced-console-error - #(#'sync-apply/replay-canonical-outliner-op! - conn - [:save-block [{:block/uuid block-uuid - :block/title "" - :block/parent [:block/uuid page-uuid] - :block/page [:block/uuid page-uuid] - :block/order "a0"} - nil]])))) - (is (nil? (d/entity @conn [:block/uuid block-uuid])))))) - -(deftest apply-history-action-redo-replays-status-property-test - (testing "apply-history-action should redo a status property change" - (let [conn (db-test/create-conn-with-blocks - {:pages-and-blocks - [{:page {:block/title "page1"} - :blocks [{:block/title "task" - :build/properties {:status "Todo"}}]}]}) - client-ops-conn (new-client-ops-db)] - (with-datascript-conns conn client-ops-conn - (fn [] - (let [task (db-test/find-block-by-content @conn "task") - task-uuid (:block/uuid task)] - (outliner-property/set-block-property! conn - (:db/id task) - :logseq.property/status - "Doing") - (let [{:keys [tx-id]} (first (#'sync-apply/pending-txs test-repo))] - (is (= true - (:applied? (#'sync-apply/apply-history-action! test-repo tx-id true {})))) - (is (= :logseq.property/status.todo - (some-> (d/entity @conn [:block/uuid task-uuid]) - :logseq.property/status - :db/ident))) - (is (= true - (:applied? (#'sync-apply/apply-history-action! test-repo tx-id false {})))) - (is (= :logseq.property/status.doing - (some-> (d/entity @conn [:block/uuid task-uuid]) - :logseq.property/status - :db/ident)))))))))) - -(deftest apply-history-action-redo-replays-upsert-property-test - (testing "apply-history-action should undo/redo creating a new property page" - (let [conn (db-test/create-conn-with-blocks - {:pages-and-blocks - [{:page {:block/title "page1"} - :blocks [{:block/title "seed"}]}]}) - client-ops-conn (new-client-ops-db) - property-name "custom_prop_x" - property-page-ids (fn [db] - (set (d/q '[:find [?e ...] - :where - [?e :block/tags :logseq.class/Property]] - db)))] - (with-datascript-conns conn client-ops-conn - (fn [] - (let [before-ids (property-page-ids @conn)] - (apply-ops! conn - [[:upsert-property [nil - {:logseq.property/type :default} - {:property-name property-name}]]] - local-tx-meta) - (let [after-ids (property-page-ids @conn) - created-id (first (seq (set/difference after-ids before-ids))) - created-ident (some-> (d/entity @conn created-id) :db/ident) - created-uuid (some-> (d/entity @conn created-id) :block/uuid) - {:keys [tx-id]} (first (#'sync-apply/pending-txs test-repo))] - (is (some? created-id)) - (is (keyword? created-ident)) - (is (uuid? created-uuid)) - (is (some? (d/entity @conn created-id))) - (let [pending (#'sync-apply/pending-tx-by-id test-repo tx-id)] - (is (= :upsert-property - (ffirst (:forward-outliner-ops pending)))) - (is (= created-ident - (get-in pending [:forward-outliner-ops 0 1 0]))) - (is (= :delete-page - (ffirst (:inverse-outliner-ops pending)))) - (is (= created-uuid - (get-in pending [:inverse-outliner-ops 0 1 0])) - (pr-str pending))) - (is (= true - (:applied? (#'sync-apply/apply-history-action! test-repo tx-id true {})))) - (is (nil? (d/entity @conn created-ident))) - (is (= true - (:applied? (#'sync-apply/apply-history-action! test-repo tx-id false {})))) - (let [restored (d/entity @conn created-ident)] - (is (some? restored)) - (is (= created-uuid (:block/uuid restored))))))))))) - -(deftest undo-upsert-property-many-node-restores-previous-schema-test - (testing "undoing upsert-property schema update should restore previous schema instead of deleting property" - (let [conn (db-test/create-conn-with-blocks - {:properties {:p-many {:logseq.property/type :node}} - :pages-and-blocks - [{:page {:block/title "page1"} - :blocks [{:block/title "seed"}]}]}) - client-ops-conn (new-client-ops-db) - property-id :user.property/p-many - prev-apply-action @undo-redo/*apply-history-action!] - (with-datascript-conns conn client-ops-conn - (fn [] - (reset! undo-redo/*apply-history-action! sync-apply/apply-history-action!) - (try - (d/transact! conn [[:db/add property-id :logseq.property/classes :logseq.class/Root]]) - (apply-ops! conn - [[:upsert-property [property-id - {:logseq.property/type :node - :db/cardinality :many} - {}]]] - local-tx-meta) - (let [{:keys [inverse-outliner-ops]} (last (#'sync-apply/pending-txs test-repo))] - (is (= :upsert-property - (ffirst inverse-outliner-ops))) - (is (= property-id - (get-in inverse-outliner-ops [0 1 0]))) - (is (string? (sqlite-util/write-transit-str inverse-outliner-ops))) - (is (= :db.cardinality/many - (:db/cardinality (d/entity @conn property-id)))) - (let [undo-result (undo-redo/undo test-repo)] - (is (= true (:undo? undo-result))) - (is (some? (d/entity @conn property-id))) - (is (= :db.cardinality/one - (:db/cardinality (d/entity @conn property-id)))))) - (finally - (reset! undo-redo/*apply-history-action! prev-apply-action)))))))) - -(deftest apply-history-action-redo-replays-block-concat-test - (testing "block concat history should undo via reversed tx and redo cleanly" - (let [conn (db-test/create-conn-with-blocks - {:pages-and-blocks - [{:page {:block/title "page1"} - :blocks [{:block/title "hellohello"} - {:block/title "hello"}]}]}) - client-ops-conn (new-client-ops-db)] - (with-datascript-conns conn client-ops-conn - (fn [] - (let [left (db-test/find-block-by-content @conn "hellohello") - right (db-test/find-block-by-content @conn "hello") - left-uuid (:block/uuid left) - right-uuid (:block/uuid right)] - (apply-ops! conn - [[:delete-blocks [[(:db/id right)] - {:deleted-by-uuid (random-uuid)}]] - [:save-block [{:block/uuid left-uuid - :block/title "hellohellohello"} nil]]] - local-tx-meta) - (let [{:keys [tx-id]} (first (#'sync-apply/pending-txs test-repo))] - (is (= "hellohellohello" - (:block/title (d/entity @conn [:block/uuid left-uuid])))) - (is (nil? (d/entity @conn [:block/uuid right-uuid]))) - (is (= true - (:applied? (#'sync-apply/apply-history-action! test-repo tx-id true {})))) - (is (= "hellohello" - (:block/title (d/entity @conn [:block/uuid left-uuid])))) - (is (some? (d/entity @conn [:block/uuid right-uuid]))) - (is (= true - (:applied? (#'sync-apply/apply-history-action! test-repo tx-id false {})))) - (is (= "hellohellohello" - (:block/title (d/entity @conn [:block/uuid left-uuid])))) - (is (nil? (d/entity @conn [:block/uuid right-uuid])))))))))) - -(deftest apply-history-action-redo-replays-save-then-insert-test - (testing "apply-history-action should redo a combined save-block then insert-block history action" - (let [{:keys [conn client-ops-conn child1]} (setup-parent-child) - child-uuid (:block/uuid child1) - child-id (:db/id child1) - inserted-uuid (random-uuid)] - (with-datascript-conns conn client-ops-conn - (fn [] - (apply-ops! conn - [[:save-block [{:block/uuid child-uuid - :block/title "child 1 edited"} {}]] - [:insert-blocks [[{:block/title "inserted after save" - :block/uuid inserted-uuid}] - child-id - {:sibling? true}]]] - local-tx-meta) - (let [{:keys [tx-id]} (first (#'sync-apply/pending-txs test-repo)) - inserted-id (d/q '[:find ?e . - :in $ ?title - :where - [?e :block/title ?title]] - @conn - "inserted after save") - inserted (d/entity @conn inserted-id) - inserted-uuid' (:block/uuid inserted)] - (is (= true - (:applied? (#'sync-apply/apply-history-action! test-repo tx-id true {})))) - (is (= "child 1" - (:block/title (d/entity @conn [:block/uuid child-uuid])))) - (is (nil? (d/entity @conn [:block/uuid inserted-uuid']))) - (is (= true - (:applied? (#'sync-apply/apply-history-action! test-repo tx-id false {})))) - (is (= "child 1 edited" - (:block/title (d/entity @conn [:block/uuid child-uuid])))) - (is (= "inserted after save" - (:block/title (d/entity @conn [:block/uuid inserted-uuid'])))))))))) - -(deftest apply-history-action-redo-replays-paste-into-empty-target-test - (testing "redo should replay paste into an empty target block without invalid rebase op" - (let [conn (db-test/create-conn-with-blocks - {:pages-and-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "first"} - {:block/title ""}]}]}) - client-ops-conn (new-client-ops-db) - empty-target (db-test/find-block-by-content @conn "") - empty-target-uuid (:block/uuid empty-target) - parent-uuid (random-uuid) - copied-blocks [{:block/uuid parent-uuid - :block/title "paste parent"} - {:block/uuid (random-uuid) - :block/title "paste child" - :block/parent [:block/uuid parent-uuid]}]] - (with-datascript-conns conn client-ops-conn - (fn [] - (apply-ops! conn - [[:insert-blocks [copied-blocks - (:db/id empty-target) - {:sibling? true - :outliner-op :paste - :replace-empty-target? true}]]] - local-tx-meta) - (let [pending (first (#'sync-apply/pending-txs test-repo)) - {:keys [tx-id]} pending - pasted-id (d/q '[:find ?e . - :in $ ?title - :where - [?e :block/title ?title]] - @conn - "paste parent") - pasted-child-id (d/q '[:find ?e . - :in $ ?title - :where - [?e :block/title ?title]] - @conn - "paste child") - pasted (d/entity @conn pasted-id) - pasted-uuid (:block/uuid pasted) - pasted-child-uuid (:block/uuid (d/entity @conn pasted-child-id))] - (is (some #(and (= :delete-blocks (first %)) - (= [empty-target-uuid] - (vec (get-in % [1 0])))) - (:inverse-outliner-ops pending))) - (is (some #(and (= :insert-blocks (first %)) - (= empty-target-uuid - (get-in % [1 0 0 :block/uuid]))) - (:inverse-outliner-ops pending))) - (is (not-any? #(= :save-block (first %)) - (:inverse-outliner-ops pending))) - (is (= true - (:applied? (#'sync-apply/apply-history-action! test-repo tx-id true {})))) - (let [restored-target (d/entity @conn [:block/uuid empty-target-uuid])] - (is (some? restored-target)) - (is (= "" (:block/title restored-target)))) - (is (nil? (d/entity @conn [:block/uuid pasted-child-uuid]))) - (is (= true - (:applied? (#'sync-apply/apply-history-action! test-repo tx-id false {})))) - (let [redone (d/entity @conn [:block/uuid pasted-uuid])] - (is (some? redone)) - (is (= "paste parent" (:block/title redone)))))))))) - -(deftest apply-history-action-redo-replays-insert-save-delete-sequence-test - (testing "history actions replay insert -> save -> recycle-delete in undo/redo order" - (let [{:keys [conn client-ops-conn parent]} (setup-parent-child) - inserted-uuid (random-uuid)] - (with-datascript-conns conn client-ops-conn - (fn [] - (apply-ops! conn - [[:insert-blocks [[{:block/title "draft" - :block/uuid inserted-uuid}] - (:db/id parent) - {:sibling? false}]]] - local-tx-meta) - (let [inserted (db-test/find-block-by-content @conn "draft") - inserted-uuid' (:block/uuid inserted)] - (apply-ops! conn - [[:save-block [{:block/uuid inserted-uuid' - :block/title "published"} {}]]] - local-tx-meta) - (outliner-core/delete-blocks! conn - [(d/entity @conn [:block/uuid inserted-uuid'])] - {}) - (let [pending (#'sync-apply/pending-txs test-repo) - insert-action (some #(when (= :insert-blocks (:outliner-op %)) %) pending) - save-action (some #(when (= :save-block (:outliner-op %)) %) pending) - delete-action (some #(when (= :delete-blocks (:outliner-op %)) %) pending)] - (is (some? insert-action)) - (is (some? save-action)) - (is (some? delete-action)) - (is (nil? (d/entity @conn [:block/uuid inserted-uuid']))) - - (is (= true - (:applied? (#'sync-apply/apply-history-action! test-repo - (:tx-id delete-action) - true - {})))) - (is (= "published" - (:block/title (d/entity @conn [:block/uuid inserted-uuid'])))) - - (is (= true - (:applied? (#'sync-apply/apply-history-action! test-repo - (:tx-id save-action) - true - {})))) - (is (= "draft" - (:block/title (d/entity @conn [:block/uuid inserted-uuid'])))) - - (is (= true - (:applied? (#'sync-apply/apply-history-action! test-repo - (:tx-id save-action) - false - {})))) - (is (= "published" - (:block/title (d/entity @conn [:block/uuid inserted-uuid'])))) - - (is (= true - (:applied? (#'sync-apply/apply-history-action! test-repo - (:tx-id delete-action) - false - {})))) - (is (nil? (d/entity @conn [:block/uuid inserted-uuid'])))))))))) - -(deftest apply-history-action-undo-keeps-working-after-remote-non-structural-update-test - (testing "undo/redo of local semantic save still works after a remote metadata-only update" - (let [{:keys [conn client-ops-conn child1]} (setup-parent-child) - child-id (:db/id child1) - child-uuid (:block/uuid child1)] - (with-datascript-conns conn client-ops-conn - (fn [] - (apply-ops! conn - [[:save-block [{:block/uuid child-uuid - :block/title "local-2"} {}]]] - local-tx-meta) - (let [{:keys [tx-id]} (first (#'sync-apply/pending-txs test-repo))] - (#'sync-apply/apply-remote-tx! - test-repo - nil - [[:db/add child-id :block/updated-at 12345]]) - (is (= true - (:applied? (#'sync-apply/apply-history-action! test-repo tx-id true {})))) - (is (= "child 1" - (:block/title (d/entity @conn [:block/uuid child-uuid])))) - (is (= true - (:applied? (#'sync-apply/apply-history-action! test-repo tx-id false {})))) - (is (= "local-2" - (:block/title (d/entity @conn [:block/uuid child-uuid])))))))))) - -(deftest apply-history-action-undo-restores-hard-deleted-block-via-semantic-inverse-test - (testing "history action undo restores a hard-deleted block via semantic inverse ops" - (let [{:keys [conn client-ops-conn child1 parent]} (setup-parent-child) - child-uuid (:block/uuid child1) - parent-uuid (some-> child1 :block/parent :block/uuid) - page-uuid (some-> parent :block/page :block/uuid)] - (with-datascript-conns conn client-ops-conn - (fn [] - (let [_ (outliner-core/delete-blocks! conn - [(d/entity @conn [:block/uuid child-uuid])] - {}) - delete-action (->> (#'sync-apply/pending-txs test-repo) - (filter #(= :delete-blocks (:outliner-op %))) - last) - deleted (d/entity @conn [:block/uuid child-uuid])] - (is (some? delete-action)) - (is (nil? deleted)) - (is (= :insert-blocks - (ffirst (:inverse-outliner-ops delete-action)))) - - (let [undo-result (#'sync-apply/apply-history-action! test-repo - (:tx-id delete-action) - true - {})] - (is (= true (:applied? undo-result)))) - (let [restored (d/entity @conn [:block/uuid child-uuid])] - (is (= page-uuid (some-> restored :block/page :block/uuid))) - (is (= parent-uuid (some-> restored :block/parent :block/uuid))) - (is (nil? (:logseq.property/deleted-at restored)))))))))) - -(deftest apply-history-action-undo-restores-multi-parent-delete-via-semantic-inverse-test - (testing "history action undo restores deleted roots to their original parents when roots span multiple parents" - (let [{:keys [conn client-ops-conn parent-a parent-b a-child-1 b-child-1]} (setup-two-parents) - a-child-uuid (:block/uuid a-child-1) - b-child-uuid (:block/uuid b-child-1) - parent-a-uuid (:block/uuid parent-a) - parent-b-uuid (:block/uuid parent-b)] - (with-datascript-conns conn client-ops-conn - (fn [] - (outliner-core/delete-blocks! conn - [(d/entity @conn [:block/uuid a-child-uuid]) - (d/entity @conn [:block/uuid b-child-uuid])] - {}) - (let [delete-action (->> (#'sync-apply/pending-txs test-repo) - (filter #(= :delete-blocks (:outliner-op %))) - last)] - (is (some? delete-action)) - (is (= true - (:applied? (#'sync-apply/apply-history-action! test-repo - (:tx-id delete-action) - true - {})))) - (let [restored-a (d/entity @conn [:block/uuid a-child-uuid]) - restored-b (d/entity @conn [:block/uuid b-child-uuid])] - (is (= parent-a-uuid (some-> restored-a :block/parent :block/uuid))) - (is (= parent-b-uuid (some-> restored-b :block/parent :block/uuid)))))))))) - -(deftest move-blocks-multi-parent-builds-per-root-inverse-history-test - (testing "move-blocks across different source parents builds per-root inverse move ops" - (let [{:keys [conn client-ops-conn parent-b a-child-1 b-child-1 parent-a]} (setup-two-parents) - a-child-uuid (:block/uuid a-child-1) - b-child-uuid (:block/uuid b-child-1) - parent-a-uuid (:block/uuid parent-a) - parent-b-uuid (:block/uuid parent-b)] - (with-datascript-conns conn client-ops-conn - (fn [] - (apply-ops! conn - [[:move-blocks [[(:db/id a-child-1) - (:db/id b-child-1)] - (:db/id parent-b) - {:sibling? false}]]] - local-tx-meta) - (let [move-action (->> (#'sync-apply/pending-txs test-repo) - (filter #(= :move-blocks (:outliner-op %))) - last) - inverse-ops (:inverse-outliner-ops move-action)] - (is (some? move-action)) - (is (= 2 (count inverse-ops))) - (is (some #(and (= :move-blocks (first %)) - (= [a-child-uuid] (get-in % [1 0])) - (= parent-a-uuid (get-in % [1 1])) - (= false (get-in % [1 2 :sibling?]))) - inverse-ops)) - (is (some #(and (= :move-blocks (first %)) - (= [b-child-uuid] (get-in % [1 0])) - (= parent-b-uuid (get-in % [1 1])) - (= false (get-in % [1 2 :sibling?]))) - inverse-ops)))))))) - -(deftest apply-history-action-undo-restores-multi-parent-move-via-semantic-inverse-test - (testing "history action undo restores moved roots to original parents when roots span multiple parents" - (let [{:keys [conn client-ops-conn parent-b a-child-1 b-child-1 parent-a]} (setup-two-parents) - a-child-uuid (:block/uuid a-child-1) - b-child-uuid (:block/uuid b-child-1) - parent-a-uuid (:block/uuid parent-a) - parent-b-uuid (:block/uuid parent-b)] - (with-datascript-conns conn client-ops-conn - (fn [] - (apply-ops! conn - [[:move-blocks [[(:db/id a-child-1) - (:db/id b-child-1)] - (:db/id parent-b) - {:sibling? false}]]] - local-tx-meta) - (let [move-action (->> (#'sync-apply/pending-txs test-repo) - (filter #(= :move-blocks (:outliner-op %))) - last)] - (is (some? move-action)) - (is (= true - (:applied? (#'sync-apply/apply-history-action! test-repo - (:tx-id move-action) - true - {})))) - (let [restored-a (d/entity @conn [:block/uuid a-child-uuid]) - restored-b (d/entity @conn [:block/uuid b-child-uuid])] - (is (= parent-a-uuid (some-> restored-a :block/parent :block/uuid))) - (is (= parent-b-uuid (some-> restored-b :block/parent :block/uuid)))))))))) - -(deftest apply-history-action-undo-replays-move-blocks-with-nested-lookup-ref-id-test - (testing "undo should replay move-blocks when ids contain a nested lookup-ref wrapper" - (let [{:keys [conn client-ops-conn parent-b a-child-1]} (setup-two-parents) - tx-id (random-uuid) - child-uuid (:block/uuid a-child-1) - target-parent-uuid (:block/uuid parent-b)] - (with-datascript-conns conn client-ops-conn - (fn [] - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id tx-id - :db-sync/pending? true - :db-sync/created-at (.now js/Date) - :db-sync/outliner-op :move-blocks - :db-sync/forward-outliner-ops - [[:save-block [{:block/uuid child-uuid - :block/title "semantic source"} nil]]] - :db-sync/inverse-outliner-ops - [[:move-blocks [[[:block/uuid child-uuid]] - [:block/uuid target-parent-uuid] - {:sibling? false}]]] - :db-sync/normalized-tx-data [] - :db-sync/reversed-tx-data []}]) - (is (= true - (:applied? (#'sync-apply/apply-history-action! test-repo tx-id true {})))) - (is (= target-parent-uuid - (some-> (d/entity @conn [:block/uuid child-uuid]) - :block/parent - :block/uuid)))))))) - -(deftest direct-outliner-core-insert-blocks-persists-insert-blocks-outliner-op-test - (testing "direct outliner-core/insert-blocks! still persists singleton insert-blocks forward-outliner-ops" - (let [{:keys [conn client-ops-conn parent]} (setup-parent-child)] - (with-datascript-conns conn client-ops-conn - (fn [] - (outliner-core/insert-blocks! conn - [{:block/title "direct insert"}] - parent - {:sibling? false}) - (let [{:keys [forward-outliner-ops]} (first (#'sync-apply/pending-txs test-repo))] - (is (= :insert-blocks (ffirst forward-outliner-ops))) - (is (= (:block/uuid parent) - (get-in forward-outliner-ops [0 1 1]))))))))) - -(deftest rebase-create-page-keeps-page-uuid-test - (testing "rebased create-page should preserve the original page uuid" - (let [{:keys [conn client-ops-conn parent]} (setup-parent-child) - page-title "rebase page uuid"] - (with-datascript-conns conn client-ops-conn - (fn [] - (apply-ops! conn - [[:create-page [page-title {:redirect? false - :split-namespace? true - :tags ()}]]] - local-tx-meta) - (let [page-before (db-test/find-page-by-title @conn page-title) - page-uuid (:block/uuid page-before) - pending-before (last (#'sync-apply/pending-txs test-repo))] - (is (= :create-page (ffirst (:forward-outliner-ops pending-before)))) - (is (= page-uuid (get-in pending-before [:forward-outliner-ops 0 1 1 :uuid]))) - (is (= :delete-page - (ffirst (:inverse-outliner-ops pending-before)))) - (is (= page-uuid - (get-in pending-before [:inverse-outliner-ops 0 1 0]))) - (#'sync-apply/apply-remote-tx! - test-repo - nil - [[:db/add (:db/id parent) :block/title "parent remote create-page"]]) - (let [page-after (db-test/find-page-by-title @conn page-title)] - (is (some? page-after)) - (is (= page-uuid (:block/uuid page-after)))))))))) - -(deftest rebase-duplicate-create-page-keeps-remote-children-test - (testing "rebased duplicate create-page should not remove remote children" - (let [{:keys [conn client-ops-conn]} (setup-parent-child) - page-title "shared rebase page" - child-uuid (random-uuid) - now 1760000000000] - (with-datascript-conns conn client-ops-conn - (fn [] - (apply-ops! conn - [[:create-page [page-title {:redirect? false - :split-namespace? true - :tags ()}]]] - local-tx-meta) - (let [page-uuid (:block/uuid (db-test/find-page-by-title @conn page-title)) - pending-before (last (#'sync-apply/pending-txs test-repo)) - remote-page-tx (:tx pending-before) - remote-child-tx [[:db/add (str child-uuid) :block/uuid child-uuid] - [:db/add (str child-uuid) :block/title "remote child"] - [:db/add (str child-uuid) :block/page [:block/uuid page-uuid]] - [:db/add (str child-uuid) :block/parent [:block/uuid page-uuid]] - [:db/add (str child-uuid) :block/order "a0"] - [:db/add (str child-uuid) :block/created-at now] - [:db/add (str child-uuid) :block/updated-at now]]] - (#'sync-apply/apply-remote-txs! - test-repo - nil - [{:tx-data remote-page-tx} - {:tx-data remote-child-tx}]) - (let [page-after (db-test/find-page-by-title @conn page-title) - child-after (d/entity @conn [:block/uuid child-uuid])] - (is (some? page-after)) - (is (= page-uuid (:block/uuid page-after))) - (is (= "remote child" (:block/title child-after))) - (is (= page-uuid (:block/uuid (:block/page child-after))))))))))) - -(deftest rebase-drops-stale-title-add-for-remotely-deleted-reference-view-test - (testing "remote datom batches should not leave a deleted reference view as title-only invalid data" - (let [{:keys [conn client-ops-conn parent]} (setup-parent-child) - page (:block/page parent) - page-uuid (:block/uuid page) - page-id (:db/id page) - local-page-title "Jul 7th, 2026" - local-page-name (common-util/page-name-sanity-lc local-page-title) - local-page-uuid (random-uuid) - view-uuid (random-uuid) - now 1760000000000 - local-page-tx-data [[:db/add "local-page" :block/name local-page-name] - [:db/add "local-page" :block/title local-page-title] - [:db/add "local-page" :block/uuid local-page-uuid] - [:db/add "local-page" :block/created-at now] - [:db/add "local-page" :block/updated-at now] - [:db/add "local-page" :block/tags :logseq.class/Page]] - local-page-reversed-tx-data [[:db/retractEntity [:block/uuid local-page-uuid]]] - view-tx-data [[:db/add "remote-view" :block/title "Unlinked references"] - [:db/add "remote-view" :block/uuid view-uuid] - [:db/add "remote-view" :block/created-at now] - [:db/add "remote-view" :block/updated-at now] - [:db/add "remote-view" :block/page [:block/uuid page-uuid]] - [:db/add "remote-view" :block/parent [:block/uuid page-uuid]] - [:db/add "remote-view" :block/order "cD66"] - [:db/add "remote-view" :logseq.property/view-for [:block/uuid page-uuid]] - [:db/add "remote-view" :logseq.property.view/feature-type :unlinked-references] - [:db/add "remote-view" :logseq.property.view/group-by-property :block/page] - [:db/add "remote-view" :logseq.property.view/type :logseq.property.view/type.list]]] - (d/transact! conn (concat local-page-tx-data view-tx-data)) - (with-datascript-conns conn client-ops-conn - (fn [] - (let [view (d/entity @conn [:block/uuid view-uuid]) - view-id (:db/id view) - view-type-id (:db/id (:logseq.property.view/type view)) - group-by-property-id (:db/id (:logseq.property.view/group-by-property view))] - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id (random-uuid) - :db-sync/pending? true - :db-sync/created-at now - :db-sync/outliner-op :create-page - :db-sync/forward-outliner-ops - [[:create-page [local-page-title {:redirect? false - :split-namespace? false - :today-journal? true - :tags () - :uuid local-page-uuid}]]] - :db-sync/inverse-outliner-ops [[:delete-page [local-page-uuid {}]]] - :db-sync/normalized-tx-data local-page-tx-data - :db-sync/reversed-tx-data local-page-reversed-tx-data}]) - (is (= 1 (count (#'sync-apply/pending-txs test-repo)))) - (#'sync-apply/apply-remote-txs! - test-repo - nil - [{:tx-data [(d/datom view-id :block/created-at now now false) - (d/datom view-id :block/order "cD66" now false) - (d/datom view-id :block/page page-id now false) - (d/datom view-id :block/parent page-id now false) - (d/datom view-id :block/title "Unlinked references" now false) - (d/datom view-id :block/updated-at now now false) - (d/datom view-id :block/uuid view-uuid now false) - (d/datom view-id :logseq.property/view-for page-id now false) - (d/datom view-id :logseq.property.view/feature-type :unlinked-references now false) - (d/datom view-id :logseq.property.view/group-by-property group-by-property-id now false) - (d/datom view-id :logseq.property.view/type view-type-id now false) - (d/datom view-id :block/title "Unlinked references" (inc now) true)]}]) - (let [view-after (d/entity @conn [:block/uuid view-uuid]) - validation (db-validate/validate-local-db! @conn)] - (is (nil? view-after)) - (is (empty? (non-recycle-validation-entities validation)) - (str (:errors validation)))))))))) - -(deftest rebase-insert-blocks-keeps-block-uuid-test - (testing "rebased insert-blocks should preserve the original block uuid" - (let [{:keys [conn client-ops-conn parent]} (setup-parent-child)] - (with-datascript-conns conn client-ops-conn - (fn [] - (apply-ops! conn - [[:insert-blocks [[{:block/title "rebase uuid block" - :block/uuid (random-uuid)}] - (:db/id parent) - {:sibling? false}]]] - local-tx-meta) - (let [block-before (db-test/find-block-by-content @conn "rebase uuid block") - block-uuid (:block/uuid block-before) - pending-before (last (#'sync-apply/pending-txs test-repo))] - (is (some? block-before)) - (is (= :insert-blocks (ffirst (:forward-outliner-ops pending-before)))) - (is (= block-uuid - (get-in pending-before [:forward-outliner-ops 0 1 0 0 :block/uuid]))) - (is (= true (get-in pending-before [:forward-outliner-ops 0 1 2 :keep-uuid?]))) - (#'sync-apply/apply-remote-tx! - test-repo - nil - [[:db/add (:db/id parent) :block/title "parent remote insert-blocks"]]) - (let [block-after (d/entity @conn [:block/uuid block-uuid])] - (is (some? block-after)) - (is (= block-uuid (:block/uuid block-after)))))))))) - -(deftest rebase-local-insert-then-save-keeps-cardinality-one-values-test - (testing "rebasing local insert followed by save should not leave duplicate cardinality-one attrs" - (let [{:keys [conn client-ops-conn parent child1]} (setup-parent-child) - block-id (:db/id child1) - block-uuid (:block/uuid child1) - parent-uuid (:block/uuid parent) - now (.now js/Date)] - (d/transact! conn [[:db/add block-id :block/title "local saved"]]) - (with-datascript-conns conn client-ops-conn - (fn [] - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id (random-uuid) - :db-sync/pending? true - :db-sync/created-at now - :db-sync/outliner-op :insert-blocks - :db-sync/forward-outliner-ops - [[:insert-blocks [[{:block/title "local inserted" - :block/uuid block-uuid}] - parent-uuid - {:sibling? false - :keep-uuid? true}]]] - :db-sync/inverse-outliner-ops [] - :db-sync/normalized-tx-data - [[:db/add [:block/uuid block-uuid] :block/title "local inserted"]] - :db-sync/reversed-tx-data - [[:db/retractEntity [:block/uuid block-uuid]]]} - {:db-sync/tx-id (random-uuid) - :db-sync/pending? true - :db-sync/created-at (inc now) - :db-sync/outliner-op :save-block - :db-sync/forward-outliner-ops - [[:save-block [{:block/uuid block-uuid - :block/title "local saved"} nil]]] - :db-sync/inverse-outliner-ops [] - :db-sync/normalized-tx-data - [[:db/add [:block/uuid block-uuid] :block/title "local saved"]] - :db-sync/reversed-tx-data - [[:db/retract [:block/uuid block-uuid] :block/title "local saved"] - [:db/add [:block/uuid block-uuid] :block/title "local inserted"]]}]) - (is (= 2 (count (#'sync-apply/pending-txs test-repo)))) - (#'sync-apply/apply-remote-tx! - test-repo - nil - [[:db/add (:db/id parent) :block/updated-at 1710000000000]]) - (let [block-after (d/entity @conn [:block/uuid block-uuid]) - validation (db-validate/validate-local-db! @conn)] - (is (= "local saved" (:block/title block-after))) - (is (empty? (:errors validation)) - (str (:errors validation))))))))) - -(deftest rebase-insert-indent-save-sequence-keeps-structural-state-test - (testing "rebasing insert -> indent -> save keeps parent linkage and local page attrs stable" - (let [conn (db-test/create-conn-with-blocks - {:pages-and-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "parent" - :build/children [{:block/title "child 1"}]}]} - {:page {:block/title "page 2"} - :blocks []}]}) - client-ops-conn (new-client-ops-db) - parent (db-test/find-block-by-content @conn "parent") - page-1 (db-test/find-page-by-title @conn "page 1") - page-2 (db-test/find-page-by-title @conn "page 2") - parent-uuid (:block/uuid parent) - block-uuid (random-uuid)] - (with-datascript-conns conn client-ops-conn - (fn [] - (outliner-core/insert-blocks! conn - [{:block/uuid block-uuid - :block/title ""}] - parent - {:sibling? true - :keep-uuid? true}) - (let [inserted (d/entity @conn [:block/uuid block-uuid])] - (outliner-core/indent-outdent-blocks! conn [inserted] true) - (outliner-core/save-block! conn - (assoc (d/entity @conn [:block/uuid block-uuid]) - :block/title "121") - {})) - (#'sync-apply/apply-remote-tx! - test-repo - nil - [[:db/retract [:block/uuid parent-uuid] :block/parent [:block/uuid (:block/uuid page-1)]] - [:db/add [:block/uuid parent-uuid] :block/parent [:block/uuid (:block/uuid page-2)]] - [:db/retract [:block/uuid parent-uuid] :block/page [:block/uuid (:block/uuid page-1)]] - [:db/add [:block/uuid parent-uuid] :block/page [:block/uuid (:block/uuid page-2)]] - [:db/retract [:block/uuid parent-uuid] :block/order (:block/order parent)] - [:db/add [:block/uuid parent-uuid] :block/order "a0"]]) - (let [block-after (d/entity @conn [:block/uuid block-uuid])] - (is (some? block-after)) - (is (= "121" (:block/title block-after))) - (is (= parent-uuid (-> block-after :block/parent :block/uuid))) - (is (= (:block/uuid page-1) (-> block-after :block/page :block/uuid))))))))) - -(deftest rebase-keeps-local-insert-and-save-when-sibling-target-deleted-test - (testing "local insert followed by save should survive when remote deletes only the sibling insert target" - (let [{:keys [conn client-ops-conn parent child1]} (setup-parent-child) - remote-delete-sibling-tx (:tx-data (outliner-core/delete-blocks @conn [child1] {})) - block-uuid (random-uuid)] - (with-redefs [db-sync/enqueue-local-tx! - (let [orig db-sync/enqueue-local-tx!] - (fn [repo tx-report] - (when-not (:rtc-tx? (:tx-meta tx-report)) - (orig repo tx-report))))] - (with-datascript-conns conn client-ops-conn - (fn [] - (outliner-core/insert-blocks! conn - [{:block/uuid block-uuid - :block/title ""}] - child1 - {:sibling? true - :keep-uuid? true}) - (outliner-core/save-block! conn - (assoc (d/entity @conn [:block/uuid block-uuid]) - :block/title "local unsynced text") - {}) - (let [pending-before (#'sync-apply/pending-txs test-repo)] - (is (<= 2 (count pending-before))) - (#'sync-apply/apply-remote-tx! test-repo nil remote-delete-sibling-tx) - (let [block-after (d/entity @conn [:block/uuid block-uuid]) - parent-after (d/entity @conn [:block/uuid (:block/uuid parent)])] - (is (some? block-after)) - (is (= "local unsynced text" (:block/title block-after))) - (is (= (:block/uuid parent-after) - (-> block-after :block/parent :block/uuid))))))))))) - -(deftest rebase-replays-pending-insert-before-save-when-local-db-missed-pending-block-test - (testing "stale local DB plus durable pending insert/save should recover the unsynced block during rebase" - (let [{:keys [conn client-ops-conn parent]} (setup-parent-child) - parent-uuid (:block/uuid parent) - page-uuid (:block/uuid (:block/page parent)) - block-uuid (random-uuid) - insert-tx-id (random-uuid) - save-tx-id (random-uuid)] - (with-datascript-conns conn client-ops-conn - (fn [] - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id insert-tx-id - :db-sync/created-at 1 - :db-sync/outliner-op :insert-blocks - :db-sync/forward-outliner-ops [[:insert-blocks [[{:block/uuid block-uuid - :block/title ""}] - parent-uuid - {:sibling? false - :keep-uuid? true}]]] - :db-sync/inverse-outliner-ops [[:delete-blocks [[block-uuid] {}]]] - :db-sync/normalized-tx-data [[:db/add (str block-uuid) :block/uuid block-uuid] - [:db/add (str block-uuid) :block/title ""] - [:db/add (str block-uuid) :block/parent [:block/uuid parent-uuid]] - [:db/add (str block-uuid) :block/page [:block/uuid page-uuid]] - [:db/add (str block-uuid) :block/order "a0"]] - :db-sync/reversed-tx-data [[:db/retractEntity [:block/uuid block-uuid]]]} - {:db-sync/tx-id save-tx-id - :db-sync/created-at 2 - :db-sync/outliner-op :save-block - :db-sync/forward-outliner-ops [[:save-block [{:block/uuid block-uuid - :block/title "local unsynced text" - :block/parent [:block/uuid parent-uuid] - :block/page [:block/uuid page-uuid] - :block/order "a0"} - {}]]] - :db-sync/inverse-outliner-ops [[:save-block [{:block/uuid block-uuid - :block/title "" - :block/parent [:block/uuid parent-uuid] - :block/page [:block/uuid page-uuid] - :block/order "a0"} - {}]]] - :db-sync/normalized-tx-data [[:db/add [:block/uuid block-uuid] - :block/title - "local unsynced text"]] - :db-sync/reversed-tx-data [[:db/retract [:block/uuid block-uuid] - :block/title - "local unsynced text"] - [:db/add [:block/uuid block-uuid] - :block/title - ""]]}]) - (is (nil? (d/entity @conn [:block/uuid block-uuid]))) - (#'sync-apply/apply-remote-tx! - test-repo - nil - [[:db/add [:block/uuid parent-uuid] :block/title "remote parent title"]]) - (let [block-after (d/entity @conn [:block/uuid block-uuid])] - (is (some? block-after)) - (is (= "local unsynced text" (:block/title block-after))) - (is (= parent-uuid (-> block-after :block/parent :block/uuid))))))))) - -(deftest reaction-remove-enqueues-pending-sync-tx-test - (testing "removing a reaction should enqueue tx for db-sync" - (let [{:keys [conn client-ops-conn parent]} (setup-parent-child)] - (with-datascript-conns conn client-ops-conn - (fn [] - (apply-ops! conn - [[:toggle-reaction [(:block/uuid parent) "+1" nil]]] - local-tx-meta) - (let [reaction-eid (-> (d/datoms @conn :avet :logseq.property.reaction/target (:db/id parent)) - first - :e) - before-count (count (#'sync-apply/pending-txs test-repo))] - (is (some? reaction-eid)) - (apply-ops! conn - [[:toggle-reaction [(:block/uuid parent) "+1" nil]]] - local-tx-meta) - (let [after-count (count (#'sync-apply/pending-txs test-repo))] - (is (> after-count before-count))))))))) - -(deftest rebase-drops-pending-reaction-tx-when-target-is-remotely-deleted-test - (testing "pending reaction tx is dropped when remote rebase deletes its target" - (let [{:keys [conn client-ops-conn parent]} (setup-parent-child) - target-uuid (:block/uuid parent) - remote-delete-tx (:tx-data (outliner-core/delete-blocks @conn [parent] {}))] - (with-datascript-conns conn client-ops-conn - (fn [] - (apply-ops! conn - [[:toggle-reaction [target-uuid "+1" nil]]] - local-tx-meta) - (let [pending-before (#'sync-apply/pending-txs test-repo) - tx-id-before (:tx-id (first pending-before))] - (is (= 1 (count pending-before))) - (#'sync-apply/apply-remote-tx! - test-repo - nil - remote-delete-tx) - (let [pending-after (#'sync-apply/pending-txs test-repo) - tx-ent-after (client-op-tx-row client-ops-conn tx-id-before)] - (is (empty? pending-after)) - (is (some? tx-ent-after)) - (is (= 0 (aget tx-ent-after "pending")))))))))) - -(deftest tx-batch-ok-removes-acked-pending-txs-test - (testing "tx/batch/ok clears inflight and removes acked pending txs" - (let [{:keys [conn client-ops-conn]} (setup-parent-child) - client {:repo test-repo - :graph-id "graph-1" - :inflight (atom []) - :online-users (atom []) - :ws-state (atom :open)} - raw-message (js/JSON.stringify (clj->js {:type "tx/batch/ok" - :t 1}))] - (with-datascript-conns conn client-ops-conn - (fn [] - (worker-page/create! conn "Ack Page" :uuid (random-uuid)) - (let [pending-before (#'sync-apply/pending-txs test-repo) - tx-ids (mapv :tx-id pending-before)] - (is (seq pending-before)) - (reset! (:inflight client) tx-ids) - (sync-handle-message/handle-message! test-repo client raw-message) - (is (= [] @(:inflight client))) - (is (empty? (#'sync-apply/pending-txs test-repo))) - (is (= 1 (client-op/get-local-tx test-repo))))))))) - -(deftest tx-batch-ok-broadcasts-cleared-pending-state-test - (let [{:keys [conn client-ops-conn]} (setup-parent-child) - client {:repo test-repo - :graph-id "graph-1" - :inflight (atom []) - :online-users (atom []) - :ws-state (atom :open)} - raw-message (js/JSON.stringify (clj->js {:type "tx/batch/ok" - :t 1})) - broadcasts (atom [])] - (with-datascript-conns conn client-ops-conn - (fn [] - (worker-page/create! conn "Ack Page" :uuid (random-uuid)) - (reset! (:inflight client) - (mapv :tx-id (#'sync-apply/pending-txs test-repo))) - (with-redefs [shared-service/broadcast-to-clients! - (fn [event payload] - (when (= :rtc-sync-state event) - (swap! broadcasts conj payload)))] - (sync-handle-message/handle-message! test-repo client raw-message)) - (is (= 0 (:unpushed-block-update-count (last @broadcasts)))))))) - -(deftest tx-batch-ok-removes-only-inflight-acked-pending-txs-test - (testing "tx/batch/ok should only clear pending txs tracked in inflight" - (let [{:keys [conn client-ops-conn]} (setup-parent-child) - client {:repo test-repo - :graph-id "graph-1" - :inflight (atom []) - :online-users (atom []) - :ws-state (atom :open)} - raw-message (js/JSON.stringify (clj->js {:type "tx/batch/ok" - :t 1}))] - (with-datascript-conns conn client-ops-conn - (fn [] - (worker-page/create! conn "Ack Page A" :uuid (random-uuid)) - (worker-page/create! conn "Ack Page B" :uuid (random-uuid)) - (let [pending-before (#'sync-apply/pending-txs test-repo) - [acked-tx-id unacked-tx-id] (mapv :tx-id pending-before)] - (is (= 2 (count pending-before))) - (reset! (:inflight client) [acked-tx-id]) - (sync-handle-message/handle-message! test-repo client raw-message) - (is (= [] @(:inflight client))) - (is (= [unacked-tx-id] - (mapv :tx-id (#'sync-apply/pending-txs test-repo)))) - (is (= 1 (client-op/get-local-tx test-repo))))))))) - -(deftest tx-batch-ok-does-not-anchor-remote-checksum-after-acked-pending-txs-test - (testing "tx/batch/ok compares the existing local checksum instead of anchoring the remote checksum" - (let [{:keys [conn client-ops-conn]} (setup-parent-child) - remote-checksum "bad-remote-checksum" - *captured (atom nil) - client {:repo test-repo - :graph-id "graph-1" - :inflight (atom []) - :online-users (atom []) - :ws-state (atom :open)} - raw-message (js/JSON.stringify (clj->js {:type "tx/batch/ok" - :t 1 - :checksum remote-checksum}))] - (with-datascript-conns conn client-ops-conn - (fn [] - (worker-page/create! conn "Ack Checksum Page" :uuid (random-uuid)) - (let [pending-before (#'sync-apply/pending-txs test-repo) - tx-ids (mapv :tx-id pending-before) - local-checksum (sync-checksum/recompute-checksum @conn)] - (is (seq pending-before)) - (client-op/update-local-checksum test-repo local-checksum) - (reset! (:inflight client) tx-ids) - (with-redefs [sync-log-state/rtc-log (fn [type payload] - (reset! *captured {:type type - :payload payload}))] - (sync-handle-message/handle-message! test-repo client raw-message)) - (is (= [] @(:inflight client))) - (is (empty? (#'sync-apply/pending-txs test-repo))) - (is (= 1 (client-op/get-local-tx test-repo))) - (is (= local-checksum (client-op/get-local-checksum test-repo))) - (is (= :rtc.log/checksum-mismatch (:type @*captured))) - (is (= local-checksum (get-in @*captured [:payload :local-checksum]))) - (is (= remote-checksum (get-in @*captured [:payload :remote-checksum]))))))))) - -(deftest apply-remote-tx-does-not-clear-pending-without-ack-test - (testing "apply-remote-tx should not clear local pending txs before tx/batch/ok ack" - (let [{:keys [conn client-ops-conn parent]} (setup-parent-child) - parent-uuid (:block/uuid parent) - block-uuid (random-uuid) - remote-conn (d/conn-from-db @conn) - *remote-tx (atom nil)] - (d/listen! remote-conn ::capture-remote-same-insert - (fn [tx-report] - (when (seq (:tx-data tx-report)) - (reset! *remote-tx - (db-normalize/normalize-tx-data - (:db-after tx-report) - (:db-before tx-report) - (:tx-data tx-report)))))) - (try - (with-datascript-conns conn client-ops-conn - (fn [] - (outliner-core/insert-blocks! conn - [{:block/title "same insert" - :block/uuid block-uuid}] - parent - {:sibling? false - :keep-uuid? true}) - (let [pending-before (#'sync-apply/pending-txs test-repo) - pending-before-tx-ids (mapv :tx-id pending-before) - remote-parent (d/entity @remote-conn [:block/uuid parent-uuid])] - (is (= 1 (count pending-before))) - (outliner-core/insert-blocks! remote-conn - [{:block/title "same insert" - :block/uuid block-uuid}] - remote-parent - {:sibling? false - :keep-uuid? true}) - (is (seq @*remote-tx)) - (#'sync-apply/apply-remote-tx! test-repo nil @*remote-tx) - (let [pending-after (#'sync-apply/pending-txs test-repo)] - (is (= pending-before-tx-ids - (mapv :tx-id pending-after))) - (is (= 1 (count pending-after))))))) - (finally - (d/unlisten! remote-conn ::capture-remote-same-insert)))))) - -(deftest tx-batch-ok-stale-ack-does-not-regress-local-or-remote-checksum-state-test - (testing "stale tx/batch/ok should not regress local tx or latest remote checksum state" - (let [{:keys [conn client-ops-conn]} (setup-parent-child) - actual-checksum (sync-checksum/recompute-checksum @conn) - stale-checksum "ffffffffffffffff" - latest-tx-prev @db-sync/*repo->latest-remote-tx - latest-checksum-prev @db-sync/*repo->latest-remote-checksum - *captured (atom nil) - client {:repo test-repo - :graph-id "graph-1" - :inflight (atom []) - :online-users (atom []) - :ws-state (atom :open)} - raw-message (js/JSON.stringify (clj->js {:type "tx/batch/ok" - :t 4 - :checksum stale-checksum}))] - (with-datascript-conns conn client-ops-conn - (fn [] - (reset! db-sync/*repo->latest-remote-tx {test-repo 5}) - (reset! db-sync/*repo->latest-remote-checksum {test-repo actual-checksum}) - (client-op/update-local-tx test-repo 5) - (client-op/update-local-checksum test-repo actual-checksum) - (try - (with-redefs [sync-log-state/rtc-log (fn [type payload] - (reset! *captured {:type type - :payload payload}))] - (sync-handle-message/handle-message! test-repo client raw-message)) - (is (= [] @(:inflight client))) - (is (= 5 (client-op/get-local-tx test-repo))) - (is (= 5 (get @db-sync/*repo->latest-remote-tx test-repo))) - (is (= actual-checksum (get @db-sync/*repo->latest-remote-checksum test-repo))) - (is (nil? @*captured)) - (finally - (reset! db-sync/*repo->latest-remote-tx latest-tx-prev) - (reset! db-sync/*repo->latest-remote-checksum latest-checksum-prev)))))))) - -(deftest tx-batch-ok-real-checksum-mismatch-logs-warning-test - (testing "tx/batch/ok logs warning on true checksum mismatch without throwing" - (let [{:keys [conn client-ops-conn]} (setup-parent-child) - stale-checksum "0000000000000000" - remote-checksum "ffffffffffffffff" - client {:repo test-repo - :graph-id "graph-1" - :inflight (atom []) - :online-users (atom []) - :ws-state (atom :open)} - raw-message (js/JSON.stringify (clj->js {:type "tx/batch/ok" - :t 0 - :checksum remote-checksum}))] - (with-datascript-conns conn client-ops-conn - (fn [] - (client-op/update-local-checksum test-repo stale-checksum) - (is (= :ok - (try - (sync-handle-message/handle-message! test-repo client raw-message) - :ok - (catch :default _error - :thrown))))))))) - -(deftest local-checksum-stays-in-sync-after-undo-redo-sequence-test - (testing "insert/delete/indent/outdent with undo-all/redo-all keeps cached checksum aligned" - (let [{:keys [conn client-ops-conn parent]} (setup-parent-child) - inserted-uuid (random-uuid)] - (with-datascript-conns conn client-ops-conn - (fn [] - (client-op/update-local-checksum test-repo (sync-checksum/recompute-checksum @conn)) - (d/listen! conn ::checksum-sync - (fn [tx-report] - (when-not (:batch-tx? @conn) - (when (seq (:tx-data tx-report)) - (db-sync/update-local-sync-checksum! test-repo tx-report))))) - (try - (outliner-core/insert-blocks! conn - [{:block/uuid inserted-uuid - :block/title "tmp"}] - parent - {:sibling? false - :keep-uuid? true}) - (let [inserted (d/entity @conn [:block/uuid inserted-uuid])] - (outliner-core/indent-outdent-blocks! conn [inserted] true) - (outliner-core/indent-outdent-blocks! conn [inserted] false) - (outliner-core/delete-blocks @conn [inserted] {})) - (loop [n 0] - (let [result (undo-redo/undo test-repo)] - (when-not (= :frontend.worker.undo-redo/empty-undo-stack result) - (when (> n 128) - (throw (ex-info "undo loop exceeded" {:count n}))) - (recur (inc n))))) - (loop [n 0] - (let [result (undo-redo/redo test-repo)] - (when-not (= :frontend.worker.undo-redo/empty-redo-stack result) - (when (> n 128) - (throw (ex-info "redo loop exceeded" {:count n}))) - (recur (inc n))))) - (is (= (sync-checksum/recompute-checksum @conn) - (client-op/get-local-checksum test-repo))) - (finally - (d/unlisten! conn ::checksum-sync)))))))) - -(deftest reparent-block-when-cycle-detected-test - (testing "cycle from remote sync reparent block to page root" - (let [{:keys [conn parent child1]} (setup-parent-child)] - (with-datascript-conns conn nil - (fn [] - (#'sync-apply/apply-remote-tx! - test-repo - nil - [[:db/add (:db/id parent) :block/parent (:db/id child1)] - [:db/add (:db/id child1) :block/parent (:db/id (:block/page parent))]]) - (let [parent' (d/entity @conn (:db/id parent)) - child1' (d/entity @conn (:db/id child1)) - page' (:block/page parent')] - (is (some? page')) - (is (= (:db/id child1') (:db/id (:block/parent parent')))) - (is (= (:db/id page') (:db/id (:block/parent child1')))))))))) - -(deftest two-children-cycle-test - (testing "conflicting parent updates can retain the local cycle shape (2 children)" - (let [{:keys [conn client-ops-conn child1 child2]} (setup-parent-child) - remote-conn (d/conn-from-db @conn) - child1-uuid (:block/uuid child1) - child2-uuid (:block/uuid child2) - *remote-tx (atom nil)] - (d/listen! remote-conn ::capture-two-children-cycle-remote - (fn [tx-report] - (when-not @*remote-tx - (reset! *remote-tx - (db-normalize/normalize-tx-data - (:db-after tx-report) - (:db-before tx-report) - (:tx-data tx-report)))))) - (with-datascript-conns conn client-ops-conn - (fn [] - (d/transact! conn [[:db/add (:db/id child1) :block/parent (:db/id child2)]]) - (let [remote-child1 (d/entity @remote-conn [:block/uuid child1-uuid]) - remote-child2 (d/entity @remote-conn [:block/uuid child2-uuid])] - (outliner-core/move-blocks! remote-conn - [remote-child2] - remote-child1 - {:sibling? false})) - (is (seq @*remote-tx)) - (#'sync-apply/apply-remote-tx! test-repo nil @*remote-tx) - (let [child1' (d/entity @conn [:block/uuid child1-uuid]) - child2' (d/entity @conn [:block/uuid child2-uuid])] - (is (= "child 2" (:block/title (:block/parent child1')))) - (is (= "child 1" (:block/title (:block/parent child2'))))))) - (d/unlisten! remote-conn ::capture-two-children-cycle-remote)))) - -(deftest three-children-cycle-test - (testing "conflicting parent updates can retain a cycle shape (3 children)" - (let [{:keys [conn client-ops-conn child1 child2 child3]} (setup-parent-child) - remote-conn (d/conn-from-db @conn) - child1-uuid (:block/uuid child1) - child2-uuid (:block/uuid child2) - child3-uuid (:block/uuid child3) - *remote-txs (atom [])] - (d/listen! remote-conn ::capture-three-children-cycle-remote - (fn [tx-report] - (when (seq (:tx-data tx-report)) - (swap! *remote-txs conj - (db-normalize/normalize-tx-data - (:db-after tx-report) - (:db-before tx-report) - (:tx-data tx-report)))))) - (with-datascript-conns conn client-ops-conn - (fn [] - (d/transact! conn [[:db/add (:db/id child2) :block/parent (:db/id child1)] - [:db/add (:db/id child3) :block/parent (:db/id child2)]]) - (let [remote-child1 (d/entity @remote-conn [:block/uuid child1-uuid]) - remote-child2 (d/entity @remote-conn [:block/uuid child2-uuid]) - remote-child3 (d/entity @remote-conn [:block/uuid child3-uuid])] - (outliner-core/move-blocks! remote-conn - [remote-child2] - remote-child3 - {:sibling? false}) - (outliner-core/move-blocks! remote-conn - [remote-child1] - remote-child2 - {:sibling? false})) - (is (= 2 (count @*remote-txs))) - (#'sync-apply/apply-remote-txs! test-repo nil (mapv (fn [tx-data] {:tx-data tx-data}) @*remote-txs)) - (let [child' (d/entity @conn [:block/uuid child1-uuid]) - child2' (d/entity @conn [:block/uuid child2-uuid]) - child3' (d/entity @conn [:block/uuid child3-uuid])] - (is (= "child 2" (:block/title (:block/parent child')))) - (is (= "child 1" (:block/title (:block/parent child2')))) - (is (= "child 2" (:block/title (:block/parent child3'))))))) - (d/unlisten! remote-conn ::capture-three-children-cycle-remote)))) - -(deftest ignore-missing-parent-update-after-local-delete-test - (testing "remote hard delete removes descendants and marks stale local insert as non-pending" - (let [{:keys [conn client-ops-conn parent child1]} (setup-parent-child) - child-uuid (:block/uuid child1)] - (with-datascript-conns conn client-ops-conn - (fn [] - (outliner-core/insert-blocks! conn [{:block/title "child 4"}] parent {:sibling? false}) - (let [pending-before (#'sync-apply/pending-txs test-repo) - tx-id-before (:tx-id (first pending-before))] - (is (= 1 (count pending-before))) - (#'sync-apply/apply-remote-tx! - test-repo - nil - (:tx-data (outliner-core/delete-blocks @conn [parent] {}))) - (let [child' (d/entity @conn [:block/uuid child-uuid]) - pending-after (#'sync-apply/pending-txs test-repo) - tx-ent-after (client-op-tx-row client-ops-conn tx-id-before)] - (is (nil? child')) - (is (empty? pending-after)) - (is (some? tx-ent-after)) - (is (= 0 (aget tx-ent-after "pending")))))))))) - -(deftest missing-parent-after-remote-delete-removes-descendants-test - (testing "remote hard delete tx removes descendants when full delete tx-data is provided" - (let [{:keys [conn parent child1]} (setup-parent-child) - child-uuid (:block/uuid child1) - remote-delete-tx (:tx-data (outliner-core/delete-blocks @conn [parent] {}))] - (with-datascript-conns conn nil - (fn [] - (#'sync-apply/apply-remote-tx! - test-repo - nil - remote-delete-tx) - (let [child' (d/entity @conn [:block/uuid child-uuid])] - (is (nil? child')))))))) - -(deftest rebase-drops-local-property-pairs-for-remotely-deleted-property-test - (testing "remote property deletion removes stale local offline property writes during rebase" - (let [graph {:properties {:p2 {:logseq.property/type :default}} - :pages-and-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "local object"}]}]} - conn-a (db-test/create-conn-with-blocks graph) - conn-b (d/conn-from-db @conn-a) - client-ops-conn (new-client-ops-db) - remote-tx (atom nil)] - (d/listen! conn-b ::capture-property-delete-rebase - (fn [tx-report] - (when-not @remote-tx - (reset! remote-tx - (db-normalize/normalize-tx-data - (:db-after tx-report) - (:db-before tx-report) - (:tx-data tx-report)))))) - (try - (with-datascript-conns conn-a client-ops-conn - (fn [] - (let [local-block (db-test/find-block-by-content @conn-a "local object") - property-id :user.property/p2] - (outliner-property/set-block-property! conn-a - [:block/uuid (:block/uuid local-block)] - property-id - "local value")) - (outliner-page/delete! conn-b (:block/uuid (d/entity @conn-b :user.property/p2))) - (#'sync-apply/apply-remote-tx! test-repo nil @remote-tx) - (let [local-block' (db-test/find-block-by-content @conn-a "local object") - validation (db-validate/validate-local-db! @conn-a)] - (is (nil? (:user.property/p2 local-block'))) - (is (empty? (non-recycle-validation-entities validation)) - (str (:errors validation)))))) - (finally - (d/unlisten! conn-b ::capture-property-delete-rebase)))))) - -(deftest rebase-drops-local-tags-for-remotely-deleted-tag-test - (testing "remote tag deletion removes stale local offline tag writes during rebase" - (let [graph {:classes {:Tag1 {}} - :pages-and-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "local object"}]}]} - conn-a (db-test/create-conn-with-blocks graph) - conn-b (d/conn-from-db @conn-a) - client-ops-conn (new-client-ops-db) - remote-tx (atom nil)] - (d/listen! conn-b ::capture-tag-delete-rebase - (fn [tx-report] - (when-not @remote-tx - (reset! remote-tx - (db-normalize/normalize-tx-data - (:db-after tx-report) - (:db-before tx-report) - (:tx-data tx-report)))))) - (try - (with-datascript-conns conn-a client-ops-conn - (fn [] - (let [local-block (db-test/find-block-by-content @conn-a "local object") - tag-id (:db/id (d/entity @conn-a :user.class/Tag1))] - (ldb/transact! conn-a [[:db/add (:db/id local-block) :block/tags tag-id]] - local-tx-meta)) - (outliner-page/delete! conn-b (:block/uuid (d/entity @conn-b :user.class/Tag1))) - (#'sync-apply/apply-remote-tx! test-repo nil @remote-tx) - (let [local-block' (db-test/find-block-by-content @conn-a "local object") - validation (db-validate/validate-local-db! @conn-a)] - (is (empty? (:block/tags local-block'))) - (is (empty? (non-recycle-validation-entities validation)) - (str (:errors validation)))))) - (finally - (d/unlisten! conn-b ::capture-tag-delete-rebase)))))) - -(deftest rebase-inserted-page-ref-does-not-keep-stale-ref-to-remotely-deleted-tag-test - (testing "offline inserted [[tag1]] block keeps text but drops stale block/refs after remote tag deletion" - (let [graph {:classes {:tag1 {}} - :pages-and-blocks - [{:page {:block/title "page 1"} - :blocks []}]} - conn-a (db-test/create-conn-with-blocks graph) - conn-b (d/conn-from-db @conn-a) - client-ops-conn (new-client-ops-db) - remote-tx (atom nil)] - (d/listen! conn-b ::capture-ref-delete-rebase - (fn [tx-report] - (when-not @remote-tx - (reset! remote-tx - (db-normalize/normalize-tx-data - (:db-after tx-report) - (:db-before tx-report) - (:tx-data tx-report)))))) - (try - (with-datascript-conns conn-a client-ops-conn - (fn [] - (let [page (db-test/find-page-by-title @conn-a "page 1") - tag1 (ldb/get-page @conn-a "tag1") - result (apply-ops! - conn-a - [[:insert-blocks - [[{:block/title (common-util/format "[[%s]]" - (:block/uuid tag1)) - - :block/refs [{:block/uuid (:block/uuid tag1) - :block/title "tag1"}]}] - (:db/id page) - {:sibling? false}]]] - {}) - block-id (:block/uuid (first (:blocks result)))] - (outliner-page/delete! conn-a (:block/uuid (d/entity @conn-b :user.class/tag1)) {}) - (#'sync-apply/apply-remote-tx! test-repo nil @remote-tx) - (let [block (d/entity @conn-a [:block/uuid block-id])] - (is (some? block)) - (is (empty? (:block/refs block))) - (is (= "tag1" (:block/raw-title block))))))) - (finally - (d/unlisten! conn-b ::capture-ref-delete-rebase)))))) - -(deftest rebase-save-block-inline-tag-recreates-deleted-tag-with-same-ident-test - (testing "offline save-block with inline tag recreates deleted tag and preserves its db/ident during rebase" - (let [graph {:classes {:tag4 {}} - :pages-and-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "hello"}]}]} - conn-a (db-test/create-conn-with-blocks graph) - conn-b (d/conn-from-db @conn-a) - client-ops-conn (new-client-ops-db) - remote-tx (atom nil)] - (d/listen! conn-b ::capture-save-inline-tag-rebase - (fn [tx-report] - (when-not @remote-tx - (reset! remote-tx - (db-normalize/normalize-tx-data - (:db-after tx-report) - (:db-before tx-report) - (:tx-data tx-report)))))) - (try - (with-datascript-conns conn-a client-ops-conn - (fn [] - (let [block (db-test/find-block-by-content @conn-a "hello") - block-uuid (:block/uuid block) - tag (d/entity @conn-a :user.class/tag4) - tag-uuid (:block/uuid tag) - tag-ident (:db/ident tag) - tag-ref tag] - (outliner-core/save-block! conn-a - (assoc (into {} block) - :block/title "hello #tag4" - :block/refs #{tag-ref} - :block/tags #{tag-ref}) - {}) - (outliner-page/delete! conn-b (:block/uuid (d/entity @conn-b :user.class/tag4))) - (#'sync-apply/apply-remote-tx! test-repo nil @remote-tx) - (let [block' (d/entity @conn-a [:block/uuid block-uuid]) - recreated-tag (d/entity @conn-a [:block/uuid tag-uuid]) - ref-idents (set (keep :db/ident (:block/refs block'))) - tag-idents (set (keep :db/ident (:block/tags block'))) - validation (db-validate/validate-local-db! @conn-a)] - (is (some? block')) - (is (some? recreated-tag)) - (is (= tag-ident (:db/ident recreated-tag))) - (is (= "hello #tag4" - (:block/raw-title block'))) - (is (set/subset? #{tag-ident} ref-idents)) - (is (= #{tag-ident} tag-idents)) - (is (empty? (non-recycle-validation-entities validation)) - (str (:errors validation))))))) - (finally - (d/unlisten! conn-b ::capture-save-inline-tag-rebase)))))) - -(deftest rebase-save-block-inline-tag-keeps-surviving-and-recreates-deleted-with-same-ident-test - (testing "offline save-block with mixed inline tags keeps surviving refs and recreates deleted tag with same db/ident" - (let [graph {:classes {:tag1 {} - :tag2 {}} - :pages-and-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "hello"}]}]} - conn-a (db-test/create-conn-with-blocks graph) - conn-b (d/conn-from-db @conn-a) - client-ops-conn (new-client-ops-db) - remote-tx (atom nil)] - (d/listen! conn-b ::capture-save-inline-mixed-tag-rebase - (fn [tx-report] - (when-not @remote-tx - (reset! remote-tx - (db-normalize/normalize-tx-data - (:db-after tx-report) - (:db-before tx-report) - (:tx-data tx-report)))))) - (try - (with-datascript-conns conn-a client-ops-conn - (fn [] - (let [block (db-test/find-block-by-content @conn-a "hello") - block-uuid (:block/uuid block) - tag1-ref (d/entity @conn-a :user.class/tag1) - tag2-ref (d/entity @conn-a :user.class/tag2) - tag1-ident (:db/ident tag1-ref) - tag2-ident (:db/ident tag2-ref) - tag2-uuid (:block/uuid tag2-ref)] - (outliner-core/save-block! conn-a - (assoc (into {} block) - :block/title "hello #tag1 #tag2" - :block/refs #{tag1-ref tag2-ref} - :block/tags #{tag1-ref tag2-ref}) - {}) - (outliner-page/delete! conn-b (:block/uuid (d/entity @conn-b :user.class/tag2))) - (#'sync-apply/apply-remote-tx! test-repo nil @remote-tx) - (let [block' (d/entity @conn-a [:block/uuid block-uuid]) - recreated-tag2 (d/entity @conn-a [:block/uuid tag2-uuid]) - ref-idents (set (keep :db/ident (:block/refs block'))) - tag-idents (set (keep :db/ident (:block/tags block'))) - validation (db-validate/validate-local-db! @conn-a)] - (is (some? block')) - (is (some? recreated-tag2)) - (is (= tag2-ident (:db/ident recreated-tag2))) - (is (= "hello #tag1 #tag2" - (:block/raw-title block'))) - (is (set/subset? #{tag1-ident tag2-ident} ref-idents)) - (is (= #{tag1-ident tag2-ident} tag-idents)) - (is (empty? (non-recycle-validation-entities validation)) - (str (:errors validation))))))) - (finally - (d/unlisten! conn-b ::capture-save-inline-mixed-tag-rebase)))))) - -(deftest cut-paste-parent-with-child-keeps-child-parent-after-sync-test - (testing "remote tx can retract and recreate target uuid; child should point to recreated parent" - (let [conn (db-test/create-conn-with-blocks - {:pages-and-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "parent" - :build/children [{:block/title "child"}]} - {:block/title "target"}]}]}) - parent (db-test/find-block-by-content @conn "parent") - child (db-test/find-block-by-content @conn "child") - target (db-test/find-block-by-content @conn "target") - page-uuid (:block/uuid (:block/page parent)) - parent-uuid (:block/uuid parent) - child-uuid (:block/uuid child) - target-uuid (:block/uuid target) - target-order (:block/order target) - now 1760000000000] - (with-datascript-conns conn nil - (fn [] - (#'sync-apply/apply-remote-tx! - test-repo - nil - [[:db/retractEntity [:block/uuid parent-uuid]] - [:db/retractEntity [:block/uuid target-uuid]] - [:db/add -1 :block/uuid target-uuid] - [:db/add -1 :block/title "parent"] - [:db/add -1 :block/parent [:block/uuid page-uuid]] - [:db/add -1 :block/page [:block/uuid page-uuid]] - [:db/add -1 :block/order target-order] - [:db/add -1 :block/created-at now] - [:db/add -1 :block/updated-at now] - [:db/add [:block/uuid child-uuid] :block/parent [:block/uuid target-uuid]]]) - (let [parent' (d/entity @conn [:block/uuid target-uuid]) - child' (d/entity @conn [:block/uuid child-uuid])] - (is (= "parent" (:block/title parent'))) - (is (= (:db/id parent') (:db/id (:block/parent child')))))))))) - -(deftest fix-duplicate-orders-after-rebase-test - (testing "duplicate order updates are fixed after remote rebase" - (let [{:keys [conn client-ops-conn child1 child2]} (setup-parent-child) - order (:block/order (d/entity @conn (:db/id child1)))] - (with-datascript-conns conn client-ops-conn - (fn [] - (d/transact! conn [[:db/add (:db/id child1) :block/title "child 1 local"]]) - (#'sync-apply/apply-remote-tx! - test-repo - nil - [[:db/add (:db/id child1) :block/order order] - [:db/add (:db/id child2) :block/order order]]) - (let [child1' (d/entity @conn (:db/id child1)) - child2' (d/entity @conn (:db/id child2)) - orders [(:block/order child1') (:block/order child2')]] - (is (every? some? orders)) - (is (= (count orders) (count (distinct orders)))))))))) - -(deftest create-today-journal-does-not-rewrite-existing-journal-timestamps-test - (testing "create today journal skips timestamp rewrite when the journal page already exists" - (let [conn (db-test/create-conn) - client-ops-conn (new-client-ops-db) - title "Dec 16th, 2024"] - (with-datascript-conns conn client-ops-conn - (fn [] - (let [[_ page-uuid] (outliner-page/create! conn title {:today-journal? true}) - page (d/entity @conn [:block/uuid page-uuid]) - library-page (ldb/get-built-in-page @conn common-config/library-page-name)] - (d/transact! conn [[:db/add (:db/id page) :block/parent (:db/id library-page)]]) - (let [created-at-before (:block/created-at (d/entity @conn [:block/uuid page-uuid])) - updated-at-before (:block/updated-at (d/entity @conn [:block/uuid page-uuid]))] - (outliner-page/create! conn title {:today-journal? true}) - (let [page' (d/entity @conn [:block/uuid page-uuid])] - (is (= created-at-before (:block/created-at page'))) - (is (= updated-at-before (:block/updated-at page'))))))))))) - -(deftest temp-conn-batch-commit-ignores-transient-invalid-page-parent-test - (testing "temp conn batch validation should check the final page parent, not transient datoms" - (let [conn (db-test/create-conn-with-blocks - {:pages-and-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "temporary parent"}]}]}) - temporary-parent (db-test/find-block-by-content @conn "temporary parent") - page-tag (:db/id (d/entity @conn :logseq.class/Page)) - page-uuid (random-uuid) - now 1760000000000] - (ldb/batch-transact-with-temp-conn! - conn - {:rtc-tx? true} - (fn [temp-conn] - (ldb/transact! temp-conn - [{:db/id -1 - :block/uuid page-uuid - :block/title "Reused UUID Page" - :block/name "reused uuid page" - :block/tags page-tag - :block/parent (:db/id temporary-parent) - :block/created-at now - :block/updated-at now}]) - (ldb/transact! temp-conn - [[:db/retract [:block/uuid page-uuid] :block/parent (:db/id temporary-parent)]]))) - (let [entity (d/entity @conn [:block/uuid page-uuid])] - (is (= "reused uuid page" (:block/name entity))) - (is (nil? (:block/parent entity))) - (is (true? (ldb/page? entity))))))) - -(deftest fix-duplicate-order-against-existing-sibling-test - (testing "duplicate order update is fixed when it collides with an existing sibling" - (let [{:keys [conn client-ops-conn child1 child2]} (setup-parent-child) - child2-order (:block/order (d/entity @conn (:db/id child2)))] - (with-datascript-conns conn client-ops-conn - (fn [] - (d/transact! conn [[:db/add (:db/id child1) :block/title "child 1 local"]]) - (#'sync-apply/apply-remote-tx! - test-repo - nil - [[:db/add (:db/id child1) :block/order child2-order]]) - (let [child1' (d/entity @conn (:db/id child1)) - child2' (d/entity @conn (:db/id child2))] - (is (some? (:block/order child1'))) - (is (not= (:block/order child1') (:block/order child2'))))))))) - -(deftest apply-remote-txs-with-local-changes-rejects-invalid-final-rebase-test - (testing "invalid reverse/rebase batches are rejected without mutating the live db" - (let [{:keys [conn client-ops-conn parent child1]} (setup-parent-child) - tx-id (random-uuid) - child-id (:db/id child1) - child-uuid (:block/uuid child1) - parent-id (:db/id parent) - parent-title (:block/title parent) - original-title (:block/title child1) - original-created-at (:block/created-at child1) - original-order (:block/order child1)] - (with-datascript-conns - conn client-ops-conn - (fn [] - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id tx-id - :db-sync/pending? true - :db-sync/created-at (.now js/Date) - :db-sync/outliner-op :insert-blocks - :db-sync/forward-outliner-ops [] - :db-sync/inverse-outliner-ops [] - :db-sync/normalized-tx-data [] - :db-sync/reversed-tx-data - [[:db/retract child-id :block/title original-title] - [:db/retract child-id :block/created-at original-created-at] - [:db/retract child-id :block/order original-order]]}]) - (is (thrown? js/Error - (with-silenced-console-error - #(#'sync-apply/apply-remote-tx! - test-repo - nil - [[:db/add parent-id :block/title "remote parent"]])))) - (let [child1' (d/entity @conn [:block/uuid child-uuid]) - parent' (d/entity @conn parent-id)] - (is (= original-title (:block/title child1'))) - (is (= original-created-at (:block/created-at child1'))) - (is (= original-order (:block/order child1'))) - (is (= parent-title (:block/title parent'))))))))) - -(deftest two-clients-extends-cycle-test - (testing "class extends updates from two clients can retain the cycle edges" - (let [conn (db-test/create-conn) - client-ops-conn (new-client-ops-db) - root-id (d/entid @conn :logseq.class/Root) - tag-id (d/entid @conn :logseq.class/Tag) - now 1710000000000 - a-uuid (random-uuid) - b-uuid (random-uuid)] - (d/transact! conn [{:db/ident :user.class/A - :block/uuid a-uuid - :block/name "a" - :block/title "A" - :block/created-at now - :block/updated-at now - :block/tags #{tag-id} - :logseq.property.class/extends #{root-id}} - {:db/ident :user.class/B - :block/uuid b-uuid - :block/name "b" - :block/title "B" - :block/created-at now - :block/updated-at now - :block/tags #{tag-id} - :logseq.property.class/extends #{root-id}}]) - (with-datascript-conns conn client-ops-conn - (fn [] - (let [a-id (d/entid @conn :user.class/A) - b-id (d/entid @conn :user.class/B)] - (d/transact! conn [[:db/add a-id - :logseq.property.class/extends - b-id]]) - (#'sync-apply/apply-remote-tx! - test-repo - nil - [[:db/add b-id - :logseq.property.class/extends - a-id]]) - (let [a (d/entity @conn :user.class/A) - b (d/entity @conn :user.class/B) - extends-a (set (map :db/ident (:logseq.property.class/extends a))) - extends-b (set (map :db/ident (:logseq.property.class/extends b)))] - (is (contains? extends-a :user.class/B)) - (is (contains? extends-a :logseq.class/Root)) - (is (contains? extends-b :user.class/A))))))))) - -(deftest fix-duplicate-orders-with-local-and-remote-new-blocks-test - (testing "local and remote new sibling blocks at the same location get unique orders" - (let [{:keys [conn client-ops-conn parent]} (setup-parent-child) - parent-id (:db/id parent) - page-uuid (:block/uuid (:block/page parent)) - remote-uuid-1 (random-uuid) - remote-uuid-2 (random-uuid)] - (with-datascript-conns conn client-ops-conn - (fn [] - (outliner-core/insert-blocks! conn [{:block/title "local 1" - :block/uuid (random-uuid)} - {:block/title "local 2" - :block/uuid (random-uuid)}] - parent - {:sibling? true}) - (let [local1 (db-test/find-block-by-content @conn "local 1") - local2 (db-test/find-block-by-content @conn "local 2")] - (#'sync-apply/apply-remote-tx! - test-repo - nil - [[:db/add -1 :block/uuid remote-uuid-1] - [:db/add -1 :block/title "remote 1"] - [:db/add -1 :block/parent [:block/uuid page-uuid]] - [:db/add -1 :block/page [:block/uuid page-uuid]] - [:db/add -1 :block/order (:block/order local1)] - [:db/add -1 :block/updated-at 1768308019312] - [:db/add -1 :block/created-at 1768308019312] - [:db/add -2 :block/uuid remote-uuid-2] - [:db/add -2 :block/title "remote 2"] - [:db/add -2 :block/parent [:block/uuid page-uuid]] - [:db/add -2 :block/page [:block/uuid page-uuid]] - [:db/add -2 :block/order (:block/order local2)] - [:db/add -2 :block/updated-at 1768308019312] - [:db/add -2 :block/created-at 1768308019312]])) - (let [parent' (d/entity @conn parent-id) - children (vec (:block/_parent parent')) - orders (map :block/order children)] - (is (every? some? orders)) - (is (= (count orders) (count (distinct orders)))))))))) - -(deftest rebase-preserves-pending-tx-boundaries-test - (testing "pending txs stay separate after remote rebase" - (let [{:keys [conn client-ops-conn parent child1 child2]} (setup-parent-child)] - (with-redefs [db-sync/enqueue-local-tx! - (let [orig db-sync/enqueue-local-tx!] - (fn [repo tx-report] - (when-not (:rtc-tx? (:tx-meta tx-report)) - (orig repo tx-report))))] - (with-datascript-conns conn client-ops-conn - (fn [] - (d/transact! conn [[:db/add (:db/id child1) :block/title "child 1 local"]]) - (d/transact! conn [[:db/add (:db/id child2) :block/title "child 2 local"]]) - (let [pending-before (#'sync-apply/pending-txs test-repo) - tx-ids-before (mapv :tx-id pending-before)] - (is (= 2 (count pending-before))) - (#'sync-apply/apply-remote-tx! - test-repo - nil - [[:db/add (:db/id parent) :block/title "parent remote"]]) - (let [pending-after (#'sync-apply/pending-txs test-repo) - tx-ids-after (mapv :tx-id pending-after)] - (is (= 2 (count pending-after))) - (is (= tx-ids-before tx-ids-after)) - (is (= 2 (count (distinct tx-ids-after)))))))))))) - -(deftest remote-rebase-tx-is-not-enqueued-as-local-pending-test - (testing "remote rebase tx reports are applied as remote data, not new local pending txs" - (let [{:keys [conn client-ops-conn parent child1]} (setup-parent-child)] - (with-datascript-conns conn client-ops-conn - (fn [] - (d/transact! conn [[:db/add (:db/id child1) :block/title "child local"]]) - (let [pending-before (#'sync-apply/pending-txs test-repo) - tx-ids-before (mapv :tx-id pending-before)] - (is (= 1 (count pending-before))) - (#'sync-apply/apply-remote-txs! - test-repo - nil - [{:tx-data [[:db/add (:db/id parent) :block/title "remote rebase"]] - :outliner-op :rebase}]) - (let [pending-after (#'sync-apply/pending-txs test-repo) - tx-ids-after (mapv :tx-id pending-after)] - (is (= 1 (count pending-after))) - (is (= tx-ids-before tx-ids-after)) - (is (= :rebase (:outliner-op (first pending-after))))))))))) - -(deftest rebase-keeps-original-created-at-for-pending-tx-test - (testing "rebasing a pending tx should keep its original created-at ordering key" - (let [{:keys [conn client-ops-conn parent child1]} (setup-parent-child)] - (with-redefs [db-sync/enqueue-local-tx! - (let [orig db-sync/enqueue-local-tx!] - (fn [repo tx-report] - (when-not (:rtc-tx? (:tx-meta tx-report)) - (orig repo tx-report))))] - (with-datascript-conns conn client-ops-conn - (fn [] - (d/transact! conn [[:db/add (:db/id child1) :block/title "child 1 local"]]) - (let [{:keys [tx-id]} (first (#'sync-apply/pending-txs test-repo)) - created-at-before (some-> (client-op-tx-row client-ops-conn tx-id) - (aget "created_at"))] - (is (number? created-at-before)) - (loop [] - (when (<= (.now js/Date) created-at-before) - (recur))) - (#'sync-apply/apply-remote-tx! - test-repo - nil - [[:db/add (:db/id parent) :block/title "parent remote"]]) - (let [created-at-after (some-> (client-op-tx-row client-ops-conn tx-id) - (aget "created_at"))] - (is (= created-at-before created-at-after)))))))))) - -(deftest persist-local-tx-keeps-created-at-for-existing-tx-id-test - (testing "persisting an existing tx-id should preserve created-at ordering" - (let [{:keys [conn client-ops-conn child1]} (setup-parent-child) - tx-id (random-uuid) - child-id (:db/id child1)] - (with-datascript-conns conn client-ops-conn - (fn [] - (with-redefs [undo-redo/gen-undo-ops! (fn [& _] nil)] - (let [tx-report-1 (d/with @conn - [[:db/add child-id :block/title "created-at-v1"]] - (assoc local-tx-meta - :db-sync/tx-id tx-id - :outliner-op :save-block)) - {:keys [normalized-tx-data reversed-datoms]} - (#'sync-apply/normalize-rebased-pending-tx tx-report-1)] - (#'sync-apply/persist-local-tx! test-repo tx-report-1 normalized-tx-data reversed-datoms) - (let [created-at-before (some-> (client-op-tx-row client-ops-conn tx-id) - (aget "created_at"))] - (is (number? created-at-before)) - (loop [] - (when (<= (.now js/Date) created-at-before) - (recur))) - (let [tx-report-2 (d/with @conn - [[:db/add child-id :block/title "created-at-v2"]] - (assoc local-tx-meta - :db-sync/tx-id tx-id - :outliner-op :rebase)) - {:keys [normalized-tx-data reversed-datoms]} - (#'sync-apply/normalize-rebased-pending-tx tx-report-2)] - (#'sync-apply/persist-local-tx! test-repo tx-report-2 normalized-tx-data reversed-datoms) - (let [created-at-after (some-> (client-op-tx-row client-ops-conn tx-id) - (aget "created_at"))] - (is (= created-at-before created-at-after)))))))))))) - -(deftest rebase-keeps-pending-when-rebased-empty-test - (testing "rebased-empty pending txs can be dropped when raw tx replay produces no change" - (let [{:keys [conn client-ops-conn child1]} (setup-parent-child)] - (with-redefs [db-sync/enqueue-local-tx! - (let [orig db-sync/enqueue-local-tx!] - (fn [repo tx-report] - (when-not (:rtc-tx? (:tx-meta tx-report)) - (orig repo tx-report))))] - (with-datascript-conns conn client-ops-conn - (fn [] - (d/transact! conn [[:db/add (:db/id child1) :block/title "same"]]) - (let [pending-before (#'sync-apply/pending-txs test-repo)] - (is (= 1 (count pending-before))) - (#'sync-apply/apply-remote-tx! - test-repo - nil - [[:db/add (:db/id child1) :block/title "same"]]) - (let [pending-after (#'sync-apply/pending-txs test-repo)] - (is (empty? pending-after)))))))))) - -(deftest apply-remote-tx-collapsed-encrypted-title-update-test - (testing "decrypted tx that collapses old/new encrypted titles should keep title instead of retracting it" - (let [{:keys [conn client-ops-conn child1]} (setup-parent-child) - child-uuid (:block/uuid child1) - title (:block/title child1)] - (with-datascript-conns conn client-ops-conn - (fn [] - (#'sync-apply/apply-remote-tx! - test-repo - nil - [[:db/add [:block/uuid child-uuid] :block/title title] - [:db/retract [:block/uuid child-uuid] :block/title title]]) - (is (= title - (:block/title (d/entity @conn [:block/uuid child-uuid]))))))))) - -(deftest rebase-later-tx-for-new-block-uses-lookup-ref-test - (testing "rebased tx after creating a block should use lookup ref instead of stale tempid" - (let [{:keys [conn client-ops-conn parent]} (setup-parent-child)] - (with-redefs [db-sync/enqueue-local-tx! - (let [orig db-sync/enqueue-local-tx!] - (fn [repo tx-report] - (when-not (:rtc-tx? (:tx-meta tx-report)) - (orig repo tx-report))))] - (with-datascript-conns conn client-ops-conn - (fn [] - (outliner-core/insert-blocks! conn [{:block/title "temp for lookup"}] parent {:sibling? false}) - (let [block (db-test/find-block-by-content @conn "temp for lookup") - block-uuid (:block/uuid block)] - (outliner-core/save-block! conn {:block/uuid block-uuid - :block/title "temp for lookup updated"}) - (let [pending-before (#'sync-apply/pending-txs test-repo) - pending-count-before (count pending-before)] - (is (<= 2 pending-count-before)) - (#'sync-apply/apply-remote-tx! - test-repo - nil - [[:db/add (:db/id parent) :block/title "parent remote"]]) - (let [pending (#'sync-apply/pending-txs test-repo) - expected-row [:db/add [:block/uuid block-uuid] :block/title "temp for lookup updated"] - save-block-tx (some (fn [{:keys [tx]}] - (let [tx-rows (mapv (fn [[op e a v _t]] - [op e a v]) - tx)] - (when (some #(= expected-row %) tx-rows) - tx))) - pending)] - (is (some? save-block-tx)) - (is (not-any? string? - (keep second save-block-tx)))))))))))) - -(deftest rebase-drops-stale-raw-pending-tx-with-missing-history-ops-test - (testing "legacy rebase rows without history ops should fallback to transact replay and be dropped when stale" - (let [{:keys [conn client-ops-conn child1]} (setup-parent-child) - block-uuid (:block/uuid child1) - previous-title (:block/title child1) - tx-id (random-uuid)] - (with-datascript-conns conn client-ops-conn - (fn [] - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id tx-id - :db-sync/pending? true - :db-sync/created-at 1 - :db-sync/outliner-op :rebase - :db-sync/forward-outliner-ops nil - :db-sync/inverse-outliner-ops nil - :db-sync/normalized-tx-data - [[:db/add [:block/uuid block-uuid] - :block/title - "stale raw value"]] - :db-sync/reversed-tx-data - [[:db/add [:block/uuid block-uuid] - :block/title - previous-title]]}]) - (is (= 1 (count (#'sync-apply/pending-txs test-repo)))) - (#'sync-apply/apply-remote-txs! - test-repo - nil - [{:tx-data [[:db/retractEntity [:block/uuid block-uuid]]]}]) - (is (empty? (#'sync-apply/pending-txs test-repo)))))))) - -(deftest rebase-replays-title-only-raw-pending-tx-without-history-ops-test - (testing "metadata-less title-only raw pending tx is replayed from raw tx during rebase" - (let [{:keys [conn client-ops-conn child1 parent]} (setup-parent-child) - block-uuid (:block/uuid child1) - previous-title (:block/title child1) - parent-uuid (:block/uuid parent) - tx-id (random-uuid) - local-title "local raw title"] - (with-datascript-conns conn client-ops-conn - (fn [] - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id tx-id - :db-sync/pending? true - :db-sync/created-at 1 - :db-sync/outliner-op nil - :db-sync/forward-outliner-ops nil - :db-sync/inverse-outliner-ops nil - :db-sync/normalized-tx-data - [[:db/add [:block/uuid block-uuid] - :block/title - local-title]] - :db-sync/reversed-tx-data - [[:db/add [:block/uuid block-uuid] - :block/title - previous-title]]}]) - (#'sync-apply/apply-remote-txs! - test-repo - nil - [{:tx-data [[:db/add [:block/uuid parent-uuid] :block/title "parent remote"]]}]) - (let [pending (#'sync-apply/pending-txs test-repo)] - (is (= local-title (:block/title (d/entity @conn [:block/uuid block-uuid])))) - (is (= 1 (count pending))))))))) - -(deftest rebase-keeps-fix-pending-tx-with-empty-reversed-data-test - (testing "schema fix txs with no reverse data should not be replayed as local rebases" - (let [{:keys [conn client-ops-conn parent child1]} (setup-parent-child) - tx-id (random-uuid) - parent-uuid (:block/uuid parent) - child-uuid (:block/uuid child1) - fix-title "local fix title"] - (d/transact! conn [[:db/add [:block/uuid parent-uuid] :block/title fix-title]]) - (with-datascript-conns conn client-ops-conn - (fn [] - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id tx-id - :db-sync/pending? true - :db-sync/created-at 1 - :db-sync/outliner-op :fix - :db-sync/normalized-tx-data - [[:db/add [:block/uuid parent-uuid] :block/title fix-title]] - :db-sync/reversed-tx-data []}]) - (#'sync-apply/apply-remote-txs! - test-repo - nil - [{:tx-data [[:db/add [:block/uuid child-uuid] :block/title "remote child"]]}]) - (let [pending-after (#'sync-apply/pending-tx-by-id test-repo tx-id)] - (is (= fix-title - (:block/title (d/entity @conn [:block/uuid parent-uuid])))) - (is (= "remote child" - (:block/title (d/entity @conn [:block/uuid child-uuid])))) - (is (= :fix (:outliner-op pending-after))))))))) - -(deftest rebase-keeps-no-op-fix-pending-tx-with-empty-reversed-data-test - (testing "schema fix txs with no reverse data should stay upload-only even when remote already applied the same tx" - (let [{:keys [conn client-ops-conn parent]} (setup-parent-child) - tx-id (random-uuid) - parent-uuid (:block/uuid parent) - fix-title "remote already fixed"] - (with-datascript-conns conn client-ops-conn - (fn [] - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id tx-id - :db-sync/pending? true - :db-sync/created-at 1 - :db-sync/outliner-op :fix - :db-sync/normalized-tx-data - [[:db/add [:block/uuid parent-uuid] :block/title fix-title]] - :db-sync/reversed-tx-data []}]) - (#'sync-apply/apply-remote-txs! - test-repo - nil - [{:tx-data [[:db/add [:block/uuid parent-uuid] :block/title fix-title]]}]) - (is (= fix-title - (:block/title (d/entity @conn [:block/uuid parent-uuid])))) - (let [pending-after (#'sync-apply/pending-tx-by-id test-repo tx-id)] - (is (= :fix (:outliner-op pending-after))))))))) - -(deftest remote-log-uuid-string-scalar-values-stay-scalar-test - (testing "log-shaped remote history txs should only resolve UUID strings on ref attrs" - (let [{:keys [conn]} (setup-parent-child) - title-uuid #uuid "6a4970da-145c-430f-ba25-869617b87b1d" - title-uuid-str (str title-uuid) - class-temp-id "6a4970e3-275b-4d99-bc0e-04616f55afb9" - history-t 536872354] - (d/transact! conn [{:block/uuid title-uuid - :block/title "existing page with UUID title text" - :block/name "existing page with UUID title text"}]) - (let [title-entity-id (:db/id (d/entity @conn [:block/uuid title-uuid]))] - (is (= [:db/add class-temp-id :block/title title-uuid-str history-t] - (#'sync-apply/resolve-temp-id - @conn - [:db/add class-temp-id :block/title title-uuid-str history-t]))) - (is (= [:db/add class-temp-id :block/name title-uuid-str history-t] - (#'sync-apply/resolve-temp-id - @conn - [:db/add class-temp-id :block/name title-uuid-str history-t]))) - (is (= [:db/add class-temp-id :block/refs title-entity-id history-t] - (#'sync-apply/resolve-temp-id - @conn - [:db/add class-temp-id :block/refs title-uuid-str history-t]))))))) - -(deftest reverse-tx-data-create-property-text-block-restores-base-db-test - (testing "reverse-tx-data for create-property-text-block should restore the base db" - (let [conn (db-test/create-conn-with-blocks - [{:page {:block/title "page1"} - :blocks [{:block/title "b1" :build/properties {:default "foo"}} - {:block/title "b2"}]}]) - tx-reports* (atom [])] - (d/listen! conn ::capture-create-property-text-block - (fn [tx-report] - (swap! tx-reports* conj tx-report))) - (try - (let [base-db @conn - block-before (db-test/find-block-by-content base-db "b2")] - (outliner-property/create-property-text-block! conn (:db/id block-before) :user.property/default "" {}) - (let [db-after @conn - block-after (db-test/find-block-by-content db-after "b2") - value-block (:user.property/default block-after) - value-uuid (:block/uuid value-block) - reversed-rows (mapv (fn [{:keys [db-before db-after tx-data]}] - (#'sync-apply/reverse-tx-data db-before db-after tx-data)) - @tx-reports*) - restored-db (reduce (fn [db reversed] - (:db-after (d/with db reversed))) - db-after - (reverse reversed-rows)) - block-restored (db-test/find-block-by-content restored-db "b2")] - (is (= 1 (count @tx-reports*))) - (is (some seq reversed-rows)) - (is (nil? (:user.property/default block-restored))) - (is (= (select-keys block-before [:block/uuid :block/title :block/order]) - (select-keys block-restored [:block/uuid :block/title :block/order]))) - (is (nil? (d/entity restored-db [:block/uuid value-uuid]))))) - (finally - (d/unlisten! conn ::capture-create-property-text-block)))))) - -(deftest pending-reversed-txs-for-multiple-status-changes-restore-base-db-test - (testing "fresh persisted reversed tx rows from repeated status changes should restore the base db" - (let [conn (db-test/create-conn-with-blocks - {:pages-and-blocks - [{:page {:block/title "page1"} - :blocks [{:block/title "task" - :build/properties {:status "Todo"}}]}]}) - client-ops-conn (new-client-ops-db)] - (with-datascript-conns conn client-ops-conn - (fn [] - (let [base-db @conn - block-before (db-test/find-block-by-content base-db "task") - block-uuid (:block/uuid block-before) - base-status (some-> (:logseq.property/status block-before) :db/ident) - base-tags (set (map :db/ident (:block/tags block-before))) - base-history-count (count (d/q '[:find ?h - :in $ ?block - :where [?h :logseq.property.history/block ?block]] - base-db - (:db/id block-before)))] - (outliner-property/set-block-property! conn (:db/id block-before) :logseq.property/status "Doing") - (outliner-property/set-block-property! conn (:db/id block-before) :logseq.property/status "Todo") - (outliner-property/set-block-property! conn (:db/id block-before) :logseq.property/status "Doing") - (let [pending (#'sync-apply/pending-txs test-repo) - restored-db (reduce (fn [db {:keys [reversed-tx]}] - (:db-after (d/with db reversed-tx))) - @conn - (reverse pending)) - block-restored (d/entity restored-db [:block/uuid block-uuid]) - restored-history-count (count (d/q '[:find ?h - :in $ ?block - :where [?h :logseq.property.history/block ?block]] - restored-db - (:db/id block-restored)))] - (is (= 3 (count pending))) - (is (= base-status - (some-> (:logseq.property/status block-restored) :db/ident))) - (is (= base-tags - (set (map :db/ident (:block/tags block-restored))))) - (is (= base-history-count restored-history-count))))))))) - -(deftest pending-reversed-txs-for-batch-status-changes-restore-base-db-test - (testing "fresh persisted reversed tx rows from repeated batch status changes should restore the base db" - (let [conn (db-test/create-conn-with-blocks - {:pages-and-blocks - [{:page {:block/title "page1"} - :blocks [{:block/title "task" - :build/properties {:status "Todo"}}]}]}) - client-ops-conn (new-client-ops-db)] - (with-datascript-conns conn client-ops-conn - (fn [] - (let [base-db @conn - block-before (db-test/find-block-by-content base-db "task") - block-uuid (:block/uuid block-before) - status-doing (:db/id (d/entity base-db :logseq.property/status.doing)) - status-todo (:db/id (d/entity base-db :logseq.property/status.todo)) - base-status (some-> (:logseq.property/status block-before) :db/ident) - base-tags (set (map :db/ident (:block/tags block-before))) - base-history-count (count (d/q '[:find ?h - :in $ ?block - :where [?h :logseq.property.history/block ?block]] - base-db - (:db/id block-before)))] - (outliner-property/batch-set-property! conn [(:db/id block-before)] :logseq.property/status status-doing {:entity-id? true}) - (outliner-property/batch-set-property! conn [(:db/id block-before)] :logseq.property/status status-todo {:entity-id? true}) - (outliner-property/batch-set-property! conn [(:db/id block-before)] :logseq.property/status status-doing {:entity-id? true}) - (let [pending (#'sync-apply/pending-txs test-repo) - restored-db (reduce (fn [db {:keys [reversed-tx]}] - (:db-after (d/with db reversed-tx))) - @conn - (reverse pending)) - block-restored (d/entity restored-db [:block/uuid block-uuid]) - restored-history-count (count (d/q '[:find ?h - :in $ ?block - :where [?h :logseq.property.history/block ?block]] - restored-db - (:db/id block-restored)))] - (is (= 3 (count pending))) - (is (= base-status - (some-> (:logseq.property/status block-restored) :db/ident))) - (is (= base-tags - (set (map :db/ident (:block/tags block-restored))))) - (is (= base-history-count restored-history-count))))))))) - -(deftest normalize-rebased-pending-tx-keeps-reconstructive-reverse-for-retract-entity-test - (testing "rebased pending tx should keep non-empty reverse datoms even when forward tx collapses to retractEntity" - (let [conn (db-test/create-conn-with-blocks - {:pages-and-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "target"}]}]}) - target (db-test/find-block-by-content @conn "target") - target-uuid (:block/uuid target) - db-before @conn - tx-report (d/with db-before - [[:db/retractEntity [:block/uuid target-uuid]]] - {}) - {:keys [normalized-tx-data reversed-datoms]} - (#'sync-apply/normalize-rebased-pending-tx - {:db-before db-before - :db-after (:db-after tx-report) - :tx-data (:tx-data tx-report) - :remote-tx-data-set #{}}) - restored-db (:db-after (d/with (:db-after tx-report) reversed-datoms))] - (is (= [[:db/retractEntity [:block/uuid target-uuid]]] - normalized-tx-data)) - (is (seq reversed-datoms)) - (is (= target-uuid - (-> (d/entity restored-db [:block/uuid target-uuid]) :block/uuid)))))) - -(deftest reverse-tx-data-delete-and-recreate-same-uuid-remains-reversible-test - (testing "reverse tx-data should remain valid when a tx retracts and recreates the same block uuid" - (let [conn (db-test/create-conn-with-blocks - {:pages-and-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "old"}]}]}) - target (db-test/find-block-by-content @conn "old") - target-uuid (:block/uuid target) - page-uuid (:block/uuid (:block/page target)) - original-order (:block/order target) - db-before @conn - tx-report (d/with db-before - [[:db/retractEntity [:block/uuid target-uuid]] - [:db/add -1 :block/uuid target-uuid] - [:db/add -1 :block/title "new"] - [:db/add -1 :block/parent [:block/uuid page-uuid]] - [:db/add -1 :block/page [:block/uuid page-uuid]] - [:db/add -1 :block/order original-order]] - {}) - reversed-datoms (#'sync-apply/reverse-tx-data - db-before - (:db-after tx-report) - (:tx-data tx-report)) - reverse-conn (d/conn-from-db (:db-after tx-report))] - (is (some? (d/entity (:db-after tx-report) [:block/uuid target-uuid]))) - (ldb/transact! reverse-conn reversed-datoms {:outliner-op :reverse-test}) - (let [restored (d/entity @reverse-conn [:block/uuid target-uuid])] - (is (some? restored)) - (is (= "old" (:block/title restored))) - (is (= page-uuid (some-> restored :block/page :block/uuid))) - (is (= page-uuid (some-> restored :block/parent :block/uuid))))))) - -(deftest rebase-preserves-title-when-reversed-tx-ids-change-test - (testing "rebase keeps local title when reverse tx gets a new tx id" - (let [conn (db-test/create-conn-with-blocks - {:pages-and-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "old"}]}]}) - client-ops-conn (new-client-ops-db) - block (db-test/find-block-by-content @conn "old")] - (with-redefs [db-sync/enqueue-local-tx! - (let [orig db-sync/enqueue-local-tx!] - (fn [repo tx-report] - (when-not (:rtc-tx? (:tx-meta tx-report)) - (orig repo tx-report))))] - (with-datascript-conns conn client-ops-conn - (fn [] - (apply-ops! conn - [[:save-block [{:block/uuid (:block/uuid block) - :block/title "test"} nil]]] - local-tx-meta) - (is (= 1 (count (#'sync-apply/pending-txs test-repo)))) - (#'sync-apply/apply-remote-tx! - test-repo - nil - [[:db/add (:db/id block) :block/updated-at 1710000000000]]) - (let [block' (d/entity @conn (:db/id block))] - (is (= "test" (:block/title block')))))))))) - -(deftest sync-conflict-store-roundtrip-test - (testing "sync title conflicts are stored outside graph data and returned by block uuid" - (let [client-ops-conn (new-client-ops-db) - block-uuid (random-uuid)] - (with-datascript-conns (db-test/create-conn-with-blocks - {:pages-and-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "target"}]}]}) - client-ops-conn - (fn [] - (client-op/add-sync-conflicts! - test-repo - [{:block-uuid block-uuid - :attr :block/title - :value "remote title" - :remote-t 42}]) - (is (= [{:block-uuid block-uuid - :attr :block/title - :value "remote title" - :remote-t 42}] - (mapv #(select-keys % [:block-uuid :attr :value :remote-t]) - (client-op/get-sync-conflicts test-repo block-uuid))))))))) - -(deftest sync-title-conflict-store-keeps-only-latest-non-empty-value-test - (testing "newer title conflicts replace previous title conflicts for the block" - (let [client-ops-conn (new-client-ops-db) - block-uuid (random-uuid)] - (with-datascript-conns (db-test/create-conn-with-blocks - {:pages-and-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "target"}]}]}) - client-ops-conn - (fn [] - (client-op/add-sync-conflicts! - test-repo - [{:block-uuid block-uuid - :attr :block/title - :value "first remote title" - :remote-t 42} - {:block-uuid block-uuid - :attr :block/title - :value "" - :remote-t 43} - {:block-uuid block-uuid - :attr :block/title - :value "latest remote title" - :remote-t 44}]) - (is (= [{:block-uuid block-uuid - :attr :block/title - :value "latest remote title" - :remote-t 44}] - (mapv #(select-keys % [:block-uuid :attr :value :remote-t]) - (client-op/get-sync-conflicts test-repo block-uuid)))) - (client-op/add-sync-conflicts! - test-repo - [{:block-uuid block-uuid - :attr :block/title - :value "" - :remote-t 45}]) - (is (empty? (client-op/get-sync-conflicts test-repo block-uuid)))))))) - -(deftest sync-conflict-clear-test - (testing "resolved sync conflicts are removed for the block" - (let [client-ops-conn (new-client-ops-db) - block-uuid (random-uuid) - other-block-uuid (random-uuid)] - (with-datascript-conns (db-test/create-conn-with-blocks - {:pages-and-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "target"}]}]}) - client-ops-conn - (fn [] - (client-op/add-sync-conflicts! - test-repo - [{:block-uuid block-uuid - :attr :block/title - :value "remote title" - :remote-t 42} - {:block-uuid other-block-uuid - :attr :block/title - :value "other remote title" - :remote-t 43}]) - (client-op/clear-sync-conflicts! test-repo block-uuid) - (is (empty? (client-op/get-sync-conflicts test-repo block-uuid))) - (is (= ["other remote title"] - (mapv :value (client-op/get-sync-conflicts test-repo other-block-uuid))))))))) - -(deftest rebase-saves-remote-title-and-name-conflicts-test - (testing "remote title/name changes that conflict with pending local edits are saved for manual resolution" - (let [conn (db-test/create-conn-with-blocks - {:pages-and-blocks - [{:page {:block/title "old page"} - :blocks [{:block/title "old block"}]}]}) - client-ops-conn (new-client-ops-db) - page (db-test/find-page-by-title @conn "old page") - block (db-test/find-block-by-content @conn "old block") - page-uuid (:block/uuid page) - block-uuid (:block/uuid block)] - (with-datascript-conns conn client-ops-conn - (fn [] - (apply-ops! conn - [[:save-block [{:block/uuid block-uuid - :block/title "local block"} nil]] - [:save-block [{:block/uuid page-uuid - :block/title "local page"} nil]]] - local-tx-meta) - (is (seq (#'sync-apply/pending-txs test-repo))) - (#'sync-apply/apply-remote-txs! - test-repo - nil - [{:t 10 - :tx-data [[:db/add [:block/uuid block-uuid] :block/title "remote block"] - [:db/add [:block/uuid page-uuid] :block/title "remote page"]]}]) - (is (= "local block" (:block/title (d/entity @conn [:block/uuid block-uuid])))) - (is (= "local page" (:block/title (d/entity @conn [:block/uuid page-uuid])))) - (is (= #{{:block-uuid (str block-uuid) - :attr "block/title" - :value "remote block"} - {:block-uuid (str page-uuid) - :attr "block/title" - :value "remote page"}} - (set (concat (sync-conflict-rows client-ops-conn block-uuid) - (sync-conflict-rows client-ops-conn page-uuid)))))))))) - -(deftest rebase-does-not-leave-anonymous-created-by-entities-test - (testing "rebase should not leave entities with timestamps/created-by but without identity attrs" - (let [{:keys [conn client-ops-conn parent child1]} (setup-parent-child) - child-id (:db/id child1) - page-id (:db/id (:block/page parent))] - (with-redefs [db-sync/enqueue-local-tx! - (let [orig db-sync/enqueue-local-tx!] - (fn [repo tx-report] - (when-not (:rtc-tx? (:tx-meta tx-report)) - (orig repo tx-report))))] - (with-datascript-conns conn client-ops-conn - (fn [] - ;; Ensure the deleted block has the same created-by shape from production repros. - (d/transact! conn [[:db/add child-id :logseq.property/created-by-ref page-id]]) - (outliner-core/delete-blocks! conn [(d/entity @conn child-id)] {}) - (is (seq (#'sync-apply/pending-txs test-repo))) - (#'sync-apply/apply-remote-tx! - test-repo - nil - [[:db/add (:db/id parent) :block/title "parent remote"]]) - (let [anonymous-ents (->> (d/datoms @conn :avet :logseq.property/created-by-ref) - (keep (fn [datom] - (let [ent (d/entity @conn (:e datom))] - (when (and (nil? (:block/uuid ent)) - (nil? (:db/ident ent)) - (some? (:block/created-at ent)) - (some? (:block/updated-at ent))) - (select-keys ent [:db/id :block/created-at :block/updated-at :logseq.property/created-by-ref])))))) - validation (db-validate/validate-local-db! @conn)] - (is (empty? anonymous-ents) (str anonymous-ents)) - (is (empty? (non-recycle-validation-entities validation)) - (str (:errors validation)))))))))) - -(deftest rebase-create-then-delete-does-not-leave-anonymous-entities-test - (testing "create+delete before sync should not leave anonymous entities after rebase" - (let [{:keys [conn client-ops-conn parent]} (setup-parent-child) - page-id (:db/id (:block/page parent))] - (with-redefs [db-sync/enqueue-local-tx! - (let [orig db-sync/enqueue-local-tx!] - (fn [repo tx-report] - (when-not (:rtc-tx? (:tx-meta tx-report)) - (orig repo tx-report))))] - (with-datascript-conns conn client-ops-conn - (fn [] - (outliner-core/insert-blocks! conn [{:block/title "temp-rebase-case"}] parent {:sibling? false}) - (let [temp-block (db-test/find-block-by-content @conn "temp-rebase-case") - temp-id (:db/id temp-block)] - (d/transact! conn [[:db/add temp-id :logseq.property/created-by-ref page-id]]) - (outliner-core/delete-blocks! conn [temp-block] {}) - (is (>= (count (#'sync-apply/pending-txs test-repo)) 2)) - (#'sync-apply/apply-remote-tx! - test-repo - nil - [[:db/add (:db/id parent) :block/title "parent remote 2"]]) - (let [anonymous-ents (->> (d/datoms @conn :avet :block/created-at) - (keep (fn [datom] - (let [ent (d/entity @conn (:e datom))] - (when (and (nil? (:block/uuid ent)) - (nil? (:db/ident ent)) - (some? (:block/updated-at ent))) - (select-keys ent [:db/id :block/created-at :block/updated-at :logseq.property/created-by-ref])))))) - validation (db-validate/validate-local-db! @conn)] - (is (empty? anonymous-ents) (str anonymous-ents)) - (is (empty? (non-recycle-validation-entities validation)) - (str (:errors validation))))))))))) - -(deftest apply-remote-txs-delete-parent-with-child-without-local-changes-test - (testing "remote delete-blocks tx should retract descendant children on client" - (let [conn (db-test/create-conn-with-blocks - {:pages-and-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "parent" - :build/children [{:block/title "child"}]}]}]}) - parent (db-test/find-block-by-content @conn "parent") - child (db-test/find-block-by-content @conn "child") - parent-uuid (:block/uuid parent) - child-uuid (:block/uuid child)] - (with-datascript-conns conn nil - (fn [] - (#'sync-apply/apply-remote-txs! - test-repo - nil - [{:tx-data [[:db/retractEntity [:block/uuid parent-uuid]]]}]) - (is (nil? (d/entity @conn [:block/uuid parent-uuid]))) - (is (nil? (d/entity @conn [:block/uuid child-uuid]))) - (let [validation (db-validate/validate-local-db! @conn)] - (is (empty? (non-recycle-validation-entities validation)) - (str (:errors validation))))))))) - -(deftest delete-expansion-includes-generated-property-value-children-test - (testing "physical delete expansion includes generated property value children" - (let [property-value-uuid (random-uuid) - conn (db-test/create-conn-with-blocks - {:properties {:user.property/delete-expansion {:logseq.property/type :default}} - :pages-and-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "parent" - :build/properties - {:user.property/delete-expansion - {:build/property-value :block - :block/title "property value" - :block/uuid property-value-uuid - :build/keep-uuid? true - :build/children [{:block/title "nested property child"}]}}}]}]}) - parent (db-test/find-block-by-content @conn "parent") - property-value (d/entity @conn [:block/uuid property-value-uuid]) - nested-child (db-test/find-block-by-content @conn "nested property child") - root-retract [:db/retractEntity (:db/id parent)] - generic-expanded (delete-blocks/expand-delete-blocks-tx - @conn [root-retract] {:outliner-op :delete-blocks}) - sync-expanded (#'sync-apply/expand-block-retracts-to-descendants - @conn [root-retract]) - property-value-retract [:db/retractEntity (:db/id property-value)] - nested-child-retract [:db/retractEntity (:db/id nested-child)] - sync-retracted-ids (->> sync-expanded - (keep (fn [[op ref]] - (when (= :db/retractEntity op) - (:db/id (d/entity @conn ref))))) - set)] - (is (some? (:logseq.property/created-from-property property-value))) - (is (empty? (:block/_parent parent))) - (is (= [(:db/id property-value)] - (mapv :db/id (:block/_raw-parent parent)))) - (is (some #{property-value-retract} generic-expanded)) - (is (some #{nested-child-retract} generic-expanded)) - (is (contains? sync-retracted-ids (:db/id property-value))) - (is (contains? sync-retracted-ids (:db/id nested-child)))))) - -(deftest apply-remote-txs-computes-remote-deletes-once-per-batch-test - (testing "a large remote batch keeps delete filtering without repeatedly rescanning the pull" - (let [{:keys [conn parent child2]} (setup-parent-child) - parent-id (:db/id parent) - child2-uuid (:block/uuid child2) - delete-set-computations (atom 0) - original-delete-set-fn (deref (var sync-apply/remote-txs-retract-entity-block-uuid-suffixes)) - remote-txs (conj (mapv (fn [index] - {:tx-data [[:db/add parent-id - :block/title - (str "remote title " index)]]}) - (range 128)) - {:tx-data [[:db/retractEntity [:block/uuid child2-uuid]]]})] - (with-redefs [sync-apply/remote-txs-retract-entity-block-uuid-suffixes - (fn [txs] - (swap! delete-set-computations inc) - (original-delete-set-fn txs))] - (with-datascript-conns conn nil - (fn [] - (#'sync-apply/apply-remote-txs! test-repo nil remote-txs) - (is (= 1 @delete-set-computations)) - (is (= "remote title 127" - (:block/title (d/entity @conn parent-id)))) - (is (nil? (d/entity @conn [:block/uuid child2-uuid]))))))))) - -(deftest apply-remote-txs-skips-block-ref-filters-when-txs-have-no-block-uuid-refs-test - (testing "plain remote title updates avoid block-ref filters" - (let [{:keys [conn parent]} (setup-parent-child) - parent-id (:db/id parent) - stale-deleted-ref-filter-computations (atom 0) - missing-ref-filter-computations (atom 0) - original-stale-deleted-ref-filter-fn (deref (var sync-apply/drop-stale-deleted-block-ref-ops)) - original-missing-ref-filter-fn (deref (var sync-apply/drop-missing-block-ref-ops)) - remote-txs (mapv (fn [index] - {:tx-data [[:db/add parent-id - :block/title - (str "remote title " index)]]}) - (range 128))] - (with-redefs [sync-apply/drop-stale-deleted-block-ref-ops - (fn [db deleted-block-uuids tx-data] - (swap! stale-deleted-ref-filter-computations inc) - (original-stale-deleted-ref-filter-fn db deleted-block-uuids tx-data)) - sync-apply/drop-missing-block-ref-ops - (fn [db tx-data] - (swap! missing-ref-filter-computations inc) - (original-missing-ref-filter-fn db tx-data))] - (with-datascript-conns conn nil - (fn [] - (#'sync-apply/apply-remote-txs! test-repo nil remote-txs) - (is (zero? @stale-deleted-ref-filter-computations)) - (is (zero? @missing-ref-filter-computations)) - (is (= "remote title 127" - (:block/title (d/entity @conn parent-id)))))))))) - -(deftest apply-remote-txs-keeps-refs-to-block-recreated-after-earlier-delete-test - (testing "a later remote tx can recreate a block uuid deleted earlier in the same batch" - (let [{:keys [conn parent child2]} (setup-parent-child) - child2-uuid (:block/uuid child2) - parent-uuid (:block/uuid parent) - page-uuid (:block/uuid (:block/page parent)) - recreated-child-uuid (random-uuid) - now (.now js/Date)] - (with-datascript-conns conn nil - (fn [] - (#'sync-apply/apply-remote-txs! - test-repo - nil - [{:tx-data [[:db/retractEntity [:block/uuid child2-uuid]]]} - {:tx-data [[:db/add -1 :block/uuid child2-uuid] - [:db/add -1 :block/title "child 2 recreated"] - [:db/add -1 :block/parent [:block/uuid parent-uuid]] - [:db/add -1 :block/page [:block/uuid page-uuid]] - [:db/add -1 :block/order "b2"] - [:db/add -1 :block/created-at now] - [:db/add -1 :block/updated-at now] - [:db/add -2 :block/uuid recreated-child-uuid] - [:db/add -2 :block/title "child 2 descendant"] - [:db/add -2 :block/parent [:block/uuid child2-uuid]] - [:db/add -2 :block/page [:block/uuid page-uuid]] - [:db/add -2 :block/order "b2a"] - [:db/add -2 :block/created-at now] - [:db/add -2 :block/updated-at now]]}]) - (let [recreated-child2 (d/entity @conn [:block/uuid child2-uuid]) - descendant (d/entity @conn [:block/uuid recreated-child-uuid])] - (is (= "child 2 recreated" (:block/title recreated-child2))) - (is (= "child 2 descendant" (:block/title descendant))) - (is (= child2-uuid (:block/uuid (:block/parent descendant)))))))))) - -(deftest apply-remote-txs-local-fallback-delete-parent-retracts-remote-child-test - (testing "rebasing a fallback local retractEntity deletes remote children inserted while the local tx was reversed" - (async done - (let [conn (db-test/create-conn-with-blocks - {:pages-and-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "parent"}]}]}) - client-ops-conn (new-client-ops-db) - parent (db-test/find-block-by-content @conn "parent") - parent-uuid (:block/uuid parent) - page-uuid (:block/uuid (:block/page parent)) - child-uuid (random-uuid) - now (.now js/Date) - remote-tx {:tx-data [[:db/add -1 :block/uuid child-uuid] - [:db/add -1 :block/title "remote child"] - [:db/add -1 :block/parent [:block/uuid parent-uuid]] - [:db/add -1 :block/page [:block/uuid page-uuid]] - [:db/add -1 :block/order "Zz"] - [:db/add -1 :block/created-at now] - [:db/add -1 :block/updated-at now]]}] - (-> (with-datascript-conns - conn client-ops-conn - (fn [] - (ldb/transact! conn - [[:db/retractEntity [:block/uuid parent-uuid]]] - {:local-tx? true - :outliner-op :batch-remove-property}) - (is (= 1 (count (#'sync-apply/pending-txs test-repo)))) - (p/let [_ (#'sync-apply/apply-remote-txs! - test-repo - (test-sync-client) - [remote-tx]) - _ (p/delay remote-apply-test-settle-ms)] - (is (nil? (d/entity @conn [:block/uuid parent-uuid]))) - (is (nil? (d/entity @conn [:block/uuid child-uuid]))) - (let [validation (db-validate/validate-local-db! @conn)] - (is (empty? (non-recycle-validation-entities validation)) - (str (:errors validation))))))) - (.catch (fn [error] - (is false (str error)))) - (.finally done)))))) - -(deftest apply-remote-txs-rechecks-local-txs-when-local-delete-races-temp-snapshot-test - (testing "remote apply uses a consistent pending-tx and DB snapshot when a local delete races the temp snapshot" - (async done - (let [{:keys [conn client-ops-conn child1 child2]} (setup-parent-child) - child1-uuid (:block/uuid child1) - child2-id (:db/id child2) - order-before (:block/order child1) - original-batch-transact-with-temp-conn! ldb/batch-transact-with-temp-conn! - injected-delete? (atom false)] - (-> (with-datascript-conns - conn client-ops-conn - (fn [] - (d/transact! conn [[:db/add child2-id :block/title "unrelated local edit"]]) - (is (= 1 (count (#'sync-apply/pending-txs test-repo)))) - (let [result (with-redefs [ldb/batch-transact-with-temp-conn! - (fn [conn' tx-meta batch-tx-fn & opts] - (when (and (:with-local-changes? tx-meta) - (not @injected-delete?)) - (reset! injected-delete? true) - (outliner-core/delete-blocks! - conn - [(d/entity @conn [:block/uuid child1-uuid])] - {})) - (apply original-batch-transact-with-temp-conn! - conn' tx-meta batch-tx-fn opts))] - (#'sync-apply/apply-remote-txs! - test-repo - (test-sync-client) - [{:tx-data [[:db/retract [:block/uuid child1-uuid] :block/order order-before] - [:db/add [:block/uuid child1-uuid] :block/order "a1"]]}]))] - (p/let [_ result - _ (p/delay remote-apply-test-settle-ms)] - (is @injected-delete?) - (is (nil? (d/entity @conn [:block/uuid child1-uuid]))) - (let [validation (db-validate/validate-local-db! @conn)] - (is (empty? (non-recycle-validation-entities validation)) - (str (:errors validation)))))))) - (.catch (fn [error] - (is false (str error)))) - (.finally done)))))) - -(deftest apply-remote-txs-rechecks-local-txs-when-local-delete-races-temp-commit-test - (testing "remote apply does not commit a temp result over local txs added after its pending snapshot" - (async done - (let [{:keys [conn client-ops-conn child1 child2]} (setup-parent-child) - child1-uuid (:block/uuid child1) - child2-id (:db/id child2) - order-before (:block/order child1) - original-batch-transact-with-temp-conn! ldb/batch-transact-with-temp-conn! - injected-delete? (atom false)] - (-> (with-datascript-conns - conn client-ops-conn - (fn [] - (d/transact! conn [[:db/add child2-id :block/title "unrelated local edit"]]) - (is (= 1 (count (#'sync-apply/pending-txs test-repo)))) - (js/Promise.resolve - (p/with-redefs [ldb/batch-transact-with-temp-conn! - (fn [conn' tx-meta batch-tx-fn & opts] - (let [opts-map (if (and (= 1 (count opts)) - (map? (first opts))) - (first opts) - (apply hash-map opts)) - before-commit (:before-commit opts-map) - opts-map' (assoc opts-map - :before-commit - (fn [] - (when (and (:with-local-changes? tx-meta) - (not @injected-delete?)) - (reset! injected-delete? true) - (outliner-core/delete-blocks! - conn - [(d/entity @conn [:block/uuid child1-uuid])] - {})) - (when before-commit - (before-commit))))] - (apply original-batch-transact-with-temp-conn! - conn' tx-meta batch-tx-fn [opts-map'])))] - (p/let [_ (#'sync-apply/apply-remote-txs! - test-repo - (test-sync-client) - [{:tx-data [[:db/retract [:block/uuid child1-uuid] :block/order order-before] - [:db/add [:block/uuid child1-uuid] :block/order "b2"]]}]) - _ (p/delay remote-apply-test-settle-ms)] - (is @injected-delete?) - (is (nil? (d/entity @conn [:block/uuid child1-uuid]))) - (let [validation (db-validate/validate-local-db! @conn)] - (is (empty? (non-recycle-validation-entities validation)) - (str (:errors validation))))))))) - (.catch (fn [error] - (is false (str error)))) - (.finally done)))))) - -(deftest apply-remote-txs-rechecks-local-txs-when-local-edit-races-without-local-batch-test - (testing "remote apply without initial local changes must not batch a racing local tx into the remote checksum" - (async done - (let [{:keys [conn client-ops-conn parent child1]} (setup-parent-child) - child1-uuid (:block/uuid child1) - local-child-uuid (random-uuid) - original-batch-transact! ldb/batch-transact! - original-batch-transact-with-temp-conn! ldb/batch-transact-with-temp-conn! - injected-edit? (atom false) - inject-local-edit! (fn [] - (when-not @injected-edit? - (reset! injected-edit? true) - (outliner-core/insert-blocks! - conn - [{:block/uuid local-child-uuid - :block/title "concurrent local child"}] - parent - {:sibling? false - :bottom? true - :keep-uuid? true})))] - (-> (with-datascript-conns - conn client-ops-conn - (fn [] - (client-op/update-local-checksum test-repo (sync-checksum/recompute-checksum @conn)) - (db-listener/listen-db-changes! test-repo conn :handler-keys [:checksum-test]) - (js/Promise.resolve - (p/with-redefs [ldb/batch-transact! - (fn [conn' tx-meta batch-tx-fn & opts] - (if (:without-local-changes? tx-meta) - (let [db-before @conn' - *tx-data (atom [])] - (d/listen! conn' ::without-local-batch-race - (fn [{:keys [tx-data]}] - (swap! *tx-data into tx-data))) - (try - (inject-local-edit!) - (swap! conn' assoc :skip-store? true :batch-tx? true) - (batch-tx-fn conn') - (d/unlisten! conn' ::without-local-batch-race) - (swap! conn' dissoc :skip-store? :batch-tx?) - (let [tx-report {:db-before db-before - :db-after @conn' - :tx-meta (assoc tx-meta :batch-final-tx-report? true) - :tx-data @*tx-data}] - (dc/run-callbacks conn' tx-report) - tx-report) - (catch :default error - (reset! conn' db-before) - (throw error)) - (finally - (d/unlisten! conn' ::without-local-batch-race) - (swap! conn' dissoc :skip-store? :batch-tx?) - (reset! *tx-data nil)))) - (apply original-batch-transact! conn' tx-meta batch-tx-fn opts))) - ldb/batch-transact-with-temp-conn! - (fn [conn' tx-meta batch-tx-fn & opts] - (apply original-batch-transact-with-temp-conn! - conn' - tx-meta - (fn [temp-conn & batch-args] - (when (:without-local-changes? tx-meta) - (inject-local-edit!)) - (apply batch-tx-fn temp-conn batch-args)) - opts))] - (p/let [_ (#'sync-apply/apply-remote-txs! - test-repo - (test-sync-client) - [{:tx-data [[:db/add [:block/uuid child1-uuid] - :block/title - "remote edit after local race"]]}]) - _ (p/delay remote-apply-test-settle-ms)] - (is @injected-edit?) - (is (= "remote edit after local race" - (:block/title (d/entity @conn [:block/uuid child1-uuid])))) - (is (= (sync-checksum/recompute-checksum @conn) - (client-op/get-local-checksum test-repo)))))))) - (.catch (fn [error] - (is false (str error)))) - (.finally (fn [] - (d/unlisten! conn :frontend.worker.db-listener/listen-db-changes!) - (done)))))))) - -(deftest apply-remote-txs-delays-retry-when-local-txs-keep-changing-test - (testing "remote apply waits for a stable pending-tx snapshot instead of reporting failure" - (async done - (let [{:keys [conn client-ops-conn child1 child2]} (setup-parent-child) - child1-uuid (:block/uuid child1) - child2-id (:db/id child2) - order-before (:block/order child1) - original-batch-transact-with-temp-conn! ldb/batch-transact-with-temp-conn! - drift-count (atom 0)] - (-> (with-datascript-conns - conn client-ops-conn - (fn [] - (d/transact! conn [[:db/add child2-id :block/title "unrelated local edit"]]) - (is (= 1 (count (#'sync-apply/pending-txs test-repo)))) - (js/Promise.resolve - (p/with-redefs [ldb/batch-transact-with-temp-conn! - (fn [conn' tx-meta batch-tx-fn & opts] - (let [opts-map (if (and (= 1 (count opts)) - (map? (first opts))) - (first opts) - (apply hash-map opts)) - before-commit (:before-commit opts-map) - opts-map' (assoc opts-map - :before-commit - (fn [] - (when (and (:with-local-changes? tx-meta) - (< @drift-count 4)) - (swap! drift-count inc) - (d/transact! - conn - [[:db/add child2-id :block/title - (str "drift " @drift-count)]])) - (when before-commit - (before-commit))))] - (apply original-batch-transact-with-temp-conn! - conn' tx-meta batch-tx-fn [opts-map'])))] - (p/let [_ (#'sync-apply/apply-remote-txs! - test-repo - (test-sync-client) - [{:tx-data [[:db/retract [:block/uuid child1-uuid] :block/order order-before] - [:db/add [:block/uuid child1-uuid] :block/order "a1"]]}]) - _ (p/delay remote-apply-test-settle-ms)] - (is (= 4 @drift-count)) - (is (= "a1" - (:block/order (d/entity @conn [:block/uuid child1-uuid])))) - (is (= 5 (count (#'sync-apply/pending-txs test-repo)))) - (let [validation (db-validate/validate-local-db! @conn)] - (is (empty? (non-recycle-validation-entities validation)) - (str (:errors validation))))))))) - (.catch (fn [error] - (is false (str error)))) - (.finally done)))))) - -(deftest apply-remote-txs-retries-snapshot-drift-even-if-pending-list-stabilizes-test - (testing "a before-commit drift signal should retry even if the pending queue changes again before catch" - (async done - (let [{:keys [conn client-ops-conn child1 child2]} (setup-parent-child) - child1-uuid (:block/uuid child1) - child2-id (:db/id child2) - original-batch-transact-with-temp-conn! ldb/batch-transact-with-temp-conn! - injected-and-acked? (atom false)] - (-> (with-datascript-conns - conn client-ops-conn - (fn [] - (d/transact! conn [[:db/add child2-id :block/title "unrelated local edit"]]) - (is (= 1 (count (#'sync-apply/pending-txs test-repo)))) - (js/Promise.resolve - (p/with-redefs [ldb/batch-transact-with-temp-conn! - (fn [conn' tx-meta batch-tx-fn & opts] - (let [opts-map (if (and (= 1 (count opts)) - (map? (first opts))) - (first opts) - (apply hash-map opts)) - before-commit (:before-commit opts-map) - opts-map' (assoc opts-map - :before-commit - (fn [] - (if (and (:with-local-changes? tx-meta) - (not @injected-and-acked?)) - (do - (reset! injected-and-acked? true) - (d/transact! - conn - [[:db/add child2-id :block/title - "concurrent already acked edit"]]) - (let [concurrent-tx-id (:tx-id (last (#'sync-apply/pending-txs test-repo)))] - (try - (when before-commit - (before-commit)) - (catch :default error - (#'sync-apply/mark-pending-txs-false! - test-repo - [concurrent-tx-id]) - (throw error))))) - (when before-commit - (before-commit)))))] - (apply original-batch-transact-with-temp-conn! - conn' tx-meta batch-tx-fn [opts-map'])))] - (p/let [_ (#'sync-apply/apply-remote-txs! - test-repo - (test-sync-client) - [{:tx-data [[:db/add [:block/uuid child1-uuid] - :block/title - "remote title after stable retry"]]}]) - _ (p/delay remote-apply-test-settle-ms)] - (is @injected-and-acked?) - (is (= "remote title after stable retry" - (:block/title (d/entity @conn [:block/uuid child1-uuid])))) - (is (= 1 (count (#'sync-apply/pending-txs test-repo)))) - (let [validation (db-validate/validate-local-db! @conn)] - (is (empty? (non-recycle-validation-entities validation)) - (str (:errors validation))))))))) - (.catch (fn [error] - (is false (str error)))) - (.finally done)))))) - -(deftest rebase-persisted-row-contains-forward-and-inverse-outliner-ops-test - (testing "rebased pending tx should always persist both forward and inverse outliner ops" - (let [{:keys [conn client-ops-conn parent child1]} (setup-parent-child) - tx-id-holder (atom nil)] - (with-datascript-conns conn client-ops-conn - (fn [] - (outliner-core/delete-blocks! conn [child1] {}) - (let [pending-before (first (#'sync-apply/pending-txs test-repo)) - tx-id (:tx-id pending-before)] - (reset! tx-id-holder tx-id) - (is (seq (:forward-outliner-ops pending-before))) - (is (seq (:inverse-outliner-ops pending-before)))) - - (#'sync-apply/apply-remote-tx! - test-repo - nil - [[:db/add (:db/id parent) :block/title "parent remote"]]) - - (let [pending-after (#'sync-apply/pending-tx-by-id test-repo @tx-id-holder)] - (is (some? pending-after)) - (is (= :rebase (:outliner-op pending-after))) - (is (seq (:forward-outliner-ops pending-after))) - (is (seq (:inverse-outliner-ops pending-after))))))))) - -(deftest apply-remote-txs-rebases-create-delete-page-as-recycled-test - (testing "local create-page then delete-page should stay recycled after remote rebase" - (let [conn (db-test/create-conn-with-blocks - {:pages-and-blocks - [{:page {:block/title "remote page"}}]}) - client-ops-conn (new-client-ops-db) - page-uuid (random-uuid) - remote-page (ldb/get-page @conn "remote page")] - (with-datascript-conns conn client-ops-conn - (fn [] - (outliner-page/create! conn "local recycled page" {:uuid page-uuid}) - (outliner-page/delete! conn page-uuid {}) - (is (true? (ldb/recycled? (d/entity @conn [:block/uuid page-uuid])))) - (is (= 2 (count (#'sync-apply/pending-txs test-repo)))) - - (#'sync-apply/apply-remote-tx! - test-repo - nil - [[:db/add (:db/id remote-page) :block/title "remote page updated"]]) - - (let [page (d/entity @conn [:block/uuid page-uuid])] - (is (some? page)) - (is (true? (ldb/recycled? page))) - (is (some? (:block/parent page))) - (is (some? (:logseq.property/deleted-at page))) - (is (= (:db/id page) - (:db/id (:logseq.property.recycle/original-page page)))))))))) - -(deftest legacy-rebase-row-with-missing-history-ops-gets-persisted-with-both-ops-test - (testing "legacy pending :rebase rows can persist with empty forward/inverse history ops" - (let [{:keys [conn client-ops-conn parent]} (setup-parent-child) - tx-id (random-uuid) - parent-uuid (:block/uuid parent) - parent-title (:block/title parent) - remote-title "parent remote refresh"] - (with-datascript-conns conn client-ops-conn - (fn [] - (seed-client-op-txs! - test-repo - [{:db-sync/tx-id tx-id - :db-sync/pending? true - :db-sync/created-at 1000 - :db-sync/outliner-op :rebase - :db-sync/normalized-tx-data - [[:db/add [:block/uuid parent-uuid] :block/title "legacy local title"]] - :db-sync/reversed-tx-data - [[:db/add [:block/uuid parent-uuid] :block/title parent-title]]}]) - (#'sync-apply/apply-remote-tx! - test-repo - nil - [[:db/add [:block/uuid parent-uuid] :block/title remote-title]]) - (let [pending-after (#'sync-apply/pending-tx-by-id test-repo tx-id)] - (is (some? pending-after)) - (is (= :rebase (:outliner-op pending-after))) - (is (vector? (:forward-outliner-ops pending-after))) - (is (vector? (:inverse-outliner-ops pending-after))))))))) - -(deftest offload-large-title-test - (testing "large titles are offloaded to object storage with placeholder" - (async done - (let [large-title (apply str (repeat 5000 "a")) - tx-data [[:db/add 1 :block/title large-title]] - upload-calls (atom []) - upload-fn (fn [_repo _graph-id title _aes-key] - (swap! upload-calls conj title) - (p/resolved {:asset-uuid "title-1" - :asset-type "txt"}))] - (-> (p/let [result (sync-large-title/offload-large-titles - tx-data - {:repo test-repo - :graph-id "graph-1" - :upload-fn upload-fn - :aes-key nil})] - (is (= [large-title] @upload-calls)) - (is (= [[:db/add 1 :block/title ""] - [:db/add 1 :logseq.property.sync/large-title-object - {:asset-uuid "title-1" - :asset-type "txt"}]] - result))) - (p/catch (fn [e] - (is false (str e)))) - (p/finally done)))))) - -(deftest offload-small-title-test - (testing "small titles are not offloaded" - (async done - (let [tx-data [[:db/add 1 :block/title "short"]] - upload-fn (fn [_repo _graph-id _title _aes-key] - (p/rejected (ex-info "unexpected upload" {})))] - (-> (p/let [result (sync-large-title/offload-large-titles - tx-data - {:repo test-repo - :graph-id "graph-1" - :upload-fn upload-fn - :aes-key nil})] - (is (= tx-data result))) - (p/catch (fn [e] - (is false (str e)))) - (p/finally done)))))) - -(deftest offload-large-title-preserves-map-form-tx-items-test - (testing "map-form tx items from built-in repair should not crash upload preparation" - (async done - (let [tx-data [{:db/ident :logseq.class/Comments - :block/uuid #uuid "00000002-2556-9161-5000-000000000000" - :block/title "Comments"} - [:db/add [:block/uuid #uuid "00000002-2556-9161-5000-000000000000"] - :block/title "Comments"]] - upload-fn (fn [_repo _graph-id _title _aes-key] - (p/rejected (ex-info "unexpected upload" {})))] - (-> (p/let [result (sync-large-title/offload-large-titles - tx-data - {:repo test-repo - :graph-id "graph-1" - :upload-fn upload-fn - :aes-key nil})] - (is (= tx-data result))) - (p/catch (fn [e] - (is false (str e)))) - (p/finally done)))))) - -(deftest offload-large-title-datoms-drops-stale-object-for-same-entity-test - (testing "snapshot upload should not keep an old large-title object when offloading the same entity title" - (async done - (let [large-title (apply str (repeat 5000 "a")) - old-obj {:asset-uuid "old-title" :asset-type "txt"} - other-obj {:asset-uuid "other-title" :asset-type "txt"} - new-obj {:asset-uuid "new-title" :asset-type "txt"} - datoms [{:e 1 :a :block/title :v large-title} - {:e 1 :a :logseq.property.sync/large-title-object :v old-obj} - {:e 2 :a :logseq.property.sync/large-title-object :v other-obj}] - upload-calls (atom []) - upload-fn (fn [_repo _graph-id title _aes-key] - (swap! upload-calls conj title) - (p/resolved new-obj))] - (-> (p/let [result (sync-large-title/offload-large-titles-in-datoms-batch - test-repo "graph-1" datoms nil upload-fn)] - (is (= [large-title] @upload-calls)) - (is (= [{:e 1 :a :block/title :v ""} - {:e 1 :a :logseq.property.sync/large-title-object :v new-obj} - {:e 2 :a :logseq.property.sync/large-title-object :v other-obj}] - result))) - (p/catch (fn [e] - (is false (str e)))) - (p/finally done)))))) - -(deftest offload-large-title-datoms-drops-stale-object-from-known-offload-set-test - (testing "snapshot upload drops stale large-title objects even when title and object are in different batches" - (async done - (let [old-obj {:asset-uuid "old-title" :asset-type "txt"} - other-obj {:asset-uuid "other-title" :asset-type "txt"} - datoms [{:e 1 :a :logseq.property.sync/large-title-object :v old-obj} - {:e 2 :a :logseq.property.sync/large-title-object :v other-obj}] - upload-fn (fn [_repo _graph-id _title _aes-key] - (p/rejected (ex-info "unexpected upload" {})))] - (-> (p/let [result (sync-large-title/offload-large-titles-in-datoms-batch - test-repo "graph-1" datoms nil upload-fn #{1})] - (is (= [{:e 2 :a :logseq.property.sync/large-title-object :v other-obj}] - result))) - (p/catch (fn [e] - (is false (str e)))) - (p/finally done)))))) - -(deftest upload-preparation-processes-datoms-in-batches-test - (testing "upload preparation should stream work batch by batch instead of sending the full graph at once" - (async done - (let [datoms [{:e 1 :a :block/title :v "a"} - {:e 2 :a :block/title :v "b"} - {:e 3 :a :block/title :v "c"} - {:e 4 :a :block/title :v "d"} - {:e 5 :a :block/title :v "e"}] - seen-batches (atom []) - progress-calls (atom [])] - (-> (p/let [_ (sync-large-title/process-upload-datoms-in-batches! - datoms - {:batch-size 2 - :process-batch-f (fn [batch] - (swap! seen-batches conj (mapv :e batch)) - (p/resolved nil)) - :progress-f (fn [processed total] - (swap! progress-calls conj [processed total]))})] - (is (= [[1 2] [3 4] [5]] @seen-batches)) - (is (= [[2 5] [4 5] [5 5]] @progress-calls))) - (p/finally done)))))) - -(deftest create-temp-sqlite-db-uses-opfs-pool-test - (testing "temp upload db should use an OPFS-backed sqlite db instead of :memory:" - (async done - (let [sqlite-prev @worker-state/*sqlite - platform-prev (try - (platform/current) - (catch :default _ nil)) - sqlite #js {:sqlite? true} - pool #js {:pool? true} - opened-opts (atom []) - installed-pools (atom []) - test-platform {:env {:runtime :node - :owner-source :test} - :storage {:install-opfs-pool (fn [sqlite* pool-name] - (swap! installed-pools conj {:sqlite sqlite* - :pool-name pool-name}) - pool) - :resolve-db-path (fn [repo _pool suffix] - (str "/tmp/" repo suffix)) - :remove-vfs! (fn [_pool] nil)} - :kv {:get (fn [_] nil) - :set! (fn [_ _] nil)} - :broadcast {:post-message! (fn [_ _] nil)} - :websocket {:connect (fn [_] nil)} - :crypto {} - :timers {} - :sqlite {:init! (fn [] nil) - :open-db (fn [opts] - (swap! opened-opts conj opts) - #js {:close (fn [] nil) - :exec (fn [& _] nil)})}}] - (platform/set-platform! test-platform) - (reset! worker-state/*sqlite sqlite) - (-> (p/let [{:keys [db path]} (sync-temp-sqlite/ (p/let [aes-key (crypt/ (p/let [aes-key (crypt/ obj-datoms first :v)] - (is (= 1 (count obj-datoms))) - (is (true? (sync-large-title/large-title-object? obj)))) - (let [items (->> tx-data - (keep (fn [item] - (when (and (vector? item) - (= :db/add (nth item 0)) - (= :logseq.property.sync/large-title-object (nth item 2)) - (true? (sync-large-title/large-title-object? (nth item 3)))) - {:e (nth item 1) - :obj (nth item 3)}))) - (distinct))] - (is (= 1 (count items)))) - (-> (p/let [result (sync-large-title/rehydrate-large-titles! - test-repo - {:tx-data tx-data - :conn conn - :graph-id "graph-1" - :download-fn download-fn - :aes-key nil - :get-conn-f worker-state/get-datascript-conn - :graph-e2ee?-f sync-crypt/graph-e2ee? - :ensure-graph-aes-key-f sync-crypt/ (p/let [_ (sync-large-title/rehydrate-large-titles! - test-repo - {:tx-data tx-data - :conn conn - :graph-id "graph-1" - :download-fn download-fn - :aes-key nil - :get-conn-f worker-state/get-datascript-conn - :graph-e2ee?-f sync-crypt/graph-e2ee? - :ensure-graph-aes-key-f sync-crypt/ (sync-large-title/rehydrate-large-titles-from-db! - test-repo - "graph-1" - {:get-conn-f worker-state/get-datascript-conn - :rehydrate-large-titles!-f (fn [repo opts] - (swap! calls conj [repo opts]) - (p/resolved nil))}) - (p/then (fn [_] - (is (= [[test-repo - {:tx-data [[:db/add - 100 - :logseq.property.sync/large-title-object - obj]] - :graph-id "graph-1"}]] - @calls)) - (done))) - (p/catch (fn [e] - (is false (str e)) - (done))))))))) - -(defn- apply-template-to-empty-target! - [conn template-root-uuid empty-target-uuid] - (let [template-root (d/entity @conn [:block/uuid template-root-uuid]) - empty-target (d/entity @conn [:block/uuid empty-target-uuid]) - template-blocks (->> (ldb/get-block-and-children @conn template-root-uuid - {:include-property-block? true}) - rest) - blocks-to-insert (cons (assoc (first template-blocks) - :logseq.property/used-template (:db/id template-root)) - (rest template-blocks))] - (apply-ops! - conn - [[:apply-template [(:db/id template-root) - (:db/id empty-target) - {:sibling? true - :replace-empty-target? true - :template-blocks blocks-to-insert}]]] - local-tx-meta))) - -(defn- apply-template-with-opts! - [conn template-root-uuid target-uuid opts] - (let [template-root (d/entity @conn [:block/uuid template-root-uuid]) - target (d/entity @conn [:block/uuid target-uuid]) - template-blocks (->> (ldb/get-block-and-children @conn template-root-uuid - {:include-property-block? true}) - rest) - blocks-to-insert (cons (assoc (first template-blocks) - :logseq.property/used-template (:db/id template-root)) - (rest template-blocks))] - (apply-ops! - conn - [[:apply-template [(:db/id template-root) - (:db/id target) - (merge {:sibling? true - :template-blocks blocks-to-insert} - opts)]]] - local-tx-meta))) - -(defn- undo-all! - [repo] - (loop [n 0] - (let [result (undo-redo/undo repo)] - (when-not (= :frontend.worker.undo-redo/empty-undo-stack result) - (when (> n 128) - (throw (ex-info "undo loop exceeded" {:count n}))) - (recur (inc n)))))) - -(defn- redo-all! - [repo] - (loop [n 0] - (let [result (undo-redo/redo repo)] - (when-not (= :frontend.worker.undo-redo/empty-redo-stack result) - (when (> n 128) - (throw (ex-info "redo loop exceeded" {:count n}))) - (recur (inc n)))))) - -(defn- select-offline-inserted-three - [conn template-root-uuid] - (let [all-three-ids (d/q '[:find [?b ...] - :in $ ?title - :where - [?b :block/title ?title]] - @conn - "3") - all-threes (mapv #(d/entity @conn %) all-three-ids)] - (or (some (fn [b] - (when (not= template-root-uuid - (some-> b :block/parent :block/uuid)) - b)) - all-threes) - (first all-threes)))) - -(defn- select-offline-inserted-one - [conn template-root-uuid] - (let [all-one-ids (d/q '[:find [?b ...] - :in $ ?title - :where - [?b :block/title ?title]] - @conn - "1") - all-ones (mapv #(d/entity @conn %) all-one-ids)] - (or (some (fn [b] - (when (not= template-root-uuid - (some-> b :block/parent :block/uuid)) - b)) - all-ones) - (first all-ones)))) - -(defn- setup-rebase-apply-template-repro-state - [] - (let [template-root-uuid (random-uuid) - template-1-uuid (random-uuid) - template-2-uuid (random-uuid) - template-3-uuid (random-uuid) - empty-target-uuid (random-uuid) - local-empty-uuid (random-uuid) - seed-conn (db-test/create-conn-with-blocks - {:pages-and-blocks - [{:page {:block/title "page 1"} - :blocks [{:block/title "seed"}]}]}) - seed-page (db-test/find-page-by-title @seed-conn "page 1") - page-id (:db/id seed-page) - client-ops-conn (new-client-ops-db)] - (apply-ops! - seed-conn - [[:insert-blocks [[{:block/uuid template-root-uuid - :block/title "template 1" - :block/tags #{:logseq.class/Template}} - {:block/uuid template-1-uuid - :block/title "1" - :block/parent [:block/uuid template-root-uuid]} - {:block/uuid template-2-uuid - :block/title "2" - :block/parent [:block/uuid template-1-uuid]} - {:block/uuid template-3-uuid - :block/title "3" - :block/parent [:block/uuid template-root-uuid]}] - page-id - {:sibling? false - :keep-uuid? true}]] - [:insert-blocks [[{:block/uuid empty-target-uuid - :block/title ""}] - page-id - {:sibling? false - :keep-uuid? true}]]] - local-tx-meta) - {:template-root-uuid template-root-uuid - :template-1-uuid template-1-uuid - :template-2-uuid template-2-uuid - :template-3-uuid template-3-uuid - :empty-target-uuid empty-target-uuid - :local-empty-uuid local-empty-uuid - :seed-conn seed-conn - :client-ops-conn client-ops-conn})) - -(deftest rebase-apply-template-preserves-followup-insert-target-uuid-test - (testing "rebase should replay apply-template with stable UUIDs so follow-up insert-blocks is not dropped" - (let [{:keys [template-root-uuid empty-target-uuid local-empty-uuid seed-conn client-ops-conn]} - (setup-rebase-apply-template-repro-state) - conn-a (d/conn-from-db @seed-conn) - conn-b (d/conn-from-db @seed-conn) - remote-txs (atom [])] - (d/listen! conn-b ::capture-rebase-apply-template - (fn [tx-report] - (swap! remote-txs conj - {:tx-data (db-normalize/normalize-tx-data - (:db-after tx-report) - (:db-before tx-report) - (:tx-data tx-report)) - :outliner-op (get-in tx-report [:tx-meta :outliner-op])}))) - (try - (apply-template-to-empty-target! conn-b template-root-uuid empty-target-uuid) - (with-datascript-conns conn-a client-ops-conn - (fn [] - (apply-template-to-empty-target! conn-a template-root-uuid empty-target-uuid) - (let [inserted-three (select-offline-inserted-three conn-a template-root-uuid)] - (is (some? inserted-three)) - (outliner-core/insert-blocks! conn-a [{:block/uuid local-empty-uuid :block/title ""}] - inserted-three - {:sibling? true :keep-uuid? true}) - (outliner-core/delete-blocks! conn-a [inserted-three] {}) - (let [pending-before (#'sync-apply/pending-txs test-repo) - insert-tx-id (some->> pending-before - (filter #(= :insert-blocks (:outliner-op %))) - last - :tx-id) - error (try - (#'sync-apply/apply-remote-txs! test-repo nil @remote-txs) - nil - (catch :default e - e)) - insert-pending-after (#'sync-apply/pending-tx-by-id test-repo insert-tx-id) - local-empty-block (d/entity @conn-a [:block/uuid local-empty-uuid])] - (is (uuid? insert-tx-id)) - (is (seq @remote-txs)) - (is (nil? error) (some-> error ex-message)) - (is (some? insert-pending-after)) - (is (= :rebase (:outliner-op insert-pending-after))) - (is (some? local-empty-block)) - (let [validation (db-validate/validate-local-db! @conn-a)] - (is (empty? (non-recycle-validation-entities validation)) - (str (:errors validation)))))))) - (finally - (d/unlisten! conn-b ::capture-rebase-apply-template)))))) - -(deftest apply-history-action-redo-after-apply-template-undo-all-preserves-followup-insert-test - (testing "apply-template then insert-blocks should replay on redo after both are undone" - (let [{:keys [template-root-uuid empty-target-uuid seed-conn client-ops-conn]} - (setup-rebase-apply-template-repro-state) - conn (d/conn-from-db @seed-conn) - followup-uuid (random-uuid) - prev-apply-action @undo-redo/*apply-history-action!] - (with-datascript-conns conn client-ops-conn - (fn [] - (reset! undo-redo/*apply-history-action! sync-apply/apply-history-action!) - (try - (apply-template-to-empty-target! conn template-root-uuid empty-target-uuid) - (let [inserted-three (select-offline-inserted-three conn template-root-uuid)] - (is (some? inserted-three)) - (apply-ops! conn - [[:insert-blocks [[{:block/uuid followup-uuid - :block/title "followup"}] - (:db/id inserted-three) - {:sibling? true - :keep-uuid? true}]]] - local-tx-meta) - (undo-all! test-repo) - (is (nil? (d/entity @conn [:block/uuid followup-uuid]))) - (redo-all! test-repo) - (let [followup (d/entity @conn [:block/uuid followup-uuid])] - (is (some? followup)) - (is (= "followup" (:block/title followup))))) - (finally - (reset! undo-redo/*apply-history-action! prev-apply-action)))))))) - -(deftest apply-history-action-redo-after-non-empty-template-insert-preserves-followup-insert-test - (testing "non-empty apply-template + insert-blocks should replay on redo after undo-all" - (let [{:keys [template-root-uuid empty-target-uuid seed-conn client-ops-conn]} - (setup-rebase-apply-template-repro-state) - conn (d/conn-from-db @seed-conn) - followup-uuid (random-uuid) - prev-apply-action @undo-redo/*apply-history-action!] - (with-datascript-conns conn client-ops-conn - (fn [] - (reset! undo-redo/*apply-history-action! sync-apply/apply-history-action!) - (try - (d/transact! conn [[:db/add [:block/uuid empty-target-uuid] :block/title "target"]]) - (apply-template-with-opts! conn template-root-uuid empty-target-uuid {}) - (let [inserted-three (select-offline-inserted-three conn template-root-uuid)] - (is (some? inserted-three)) - (apply-ops! conn - [[:insert-blocks [[{:block/uuid followup-uuid - :block/title "followup"}] - (:db/id inserted-three) - {:sibling? true - :keep-uuid? true}]]] - local-tx-meta) - (undo-all! test-repo) - (is (nil? (d/entity @conn [:block/uuid followup-uuid]))) - (redo-all! test-repo) - (let [followup (d/entity @conn [:block/uuid followup-uuid])] - (is (some? followup)) - (is (= "followup" (:block/title followup))))) - (finally - (reset! undo-redo/*apply-history-action! prev-apply-action)))))))) - -(deftest undo-redo-apply-template-without-template-blocks-keeps-followup-insert-target-test - (testing "redo after apply-template (without template-blocks in original op) should preserve inserted target uuid" - (let [{:keys [template-root-uuid empty-target-uuid seed-conn client-ops-conn]} - (setup-rebase-apply-template-repro-state) - conn (d/conn-from-db @seed-conn) - followup-uuid (random-uuid) - prev-apply-action @undo-redo/*apply-history-action!] - (with-datascript-conns conn client-ops-conn - (fn [] - (reset! undo-redo/*apply-history-action! sync-apply/apply-history-action!) - (try - ;; Match editor path: apply-template op only carries target/template ids + opts. - (d/transact! conn [[:db/add [:block/uuid empty-target-uuid] :block/title "target"]]) - (apply-ops! conn - [[:apply-template [(:db/id (d/entity @conn [:block/uuid template-root-uuid])) - (:db/id (d/entity @conn [:block/uuid empty-target-uuid])) - {:sibling? true}]]] - local-tx-meta) - (let [inserted-three (select-offline-inserted-three conn template-root-uuid)] - (is (some? inserted-three)) - (apply-ops! conn - [[:insert-blocks [[{:block/uuid followup-uuid - :block/title "followup"}] - (:db/id inserted-three) - {:sibling? true - :keep-uuid? true}]]] - local-tx-meta) - (undo-all! test-repo) - (is (nil? (d/entity @conn [:block/uuid followup-uuid]))) - (redo-all! test-repo) - (let [followup (d/entity @conn [:block/uuid followup-uuid])] - (is (some? followup)) - (is (= "followup" (:block/title followup))))) - (finally - (reset! undo-redo/*apply-history-action! prev-apply-action)))))))) - -(deftest undo-redo-apply-template-without-template-blocks-rewrites-property-value-refs-test - (testing "redo apply-template should not keep property value refs to template source blocks" - (let [{:keys [template-root-uuid template-1-uuid template-3-uuid empty-target-uuid seed-conn client-ops-conn]} - (setup-rebase-apply-template-repro-state) - conn (d/conn-from-db @seed-conn) - prev-apply-action @undo-redo/*apply-history-action!] - (with-datascript-conns conn client-ops-conn - (fn [] - (reset! undo-redo/*apply-history-action! sync-apply/apply-history-action!) - (try - (d/transact! conn [[:db/add [:block/uuid template-1-uuid] :user.property/p1 [:block/uuid template-3-uuid]] - [:db/add [:block/uuid empty-target-uuid] :block/title "target"]]) - (apply-ops! conn - [[:apply-template [(:db/id (d/entity @conn [:block/uuid template-root-uuid])) - (:db/id (d/entity @conn [:block/uuid empty-target-uuid])) - {:sibling? true}]]] - local-tx-meta) - (let [inserted-one (select-offline-inserted-one conn template-root-uuid) - inserted-three (select-offline-inserted-three conn template-root-uuid) - property-value (:user.property/p1 inserted-one) - initial-ref-uuid (cond - (map? property-value) - (:block/uuid property-value) - - (and (vector? property-value) - (= :block/uuid (first property-value))) - (second property-value) - - :else - property-value)] - (is (= (:block/uuid inserted-three) initial-ref-uuid)) - (is (not= template-3-uuid initial-ref-uuid))) - (undo-all! test-repo) - (redo-all! test-repo) - (let [inserted-one (select-offline-inserted-one conn template-root-uuid) - inserted-three (select-offline-inserted-three conn template-root-uuid) - property-value (:user.property/p1 inserted-one) - redone-ref-uuid (cond - (map? property-value) - (:block/uuid property-value) - - (and (vector? property-value) - (= :block/uuid (first property-value))) - (second property-value) - - :else - property-value)] - (is (= (:block/uuid inserted-three) redone-ref-uuid)) - (is (not= template-3-uuid redone-ref-uuid))) - (finally - (reset! undo-redo/*apply-history-action! prev-apply-action)))))))) diff --git a/src/test/frontend/worker/db_worker_node_test.cljs b/src/test/frontend/worker/db_worker_node_test.cljs index bf4d15f..cbc06c9 100644 --- a/src/test/frontend/worker/db_worker_node_test.cljs +++ b/src/test/frontend/worker/db_worker_node_test.cljs @@ -930,14 +930,9 @@ (let [repo-error #'db-worker-node/repo-error bound-repo "logseq_db_bound"] (is (nil? (repo-error :thread-api/list-db [] bound-repo))) - (is (nil? (repo-error :thread-api/get-db-sync-config [] bound-repo))) (is (nil? (repo-error :thread-api/sync-app-state [{:auth/id-token "token"}] bound-repo))) - (is (nil? (repo-error :thread-api/db-sync-list-remote-graphs [] bound-repo))) (is (nil? (repo-error "thread-api/list-db" [] bound-repo))) (is (nil? (repo-error :thread-api/set-context [{:repo "not-a-repo-arg"}] bound-repo))) - (is (nil? (repo-error :thread-api/resolve-ui-request ["req-id" {:password "pw"}] bound-repo))) - (is (nil? (repo-error :thread-api/reject-ui-request ["req-id" {:code :cancelled}] bound-repo))) - (is (nil? (repo-error :thread-api/cancel-ui-requests [{:context :logout}] bound-repo))) (is (= {:status 400 :error {:code :missing-repo :message "repo is required"}} @@ -963,13 +958,8 @@ (start-daemon! {:root-dir data-dir :repo repo}) _ (reset! daemon {:host host :port port :stop! stop!}) - _ (invoke host port "thread-api/set-db-sync-config" - [{:ws-url "wss://example.com/sync/%s"}]) _ (invoke host port "thread-api/sync-app-state" [{:auth/id-token "token-value"}]) - config (invoke host port "thread-api/get-db-sync-config" []) - _ (is (= "wss://example.com/sync/%s" (:ws-url config))) - _ (is (not (contains? config :auth-token))) result (invoke host port "thread-api/set-context" [{:app "desktop"}])] (is (nil? result))) (p/catch (fn [e] @@ -1003,64 +993,6 @@ (-> (stop!) (p/finally (fn [] (done)))) (done)))))))) -(deftest db-worker-node-sync-status-requires-repo-and-returns-structured-status - (async done - (let [daemon (atom nil) - data-dir (node-helper/create-tmp-dir "db-worker-sync-status") - repo (str "logseq_db_sync_status_" (subs (str (random-uuid)) 0 8))] - (-> (p/let [{:keys [host port stop!]} - (start-daemon! {:root-dir data-dir - :repo repo}) - _ (reset! daemon {:host host :port port :stop! stop!}) - {:keys [status body]} (invoke-raw host port "thread-api/db-sync-status" []) - parsed (js->clj (js/JSON.parse body) :keywordize-keys true) - _ (is (= 400 status)) - _ (is (= false (:ok parsed))) - _ (is (= "missing-repo" (get-in parsed [:error :code]))) - _ (invoke host port "thread-api/create-or-open-db" [repo {}]) - status-result (invoke host port "thread-api/db-sync-status" [repo])] - (is (= repo (:repo status-result))) - (is (contains? status-result :ws-state)) - (is (contains? status-result :pending-local)) - (is (contains? status-result :pending-asset)) - (is (contains? status-result :pending-server)) - (is (contains? status-result :local-tx)) - (is (contains? status-result :remote-tx)) - (is (contains? status-result :graph-id))) - (p/catch (fn [e] - (is false (str "unexpected error: " e)))) - (p/finally (fn [] - (if-let [stop! (:stop! @daemon)] - (-> (stop!) (p/finally (fn [] (done)))) - (done)))))))) - -(deftest db-worker-node-sync-start-and-status-invoke-path - (async done - (let [daemon (atom nil) - data-dir (node-helper/create-tmp-dir "db-worker-sync-start") - repo (str "logseq_db_sync_start_" (subs (str (random-uuid)) 0 8))] - (-> (p/let [{:keys [host port stop!]} - (start-daemon! {:root-dir data-dir - :repo repo}) - _ (reset! daemon {:host host :port port :stop! stop!}) - _ (invoke host port "thread-api/create-or-open-db" [repo {}]) - _ (invoke host port "thread-api/set-db-sync-config" - [{:ws-url nil - :http-base "https://example.com"}]) - start-result (invoke host port "thread-api/db-sync-start" [repo]) - status-result (invoke host port "thread-api/db-sync-status" [repo])] - (is (nil? start-result)) - (is (= repo (:repo status-result))) - (is (= :inactive (:ws-state status-result))) - (is (contains? status-result :pending-local)) - (is (contains? status-result :pending-server))) - (p/catch (fn [e] - (is false (str "unexpected error: " e)))) - (p/finally (fn [] - (if-let [stop! (:stop! @daemon)] - (-> (stop!) (p/finally (fn [] (done)))) - (done)))))))) - (deftest db-worker-node-daemon-smoke-test (async done (let [daemon (atom nil) diff --git a/src/test/frontend/worker/db_worker_test.cljs b/src/test/frontend/worker/db_worker_test.cljs index 8e092ec..a984c3e 100644 --- a/src/test/frontend/worker/db_worker_test.cljs +++ b/src/test/frontend/worker/db_worker_test.cljs @@ -1,41 +1,23 @@ (ns frontend.worker.db-worker-test (:require [cljs.test :refer [async deftest is]] - [clojure.string :as string] - [datascript.core :as d] [frontend.common.thread-api :as thread-api] [frontend.worker.a-test-env] [frontend.worker.db-core :as db-worker] + [frontend.worker.local-tx-log :as local-tx-log] [frontend.worker.platform :as platform] [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] - [frontend.worker.sync.log-and-state :as rtc-log-and-state] - [logseq.db.frontend.schema :as db-schema] [promesa.core :as p])) (def ^:private test-repo "test-db-worker-repo") (def ^:private close-db!-orig db-worker/close-db!) -(def ^:private decrypt-snapshot-datoms-batch-orig sync-crypt/content :thread-api/validate-db - :thread-api/recompute-checksum-diagnostics :thread-api/export-edn :thread-api/import-edn + :thread-api/export-edn :thread-api/import-edn :thread-api/get-fsrs-due-card-block-ids :thread-api/get-view-data :thread-api/get-class-objects :thread-api/validate-block-tag :thread-api/convert-tag-to-page @@ -133,11 +113,7 @@ platform-prev @@#'platform/*platform cleanup (fn [] (set! db-worker/close-db! close-db!-orig) - (set! sync-crypt/pending-local-tx-count {test-repo 9}) + (reset! local-tx-log/*repo->pending-local-tx-count {test-repo 9}) (db-worker/close-db! test-repo) (is (= #{:db :search :client-ops} (set @closed))) (is (= 1 @pause-calls)) - (is (nil? (get @client-op/*repo->pending-local-tx-count test-repo))) + (is (nil? (get @local-tx-log/*repo->pending-local-tx-count test-repo))) (is (nil? (get @worker-state/*sqlite-conns test-repo))))))) (deftest close-db-checkpoints-wal-before-closing-test @@ -248,328 +220,6 @@ (set! js/setInterval original-set-interval) (set! js/clearInterval original-clear-interval))))))) -(deftest complete-datoms-import-invalidates-existing-search-db-test - (async done - (restoring-worker-state - (fn [] - (let [thread-apis-prev @thread-api/*thread-apis] - (vreset! thread-api/*thread-apis - (assoc thread-apis-prev - :thread-api/create-or-open-db (fn [_repo _opts] (p/resolved nil)) - :thread-api/db-sync-rehydrate-large-titles (fn [_repo _graph-id] (p/resolved nil)))) - (-> (p/with-redefs [rtc-log-and-state/rtc-log (fn [& _] nil) - client-op/update-graph-uuid (fn [& _] nil) - client-op/update-local-tx (fn [& _] nil) - shared-service/broadcast-to-clients! (fn [& _] nil)] - (sync-download/complete-datoms-import! test-repo "graph-1" 42)) - (p/then (fn [_] - (is true) - (vreset! thread-api/*thread-apis thread-apis-prev) - (done))) - (p/catch (fn [error] - (vreset! thread-api/*thread-apis thread-apis-prev) - (is false (str error)) - (done))))))))) - -(defn- capture-outcome - [thunk] - (try - (-> (thunk) - (p/then (fn [value] {:value value})) - (p/catch (fn [error] {:error error}))) - (catch :default error - (p/resolved {:error error})))) - -(defn- with-fake-create-or-open-db - ([repo conn f] - (with-fake-create-or-open-db repo conn {} f)) - ([repo conn - {:keys [create-or-open-db-f close-db-f invalidate-search-db-f unlink-db-f recreate-lock-f]} - f] - (let [thread-apis-prev @thread-api/*thread-apis - create-or-open-db-f (or create-or-open-db-f - (fn [_repo _opts] - (swap! worker-state/*datascript-conns assoc repo conn) - (p/resolved nil))) - close-db-f (or close-db-f (fn [_repo] nil)) - invalidate-search-db-f (or invalidate-search-db-f (fn [_repo] (p/resolved nil))) - unlink-db-f (or unlink-db-f (fn [_repo] nil)) - recreate-lock-f (or recreate-lock-f (fn [_repo] (p/resolved nil)))] - (vreset! thread-api/*thread-apis - (assoc thread-apis-prev - :thread-api/create-or-open-db create-or-open-db-f - :thread-api/db-sync-close-db close-db-f - :thread-api/db-sync-invalidate-search-db invalidate-search-db-f - :thread-api/unsafe-unlink-db unlink-db-f - :thread-api/db-sync-recreate-lock recreate-lock-f)) - (-> (f) - (p/finally (fn [] - (vreset! thread-api/*thread-apis thread-apis-prev))))))) - -(deftest db-sync-import-prepare-replaces-active-import-state-test - (async done - (restoring-worker-state - (fn [] - (let [prepare (@thread-api/*thread-apis :thread-api/db-sync-import-prepare) - conn-a (d/create-conn db-schema/schema) - conn-b (d/create-conn db-schema/schema)] - (with-fake-create-or-open-db - test-repo conn-a - (fn [] - (-> (p/with-redefs [db-worker/close-db! (fn [_] nil)] - (p/let [first-import (prepare test-repo true "graph-1" false) - _ (swap! worker-state/*datascript-conns assoc test-repo conn-b) - second-import (prepare test-repo true "graph-1" false)] - (is (map? first-import)) - (is (map? second-import)) - (is (not= (:import-id first-import) (:import-id second-import))))) - (p/then (fn [_] (done))) - (p/catch (fn [error] - (is false (str error)) - (done))))))))))) - -(deftest db-sync-import-prepare-reset-unlinks-db-before-reopen-test - (async done - (restoring-worker-state - (fn [] - (let [prepare (@thread-api/*thread-apis :thread-api/db-sync-import-prepare) - conn (d/create-conn db-schema/schema) - calls (atom [])] - (with-fake-create-or-open-db - test-repo conn - {:close-db-f (fn [repo] - (swap! calls conj [:close repo]) - nil) - :unlink-db-f (fn [repo] - (swap! calls conj [:unlink repo]) - nil) - :recreate-lock-f (fn [repo] - (swap! calls conj [:recreate-lock repo]) - (p/resolved nil)) - :invalidate-search-db-f (fn [repo] - (swap! calls conj [:invalidate-search repo]) - (p/resolved nil)) - :create-or-open-db-f (fn [repo opts] - (swap! calls conj [:create-or-open repo opts]) - (swap! worker-state/*datascript-conns assoc repo conn) - (p/resolved nil))} - (fn [] - (-> (prepare test-repo true "graph-1" false) - (p/then (fn [_] - (let [ops (mapv first @calls) - idx (fn [op] - (first (keep-indexed (fn [i v] - (when (= op v) i)) - ops)))] - (is (some? (idx :close))) - (is (some? (idx :unlink))) - (is (some? (idx :recreate-lock))) - (is (some? (idx :invalidate-search))) - (is (some? (idx :create-or-open))) - (is (< (idx :close) (idx :unlink))) - (is (< (idx :unlink) (idx :recreate-lock))) - (is (< (idx :recreate-lock) (idx :invalidate-search))) - (is (< (idx :invalidate-search) (idx :create-or-open)))) - (done))) - (p/catch (fn [error] - (is false (str error)) - (done))))))))))) - -(deftest db-sync-import-finalize-rejects-stale-import-id-test - (async done - (restoring-worker-state - (fn [] - (let [prepare (@thread-api/*thread-apis :thread-api/db-sync-import-prepare) - finalize (@thread-api/*thread-apis :thread-api/db-sync-import-finalize) - conn (d/create-conn db-schema/schema)] - (with-fake-create-or-open-db - test-repo conn - (fn [] - (-> (p/with-redefs [rtc-log-and-state/rtc-log (fn [& _] nil) - client-op/update-local-tx (fn [& _] nil) - shared-service/broadcast-to-clients! (fn [& _] nil)] - (p/let [first-import (prepare test-repo true "graph-1" false) - second-import (prepare test-repo true "graph-1" false) - stale-outcome (capture-outcome #(finalize test-repo "graph-1" 42 (:import-id first-import)))] - (is (= :db-sync/stale-import (some-> stale-outcome :error ex-data :type))) - (-> (finalize test-repo "graph-1" 42 (:import-id second-import)) - (p/then (fn [_] - (is true) - (done)))))) - (p/catch (fn [error] - (is false (str error)) - (done))))))))))) - -(deftest db-sync-import-finalize-cleans-temp-pool-on-success-test - (async done - (restoring-worker-state - (fn [] - (let [import-id "import-success-1" - graph-id "graph-success-1" - remote-tx 42 - rows-db-closed* (atom 0) - removed-pools* (atom []) - rows-pool #js {:name "temp-download-pool"} - rows-db #js {:close (fn [] - (swap! rows-db-closed* inc))}] - (reset! @#'sync-download/*import-state - {:import-id import-id - :repo test-repo - :graph-id graph-id - :rows-db rows-db - :rows-pool rows-pool - :rows-path "/download-import.sqlite" - :rows-imported? false}) - (-> (p/with-redefs [sync-download/complete-datoms-import! (fn [_repo _graph-id _remote-tx] - (p/resolved :ok)) - platform/remove-storage-pool! (fn [_platform pool] - (swap! removed-pools* conj pool) - (p/resolved true))] - (sync-download/finalize-import! test-repo graph-id remote-tx import-id)) - (p/then (fn [result] - (is (= :ok result)) - (is (= 1 @rows-db-closed*)) - (is (= [rows-pool] @removed-pools*)) - (is (nil? @@#'sync-download/*import-state)) - (done))) - (p/catch (fn [error] - (is false (str error)) - (done))))))))) - -(deftest db-sync-download-graph-by-id-cleans-temp-pool-on-failure-test - (async done - (restoring-worker-state - (fn [] - (let [original-fetch js/fetch - import-id "import-failure-1" - graph-id "graph-failure-1" - rows-db-closed* (atom 0) - removed-pools* (atom []) - finalize-calls* (atom 0) - rows-pool #js {:name "temp-download-pool"} - rows-db #js {:close (fn [] - (swap! rows-db-closed* inc))}] - (reset! worker-state/*db-sync-config {:http-base "https://sync.example.test"}) - (set! js/fetch (fn [_url _opts] - (p/resolved #js {:ok true}))) - (-> (p/with-redefs [rtc-log-and-state/rtc-log (fn [& _] nil) - sync-download/fetch-json (fn [_url _opts schema] - (case schema - :sync/pull (p/resolved {:t 77}) - :sync/snapshot-download (p/resolved {:url "https://snapshot.example.test"}) - (p/rejected (ex-info "unexpected schema" {:schema schema})))) - sync-download/prepare-import! (fn [repo _reset? gid _graph-e2ee? & _] - (reset! @#'sync-download/*import-state - {:import-id import-id - :repo repo - :graph-id gid - :rows-db rows-db - :rows-pool rows-pool - :rows-path "/download-import.sqlite" - :rows-imported? false}) - (p/resolved {:import-id import-id})) - sync-download/import-rows-chunk! (fn [_rows _graph-id _import-id] - (p/resolved true)) - sync-download/finalize-import! (fn [& _] - (swap! finalize-calls* inc) - (p/resolved nil)) - sync-download/ (#'sync-download/import-datoms-batch! conn nil false datoms) - (p/then (fn [_] - (is (= 1 (count (d/datoms @conn :avet :user.test/indexed "hello")))) - (done))) - (p/catch (fn [error] - (is false (str error)) - (done))))))) - -(deftest imported-snapshot-blocks-receive-local-revisions-test - (async done - (let [conn (d/create-conn db-schema/schema) - block-uuid (random-uuid) - datoms [{:e 100 :a :block/uuid :v block-uuid} - {:e 100 :a :block/title :v "downloaded"} - {:e 100 :a :block/tx-id :v 42}]] - (-> (#'sync-download/import-datoms-batch! conn nil false datoms) - (p/then (fn [_] - (let [block (d/entity @conn [:block/uuid block-uuid])] - (is (= "downloaded" (:block/title block))) - (is (not= 42 (:block/tx-id block)) - "A remote snapshot cannot supply a renderer revision.") - (is (= (:max-tx @conn) (:block/tx-id block)) - "Snapshot import stamps the local DataScript transaction.")) - (done))) - (p/catch (fn [error] - (is false (str error)) - (done))))))) - (deftest thread-api-export-client-ops-db-binary-checkpoints-and-exports-client-ops-file-test (async done (restoring-worker-state @@ -685,174 +335,13 @@ (is (empty? missing) (str "Missing thread apis: " missing)) (is (empty? non-functions) (str "Non-function thread apis: " non-functions)))) -(defn- with-db-sync-core-wrapper-redefs - [calls f] - (let [results {:status {:state :connected} - :ensure-keys {:ok true} - :list-graphs [{:graph-id "g1"}] - :upload-stopped? true - :download-missing-assets {:total 2 :downloaded 2 :skipped-existing 0}}] - (with-redefs [db-worker/db-sync-dbs-open? (fn [repo] - (swap! calls conj [:db-sync-dbs-open? repo]) - true) - db-sync/status (fn [repo] - (swap! calls conj [:status repo]) - (:status results)) - db-sync/start! (fn [repo] - (swap! calls conj [:start repo]) - :started) - db-sync/stop! (fn [] - (swap! calls conj [:stop]) - :stopped) - db-sync/update-presence! (fn [editing-block-uuid] - (swap! calls conj [:update-presence editing-block-uuid]) - :presence-updated) - db-sync/request-asset-download! (fn [repo asset-uuid] - (swap! calls conj [:request-asset-download repo asset-uuid]) - :asset-requested) - db-sync/download-missing-assets! (fn [repo graph-id] - (swap! calls conj [:download-missing-assets repo graph-id]) - (:download-missing-assets results)) - sync-crypt/ (#'db-sync/ (p/with-redefs [worker-state/get-datascript-conn (fn [_repo] - conn) - platform/current (fn [] {}) - platform/asset-stat (fn [_platform repo' file-name] - (swap! asset-stat-calls conj [repo' file-name]) - (p/resolved {:size 10})) - sync-assets/download-remote-asset! (fn [& args] - (swap! download-calls conj args) - (p/resolved nil))] - (sync-assets/request-asset-download! - repo - asset-uuid - {:current-client-f (fn [_repo] - {:graph-id graph-id}) - :enqueue-asset-task-f (fn [_client task] - (reset! enqueued-task task) - (execute-enqueued-asset-task! task)) - :broadcast-rtc-state!-f (fn [& args] - (swap! broadcast-calls conj args))})) - (p/then (fn [_] - (is (= [[repo (str asset-uuid ".png")]] @asset-stat-calls)) - (is (fn? @enqueued-task)) - (is (= [] @download-calls)) - (is (= [] @broadcast-calls)))) - (p/catch (fn [error] - (is false (str "unexpected error: " error)))) - (p/finally done))))) - -(deftest request-asset-download-downloads-missing-local-asset-test - (async done - (let [repo "asset-download-repo" - graph-id "graph-1" - asset-uuid (random-uuid) - conn (asset-conn asset-uuid) - download-calls (atom []) - asset-stat-calls (atom []) - broadcast-calls (atom [])] - (-> (p/with-redefs [worker-state/get-datascript-conn (fn [_repo] - conn) - platform/current (fn [] {}) - platform/asset-stat (fn [_platform repo' file-name] - (swap! asset-stat-calls conj [repo' file-name]) - (p/resolved nil)) - sync-assets/download-remote-asset! (fn [& args] - (swap! download-calls conj args) - (p/resolved nil))] - (sync-assets/request-asset-download! - repo - asset-uuid - {:current-client-f (fn [_repo] - {:graph-id graph-id}) - :enqueue-asset-task-f (fn [_client task] - (execute-enqueued-asset-task! task)) - :broadcast-rtc-state!-f (fn [& args] - (swap! broadcast-calls conj args))})) - (p/then (fn [_] - (is (= [[repo (str asset-uuid ".png")]] @asset-stat-calls)) - (is (= [[repo graph-id asset-uuid "png"]] @download-calls)) - (is (= 1 (count @broadcast-calls))))) - (p/catch (fn [error] - (is false (str "unexpected error: " error)))) - (p/finally done))))) - -(deftest request-asset-download-propagates-and-logs-download-failure-test - (async done - (let [repo "asset-download-repo" - graph-id "graph-1" - asset-uuid (random-uuid) - conn (asset-conn asset-uuid) - download-error (ex-info "download failed" {:type :rtc.exception/download-asset-failed}) - log-calls (atom [])] - (-> (p/with-redefs [worker-state/get-datascript-conn (fn [_repo] - conn) - platform/current (fn [] {}) - platform/asset-stat (fn [_platform _repo _file-name] - (p/resolved nil)) - sync-assets/download-remote-asset! (fn [& _args] - (p/rejected download-error)) - sync-assets/log-request-asset-download-failed! - (fn [repo' asset-uuid' error'] - (swap! log-calls conj [repo' asset-uuid' error']))] - (sync-assets/request-asset-download! - repo - asset-uuid - {:current-client-f (fn [_repo] - {:graph-id graph-id}) - :enqueue-asset-task-f (fn [_client task] - (execute-enqueued-asset-task! task)) - :broadcast-rtc-state!-f (fn [& _args] nil)})) - (p/then (fn [_] - (is false "expected download failure to reject"))) - (p/catch (fn [error] - (is (= download-error error)) - (is (= [[repo asset-uuid download-error]] @log-calls)))) - (p/finally done))))) - -(deftest upload-remote-asset-serializes-resolved-encrypted-payload-test - (async done - (let [repo "asset-upload-repo" - graph-id "graph-1" - asset-uuid (random-uuid) - checksum "sha-256-value" - asset-bytes (js/Uint8Array. #js [1 2 3]) - encrypted-payload {:cipher "encrypted-payload"} - expected-body (ldb/write-transit-str encrypted-payload) - fetch-call* (atom nil) - encrypt-input* (atom nil) - original-fetch js/fetch - db-sync-config @worker-state/*db-sync-config] - (reset! worker-state/*db-sync-config - {:http-base "https://sync.example.test"}) - (set! js/fetch - (fn [url opts] - (reset! fetch-call* - {:url url - :body (.-body opts)}) - (p/resolved #js {:ok true - :status 200}))) - (-> (p/with-redefs [sync-assets/graph-aes-key - (fn [_repo _graph-id _fail-fast-f] - (p/resolved "aes-key")) - platform/current - (fn [] {}) - platform/asset-read-bytes! - (fn [_platform _repo _file-name] - (p/resolved asset-bytes)) - crypt/ (p/with-redefs [sync-assets/graph-aes-key - (fn [_repo _graph-id _fail-fast-f] - (p/resolved nil)) - platform/current - (fn [] {}) - platform/asset-read-bytes! - (fn [_platform _repo _file-name] - (p/rejected read-error)) - shared-service/broadcast-to-clients! - (fn [event payload] - (swap! broadcasts conj [event payload]))] - (sync-assets/clear-missing-asset-upload-files! repo) - (sync-assets/upload-remote-asset! - repo graph-id asset-uuid "pdf" checksum)) - (p/then - (fn [_] - (is false "expected missing local file to reject"))) - (p/catch - (fn [error] - (is (= :rtc.exception/read-asset-failed (:type (ex-data error)))) - (is (false? @fetch-called?)) - (is (= [] @broadcasts)) - (is (= [{:asset-id (str asset-uuid) - :asset-type "pdf" - :file missing-file}] - (sync-assets/get-missing-asset-upload-files repo))))) - (p/finally - (fn [] - (set! js/fetch original-fetch) - (reset! worker-state/*db-sync-config db-sync-config) - (sync-assets/clear-missing-asset-upload-files! repo) - (done))))))) - -(deftest download-missing-remote-assets-downloads-only-missing-sync-assets-test - (async done - (let [repo "asset-prefetch-repo" - graph-id "graph-1" - missing-uuid (random-uuid) - existing-uuid (random-uuid) - local-uuid (random-uuid) - external-uuid (random-uuid) - conn (d/create-conn db-schema/schema) - stat-calls (atom []) - download-calls (atom [])] - (ldb/transact! - conn - [{:db/ident :logseq.class/Asset} - {:block/uuid missing-uuid - :block/tags #{:logseq.class/Asset} - :logseq.property.asset/type "png" - :logseq.property.asset/checksum "missing-checksum" - :logseq.property.asset/remote-metadata {:checksum "missing-checksum" - :type "png"}} - {:block/uuid existing-uuid - :block/tags #{:logseq.class/Asset} - :logseq.property.asset/type "pdf" - :logseq.property.asset/checksum "existing-checksum" - :logseq.property.asset/remote-metadata {:checksum "existing-checksum" - :type "pdf"}} - {:block/uuid local-uuid - :block/tags #{:logseq.class/Asset} - :logseq.property.asset/type "jpg" - :logseq.property.asset/checksum "local-checksum"} - {:block/uuid external-uuid - :block/tags #{:logseq.class/Asset} - :logseq.property.asset/type "gif" - :logseq.property.asset/checksum "external-checksum" - :logseq.property.asset/remote-metadata {:checksum "external-checksum" - :type "gif"} - :logseq.property.asset/external-url "https://example.com/asset.gif"}]) - (-> (p/with-redefs [worker-state/get-datascript-conn (fn [_repo] - conn) - platform/current (fn [] {}) - platform/asset-stat - (fn [_platform repo' file-name] - (swap! stat-calls conj [repo' file-name]) - (p/resolved (when (= file-name (str existing-uuid ".pdf")) - {:size 10}))) - sync-assets/download-remote-asset! - (fn [& args] - (swap! download-calls conj args) - (p/resolved nil))] - (sync-assets/download-missing-remote-assets! repo graph-id)) - (p/then (fn [result] - (is (= {:total 2 - :downloaded 1 - :skipped-existing 1} - result)) - (is (= #{[repo (str existing-uuid ".pdf")] - [repo (str missing-uuid ".png")]} - (set @stat-calls))) - (is (= [[repo graph-id missing-uuid "png"]] - @download-calls)))) - (p/catch (fn [error] - (is false (str "unexpected error: " error)))) - (p/finally done))))) - -(deftest download-remote-assets-if-missing-bounds-download-concurrency-test - (async done - (let [repo "asset-prefetch-repo" - graph-id "graph-1" - candidates (mapv (fn [_] - {:asset-uuid (random-uuid) - :asset-type "png"}) - (range 12)) - active-downloads (atom 0) - max-active-downloads (atom 0) - download-calls (atom [])] - (-> (p/with-redefs [platform/current (fn [] {}) - platform/asset-stat - (fn [_platform _repo _file-name] - (p/resolved nil)) - sync-assets/download-remote-asset! - (fn [repo' graph-id' asset-uuid asset-type] - (swap! download-calls conj [repo' graph-id' asset-uuid asset-type]) - (let [active (swap! active-downloads inc)] - (swap! max-active-downloads max active)) - (p/let [_ (p/delay 20)] - (swap! active-downloads dec) - nil))] - (sync-assets/download-remote-assets-if-missing! - repo graph-id candidates)) - (p/then (fn [result] - (is (= {:total 12 - :downloaded 12 - :skipped-existing 0} - result)) - (is (= 12 (count @download-calls))) - (is (= 10 @max-active-downloads)))) - (p/catch (fn [error] - (is false (str "unexpected error: " error)))) - (p/finally done))))) diff --git a/src/test/frontend/worker/sync/crypt_test.cljs b/src/test/frontend/worker/sync/crypt_test.cljs deleted file mode 100644 index 4cb72e4..0000000 --- a/src/test/frontend/worker/sync/crypt_test.cljs +++ /dev/null @@ -1,1355 +0,0 @@ -(ns frontend.worker.sync.crypt-test - (:require [cljs.test :refer [deftest is async]] - [clojure.string :as string] - [frontend.common.crypt :as crypt] - [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.crypt :as sync-crypt] - [frontend.worker.sync.util :as sync-util] - [frontend.worker.ui-request :as ui-request] - [logseq.db :as ldb] - [promesa.core :as p])) - -(def ^:private decrypt-snapshot-datoms-batch-orig sync-crypt/ (p/with-redefs [sync-crypt/get-user-uuid (fn [] nil) - sync-auth/ (p/with-redefs [platform/current (fn [] {:runtime :test}) - platform/kv-get (fn [_platform' _k] - (p/resolved expected))] - (#'sync-crypt/clj result)))))) - (p/catch (fn [e] - (is false (str e)))) - (p/finally done))))) - -(deftest graph-e2ee-preserves-nil-kv-value-test - (with-redefs [worker-state/get-datascript-conn (fn [_repo] - (atom {})) - ldb/get-graph-rtc-e2ee? (fn [_db] - nil)] - (is (nil? (sync-crypt/graph-e2ee? "logseq_db_demo"))))) - -(deftest graph-e2ee-preserves-false-kv-value-test - (with-redefs [worker-state/get-datascript-conn (fn [_repo] - (atom {})) - ldb/get-graph-rtc-e2ee? (fn [_db] - false)] - (is (= false (sync-crypt/graph-e2ee? "logseq_db_demo"))))) - -(deftest save-e2ee-password-uses-secret-storage-in-browser-runtime-test - (async done - (let [platform-map {:env {:runtime :browser}} - state-prev @worker-state/*state - secret-calls (atom []) - file-calls (atom []) - auth-read-calls (atom []) - encrypt-calls (atom [])] - (reset! worker-state/*state (assoc state-prev :auth/refresh-token "refresh-from-state")) - (-> (p/with-redefs [crypt/ (p/with-redefs [crypt/ (p/with-redefs [crypt/ (p/with-redefs [crypt/ (p/with-redefs [platform/current (fn [] platform-map) - platform/read-text! (fn [_platform' _path] - (p/resolved "{\"refresh-token\":\"\"}")) - crypt/ (p/with-redefs [platform/current (fn [] platform-map) - platform/read-secret-text (fn [platform' key] - (swap! secret-calls conj {:platform platform' - :key key}) - (p/resolved (ldb/write-transit-str {:cipher "payload"}))) - platform/read-text! (fn [platform' path] - (swap! file-calls conj {:platform platform' - :path path}) - (p/resolved (ldb/write-transit-str {:cipher "legacy"}))) - crypt/ (p/with-redefs [platform/current (fn [] platform-map) - ui-request/ (p/with-redefs [platform/current (fn [] platform-map) - platform/read-secret-text (fn [platform' key] - (swap! secret-calls conj {:platform platform' - :key key}) - (p/resolved (ldb/write-transit-str {:cipher "payload"}))) - platform/read-text! (fn [platform' path] - (swap! file-calls conj {:platform platform' - :path path}) - (p/resolved (ldb/write-transit-str {:cipher "legacy"}))) - crypt/ (p/with-redefs [platform/current (fn [] platform-map) - platform/read-secret-text (fn [platform' key] - (swap! secret-calls conj {:platform platform' - :key key}) - (p/resolved (ldb/write-transit-str {:cipher "payload"}))) - platform/read-text! (fn [platform' path] - (swap! file-calls conj {:platform platform' - :path path}) - (p/resolved (ldb/write-transit-str {:cipher "legacy"}))) - crypt/ (p/with-redefs [platform/current (fn [] platform-map) - platform/read-secret-text (fn [_platform' _key] - (swap! secret-read-calls inc) - (p/resolved nil)) - platform/read-text! (fn [_platform' _path] - (swap! file-read-calls inc) - (p/resolved (ldb/write-transit-str {:cipher "legacy"}))) - crypt/ (p/with-redefs [platform/current (fn [] platform-map) - ui-request/ (p/with-redefs [platform/current (fn [] {:env {:runtime :node - :owner-source :cli}}) - ldb/read-transit-str (fn [value] - (if (= value "encrypted-private-key") - :encrypted-private-key-payload - value)) - crypt/ (p/with-redefs [platform/current (fn [] {:env {:runtime :node - :owner-source :cli}}) - ldb/read-transit-str (fn [_] :encrypted-private-key-payload) - crypt/ (p/with-redefs [platform/current (fn [] {:env {:runtime :node - :owner-source :cli}}) - sync-crypt/e2ee-base (fn [] "https://example.com") - sync-crypt/ (p/with-redefs [sync-crypt/e2ee-base (fn [] "https://example.com") - sync-crypt/ (p/with-redefs [sync-crypt/e2ee-base (fn [] "http://base") - sync-crypt/ (p/with-redefs [sync-crypt/e2ee-base (fn [] "http://base") - sync-crypt/ (p/with-redefs [platform/current (fn [] {:env {:runtime :node - :owner-source :cli}}) - ldb/read-transit-str (fn [_] :encrypted-private-key) - crypt/ (p/with-redefs [platform/current (fn [] {:env {:runtime :browser}}) - platform/read-secret-text (fn [_platform' _key] - (p/resolved nil)) - platform/read-text! (fn [_platform' _path] - (p/rejected (ex-info "should-not-read-browser-file" {}))) - ui-request/ (p/with-redefs [platform/current (fn [] {:env {:runtime :browser - :owner-source :capacitor}}) - platform/read-secret-text (fn [_platform' _key] - (p/rejected (ex-info "should-not-read-worker-secret" {}))) - platform/save-secret-text! (fn [_platform' _key _text] - (p/rejected (ex-info "should-not-save-worker-secret" {}))) - platform/read-text! (fn [_platform' _path] - (p/rejected (ex-info "should-not-read-browser-file" {}))) - ui-request/ (p/with-redefs [platform/current (fn [] {:env {:runtime :browser - :owner-source :capacitor}}) - ui-request/ (p/with-redefs [sync-crypt/e2ee-base (fn [] "https://sync.example.test") - sync-crypt/ (p/with-redefs [sync-crypt/e2ee-base (fn [] "https://sync.example.test") - sync-crypt/ (p/with-redefs [sync-crypt/e2ee-base (fn [] "https://sync.example.test") - sync-crypt/ (p/with-redefs [sync-crypt/e2ee-base (fn [] "https://sync.example.test") - sync-crypt/ (p/with-redefs [sync-crypt/graph-e2ee? (fn [_repo] true) - sync-crypt/e2ee-base (fn [] "https://example.com") - worker-state/get-id-token (fn [] "token") - worker-util/parse-jwt (fn [_] {:sub "user-1"}) - sync-crypt/ (p/with-redefs [sync-crypt/e2ee-base (fn [] "https://example.com") - worker-state/get-id-token (fn [] "token") - worker-util/parse-jwt (fn [_] {:sub "user-1"}) - sync-crypt/ (p/let [aes-key (crypt/ (p/let [aes-key (crypt/ (p/with-redefs [sync-crypt/e2ee-base (fn [] "https://sync.example.test") - sync-crypt/get-user-uuid (fn [] "user-1") - sync-crypt/ (p/with-redefs [sync-crypt/e2ee-base (fn [] "https://sync.example.test") - sync-crypt/get-user-uuid (fn [] nil) - sync-crypt/ (p/with-redefs [platform/current (fn [] platform-map) - platform/kv-get (fn [_ k] (p/resolved (get @kv-store k))) - platform/kv-set! (fn [_ k v] - (if (nil? v) - (swap! kv-store dissoc k) - (swap! kv-store assoc k v)) - (p/resolved nil))] - (p/let [pair-a {:public-key "pk-a" :encrypted-private-key "enc-a"} - pair-b {:public-key "pk-b" :encrypted-private-key "enc-b"} - _ (#'sync-crypt/ (p/let [aes-key (crypt/ (#'sync-download/ (p/with-redefs [sync-download/fetch-json (fn [_url _opts schema] - (case schema - :sync/pull - (p/resolved {:t 42}) - - :sync/snapshot-download - (p/resolved {:url "https://sync.example.test/snapshot"}) - - (p/rejected (ex-info "unexpected schema" {:schema schema})))) - sync-crypt/ (p/with-redefs [sync-download/fetch-json (fn [_url _opts schema] - (case schema - :sync/pull - (p/resolved {:t 42}) - - :sync/snapshot-download - (p/resolved {:url "https://sync.example.test/snapshot"}) - - (p/rejected (ex-info "unexpected schema" {:schema schema})))) - sync-crypt/ (p/with-redefs [worker-state/get-client-ops-conn (fn [_repo] true) - client-op/get-local-tx (fn [_repo] 0) - client-op/get-pending-local-tx-count (fn [_repo] 0) - client-op/get-unpushed-asset-ops-count (fn [_repo] 0) - client-op/get-all-asset-ops (fn [_repo] []) - client-op/get-local-checksum (fn [_repo] nil) - client-op/get-graph-uuid (fn [_repo] graph-id) - client-op/update-graph-uuid (fn [_repo _graph-id] nil) - sync-util/get-graph-id (fn [_repo] graph-id) - sync/ (p/with-redefs [worker-state/get-client-ops-conn (fn [_repo] true) - client-op/get-local-tx (fn [_repo] nil) - client-op/update-local-tx (fn [_repo _tx] - (throw (js/Error. "must not initialize missing local-tx to 0"))) - sync-util/get-graph-id (fn [_repo] graph-id)] - (sync/start! repo)) - (p/then - (fn [_] - (is (zero? @connect-calls) - "start! should wait for valid client-op local-tx instead of syncing from 0"))) - (p/catch - (fn [error] - (is false (str "unexpected error: " error)))) - (p/finally - (fn [] - (reset! worker-state/*db-sync-client prev-client) - (reset! worker-state/*db-sync-config prev-config) - (when prev-platform - (platform/set-platform! prev-platform)) - (done))))))) - -(deftest stale-loop-marks-non-open-ws-closed-test - (let [broadcasts (atom []) - clear-interval-calls (atom []) - interval-f* (atom nil) - original-clear-interval js/clearInterval - original-set-interval js/setInterval - prev-client @worker-state/*db-sync-client - ws #js {:readyState 3 - :close (fn [] nil)} - client {:repo "stale-repo" - :graph-id "graph-1" - :ws ws - :ws-state (atom :open) - :inflight (atom [(random-uuid)]) - :online-users (atom []) - :stale-kill-timer (atom nil)}] - (set! js/setInterval - (fn [f _ms] - (reset! interval-f* f) - :interval-id)) - (set! js/clearInterval - (fn [interval-id] - (swap! clear-interval-calls conj interval-id))) - (reset! worker-state/*db-sync-client client) - (with-redefs [shared-service/broadcast-to-clients! - (fn [topic payload] - (swap! broadcasts conj [topic payload]))] - (try - (#'sync/close-stale-ws-loop client ws "wss://sync.example.test/sync/graph-1") - (@interval-f*) - (is (= :closed @(:ws-state client))) - (is (empty? @(:inflight client))) - (is (= [:interval-id] @clear-interval-calls)) - (is (some #(= :rtc-sync-state (first %)) @broadcasts)) - (finally - (reset! worker-state/*db-sync-client prev-client) - (set! js/setInterval original-set-interval) - (set! js/clearInterval original-clear-interval)))))) - -(deftest ws-close-clears-inflight-before-reconnect-test - (let [broadcasts (atom []) - original-set-timeout js/setTimeout - prev-client @worker-state/*db-sync-client - ws #js {:readyState 3 - :close (fn [] nil)} - client {:repo "stale-repo" - :graph-id "graph-1" - :ws ws - :ws-state (atom :open) - :inflight (atom [(random-uuid)]) - :online-users (atom [:user]) - :reconnect (atom {:attempt 0 :timer nil}) - :stale-kill-timer (atom nil)}] - (set! js/setTimeout - (fn [_f _ms] - :timeout-id)) - (reset! worker-state/*db-sync-client client) - (with-redefs [shared-service/broadcast-to-clients! - (fn [topic payload] - (swap! broadcasts conj [topic payload]))] - (try - (#'sync/attach-ws-handlers! "stale-repo" client ws "wss://sync.example.test/sync/graph-1") - ((.-onclose ws) #js {}) - (is (= :closed @(:ws-state client))) - (is (empty? @(:inflight client))) - (is (empty? @(:online-users client))) - (is (= :timeout-id (:timer @(:reconnect client)))) - (is (some #(= :rtc-sync-state (first %)) @broadcasts)) - (finally - (reset! worker-state/*db-sync-client prev-client) - (set! js/setTimeout original-set-timeout)))))) diff --git a/src/test/frontend/worker/sync/upload_test.cljs b/src/test/frontend/worker/sync/upload_test.cljs deleted file mode 100644 index 84ce721..0000000 --- a/src/test/frontend/worker/sync/upload_test.cljs +++ /dev/null @@ -1,269 +0,0 @@ -(ns frontend.worker.sync.upload-test - (:require [cljs.test :refer [async deftest is]] - [datascript.core :as d] - [frontend.worker.sync.crypt :as sync-crypt] - [frontend.worker.sync.temp-sqlite :as sync-temp-sqlite] - [frontend.worker.sync.util :as sync-util] - [frontend.worker.sync.upload :as sync-upload] - [logseq.db.frontend.schema :as db-schema] - [promesa.core :as p] - [clojure.string :as string])) - -(deftest split-snapshot-rows-by-max-bytes-splits-rows-into-byte-capped-batches-test - (let [sizes {:a 4 - :b 4 - :c 4 - :d 4} - rows [[:a] [:b] [:c] [:d]]] - (with-redefs [sync-upload/snapshot-rows-byte-length - (fn [rows'] - (reduce + (map (fn [[addr]] (get sizes addr 0)) rows')))] - (is (= [[[:a] [:b]] - [[:c] [:d]]] - (#'sync-upload/split-snapshot-rows-by-max-bytes rows 8)))))) - -(deftest split-snapshot-rows-by-max-bytes-fails-fast-for-oversized-single-row-test - (let [sizes {:ok 3 - :too-big 11} - rows [[:ok] [:too-big]]] - (with-redefs [sync-upload/snapshot-rows-byte-length - (fn [rows'] - (reduce + (map (fn [[addr]] (get sizes addr 0)) rows')))] - (try - (#'sync-upload/split-snapshot-rows-by-max-bytes rows 10) - (is false "expected snapshot row too large error") - (catch :default error - (let [data (ex-data error)] - (is (= "snapshot-row-too-large" (ex-message error))) - (is (= 10 (:max-bytes data))) - (is (= 11 (:row-size data))) - (is (= :too-big (:addr data))))))))) - -(deftest upload-snapshot-rows-batches-sets-reset-and-finished-flags-correctly-test - (async done - (let [calls* (atom []) - rows-batches [[[1 "a" nil]] - [[2 "b" nil]] - [[3 "c" nil]]]] - (-> (p/with-redefs [sync-upload/ (p/with-redefs [sync-temp-sqlite/ (p/with-redefs [sync-crypt/ (p/with-redefs [sync-crypt/ (p/with-redefs [sync-crypt/ (p/with-redefs [sync-upload/list-remote-graphs! (fn [] - (swap! calls* conj :list-remote-graphs) - (p/resolved [])) - sync-crypt/ (p/with-redefs [sync-upload/list-remote-graphs! (fn [] (p/resolved [])) - sync-crypt/