[nongnu] elpa/jabber 5715e0b3af 1/2: reactions: Persist message reactions

[ELPA Syncer]

branch: elpa/jabber
commit 5715e0b3af3b07b078bf0b4a7524bb31befa7ef0
Author: Thanos Apollo <pub...@thanosapollo.org>
Commit: Thanos Apollo <pub...@thanosapollo.org>

    reactions: Persist message reactions
---
 doap.xml                       |   2 +-
 lisp/jabber-db.el              | 144 ++++++++++++++++++++++++-
 lisp/jabber-reactions.el       | 130 ++++++++++++++++++++--
 tests/jabber-test-db.el        | 230 ++++++++++++++++++++++++++++++++++++++-
 tests/jabber-test-reactions.el | 238 +++++++++++++++++++++++++++++++++++++++++
 5 files changed, 728 insertions(+), 16 deletions(-)

diff --git a/doap.xml b/doap.xml
index 4a2468d02b..f58ba78d86 100644
--- a/doap.xml
+++ b/doap.xml
@@ -541,7 +541,7 @@
       <xmpp:SupportedXep>
         <xmpp:xep rdf:resource="https://xmpp.org/extensions/xep-0444.html"/>
         <xmpp:status>partial</xmpp:status>
-        <xmpp:note>Message Reactions display is in-memory only, with no 
persistence, no restriction discovery, and provisional MUC actor 
identity.</xmpp:note>
+        <xmpp:note>Message Reactions are persisted and displayed from backlog; 
restriction discovery is not implemented and MUC actor identity remains 
provisional.</xmpp:note>
       </xmpp:SupportedXep>
     </implements>
     <implements>
diff --git a/lisp/jabber-db.el b/lisp/jabber-db.el
index c1340e6ce4..b369c79083 100644
--- a/lisp/jabber-db.el
+++ b/lisp/jabber-db.el
@@ -35,6 +35,7 @@
 
 ;;; Code:
 
+(require 'subr-x)
 (require 'jabber-util)
 (require 'jabber-xml)
 (eval-when-compile
@@ -179,6 +180,19 @@ END"
   desc       TEXT)"
     "CREATE INDEX IF NOT EXISTS idx_oob_message_id
   ON message_oob(message_id)"
+    "CREATE TABLE IF NOT EXISTS message_reaction (
+  message_id INTEGER NOT NULL REFERENCES message(id) ON DELETE CASCADE,
+  sender     TEXT NOT NULL,
+  reaction   TEXT NOT NULL,
+  updated_at INTEGER NOT NULL,
+  PRIMARY KEY (message_id, sender, reaction))"
+    "CREATE INDEX IF NOT EXISTS idx_reaction_message_id
+  ON message_reaction(message_id)"
+    "CREATE TABLE IF NOT EXISTS message_reaction_actor (
+  message_id INTEGER NOT NULL REFERENCES message(id) ON DELETE CASCADE,
+  sender     TEXT NOT NULL,
+  updated_at INTEGER NOT NULL,
+  PRIMARY KEY (message_id, sender))"
     "CREATE TABLE IF NOT EXISTS caps_cache (
   hash       TEXT NOT NULL,
   ver        TEXT NOT NULL,
@@ -192,7 +206,7 @@ END"
   (dolist (ddl jabber-db--schema-ddl)
     (sqlite-execute db ddl)))
 
-(defconst jabber-db--schema-version 4
+(defconst jabber-db--schema-version 5
   "Current schema version.
 Bump this when adding migrations.  A database whose version
 exceeds this value is from a newer (or development) build and
@@ -260,7 +274,26 @@ CREATE TABLE IF NOT EXISTS caps_cache (
   features   TEXT NOT NULL,
   PRIMARY KEY (hash, ver))")
       (sqlite-execute db "PRAGMA user_version=4")
-      (setq version 4))))
+      (setq version 4))
+    (when (= version 4)
+      (sqlite-execute db "\
+CREATE TABLE IF NOT EXISTS message_reaction (
+  message_id INTEGER NOT NULL REFERENCES message(id) ON DELETE CASCADE,
+  sender     TEXT NOT NULL,
+  reaction   TEXT NOT NULL,
+  updated_at INTEGER NOT NULL,
+  PRIMARY KEY (message_id, sender, reaction))")
+      (sqlite-execute db "\
+CREATE INDEX IF NOT EXISTS idx_reaction_message_id
+  ON message_reaction(message_id)")
+      (sqlite-execute db "\
+CREATE TABLE IF NOT EXISTS message_reaction_actor (
+  message_id INTEGER NOT NULL REFERENCES message(id) ON DELETE CASCADE,
+  sender     TEXT NOT NULL,
+  updated_at INTEGER NOT NULL,
+  PRIMARY KEY (message_id, sender))")
+      (sqlite-execute db "PRAGMA user_version=5")
+      (setq version 5))))
 
 (defun jabber-db-ensure-open ()
   "Open the SQLite database, creating it if needed.  Idempotent.
@@ -598,6 +631,110 @@ FROM message WHERE stanza_id = ? LIMIT 1"
             (if resource (concat peer "/" resource) peer)
           account)))))
 
