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:
Griffin Smith 2020-07-30 23:05:19 -04:00 committed by glittershark
parent 94796399e2
commit 37540b3ed7
3 changed files with 64 additions and 4 deletions

View file

@ -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

View file

@ -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

View file

@ -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