diff --git a/web/panettone/src/model.lisp b/web/panettone/src/model.lisp index d7d1af924..4fa51026a 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 dfee8e81f..3e6aa4a05 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 f21bffdb0..9a9aa9ce6 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