jadedctrl/webtentacle
jadedctrl/ webtentacle
1
0
Disbranĉigi 0
Fontkodo Issues Tirpetoj Activity

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
1 changed files with 30 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
webtentacle.lisp
View File

@ -24,21 +24,34 @@
"Given the USER’s information, return the applicable Webfinger JSON. "Given the USER’s 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."
(yason:with-output-to-string* () (let ((yason:*symbol-key-encoder* #'yason:encode-symbol-as-lowercase)
(yason:with-object () (yason:*symbol-encoder* #'yason:encode-symbol-as-lowercase))
(yason:encode-object-element (yason:with-output-to-string* ()
"subject" (yason:with-object ()
(concatenate 'string "acct:" user "@" host)) (yason:encode-object-element
(when (and aliases (listp aliases)) "subject"
(yason:encode-object-element "aliases" aliases)) (concatenate 'string "acct:" user "@" host))
(when (and properties (listp properties)) (when (and aliases (listp aliases))
(yason:encode-object-element (yason:encode-object-element "aliases" aliases))
"properties" (when (and properties (listp properties))
(alexandria:plist-hash-table properties))) (yason:encode-object-element
(when (and links (listp links)) "properties"
(yason:encode-object-element (alexandria:plist-hash-table properties)))
"links" (when (and links (listp links))
(mapcar #'alexandria:plist-hash-table links)))))) (yason:encode-object-element
"links"
;; Each link needs to be a hash-table (so it's encoded as a JSON object.
(mapcar
(lambda (link)
;; Each link’s 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")))))