|
|
|
(in-package #:cl-user)
|
|
|
|
(defpackage #:ritherdon-archive.web
|
|
|
|
(:use #:cl
|
|
|
|
#:caveman2
|
|
|
|
#:ritherdon-archive.config
|
|
|
|
#:ritherdon-archive.view
|
|
|
|
#:ritherdon-archive.db
|
|
|
|
#:datafly
|
|
|
|
#:sxql
|
|
|
|
#:app-constants
|
|
|
|
#:hermetic
|
|
|
|
#:authentication
|
|
|
|
#:utils
|
|
|
|
#:user)
|
|
|
|
(:export #:*web*))
|
|
|
|
(in-package #:ritherdon-archive.web)
|
|
|
|
|
|
|
|
;; for @route annotation
|
|
|
|
(syntax:use-syntax :annot)
|
|
|
|
|
|
|
|
;;
|
|
|
|
;; Application
|
|
|
|
|
|
|
|
(defclass <web> (<app>) ())
|
|
|
|
(defvar *web* (make-instance '<web>))
|
|
|
|
(clear-routing-rules *web*)
|
|
|
|
|
|
|
|
(defun init-db (request)
|
|
|
|
"Creates the database and creates Admin. so in `USER' table."
|
|
|
|
(destructuring-bind
|
|
|
|
(&key username display-name password &allow-other-keys)
|
|
|
|
(utils:request-params request)
|
|
|
|
(with-connection (db)
|
|
|
|
;; Add to the list to add more tables.
|
|
|
|
(mapcar #'mito:ensure-table-exists '(user))
|
|
|
|
(mito:create-dao 'user
|
|
|
|
:username username
|
|
|
|
:display-name display-name
|
|
|
|
:password password
|
|
|
|
:administrator +true+))))
|
|
|
|
;;
|
|
|
|
;; Routing rules
|
|
|
|
|
|
|
|
(defroute "/" ()
|
|
|
|
(let ((databag
|
|
|
|
(if (hermetic::logged-in-p)
|
|
|
|
`(:roles ,(authentication:get-user-roles)
|
|
|
|
:user ,(authentication:get-current-user)))))
|
|
|
|
(render #P"index.html" databag)))
|
|
|
|
|
|
|
|
(defroute "/setup" ()
|
|
|
|
(cond ((not (uiop:file-exists-p (ritherdon-archive.config:database-name)))
|
|
|
|
(render #P"initial-setup.html" `(:token ,(authentication:csrf-token))))
|
|
|
|
(t '(303 (:location "/")))))
|
|
|
|
|
|
|
|
(defroute ("/run-setup" :method :POST) ()
|
|
|
|
(destructuring-bind (&key authenticity-token &allow-other-keys)
|
|
|
|
(utils:request-params
|
|
|
|
(lack.request:request-body-parameters ningle:*request*))
|
|
|
|
(cond ((not (string= authenticity-token (authentication:csrf-token)))
|
|
|
|
'(403 (:content-type "text/plain") ("Denied")))
|
|
|
|
((uiop:file-exists-p (ritherdon-archive.config:database-name))
|
|
|
|
(render #P"initial-setup.html" `(:token ,(authentication:csrf-token))))
|
|
|
|
((hermetic::logged-in-p)
|
|
|
|
'(303 (:location "/")))
|
|
|
|
(t (init-db (lack.request:request-body-parameters ningle:*request*))
|
|
|
|
'(301 (:location "/"))))))
|
|
|
|
|
|
|
|
;; TODO: YOU ARE UP TO HERE. FINISH THE LOG-IN ROUTES. NOT WORKING.
|
|
|
|
(defroute ("/login" :method :GET) ()
|
|
|
|
(if (hermetic:logged-in-p)
|
|
|
|
`(301 (:location "/dashboard"))
|
|
|
|
(render "user/log-in.html"
|
|
|
|
`(:token ,(authentication:csrf-token)))))
|
|
|
|
|
|
|
|
(defroute ("/login" :method :POST) (&key method)
|
|
|
|
(routing:attempt-login (lack.request:request-body-parameters ningle:*request*)))
|
|
|
|
|
|
|
|
(defroute ("/logout" :method :POST) (&key method)
|
|
|
|
(log-out (lack.request:request-body-parameters ningle:*request*))
|
|
|
|
|
|
|
|
(defroute ("/dashboard" :method :GET) ()
|
|
|
|
(if (hermetic::logged-in-p)
|
|
|
|
(render #P"user/dashboard.html"
|
|
|
|
`(:roles ,(authentication:get-user-roles)
|
|
|
|
:user ,(authentication:get-current-user))))
|
|
|
|
'(303 (:location "/"))) ; Change to /login.
|
|
|
|
;;
|
|
|
|
;; Error pages
|
|
|
|
|
|
|
|
(defmethod on-exception ((app <web>) (code (eql 404)))
|
|
|
|
(declare (ignore app))
|
|
|
|
(merge-pathnames #P"_errors/404.html"
|
|
|
|
*template-directory*))
|