From 3ec15ec9f9b4f010f32630cc3cef19120c90ed28 Mon Sep 17 00:00:00 2001
From: Griffin Smith <grfn@gws.fyi>
Date: Sat, 3 Apr 2021 14:27:37 -0400
Subject: feat(panettone): Add a settings page

Add a user settings page, with a single checkbox that allows disabling
receiving all email notifications.

Change-Id: Ibef2a497cd59f93b695ff8b9cd36047e514e00c2
Reviewed-on: https://cl.tvl.fyi/c/depot/+/2806
Tested-by: BuildkiteCI
Reviewed-by: sterni <sternenseemann@systemli.org>
Reviewed-by: tazjin <mail@tazj.in>
---
 web/panettone/src/css.lisp       | 15 ++++++++++++--
 web/panettone/src/model.lisp     | 18 +++++++++++++++++
 web/panettone/src/packages.lisp  |  1 +
 web/panettone/src/panettone.lisp | 42 ++++++++++++++++++++++++++++++++++++----
 4 files changed, 70 insertions(+), 6 deletions(-)

(limited to 'web/panettone/src')

diff --git a/web/panettone/src/css.lisp b/web/panettone/src/css.lisp
index d280e11981d9..0919cc62f602 100644
--- a/web/panettone/src/css.lisp
+++ b/web/panettone/src/css.lisp
@@ -138,7 +138,13 @@
 
      ((:and input (:= type "submit")
             (:or :hover :active :focus))
-      :box-shadow 0 0 0 0))))
+      :box-shadow 0 0 0 0))
+
+    (.form-group
+     :margin-top "1rem")
+
+    (label.checkbox
+     :cursor "pointer")))
 
 (defparameter issue-styles
   `((.issue-info
@@ -193,7 +199,12 @@
     (nav
      :display "flex"
      :color ,color/gray
-     :justify-content "space-between")
+     :justify-content "space-between"
+
+     (.nav-group
+      :display "flex"
+      (>*
+       :margin-left "0.5rem")))
 
     (footer
      :border-top "1px" "solid" ,color/gray
diff --git a/web/panettone/src/model.lisp b/web/panettone/src/model.lisp
index 648b9a5677a1..d7d1af924c29 100644
--- a/web/panettone/src/model.lisp
+++ b/web/panettone/src/model.lisp
@@ -55,6 +55,24 @@ database connection."
      (:select '* :from 'user-settings :where (:= 'user-dn dn))))
    (insert-dao (make-instance 'user-settings :user-dn dn))))
 
+(defun update-user-settings (settings &rest attrs)
+  "Update the fields of the settings for USER with the given ATTRS, which is a
+  plist of slot and value"
+  (check-type settings user-settings)
+  (when-let ((set-fields
+              (iter
+                (for slot in '(enable-email-notifications))
+                (for new-value = (getf attrs slot))
+                (appending
+                 (progn
+                   (setf (slot-value settings slot) new-value)
+                   (list slot new-value))))))
+    (execute
+     (sql-compile
+      `(:update user-settings
+        :set ,@set-fields
+        :where (:= user-dn ,(user-dn settings)))))))
+
 
 (define-constant +issue-statuses+ '(:open :closed)
   :test #'equal)
diff --git a/web/panettone/src/packages.lisp b/web/panettone/src/packages.lisp
index 891a6a199521..dfee8e81f732 100644
--- a/web/panettone/src/packages.lisp
+++ b/web/panettone/src/packages.lisp
@@ -36,6 +36,7 @@
 
    :user-settings
    :user-dn :enable-email-notifications-p :settings-for-user
+   :update-user-settings :enable-email-notifications
 
    :issue :issue-comment :issue-event
    :id :subject :body :author-dn :issue-id :status :created-at :acting-user-dn
diff --git a/web/panettone/src/panettone.lisp b/web/panettone/src/panettone.lisp
index ba079df62b66..f21bffdb0639 100644
--- a/web/panettone/src/panettone.lisp
+++ b/web/panettone/src/panettone.lisp
@@ -75,10 +75,12 @@
          (who:htm (:a :href "/" "All Issues")))
      (if *user*
          (who:htm
-          (:form :class "form-link log-out"
-                 :method "post"
-                 :action "/logout"
-                 (:input :type "submit" :value "Log Out")))
+          (:div :class "nav-group"
+           (:a :href "/settings" "Settings")
+           (:form :class "form-link log-out"
+                  :method "post"
+                  :action "/logout"
+                  (:input :type "submit" :value "Log Out"))))
          (who:htm
           (:a :href
               (format nil
@@ -169,6 +171,27 @@
        (:input :type "submit"
                :value "Submit"))))))
 
+(defun render/settings ()
+  (let ((settings (model:settings-for-user (dn *user*))))
+    (render ()
+      (:div
+       :class "settings-page"
+       (:header
+        (:h1 "Settings"))
+       (:form
+        :method :post :action "/settings"
+        (:div
+         (:label :class "checkbox"
+          (:input :type "checkbox"
+                  :name "enable-email-notifications"
+                  :id "enable-email-notifications"
+                  :checked (model:enable-email-notifications-p
+                            settings))
+          "Enable Email Notifications"))
+        (:div :class "form-group"
+         (:input :type "submit"
+                 :value "Save Settings")))))))
+
 (defun created-by-at (issue)
   (check-type issue model:issue)
   (who:with-html-output (*standard-output*)
@@ -438,6 +461,17 @@
   (let ((issues (model:list-issues :status :open)))
     (render/index :issues issues)))
 
+(defroute settings ("/settings" :method :get :decorators (@auth)) ()
+  (render/settings))
+
+(defroute save-settings ("/settings" :method :post :decorators (@auth))
+    (&post enable-email-notifications)
+  (let ((settings (model:settings-for-user (dn *user*))))
+    (model:update-user-settings
+     settings
+     'model:enable-email-notifications enable-email-notifications)
+    (render/settings)))
+
 (defroute handle-closed-issues
     ("/issues/closed" :decorators (@auth-optional)) ()
   (let ((issues (model:list-issues :status :closed)))
-- 
cgit 1.4.1