about summary refs log tree commit diff
diff options
context:
space:
mode:
-rw-r--r--web/panettone/src/model.lisp14
-rw-r--r--web/panettone/src/packages.lisp2
-rw-r--r--web/panettone/src/panettone.lisp44
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