+;;; Reactions
+
+(defun jabber-db--reaction-id-column (type)
+  "Return the message ID column used for reaction targets of TYPE."
+  (if (string= type "groupchat") "server_id" "stanza_id"))
+
+(defun jabber-db--message-id-for-reaction-target (db account peer type 
target-id)
+  "Return DB message id for reaction target TARGET-ID, or nil.
+DB is the SQLite connection.  ACCOUNT, PEER and TYPE scope the lookup."
+  (when (and account peer type target-id)
+    (caar (sqlite-select
+           db
+           (format "SELECT id FROM message \
+WHERE account = ? AND peer = ? AND type = ? AND %s = ? LIMIT 1"
+                   (jabber-db--reaction-id-column type))
+           (list account peer type target-id)))))
+
+(defun jabber-db--reaction-current-updated-at (db message-id sender)
+  "Return actor reaction timestamp in DB for MESSAGE-ID and SENDER."
+  (caar (sqlite-select db "SELECT updated_at FROM message_reaction_actor \
+WHERE message_id = ? AND sender = ?"
+                       (list message-id sender))))
+
+(defun jabber-db--source-reaction-stale-p (db message-id sender updated-at)
+  "Return non-nil when UPDATED-AT is stale for MESSAGE-ID and SENDER in DB."
+  (when-let* ((current-updated-at (jabber-db--reaction-current-updated-at
+                                   db message-id sender)))
+    (<= updated-at current-updated-at)))
+
+(defun jabber-db-reaction-stale-p (account peer type target-id sender 
updated-at)
+  "Return non-nil when UPDATED-AT is stale for SENDER's target reactions.
+ACCOUNT, PEER, TYPE and TARGET-ID identify the target message.  Return
+nil when storage is disabled or the target is not stored."
+  (when-let* ((db (jabber-db-ensure-open))
+              (updated-at)
+              (message-id (jabber-db--message-id-for-reaction-target
+                           db account peer type target-id)))
+    (jabber-db--source-reaction-stale-p db message-id sender updated-at)))
+
+(defun jabber-db-replace-reactions (account peer type target-id sender 
reactions
+                                    &optional updated-at)
+  "Replace SENDER's REACTIONS for TARGET-ID in ACCOUNT/PEER conversation.
+TYPE is the target message type.  Return non-nil when the target message
+exists and the replacement was applied.  Empty REACTIONS deletes SENDER's
+stored reactions for the target.  Non-nil UPDATED-AT is source ordered and
+older or equal values are ignored.  Nil UPDATED-AT is a local replacement
+and is always accepted with the current timestamp."
+  (when-let* ((db (jabber-db-ensure-open))
+              (message-id (jabber-db--message-id-for-reaction-target
+                           db account peer type target-id)))
+    (unless (and updated-at
+                 (jabber-db--source-reaction-stale-p
+                  db message-id sender updated-at))
+      (let ((deduplicated (delete-dups (cl-remove-if-not #'stringp reactions)))
+            (replacement-updated-at (or updated-at (floor (float-time)))))
+        (sqlite-execute db "INSERT INTO message_reaction_actor \
+(message_id, sender, updated_at) VALUES (?, ?, ?) \
+ON CONFLICT(message_id, sender) DO UPDATE SET updated_at = excluded.updated_at"
+                        (list message-id sender replacement-updated-at))
+        (sqlite-execute db "DELETE FROM message_reaction \
+WHERE message_id = ? AND sender = ?"
+                        (list message-id sender))
+        (dolist (reaction deduplicated)
+          (unless (string-empty-p reaction)
+            (sqlite-execute db "INSERT INTO message_reaction \
+(message_id, sender, reaction, updated_at) VALUES (?, ?, ?, ?)"
+                            (list message-id sender reaction 
replacement-updated-at))))
+        t))))
+
+(defun jabber-db-reactions-for-message-ids (message-ids)
+  "Return reaction state for MESSAGE-IDS keyed by message DB id.
+The returned hash table maps message ids to alists of (SENDER . REACTIONS)."
+  (let ((grouped (make-hash-table :test #'eql)))
+    (when-let* ((db (jabber-db-ensure-open))
+                ((cl-some #'identity message-ids)))
+      (dolist (row (sqlite-select
+                    db
+                    (format "SELECT message_id, sender, reaction \
+FROM message_reaction WHERE message_id IN (%s) \
+ORDER BY message_id, updated_at, rowid"
+                            (mapconcat #'number-to-string message-ids ","))))
+        (seq-let (message-id sender reaction) row
+          (push reaction (alist-get sender (gethash message-id grouped)
+                                    nil nil #'equal))))
+      (maphash (lambda (message-id sender-state)
+                 (puthash message-id
+                          (mapcar (lambda (entry)
+                                    (cons (car entry) (nreverse (cdr entry))))
+                                  (nreverse sender-state))
+                          grouped))
+               grouped))
+    grouped))
+
+(defun jabber-db--attach-reactions (plists)
+  "Batch-query reactions and attach them to PLISTS by :db-id."
+  (let* ((ids (cl-loop for p in plists
+                       for id = (plist-get p :db-id)
+                       when id collect id))
+         (reactions (jabber-db-reactions-for-message-ids ids)))
+    (dolist (p plists)
+      (when-let* ((db-id (plist-get p :db-id)))
+        (plist-put p :reactions (gethash db-id reactions))))
+    plists))
+
 ;;; Retrieval
 
 (defun jabber-db--row-to-plist (row)
@@ -716,7 +853,8 @@ AND timestamp >= ? ORDER BY timestamp DESC LIMIT ?"))))
                            (if (eq n t) -1 n)))))
            (rows (sqlite-select db sql params))
            (plists (mapcar #'jabber-db--row-to-plist rows)))
-      (jabber-db--attach-oob-entries db plists))))
+      (jabber-db--attach-reactions
+       (jabber-db--attach-oob-entries db plists)))))
 
 (defun jabber-db--raw-row-to-plist (row)
   "Convert a raw query ROW to a plist.
diff --git a/lisp/jabber-reactions.el b/lisp/jabber-reactions.el
index efc3e7bbf6..eabb7bc860 100644
--- a/lisp/jabber-reactions.el
+++ b/lisp/jabber-reactions.el
@@ -29,6 +29,7 @@
 (require 'cl-lib)
 (require 'ewoc)
 (require 'subr-x)
+(require 'jabber-db)
 (require 'jabber-disco)
 (require 'jabber-util)
 
@@ -38,6 +39,9 @@
 (defconst jabber-reactions-hints-xmlns "urn:xmpp:hints"
   "XEP-0334 Message Processing Hints namespace.")
 
+(defconst jabber-reactions-fallback-xmlns "urn:xmpp:fallback:0"
+  "XEP-0428 Fallback Indication namespace.")
+
 (defcustom jabber-reactions-default-choices
   '("👍" "❤️" "😂" "🎉" "😮" "😢" "🙏")
   "Reaction strings offered by the outgoing reaction picker.
@@ -62,6 +66,11 @@ are not filtered against it."
 (defvar jabber-group)
 (defvar jabber-point-insert)
 
+(declare-function jabber-db-reaction-stale-p
+                  "jabber-db" (account peer type target-id sender updated-at))
+(declare-function jabber-db-replace-reactions
+                  "jabber-db" (account peer type target-id sender reactions
+                                        &optional updated-at))
 (declare-function jabber-chat--unwrap-carbon "jabber-chat" (jc xml-data))
 (declare-function jabber-chat-ewoc-find-by-id "jabber-chatbuffer" (stanza-id))
 (declare-function jabber-chat-ewoc-invalidate "jabber-chatbuffer" (node))
@@ -173,15 +182,76 @@ an empty update."
                      (car (jabber-xml-node-children reaction)))
                    (jabber-xml-get-children reactions 'reaction))))))
 
+(defun jabber-reactions--fallback-for-reactions-p (fallback)
+  "Return non-nil when FALLBACK marks XEP-0444 reaction fallback text."
+  (and (string= (or (jabber-xml-get-attribute fallback 'xmlns) "")
+                jabber-reactions-fallback-xmlns)
+       (string= (or (jabber-xml-get-attribute fallback 'for) "")
+                jabber-reactions-xmlns)))
+
+(defun jabber-reactions--body-text (xml-data)
+  "Return the plain `<body>' text from XML-DATA, or nil."
+  (car (jabber-xml-node-children
+        (car (jabber-xml-get-children xml-data 'body)))))
+
+(defun jabber-reactions--integer-attribute (xml-data attribute)
+  "Return XML-DATA's integer ATTRIBUTE, or nil when malformed."
+  (when-let* ((value (jabber-xml-get-attribute xml-data attribute))
+              ((string-match-p "\\`[0-9]+\\'" value)))
+    (string-to-number value)))
+
+(defun jabber-reactions--element-children (xml-data)
+  "Return XML-DATA's child elements."
+  (cl-remove-if-not #'listp (jabber-xml-node-children xml-data)))
+
+(defun jabber-reactions--fallback-body-range (fallback)
+  "Return FALLBACK body coverage as `whole', (START END), or nil."
+  (let ((children (jabber-reactions--element-children fallback)))
+    (if (null children)
+        'whole
+      (when-let* ((body (car (jabber-xml-get-children fallback 'body))))
+        (let ((start-attr (jabber-xml-get-attribute body 'start))
+              (end-attr (jabber-xml-get-attribute body 'end)))
+          (cond
+           ((and (null start-attr) (null end-attr)) 'whole)
+           ((and start-attr end-attr)
+            (when-let* ((start (jabber-reactions--integer-attribute body 
'start))
+                        (end (jabber-reactions--integer-attribute body 'end)))
+              (list start end)))))))))
+
+(defun jabber-reactions--range-covers-body-p (range body)
+  "Return non-nil when RANGE covers all of BODY."
+  (or (eq range 'whole)
+      (pcase range
+        (`(,start ,end)
+         (and (zerop start)
+              (>= end (length body)))))))
+
+(defun jabber-reactions--fallback-body-p (xml-data)
+  "Return non-nil when XML-DATA's body is only XEP-0444 fallback text."
+  (when-let* ((body (jabber-reactions--body-text xml-data)))
+    (cl-some (lambda (fallback)
+               (and (jabber-reactions--fallback-for-reactions-p fallback)
+                    (jabber-reactions--range-covers-body-p
+                     (jabber-reactions--fallback-body-range fallback)
+                     body)))
+             (jabber-xml-get-children xml-data 'fallback))))
+
 (defun jabber-reactions--reaction-only-p (xml-data)
   "Return non-nil when XML-DATA is only a reaction update stanza.
 A reaction-only stanza has a XEP-0444 `<reactions>' payload and no
-`<body>', `<subject>', or `<error>' child."
+real `<body>', `<subject>', or `<error>' child.  A `<body>' fully marked
+as XEP-0428 fallback for reactions does not count as a real body."
   (and (jabber-xml-child-with-xmlns xml-data jabber-reactions-xmlns)
-       (not (jabber-xml-get-children xml-data 'body))
+       (or (not (jabber-xml-get-children xml-data 'body))
+           (jabber-reactions--fallback-body-p xml-data))
        (not (jabber-xml-get-children xml-data 'subject))
        (not (jabber-xml-get-children xml-data 'error))))
 
+(defun jabber-reactions--history-inhibit-p (_jc xml-data)
+  "Return non-nil when XML-DATA should not be stored as a message body."
+  (jabber-reactions--reaction-only-p xml-data))
+
 (defun jabber-reactions--incoming-sender (from type)
   "Return the reaction sender key for incoming FROM and message TYPE."
   (when from
@@ -196,6 +266,39 @@ A reaction-only stanza has a XEP-0444 `<reactions>' 
payload and no
         (jabber-muc-find-buffer (jabber-jid-user from))
       (jabber-chat-find-buffer (jabber-jid-user from)))))
 
+(defun jabber-reactions--storage-peer (jc message type)
+  "Return the DB peer for reaction-bearing MESSAGE on JC with TYPE."
+  (let ((from (jabber-xml-get-attribute message 'from))
+        (to (jabber-xml-get-attribute message 'to)))
+    (if (string= type "groupchat")
+        (and from (jabber-jid-user from))
+      (let ((account (jabber-connection-bare-jid jc)))
+        (cond
+         ((and from (string= (jabber-jid-user from) account))
+          (and to (jabber-jid-user to)))
+         (from (jabber-jid-user from))
+         (to (jabber-jid-user to)))))))
+
+(defun jabber-reactions--message-updated-at (message)
+  "Return the source timestamp for reaction MESSAGE, or nil.
+Nil means MESSAGE has no delayed/source timestamp and should be applied
+in arrival order."
+  (when-let* ((timestamp (jabber-message-timestamp message)))
+    (floor (float-time timestamp))))
+
+(defun jabber-reactions--persist-update (jc message target-id sender reactions)
+  "Persist SENDER's REACTIONS for TARGET-ID from MESSAGE on JC.
+Return :stale when persistent storage confirms MESSAGE is stale."
+  (let ((type (or (jabber-xml-get-attribute message 'type) "chat"))
+        (updated-at (jabber-reactions--message-updated-at message)))
+    (when-let* ((account (jabber-connection-bare-jid jc))
+                (peer (jabber-reactions--storage-peer jc message type)))
+      (unless (jabber-db-replace-reactions
+               account peer type target-id sender reactions updated-at)
+        (when (jabber-db-reaction-stale-p
+               account peer type target-id sender updated-at)
+          :stale)))))
+
 (defun jabber-reactions--unwrap-stanza (jc xml-data)
   "Return (MESSAGE . BUFFER) for reaction-bearing XML-DATA on JC."
   (if (or (string= (or (jabber-xml-get-attribute xml-data 'type) "") 
"groupchat")
@@ -296,6 +399,10 @@ buffers with a known destination."
              (jabber-reactions--build-stanza to type target-id
                                              sender-reactions
                                              (jabber-reactions--message-id)))
+            (jabber-db-replace-reactions
+             (jabber-connection-bare-jid jabber-buffer-connection)
+             (jabber-jid-user to)
+             type target-id sender sender-reactions)
             (unless (bound-and-true-p jabber-group)
               (jabber-reactions--optimistic-update node msg sender 
sender-reactions))))
       (jabber-reactions--insert-literal-bang))))
@@ -320,15 +427,20 @@ buffers with a known destination."
                             message jabber-reactions-xmlns))
                 (parsed (jabber-reactions--parse-element reactions))
                 (from (jabber-xml-get-attribute message 'from))
-                (type (jabber-xml-get-attribute message 'type))
-                (sender (jabber-reactions--incoming-sender from type))
-                (buffer (or carbon-buffer
-                            (jabber-reactions--buffer-for-stanza from type))))
-      (with-current-buffer buffer
-        (when-let* ((node (jabber-chat-ewoc-find-by-id (car parsed))))
-          (jabber-reactions--apply-incoming-update node sender (cadr 
parsed)))))))
+                (type (or (jabber-xml-get-attribute message 'type) "chat"))
+                (sender (jabber-reactions--incoming-sender from type)))
+      (unless (eq (jabber-reactions--persist-update
+                   jc message (car parsed) sender (cadr parsed))
+                  :stale)
+        (when-let* ((buffer (or carbon-buffer
+                                (jabber-reactions--buffer-for-stanza from 
type))))
+          (with-current-buffer buffer
+            (when-let* ((node (jabber-chat-ewoc-find-by-id (car parsed))))
+              (jabber-reactions--apply-incoming-update node sender (cadr 
parsed)))))))))
 
 (jabber-chain-add 'jabber-message-chain #'jabber-reactions--handle-message -5)
+(add-to-list 'jabber-history-inhibit-received-message-functions
+             #'jabber-reactions--history-inhibit-p)
 
 ;;; Disco
 
diff --git a/tests/jabber-test-db.el b/tests/jabber-test-db.el
index 56038b5473..4ed18b9afe 100644
--- a/tests/jabber-test-db.el
+++ b/tests/jabber-test-db.el
@@ -9,6 +9,11 @@
 (require 'ert)
 (require 'jabber-chat)
 (require 'jabber-db)
+(require 'jabber-reactions)
+
+(declare-function jabber-db-replace-reactions
+                  "jabber-db" (account peer type target-id sender reactions
+                                        &optional updated-at))
 
 ;;; Test infrastructure
 
@@ -1532,9 +1537,15 @@ VALUES ('m...@x.com', 'p...@x.com', 'in', 'chat', 
'text', 1001,
             (sqlite-close db))
           ;; Open with migration.
           (jabber-db-ensure-open)
-          ;; Check version is now 4 (full chain: v2->v3->v4).
-          (should (= 4 (caar (sqlite-select jabber-db--connection
-                                            "PRAGMA user_version"))))
+          ;; Check version is current (full chain: v2 through latest).
+          (should (= jabber-db--schema-version
+                     (caar (sqlite-select jabber-db--connection
+                                          "PRAGMA user_version"))))
+          (let ((tables (mapcar #'car
+                                (sqlite-select jabber-db--connection
+                                  "SELECT name FROM sqlite_master WHERE 
type='table'"))))
+            (should (member "message_reaction" tables))
+            (should (member "message_reaction_actor" tables)))
           ;; OOB data migrated to child table.
           (let ((oob-rows (sqlite-select jabber-db--connection
                            "SELECT url, desc FROM message_oob")))
@@ -1577,6 +1588,219 @@ VALUES ('m...@x.com', 'p...@x.com', 'in', 'chat', 
'text', 1001,
         (should (string= "https://new.com/a.pdf"; (car (nth 0 oob))))
         (should (string= "https://new.com/b.pdf"; (car (nth 1 oob))))))))
 
+;;; Group: message_reaction child table
+
+(ert-deftest jabber-test-db-reaction-table-exists ()
+  "The reaction row and actor metadata tables exist in fresh databases."
+  (jabber-test-db-with-db
+    (let ((tables (mapcar #'car
+                          (sqlite-select jabber-db--connection
+                            "SELECT name FROM sqlite_master WHERE 
type='table'"))))
+      (should (member "message_reaction" tables))
+      (should (member "message_reaction_actor" tables)))
+    (let ((indexes (mapcar #'car
+                           (sqlite-select jabber-db--connection
+                             "SELECT name FROM sqlite_master WHERE 
type='index'"))))
+      (should (member "idx_reaction_message_id" indexes)))))
+
+(ert-deftest jabber-test-db-reaction-fallback-body-not-stored ()
+  "Reaction fallback body is not stored as a normal message body."
+  (jabber-test-db-with-db
+    (let ((xml `(message ((from . "fri...@example.com/laptop")
+                          (type . "chat")
+                          (id . "reaction-1"))
+                         (body nil "> quoted\n👍")
+                         (reactions ((xmlns . ,jabber-reactions-xmlns)
+                                     (id . "target-1"))
+                                    (reaction nil "👍"))
+                         (fallback ((xmlns . "urn:xmpp:fallback:0")
+                                    (for . ,jabber-reactions-xmlns))
+                                   (body ((start . "0") (end . "10")))))))
+      (cl-letf (((symbol-function 'jabber-connection-bare-jid)
+                 (lambda (_jc) "m...@example.com")))
+        (jabber-db--message-handler 'fake-jc xml))
+      (should (null (jabber-db-query "m...@example.com" 
"fri...@example.com"))))))
+
+(ert-deftest jabber-test-db-replace-reactions-chat-by-stanza-id ()
+  "Direct-chat reactions are stored against the target stanza id."
+  (jabber-test-db-with-db
+    (jabber-db-store-message "m...@example.com" "fri...@example.com"
+                             "in" "chat" "hello" 1000 nil "stanza-1")
+    (should (jabber-db-replace-reactions
+             "m...@example.com" "fri...@example.com" "chat" "stanza-1"
+             "fri...@example.com" '("👍" "👍" "🎉")))
+    (let ((rows (sqlite-select jabber-db--connection
+                 "SELECT sender, reaction FROM message_reaction")))
+      (should (= 2 (length rows)))
+      (should (member '("fri...@example.com" "👍") rows))
+      (should (member '("fri...@example.com" "🎉") rows)))))
+
+(ert-deftest jabber-test-db-replace-reactions-groupchat-by-server-id ()
+  "MUC reactions are stored against the target server id."
+  (jabber-test-db-with-db
+    (jabber-db-store-message "m...@example.com" "r...@example.com"
+                             "in" "groupchat" "hello" 1000
+                             "alice" nil "server-1")
+    (should (jabber-db-replace-reactions
+             "m...@example.com" "r...@example.com" "groupchat" "server-1"
+             "r...@example.com/bob" '("❤️")))
+    (let ((row (car (sqlite-select jabber-db--connection
+                    "SELECT sender, reaction FROM message_reaction"))))
+      (should (equal row '("r...@example.com/bob" "❤️"))))))
+
+(ert-deftest jabber-test-db-replace-reactions-stores-source-timestamp ()
+  "Reaction replacement stores the supplied source timestamp."
+  (jabber-test-db-with-db
+    (jabber-db-store-message "m...@example.com" "fri...@example.com"
+                             "in" "chat" "hello" 1000 nil "stanza-1")
+    (should (jabber-db-replace-reactions
+             "m...@example.com" "fri...@example.com" "chat" "stanza-1"
+             "alice" '("👍") 1234))
+    (should (= 1234 (caar (sqlite-select jabber-db--connection
+                            "SELECT updated_at FROM message_reaction"))))
+    (should (= 1234 (caar (sqlite-select jabber-db--connection
+                            "SELECT updated_at FROM 
message_reaction_actor"))))))
+
+(ert-deftest jabber-test-db-replace-reactions-newer-overwrites ()
+  "A newer reaction replacement overwrites existing sender state."
+  (jabber-test-db-with-db
+    (jabber-db-store-message "m...@example.com" "fri...@example.com"
+                             "in" "chat" "hello" 1000 nil "stanza-1")
+    (jabber-db-replace-reactions "m...@example.com" "fri...@example.com"
+                                 "chat" "stanza-1" "alice" '("👍") 1000)
+    (should (jabber-db-replace-reactions "m...@example.com" 
"fri...@example.com"
+                                         "chat" "stanza-1" "alice" '("🎉") 
1001))
+    (should (equal (sqlite-select jabber-db--connection
+                     "SELECT reaction, updated_at FROM message_reaction")
+                   '(("🎉" 1001))))))
+
+(ert-deftest jabber-test-db-replace-reactions-stale-ignored ()
+  "An older or equal reaction replacement does not overwrite sender state."
+  (jabber-test-db-with-db
+    (jabber-db-store-message "m...@example.com" "fri...@example.com"
+                             "in" "chat" "hello" 1000 nil "stanza-1")
+    (jabber-db-replace-reactions "m...@example.com" "fri...@example.com"
+                                 "chat" "stanza-1" "alice" '("👍") 1000)
+    (should-not (jabber-db-replace-reactions "m...@example.com" 
"fri...@example.com"
+                                             "chat" "stanza-1" "alice" '("🎉") 
999))
+    (should-not (jabber-db-replace-reactions "m...@example.com" 
"fri...@example.com"
+                                             "chat" "stanza-1" "alice" '("❤️") 
1000))
+    (should (equal (sqlite-select jabber-db--connection
+                     "SELECT reaction, updated_at FROM message_reaction")
+                   '(("👍" 1000))))))
+
+(ert-deftest jabber-test-db-replace-reactions-old-call-remains-compatible ()
+  "Reaction replacement still works when callers omit UPDATED-AT."
+  (jabber-test-db-with-db
+    (jabber-db-store-message "m...@example.com" "fri...@example.com"
+                             "in" "chat" "hello" 1000 nil "stanza-1")
+    (should (jabber-db-replace-reactions "m...@example.com" 
"fri...@example.com"
+                                         "chat" "stanza-1" "alice" '("👍")))
+    (should (equal (caar (sqlite-select jabber-db--connection
+                           "SELECT reaction FROM message_reaction"))
+                   "👍"))))
+
+(ert-deftest jabber-test-db-replace-reactions-empty-removes-sender ()
+  "An empty replacement removes only that sender's reactions."
+  (jabber-test-db-with-db
+    (jabber-db-store-message "m...@example.com" "fri...@example.com"
+                             "in" "chat" "hello" 1000 nil "stanza-1")
+    (jabber-db-replace-reactions "m...@example.com" "fri...@example.com"
+                                 "chat" "stanza-1" "alice" '("👍"))
+    (jabber-db-replace-reactions "m...@example.com" "fri...@example.com"
+                                 "chat" "stanza-1" "bob" '("🎉"))
+    (jabber-db-replace-reactions "m...@example.com" "fri...@example.com"
+                                 "chat" "stanza-1" "alice" nil)
+    (let ((rows (sqlite-select jabber-db--connection
+                 "SELECT sender, reaction FROM message_reaction")))
+      (should (equal rows '(("bob" "🎉")))))))
+
+(ert-deftest jabber-test-db-replace-reactions-empty-preserves-actor-timestamp 
()
+  "Empty replacement records actor timestamp and blocks older replays."
+  (jabber-test-db-with-db
+    (jabber-db-store-message "m...@example.com" "fri...@example.com"
+                             "in" "chat" "hello" 1000 nil "stanza-1")
+    (jabber-db-replace-reactions "m...@example.com" "fri...@example.com"
+                                 "chat" "stanza-1" "alice" '("👍") 1000)
+    (should (jabber-db-replace-reactions "m...@example.com" 
"fri...@example.com"
+                                         "chat" "stanza-1" "alice" nil 1001))
+    (should-not (jabber-db-replace-reactions "m...@example.com" 
"fri...@example.com"
+                                             "chat" "stanza-1" "alice" '("🎉") 
1000))
+    (should (= 1001 (caar (sqlite-select jabber-db--connection
+                            "SELECT updated_at FROM message_reaction_actor"))))
+    (should (= 0 (caar (sqlite-select jabber-db--connection
+                         "SELECT count(*) FROM message_reaction"))))))
+
+(ert-deftest jabber-test-db-replace-reactions-local-same-second-updates ()
+  "Local replacements without UPDATED-AT are accepted even in the same second."
+  (jabber-test-db-with-db
+    (jabber-db-store-message "m...@example.com" "fri...@example.com"
+                             "in" "chat" "hello" 1000 nil "stanza-1")
+    (cl-letf (((symbol-function 'float-time) (lambda (&optional _time) 
1234.9)))
+      (should (jabber-db-replace-reactions "m...@example.com" 
"fri...@example.com"
+                                           "chat" "stanza-1" "alice" '("👍")))
+      (should (jabber-db-replace-reactions "m...@example.com" 
"fri...@example.com"
+                                           "chat" "stanza-1" "alice" '("🎉"))))
+    (should (equal (sqlite-select jabber-db--connection
+                     "SELECT reaction, updated_at FROM message_reaction")
+                   '(("🎉" 1234))))))
+
+(ert-deftest jabber-test-db-replace-reactions-explicit-equal-rejected ()
+  "Source-ordered replacement with equal timestamp is ignored."
+  (jabber-test-db-with-db
+    (jabber-db-store-message "m...@example.com" "fri...@example.com"
+                             "in" "chat" "hello" 1000 nil "stanza-1")
+    (jabber-db-replace-reactions "m...@example.com" "fri...@example.com"
+                                 "chat" "stanza-1" "alice" '("👍") 1000)
+    (should-not (jabber-db-replace-reactions "m...@example.com" 
"fri...@example.com"
+                                             "chat" "stanza-1" "alice" '("🎉") 
1000))
+    (should (equal (sqlite-select jabber-db--connection
+                     "SELECT reaction, updated_at FROM message_reaction")
+                   '(("👍" 1000))))))
+
+(ert-deftest jabber-test-db-backlog-empty-reactions-after-removal ()
+  "Empty replacement leaves no reactions in backlog."
+  (jabber-test-db-with-db
+    (jabber-db-store-message "m...@example.com" "fri...@example.com"
+                             "in" "chat" "hello" 1000 nil "stanza-1")
+    (jabber-db-replace-reactions "m...@example.com" "fri...@example.com"
+                                 "chat" "stanza-1" "alice" '("👍") 1000)
+    (jabber-db-replace-reactions "m...@example.com" "fri...@example.com"
+                                 "chat" "stanza-1" "alice" nil 1001)
+    (let ((entry (car (jabber-db-backlog "m...@example.com" 
"fri...@example.com"))))
+      (should-not (plist-get entry :reactions)))))
+
+(ert-deftest jabber-test-db-backlog-attaches-reactions ()
+  "Backlog entries include persisted reaction state."
+  (jabber-test-db-with-db
+    (let ((ts (floor (float-time))))
+      (jabber-db-store-message "m...@example.com" "fri...@example.com"
+                               "in" "chat" "hello" ts nil "stanza-1"))
+    (jabber-db-replace-reactions "m...@example.com" "fri...@example.com"
+                                 "chat" "stanza-1" "alice" '("👍" "🎉"))
+    (jabber-db-replace-reactions "m...@example.com" "fri...@example.com"
+                                 "chat" "stanza-1" "bob" '("👍"))
+    (let* ((entry (car (jabber-db-backlog
+                        "m...@example.com" "fri...@example.com")))
+           (reactions (plist-get entry :reactions)))
+      (should (equal (alist-get "alice" reactions nil nil #'equal)
+                     '("👍" "🎉")))
+      (should (equal (alist-get "bob" reactions nil nil #'equal)
+                     '("👍"))))))
+
+(ert-deftest jabber-test-db-reaction-cascade-delete ()
+  "Deleting a message cascades to reaction rows and actor metadata."
+  (jabber-test-db-with-db
+    (jabber-db-store-message "m...@example.com" "fri...@example.com"
+                             "in" "chat" "hello" 1000 nil "stanza-1")
+    (jabber-db-replace-reactions "m...@example.com" "fri...@example.com"
+                                 "chat" "stanza-1" "alice" '("👍"))
+    (jabber-db-delete-peer-messages "m...@example.com" "fri...@example.com")
+    (should (= 0 (caar (sqlite-select jabber-db--connection
+                         "SELECT count(*) FROM message_reaction"))))
+    (should (= 0 (caar (sqlite-select jabber-db--connection
+                         "SELECT count(*) FROM message_reaction_actor"))))))
+
 (provide 'jabber-test-db)
 
 ;;; jabber-test-db.el ends here
diff --git a/tests/jabber-test-reactions.el b/tests/jabber-test-reactions.el
index ee9c7765bf..d95052a028 100644
--- a/tests/jabber-test-reactions.el
+++ b/tests/jabber-test-reactions.el
@@ -7,8 +7,31 @@
 ;;; Code:
 
 (require 'ert)
+(require 'jabber-db)
 (require 'jabber-reactions)
 
+(declare-function jabber-db-replace-reactions
+                  "jabber-db" (account peer type target-id sender reactions
+                              &optional updated-at))
+(declare-function jabber-reactions--message-updated-at
+                  "jabber-reactions" (message))
+
+;;; Test infrastructure
+
+(defmacro jabber-test-reactions-with-db (&rest body)
+  "Run BODY with a fresh temp SQLite database."
+  (declare (indent 0) (debug t))
+  `(let* ((jabber-test-reactions--dir (make-temp-file "jabber-reactions-test" 
t))
+          (jabber-db-path (expand-file-name "test.sqlite" 
jabber-test-reactions--dir))
+          (jabber-db--connection nil))
+     (unwind-protect
+         (progn
+           (jabber-db-ensure-open)
+           ,@body)
+       (jabber-db-close)
+       (when (file-directory-p jabber-test-reactions--dir)
+         (delete-directory jabber-test-reactions--dir t)))))
+
 ;;; Group 1: Pure reaction state helpers
 
 (ert-deftest jabber-test-reactions-deduplicate-filters-empty-and-duplicates ()
@@ -126,6 +149,96 @@
                            (reaction nil "👍"))
                 ,extra)))))
 
+(ert-deftest jabber-test-reactions-reaction-only-p-accepts-fallback-body ()
+  "A reaction stanza with whole-body fallback is reaction-only."
+  (should
+   (jabber-reactions--reaction-only-p
+    `(message ((from . "jul...@example.com") (type . "chat"))
+              (body nil "> quoted\n👍")
+              (reactions ((xmlns . ,jabber-reactions-xmlns)
+                          (id . "target-1"))
+                         (reaction nil "👍"))
+              (fallback ((xmlns . "urn:xmpp:fallback:0")
+                         (for . ,jabber-reactions-xmlns))
+                        (body ((start . "0") (end . "10"))))))))
+
+(ert-deftest 
jabber-test-reactions-reaction-only-p-rejects-partial-fallback-body ()
+  "A reaction stanza with partially covered fallback body is not 
reaction-only."
+  (should-not
+   (jabber-reactions--reaction-only-p
+    `(message ((from . "jul...@example.com") (type . "chat"))
+              (body nil "> quoted\n👍")
+              (reactions ((xmlns . ,jabber-reactions-xmlns)
+                          (id . "target-1"))
+                         (reaction nil "👍"))
+              (fallback ((xmlns . "urn:xmpp:fallback:0")
+                         (for . ,jabber-reactions-xmlns))
+                        (body ((start . "0") (end . "1"))))))))
+
+(ert-deftest jabber-test-reactions-reaction-only-p-rejects-length-minus-one ()
+  "A fallback ending at the last character index is not full coverage."
+  (should-not
+   (jabber-reactions--reaction-only-p
+    `(message ((from . "jul...@example.com") (type . "chat"))
+              (body nil "> quoted\n👍")
+              (reactions ((xmlns . ,jabber-reactions-xmlns)
+                          (id . "target-1"))
+                         (reaction nil "👍"))
+              (fallback ((xmlns . "urn:xmpp:fallback:0")
+                         (for . ,jabber-reactions-xmlns))
+                        (body ((start . "0") (end . "9"))))))))
+
+(ert-deftest 
jabber-test-reactions-reaction-only-p-rejects-subject-only-fallback ()
+  "A fallback with children but no body child does not cover the body."
+  (should-not
+   (jabber-reactions--reaction-only-p
+    `(message ((from . "jul...@example.com") (type . "chat"))
+              (body nil "> quoted\n👍")
+              (reactions ((xmlns . ,jabber-reactions-xmlns)
+                          (id . "target-1"))
+                         (reaction nil "👍"))
+              (fallback ((xmlns . "urn:xmpp:fallback:0")
+                         (for . ,jabber-reactions-xmlns))
+                        (subject ((start . "0") (end . "10"))))))))
+
+(ert-deftest 
jabber-test-reactions-reaction-only-p-rejects-malformed-fallback-range ()
+  "A malformed body fallback range does not cover the body."
+  (should-not
+   (jabber-reactions--reaction-only-p
+    `(message ((from . "jul...@example.com") (type . "chat"))
+              (body nil "> quoted\n👍")
+              (reactions ((xmlns . ,jabber-reactions-xmlns)
+                          (id . "target-1"))
+                         (reaction nil "👍"))
+              (fallback ((xmlns . "urn:xmpp:fallback:0")
+                         (for . ,jabber-reactions-xmlns))
+                        (body ((start . "oops") (end . "10"))))))))
+
+(ert-deftest jabber-test-reactions-reaction-only-p-accepts-childless-fallback 
()
+  "A reaction fallback with no child elements covers the whole body."
+  (should
+   (jabber-reactions--reaction-only-p
+    `(message ((from . "jul...@example.com") (type . "chat"))
+              (body nil "> quoted\n👍")
+              (reactions ((xmlns . ,jabber-reactions-xmlns)
+                          (id . "target-1"))
+                         (reaction nil "👍"))
+              (fallback ((xmlns . "urn:xmpp:fallback:0")
+                         (for . ,jabber-reactions-xmlns)))))))
+
+(ert-deftest jabber-test-reactions-reaction-only-p-accepts-body-child-fallback 
()
+  "A reaction fallback with a bare body child covers the whole body."
+  (should
+   (jabber-reactions--reaction-only-p
+    `(message ((from . "jul...@example.com") (type . "chat"))
+              (body nil "> quoted\n👍")
+              (reactions ((xmlns . ,jabber-reactions-xmlns)
+                          (id . "target-1"))
+                         (reaction nil "👍"))
+              (fallback ((xmlns . "urn:xmpp:fallback:0")
+                         (for . ,jabber-reactions-xmlns))
+                        (body nil))))))
+
 (ert-deftest jabber-test-reactions-react-allows-custom-picker-input ()
   "Outgoing reaction picker accepts custom reactions outside defaults."
   (let ((sent nil)
@@ -142,6 +255,7 @@
                  "🔥"))
               ((symbol-function 'jabber-send-sexp)
                (lambda (_jc stanza) (setq sent stanza)))
+              ((symbol-function 'jabber-db-replace-reactions) #'ignore)
               ((symbol-function 'jabber-reactions--optimistic-update) 
#'ignore))
       (with-temp-buffer
         (setq-local jabber-buffer-connection 'fake-jc)
@@ -173,6 +287,7 @@
                  (lambda (_jc _xml-data) (cons inner nil)))
                 ((symbol-function 'jabber-chat-find-buffer)
                  (lambda (_chat-with) (current-buffer)))
+                ((symbol-function 'jabber-db-replace-reactions) #'ignore)
                 ((symbol-function 'jabber-chat-ewoc-find-by-id)
                  (lambda (_stanza-id) node))
                 ((symbol-function 'jabber-chat-ewoc-invalidate) #'ignore))
@@ -201,6 +316,7 @@
                  (lambda (_jc _xml-data) (cons inner carbon-buffer)))
                 ((symbol-function 'jabber-chat-find-buffer)
                  (lambda (_chat-with) nil))
+                ((symbol-function 'jabber-db-replace-reactions) #'ignore)
                 ((symbol-function 'jabber-chat-ewoc-find-by-id)
                  (lambda (_stanza-id) node))
                 ((symbol-function 'jabber-chat-ewoc-invalidate) #'ignore))
@@ -208,5 +324,127 @@
         (should (equal (plist-get (cadr (ewoc-data node)) :reactions)
                        '(("ro...@example.com" . ("🔥")))))))))
 
+(ert-deftest 
jabber-test-reactions-message-updated-at-returns-nil-without-delay ()
+  "Reaction source timestamps are nil when no delay is present."
+  (should-not (jabber-reactions--message-updated-at '(message nil))))
+
+(ert-deftest jabber-test-reactions-handle-invisible-target-persists ()
+  "Incoming reactions persist even when no visible target node exists."
+  (jabber-test-reactions-with-db
+   (jabber-db-store-message "ro...@example.com" "jul...@example.com"
+                            "in" "chat" "hello" 1000 nil "target-1")
+   (let ((xml `(message ((from . "jul...@example.com/laptop")
+                         (to . "ro...@example.com")
+                         (type . "chat"))
+                        (reactions ((xmlns . ,jabber-reactions-xmlns)
+                                    (id . "target-1"))
+                                   (reaction nil "👍"))
+                        (delay ((xmlns . "urn:xmpp:delay")
+                                (stamp . "2025-01-15T10:30:00Z"))))))
+     (cl-letf (((symbol-function 'jabber-connection-bare-jid)
+                (lambda (_jc) "ro...@example.com"))
+               ((symbol-function 'jabber-chat-find-buffer)
+                (lambda (_chat-with) nil)))
+       (jabber-reactions--handle-message 'fake-jc xml))
+     (let* ((entry (car (jabber-db-backlog
+                         "ro...@example.com" "jul...@example.com")))
+            (reactions (plist-get entry :reactions))
+            (updated-at (caar (sqlite-select jabber-db--connection
+                               "SELECT updated_at FROM message_reaction"))))
+       (should (equal reactions '(("jul...@example.com" . ("👍")))))
+       (should (= updated-at
+                  (floor (float-time (date-to-time 
"2025-01-15T10:30:00Z")))))))))
+
+(ert-deftest jabber-test-reactions-handle-stale-after-empty-does-not-resurrect 
()
+  "Incoming stale reactions do not overwrite a newer empty replacement."
+  (jabber-test-reactions-with-db
+   (jabber-db-store-message "ro...@example.com" "jul...@example.com"
+                            "in" "chat" "hello" 1000 nil "target-1")
+   (cl-labels ((reaction-message
+                (stamp &rest reactions)
+                `(message ((from . "jul...@example.com/laptop")
+                           (to . "ro...@example.com")
+                           (type . "chat"))
+                          (reactions ((xmlns . ,jabber-reactions-xmlns)
+                                      (id . "target-1"))
+                                     ,@(mapcar (lambda (reaction)
+                                                 `(reaction nil ,reaction))
+                                               reactions))
+                          (delay ((xmlns . "urn:xmpp:delay")
+                                  (stamp . ,stamp))))))
+     (cl-letf (((symbol-function 'jabber-connection-bare-jid)
+                (lambda (_jc) "ro...@example.com"))
+               ((symbol-function 'jabber-chat-find-buffer)
+                (lambda (_chat-with) nil)))
+       (jabber-reactions--handle-message
+        'fake-jc (reaction-message "2025-01-15T10:30:00Z" "👍"))
+       (jabber-reactions--handle-message
+        'fake-jc (reaction-message "2025-01-15T10:31:00Z"))
+       (jabber-reactions--handle-message
+        'fake-jc (reaction-message "2025-01-15T10:30:30Z" "🎉")))
+     (let ((entry (car (jabber-db-backlog
+                        "ro...@example.com" "jul...@example.com"))))
+       (should-not (plist-get entry :reactions))))))
+
+(ert-deftest jabber-test-reactions-handle-visible-stale-update-is-ignored ()
+  "Incoming stale delayed reactions do not overwrite visible buffer state."
+  (jabber-test-reactions-with-db
+   (jabber-db-store-message "ro...@example.com" "jul...@example.com"
+                            "in" "chat" "hello" 1000 nil "target-1")
+   (jabber-db-replace-reactions "ro...@example.com" "jul...@example.com"
+                                "chat" "target-1" "jul...@example.com"
+                                '("🎉")
+                                (floor (float-time
+                                        (date-to-time 
"2025-01-15T10:31:00Z"))))
+   (with-temp-buffer
+     (let* ((jabber-chat-ewoc (ewoc-create #'ignore))
+            (msg '(:id "target-1" :body "hello"
+                   :reactions (("jul...@example.com" . ("🎉")))))
+            (node (ewoc-enter-last jabber-chat-ewoc (list :foreign msg)))
+            (xml `(message ((from . "jul...@example.com/laptop")
+                            (to . "ro...@example.com")
+                            (type . "chat"))
+                           (reactions ((xmlns . ,jabber-reactions-xmlns)
+                                       (id . "target-1"))
+                                      (reaction nil "👍"))
+                           (delay ((xmlns . "urn:xmpp:delay")
+                                   (stamp . "2025-01-15T10:30:00Z"))))))
+       (cl-letf (((symbol-function 'jabber-connection-bare-jid)
+                  (lambda (_jc) "ro...@example.com"))
+                 ((symbol-function 'jabber-chat-find-buffer)
+                  (lambda (_chat-with) (current-buffer)))
+                 ((symbol-function 'jabber-chat-ewoc-find-by-id)
+                  (lambda (_stanza-id) node))
+                 ((symbol-function 'jabber-chat-ewoc-invalidate) #'ignore))
+         (jabber-reactions--handle-message 'fake-jc xml)
+         (should (equal (plist-get (cadr (ewoc-data node)) :reactions)
+                        '(("jul...@example.com" . ("🎉"))))))))))
+
+(ert-deftest jabber-test-reactions-handle-live-same-second-updates ()
+  "No-delay incoming reactions apply in arrival order."
+  (jabber-test-reactions-with-db
+   (jabber-db-store-message "ro...@example.com" "jul...@example.com"
+                            "in" "chat" "hello" 1000 nil "target-1")
+   (cl-labels ((reaction-message
+                (reaction)
+                `(message ((from . "jul...@example.com/laptop")
+                           (to . "ro...@example.com")
+                           (type . "chat"))
+                          (reactions ((xmlns . ,jabber-reactions-xmlns)
+                                      (id . "target-1"))
+                                     (reaction nil ,reaction)))))
+     (cl-letf (((symbol-function 'jabber-connection-bare-jid)
+                (lambda (_jc) "ro...@example.com"))
+               ((symbol-function 'jabber-chat-find-buffer)
+                (lambda (_chat-with) nil))
+               ((symbol-function 'float-time)
+                (lambda (&optional _time) 1234.0)))
+       (jabber-reactions--handle-message 'fake-jc (reaction-message "👍"))
+       (jabber-reactions--handle-message 'fake-jc (reaction-message "🎉")))
+     (let* ((entry (car (jabber-db-backlog
+                         "ro...@example.com" "jul...@example.com")))
+            (reactions (plist-get entry :reactions)))
+       (should (equal reactions '(("jul...@example.com" . ("🎉")))))))))
+
 (provide 'jabber-test-reactions)
 ;;; jabber-test-reactions.el ends here