diff of 3bf0a7839f4bc91e5f229cba2ca3759be55887af
3bf0a7839f4bc91e5f229cba2ca3759be55887af
diff --git a/src/model/settings.lisp b/src/model/settings.lisp
index e1965ca..597c2b3 100644
--- a/src/model/settings.lisp
+++ b/src/model/settings.lisp
@@ -25,6 +25,21 @@
(defvar *setting->getter* (make-hash-table :test 'equal))
(defvar *inside-defsetting?* nil))
+(defvar *cache* nil "A hashmap for storing the contents of blog.settings in a request-scope")
+
+(defun generate-cache ()
+ (reduce (lambda (acc pair)
+ (destructuring-bind (key value) pair
+ (setf (gethash key acc) (parse value)))
+ acc)
+ (postmodern:query "SELECT key, value FROM blog.settings")
+ :initial-value (make-hash-table :test 'equal)))
+
+(defmacro with-cache (&body body)
+ `(let ((*cache* (or *cache*
+ (generate-cache))))
+ ,@body))
+
(defun update-setting (k v)
(postmodern:execute "INSERT INTO blog.Settings (key, value) VALUES ($1, $2) ON CONFLICT (key) DO UPDATE SET value = excluded.value" k (stringify v)))
@@ -39,8 +54,8 @@
(defun all-setting-names ()
"Returns all known setting names as \"strings\""
- (map 'list setting-name-cleaner
- *setting-fields*))
+ (with-cache
+ (map 'list #'car (alexandria:hash-table-alist *cache*))))
(defun setting-getter (setting-name-str)
(gethash setting-name-str *setting->getter*))
@@ -65,20 +80,21 @@
,@(map 'list
(lambda (setting)
(with-slots (setting-name default-value) setting
- `(progn
- (defun ,(kw-to-sym setting-name) (&optional value)
- ,(format nil "If called without parameters, returns current value of ~a. If with parameters, update's setting's value both in-app and in db" setting-name)
- (murja.middleware.db:with-db
- (postmodern:execute "INSERT INTO blog.settings VALUES ($1, $2) ON CONFLICT DO NOTHING" ,(prin1-to-string (kw-to-sym setting-name)) ,(format nil "~s" default-value))
+ (let ((setting-name-str (prin1-to-string (kw-to-sym setting-name))))
+ `(progn
+ (defun ,(kw-to-sym setting-name) (&optional value)
+ ,(format nil "If called without parameters, returns current value of ~a. If with parameters, update's setting's value both in-app and in db" setting-name)
+ (assert *cache* nil ,(format nil "Settings (trying to get ~a) aren't loaded. Please use murja.model.settings:with-cache" setting-name-str))
(if value
(progn
- (update-setting ,(prin1-to-string (kw-to-sym setting-name)) value)
+ (setf (gethash ,setting-name-str *cache*) value)
+ (update-setting ,setting-name-str value)
value)
- (parse
- (caar (postmodern:query "SELECT value FROM blog.settings WHERE key = $1" ,(prin1-to-string (kw-to-sym setting-name))))))))
- (setf (gethash ,(funcall setting-name-kwcleaner setting-name)
- *setting->getter*)
- (function ,(kw-to-sym setting-name))))))
+
+ (gethash ,setting-name-str *cache*)))
+ (setf (gethash ,(funcall setting-name-kwcleaner setting-name)
+ *setting->getter*)
+ (function ,(kw-to-sym setting-name)))))))
*setting-fields*)
diff --git a/src/packages/settings.lisp b/src/packages/settings.lisp
index 8624129..5060c3b 100644
--- a/src/packages/settings.lisp
+++ b/src/packages/settings.lisp
@@ -1,6 +1,6 @@
(defpackage :murja.model.settings
(:use :cl)
- (:export :setup-settings :setting-getter :all-setting-names :update-setting :defsetting :define-settings :create-settings)
+ (:export :setup-settings :setting-getter :all-setting-names :update-setting :defsetting :define-settings :create-settings :with-cache)
(:import-from :com.inuoe.jzon :stringify :parse)
(:documentation "This package specifies macros define-settings and defsetting, which are used thus:
diff --git a/src/packages/tabs-component.lisp b/src/packages/tabs-component.lisp
index 70b7d86..5a7daa1 100644
--- a/src/packages/tabs-component.lisp
+++ b/src/packages/tabs-component.lisp
@@ -1,5 +1,6 @@
(defpackage :murja.view.components.tabs
(:use :cl :easy-routes :murja.middleware.auth :murja.view.components.root :spinneret)
(:import-from :murja.middleware.db :@transaction)
+ (:local-nicknames (:settings :murja.model.settings))
(:export :*inject-to-head* :deftab))
diff --git a/src/view/components/tabs.lisp b/src/view/components/tabs.lisp
index cb782d1..0ec6665 100644
--- a/src/view/components/tabs.lisp
+++ b/src/view/components/tabs.lisp
@@ -84,31 +84,32 @@
(defun @dispatcher (next inject-to-head)
(multiple-value-bind (sym url-params) (funcall next)
- (let* ((tab (gethash sym *tabs*))
- ;; inject-to-head gets passed through to macros here as an unevaluated list
- ;; and I don't understand why that happens, but this fixes the symptom and
- ;; shouldn't expose too much vulnerabilities as :inject-to-head is trusted data
- (inject-to-head (map 'list
- #'eval
- inject-to-head))
- (usr-abilities (when *user*
- (coerce (murja.model.user:abilities *user*) 'list))))
- (assert tab)
- (if (or (not (abilities tab))
- (intersection usr-abilities (abilities tab))
- (or (not (require-login tab))
- *user*))
- (let ((*inject-to-head* inject-to-head))
- (root-component
- (tab-container tab
- (remove-if-not (lambda (tab)
- (or (not (require-login tab))
- (subtab tab)
- *user*))
- (alexandria:hash-table-values
- *tabs*))
- url-params)))
- (progn
- (setf (hunchentoot:return-code*) 404)
- "Nothing found")))))
+ (settings:with-cache
+ (let* ((tab (gethash sym *tabs*))
+ ;; inject-to-head gets passed through to macros here as an unevaluated list
+ ;; and I don't understand why that happens, but this fixes the symptom and
+ ;; shouldn't expose too much vulnerabilities as :inject-to-head is trusted data
+ (inject-to-head (map 'list
+ #'eval
+ inject-to-head))
+ (usr-abilities (when *user*
+ (coerce (murja.model.user:abilities *user*) 'list))))
+ (assert tab)
+ (if (or (not (abilities tab))
+ (intersection usr-abilities (abilities tab))
+ (or (not (require-login tab))
+ *user*))
+ (let ((*inject-to-head* inject-to-head))
+ (root-component
+ (tab-container tab
+ (remove-if-not (lambda (tab)
+ (or (not (require-login tab))
+ (subtab tab)
+ *user*))
+ (alexandria:hash-table-values
+ *tabs*))
+ url-params)))
+ (progn
+ (setf (hunchentoot:return-code*) 404)
+ "Nothing found"))))))
diff --git a/src/view/settings.lisp b/src/view/settings.lisp
index f78e393..33dd809 100644
--- a/src/view/settings.lisp
+++ b/src/view/settings.lisp
@@ -8,21 +8,22 @@
@ssr-authenticated)) ()
(let ((abilities (coerce (murja.model.user:abilities *user*) 'list)))
- (when (member "update-settings" abilities :test 'equal)
- (let ((form (lisp-fixup:formdata->hashmap (hunchentoot:raw-post-data :force-text t)))
- (settings (all-setting-names)))
- (maphash (lambda (key value)
- (when (member key settings :test 'equal)
- (let* ((accessor (setting-getter key))
- (old-value (funcall accessor))
- (value (if (numberp old-value)
- (parse-number:parse-number value)
- value)))
- (funcall accessor value))))
- form)
-
- (setf (hunchentoot:return-code*) 204)
- ""))))
+ (murja.model.settings:with-cache
+ (when (member "update-settings" abilities :test 'equal)
+ (let ((form (lisp-fixup:formdata->hashmap (hunchentoot:raw-post-data :force-text t)))
+ (settings (all-setting-names)))
+ (maphash (lambda (key value)
+ (when (member key settings :test 'equal)
+ (let* ((accessor (setting-getter key))
+ (old-value (funcall accessor))
+ (value (if (numberp old-value)
+ (parse-number:parse-number value)
+ value)))
+ (funcall accessor value))))
+ form)
+
+ (setf (hunchentoot:return-code*) 204)
+ "")))))
(deftab settings (:url "/settings"
:title "Settings"