accordius.lisp

(defun do-wl-rest-mutate (mutation-type endpoint post-params auth-token)
  (drakma:http-request
   (quri:render-uri (quri:merge-uris (quri:make-uri :path endpoint :query "") (quri:uri (rest-api-uri *current-backend*))))
   :method mutation-type
   :parameters post-params
   :additional-headers `(("authorization" . ,auth-token)))
  )

(define-backend-operation do-lw2-mutation backend-accordius (auth-token target-type mutation-type terms fields)
  (setf endpoint
   (case target-type
	 (:post "posts")
	 (:comment "comments")
	 ))
  (cond ((eq mutation-type :post) (do-wl-rest-mutate :post endpoint terms auth-token))
	((eq mutation-type :delete) (do-wl-rest-mutate :delete endpoint terms auth-token))))
   

lw2-login.lisp

(defun do-lw2-comment-remove (auth-token comment-id)
  (do-lw2-mutation auth-token :comment :delete (alist :document-id comment-id) '(----typename)))

lw2.lisp

(define-page view-post-lw2-link (:function #'match-lw2-link post-id comment-id * comment-link-type) (need-auth chrono)
  (request-method
    (:get ()
     (let ((lw2-auth-token *current-auth-token*))
       (labels ((output-comments (out-stream id comments target)
                  (format out-stream "<div id=\"~A\" class=\"comments\">" id)
                  (with-error-html-block (out-stream)
                    (if target
                        (comment-thread-to-html out-stream
                                                (lambda ()
                                                  (comment-item-to-html
                                                    out-stream
                                                    target
                                                    :extra-html-fn (lambda (c-id)
                                                                     (let ((*comment-individual-link* nil))
                                                                       (comment-tree-to-html out-stream (make-comment-parent-hash comments) c-id))))))
                        (if comments
			    (if chrono
				(comment-chrono-to-html out-stream comments)
				(comment-tree-to-html out-stream (make-comment-parent-hash comments)))
			    <div class="comments-empty-message">(if (string= id "answers") "No answers." "No comments.")</div>)))
		  (format out-stream "</div>"))
		(output-comments-votes (out-stream)
                  (handler-case
                    (when lw2-auth-token
                      (format out-stream "<script>commentVotes=~A</script>"
                              (json:encode-json-to-string (get-post-comments-votes post-id lw2-auth-token))))
                    (t () nil)))
                (output-post-vote (out-stream)
                  (handler-case
                    (format out-stream "<script>postVote=~A</script>"
                            (json:encode-json-to-string (get-post-vote post-id lw2-auth-token)))
                    (t () nil))))
         (multiple-value-bind (post title condition)
           (handler-case (nth-value 0 (get-post-body post-id :auth-token (and need-auth lw2-auth-token)))
             (serious-condition (c) (values nil "Error" c))
             (:no-error (post) (values post (cdr (assoc :title post)) nil)))
           (if comment-id
	       (let* ((*comment-individual-link* t)
		      (comment-thread-type (if (string= comment-link-type "answer") :answer :comment))
		      (comments (case comment-thread-type
				  (:comment (get-post-comments post-id))
				  (:answer (get-post-answers post-id))))
		      (target-comment (find comment-id comments :key (lambda (c) (cdr (assoc :--id c))) :test #'string=))
		      (display-name (get-username (cdr (assoc :user-id target-comment))))
		      (verb-phrase (cond
				     ((and (eq comment-thread-type :answer)
					   (not (cdr (assoc :parent-comment-id target-comment))))
				      "answers")
				     (t "comments on"))))
		 (emit-page (out-stream :title (format nil "~A ~A ~A" display-name verb-phrase title)
					:content-class "individual-thread-page comment-thread-page")
			    (format out-stream "<h1 class=\"post-title\">~A ~A <a href=\"~A\">~A</a></h1>"
				    (encode-entities display-name)
				    verb-phrase
				    (generate-post-link post-id)
				    (clean-text-to-html title :hyphenation nil))
			    (output-comments out-stream "comments" comments target-comment)
			    (when lw2-auth-token
			      (force-output out-stream)
			      (output-comments-votes out-stream))))
	     (emit-page (out-stream :title title :content-class (format nil "post-page comment-thread-page~:[~; question-post-page~]" (cdr (assoc :question post))))
			(cond
			  (condition
                            (error-to-html out-stream condition))
                          (t
                           (post-body-to-html post)))
                        (when (and lw2-auth-token (equal (logged-in-userid) (cdr (assoc :user-id post))))
                          (format out-stream "<div class=\"post-controls\"><a class=\"edit-post-link button\" href=\"/edit-post?post-id=~A\" accesskey=\"e\" title=\"Edit post [e]\">Edit post</a></div>"
                                  (cdr (assoc :--id post))))
                        (force-output out-stream)
			(handler-case
			    (let* ((question (cdr (assoc :question post)))
				   (answers (when question
					      (get-post-answers post-id)))
				   (comments (get-post-comments post-id)))
			      (when question
				(output-comments out-stream "answers" answers nil))
			      (output-comments out-stream "comments" comments nil))
			  (serious-condition (c) (error-to-html out-stream c)))
			(when lw2-auth-token
                          (force-output out-stream)
                          (output-post-vote out-stream)
                          (output-comments-votes out-stream))))))))
    (:post (csrf-token text answer parent-answer-id parent-comment-id edit-comment-id retract-comment-id unretract-comment-id delete-comment-id)
     (let ((lw2-auth-token *current-auth-token*))
       (check-csrf-token csrf-token)
       (assert lw2-auth-token)
       (let ((question (cdr (assoc :question (get-post-body post-id :auth-token lw2-auth-token))))
	     (new-comment-id
	      (cond
		(text
		 (let ((comment-data
			(list-cond
			 (t :body (postprocess-markdown text))
			 (t :last-edited-as "markdown")
			 ((not edit-comment-id) :post-id post-id)
			 (parent-comment-id :parent-comment-id parent-comment-id)
			 (answer :answer t)
			 (parent-answer-id :parent-answer-id parent-answer-id))))
		   (if edit-comment-id
		       (prog1 edit-comment-id
			 (do-lw2-comment-edit lw2-auth-token edit-comment-id comment-data))
		       (do-lw2-comment lw2-auth-token comment-data))))
		(retract-comment-id
		 (do-lw2-comment-edit lw2-auth-token retract-comment-id '((:retracted . t))))
		(unretract-comment-id
		 (do-lw2-comment-edit lw2-auth-token unretract-comment-id '((:retracted . nil))))
		(delete-comment-id
		 (do-lw2-comment-remove lw2-auth-token delete-comment-id)
									 
		 nil))))
	 (ignore-errors
	   (get-post-comments post-id :force-revalidate t)
	   (when question
	     (get-post-answers post-id :force-revalidate t)))
	 (when text
	   (cache-put "comment-markdown-source" new-comment-id text)
	   (redirect (generate-post-link (match-lw2-link (hunchentoot:request-uri*)) new-comment-id))))))))