A WhatsApp (Web) transport for XMPP.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

52 lines
1.9KB

  1. (in-package :whatsxmpp)
  2. (defun get-disco-info (comp to &optional from)
  3. "Send an XEP-0030 disco#info request. Returns a promise that resolves with a list of supported features."
  4. (attach
  5. (with-iq (comp to :from from)
  6. (cxml:with-element "query"
  7. (cxml:attribute "xmlns" +disco-info-ns+)))
  8. (lambda (results)
  9. (let ((query-node (get-node-named results "query"))
  10. (features '()))
  11. (unless query-node
  12. (error "Malformed disco#info response: no <query/>"))
  13. (loop
  14. for node across (child-elements query-node)
  15. do (let ((name (dom:tag-name node)))
  16. (when (equal name "feature")
  17. (setf features (cons (dom:get-attribute node "var") features)))))
  18. features))))
  19. (defun get-disco-items (comp to &optional from)
  20. "Send an XEP-0030 disco#items request. Returns a promise that resolves with an alist, mapping JIDs to names."
  21. (attach
  22. (with-iq (comp to :from from)
  23. (cxml:with-element "query"
  24. (cxml:attribute "xmlns" +disco-items-ns+)))
  25. (lambda (results)
  26. (let ((query-node (get-node-named results "query"))
  27. (items '()))
  28. (unless query-node
  29. (error "Malformed disco#items response: no <query/>"))
  30. (loop
  31. for node across (child-elements query-node)
  32. do (let ((name (dom:tag-name node)))
  33. (when (equal name "item")
  34. (setf items (cons
  35. (cons (dom:get-attribute node "jid") (dom:get-attribute node "name"))
  36. items)))))
  37. items))))
  38. (defmacro disco-identity (name type category)
  39. `(cxml:with-element "identity"
  40. ,@(when name
  41. `((cxml:attribute "name" ,name)))
  42. (cxml:attribute "type" ,type)
  43. (cxml:attribute "category" ,category)))
  44. (defmacro disco-feature (feature)
  45. `(cxml:with-element "feature"
  46. (cxml:attribute "var" ,feature)))