diff of c1b7556791bfee0c0fd7081b66154caa2bce0adf
c1b7556791bfee0c0fd7081b66154caa2bce0adf
diff --git a/aggressive-murja.asd b/aggressive-murja.asd
index 4fe8f09..23a1326 100644
--- a/aggressive-murja.asd
+++ b/aggressive-murja.asd
@@ -90,6 +90,11 @@
(:file "root")
(:file "post")
(:file "page")))
+
+ (:module "middleware"
+ :components
+ ((:file "newui-dispatcher")))
+
(:file "blog-main")
(:file "blog-post")))
diff --git a/resources/sql/user-fns.sql b/resources/sql/user-fns.sql
index f244d4d..dbade9c 100644
--- a/resources/sql/user-fns.sql
+++ b/resources/sql/user-fns.sql
@@ -54,5 +54,5 @@ WHERE id = $4;
-- name: patch-user-img*
UPDATE blog.Users
-SET img_location = $1
+pSET img_location = $1
WHERE id = $2;
diff --git a/src/middleware/db.lisp b/src/middleware/db.lisp
index b24570e..8a08c3b 100644
--- a/src/middleware/db.lisp
+++ b/src/middleware/db.lisp
@@ -34,6 +34,8 @@
;; (connect-murjadb-toplevel)
+;; (postmodern:disconnect-toplevel)
+
(defmacro with-db (&rest body)
`(destructuring-bind (&key db username password host port) (db-config)
(format t "Connecting to db ~a ~%" (list db username "$password" host :port port))
diff --git a/src/models/user.lisp b/src/models/user.lisp
index d907ea5..744f7f1 100644
--- a/src/models/user.lisp
+++ b/src/models/user.lisp
@@ -1,6 +1,7 @@
(defpackage murja.models.user
(:use :cl)
- (:export :User :user-id :user-username :user-password :user-nickname :user-img-location))
+ (:local-nicknames (:json :com.inuoe.jzon))
+ (:export :User :user-id :user-username :user-password :user-nickname :user-img-location :abilities))
(in-package :murja.models.user)
@@ -9,20 +10,52 @@
(username :initarg :username :accessor user-username :col-type string)
(password :initarg :password :accessor user-password :col-type string)
(nickname :initarg :nickname :accessor user-nickname :col-type string)
- (img-location :initform "" :initarg :img-location :accessor user-img-location :col-type string))
+ (img-location :initform "" :initarg :img-location :accessor user-img-location :col-type string)
+ (abilities :initarg :abilities :initform #() :accessor abilities :col-type string))
(:metaclass postmodern:dao-class)
(:keys id)
(:table-name "blog.Users"))
(defmethod print-object ((usr User) output)
- (with-slots (id username nickname img-location) usr
+ (with-slots (id username nickname img-location abilities) usr
(format output "#<USER: ~{~{~a: ~s~}~^,~%~t ~}>" (list
(list :id id)
(list :username username)
(list :nickname nickname)
(list :password "******")
- (list :img-location img-location)))))
+ (list :img-location img-location)
+ (list :abilities abilities)))))
+
+(defparameter *user-query*
+ "SELECT
+ u.id,
+ u.username,
+ u.nickname,
+ u.img_location,
+ u.password,
+ json_agg(DISTINCT perm.action) as abilities
+FROM
+ blog.users u
+ left JOIN blog.groupmapping gm ON u.id = gm.userid
+ left JOIN blog.grouppermissions gp ON gp.groupid = gm.groupid
+ left JOIN blog.permission perm ON gp.permissionid = perm.id
+WHERE
+ u.id = $1
+GROUP BY
+ u.id;")
+
+(defun get-user (id)
+ "Gets user and populates its abilities"
+ (let ((usr (postmodern:query *user-query* id (:dao User :single))))
+ (with-slots (abilities) usr
+ (when (stringp abilities)
+ (setf abilities (json:parse abilities))))
+ usr))
+
;; (postmodern:get-dao 'User 1)
+
+;; (get-user 1)
+
diff --git a/src/views/blog-main.lisp b/src/views/blog-main.lisp
index cea0d14..2efe8a0 100644
--- a/src/views/blog-main.lisp
+++ b/src/views/blog-main.lisp
@@ -9,28 +9,50 @@
(:import-from :murja.newui :@newui :c :with-state)
(:import-from :easy-routes :defroute)
+
+ (:import-from murja.newui.dispatcher :deftab :@dispatcher)
+
(:export :blog-root-view))
(in-package :murja.views.blog-main)
+
+(deftab /only-logged-in (:route "/only-logged-in"
+ :require-login t
+ :title "This shouldn't be visible")
+ (c :div ()
+ "Näkyyköhän tää?"))
+
+(deftab / (:route "/blog/"
+ :title "Home")
+ (let* ((settings (get-settings))
+ (page-size (gethash "recent-post-count" settings))
+ (page 1)
+ (page-posts (murja.models.post:get-page page page-size)))
+
+ ;; (when *user*
+ ;; (setf (gethash "Secret logged in user tab" tabs-spec)
+ ;; (c :div () (format nil "Welcome ~a" (user-nickname *user*)))))
+
+ (murja.views.components.page:page page-posts)))
+
+
+
+
+
(defroute blog-root-view ("/blog/" :method :get
:decorators (@transaction
@newui
(@ssr-authenticated :require-authentication nil)
- @check-if-initial)) ()
-
- (let* ((settings (get-settings))
- (page-size (gethash "recent-post-count" settings))
- (page 1)
- (page-posts (murja.models.post:get-page page page-size))
-
- (tabs-spec (hash
- ("Home" (murja.views.components.page:page page-posts)))))
-
- (when *user*
- (setf (gethash "Secret logged in user tab" tabs-spec)
- (c :div () (format nil "Welcome ~a" (user-nickname *user*)))))
-
- (root-component
- (tabs "Home"
- tabs-spec))))
+ @check-if-initial
+ @dispatcher)) ()
+ '/)
+
+(defroute /only-logged-in-handler ("/only-logged-in"
+ :method :get
+ :decorators (@transaction
+ @newui
+ (@ssr-authenticated :require-authentication nil)
+ @check-if-initial
+ @dispatcher)) ()
+ '/only-logged-in)
diff --git a/src/views/middleware/newui-dispatcher.lisp b/src/views/middleware/newui-dispatcher.lisp
new file mode 100644
index 0000000..1c48b0a
--- /dev/null
+++ b/src/views/middleware/newui-dispatcher.lisp
@@ -0,0 +1,67 @@
+(defpackage murja.newui.dispatcher
+ (:use :cl :murja.views.components.root :murja.views.components.tab :cl-hash-util)
+ (:import-from :murja.newui :c)
+ (:import-from :murja.middleware.auth :@ssr-authenticated :*user*)
+ (:export :@dispatcher :deftab))
+
+(in-package :murja.newui.dispatcher)
+
+;; (defun @view-dispatcher (next)
+;; "Returns newui data structures based on whatever parameters next returns.
+
+(defclass tab ()
+ ((route :initarg :route :initform (error "Route needed") :accessor tab-route)
+ (component :initarg :component :initform (error "Component needed") :accessor tab-component)
+ (title :initarg :title :initform (error "Title needed") :accessor title)
+ (require-login :initarg :require-login :initform nil :accessor require-login)
+ (needed-abilities :initarg :abilities :initform nil :accessor abilities)))
+
+(defmethod print-object ((current-tab tab) output)
+ (with-slots (route title needed-abilities) current-tab
+ (format output "#<TAB: ~{~{~a: ~s~}~^,~%~t ~}>" (list
+ (list :route route)
+ (list :title title)
+ (list :needed-abilities needed-abilities)))))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defvar *tabs* (make-hash-table :test 'equal)
+ "A list of tabs, keyed by symbol and valued by instances of tab class"))
+
+(defmacro deftab (sym (&key
+ route
+ title
+ require-login
+ needed-abilities)
+ &body rst)
+ `(setf (gethash (quote ,sym) *tabs*)
+ (make-instance 'tab :route ,route
+ :abilities ,needed-abilities
+ :require-login ,require-login
+ :title ,title
+ :component (lambda ()
+ (c :div ()
+ ,@rst)))))
+(defun @dispatcher (next)
+ (let* ((sym (funcall next))
+ (tab (gethash sym *tabs*))
+ (usr-abilities (when *user*
+ (coerce (murja.models.user:abilities *user*) 'list))))
+ (assert tab)
+
+ (when (or (not (abilities tab))
+ (intersection usr-abilities (abilities tab))
+ (or (not (require-login tab))
+ *user*))
+
+ (let ((tab-spec (hash)))
+ (maphash (lambda (k v)
+ (declare (ignore k))
+ (format t "req login? ~a~%" (require-login v))
+ (when (or (not (require-login v))
+ *user*)
+ (setf (gethash (title v) tab-spec)
+ (funcall (tab-component v)))))
+ *tabs*)
+ (root-component
+ (tabs (title tab)
+ tab-spec))))))