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.

32 lines
1.5KB

  1. ;;;; XEP-0313: Message Archive Management
  2. (in-package :whatsxmpp)
  3. (defun whitelisted-mam-keywordize (thing)
  4. "Interns THING, but only after making sure it's a string from XEP-0313."
  5. (if (member thing '("start" "end" "with" "first" "last" "count" "max" "FORM_TYPE" "after" "before")
  6. :test #'string=)
  7. (intern (string-upcase thing) :keyword)
  8. thing))
  9. (defun alist-from-mam-query (query-elt)
  10. "Parses the QUERY-ELT, a MAM <query> element, and returns an alist."
  11. (labels ((consify-df (field-elt)
  12. (cons (whitelisted-mam-keywordize
  13. (dom:get-attribute field-elt "var"))
  14. (nil-empty
  15. (get-node-text
  16. (get-node-named (child-elements field-elt) "value")))))
  17. (consify-rsm (rsm-elt)
  18. (cons (whitelisted-mam-keywordize
  19. (dom:node-name rsm-elt))
  20. (nil-empty (get-node-text rsm-elt)))))
  21. (let* ((x-elt (get-node-with-xmlns (child-elements query-elt) +data-forms-ns+))
  22. (rsm-elt (get-node-with-xmlns (child-elements query-elt) +rsm-ns+))
  23. (query-id (dom:get-attribute query-elt "queryid"))
  24. (form-fields (map 'list #'consify-df (child-elements x-elt)))
  25. (rsm-fields (when rsm-elt
  26. (map 'list #'consify-rsm (child-elements rsm-elt)))))
  27. (append form-fields rsm-fields (when query-id
  28. `((:query-id . ,query-id)))))))