feat(panettone): Add functions to send email notifications r/2426

Add a new package to panettone, :panettone.email with functions to send
email notifications to users through the SMTP relay on whitby,
respecting the value of `enable_email_notifications` on the
user_settings table.

Change-Id: Ia4ec65965abda06f1fadb178143d66bb8eae6482
Reviewed-on: https://cl.tvl.fyi/c/depot/+/2804
Tested-by: BuildkiteCI
Reviewed-by: sterni <sternenseemann@systemli.org>
Reviewed-by: tazjin <mail@tazj.in>

4 files changed, 65 insertions, 1 deletions

diff --git a/web/panettone/default.nix b/web/panettone/default.nix
index 4238af804a..c589c2a7b8 100644
--- a/web/panettone/default.nix
+++ b/web/panettone/default.nix
@@ -6,9 +6,10 @@ depot.nix.buildLisp.program {
   deps = with depot.third_party.lisp; [
     cl-json
     cl-ppcre
+    cl-smtp
     cl-who
-    drakma
     defclass-std
+    drakma
     easy-routes
     hunchentoot
     lass
diff --git a/web/panettone/src/authentication.lisp b/web/panettone/src/authentication.lisp
index 50befbc7a1..07b9a6a87c 100644
--- a/web/panettone/src/authentication.lisp
+++ b/web/panettone/src/authentication.lisp
@@ -78,6 +78,8 @@ and a retry"
     (ldap-entry->user ldap-entry)))
 
 (defun find-user-by-dn (dn)
+  "Look up the user with the given DN in the LDAP database, returning an
+instance of `user'"
   (with-ldap ()
     (let ((have-results
             (handler-case
diff --git a/web/panettone/src/email.lisp b/web/panettone/src/email.lisp
new file mode 100644
index 0000000000..cb01c488a2
--- /dev/null
+++ b/web/panettone/src/email.lisp
@@ -0,0 +1,48 @@
+(in-package :panettone.email)
+(declaim (optimize (safety 3)))
+
+(defvar *smtp-server* "localhost"
+  "The host for SMTP connections")
+
+(defvar *smtp-server-port* 2525
+  "The port for SMTP connections")
+
+(defvar *notification-from* "tvlbot@tazj.in"
+  "The email address to send email notifications from")
+
+(defvar *notification-from-display-name* "Panettone"
+  "The Display Name to use when sending email notifications")
+
+(defvar *notification-subject-prefix* "[panettone]"
+  "String to prefix all email subjects with")
+
+(defun send-email-notification (&key to subject message)
+  "Sends an email to TO with the given SUBJECT and MESSAGE, using the current
+values of `*smtp-server*', `*smtp-server-port*' and `*email-notification-from*'"
+  (let ((subject (if *notification-subject-prefix*
+                     (format nil "~A ~A"
+                             *notification-subject-prefix*
+                             subject)
+                     subject)))
+    (cl-smtp:send-email
+     *smtp-server*
+     *notification-from*
+     to
+     subject
+     message
+     :port *smtp-server-port*
+     :display-name *notification-from-display-name*)))
+
+(defun user-has-email-notifications-enabled-p (dn)
+  "Returns T if the user with the given DN has enabled email notifications"
+  (enable-email-notifications-p (settings-for-user dn)))
+
+(defun notify-user (dn &key subject message)
+  "Sends an email notification to the user with DN with the given SUBJECT and
+  MESSAGE, iff that user has not disabled email notifications"
+  (when (user-has-email-notifications-enabled-p dn)
+    (when-let ((user (find-user-by-dn dn)))
+      (send-email-notification
+       :to (mail user)
+       :subject subject
+       :message message))))
diff --git a/web/panettone/src/packages.lisp b/web/panettone/src/packages.lisp
index 3bdb553b70..22a2a8649a 100644
--- a/web/panettone/src/packages.lisp
+++ b/web/panettone/src/packages.lisp
@@ -48,6 +48,19 @@
 
    :issue-comments :num-comments :create-issue-comment))
 
+(defpackage panettone.email
+  (:nicknames :email)
+  (:use :cl)
+  (:import-from :alexandria :when-let)
+  (:import-from :panettone.model
+   :settings-for-user :enable-email-notifications-p)
+  (:import-from :panettone.authentication
+   :find-user-by-dn :mail :displayname)
+  (:export
+   :*smtp-server* :*smtp-server-port* :*notification-from*
+   :*notification-from-display-name* :*notification-subject-prefix*
+   :notify-user :send-email-notification))
+
 (defpackage panettone
   (:use :cl :klatre :easy-routes :iterate
         :panettone.util