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.
88 lines
2.6 KiB
88 lines
2.6 KiB
2 years ago
|
(defpackage #:authentication
|
||
|
(: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
|
||
|
#:request-params
|
||
|
#:get-current-user
|
||
|
#:get-user-id))
|
||
|
|
||
|
(in-package #:authentication)
|
||
|
|
||
|
(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 :username username)))
|
||
|
:user-pass #'(lambda (username)
|
||
|
(user::password-of
|
||
|
(with-connection (db)
|
||
|
(mito:find-dao 'user :username username))))
|
||
|
:user-roles #'(lambda (username)
|
||
|
(cons :logged-in
|
||
|
(let ((user (with-connection (db)
|
||
|
(mito:find-dao
|
||
|
'user :username username))))
|
||
|
(and user
|
||
|
(= (user::is-administrator-p user) app-constants:+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 get-user-data ()
|
||
|
"Get session csrf-token, current (logged-in) user and there roles."
|
||
|
(let ((databag (list :token (csrf-token))))
|
||
|
(if (hermetic::logged-in-p)
|
||
|
(append databag
|
||
|
(list
|
||
|
:roles (get-user-roles)
|
||
|
:user (get-current-user))))))
|
||
|
|
||
|
(defun get-user-id (username)
|
||
|
"Returns the Id. number of the specified `USERNAME' in the database."
|
||
|
(with-connection (db)
|
||
|
(mito:object-id
|
||
|
(mito:find-dao 'user :username username))))
|
||
|
|
||
|
(defun request-params (request)
|
||
|
"Loops through the HTTP `REQUEST' and creates a key-value pairing."
|
||
|
(loop :for (key . value) :in request
|
||
|
:collect (let ((*package* (find-package :keyword)))
|
||
|
(read-from-string key))
|
||
|
:collect value))
|
||
|
|
||
|
(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))
|