From 606d2af2da946c9ddf15e737d77d9b193b7725bc Mon Sep 17 00:00:00 2001
From: Griffin Smith <grfn@gws.fyi>
Date: Sat, 3 Apr 2021 14:40:33 -0400
Subject: 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>
---
 web/panettone/src/model.lisp     | 14 +++++++++++++
 web/panettone/src/packages.lisp  |  2 +-
 web/panettone/src/panettone.lisp | 44 ++++++++++++++++++++++++----------------
 3 files changed, 42 insertions(+), 18 deletions(-)

diff --git a/web/panettone/src/model.lisp b/web/panettone/src/model.lisp
index d7d1af924c..4fa51026a0 100644
--- a/web/panettone/src/model.lisp
+++ b/web/panettone/src/model.lisp
@@ -395,6 +395,19 @@ ISSUE-ID, which should be a plist of initforms, and return an instance of
           :where (:= 'issue-id issue-id))
          :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
  (connect-postgres)
  (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")
 
  (issue-commenter-dns 1)
+ (issue-subscribers 1)
 
  )
diff --git a/web/panettone/src/packages.lisp b/web/panettone/src/packages.lisp
index dfee8e81f7..3e6aa4a05f 100644
--- a/web/panettone/src/packages.lisp
+++ b/web/panettone/src/packages.lisp
@@ -48,7 +48,7 @@
    :issue-events
 
    :issue-comments :num-comments :create-issue-comment
-   :issue-commenter-dns))
+   :issue-commenter-dns :issue-subscribers))
 
 (defpackage panettone.email
   (:nicknames :email)
diff --git a/web/panettone/src/panettone.lisp b/web/panettone/src/panettone.lisp
index f21bffdb06..9a9aa9ce62 100644
--- a/web/panettone/src/panettone.lisp
+++ b/web/panettone/src/panettone.lisp
@@ -409,6 +409,20 @@
 ;;; 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)
   (let ((*user* (hunchentoot:session-value 'user)))
     (funcall next)))
@@ -550,22 +564,13 @@
         :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)))))))
+       (let ((issue (model:get-issue id)))
+         (send-email-for-issue
+          id
+          :subject (format nil "~A commented on \"~A\""
+                           (displayname *user*)
+                           (subject issue))
+          :message body))
        (redirect-to-issue)))))
 
 (defroute close-issue
@@ -582,7 +587,12 @@
              (irc:noping (cn *user*))
              id)
      :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)))
 
 (defroute open-issue
-- 
cgit 1.4.1