feat(panettone): Send email notifications for comments
When a user posts a comment on an issue, send email notifications (respecting the enable-email-notifications setting) to the author of that issue and all the other users who have commented on that issue. Since the oauth & gmail API stuff that the relay does is slow, this happens in a background thread. Change-Id: Ic00c265deab1030d9ba64c29c9f56314dd179141 Reviewed-on: https://cl.tvl.fyi/c/depot/+/2805 Tested-by: BuildkiteCI Reviewed-by: sterni <sternenseemann@systemli.org> Reviewed-by: tazjin <mail@tazj.in>
This commit is contained in:
parent
349b98ccc8
commit
8d3ab61e7c
4 changed files with 46 additions and 2 deletions
|
@ -4,6 +4,7 @@ depot.nix.buildLisp.program {
|
|||
name = "panettone";
|
||||
|
||||
deps = with depot.third_party.lisp; [
|
||||
bordeaux-threads
|
||||
cl-json
|
||||
cl-ppcre
|
||||
cl-smtp
|
||||
|
|
|
@ -10,6 +10,20 @@
|
|||
"Initialize the global postgresql connection for Panettone"
|
||||
(postmodern:connect-toplevel database user password host :port port))
|
||||
|
||||
(defun make-thread
|
||||
(function &rest args)
|
||||
"Make a new thread as per `BORDEAUX-THREADS:MAKE-THREAD' but with its own, new
|
||||
database connection."
|
||||
(let ((spec `(,(or (uiop:getenvp "PGDATABASE") "panettone")
|
||||
,(or (uiop:getenvp "PGUSER") "panettone")
|
||||
,(or (uiop:getenvp "PGPASSWORD") "password")
|
||||
,(or (uiop:getenvp "PGHOST") "localhost")
|
||||
:port ,(or (integer-env "PGPORT") 5432))))
|
||||
(apply #'bt:make-thread
|
||||
(lambda ()
|
||||
(postmodern:call-with-connection spec function))
|
||||
args)))
|
||||
|
||||
;;;
|
||||
;;; Schema
|
||||
;;;
|
||||
|
@ -356,10 +370,20 @@ ISSUE-ID, which should be a plist of initforms, and return an instance of
|
|||
(error 'issue-not-found :id issue-id))
|
||||
(insert-dao (apply #'make-instance 'issue-comment :issue-id issue-id attrs)))
|
||||
|
||||
(defun issue-commenter-dns (issue-id)
|
||||
"Returns a list of all the dns of users who have commented on ISSUE-ID"
|
||||
(query (:select 'author-dn :distinct
|
||||
:from 'issue-comments
|
||||
:where (:= 'issue-id issue-id))
|
||||
:column))
|
||||
|
||||
(comment
|
||||
(connect-postgres)
|
||||
(ddl/init)
|
||||
(make-instance 'issue :subject "test")
|
||||
(create-issue :subject "test"
|
||||
:author-dn "cn=glittershark,ou=users,dc=tvl,dc=fyi")
|
||||
|
||||
(issue-commenter-dns 1)
|
||||
|
||||
)
|
||||
|
|
|
@ -32,7 +32,7 @@
|
|||
(:use :cl :panettone.util :klatre :postmodern :iterate)
|
||||
(:import-from :alexandria :if-let :when-let :define-constant)
|
||||
(:export
|
||||
:connect-postgres :ddl/init
|
||||
:connect-postgres :ddl/init :make-thread
|
||||
|
||||
:user-settings
|
||||
:user-dn :enable-email-notifications-p :settings-for-user
|
||||
|
@ -46,7 +46,8 @@
|
|||
|
||||
:issue-events
|
||||
|
||||
:issue-comments :num-comments :create-issue-comment))
|
||||
:issue-comments :num-comments :create-issue-comment
|
||||
:issue-commenter-dns))
|
||||
|
||||
(defpackage panettone.email
|
||||
(:nicknames :email)
|
||||
|
@ -69,6 +70,7 @@
|
|||
(:import-from :defclass-std :defclass/std)
|
||||
(:import-from :alexandria :if-let :when-let :switch :alist-hash-table)
|
||||
(:import-from :cl-ppcre :split)
|
||||
(:import-from :bordeaux-threads :make-thread)
|
||||
(:import-from
|
||||
:panettone.model
|
||||
:id :subject :body :author-dn :issue-id :status :created-at
|
||||
|
|
|
@ -515,6 +515,23 @@
|
|||
:issue-id id
|
||||
:body body
|
||||
:author-dn (dn *user*))
|
||||
|
||||
;; Send email notifications (in a thread, since smtp is slow)
|
||||
(let ((current-user *user*))
|
||||
(model:make-thread
|
||||
(lambda ()
|
||||
(let ((issue (model:get-issue id)))
|
||||
(dolist (user-dn (remove-duplicates
|
||||
(cons (author-dn issue)
|
||||
(model:issue-commenter-dns id))
|
||||
:test #'equal))
|
||||
(when (not (equal (dn current-user) user-dn))
|
||||
(email:notify-user
|
||||
user-dn
|
||||
:subject (format nil "~A commented on \"~A\""
|
||||
(displayname current-user)
|
||||
(subject issue))
|
||||
:message body)))))))
|
||||
(redirect-to-issue)))))
|
||||
|
||||
(defroute close-issue
|
||||
|
|
Loading…
Reference in a new issue