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";
|
name = "panettone";
|
||||||
|
|
||||||
deps = with depot.third_party.lisp; [
|
deps = with depot.third_party.lisp; [
|
||||||
|
bordeaux-threads
|
||||||
cl-json
|
cl-json
|
||||||
cl-ppcre
|
cl-ppcre
|
||||||
cl-smtp
|
cl-smtp
|
||||||
|
|
|
@ -10,6 +10,20 @@
|
||||||
"Initialize the global postgresql connection for Panettone"
|
"Initialize the global postgresql connection for Panettone"
|
||||||
(postmodern:connect-toplevel database user password host :port port))
|
(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
|
;;; 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))
|
(error 'issue-not-found :id issue-id))
|
||||||
(insert-dao (apply #'make-instance 'issue-comment :issue-id issue-id attrs)))
|
(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
|
(comment
|
||||||
(connect-postgres)
|
(connect-postgres)
|
||||||
(ddl/init)
|
(ddl/init)
|
||||||
(make-instance 'issue :subject "test")
|
(make-instance 'issue :subject "test")
|
||||||
(create-issue :subject "test"
|
(create-issue :subject "test"
|
||||||
:author-dn "cn=glittershark,ou=users,dc=tvl,dc=fyi")
|
: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)
|
(:use :cl :panettone.util :klatre :postmodern :iterate)
|
||||||
(:import-from :alexandria :if-let :when-let :define-constant)
|
(:import-from :alexandria :if-let :when-let :define-constant)
|
||||||
(:export
|
(:export
|
||||||
:connect-postgres :ddl/init
|
:connect-postgres :ddl/init :make-thread
|
||||||
|
|
||||||
:user-settings
|
:user-settings
|
||||||
:user-dn :enable-email-notifications-p :settings-for-user
|
:user-dn :enable-email-notifications-p :settings-for-user
|
||||||
|
@ -46,7 +46,8 @@
|
||||||
|
|
||||||
:issue-events
|
:issue-events
|
||||||
|
|
||||||
:issue-comments :num-comments :create-issue-comment))
|
:issue-comments :num-comments :create-issue-comment
|
||||||
|
:issue-commenter-dns))
|
||||||
|
|
||||||
(defpackage panettone.email
|
(defpackage panettone.email
|
||||||
(:nicknames :email)
|
(:nicknames :email)
|
||||||
|
@ -69,6 +70,7 @@
|
||||||
(:import-from :defclass-std :defclass/std)
|
(:import-from :defclass-std :defclass/std)
|
||||||
(:import-from :alexandria :if-let :when-let :switch :alist-hash-table)
|
(:import-from :alexandria :if-let :when-let :switch :alist-hash-table)
|
||||||
(:import-from :cl-ppcre :split)
|
(:import-from :cl-ppcre :split)
|
||||||
|
(:import-from :bordeaux-threads :make-thread)
|
||||||
(:import-from
|
(:import-from
|
||||||
:panettone.model
|
:panettone.model
|
||||||
:id :subject :body :author-dn :issue-id :status :created-at
|
:id :subject :body :author-dn :issue-id :status :created-at
|
||||||
|
|
|
@ -515,6 +515,23 @@
|
||||||
:issue-id id
|
:issue-id id
|
||||||
:body body
|
:body body
|
||||||
:author-dn (dn *user*))
|
: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)))))
|
(redirect-to-issue)))))
|
||||||
|
|
||||||
(defroute close-issue
|
(defroute close-issue
|
||||||
|
|
Loading…
Reference in a new issue