From 47e8d8c256c9b2021341d656aeaa9ac7850edd7f Mon Sep 17 00:00:00 2001 From: Kinneyzhang Date: Sat, 5 Sep 2026 07:07:53 +0800 Subject: [PATCH] perf: retain authoritative publication target state --- tests/tp-surface-tests.el | 127 ++++++++++++++++++++++++++++++++++ tests/tp-transaction-tests.el | 13 +++- tp-surface.el | 113 ++++++++++++++++++------------ tp-transaction.el | 24 +++++-- 4 files changed, 226 insertions(+), 51 deletions(-) diff --git a/tests/tp-surface-tests.el b/tests/tp-surface-tests.el index 35bf01b..4c0a075 100644 --- a/tests/tp-surface-tests.el +++ b/tests/tp-surface-tests.el @@ -39,6 +39,43 @@ (error condition) (quit condition))) +(defun tp-surface-test--commit-batch-update + (surface root batch client-state before-stage) + "Update SURFACE through BATCH after calling BEFORE-STAGE with its entry. +ROOT is the retained object and CLIENT-STATE is transferred by its active +prepare context." + (let ((execute (symbol-function 'tp--publication-batch-execute-stage))) + (cl-letf (((symbol-function 'tp--publication-batch-execute-stage) + (lambda (candidate) + (let* ((entry + (car (tp-publication-batch-candidate-entries + candidate))) + (prepared + (aref + (tp-publication-target-entry-rollback-snapshot entry) + 0))) + (funcall before-stage entry prepared) + (funcall execute candidate))))) + (tp-surface-update + surface + (lambda (context) + (tp-object-reuse-subtree context root) + (tp-commit-batch-result-create + context batch :client-state client-state + :reuse-mount-projection t)))))) + +(defun tp-surface-test--replacement-batch (surface replacement) + "Return an equal-extent batch replacing SURFACE's middle character." + (tp-commit-batch-create + :base-revision (tp-surface-revision surface) + :target-revision (1+ (tp-surface-revision surface)) + :base-extent 3 :target-extent 3 + :patches + (list (list :old-start 1 :old-end 2 :new-start 1 :new-end 2 + :replacement replacement)) + :coordinate-patches + '((:old-start 1 :old-end 2 :new-start 1 :new-end 2)))) + (defun tp-surface-test--shadow-apply-commit-batch-oracle (string batch) "Return the former exact replay result for STRING and BATCH." (let ((result (copy-sequence string))) @@ -138,6 +175,96 @@ (tp-surface-client-state surface)))) (should-error (tp-surface-commit-batch surface batch))))) +(ert-deftest tp-surface-test-publication-entry-adopts-prepared-authority () + "A real surface entry references its authenticated prepared values exactly." + (tp-surface-test--with-buffer + (let* ((surface + (tp-surface-mount + (current-buffer) (tp-surface-test--leaf 'root "abc") + '(:capability content :coordinate-mounts t))) + (root (tp-object-resolve surface '(root))) + (batch (tp-surface-test--replacement-batch surface "X")) + (client-state (list :owned (list 'next))) + entry prepared) + (tp-surface-test--commit-batch-update + surface root batch client-state + (lambda (target candidate) + (setq entry target prepared candidate))) + (should (eq (tp-publication-target-entry-client-state entry) + (tp--prepared-surface-client-state prepared))) + (should (eq (tp-publication-target-entry-diff entry) + (tp--prepared-surface-commit-batch prepared))) + (should (eq (tp-surface-client-state surface) client-state)) + (should (equal (buffer-string) "aXc"))))) + +(ert-deftest tp-surface-test-publication-entry-rejects-binding-tamper () + "Prepared batch, revision, extent, and client identity drift fail before write." + (dolist (fault '(batch client-state context-inactive context-surface + base-revision target-revision base-extent + target-extent)) + (tp-surface-test--with-buffer + (let* ((surface + (tp-surface-mount + (current-buffer) (tp-surface-test--leaf 'root "abc") + '(:capability content :coordinate-mounts t))) + (root (tp-object-resolve surface '(root))) + (batch (tp-surface-test--replacement-batch surface "X")) + (client-state (list :owned (list 'next))) + captured-context) + (should-error + (tp-surface-test--commit-batch-update + surface root batch client-state + (lambda (entry prepared) + (setq captured-context (tp--prepared-surface-context prepared)) + (pcase fault + ('batch + (setf (tp--prepared-surface-commit-batch prepared) + (tp-surface-test--replacement-batch surface "X"))) + ('client-state + (setf (tp--prepared-surface-client-state prepared) + (copy-tree client-state))) + ('context-inactive + (setf (tp--context-active captured-context) nil)) + ('context-surface + (setf (tp--context-surface captured-context) nil)) + ('base-revision + (setf (tp-commit-batch-base-revision batch) 0)) + ('target-revision + (setf (tp-commit-batch-target-revision batch) 9)) + ('base-extent + (setf (tp-commit-batch-base-extent batch) 2)) + ('target-extent + (setf (tp-commit-batch-target-extent batch) 4))) + (should (tp-publication-target-entry-p entry)))) + :type 'tp-publication-binding-error) + (should (equal (buffer-string) "abc")) + (should (= (tp-surface-revision surface) 1)) + (should-not (tp-surface-client-state surface)) + (should-not (tp--context-active captured-context)))))) + +(ert-deftest tp-surface-test-publication-entry-patch-tamper-stays-proven () + "Existing full shadow proof diagnoses in-place patch payload mutation." + (tp-surface-test--with-buffer + (let* ((surface + (tp-surface-mount + (current-buffer) (tp-surface-test--leaf 'root "abc") + '(:capability content :coordinate-mounts t))) + (root (tp-object-resolve surface '(root))) + (batch (tp-surface-test--replacement-batch surface "X"))) + (tp-surface-test--commit-batch-update + surface root batch '(:owned next) + (lambda (_entry _prepared) + (setf (plist-get (car (tp-commit-batch-patches batch)) :replacement) + "Z"))) + (should (equal (buffer-string) "aZc")) + (should-not (plist-get tp--last-shadow-proof :equivalent)) + (should + (cl-some + (lambda (entry) + (and (eq (car entry) 'shadow-proof) + (eq (cadr entry) 'commit))) + tp--last-transaction-diagnostics))))) + (ert-deftest tp-surface-test-shadow-batch-replay-preserves-exact-properties () "Shadow replay preserves Unicode, properties, order, and input ownership." (let* ((opaque (make-symbol "owner")) diff --git a/tests/tp-transaction-tests.el b/tests/tp-transaction-tests.el index 783abff..b746820 100644 --- a/tests/tp-transaction-tests.el +++ b/tests/tp-transaction-tests.el @@ -312,10 +312,17 @@ :type 'tp-publication-binding-error) (with-temp-buffer (let* ((mount-ids (list 'mount-a)) - (entry (tp-transaction-test--entry :mount-ids mount-ids)) + (diff (list :replace (list 1 2))) + (client-state (list :client (list 'candidate))) + (entry (tp-transaction-test--entry + :mount-ids mount-ids + :diff diff + :client-state client-state)) (entries (list entry)) (batch (tp-transaction-test--batch entries))) (setcar mount-ids 'mutated-after-create) + (setcar (plist-get diff :replace) 'mutated-after-create) + (setcar (plist-get client-state :client) 'mutated-after-create) (setcar entries (tp-transaction-test--entry :candidate-id 'replacement :surface-id 'replacement-surface @@ -326,6 +333,10 @@ (should (equal (tp-publication-target-entry-mount-ids (car (tp-publication-batch-candidate-entries batch))) '(mount-a))) + (should (equal (tp-publication-target-entry-diff entry) + '(:replace (1 2)))) + (should (equal (tp-publication-target-entry-client-state entry) + '(:client (candidate)))) (should (eq (car (tp-publication-batch-candidate-entries batch)) entry)) (should-error (tp-transaction-test--batch (list entry entry)) diff --git a/tp-surface.el b/tp-surface.el index b67a701..70d7a9a 100644 --- a/tp-surface.el +++ b/tp-surface.el @@ -3454,24 +3454,6 @@ When RETAIN-MARKERS is non-nil, keep snapshot markers for rollback." (when-let* ((state (cl-find buffer views :key #'car :test #'eq))) (marker-position (cadr state)))) -(defun tp--shadow-prepared-diff (prepared) - "Return PREPARED's deterministic v2 diff artifact." - (cond - ((tp--prepared-surface-commit-batch prepared) - (let ((batch (tp--prepared-surface-commit-batch prepared))) - (list :kind 'commit-batch - :patches (tp-commit-batch-patches batch) - :coordinate-patches (tp-commit-batch-coordinate-patches batch)))) - ((and (tp--prepared-surface-scope-objects prepared) - (not (tp--prepared-surface-scope-fallback prepared))) - (list :kind 'scoped - :patches (tp--prepared-surface-scope-patches prepared))) - (t - (list :kind 'full - :target-extent - (and (tp--prepared-surface-rendered prepared) - (length (tp--prepared-surface-rendered prepared))))))) - (defun tp--shadow-artifact-equal-p (expected actual) "Return non-nil when EXPECTED and ACTUAL publication artifacts are equal." (and (eq (plist-get expected :buffer) (plist-get actual :buffer)) @@ -3505,7 +3487,9 @@ When RETAIN-MARKERS is non-nil, keep snapshot markers for rollback." (defun tp--surface-shadow-target-entry (prepared snapshot journals views batch-id mapping-generation) "Build a BATCH-ID target view over PREPARED and SNAPSHOT. -JOURNALS and VIEWS are exact references to the shared rollback state." +JOURNALS and VIEWS are exact references to the shared rollback state. +For real surface entries, the diff slot references PREPARED's exact commit +batch, or nil when publication does not use a commit batch." (let* ((prepared (tp--assign-prepared-mount-ids prepared)) (surface (tp--prepared-surface-surface prepared)) (buffer (tp--surface-buffer surface)) @@ -3514,6 +3498,11 @@ JOURNALS and VIEWS are exact references to the shared rollback state." (old-ledger (tp--shadow-live-ledger-signature (tp--surface-snapshot-ledger snapshot))) + (context (tp--prepared-surface-context prepared)) + (commit-batch (tp--prepared-surface-commit-batch prepared)) + (target-mount-ids (tp--prepared-target-mount-ids prepared)) + (candidate-id (tp--next-publication-candidate-id)) + (authority-token (make-symbol "tp-publication-entry-authority")) (point (tp--shadow-view-point views buffer)) (commit-expected (list :buffer buffer @@ -3523,7 +3512,7 @@ JOURNALS and VIEWS are exact references to the shared rollback state." :object-ids (tp--shadow-object-ids (tp--prepared-surface-objects prepared)) - :mount-ids (tp--prepared-target-mount-ids prepared) + :mount-ids target-mount-ids :mounts (tp--prepared-mount-signature prepared) :ledger (tp--shadow-ledger-spec-signature @@ -3546,36 +3535,50 @@ JOURNALS and VIEWS are exact references to the shared rollback state." :point point :output old-output)) (expected (list :commit commit-expected - :rollback rollback-expected))) - (tp--publication-target-entry-create + :rollback rollback-expected)) + (old-revision (tp--surface-snapshot-revision snapshot)) + (new-revision (1+ old-revision)) + (shadow-validator + (lambda (_entry phase) + (let* ((target (plist-get expected + (if (eq phase 'commit) + :commit + :rollback))) + (actual (tp--shadow-current-artifact surface))) + (list :equivalent (tp--shadow-artifact-equal-p target actual) + :surface-id (tp--surface-id surface) + :expected target :actual actual))))) + (unless + (and (tp-prepare-context-p context) + (tp--context-active context) + (eq (tp--context-surface context) surface) + (= old-revision (tp--surface-revision surface)) + (tp--publication-target-entry-arguments-valid-p + tp--transaction-id batch-id candidate-id (tp--surface-id surface) + target-mount-ids buffer + old-revision new-revision authority-token shadow-validator)) + (signal 'tp-publication-binding-error + (list :prepared-target prepared snapshot))) + (tp--make-publication-target-entry :transaction-id tp--transaction-id :batch-id batch-id - :candidate-id (tp--next-publication-candidate-id) - :surface-id (tp--surface-id surface) - :mount-ids (tp--prepared-target-mount-ids prepared) + :candidate-id candidate-id + :surface-id (tp--copy-property-value (tp--surface-id surface)) + :mount-ids (tp--copy-property-value target-mount-ids) :buffer buffer - :old-revision (tp--surface-snapshot-revision snapshot) - :new-revision (1+ (tp--surface-snapshot-revision snapshot)) + :old-revision old-revision + :new-revision new-revision :plan (tp--prepared-surface-plan prepared) - :diff (tp--shadow-prepared-diff prepared) + :diff commit-batch :ledger (tp--prepared-surface-ledger-specs prepared) :objects (tp--prepared-surface-objects prepared) :ranges (tp--prepared-surface-mount-specs prepared) :client-state (tp--prepared-surface-client-state prepared) :rollback-snapshot (vector prepared snapshot journals views) - :authority-token (make-symbol "tp-publication-entry-authority") + :authority-token authority-token :mapping-generation mapping-generation :shadow-expected expected - :shadow-validator - (lambda (_entry phase) - (let* ((target (plist-get expected - (if (eq phase 'commit) - :commit - :rollback))) - (actual (tp--shadow-current-artifact surface))) - (list :equivalent (tp--shadow-artifact-equal-p target actual) - :surface-id (tp--surface-id surface) - :expected target :actual actual)))))) + :shadow-validator shadow-validator))) (defun tp--surface-shadow-target-entries (prepared snapshots journals views batch-id mapping-generation) @@ -3596,9 +3599,19 @@ JOURNALS and VIEWS are exact references to the shared rollback state." (aref rollback 0))) (snapshot (and prepared (aref rollback 1))) (surface (and (tp--prepared-surface-p prepared) - (tp--prepared-surface-surface prepared)))) + (tp--prepared-surface-surface prepared))) + (context (and surface (tp--prepared-surface-context prepared))) + (commit-batch + (and surface (tp--prepared-surface-commit-batch prepared))) + (expected (and surface + (tp-publication-target-entry-shadow-expected entry))) + (commit-expected (and expected (plist-get expected :commit))) + (rollback-expected (and expected (plist-get expected :rollback)))) (unless - (and surface snapshot + (and surface (tp--surface-snapshot-p snapshot) + (tp-prepare-context-p context) + (tp--context-active context) + (eq (tp--context-surface context) surface) (tp--publication-target-entry-bound-p entry (tp-publication-batch-candidate-transaction-id candidate) @@ -3609,6 +3622,8 @@ JOURNALS and VIEWS are exact references to the shared rollback state." (tp--surface-buffer surface)) (= (tp-publication-target-entry-old-revision entry) (tp--surface-snapshot-revision snapshot)) + (= (tp-publication-target-entry-old-revision entry) + (tp--surface-revision surface)) (= (tp-publication-target-entry-new-revision entry) (1+ (tp--surface-snapshot-revision snapshot))) (eq (tp-publication-target-entry-plan entry) @@ -3619,8 +3634,20 @@ JOURNALS and VIEWS are exact references to the shared rollback state." (tp--prepared-surface-objects prepared)) (eq (tp-publication-target-entry-ranges entry) (tp--prepared-surface-mount-specs prepared)) - (equal (tp-publication-target-entry-client-state entry) - (tp--prepared-surface-client-state prepared)) + (eq (tp-publication-target-entry-client-state entry) + (tp--prepared-surface-client-state prepared)) + (eq (tp-publication-target-entry-diff entry) commit-batch) + (or + (null commit-batch) + (and + (= (tp-publication-target-entry-old-revision entry) + (tp-commit-batch-base-revision commit-batch)) + (= (tp-publication-target-entry-new-revision entry) + (tp-commit-batch-target-revision commit-batch)) + (= (tp-commit-batch-base-extent commit-batch) + (length (plist-get rollback-expected :output))) + (= (tp-commit-batch-target-extent commit-batch) + (length (plist-get commit-expected :output))))) (= (tp-publication-target-entry-mapping-generation entry) tp--surface-transaction-id)) (signal 'tp-publication-binding-error diff --git a/tp-transaction.el b/tp-transaction.el index 2620d23..7395988 100644 --- a/tp-transaction.el +++ b/tp-transaction.el @@ -115,6 +115,20 @@ (shadow-validator nil :read-only t) rollback-result post-rollback-state shadow-actual shadow-proven-p) +(defun tp--publication-target-entry-arguments-valid-p + (transaction-id batch-id candidate-id surface-id mount-ids buffer + old-revision new-revision authority-token shadow-validator) + "Return non-nil when target arguments bind TRANSACTION-ID and BATCH-ID. +CANDIDATE-ID, SURFACE-ID, MOUNT-IDS, BUFFER, OLD-REVISION, NEW-REVISION, +AUTHORITY-TOKEN, and SHADOW-VALIDATOR must have valid publication shapes." + (and transaction-id batch-id candidate-id surface-id + (bufferp buffer) (buffer-live-p buffer) + (integerp old-revision) (>= old-revision 0) + (integerp new-revision) (= new-revision (1+ old-revision)) + (tp--proper-unique-list-p mount-ids) + authority-token + (or (null shadow-validator) (functionp shadow-validator)))) + (cl-defun tp--publication-target-entry-create (&key transaction-id batch-id candidate-id surface-id mount-ids buffer old-revision new-revision plan diff ledger objects ranges client-state @@ -126,13 +140,9 @@ DIFF, LEDGER, OBJECTS, RANGES, CLIENT-STATE, ROLLBACK-SNAPSHOT, and AUTHORITY-TOKEN describe the target. MAPPING-GENERATION is optional. OPERATION-COUNTS is filled from the live report. SHADOW-EXPECTED and SHADOW-VALIDATOR are private comparison artifacts." - (unless (and transaction-id batch-id candidate-id surface-id - (bufferp buffer) (buffer-live-p buffer) - (integerp old-revision) (>= old-revision 0) - (integerp new-revision) (= new-revision (1+ old-revision)) - (tp--proper-unique-list-p mount-ids) - authority-token - (or (null shadow-validator) (functionp shadow-validator))) + (unless (tp--publication-target-entry-arguments-valid-p + transaction-id batch-id candidate-id surface-id mount-ids buffer + old-revision new-revision authority-token shadow-validator) (signal 'tp-publication-binding-error (list :target-entry transaction-id batch-id candidate-id surface-id buffer old-revision new-revision mount-ids authority-token)))