|
|
|
@ -6,26 +6,61 @@
|
|
|
|
|
#:hermetic |
|
|
|
|
#:ritherdon-archive.db |
|
|
|
|
#:utils |
|
|
|
|
#:user) |
|
|
|
|
#:user |
|
|
|
|
#:site-settings) |
|
|
|
|
(:export #:init-db |
|
|
|
|
#:update-user |
|
|
|
|
#:get-user |
|
|
|
|
#:get-user-id)) |
|
|
|
|
#:get-user-id |
|
|
|
|
#:delete-user |
|
|
|
|
#:create-user |
|
|
|
|
#:get-site-settings |
|
|
|
|
#:migrate-all)) |
|
|
|
|
(in-package #:nera-db) |
|
|
|
|
|
|
|
|
|
(defparameter *tables* '(user site-settings) |
|
|
|
|
"List of the DB tables that need to be checked for migrations and DB setup.") |
|
|
|
|
|
|
|
|
|
(defun init-db (request) |
|
|
|
|
"Creates the database and creates Admin. in `USER' table." |
|
|
|
|
(destructuring-bind |
|
|
|
|
(&key username display-name password &allow-other-keys) |
|
|
|
|
(&key username display-name password allow-sign-up &allow-other-keys) |
|
|
|
|
(utils:request-params request) |
|
|
|
|
(with-connection (db) |
|
|
|
|
;; Add to the list to add more tables. |
|
|
|
|
(mapcar #'mito:ensure-table-exists '(user)) |
|
|
|
|
(mapcar #'mito:ensure-table-exists *tables*) |
|
|
|
|
(mito:create-dao 'user |
|
|
|
|
:username username |
|
|
|
|
:display-name display-name |
|
|
|
|
:password (hermetic::hash password) |
|
|
|
|
:administrator +true+)))) |
|
|
|
|
:administrator +true+) |
|
|
|
|
(mito:create-dao 'site-settings |
|
|
|
|
:enable-sign-up (utils:checkbox-to-bool allow-sign-up))))) |
|
|
|
|
|
|
|
|
|
(defun ensure-tables-exist () |
|
|
|
|
"Creates missing tables from the database." |
|
|
|
|
(with-connection (db) |
|
|
|
|
(mapcar #'mito:ensure-table-exists *tables*))) |
|
|
|
|
|
|
|
|
|
(defun migrate-all () |
|
|
|
|
"Migrate the tables after we changed the class definition." |
|
|
|
|
(with-connection (db) |
|
|
|
|
(ensure-tables-exist) |
|
|
|
|
(mapcar #'mito:migrate-table *tables*))) |
|
|
|
|
|
|
|
|
|
(defun create-user (username display-name password administrator) |
|
|
|
|
"Add a new `USER' to the database." |
|
|
|
|
(with-connection (db) |
|
|
|
|
(mito:create-dao 'user |
|
|
|
|
:username username |
|
|
|
|
:display-name display-name |
|
|
|
|
:administrator administrator |
|
|
|
|
:password (hermetic::hash password)))) |
|
|
|
|
|
|
|
|
|
(defun delete-user (username) |
|
|
|
|
"Deletes `USER' from the database." |
|
|
|
|
(with-connection (db) |
|
|
|
|
(mito:delete-by-values 'user:user :username username))) |
|
|
|
|
|
|
|
|
|
(defun update-user (username &optional display-name new-password) |
|
|
|
|
"Updates `USER' in database." |
|
|
|
@ -48,3 +83,10 @@
|
|
|
|
|
"Returns a `USER' profile from the database." |
|
|
|
|
(with-connection (db) |
|
|
|
|
(mito:find-dao 'user :username username))) |
|
|
|
|
|
|
|
|
|
;; (site-settings::enable-sign-up-p (nera:get-site-settings 'enable-sign-up)) |
|
|
|
|
|
|
|
|
|
(defun get-site-settings () |
|
|
|
|
"Gets the settings for the website from the database." |
|
|
|
|
(with-connection (db) |
|
|
|
|
(mito:find-dao 'site-settings))) |
|
|
|
|