branch: elpa/jabber
commit 28382b54ef549ffd7b07446b7ef6e49ddbf62746
Author: Thanos Apollo <[email protected]>
Commit: Thanos Apollo <[email protected]>
db: Persist reply metadata across buffer reloads
---
CHANGELOG.org | 1 +
lisp/jabber-chat.el | 13 +++-
lisp/jabber-db.el | 150 +++++++++++++++++++++++++++++++++++++++-------
lisp/jabber-mam.el | 3 +-
tests/jabber-test-chat.el | 23 +++++++
tests/jabber-test-db.el | 116 ++++++++++++++++++++++++++++++++++-
6 files changed, 280 insertions(+), 26 deletions(-)
diff --git a/CHANGELOG.org b/CHANGELOG.org
index fe7ac2a014..6d86808dd8 100644
--- a/CHANGELOG.org
+++ b/CHANGELOG.org
@@ -3,6 +3,7 @@
* [Unreleased]
** Added
+- Reply context survives buffer reloads: reply metadata is now stored in the
message database
- Outgoing messages carry an XEP-0359 origin-id, so replies from other clients
reference a stable id
- OMEMO signed pre-keys now rotate automatically on connect
(~jabber-omemo-signed-pre-key-rotation-period~, 7 days default)
diff --git a/lisp/jabber-chat.el b/lisp/jabber-chat.el
index b38645a9f9..e0cd72c429 100644
--- a/lisp/jabber-chat.el
+++ b/lisp/jabber-chat.el
@@ -232,13 +232,19 @@ added to the outgoing message.")
Hooks holding state for the next composed message (e.g. pending
reply data) should stay inert instead of consuming it.")
+(defvar jabber-chat--send-hook-stanza nil
+ "The outgoing stanza, bound while `jabber-chat-send-hooks' run.
+Lets late hooks (e.g. the DB store) read elements that earlier
+hooks attached, without changing the (BODY ID) hook signature.")
+
(defun jabber-chat--run-send-hooks (stanza body id)
"Run `jabber-chat-send-hooks' and nconc results onto STANZA.
BODY and ID are passed to each hook function.
When STANZA is an XEP-0308 correction, the hooks run with
`jabber-chat--sending-correction' bound non-nil so that hooks
holding state for the next composed message stay inert."
- (let ((jabber-chat--sending-correction
+ (let ((jabber-chat--send-hook-stanza stanza)
+ (jabber-chat--sending-correction
(and (jabber-xml-child-with-xmlns
stanza "urn:xmpp:message-correct:0")
t)))
@@ -282,7 +288,7 @@ holding state for the next composed message stay inert."
(account peer direction type body timestamp
&optional resource stanza-id
server-id occupant-id oob-entries
- encrypted))
+ encrypted reply))
(declare-function jabber-db--extract-occupant-id "jabber-db.el" (xml-data))
(declare-function jabber-message-correct--replace-id "jabber-message-correct"
(xml-data))
@@ -593,7 +599,8 @@ updates the original row instead."
(when from (jabber-jid-resource from))
stanza-id
nil (jabber-db--extract-occupant-id xml-data) nil
- encrypted)))))
+ encrypted
+ (jabber-chat--reply-fields xml-data))))))
(defun jabber-chat--select-buffer (jc from &optional carbon-buffer)
"Return the chat buffer for an incoming message from FROM.
diff --git a/lisp/jabber-db.el b/lisp/jabber-db.el
index f23a36463d..cb8cb2c9b7 100644
--- a/lisp/jabber-db.el
+++ b/lisp/jabber-db.el
@@ -103,7 +103,11 @@ in the message history.")
displayed_at INTEGER,
retracted_by TEXT,
retraction_reason TEXT,
- edited INTEGER DEFAULT 0)"
+ edited INTEGER DEFAULT 0,
+ reply_to_id TEXT,
+ reply_to_jid TEXT,
+ fallback_start INTEGER,
+ fallback_end INTEGER)"
"CREATE INDEX IF NOT EXISTS idx_msg_peer_ts
ON message(account, peer, timestamp)"
"CREATE INDEX IF NOT EXISTS idx_msg_stanza_id
@@ -263,7 +267,7 @@ WHERE updated_at < (
(jabber-db--ensure-reaction-actor-table db)
(jabber-db--backfill-reaction-actors db)))
-(defconst jabber-db--schema-version 6
+(defconst jabber-db--schema-version 7
"Current schema version.
Bump this when adding migrations. A database whose version
exceeds this value is from a newer (or development) build and
@@ -353,6 +357,12 @@ CREATE INDEX IF NOT EXISTS idx_reaction_message_id
(sqlite-execute db "PRAGMA user_version=6")
(setq version 6))
(when (= version 6)
+ (dolist (col '("reply_to_id TEXT" "reply_to_jid TEXT"
+ "fallback_start INTEGER" "fallback_end INTEGER"))
+ (sqlite-execute db (concat "ALTER TABLE message ADD COLUMN " col)))
+ (sqlite-execute db "PRAGMA user_version=7")
+ (setq version 7))
+ (when (= version 7)
(jabber-db--repair-reaction-actors db))))
(defun jabber-db-ensure-open ()
@@ -445,6 +455,61 @@ SELECT identities, features FROM caps_cache
;;; Storage
+(defun jabber-db--extract-reply-fields (xml-data)
+ "Return XEP-0461 reply metadata in XML-DATA as a plist, or nil.
+Keys are :reply-to-id, :reply-to-jid and :fallback-range. Mirrors
+`jabber-chat--reply-fields' in jabber-chat.el; duplicated here for
+the same layering reason as `jabber-db--stanza-id-element'."
+ (and-let* ((reply-el
+ (seq-find
+ (lambda (child)
+ (and (eq (jabber-xml-node-name child) 'reply)
+ (equal (jabber-xml-get-xmlns child)
+ "urn:xmpp:reply:0")))
+ (jabber-xml-node-children xml-data))))
+ (list :reply-to-id (jabber-xml-get-attribute reply-el 'id)
+ :reply-to-jid (jabber-xml-get-attribute reply-el 'to)
+ :fallback-range (jabber-db--reply-fallback-range xml-data))))
+
+(defun jabber-db--reply-fallback-range (xml-data)
+ "Return the XEP-0428 fallback range for replies in XML-DATA.
+Same return values as `jabber-chat--reply-fallback-range': a
+\(START END) list, `all', or nil."
+ (when-let* ((fallback
+ (seq-find
+ (lambda (child)
+ (and (eq (jabber-xml-node-name child) 'fallback)
+ (equal (jabber-xml-get-xmlns child)
+ "urn:xmpp:fallback:0")
+ (equal (jabber-xml-get-attribute child 'for)
+ "urn:xmpp:reply:0")))
+ (jabber-xml-node-children xml-data))))
+ (if-let* ((body (car (jabber-xml-get-children fallback 'body))))
+ (let ((start (jabber-xml-get-attribute body 'start))
+ (end (jabber-xml-get-attribute body 'end)))
+ (if (or start end)
+ (and start end
+ (string-match-p "\\`[0-9]+\\'" start)
+ (string-match-p "\\`[0-9]+\\'" end)
+ (list (string-to-number start) (string-to-number end)))
+ 'all))
+ 'all)))
+
+(defun jabber-db--fallback-range-cols (range)
+ "Encode RANGE for storage as a (START . END) cons of column values.
+RANGE is nil, `all', or a (START END) list; `all' is stored
+as -1/-1, nil as NULL/NULL."
+ (pcase range
+ ('all '(-1 . -1))
+ (`(,start ,end) (cons start end))
+ (_ '(nil . nil))))
+
+(defun jabber-db--decode-fallback-range (start end)
+ "Decode fallback columns START and END back into a range value.
+Inverse of `jabber-db--fallback-range-cols'."
+ (cond ((and (eql start -1) (eql end -1)) 'all)
+ ((and start end) (list start end))))
+
(defun jabber-db--detect-duplicate (db account peer timestamp body
stanza-id server-id &optional type)
"Check whether a message for ACCOUNT already exists in DB.
@@ -482,18 +547,26 @@ WHERE account = ? AND peer = ? AND timestamp = ? AND body
= ? LIMIT 1"
(defun jabber-db--insert-message (db account peer resource occupant-id
direction type body timestamp
stanza-id server-id encrypted
- oob-entries)
+ oob-entries reply)
"Insert a new message row into DB for ACCOUNT and attach OOB-ENTRIES.
PEER, RESOURCE, OCCUPANT-ID, DIRECTION, TYPE, BODY, TIMESTAMP,
-STANZA-ID, SERVER-ID and ENCRYPTED fill the corresponding columns."
- (sqlite-execute
- db
- "INSERT INTO message \
+STANZA-ID, SERVER-ID and ENCRYPTED fill the corresponding columns.
+REPLY is a plist from `jabber-db--extract-reply-fields', or nil."
+ (pcase-let ((`(,fb-start . ,fb-end)
+ (jabber-db--fallback-range-cols
+ (plist-get reply :fallback-range))))
+ (sqlite-execute
+ db
+ "INSERT INTO message \
(account, peer, resource, occupant_id, direction, type, body, timestamp, \
-stanza_id, server_id, encrypted) \
-VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)"
- (list account peer resource occupant-id direction type body timestamp
- stanza-id server-id (if encrypted 1 0)))
+stanza_id, server_id, encrypted, reply_to_id, reply_to_jid, \
+fallback_start, fallback_end) \
+VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)"
+ (list account peer resource occupant-id direction type body timestamp
+ stanza-id server-id (if encrypted 1 0)
+ (plist-get reply :reply-to-id)
+ (plist-get reply :reply-to-jid)
+ fb-start fb-end)))
(when oob-entries
(let ((msg-id (caar (sqlite-select db "SELECT last_insert_rowid()"))))
(dolist (entry oob-entries)
@@ -570,10 +643,26 @@ WHERE account = ? AND peer = ? AND timestamp = ? AND body
= ? \
AND stanza_id IS NULL AND server_id IS NULL"
(list stanza-id server-id account peer timestamp body))))
+(defun jabber-db--backfill-reply-fields (db account peer stanza-id reply)
+ "Fill NULL reply columns for ACCOUNT/PEER's row with STANZA-ID from REPLY.
+Completes rows stored before the reply elements were attached to
+the outgoing stanza (e.g. the OMEMO pending echo)."
+ (pcase-let ((`(,fb-start . ,fb-end)
+ (jabber-db--fallback-range-cols
+ (plist-get reply :fallback-range))))
+ (sqlite-execute
+ db
+ "UPDATE message SET reply_to_id = ?, reply_to_jid = ?, \
+fallback_start = ?, fallback_end = ? \
+WHERE stanza_id = ? AND account = ? AND peer = ? AND reply_to_id IS NULL"
+ (list (plist-get reply :reply-to-id)
+ (plist-get reply :reply-to-jid)
+ fb-start fb-end stanza-id account peer))))
+
(defun jabber-db-store-message (account peer direction type body timestamp
&optional resource stanza-id
server-id occupant-id oob-entries
- encrypted)
+ encrypted reply)
"Store a message in the database.
ACCOUNT is the bare JID of the local account.
PEER is the bare JID of the contact or room.
@@ -587,7 +676,9 @@ Optional SERVER-ID is the XEP-0359 server-assigned id.
Optional OCCUPANT-ID is the XEP-0421 occupant id.
Optional OOB-ENTRIES is a list of (URL . DESC) cons cells for
jabber:x:oob elements.
-Optional ENCRYPTED is non-nil if the message was OMEMO-encrypted."
+Optional ENCRYPTED is non-nil if the message was OMEMO-encrypted.
+Optional REPLY is a reply metadata plist from
+`jabber-db--extract-reply-fields'."
(when-let* ((db (jabber-db-ensure-open)))
(let ((dup-id-col (jabber-db--detect-duplicate
db account peer timestamp body stanza-id server-id
@@ -596,11 +687,15 @@ Optional ENCRYPTED is non-nil if the message was
OMEMO-encrypted."
('nil
(jabber-db--insert-message db account peer resource occupant-id
direction type body timestamp
- stanza-id server-id encrypted oob-entries))
+ stanza-id server-id encrypted oob-entries
+ reply))
((or 'stanza_id 'server_id)
(jabber-db--update-duplicate-ids db account peer timestamp body
stanza-id server-id oob-entries
- dup-id-col))
+ dup-id-col)
+ (when (and reply stanza-id)
+ (jabber-db--backfill-reply-fields db account peer stanza-id
+ reply)))
('content
(jabber-db--upgrade-content-match db account peer timestamp body
stanza-id server-id))))))
@@ -822,7 +917,8 @@ ROW columns match the SELECT in `jabber-db-backlog'.
The :oob-entries key is populated later by `jabber-db--attach-oob-entries'."
(seq-let (id account peer direction body timestamp resource type
encrypted stanza-id delivered-at
- displayed-at server-id retracted-by retraction-reason edited)
+ displayed-at server-id retracted-by retraction-reason edited
+ reply-to-id reply-to-jid fallback-start fallback-end)
row
(let ((from (cond
;; Incoming: peer/resource (or just peer if no resource).
@@ -846,6 +942,10 @@ The :oob-entries key is populated later by
`jabber-db--attach-oob-entries'."
:retracted-by retracted-by
:retraction-reason retraction-reason
:edited (and edited (not (zerop edited)))
+ :reply-to-id reply-to-id
+ :reply-to-jid reply-to-jid
+ :fallback-range (jabber-db--decode-fallback-range
+ fallback-start fallback-end)
:direction direction
:msg-type type
:oob-entries nil
@@ -907,7 +1007,8 @@ MSG-TYPE, when non-nil, filters to messages of that type
only
(t 0)))
(base-cols "SELECT id, account, peer, direction, body, timestamp, \
resource, type, encrypted, stanza_id, delivered_at, displayed_at, \
-server_id, retracted_by, retraction_reason, edited FROM message")
+server_id, retracted_by, retraction_reason, edited, \
+reply_to_id, reply_to_jid, fallback_start, fallback_end FROM message")
(sql (cond
(resource
(concat base-cols " WHERE account = ? AND peer = ? \
@@ -1113,12 +1214,15 @@ XML-DATA is the parsed stanza."
server-id
(jabber-db--extract-occupant-id xml-data)
oob-entries
- encrypted)))))
+ encrypted
+ (jabber-db--extract-reply-fields xml-data))))))
(defun jabber-db--outgoing-handler (body id)
"Store outgoing chat message in the database.
BODY is the message text. ID is the stanza id for dedup.
-Called from `jabber-chat-send-hooks'."
+Called from `jabber-chat-send-hooks'. Reply metadata is read from
+`jabber-chat--send-hook-stanza' when the hooks that emit the reply
+elements have already run."
(when (and jabber-chatting-with jabber-buffer-connection)
(jabber-db-store-message
(jabber-connection-bare-jid jabber-buffer-connection)
@@ -1131,7 +1235,9 @@ Called from `jabber-chat-send-hooks'."
(jabber-jid-resource jabber-chatting-with))
id
nil nil nil
- (memq jabber-chat-encryption '(omemo openpgp openpgp-legacy))))
+ (memq jabber-chat-encryption '(omemo openpgp openpgp-legacy))
+ (and (bound-and-true-p jabber-chat--send-hook-stanza)
+ (jabber-db--extract-reply-fields jabber-chat--send-hook-stanza))))
nil)
(defun jabber-db--store-outgoing (jc to body type)
@@ -1233,7 +1339,9 @@ files, depending on the value of
`jabber-use-global-history'."
;;; Registration
(jabber-chain-add 'jabber-message-chain #'jabber-db--message-handler 90)
-(add-hook 'jabber-chat-send-hooks #'jabber-db--outgoing-handler)
+;; Depth 90: run after the hooks that attach reply/receipt elements,
+;; so the stored row sees the complete stanza.
+(add-hook 'jabber-chat-send-hooks #'jabber-db--outgoing-handler 90)
(add-hook 'jabber-post-connect-hooks #'jabber-db--on-connect)
(add-hook 'jabber-pre-disconnect-hook #'jabber-db--on-disconnect)
(add-hook 'kill-emacs-hook #'jabber-db-close)
diff --git a/lisp/jabber-mam.el b/lisp/jabber-mam.el
index 1e15955fa1..881b105712 100644
--- a/lisp/jabber-mam.el
+++ b/lisp/jabber-mam.el
@@ -379,7 +379,8 @@ JC is the Jabber connection. XML-DATA is the stanza."
body ts (jabber-jid-resource (plist-get fields :from))
(plist-get fields :stanza-id) archive-id
(jabber-db--extract-occupant-id inner-msg)
- (plist-get fields :oob-entries) encrypted)))
+ (plist-get fields :oob-entries) encrypted
+ (jabber-db--extract-reply-fields inner-msg))))
(jabber-mam--track-sync-ids qid archive-id
(plist-get fields :stanza-id) ts)
(jabber-mam--mark-dirty peer (plist-get fields :type))
diff --git a/tests/jabber-test-chat.el b/tests/jabber-test-chat.el
index df2794bf5f..a824448ee7 100644
--- a/tests/jabber-test-chat.el
+++ b/tests/jabber-test-chat.el
@@ -261,6 +261,29 @@
(plist (jabber-chat--msg-plist-from-stanza stanza)))
(should-not (plist-get plist :fallback-range))))
+(ert-deftest jabber-test-chat-outgoing-handler-stores-reply-metadata ()
+ "The DB outgoing handler reads reply elements off the final stanza."
+ (require 'jabber-db)
+ (with-temp-buffer
+ (setq-local jabber-chatting-with "[email protected]")
+ (setq-local jabber-buffer-connection 'fake-jc)
+ (let (stored-reply)
+ (cl-letf (((symbol-function 'jabber-connection-bare-jid)
+ (lambda (_jc) "[email protected]"))
+ ((symbol-function 'jabber-muc-sender-p)
+ (lambda (_jid) nil))
+ ((symbol-function 'jabber-db-store-message)
+ (lambda (&rest args) (setq stored-reply (nth 12 args)))))
+ (let ((stanza '(message ((to . "[email protected]")
+ (type . "chat")
+ (id . "m-9"))
+ (body () "> q\nanswer")
+ (reply ((xmlns . "urn:xmpp:reply:0")
+ (id . "orig-9")))))
+ (jabber-chat-send-hooks (list #'jabber-db--outgoing-handler)))
+ (jabber-chat--run-send-hooks stanza "> q\nanswer" "m-9")))
+ (should (equal "orig-9" (plist-get stored-reply :reply-to-id))))))
+
(ert-deftest jabber-test-chat-send-hooks-stamp-origin-id ()
"The default send hooks stamp an XEP-0359 origin-id on outgoing stanzas."
(with-temp-buffer
diff --git a/tests/jabber-test-db.el b/tests/jabber-test-db.el
index 3150836232..a4b191cefe 100644
--- a/tests/jabber-test-db.el
+++ b/tests/jabber-test-db.el
@@ -1629,9 +1629,15 @@ CREATE TABLE omemo_store (
(unwind-protect
(progn
;; Create a minimal v5 database with a store row. The
- ;; reaction tables satisfy the post-migration repair step.
+ ;; reaction tables satisfy the post-migration repair step;
+ ;; the message table is needed by the v6->v7 migration.
(let ((db (sqlite-open jabber-db-path)))
(sqlite-execute db "\
+CREATE TABLE message (
+ id INTEGER PRIMARY KEY, account TEXT NOT NULL, peer TEXT NOT NULL,
+ direction TEXT NOT NULL, type TEXT, body TEXT,
+ timestamp INTEGER NOT NULL, stanza_id TEXT)")
+ (sqlite-execute db "\
CREATE TABLE omemo_store (
account TEXT PRIMARY KEY,
store_blob BLOB NOT NULL)")
@@ -1667,6 +1673,114 @@ CREATE TABLE message_reaction_actor (
(when (file-directory-p jabber-test-db--dir)
(delete-directory jabber-test-db--dir t)))))
+(ert-deftest jabber-test-db-migration-v6-to-v7 ()
+ "Migration v6->v7 adds the reply metadata columns."
+ (let* ((jabber-test-db--dir (make-temp-file "jabber-db-test" t))
+ (jabber-db-path (expand-file-name "test.sqlite" jabber-test-db--dir))
+ (jabber-db--connection nil))
+ (unwind-protect
+ (progn
+ (let ((db (sqlite-open jabber-db-path)))
+ (sqlite-execute db "\
+CREATE TABLE message (
+ id INTEGER PRIMARY KEY, account TEXT NOT NULL, peer TEXT NOT NULL,
+ direction TEXT NOT NULL, type TEXT, body TEXT,
+ timestamp INTEGER NOT NULL, stanza_id TEXT)")
+ (sqlite-execute db "\
+CREATE TABLE message_reaction (
+ message_id INTEGER NOT NULL, sender TEXT NOT NULL,
+ reaction TEXT NOT NULL, updated_at INTEGER NOT NULL,
+ PRIMARY KEY (message_id, sender, reaction))")
+ (sqlite-execute db "\
+CREATE TABLE message_reaction_actor (
+ message_id INTEGER NOT NULL, sender TEXT NOT NULL,
+ updated_at INTEGER NOT NULL, PRIMARY KEY (message_id, sender))")
+ (sqlite-execute db "\
+CREATE TABLE omemo_store (
+ account TEXT PRIMARY KEY, store_blob BLOB NOT NULL,
+ spk_rotated_at INTEGER)")
+ (sqlite-execute db "PRAGMA user_version=6")
+ (sqlite-close db))
+ (jabber-db-ensure-open)
+ (should (= jabber-db--schema-version
+ (caar (sqlite-select jabber-db--connection
+ "PRAGMA user_version"))))
+ (let ((cols (mapcar #'car
+ (sqlite-select jabber-db--connection
+ "SELECT name FROM
pragma_table_info('message')"))))
+ (dolist (col '("reply_to_id" "reply_to_jid"
+ "fallback_start" "fallback_end"))
+ (should (member col cols)))))
+ (jabber-db-close)
+ (when (file-directory-p jabber-test-db--dir)
+ (delete-directory jabber-test-db--dir t)))))
+
+;;; Group: Reply metadata persistence
+
+(ert-deftest jabber-test-db-reply-metadata-round-trip ()
+ "Reply metadata stored with a message comes back in the backlog."
+ (jabber-test-db-with-db
+ (jabber-db-store-message
+ "[email protected]" "[email protected]" "in" "chat" "> quote\nanswer"
+ (floor (float-time)) "phone" "msg-1" nil nil nil nil
+ '(:reply-to-id "orig-1" :reply-to-jid "[email protected]"
+ :fallback-range (0 8)))
+ (let ((msg (car (jabber-db-backlog "[email protected]" "[email protected]"))))
+ (should (equal "orig-1" (plist-get msg :reply-to-id)))
+ (should (equal "[email protected]" (plist-get msg :reply-to-jid)))
+ (should (equal '(0 8) (plist-get msg :fallback-range))))))
+
+(ert-deftest jabber-test-db-reply-metadata-all-range ()
+ "A whole-body fallback range survives the -1 encoding."
+ (jabber-test-db-with-db
+ (jabber-db-store-message
+ "[email protected]" "[email protected]" "in" "chat" "> just a quote"
+ (floor (float-time)) "phone" "msg-2" nil nil nil nil
+ '(:reply-to-id "orig-2" :fallback-range all))
+ (let ((msg (car (jabber-db-backlog "[email protected]" "[email protected]"))))
+ (should (eq 'all (plist-get msg :fallback-range))))))
+
+(ert-deftest jabber-test-db-reply-metadata-absent ()
+ "A message without reply metadata reads back nil fields."
+ (jabber-test-db-with-db
+ (jabber-db-store-message
+ "[email protected]" "[email protected]" "in" "chat" "plain"
+ (floor (float-time)) "phone" "msg-3")
+ (let ((msg (car (jabber-db-backlog "[email protected]" "[email protected]"))))
+ (should-not (plist-get msg :reply-to-id))
+ (should-not (plist-get msg :fallback-range)))))
+
+(ert-deftest jabber-test-db-reply-metadata-backfill-on-dedup ()
+ "A duplicate store with reply metadata backfills NULL reply columns."
+ (jabber-test-db-with-db
+ (let ((ts (floor (float-time))))
+ ;; First store without reply metadata (OMEMO pending echo shape).
+ (jabber-db-store-message
+ "[email protected]" "[email protected]" "out" "chat" "answer" ts nil "msg-4")
+ ;; Same stanza-id again, now with reply metadata.
+ (jabber-db-store-message
+ "[email protected]" "[email protected]" "out" "chat" "answer" ts nil "msg-4"
+ nil nil nil nil '(:reply-to-id "orig-4" :fallback-range all))
+ (let ((msg (car (jabber-db-backlog "[email protected]" "[email protected]"))))
+ (should (equal "orig-4" (plist-get msg :reply-to-id)))
+ (should (eq 'all (plist-get msg :fallback-range)))))))
+
+(ert-deftest jabber-test-db-extract-reply-fields ()
+ "Reply extraction matches the chat-side parser's shape."
+ (let ((stanza '(message ((from . "[email protected]") (type . "chat"))
+ (body () "> q\nanswer")
+ (reply ((xmlns . "urn:xmpp:reply:0")
+ (to . "[email protected]")
+ (id . "orig-5")))
+ (fallback ((xmlns . "urn:xmpp:fallback:0")
+ (for . "urn:xmpp:reply:0"))
+ (body ((start . "0") (end . "4")))))))
+ (should (equal '(:reply-to-id "orig-5" :reply-to-jid "[email protected]"
+ :fallback-range (0 4))
+ (jabber-db--extract-reply-fields stanza))))
+ (should-not (jabber-db--extract-reply-fields
+ '(message ((from . "[email protected]")) (body () "plain")))))
+
(ert-deftest jabber-test-db-oob-dedup-replacement ()
"Failed-decrypt replacement updates OOB entries."
(jabber-test-db-with-db
