From 8d3ab61e7c136610ae1dc002226559e8c6b21fcb Mon Sep 17 00:00:00 2001
From: Griffin Smith <grfn@gws.fyi>
Date: Sat, 3 Apr 2021 13:44:25 -0400
Subject: 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>
---
 web/panettone/default.nix        |  1 +
 web/panettone/src/model.lisp     | 24 ++++++++++++++++++++++++
 web/panettone/src/packages.lisp  |  6 ++++--
 web/panettone/src/panettone.lisp | 17 +++++++++++++++++
 4 files changed, 46 insertions(+), 2 deletions(-)

(limited to 'web/panettone')

diff --git a/web/panettone/default.nix b/web/panettone/default.nix
index c589c2a7b8..f1bb73d35c 100644
--- a/web/panettone/default.nix
+++ b/web/panettone/default.nix
@@ -4,6 +4,7 @@ depot.nix.buildLisp.program {
   name = "panettone";
 
   deps = with depot.third_party.lisp; [
+    bordeaux-threads
     cl-json
     cl-ppcre
     cl-smtp
diff --git a/web/panettone/src/model.lisp b/web/panettone/src/model.lisp
index d43478d45b..648b9a5677 100644
--- a/web/panettone/src/model.lisp
+++ b/web/panettone/src/model.lisp
@@ -10,6 +10,20 @@
   "Initialize the global postgresql connection for Panettone"
   (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
 ;;;
@@ -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))
   (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
  (connect-postgres)
  (ddl/init)
  (make-instance 'issue :subject "test")
  (create-issue :subject "test"
                :author-dn "cn=glittershark,ou=users,dc=tvl,dc=fyi")
+
+ (issue-commenter-dns 1)
+
  )
diff --git a/web/panettone/src/packages.lisp b/web/panettone/src/packages.lisp
index 22a2a8649a..891a6a1995 100644
--- a/web/panettone/src/packages.lisp
+++ b/web/panettone/src/packages.lisp
@@ -32,7 +32,7 @@
   (:use :cl :panettone.util :klatre :postmodern :iterate)
   (:import-from :alexandria :if-let :when-let :define-constant)
   (:export
-   :connect-postgres :ddl/init
+   :connect-postgres :ddl/init :make-thread
 
    :user-settings
    :user-dn :enable-email-notifications-p :settings-for-user
@@ -46,7 +46,8 @@
 
    :issue-events
 
-   :issue-comments :num-comments :create-issue-comment))
+   :issue-comments :num-comments :create-issue-comment
+   :issue-commenter-dns))
 
 (defpackage panettone.email
   (:nicknames :email)
@@ -69,6 +70,7 @@
   (:import-from :defclass-std :defclass/std)
   (:import-from :alexandria :if-let :when-let :switch :alist-hash-table)
   (:import-from :cl-ppcre :split)
+  (:import-from :bordeaux-threads :make-thread)
   (:import-from
    :panettone.model
    :id :subject :body :author-dn :issue-id :status :created-at
diff --git a/web/panettone/src/panettone.lisp b/web/panettone/src/panettone.lisp
index c97a988404..ba079df62b 100644
--- a/web/panettone/src/panettone.lisp
+++ b/web/panettone/src/panettone.lisp
@@ -515,6 +515,23 @@
         :issue-id id
         :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)))))))
        (redirect-to-issue)))))
 
 (defroute close-issue
-- 
cgit 1.4.1