feat(panettone): Add functions to send email notifications
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>
This commit is contained in:
parent
37d573479b
commit
349b98ccc8
4 changed files with 65 additions and 1 deletions
|
|
@ -6,9 +6,10 @@ depot.nix.buildLisp.program {
|
||||||
deps = with depot.third_party.lisp; [
|
deps = with depot.third_party.lisp; [
|
||||||
cl-json
|
cl-json
|
||||||
cl-ppcre
|
cl-ppcre
|
||||||
|
cl-smtp
|
||||||
cl-who
|
cl-who
|
||||||
drakma
|
|
||||||
defclass-std
|
defclass-std
|
||||||
|
drakma
|
||||||
easy-routes
|
easy-routes
|
||||||
hunchentoot
|
hunchentoot
|
||||||
lass
|
lass
|
||||||
|
|
|
||||||
|
|
@ -78,6 +78,8 @@ and a retry"
|
||||||
(ldap-entry->user ldap-entry)))
|
(ldap-entry->user ldap-entry)))
|
||||||
|
|
||||||
(defun find-user-by-dn (dn)
|
(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 ()
|
(with-ldap ()
|
||||||
(let ((have-results
|
(let ((have-results
|
||||||
(handler-case
|
(handler-case
|
||||||
|
|
|
||||||
48
web/panettone/src/email.lisp
Normal file
48
web/panettone/src/email.lisp
Normal file
|
|
@ -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))))
|
||||||
|
|
@ -48,6 +48,19 @@
|
||||||
|
|
||||||
:issue-comments :num-comments :create-issue-comment))
|
: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
|
(defpackage panettone
|
||||||
(:use :cl :klatre :easy-routes :iterate
|
(:use :cl :klatre :easy-routes :iterate
|
||||||
:panettone.util
|
:panettone.util
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue