diff of fbde6f2072926f6c513c5ce08843741b36a300c0
fbde6f2072926f6c513c5ce08843741b36a300c0
diff --git a/aggressive-murja.asd b/aggressive-murja.asd
index 1daef03..203a241 100644
--- a/aggressive-murja.asd
+++ b/aggressive-murja.asd
@@ -45,14 +45,16 @@
:components ((:file "user-db")))
(:file "session-db")
(:file "settings")
+ (:file "middleware-db")
(:module "model"
:components
((:file "user")
(:file "post")
- (:file "log")))
+ (:file "log")
+ (:file "settings")))
+ (:file "setting-definitions")
(:module "middleware"
:components ((:file "json")
- (:file "db")
(:file "auth")))
(:file "session")
(:module "posts"
@@ -97,7 +99,8 @@
(:file "media-admin")
(:file "new-post")
(:file "logs")))
- (:file "rss")))
+ (:file "rss")
+ (:file "settings")))
(:file "main"))))
:build-operation program-op
:build-pathname "murja"
diff --git a/src/middleware-db.lisp b/src/middleware-db.lisp
new file mode 100644
index 0000000..8cc9a45
--- /dev/null
+++ b/src/middleware-db.lisp
@@ -0,0 +1,72 @@
+(defpackage murja.middleware.db
+ (:use :cl :postmodern)
+ (:export :connect-murjadb-toplevel
+ :@db
+ :@transaction
+ :with-db
+ :*automatic-tests-on?*))
+
+(in-package :murja.middleware.db)
+
+(defvar *automatic-tests-on?* nil)
+
+(defun db-config ()
+ (list :db (or (sb-ext:posix-getenv "MURJA_DB")
+ "blogdb")
+ :username (or (sb-ext:posix-getenv "MURJA_DB_USER")
+ "blogadmin")
+ :password (or (sb-ext:posix-getenv "MURJA_DB_PASSWD")
+ "blog")
+ :host (or (sb-ext:posix-getenv "MURJA_DB_HOST")
+ "localhost")
+ :port (let ((port-str
+ ;; return env-var if it exists (GHA, connecting straight to the automatic test db container)
+ (or (sb-ext:posix-getenv "MURJA_DB_PORT")
+ ;; return "2345", where autotest-db is on localhost (proxied to automatic-test-db:5432)
+ (and *automatic-tests-on?* "2345"))))
+ (if port-str
+ (parse-integer port-str)
+ ;; or else return the basic postgresql 5432 port
+ 5432))))
+
+(defun connect-murjadb-toplevel ()
+ (destructuring-bind (&key db username password host port) (db-config)
+ (postmodern:connect-toplevel db username password host :port port)))
+
+;; (connect-murjadb-toplevel)
+
+(defmacro with-db (&rest body)
+ `(destructuring-bind (&key db username password host port) (db-config)
+ (with-connection (list db username password host :port port)
+ ,@body)))
+
+(defun @transaction (next)
+ (with-db
+ (handler-bind ((cl-postgres:database-socket-error
+ (lambda (c)
+ (log:error "Socket error from db: ~a~%" c)
+ (setf (hunchentoot:return-code*) 500)
+ (return-from @transaction "Internal Server Error")))
+ (cl-postgres:database-error
+ (lambda (c)
+ (log:error "Error from db: ~a~%" c)
+ (setf (hunchentoot:return-code*) 500)
+ (return-from @transaction "Internal Server Error"))))
+ (with-transaction (:repeatable-read-rw)
+ (let* ((murja.settings:*settings* (murja.settings:get-settings)))
+ (funcall next))))))
+
+(defun @db (next)
+ (with-db
+ (handler-bind ((cl-postgres:database-socket-error
+ (lambda (c)
+ (log:error "Socket error from db: ~a~%" c)
+ (setf (hunchentoot:return-code*) 500)
+ (return-from @db "Internal Server Error")))
+ (cl-postgres:database-error
+ (lambda (c)
+ (log:error "Error from db: ~a~%" c)
+ (setf (hunchentoot:return-code*) 500)
+ (return-from @db "Internal Server Error"))))
+ (let* ((murja.settings:*settings* (murja.settings:get-settings)))
+ (funcall next)))))
diff --git a/src/middleware/db.lisp b/src/middleware/db.lisp
deleted file mode 100644
index 8cc9a45..0000000
--- a/src/middleware/db.lisp
+++ /dev/null
@@ -1,72 +0,0 @@
-(defpackage murja.middleware.db
- (:use :cl :postmodern)
- (:export :connect-murjadb-toplevel
- :@db
- :@transaction
- :with-db
- :*automatic-tests-on?*))
-
-(in-package :murja.middleware.db)
-
-(defvar *automatic-tests-on?* nil)
-
-(defun db-config ()
- (list :db (or (sb-ext:posix-getenv "MURJA_DB")
- "blogdb")
- :username (or (sb-ext:posix-getenv "MURJA_DB_USER")
- "blogadmin")
- :password (or (sb-ext:posix-getenv "MURJA_DB_PASSWD")
- "blog")
- :host (or (sb-ext:posix-getenv "MURJA_DB_HOST")
- "localhost")
- :port (let ((port-str
- ;; return env-var if it exists (GHA, connecting straight to the automatic test db container)
- (or (sb-ext:posix-getenv "MURJA_DB_PORT")
- ;; return "2345", where autotest-db is on localhost (proxied to automatic-test-db:5432)
- (and *automatic-tests-on?* "2345"))))
- (if port-str
- (parse-integer port-str)
- ;; or else return the basic postgresql 5432 port
- 5432))))
-
-(defun connect-murjadb-toplevel ()
- (destructuring-bind (&key db username password host port) (db-config)
- (postmodern:connect-toplevel db username password host :port port)))
-
-;; (connect-murjadb-toplevel)
-
-(defmacro with-db (&rest body)
- `(destructuring-bind (&key db username password host port) (db-config)
- (with-connection (list db username password host :port port)
- ,@body)))
-
-(defun @transaction (next)
- (with-db
- (handler-bind ((cl-postgres:database-socket-error
- (lambda (c)
- (log:error "Socket error from db: ~a~%" c)
- (setf (hunchentoot:return-code*) 500)
- (return-from @transaction "Internal Server Error")))
- (cl-postgres:database-error
- (lambda (c)
- (log:error "Error from db: ~a~%" c)
- (setf (hunchentoot:return-code*) 500)
- (return-from @transaction "Internal Server Error"))))
- (with-transaction (:repeatable-read-rw)
- (let* ((murja.settings:*settings* (murja.settings:get-settings)))
- (funcall next))))))
-
-(defun @db (next)
- (with-db
- (handler-bind ((cl-postgres:database-socket-error
- (lambda (c)
- (log:error "Socket error from db: ~a~%" c)
- (setf (hunchentoot:return-code*) 500)
- (return-from @db "Internal Server Error")))
- (cl-postgres:database-error
- (lambda (c)
- (log:error "Error from db: ~a~%" c)
- (setf (hunchentoot:return-code*) 500)
- (return-from @db "Internal Server Error"))))
- (let* ((murja.settings:*settings* (murja.settings:get-settings)))
- (funcall next)))))
diff --git a/src/model/settings.lisp b/src/model/settings.lisp
new file mode 100644
index 0000000..084533c
--- /dev/null
+++ b/src/model/settings.lisp
@@ -0,0 +1,126 @@
+(defpackage murja.model.settings
+ (:use :cl)
+ (:export :setting-getter :all-setting-names :update-setting :defsetting :define-settings)
+ (:import-from :com.inuoe.jzon :stringify :parse)
+ (:documentation "This package specifies macros define-settings and defsetting, which are used thus:
+
+```
+(define-settings
+ (defsetting site-name \"default-site\")
+ (defsetting test-setting 12345))
+```
+
+After running that form, one can get setting's current value by funcalling its symbol (for example: `(site-name) => \"default site\")`. If you wish to change
+the value of this setting, you call its symbol with a parameter (`(site-name \"a new site\")`, after which calling it with 0-arity begins returning \"a new site\").
+
+These changes are saved in murja's table `blog.Settings`."))
+
+(in-package :murja.model.settings)
+
+(named-readtables:in-readtable :murja.ps)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+
+ (defclass Setting ()
+ ((setting-name :initarg :name :accessor setting-name-access :initform (error "Name needed"))
+ (default-value :initarg :default-value :initform (error "Value needed"))))
+
+ ;; (defmethod print-object ((obj person) stream)
+ ;; (print-unreadable-object (obj stream :type t)
+ ;; (with-accessors ((name name)
+ ;; (lisper lisper))
+ ;; obj
+ ;; (format stream "~a, lisper: ~a" name lisper))))
+
+ (defmethod print-object ((s Setting) output)
+ (print-unreadable-object (s output :type t)
+ (with-slots (setting-name default-value) s
+ (format output "~a - default: ~a" setting-name default-value))))
+
+ (defvar *setting-fields* nil
+ "A list that's used to populate Settings-class")
+ (defvar *setting->getter* (make-hash-table :test 'equal))
+ (defvar *inside-defsetting?* nil))
+
+(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)))
+
+(defun all-setting-names ()
+ "Returns all known setting names as \"strings\""
+ (map 'list (alexandria:compose (alexandria:curry #'str:replace-all ":" "")
+ #'prin1-to-string
+ #'setting-name-access)
+ *setting-fields*))
+
+(defun setting-getter (setting-name-str)
+ (gethash setting-name-str *setting->getter*))
+
+;; a stupid hack
+(defun kw-to-sym (kw)
+ (read-from-string (str:replace-all ":" "" (prin1-to-string kw))))
+
+(defmacro defsetting (name default-value)
+ "Sets up a setting and its default value. Please call this inside (define-settings)"
+ (unless (some (lambda (setting)
+ (with-slots (setting-name) setting
+ (equalp name setting-name)))
+ *setting-fields*)
+ (push (make-instance 'Setting :name (read-from-string (format nil ":~a" name)) :default-value default-value) *setting-fields*))
+ `(progn
+ (assert *inside-defsetting?* nil "Please wrap `(defsetting ~a ~a)` inside a define-settings macro" ,(prin1-to-string name) ,(prin1-to-string default-value))
+ (quote ,name)))
+
+(defmacro create-settings ()
+ `(progn
+ (defclass Settings ()
+ (,@(map 'list
+ (lambda (setting)
+ (with-slots (setting-name default-value) setting
+ `(,(kw-to-sym setting-name) :initarg ,(read-from-string (format nil ":~a" setting-name))
+ :initform (or (caar (postmodern:query "SELECT value FROM blog.settings WHERE key = $1" ,(prin1-to-string setting-name)))
+ ,default-value)
+ ;; :accessor ,(kw-to-sym setting-name)
+ )))
+ *setting-fields*)))
+
+ (murja.middleware.db:with-db
+ (defparameter *settings* (make-instance 'Settings)))
+
+ ,@(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)
+ (with-slots (,(kw-to-sym setting-name)) *settings*
+ (if value
+ (progn
+ (setf ,(kw-to-sym setting-name) value)
+ (murja.middleware.db:with-db
+ (update-setting ,(kw-to-sym setting-name) value))
+ value)
+ ,(kw-to-sym setting-name))))
+ (setf (gethash ,(prin1-to-string setting-name) *setting->getter*) (function ,(kw-to-sym setting-name))))))
+
+ *setting-fields*)
+
+ 'Settings))
+
+(defmacro define-settings (&body body)
+ "Resets the settings (it's an error to call define-settings twice, but it doesn't throw as resetting the old settings in REPL is a feature) and after running through defsettings, creates the final setting getters and setters. Refer to package :documentation on example how to use this"
+ (setf *setting-fields* nil
+ *setting->getter* (make-hash-table :test 'equal))
+
+ (let ((*inside-defsetting?* t))
+ `(let ((*inside-defsetting?* t))
+ ,@body
+ (create-settings))))
+
+
+;; (defsetting random-size 45)
+
+;; (page-size) => 45
+;; (page-size 23456)
+;; (page-size) => 23456
+
+ ;; (setf *setting-fields* nil)
diff --git a/src/setting-definitions.lisp b/src/setting-definitions.lisp
new file mode 100644
index 0000000..d945cc6
--- /dev/null
+++ b/src/setting-definitions.lisp
@@ -0,0 +1,19 @@
+(defpackage murja.setting-definitions
+ (:use :cl :murja.model.settings)
+ (:export :page-size :rss-email :rss-lang :rss-description :rss-link :rss-title
+ :blog-title :domain :previously_label :recent-post-count :time-format))
+
+(in-package murja.setting-definitions)
+
+(define-settings
+ (defsetting time-format "dd.MM.yyyy HH:mm")
+ (defsetting recent-post-count 6)
+ (defsetting previously_label "Previously")
+ (defsetting domain "")
+ (defsetting blog-title "MURJA DEV")
+ (defsetting rss-title "-")
+ (defsetting rss-link "-")
+ (defsetting rss-description "MURJA DEV")
+ (defsetting rss-lang "fi")
+ (defsetting rss-email "-")
+ (defsetting page-size 23456))
diff --git a/src/settings.lisp b/src/settings.lisp
index 7c06fcf..896ca47 100644
--- a/src/settings.lisp
+++ b/src/settings.lisp
@@ -1,5 +1,8 @@
(defpackage murja.settings
(:use :cl)
+ (:documentation "DEPRECATED.
+
+Please use murja.setting-definitions functions")
(:export :*settings* :get-settings))
(in-package :murja.settings)
@@ -13,4 +16,4 @@
:initial-value (make-hash-table :test 'equal)))
-(defvar *settings* nil "A hashmap view of `select * from blog.settings`. If this variable is nil, wrap your route with @transaction middleware. If you setf keys here, remember to update db too with murja.settings:update-setting")
+(defvar *settings* nil "A hashmap view of `select * from blog.settings`. If this variable is nil, wrap your route with @transaction middleware. If you setf keys here, remember to update db too with murja.routes.settings-routes:update-setting")
diff --git a/src/view/settings.lisp b/src/view/settings.lisp
new file mode 100644
index 0000000..335b577
--- /dev/null
+++ b/src/view/settings.lisp
@@ -0,0 +1,18 @@
+(defpackage murja.view.settings
+ (:use :cl :binding-arrows :spinneret :easy-routes :murja.model.settings)
+ (:import-from :murja.view.components.tabs :deftab))
+
+(in-package :murja.view.settings)
+
+(deftab settings (:url "/settings"
+ :title "Settings"
+ :require-login t
+ :needed-abilities ("update-settings"))
+ (let ((all-settings (all-setting-names)))
+ (:form :action "/settings" :method "post"
+ (dolist (setting all-settings)
+ (let ((getter (setting-getter setting)))
+ (if getter
+ (:label ("~a: " setting)
+ (:input :type :text :value (funcall getter) :name setting))
+ (:div.alert ("~a is missing it's getter" setting))))))))