|
|
|
@ -1,4 +1,4 @@
|
|
|
|
|
(defpackage #:authentication |
|
|
|
|
(defpackage #:auth |
|
|
|
|
(:use #:cl |
|
|
|
|
#:hermetic |
|
|
|
|
#:sxql |
|
|
|
@ -13,11 +13,12 @@
|
|
|
|
|
#:with-connection) |
|
|
|
|
(:export #:csrf-token |
|
|
|
|
#:get-user-roles |
|
|
|
|
#:request-params |
|
|
|
|
#:get-current-user |
|
|
|
|
#:get-user-id)) |
|
|
|
|
#:get-user-id |
|
|
|
|
#:flash-gethash |
|
|
|
|
#:auth-user-data)) |
|
|
|
|
|
|
|
|
|
(in-package #:authentication) |
|
|
|
|
(in-package #:auth) |
|
|
|
|
|
|
|
|
|
(defun csrf-token () |
|
|
|
|
"Cross-Site Request Forgery (CSRF) token." |
|
|
|
@ -33,50 +34,46 @@
|
|
|
|
|
;; as an argument. Keep forgetting that. |
|
|
|
|
:user-p #'(lambda (username) |
|
|
|
|
(with-connection (db) |
|
|
|
|
(mito:find-dao 'user :username username))) |
|
|
|
|
(mito:find-dao 'user::user :username username))) |
|
|
|
|
:user-pass #'(lambda (username) |
|
|
|
|
(user::password-of |
|
|
|
|
(with-connection (db) |
|
|
|
|
(mito:find-dao 'user :username username)))) |
|
|
|
|
(mito:find-dao 'user::user :username username)))) |
|
|
|
|
:user-roles #'(lambda (username) |
|
|
|
|
(cons :logged-in |
|
|
|
|
(let ((user (with-connection (db) |
|
|
|
|
(mito:find-dao |
|
|
|
|
'user :username username)))) |
|
|
|
|
'user::user :username username)))) |
|
|
|
|
(and user |
|
|
|
|
(= (user::is-administrator-p user) app-constants:+true+) |
|
|
|
|
'(:administrator))))) |
|
|
|
|
:Session ningle:*session* |
|
|
|
|
:session ningle:*session* |
|
|
|
|
:denied (constantly '(400 (:content-type "text/plain") ("Authentication denied")))) |
|
|
|
|
|
|
|
|
|
;; TODO: MOVE GET-USER OUT OF AUTH PACKAGE (NOT APPLICABLE HERE)) |
|
|
|
|
(defun get-user (username) |
|
|
|
|
"Returns a `USER' profile from the database." |
|
|
|
|
(with-connection (db) |
|
|
|
|
(mito:find-dao 'user :username username))) |
|
|
|
|
|
|
|
|
|
(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*)))) |
|
|
|
|
(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 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))) |
|
|
|
|
|
|
|
|
|
;; TODO: MOVE GET-USER-ID OUT OF AUTH PACKAGE (NOT APPLICABLE HERE)) |
|
|
|
|
(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 |
|
|
|
@ -85,3 +82,9 @@ 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)) |