feat(panettone): Send emails when issues are closed

Send notification emails to the same group of users who receive
notifications on issue comments when issues are marked as closed. This
also takes the opportunity to generalize issue notification emails a
bit, and lay the groundwork for (but not implement) explicit issue
subscriber lists.

Change-Id: Ie2572ed3ad0207d415b4c362438f772925e7a2c5
Reviewed-on: https://cl.tvl.fyi/c/depot/+/2807
Tested-by: BuildkiteCI
Reviewed-by: sterni <sternenseemann@systemli.org>
Reviewed-by: tazjin <mail@tazj.in>
This commit is contained in:
Griffin Smith 2021-04-03 14:40:33 -04:00 committed by glittershark
parent 3ec15ec9f9
commit 606d2af2da
3 changed files with 42 additions and 18 deletions

View file

@ -395,6 +395,19 @@ ISSUE-ID, which should be a plist of initforms, and return an instance of
:where (:= 'issue-id issue-id)) :where (:= 'issue-id issue-id))
:column)) :column))
(defun issue-subscribers (issue-id)
"Returns a list of user DNs who should receive notifications for actions taken
on ISSUE-ID.
Currently this is implemented as the author of issue plus all the users who have
commented on the issue, but in the future we likely want to also allow
explicitly subscribing to / unsubscribing from individual issues."
(let ((issue (get-issue issue-id)))
(adjoin (author-dn issue)
(issue-commenter-dns issue-id)
:test #'equal)))
(comment (comment
(connect-postgres) (connect-postgres)
(ddl/init) (ddl/init)
@ -403,5 +416,6 @@ ISSUE-ID, which should be a plist of initforms, and return an instance of
:author-dn "cn=glittershark,ou=users,dc=tvl,dc=fyi") :author-dn "cn=glittershark,ou=users,dc=tvl,dc=fyi")
(issue-commenter-dns 1) (issue-commenter-dns 1)
(issue-subscribers 1)
) )

View file

@ -48,7 +48,7 @@
:issue-events :issue-events
:issue-comments :num-comments :create-issue-comment :issue-comments :num-comments :create-issue-comment
:issue-commenter-dns)) :issue-commenter-dns :issue-subscribers))
(defpackage panettone.email (defpackage panettone.email
(:nicknames :email) (:nicknames :email)

View file

@ -409,6 +409,20 @@
;;; HTTP handlers ;;; HTTP handlers
;;; ;;;
(defun send-email-for-issue
(issue-id &key subject (message ""))
"Send an email notification to all subscribers to the given issue with the
given subject an body (in a thread, to avoid blocking)"
(let ((current-user *user*))
(model:make-thread
(lambda ()
(dolist (user-dn (model:issue-subscribers issue-id))
(when (not (equal (dn current-user) user-dn))
(email:notify-user
user-dn
:subject subject
:message message)))))))
(defun @auth-optional (next) (defun @auth-optional (next)
(let ((*user* (hunchentoot:session-value 'user))) (let ((*user* (hunchentoot:session-value 'user)))
(funcall next))) (funcall next)))
@ -550,22 +564,13 @@
:body body :body body
:author-dn (dn *user*)) :author-dn (dn *user*))
;; Send email notifications (in a thread, since smtp is slow) (let ((issue (model:get-issue id)))
(let ((current-user *user*)) (send-email-for-issue
(model:make-thread id
(lambda () :subject (format nil "~A commented on \"~A\""
(let ((issue (model:get-issue id))) (displayname *user*)
(dolist (user-dn (remove-duplicates (subject issue))
(cons (author-dn issue) :message body))
(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))))) (redirect-to-issue)))))
(defroute close-issue (defroute close-issue
@ -582,7 +587,12 @@
(irc:noping (cn *user*)) (irc:noping (cn *user*))
id) id)
:channel (or (uiop:getenvp "ISSUECHANNEL") :channel (or (uiop:getenvp "ISSUECHANNEL")
"##tvl-dev"))) "##tvl-dev"))
(send-email-for-issue
id
:subject (format nil "~A closed \"~A\""
(dn *user*)
(subject issue))))
(hunchentoot:redirect (format nil "/issues/~A" id))) (hunchentoot:redirect (format nil "/issues/~A" id)))
(defroute open-issue (defroute open-issue