Public archive for the Return to Ritherdon project.
https://www.nicolaellisandritherdon.com
You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
77 lines
2.3 KiB
77 lines
2.3 KiB
(defpackage #:auth
|
|||
(:use #:cl
|
|||
#:hermetic
|
|||
#:sxql
|
|||
;; #:datafly
|
|||
#:ningle
|
|||
#:mito
|
|||
#:app-constants
|
|||
#:user)
|
|||
(:import-from #:ritherdon-archive.db
|
|||
#:connection-settings
|
|||
#:db
|
|||
#:with-connection)
|
|||
(:export #:csrf-token
|
|||
#:get-user-roles
|
|||
#:get-current-user
|
|||
#:flash-gethash
|
|||
#:auth-user-data))
|
|||
|
|||
(in-package #:auth)
|
|||
|
|||
(defun csrf-token ()
|
|||
"Cross-Site Request Forgery (CSRF) token."
|
|||
(cdr (assoc "lack.session"
|
|||
(lack.request:request-cookies ningle:*request*)
|
|||
:test #'string=)))
|
|||
|
|||
(hermetic:setup
|
|||
;; #' is needed. (hermetic:roles) generates infinite-loop when called
|
|||
;; otherwise -- 'roles' called in other parts of code-base.
|
|||
;; #' is shorthand for the 'function' operator (returns the function
|
|||
;; object associated with the name of the function which is supplied
|
|||
;; as an argument. Keep forgetting that.
|
|||
:user-p #'(lambda (username)
|
|||
(with-connection (db)
|
|||
(mito:find-dao 'user::user :username username)))
|
|||
:user-pass #'(lambda (username)
|
|||
(user::password-of
|
|||
(with-connection (db)
|
|||
(mito:find-dao 'user::user :username username))))
|
|||
:user-roles #'(lambda (username)
|
|||
(cons :logged-in
|
|||
(let ((user (with-connection (db)
|
|||
(mito:find-dao
|
|||
'user::user :username username))))
|
|||
(and user
|
|||
(= (user::is-administrator-p user) +true+)
|
|||
'(:administrator)))))
|
|||
:session ningle:*session*
|
|||
:denied (constantly '(400 (:content-type "text/plain") ("Authentication denied"))))
|
|||
|
|||
(defun get-current-user()
|
|||
"Returns the currently logged in user from the browser session."
|
|||
(with-connection (db)
|
|||
(mito:find-dao 'user :id (gethash :id ningle:*session*))))
|
|||
|
|||
(defun auth-user-data ()
|
|||
"Get usual session data for logged in `USER'."
|
|||
`(:token ,(auth:csrf-token)
|
|||
:roles ,(auth:get-user-roles)
|
|||
:user ,(auth:get-current-user)))
|
|||
|
|||
(defun get-user-roles()
|
|||
"Returns a list of roles the current user has assigned to them.
|
|||
This is mostly to check if the user is logged-in or has administration
|
|||
privileges. You can then create if-blocks in the HTML templates and
|
|||
control what the user can and cannot see or do."
|
|||
(loop :for role :in (hermetic:roles)
|
|||
:collect role
|
|||
:collect t))
|
|||
|
|||
(defun flash-gethash (key table)
|
|||
"Clears out the session hash."
|
|||
(let ((value (gethash key table)))
|
|||
(remhash key table)
|
|||
value))
|