chore: freeze verified etaf-sqlite baseline before C1b
This commit is contained in:
Kinneyzhang
parent
fc0ec68447
commit
911e08767a
@ -13,9 +13,14 @@
|
||||
(database (etaf-sqlite-database "~/items.sqlite" table))
|
||||
(source (etaf-sqlite-source database)))
|
||||
(etaf-sqlite-initialize database)
|
||||
(etaf-data-controller source :auto-load t))
|
||||
(etaf-data-controller source :auto-load t))
|
||||
```
|
||||
|
||||
The source keeps the legacy `:mutate` callback by default. The additive
|
||||
commit-certified wrapper is opt-in: use `(etaf-sqlite-source database
|
||||
:mutate-v2 t)` when a controller needs explicit commit/rollback certainty and
|
||||
read-only reconciliation.
|
||||
|
||||
Other databases, REST services, files, and ORMs should implement the same source capability in their own packages; they do not belong in ETAF core or in a generic `etaf-adapters` layer.
|
||||
|
||||
Run `make check EMACS=/Applications/Emacs.app/Contents/MacOS/Emacs` from this directory.
|
||||
|
||||
@ -16,6 +16,10 @@
|
||||
(etaf-data-controller source :auto-load t))
|
||||
```
|
||||
|
||||
默认 source 仍只暴露兼容的 `:mutate` callback。需要明确的提交/回滚确定性
|
||||
和只读 reconciliation 时，显式使用 `(etaf-sqlite-source database
|
||||
:mutate-v2 t)` 开启增量 wrapper。
|
||||
|
||||
其他数据库、REST、文件和 ORM 应在各自的具体数据源包中实现同一个 source capability；它们不进入 ETAF core，也不创建笼统的 `etaf-adapters` 层。
|
||||
|
||||
在该目录运行 `make check EMACS=/Applications/Emacs.app/Contents/MacOS/Emacs`。
|
||||
|
||||
155
etaf-sqlite.el
155
etaf-sqlite.el
@ -25,6 +25,19 @@
|
||||
'etaf-sqlite-error)
|
||||
(define-error 'etaf-sqlite-unavailable "SQLite is unavailable"
|
||||
'etaf-sqlite-error)
|
||||
(define-error 'etaf-sqlite-commit-unknown
|
||||
"SQLite commit outcome is unknown"
|
||||
'etaf-sqlite-error)
|
||||
|
||||
;; Opaque tokens let Data reconcile a committed external mutation without
|
||||
;; coupling itself to SQLite connection or transaction objects.
|
||||
(defvar etaf-sqlite--reconciliation-sequence 0)
|
||||
(defvar etaf-sqlite--mutation-active nil)
|
||||
(defvar etaf-sqlite--mutation-phase nil)
|
||||
|
||||
(defun etaf-sqlite--reconciliation-token ()
|
||||
"Return a fresh opaque token for one SQLite mutation outcome."
|
||||
(list :etaf-sqlite (cl-incf etaf-sqlite--reconciliation-sequence)))
|
||||
|
||||
(cl-defstruct (etaf-sqlite--column
|
||||
(:constructor etaf-sqlite--column-create))
|
||||
@ -143,7 +156,12 @@ validated once and never comes from a runtime query."
|
||||
(signal 'etaf-sqlite-unavailable nil)))
|
||||
|
||||
(defun etaf-sqlite--call (database function)
|
||||
"Call FUNCTION with a short-lived connection for DATABASE."
|
||||
"Call FUNCTION with a short-lived connection for DATABASE.
|
||||
|
||||
Keep a cleanup failure after a successful mutation conservative: the write may
|
||||
already have committed even though closing the connection signalled. When the
|
||||
body already failed, preserve that primary condition so transaction certainty
|
||||
is determined by the transaction phase rather than by cleanup noise."
|
||||
(etaf-sqlite--require-available)
|
||||
(let* ((file (etaf-sqlite--database-file database))
|
||||
(directory (file-name-directory file))
|
||||
@ -151,20 +169,67 @@ validated once and never comes from a runtime query."
|
||||
(when directory
|
||||
(make-directory directory t))
|
||||
(setq connection (sqlite-open file))
|
||||
(unwind-protect
|
||||
(funcall function connection)
|
||||
(when (sqlitep connection)
|
||||
(sqlite-close connection)))))
|
||||
(let (result body-condition close-condition)
|
||||
;; Keep the connection cleanup on all non-local exits, including a
|
||||
;; caller's `throw'. Error and quit conditions are captured so cleanup
|
||||
;; failures can be classified without masking the primary condition.
|
||||
(unwind-protect
|
||||
(condition-case err
|
||||
(setq result (funcall function connection))
|
||||
((error quit)
|
||||
(setq body-condition err)))
|
||||
(when (sqlitep connection)
|
||||
(condition-case err
|
||||
(sqlite-close connection)
|
||||
((error quit)
|
||||
(setq close-condition err))))
|
||||
)
|
||||
(when (and close-condition
|
||||
etaf-sqlite--mutation-active
|
||||
(memq etaf-sqlite--mutation-phase '(committed committing))
|
||||
(not (and body-condition
|
||||
(eq (car body-condition)
|
||||
'etaf-sqlite-commit-unknown))))
|
||||
(setq body-condition
|
||||
(list 'etaf-sqlite-commit-unknown
|
||||
(list :failure-phase 'close :error close-condition))))
|
||||
(when (and close-condition (not body-condition))
|
||||
(setq body-condition close-condition))
|
||||
(if body-condition
|
||||
(signal (car body-condition) (cdr body-condition))
|
||||
result))))
|
||||
|
||||
(defun etaf-sqlite--transaction (connection function)
|
||||
"Run FUNCTION in a transaction on CONNECTION and return its value."
|
||||
(sqlite-transaction connection)
|
||||
(condition-case err
|
||||
(prog1 (funcall function connection)
|
||||
(sqlite-commit connection))
|
||||
(error
|
||||
(sqlite-rollback connection)
|
||||
(signal (car err) (cdr err)))))
|
||||
(let ((value
|
||||
(condition-case body-err
|
||||
(funcall function connection)
|
||||
((error quit)
|
||||
(setq etaf-sqlite--mutation-phase 'rolling-back)
|
||||
(let ((rollback-err
|
||||
(condition-case rollback-condition
|
||||
(progn (sqlite-rollback connection) nil)
|
||||
((error quit) rollback-condition))))
|
||||
(if rollback-err
|
||||
(progn
|
||||
(setq etaf-sqlite--mutation-phase 'unknown)
|
||||
(signal 'etaf-sqlite-commit-unknown
|
||||
(list :failure-phase 'rollback
|
||||
:error body-err
|
||||
:rollback-error rollback-err)))
|
||||
(setq etaf-sqlite--mutation-phase 'rolled-back)
|
||||
(signal (car body-err) (cdr body-err))))))))
|
||||
(condition-case commit-err
|
||||
(progn
|
||||
(setq etaf-sqlite--mutation-phase 'committing)
|
||||
(sqlite-commit connection)
|
||||
(setq etaf-sqlite--mutation-phase 'committed)
|
||||
value)
|
||||
((error quit)
|
||||
(setq etaf-sqlite--mutation-phase 'unknown)
|
||||
(signal 'etaf-sqlite-commit-unknown
|
||||
(list :failure-phase 'commit :error commit-err))))))
|
||||
|
||||
(defun etaf-sqlite--sql-type (type)
|
||||
"Return SQLite DDL type for TYPE."
|
||||
@ -319,9 +384,11 @@ exposing the inserted identity and affected row count to application code."
|
||||
(unless primary
|
||||
(signal 'etaf-sqlite-schema-error
|
||||
(list "Mutations require a primary key")))
|
||||
(etaf-sqlite--call
|
||||
database
|
||||
(lambda (connection)
|
||||
(let ((etaf-sqlite--mutation-active t)
|
||||
(etaf-sqlite--mutation-phase 'body))
|
||||
(etaf-sqlite--call
|
||||
database
|
||||
(lambda (connection)
|
||||
(etaf-sqlite--transaction
|
||||
connection
|
||||
(lambda (transaction-connection)
|
||||
@ -405,27 +472,67 @@ exposing the inserted identity and affected row count to application code."
|
||||
(list (format "Unsupported SQLite mutation: %S"
|
||||
operation)))))))
|
||||
(etaf-sqlite--mutation-result
|
||||
transaction-connection operation value))))))))
|
||||
transaction-connection operation value)))))))))
|
||||
|
||||
(defun etaf-sqlite--mutate-v2 (database operation payload)
|
||||
"Return a commit-certified outcome for DATABASE mutation OPERATION and PAYLOAD.
|
||||
|
||||
This optional capability deliberately does not replace the v1 `:mutate'
|
||||
callback. Successful transactions return `:certainty committed' and a
|
||||
reconciliation token. A body failure is `:certainty rolled-back' only when
|
||||
rollback succeeds; commit, rollback, or close uncertainty is returned as
|
||||
`:certainty external-unknown' with the original condition in `:error'."
|
||||
(let ((token (etaf-sqlite--reconciliation-token)))
|
||||
(condition-case err
|
||||
(let ((result (etaf-sqlite--mutate database operation payload)))
|
||||
(list :certainty 'committed
|
||||
:external-commit-certainty 'committed
|
||||
:operation operation
|
||||
:result result
|
||||
:mutation-result result
|
||||
:reconciliation-token token))
|
||||
((error quit)
|
||||
(list :certainty (if (eq (car err) 'etaf-sqlite-commit-unknown)
|
||||
'external-unknown
|
||||
'rolled-back)
|
||||
:external-commit-certainty
|
||||
(if (eq (car err) 'etaf-sqlite-commit-unknown)
|
||||
'external-unknown
|
||||
'rolled-back)
|
||||
:operation operation
|
||||
:error err
|
||||
:reconciliation-token token)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun etaf-sqlite-source (database)
|
||||
(cl-defun etaf-sqlite-source (database &key mutate-v2)
|
||||
"Return an `etaf-data-source' backed by DATABASE.
|
||||
|
||||
The source accepts equality plist/alist queries and supports `insert',
|
||||
`replace', `update', and `delete' mutations. Mutation results include the
|
||||
operation, affected row count, and inserted identity when applicable. Every
|
||||
operation uses a short connection; controllers remain the owner of reactive
|
||||
state and lifecycle."
|
||||
state and lifecycle. The legacy `:mutate' capability is exposed by default.
|
||||
When MUTATE-V2 is non-nil, add the opt-in `:mutate-v2' capability that returns
|
||||
explicit commit/rollback certainty and an opaque reconciliation token."
|
||||
(unless (etaf-sqlite--database-p database)
|
||||
(signal 'wrong-type-argument
|
||||
(list 'etaf-sqlite-database-p database)))
|
||||
(etaf-data-source
|
||||
:name 'etaf-sqlite
|
||||
:provider 'sqlite
|
||||
:load (lambda (query page page-size)
|
||||
(etaf-sqlite--select-items database query page page-size))
|
||||
:mutate (lambda (operation payload)
|
||||
(etaf-sqlite--mutate database operation payload))))
|
||||
(let ((capabilities
|
||||
(list :name 'etaf-sqlite
|
||||
:provider 'sqlite
|
||||
:load (lambda (query page page-size)
|
||||
(etaf-sqlite--select-items database query page page-size))
|
||||
:mutate (lambda (operation payload)
|
||||
(etaf-sqlite--mutate database operation payload)))))
|
||||
;; Keep the typed wrapper opt-in. The M4a additive path must not silently
|
||||
;; change existing SQLite controllers from the v1 callback contract.
|
||||
(when mutate-v2
|
||||
(setq capabilities
|
||||
(append capabilities
|
||||
(list :mutate-v2
|
||||
(lambda (operation payload)
|
||||
(etaf-sqlite--mutate-v2 database operation payload))))))
|
||||
(apply #'etaf-data-source capabilities)))
|
||||
|
||||
(provide 'etaf-sqlite)
|
||||
|
||||
|
||||
@ -88,8 +88,120 @@
|
||||
(should (eq 'sqlite (plist-get source :provider)))
|
||||
(should (functionp (plist-get source :load)))
|
||||
(should (functionp (plist-get source :mutate)))
|
||||
(should-not (plist-member source :mutate-v2))
|
||||
(should (functionp
|
||||
(plist-get (etaf-sqlite-source database :mutate-v2 t)
|
||||
:mutate-v2)))
|
||||
(should-not (plist-member source :dispose)))))
|
||||
|
||||
(ert-deftest etaf-sqlite-v2-mutation-outcome-reports-commit ()
|
||||
"The optional v2 capability reports a committed transaction and token."
|
||||
(etaf-sqlite-test--with-database (database)
|
||||
(let* ((source (etaf-sqlite-source database :mutate-v2 t))
|
||||
(mutate-v2 (plist-get source :mutate-v2))
|
||||
(outcome (funcall mutate-v2 'insert
|
||||
'(:id 3 :name "Alan" :score 30))))
|
||||
(should (eq (plist-get outcome :certainty) 'committed))
|
||||
(should (plist-get outcome :reconciliation-token))
|
||||
(should (equal (plist-get (plist-get outcome :result) :operation)
|
||||
'insert))
|
||||
(should (= (plist-get (plist-get outcome :result) :id) 3)))))
|
||||
|
||||
(ert-deftest etaf-sqlite-v2-mutation-outcome-reports-rollback ()
|
||||
"A failed v2 mutation reports rollback and preserves the original error."
|
||||
(etaf-sqlite-test--with-database (database)
|
||||
(let* ((source (etaf-sqlite-source database :mutate-v2 t))
|
||||
(mutate-v2 (plist-get source :mutate-v2))
|
||||
(outcome (funcall mutate-v2 'insert
|
||||
'(:id 1 :name "Duplicate" :score 99)))
|
||||
(loaded (funcall (plist-get source :load) nil 1 20)))
|
||||
(should (eq (plist-get outcome :certainty) 'rolled-back))
|
||||
(should (consp (plist-get outcome :error)))
|
||||
(should (plist-get outcome :reconciliation-token))
|
||||
(should (= (plist-get loaded :total) 2)))))
|
||||
|
||||
(ert-deftest etaf-sqlite-committed-mutation-load-failure-is-read-only-retry ()
|
||||
"A committed SQLite row survives a failed projection read and retries safely."
|
||||
(etaf-sqlite-test--with-database (database)
|
||||
(let* ((base (etaf-sqlite-source database :mutate-v2 t))
|
||||
(base-load (plist-get base :load))
|
||||
(base-mutate-v2 (plist-get base :mutate-v2))
|
||||
(load-count 0)
|
||||
(mutate-count 0)
|
||||
(fail-load t)
|
||||
(source (copy-sequence base)))
|
||||
(setf (plist-get source :load)
|
||||
(lambda (&rest args)
|
||||
(cl-incf load-count)
|
||||
(if fail-load
|
||||
(error "injected reconciliation read failure")
|
||||
(apply base-load args))))
|
||||
(setf (plist-get source :mutate-v2)
|
||||
(lambda (operation payload)
|
||||
(cl-incf mutate-count)
|
||||
(funcall base-mutate-v2 operation payload)))
|
||||
(let* ((initial (funcall base-load nil 1 20))
|
||||
(controller (etaf-data-controller source :initial-result initial))
|
||||
captured)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(condition-case condition
|
||||
(etaf-data-mutate
|
||||
controller 'insert '(:id 3 :name "Alan" :score 30))
|
||||
(error (setq captured condition)))
|
||||
(should captured)
|
||||
(should (etaf-data-condition-projection-info captured))
|
||||
(should (= mutate-count 1))
|
||||
(should (= load-count 1))
|
||||
(should (equal '(1 2)
|
||||
(mapcar (lambda (row) (plist-get row :id))
|
||||
(etaf-value (etaf-data-items controller)))))
|
||||
(should (= 3
|
||||
(plist-get (funcall base-load nil 1 20) :total)))
|
||||
(setq fail-load nil)
|
||||
(etaf-data-retry-reconciliation controller)
|
||||
(should (= mutate-count 1))
|
||||
(should (= load-count 2))
|
||||
(should (eq 'success (etaf-value (etaf-data-status controller))))
|
||||
(should (equal '(1 2 3)
|
||||
(mapcar (lambda (row) (plist-get row :id))
|
||||
(etaf-value (etaf-data-items controller)))))
|
||||
(should (eq 'projected
|
||||
(etaf-data-reconciliation-state controller))))
|
||||
(etaf-data-stop controller))))))
|
||||
|
||||
(ert-deftest etaf-sqlite-v2-post-commit-signal-reports-unknown ()
|
||||
"A signal after sqlite-commit must not claim the committed write rolled back."
|
||||
(etaf-sqlite-test--with-database (database)
|
||||
(let* ((source (etaf-sqlite-source database :mutate-v2 t))
|
||||
(mutate-v2 (plist-get source :mutate-v2))
|
||||
(original-commit (symbol-function 'sqlite-commit))
|
||||
(outcome
|
||||
(cl-letf (((symbol-function 'sqlite-commit)
|
||||
(lambda (connection)
|
||||
(funcall original-commit connection)
|
||||
(error "post-commit fault"))))
|
||||
(funcall mutate-v2 'insert
|
||||
'(:id 3 :name "Committed" :score 30))))
|
||||
(loaded (funcall (plist-get source :load) nil 1 20)))
|
||||
(should (eq (plist-get outcome :certainty) 'external-unknown))
|
||||
(should (= (plist-get loaded :total) 3)))))
|
||||
|
||||
(ert-deftest etaf-sqlite-v2-close-after-commit-reports-unknown ()
|
||||
"A close signal after commit is also external uncertainty."
|
||||
(etaf-sqlite-test--with-database (database)
|
||||
(let* ((source (etaf-sqlite-source database :mutate-v2 t))
|
||||
(mutate-v2 (plist-get source :mutate-v2))
|
||||
(original-close (symbol-function 'sqlite-close))
|
||||
(outcome
|
||||
(cl-letf (((symbol-function 'sqlite-close)
|
||||
(lambda (connection)
|
||||
(funcall original-close connection)
|
||||
(error "post-commit close fault"))))
|
||||
(funcall mutate-v2 'insert
|
||||
'(:id 3 :name "Committed" :score 30)))))
|
||||
(should (eq (plist-get outcome :certainty) 'external-unknown)))))
|
||||
|
||||
(provide 'etaf-sqlite-tests)
|
||||
|
||||
;;; etaf-sqlite-tests.el ends here
|
||||
|
||||
Loading…
Reference in New Issue
Block a user