;;; ebox-spi-tests.el --- M2a framework provider SPI gates -*- lexical-binding: t; -*-

;;; Code:

(require 'ert)
(require 'cl-lib)
(require 'benchmark)
(require 'ebox)
(require 'ebox-spi)
(require 'ebox-fixtures)

(defconst ebox-spi-test--root
  (expand-file-name ".." (file-name-directory (or load-file-name buffer-file-name)))
  "Repository root used by provider SPI tests.")

(defun ebox-spi-test--source (file)
  "Return repository FILE as text."
  (with-temp-buffer
    (insert-file-contents (expand-file-name file ebox-spi-test--root))
    (buffer-string)))

(defun ebox-spi-test--reset-runtime-state ()
  "Reset identities and compatibility mirrors used by SPI tests."
  (setq ebox--region-id-counter 0
        ebox--runtime-node-id-counter 0)
  (dolist (table (list ebox--region-box-table
                       ebox--buffer-render-state-table
                       ebox--scroll-global-state))
    (when (hash-table-p table) (clrhash table))))

(ert-deftest ebox-spi-provider-schema-is-complete-and-defensive ()
  "The additive v2 provider exposes one complete immutable snapshot."
  (let* ((first (ebox-framework-spi-capabilities))
         (second (ebox-framework-spi-capabilities))
         (initial (ebox-framework-spi-provider-initial-operation first))
         (update (ebox-framework-spi-provider-update-operation first)))
    (should (featurep 'ebox-framework-spi-v2))
    (should (ebox-framework-spi-validate-provider first))
    (should-not (eq first second))
    (should (= (ebox-framework-spi-provider-spi-version first) 2))
    (should (eq (ebox-framework-spi-provider-schema-version first)
                'ebox-framework-spi-schema/v2))
    (should (eq (ebox-framework-spi-provider-tp-protocol first)
                'tp-transaction-protocol-v1+v2))
    (should
     (equal (ebox-framework-spi-provider-capabilities first)
            '(initial-paired-stage-rollback
              update-paired-stage-rollback
              combined-participant-ordering
              same-object-legacy-report
              initial-observation-replay)))
    (should
     (equal (ebox-framework-spi-provider-stage-order first)
            '(ebox-mirror/native framework-stage)))
    (should
     (equal (ebox-framework-spi-provider-rollback-order first)
            '(framework-rollback ebox-mirror/native tp)))
    (should (eq (ebox-framework-spi-provider-report-semantics first)
                'same-object-legacy-report))
    (should (eq (ebox-framework-spi-operation-kind initial) 'initial))
    (should (eq (ebox-framework-spi-operation-function initial)
                'ebox-framework-spi-initial))
    (should
     (equal (ebox-framework-spi-operation-argument-schema initial)
            '(buffer canonical-input framework-stage framework-rollback)))
    (should (eq (ebox-framework-spi-operation-result-schema initial)
                'ebox-legacy-report/same-object))
    (should (eq (ebox-framework-spi-operation-paired-stage-rollback-p initial)
                t))
    (should (eq (ebox-framework-spi-operation-kind update) 'update))
    (should (eq (ebox-framework-spi-operation-function update)
                'ebox-framework-spi-update))
    (should
     (equal (ebox-framework-spi-operation-argument-schema update)
            '(buffer canonical-input-or-candidate
              framework-stage framework-rollback)))
    (should (eq (ebox-framework-spi-operation-result-schema update)
                'ebox-legacy-report/same-object))
    (should (eq (ebox-framework-spi-operation-paired-stage-rollback-p update)
                t))
    (should-error
     (eval
      `(setf (ebox-framework-spi-provider-spi-version ',first) 3)))
    (should-error
     (eval
      `(setf (ebox-framework-spi-operation-kind ',initial) 'broken)))
    (let ((capabilities (ebox-framework-spi-provider-capabilities first))
          (stage-order (ebox-framework-spi-provider-stage-order first))
          (rollback-order (ebox-framework-spi-provider-rollback-order first))
          (arguments (ebox-framework-spi-operation-argument-schema initial)))
      (setcar capabilities 'mutated)
      (setcar stage-order 'mutated)
      (setcar rollback-order 'mutated)
      (setcar arguments 'mutated))
    (should (ebox-framework-spi-validate-provider first))
    (should (eq (car (ebox-framework-spi-provider-capabilities first))
                'initial-paired-stage-rollback))
    (should (eq (car (ebox-framework-spi-provider-stage-order first))
                'ebox-mirror/native))
    (should (eq (car (ebox-framework-spi-provider-rollback-order first))
                'framework-rollback))
    (should (eq (car (ebox-framework-spi-operation-argument-schema initial))
                'buffer))
    (let ((fresh (ebox-framework-spi-capabilities)))
      (should (eq (car (ebox-framework-spi-provider-capabilities fresh))
                  'initial-paired-stage-rollback))
      (should (eq (car (ebox-framework-spi-operation-argument-schema
                        (ebox-framework-spi-provider-initial-operation fresh)))
                  'buffer)))))

(ert-deftest ebox-spi-provider-is-additive-and-does-not-bootstrap-consumers ()
  "E5 publishes no selected port, consumer probe, or v1 removal."
  (let ((source (ebox-spi-test--source "ebox-spi.el"))
        (facade (ebox-spi-test--source "ebox.el")))
    (dolist (pattern '("featurep" "fboundp" "selected-port"
                       "etaf-renderer-port" "etaf-spi-bootstrap"))
      (should-not (string-match-p (regexp-quote pattern) source)))
    (should (string-match-p "Version: 2.0.1" facade))
    (should (string-match-p "(tp \"1.0.1\")" facade))
    (should (functionp #'ebox-render-to-buffer))
    (should (functionp #'ebox-commit))
    (should (functionp #'ebox-framework-spi-capabilities))))

(ert-deftest ebox-spi-absent-tp-v2-keeps-the-v1-facade-loadable ()
  "An absent TP transaction feature leaves the optional v2 provider absent."
  (let* ((emacs (expand-file-name invocation-name invocation-directory))
         (parent (file-name-directory
                  (directory-file-name ebox-spi-test--root)))
         (ecss (expand-file-name "ecss" parent))
         (tp (expand-file-name "tp" parent))
         (provider-source
          (expand-file-name "ebox-spi.el" ebox-spi-test--root))
         (probe
          (prin1-to-string
           `(progn
              (require 'cl-lib)
              (require 'ebox-canonical)
              (require 'ebox-surface)
              (let ((original-require (symbol-function 'require)))
                (cl-letf (((symbol-function 'require)
                           (lambda (feature &optional filename noerror)
                             (if (eq feature 'tp-transaction)
                                 nil
                               (funcall original-require feature filename
                                        noerror)))))
                  (load ,provider-source nil t)))
              (require 'ebox)
              (unless (featurep 'ebox-spi)
                (error "SPI loader feature is absent"))
              (when (featurep 'ebox-framework-spi-v2)
                (error "v2 provider feature leaked without TP v2"))
              (when (fboundp 'ebox-framework-spi-capabilities)
                (error "v2 provider predicate leaked without TP v2"))
              (unless (and (fboundp 'ebox-render-to-buffer)
                           (fboundp 'ebox-commit))
                (error "v1 Ebox facade failed to load"))))))
    (with-temp-buffer
      (let ((status
             (process-file
              emacs nil (current-buffer) nil
              "-Q" "--batch"
              "-L" ebox-spi-test--root "-L" ecss "-L" tp
              "--eval" "(setq load-prefer-newer t)"
              "--eval" probe)))
        (unless (zerop status)
          (ert-fail (buffer-string)))))))

(ert-deftest ebox-spi-initial-and-update-share-their-legacy-report ()
  "Both operation descriptors preserve paired callbacks and report identity."
  (ebox-spi-test--reset-runtime-state)
  (let* ((provider (ebox-framework-spi-capabilities))
         (initial-function
          (ebox-framework-spi-operation-function
           (ebox-framework-spi-provider-initial-operation provider)))
         (update-function
          (ebox-framework-spi-operation-function
           (ebox-framework-spi-provider-update-operation provider)))
         (buffer (generate-new-buffer " *ebox-m2a-e5-success*"))
         initial-seen update-seen trace)
    (unwind-protect
        (let ((initial-report
               (funcall
                initial-function buffer
                (ebox-test-box :key 'root (ebox-test-text "initial")
                               :width '(96))
                (lambda (report)
                  (setq initial-seen report)
                  (push 'initial-stage trace)
                  (should (eq (plist-get report :framework-participant-state)
                              'published))
                  (let ((surface (ebox-surface--live-buffer-surface buffer)))
                    (should surface)
                    (should
                     (eq (gethash buffer ebox--buffer-render-state-table)
                         (tp-surface-client-state surface))))
                  (plist-put report :framework-token 'initial-token))
                (lambda (_report) (push 'initial-rollback trace)))))
          (should (eq initial-report initial-seen))
          (should (eq (plist-get initial-report :framework-participant-state)
                      'completed))
          (should (eq (plist-get initial-report :framework-token)
                      'initial-token))
          (should (eq (plist-get initial-report :strategy) 'initial-mount))
          (should (equal trace '(initial-stage)))
          (setq trace nil)
          (let ((update-report
                 (funcall
                  update-function buffer
                  (ebox-test-box :key 'root (ebox-test-text "updated")
                                 :width '(96))
                  (lambda (report)
                    (setq update-seen report)
                    (push 'update-stage trace)
                    (plist-put report :framework-token 'update-token))
                  (lambda (_report) (push 'update-rollback trace)))))
            (should (eq update-report update-seen))
            (should (eq (plist-get update-report
                                   :framework-participant-state)
                        'completed))
            (should (eq (plist-get update-report :framework-token)
                        'update-token))
            (should (equal trace '(update-stage)))
            (should (string-match-p
                     "updated"
                     (with-current-buffer buffer
                       (buffer-substring-no-properties
                        (point-min) (point-max)))))))
      (when (buffer-live-p buffer) (kill-buffer buffer)))))

(ert-deftest ebox-spi-initial-replays-observational-provider-reports ()
  "Completed initial reports replay TP then Ebox without mutable authority."
  (ebox-spi-test--reset-runtime-state)
  (let ((buffer (generate-new-buffer " *ebox-m2a-e5-observation*")))
    (unwind-protect
        (let* ((report
                (ebox-framework-spi-initial
                 buffer
                 (ebox-test-box :key 'root (ebox-test-text "observed"))
                 #'ignore #'ignore))
               (reports
                (ebox-framework-spi-initial-observation-reports report)))
          (should (equal (mapcar (lambda (item) (plist-get item :provider))
                                 reports)
                         '(tp ebox)))
          (should (equal (mapcar (lambda (item) (plist-get item :stage))
                                 reports)
                         '(publication mount)))
          (should
           (apply #'=
                  (mapcar (lambda (item)
                            (plist-get item :correlation-id))
                          reports)))
          (dolist (item reports)
            (should (numberp (plist-get item :duration-ms)))
            (should (> (plist-get item :duration-ms) 0.0)))
          (should
           (equal reports
                  (plist-get report
                             :framework-initial-observation-reports)))
          (plist-put (car reports) :provider 'mutated)
          (should-not (plist-member report :provider)))
      (when (buffer-live-p buffer) (kill-buffer buffer)))))

(ert-deftest ebox-spi-native-retirement-failure-is-postaccept-diagnostic ()
  "A contained native retirement failure cannot escape after final accept."
  (ebox-spi-test--reset-runtime-state)
  (let ((buffer (generate-new-buffer " *ebox-m2a-e5-native-retirement*"))
        (diagnostic
         '(:phase native-session-retirement :session-id 7
           :condition (error "release failed"))))
    (unwind-protect
        (cl-letf (((symbol-function 'ebox-surface--settle-native-session)
                   (lambda (&rest _arguments) (list diagnostic))))
          (let ((report
                 (ebox-framework-spi-initial
                  buffer
                  (ebox-test-box :key 'root (ebox-test-text "committed"))
                  #'ignore #'ignore)))
            (should (eq (plist-get report :framework-participant-state)
                        'completed))
            (should
             (equal (plist-get report :framework-participant-diagnostics)
                    (list diagnostic)))
            (should (ebox-surface-buffer-mounted-p buffer))
            (should (equal "committed"
                           (with-current-buffer buffer
                             (buffer-substring-no-properties
                              (point-min) (point-max)))))
            (let ((update-report
                   (ebox-framework-spi-update
                    buffer
                    (ebox-test-box :key 'root (ebox-test-text "updated"))
                    #'ignore #'ignore)))
              (should (eq (plist-get update-report
                                     :framework-participant-state)
                          'completed))
              (should
               (equal
                (plist-get update-report :framework-participant-diagnostics)
                (list diagnostic)))
              (should (equal "updated"
                             (with-current-buffer buffer
                               (buffer-substring-no-properties
                                (point-min) (point-max))))))))
      (when (buffer-live-p buffer) (kill-buffer buffer)))))

(ert-deftest ebox-spi-postaccept-report-failure-never-enters-rollback ()
  "Initial, scoped, and full report-finalization faults stay postaccept."
  (ebox-spi-test--reset-runtime-state)
  (let ((buffer (generate-new-buffer " *ebox-m2a-e5-report-finalization*"))
        (rollback-count 0))
    (unwind-protect
        (cl-letf (((symbol-function 'ebox-surface--participant-complete)
                   (lambda (&rest _arguments)
                     (error "injected report finalization failure"))))
          (cl-labels
              ((assert-completed
                (report)
                (should (eq (plist-get report :framework-participant-state)
                            'completed))
                (should
                 (eq (plist-get
                      (car (plist-get report
                                     :framework-participant-diagnostics))
                      :phase)
                     'framework-report-finalization))))
            (let ((initial-report
                   (ebox-framework-spi-initial
                    buffer
                    (ebox-test-box :key 'root (ebox-test-text "initial"))
                    #'ignore (lambda (_report) (cl-incf rollback-count)))))
              (assert-completed initial-report)
              (should-not
               (ebox-framework-spi-initial-observation-reports
                initial-report)))
            (assert-completed
             (ebox-framework-spi-update
              buffer (ebox-test-box :key 'root (ebox-test-text "scoped"))
              #'ignore (lambda (_report) (cl-incf rollback-count))))
            (let ((candidate (ebox-candidate-begin buffer)))
              (ebox-candidate-replace-root
               candidate
               (ebox-test-box :key 'root (ebox-test-text "full")))
              (assert-completed
               (ebox-framework-spi-update
                buffer candidate #'ignore
                (lambda (_report) (cl-incf rollback-count)))))
            (should (zerop rollback-count))
            (should (string-match-p
                     "full"
                     (with-current-buffer buffer
                       (buffer-substring-no-properties
                        (point-min) (point-max)))))))
      (when (buffer-live-p buffer) (kill-buffer buffer)))))

(ert-deftest ebox-spi-public-unmount-allows-a-fresh-initial-generation ()
  "Public Ebox teardown removes retained authority before a later initial."
  (ebox-spi-test--reset-runtime-state)
  (let ((buffer (generate-new-buffer " *ebox-m2a-e5-remount*")))
    (unwind-protect
        (progn
          (ebox-framework-spi-initial
           buffer (ebox-test-box :key 'root (ebox-test-text "first"))
           #'ignore #'ignore)
          (should (ebox-surface-buffer-mounted-p buffer))
          (should (eq (ebox-unmount-buffer buffer) buffer))
          (should-not (ebox-surface-buffer-mounted-p buffer))
          (ebox-framework-spi-initial
           buffer (ebox-test-box :key 'root (ebox-test-text "second"))
           #'ignore #'ignore)
          (should (ebox-surface-buffer-mounted-p buffer))
          (should (string-match-p
                   "second"
                   (with-current-buffer buffer
                     (buffer-substring-no-properties
                      (point-min) (point-max))))))
      (when (buffer-live-p buffer) (kill-buffer buffer)))))

(ert-deftest ebox-spi-initial-rolls-the-same-report-back ()
  "A later TP failure rolls initial framework and Ebox state back in order."
  (ebox-spi-test--reset-runtime-state)
  (let ((buffer (generate-new-buffer " *ebox-m2a-e5-initial-fault*"))
        (original
         (symbol-function 'tp--run-transaction-precommit-functions))
        stage-report rollback-report trace failure)
    (unwind-protect
        (progn
          (with-current-buffer buffer (insert "sentinel"))
          (cl-letf
              (((symbol-function 'tp--run-transaction-precommit-functions)
                (lambda ()
                  (funcall original)
                  (error "E5 initial later failure"))))
            (setq failure
                  (condition-case condition
                      (ebox-framework-spi-initial
                       buffer
                       (ebox-test-box
                        :key 'root :width '(96) :height 1 :overflow 'scroll
                        (ebox-test-text "zero\none\ntwo\nthree"))
                       (lambda (report)
                         (setq stage-report report)
                         (push 'stage trace)
                         (should (> (hash-table-count
                                     ebox--scroll-global-state)
                                    0)))
                       (lambda (report)
                         (setq rollback-report report)
                         (push 'rollback trace)))
                    (error condition))))
          (should (equal (cadr failure) "E5 initial later failure"))
          (should (equal trace '(rollback stage)))
          (should (eq stage-report rollback-report))
          (should (eq (plist-get stage-report :framework-participant-state)
                      'rolled-back))
          (should-not (ebox-surface-buffer-mounted-p buffer))
          (should-not (gethash buffer ebox--buffer-render-state-table))
          (should (= (hash-table-count ebox--scroll-global-state) 0))
          (should
           (equal (with-current-buffer buffer (buffer-string)) "sentinel")))
      (when (buffer-live-p buffer) (kill-buffer buffer)))))

(ert-deftest ebox-spi-initial-stage-failure-runs-its-pair ()
  "An initial framework-stage error rolls back the same report and mount."
  (ebox-spi-test--reset-runtime-state)
  (let ((buffer (generate-new-buffer " *ebox-m2a-e5-stage-fault*"))
        stage-report rollback-report trace)
    (unwind-protect
        (progn
          (should-error
           (ebox-framework-spi-initial
            buffer
            (ebox-test-box :key 'root (ebox-test-text "rejected"))
            (lambda (report)
              (setq stage-report report)
              (push 'stage trace)
              (error "E5 stage callback failure"))
            (lambda (report)
              (setq rollback-report report)
              (push 'rollback trace))))
          (should (equal trace '(rollback stage)))
          (should (eq stage-report rollback-report))
          (should (eq (plist-get stage-report :framework-participant-state)
                      'rolled-back))
          (should-not (ebox-surface-buffer-mounted-p buffer))
          (should-not (gethash buffer ebox--buffer-render-state-table))
          (should (equal (with-current-buffer buffer (buffer-string)) "")))
      (when (buffer-live-p buffer) (kill-buffer buffer)))))

(ert-deftest ebox-spi-update-rolls-the-same-report-back ()
  "A later TP failure restores update state through the v2 operation."
  (ebox-spi-test--reset-runtime-state)
  (let ((buffer (generate-new-buffer " *ebox-m2a-e5-update-fault*"))
        (original
         (symbol-function 'tp--run-transaction-precommit-functions))
        stage-report rollback-report trace)
    (unwind-protect
        (progn
          (ebox-render-to-buffer
           buffer (ebox-test-box :key 'root (ebox-test-text "old")))
          (let* ((surface (ebox-surface--live-buffer-surface buffer))
                 (state (tp-surface-client-state surface))
                 (revision (tp-surface-revision surface))
                 (contents
                  (with-current-buffer buffer
                    (buffer-substring (point-min) (point-max)))))
            (cl-letf
                (((symbol-function 'tp--run-transaction-precommit-functions)
                  (lambda ()
                    (funcall original)
                    (error "E5 update later failure"))))
              (should-error
               (ebox-framework-spi-update
                buffer
                (ebox-test-box :key 'root (ebox-test-text "rejected"))
                (lambda (report)
                  (setq stage-report report)
                  (push 'stage trace))
                (lambda (report)
                  (setq rollback-report report)
                  (push 'rollback trace)))))
            (should (equal trace '(rollback stage)))
            (should (eq stage-report rollback-report))
            (should (eq (plist-get stage-report
                                   :framework-participant-state)
                        'rolled-back))
            (should (eq (tp-surface-client-state surface) state))
            (should (= (tp-surface-revision surface) revision))
            (should
             (equal-including-properties
              (with-current-buffer buffer
                (buffer-substring (point-min) (point-max)))
              contents))))
      (when (buffer-live-p buffer) (kill-buffer buffer)))))

(ert-deftest ebox-spi-rejects-malformed-pairs-and-provider-records ()
  "Provider-side schemas reject malformed callbacks and capability records."
  (let ((buffer (generate-new-buffer " *ebox-m2a-e5-invalid*"))
        (input (ebox-test-box :key 'root (ebox-test-text "invalid")))
        (valid (ebox-framework-spi-capabilities)))
    (unwind-protect
        (progn
          (should-error
           (ebox-framework-spi-initial buffer input nil #'ignore)
           :type 'wrong-type-argument)
          (should-error
           (ebox-framework-spi-initial buffer input #'ignore nil)
           :type 'wrong-type-argument)
          (should-error
           (ebox-framework-spi-update buffer input 7 #'ignore)
           :type 'wrong-type-argument)
          (should-error
           (ebox-framework-spi-validate-provider
            (ebox-framework-spi--make-provider
             :spi-version 99
             :schema-version 'broken
             :capabilities nil
             :tp-protocol 'broken))
           :type 'ebox-framework-spi-provider-error)
          (should-error
           (ebox-framework-spi-validate-provider
            (ebox-framework-spi--make-provider
             :spi-version 2
             :schema-version 'ebox-framework-spi-schema/v2
             :capabilities
             '(initial-paired-stage-rollback
               update-paired-stage-rollback
               combined-participant-ordering
               same-object-legacy-report)
             :tp-protocol 'tp-transaction-protocol-v1+v2
             :stage-order '(ebox-mirror/native framework-stage)
             :rollback-order '(framework-rollback ebox-mirror/native tp)
             :report-semantics 'same-object-legacy-report
             :initial-operation
             (ebox-framework-spi--make-operation
              :kind 'initial
              :function 'ebox-framework-spi-initial
              :argument-schema
              '(buffer canonical-input framework-stage framework-rollback)
              :result-schema 'broken
              :paired-stage-rollback-p nil)
             :update-operation
             (ebox-framework-spi-provider-update-operation valid)))
           :type 'ebox-framework-spi-provider-error))
      (when (buffer-live-p buffer) (kill-buffer buffer)))))

(ert-deftest ebox-spi-performance-builds-bounded-provider-snapshots ()
  "Capability access constructs one provider and two operations per call."
  (let ((provider-count 0)
        (operation-count 0)
        (provider-constructor
         (symbol-function 'ebox-framework-spi--make-provider))
        (operation-factory
         (symbol-function 'ebox-framework-spi--operation))
        benchmark last)
    (cl-letf (((symbol-function 'ebox-framework-spi--make-provider)
               (lambda (&rest arguments)
                 (cl-incf provider-count)
                 (apply provider-constructor arguments)))
              ((symbol-function 'ebox-framework-spi--operation)
               (lambda (&rest arguments)
                 (cl-incf operation-count)
                 (apply operation-factory arguments))))
      (setq benchmark
            (benchmark-run
              1
              (dotimes (_iteration 1000)
                (setq last (ebox-framework-spi-capabilities))))))
    (should (ebox-framework-spi-provider-p last))
    (should (= provider-count 1000))
    (should (= operation-count 2000))
    (should (< (car benchmark) 2.0))))

(provide 'ebox-spi-tests)

;;; ebox-spi-tests.el ends here