Encode links’ properties & titles as JSON objects

This commit is contained in:
Jaidyn Ann 2023-07-28 05:50:49 -05:00
parent ed9bcc60cc
commit b34ca289a3

View File

@ -24,6 +24,8 @@
"Given the USERs information, return the applicable Webfinger JSON. "Given the USERs information, return the applicable Webfinger JSON.
Details of the values of USER, HOST, ALIASES, PROPERTIES, and LINKS can be found Details of the values of USER, HOST, ALIASES, PROPERTIES, and LINKS can be found
in the docstring of SERVER." in the docstring of SERVER."
(let ((yason:*symbol-key-encoder* #'yason:encode-symbol-as-lowercase)
(yason:*symbol-encoder* #'yason:encode-symbol-as-lowercase))
(yason:with-output-to-string* () (yason:with-output-to-string* ()
(yason:with-object () (yason:with-object ()
(yason:encode-object-element (yason:encode-object-element
@ -38,7 +40,18 @@ in the docstring of SERVER."
(when (and links (listp links)) (when (and links (listp links))
(yason:encode-object-element (yason:encode-object-element
"links" "links"
(mapcar #'alexandria:plist-hash-table links)))))) ;; Each link needs to be a hash-table (so it's encoded as a JSON object.
(mapcar
(lambda (link)
;; Each links properties/titles need to be hash-tables, likewise.
(let ((properties (getf link 'properties))
(titles (getf link 'titles)))
(when (and properties (not (hash-table-p properties)))
(setf (getf link 'properties) (alexandria:plist-hash-table properties)))
(when (and titles (not (hash-table-p titles)))
(setf (getf link 'titles) (alexandria:plist-hash-table titles))))
(alexandria:plist-hash-table link))
links)))))))
(defun fake-info-func (user host) (defun fake-info-func (user host)
@ -49,10 +62,10 @@ in the docstring of SERVER."
:host host :host host
:aliases (list profile "https://example.example/users/old-user") :aliases (list profile "https://example.example/users/old-user")
:links :links
`((href profile `((href ,profile
rel "http://webfinger.net/rel/profile-page" rel "http://webfinger.net/rel/profile-page"
type "text/html" type "text/html"
properties ,(alexandria:plist-hash-table '(:apple 3 :bear 4))) properties (:apple 3 :bear 4))
(href ,profile (href ,profile
rel "self" rel "self"
type "application/activity+json"))))) type "application/activity+json")))))