A website for producing interactive charts without writing a single line of code. Built with Common Lisp and Python. https://charts.craigoates.net
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.
 
 
 
 

85 lines
2.6 KiB

(defpackage #:authentication
(:use #:cl
#:hermetic
#:sxql
;; #:datafly
#:ningle
#:mito
#:user)
(:import-from #:hot-line.db
#:connection-settings
#:db
#:with-connection)
(:export #:csrf-token
#:get-user-roles
#:request-params
#:get-current-user
#:get-user-id
#:flash-gethash))
(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::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) 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::user
:id (gethash :id ningle:*session*))))
(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::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))
;; Copied over from rails-to-caveman project. I don't know what it
;; does exactly.
(defun flash-gethash (key table)
(let ((value (gethash key table)))
(remhash key table)
value))