feat(web/panettone): Render issues+comments as Markdown
Use the new cheddar markdown endpoint to render issue bodies and comment bodies as JSON. I've checked, and this *also* appears to be XSS safe (yay) Change-Id: Ib4b19fd581b0cf40ba03f5d13443535d17df6632 Reviewed-on: https://cl.tvl.fyi/c/depot/+/1500 Reviewed-by: tazjin <mail@tazj.in> Tested-by: BuildkiteCI
This commit is contained in:
parent
94796399e2
commit
37540b3ed7
3 changed files with 64 additions and 4 deletions
|
@ -4,6 +4,7 @@ depot.nix.buildLisp.program {
|
||||||
name = "panettone";
|
name = "panettone";
|
||||||
|
|
||||||
deps = with depot.third_party.lisp; [
|
deps = with depot.third_party.lisp; [
|
||||||
|
cl-json
|
||||||
cl-who
|
cl-who
|
||||||
drakma
|
drakma
|
||||||
defclass-std
|
defclass-std
|
||||||
|
|
|
@ -40,7 +40,7 @@
|
||||||
:panettone.util
|
:panettone.util
|
||||||
:panettone.authentication)
|
:panettone.authentication)
|
||||||
(:import-from :defclass-std :defclass/std)
|
(:import-from :defclass-std :defclass/std)
|
||||||
(:import-from :alexandria :if-let :when-let :switch)
|
(:import-from :alexandria :if-let :when-let :switch :alist-hash-table)
|
||||||
(:import-from
|
(:import-from
|
||||||
:panettone.model
|
:panettone.model
|
||||||
:id :subject :body :author-dn :issue-id :status :created-at
|
:id :subject :body :author-dn :issue-id :status :created-at
|
||||||
|
|
|
@ -1,6 +1,62 @@
|
||||||
(in-package :panettone)
|
(in-package :panettone)
|
||||||
(declaim (optimize (safety 3)))
|
(declaim (optimize (safety 3)))
|
||||||
|
|
||||||
|
(defvar *cheddar-url* "http://localhost:4238")
|
||||||
|
|
||||||
|
(defgeneric render-markdown (markdown)
|
||||||
|
(:documentation
|
||||||
|
"Render the argument, or the elements of the argument, as markdown, and return
|
||||||
|
the same structure"))
|
||||||
|
|
||||||
|
(defmethod render-markdown ((markdown string))
|
||||||
|
(cdr
|
||||||
|
(assoc :markdown
|
||||||
|
(cl-json:decode-json
|
||||||
|
(drakma:http-request
|
||||||
|
(concatenate 'string
|
||||||
|
*cheddar-url*
|
||||||
|
"/markdown")
|
||||||
|
:accept "application/json"
|
||||||
|
:method :post
|
||||||
|
:content-type "application/json"
|
||||||
|
:external-format-out :utf-8
|
||||||
|
:external-format-in :utf-8
|
||||||
|
:content (json:encode-json-to-string
|
||||||
|
`((markdown . ,markdown)))
|
||||||
|
:want-stream t)))))
|
||||||
|
|
||||||
|
(defmethod render-markdown ((markdown hash-table))
|
||||||
|
(alist-hash-table
|
||||||
|
(cl-json:decode-json
|
||||||
|
(drakma:http-request
|
||||||
|
(concatenate 'string
|
||||||
|
*cheddar-url*
|
||||||
|
"/markdown")
|
||||||
|
:accept "application/json"
|
||||||
|
:method :post
|
||||||
|
:content-type "application/json"
|
||||||
|
:external-format-out :utf-8
|
||||||
|
:external-format-in :utf-8
|
||||||
|
:content (json:encode-json-to-string markdown)
|
||||||
|
:want-stream t))))
|
||||||
|
|
||||||
|
(defun markdownify-comment-bodies (comments)
|
||||||
|
"Convert the bodies of the given list of comments to markdown in-place using
|
||||||
|
Cheddar, and return nothing"
|
||||||
|
(let ((in (make-hash-table))
|
||||||
|
(comment-table (make-hash-table)))
|
||||||
|
(dolist (comment comments)
|
||||||
|
(check-type comment model:issue-comment)
|
||||||
|
(setf (gethash (id comment) in) (body comment))
|
||||||
|
(setf (gethash (id comment) comment-table) comment))
|
||||||
|
(let ((res (render-markdown in)))
|
||||||
|
(iter (for (comment-id markdown-body) in-hashtable res)
|
||||||
|
(let ((comment-id (parse-integer (symbol-name comment-id))))
|
||||||
|
(setf (slot-value (gethash comment-id comment-table)
|
||||||
|
'model:body)
|
||||||
|
markdown-body)))))
|
||||||
|
(values))
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
;;; Views
|
;;; Views
|
||||||
;;;
|
;;;
|
||||||
|
@ -196,7 +252,7 @@
|
||||||
(who:htm
|
(who:htm
|
||||||
(:li
|
(:li
|
||||||
:class "comment"
|
:class "comment"
|
||||||
(:p (who:esc (body comment)))
|
(:p (who:str (body comment)))
|
||||||
(:p
|
(:p
|
||||||
:class "comment-info"
|
:class "comment-info"
|
||||||
(:span :class "username"
|
(:span :class "username"
|
||||||
|
@ -249,7 +305,7 @@
|
||||||
:value (case issue-status
|
:value (case issue-status
|
||||||
(:open "Close")
|
(:open "Close")
|
||||||
(:closed "Reopen")))))))
|
(:closed "Reopen")))))))
|
||||||
(:p (who:esc (body issue)))
|
(:p (who:str (render-markdown (body issue))))
|
||||||
(let* ((comments (issue-comments issue))
|
(let* ((comments (issue-comments issue))
|
||||||
(events (issue-events issue))
|
(events (issue-events issue))
|
||||||
(history (merge 'list
|
(history (merge 'list
|
||||||
|
@ -257,6 +313,7 @@
|
||||||
events
|
events
|
||||||
#'local-time:timestamp<
|
#'local-time:timestamp<
|
||||||
:key #'created-at)))
|
:key #'created-at)))
|
||||||
|
(markdownify-comment-bodies comments)
|
||||||
(who:htm
|
(who:htm
|
||||||
(:ol
|
(:ol
|
||||||
:class "issue-history"
|
:class "issue-history"
|
||||||
|
@ -410,7 +467,9 @@
|
||||||
|
|
||||||
(defun main ()
|
(defun main ()
|
||||||
(let ((port (integer-env "PANETTONE_PORT" :default 6161))
|
(let ((port (integer-env "PANETTONE_PORT" :default 6161))
|
||||||
(ldap-port (integer-env "LDAP_PORT" :default 389)))
|
(ldap-port (integer-env "LDAP_PORT" :default 389))
|
||||||
|
(cheddar-url (uiop:getenvp "CHEDDAR_URL")))
|
||||||
|
(when cheddar-url (setq *cheddar-url* cheddar-url))
|
||||||
(setq hunchentoot:*show-lisp-backtraces-p* nil)
|
(setq hunchentoot:*show-lisp-backtraces-p* nil)
|
||||||
(setq hunchentoot:*log-lisp-backtraces-p* nil)
|
(setq hunchentoot:*log-lisp-backtraces-p* nil)
|
||||||
(start-panettone :port port
|
(start-panettone :port port
|
||||||
|
|
Loading…
Reference in a new issue