src/views/middleware/newui-dispatcher.lisp

(defpackage murja.newui.dispatcher
  (:use :cl :murja.views.components.root :murja.views.components.tab :cl-hash-util :murja.models.tab)
  (:import-from :murja.middleware.db :@transaction)
  (:import-from :easy-routes :defroute)
  (:import-from :murja.newui :c :@newui)
  (:import-from :murja.routes.root-routes :@check-if-initial)
  (:import-from :murja.middleware.auth :@ssr-authenticated :*user*)
  (:export :@dispatcher :deftab))

(in-package :murja.newui.dispatcher)

(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
			 subtab 
			 require-login
			 needed-abilities
			 captured-route-params
			 inject-to-head)
		  &body rst)
  `(progn
     (setf (gethash (quote ,sym) *tabs*)
	   (make-instance 'tab :route ,route
			       :abilities ,needed-abilities
			       :require-login ,require-login
			       :subtab ,subtab
			       :title ,title
			       :component (lambda (&rest all)
					    (destructuring-bind ,captured-route-params all 
					      (murja.middleware.db:with-db
						  (let ((murja.middleware.db:*settings* (murja.settings:get-settings)))
						    (c :div ()
						       ,@rst)))))))
     
     (defroute ,(intern (format nil "~a-sym" sym)) (,route 
						    :method :get
						    :decorators (@transaction
								 @newui
								 (@ssr-authenticated :require-authentication ,require-login )
								 @check-if-initial
								 (@dispatcher ,inject-to-head))) ()
       (values (quote ,sym) (list ,@captured-route-params)))))
     
(defun @dispatcher (next inject-to-head)
  (multiple-value-bind (sym route-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.models.user:abilities *user*) 'list))))
      (assert tab)
      (when (or (not (abilities tab))
		(intersection usr-abilities (abilities tab))
		(or (not (require-login tab))
		    *user*))
	(let ((*inject-to-head* inject-to-head))
	  (root-component
	   (tabs (title tab)
		 (remove-if-not (lambda (tab)
				  (or (not (require-login tab))
				      (subtab tab)
				      *user*))
				(alexandria:hash-table-values 
				 *tabs*))
		 route-params)))))))