From b8760ac94879b74d330276e8615c0198c62c2ac0 Mon Sep 17 00:00:00 2001 From: eta Date: Thu, 28 May 2020 14:02:37 +0100 Subject: [PATCH] Initial support for typing notifications / chat state (1-to-1 only) --- stuff.lisp | 69 +++++++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 66 insertions(+), 3 deletions(-) diff --git a/stuff.lisp b/stuff.lisp index ce937ec..8a0127c 100644 --- a/stuff.lisp +++ b/stuff.lisp @@ -19,6 +19,8 @@ (defparameter +muc-stable-id-ns+ "http://jabber.org/protocol/muc#stable_id") (defparameter +muc-user-ns+ "http://jabber.org/protocol/muc#user") (defparameter +unique-stanzas-ns+ "urn:xmpp:sid:0") +(defparameter +chat-states-ns+ "http://jabber.org/protocol/chatstates") +(defparameter +hints-ns+ "urn:xmpp:hints") (defvar *xmpp-debug-io* (make-broadcast-stream)) (defvar *xmpp-debug-out* (make-synonym-stream '*xmpp-debug-io*)) @@ -559,7 +561,8 @@ (id (dom:get-attribute stanza "id")) (children (dom:child-nodes stanza)) (body (get-node-named children "body")) - (marker (get-node-with-xmlns children +chat-markers-ns+))) + (marker (get-node-with-xmlns children +chat-markers-ns+)) + (chat-state (get-node-with-xmlns children +chat-states-ns+))) (cond (body (let* ((child-nodes (dom:child-nodes body)) @@ -571,6 +574,9 @@ (let ((marker-type (dom:tag-name marker)) (msgid (dom:get-attribute marker "id"))) (emit :message-marker comp :from from :to to :type marker-type :marker-id msgid :id id :stanza stanza))) + (chat-state + (let ((state-type (dom:tag-name chat-state))) + (emit :chat-state comp :from from :to to :type state-type :id id :stanza stanza))) (t (emit :message comp :from from :to to :id id :stanza stanza))))) @@ -707,7 +713,6 @@ Commands: (cxml:with-element "status" (cxml:text status)))) - (defun wa-resetup-users (comp) "Go through the list of WhatsApp users and reconnect those whose connections have dropped." (with-component-data-lock (comp) @@ -900,6 +905,7 @@ WhatsXMPP represents users as u440123456789 and groups as g1234-5678." (update-session-data jid sessdata) (admin-msg comp jid status) (admin-presence comp jid status) + (whatscl::send-presence conn :available) (format *debug-io* "~&ws-connected: ~A (as ~A)~%" jid wa-jid)))) (defun wa-handle-error-status-code (comp conn jid err) @@ -1002,6 +1008,8 @@ WhatsXMPP represents users as u440123456789 and groups as g1234-5678." (cxml:with-element "delay" (cxml:attribute "xmlns" +delivery-delay-ns+) (cxml:attribute "stamp" (local-time:format-timestring nil ts))) + (cxml:with-element "active" + (cxml:attribute "xmlns" +chat-states-ns+)) (when (and group-localpart (not ,suppress-insert)) (cxml:with-element "stanza-id" (cxml:attribute "xmlns" +unique-stanzas-ns+) @@ -1544,6 +1552,25 @@ Returns three values: avatar data (as two values), and a generalized boolean spe (sqlite:reset-statement insert-member-stmt))) (handle-wa-chat-invitation comp conn jid uid localpart :noretry t)))))) +(defun wa-handle-presence (comp conn jid &key for-jid type participant &allow-other-keys) + (with-wa-handler-context (comp conn jid) + (let* ((localpart (wa-jid-to-whatsxmpp-localpart for-jid)) + (chat-state + (cond + ((eql type :composing) "composing") + ((eql type :paused) "paused") + ((eql type :available) "active") + (t (return-from wa-handle-presence))))) + (unless participant ; Groups hard + (let ((from-jid (concatenate 'string + localpart + "@" + (component-name comp)))) + (with-message (comp jid + :from from-jid) + (cxml:with-element chat-state + (cxml:attribute "xmlns" +chat-states-ns+)))))))) + (defun bind-wa-handlers (comp conn jid) (on :ws-open conn (lambda () (wa-handle-ws-open comp conn jid))) (on :ws-close conn (lambda (&rest args) @@ -1566,6 +1593,10 @@ Returns three values: avatar data (as two values), and a generalized boolean spe (on :status-change conn (lambda (for-jid status) (wa-handle-status-change comp conn jid for-jid status))) + (on :presence conn (lambda (&key of type participant &allow-other-keys) + (wa-handle-presence comp conn jid + :for-jid of :type type + :participant participant))) (on :connected conn (lambda (waj) (wa-handle-ws-connected comp conn jid waj)))) (defun handle-setup-user (comp jid) @@ -1861,7 +1892,8 @@ Returns three values: avatar data (as two values), and a generalized boolean spe (when conn (loop for localpart in (get-contact-localparts uid) - do (handle-wa-contact-presence comp conn stripped localpart)))))) + do (handle-wa-contact-presence comp conn stripped localpart)) + (whatscl::send-presence conn :available))))) (t nil)))))) (defun whatsxmpp-presence-probe-handler (comp &key from to id &allow-other-keys) @@ -1908,6 +1940,34 @@ Returns three values: avatar data (as two values), and a generalized boolean spe :text "That user's JID isn't in a recognizable format." :type "modify")))))) +(defun whatsxmpp-chat-state-handler (comp &key from to type &allow-other-keys) + "Handles a chat state sent to the whatsxmpp bridge." + (with-component-data-lock (comp) + (multiple-value-bind (to-hostname to-localpart) + (parse-jid to) + (declare (ignore to-hostname)) + (format *debug-io* "~&chat state: ~A is ~A to ~A~%" from type to) + (let* ((stripped (strip-resource from)) + (uid (get-user-id stripped)) + (conn (gethash stripped (component-whatsapps comp))) + (wa-jid (whatsxmpp-localpart-to-wa-jid to-localpart)) + (presence-type + (cond + ((string= type "composing") :composing) + ((string= type "paused") :paused) + ((string= type "active") :available) + (t (return-from whatsxmpp-chat-state-handler))))) + (unless uid + (warn "Got chat state for user that isn't registered") + (return-from whatsxmpp-chat-state-handler)) + (unless wa-jid + (return-from whatsxmpp-chat-state-handler)) + (unless conn + (warn "Can't send chat state, since user connection is offline")) + (whatscl::send-presence conn presence-type + (unless (eql presence-type :active) + wa-jid)))))) + (defun whatsxmpp-marker-handler (comp &key from to type marker-id id &allow-other-keys) "Handles a message marker sent to the whatsxmpp bridge." (with-component-data-lock (comp) @@ -1994,6 +2054,7 @@ Returns three values: avatar data (as two values), and a generalized boolean spe :muc-resource user-resource :result result))) (msgid (whatscl::send-simple-text-message conn wa-jid body callback))) + (whatscl::send-presence conn :available) (insert-user-message uid id msgid))))))))) (defun whatsxmpp-load-users (comp) @@ -2033,6 +2094,8 @@ Returns three values: avatar data (as two values), and a generalized boolean spe (apply #'whatsxmpp-presence-unavailable-handler ret args))) (on :presence ret (lambda (&rest args) (apply #'whatsxmpp-presence-handler ret args))) + (on :chat-state ret (lambda (&rest args) + (apply #'whatsxmpp-chat-state-handler ret args))) (register-whatsxmpp-handlers ret) (whatsxmpp-load-users ret) (setf (component-reconnect-timer ret) (trivial-timers:make-timer