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.
562 lines
22 KiB
562 lines
22 KiB
(defpackage #:routing |
|
(:use #:cl |
|
#:caveman2 |
|
#:hot-line.config |
|
#:hot-line.view |
|
#:hot-line.db |
|
#:app-constants |
|
#:datafly |
|
#:sxql |
|
#:local-time |
|
#:sqlite |
|
#:cl-pass |
|
#:storage |
|
#:validation |
|
#:authentication |
|
#:user-management |
|
#:storage-management |
|
#:convert |
|
#:hermetic |
|
#:pagination) |
|
(:export |
|
;; CHARTING SECTION |
|
#:create-chart |
|
#:create-chart1 |
|
|
|
;; STORAGE SECTION |
|
#:add-storage-file |
|
#:delete-storage-file |
|
#:update-storage-file |
|
|
|
;; SESSION MANAGEMENT |
|
#:attempt-login |
|
#:log-out |
|
|
|
;; USER MANAGEMENT |
|
#:add-user |
|
#:delete-user |
|
#:sign-up-user |
|
#:update-role |
|
#:update-display-name |
|
#:update-password)) |
|
(in-package #:routing) |
|
|
|
#| Routing.lisp (The overflow file for web.lisp) |
|
================================================================================ |
|
In here is essentially the overflow of code from the web.lisp file. When the |
|
code in one of 'defroute' macros needs breaking out into its own |
|
function (defined with a 'defun'), I add that function into this file. The |
|
reason why is so I can keep the website routes free from clutter (as much as I |
|
can help it). By using something like the origami package in Emacs, I can reduce |
|
the routes to their first line so I an quickly scan through the file and |
|
navigate to the function I need to work next. |
|
|
|
You will find, the functions in here tend to deal the HTTP POST requests almost |
|
exclusively. At the time of writing (August 2022), I have not had any need to |
|
include a function which deals with a HTTP GET request. But, I intend to add |
|
them to this file unless this file becomes too unwieldy. |
|
|# |
|
|
|
;; CHARTING SECTION |
|
|
|
(defun create-chart (request) |
|
"Builds the chart by calling out to Python and returns the file created by it." |
|
(destructuring-bind |
|
(&key title content-file x-axis y-axis &allow-other-keys) |
|
(authentication:request-params request) |
|
(let* ((current-user (authentication:get-current-user)) |
|
(username (user::username-of current-user)) |
|
(alert-message nil) |
|
(checks-failed? nil) |
|
(status-code nil) |
|
(python-output nil) |
|
(file-type (car (last content-file))) |
|
(data-bag `(:token ,(authentication:csrf-token) |
|
:user ,current-user |
|
:roles ,(authentication:get-user-roles)))) |
|
(cond ((null content-file) |
|
(setf alert-message +storage-file-not-found+) |
|
(setf checks-failed? t)) |
|
((and (not (string-equal "text/csv" file-type)) |
|
(not (string-equal "text/tsv" file-type)) |
|
(not (string-equal "text/tab-separated-values" file-type))) |
|
(setf alert-message +undetermined-file-type+) |
|
(setf checks-failed? t) |
|
(setf status-code 301)) |
|
((or (null (directory-exists-p username +uploads-directory+)) |
|
(null (directory-exists-p username ""))) |
|
(setf alert-message +storage-directory-not-found+) |
|
(setf checks-failed? t) |
|
(setf status-code 301)) |
|
(t (setf checks-failed? nil) |
|
(setf status-code 201))) |
|
(if (not checks-failed?) |
|
(progn |
|
;; File is stored on server so it available to hot-line-python. |
|
;; hot-line-python is called from this website but is run in |
|
;; seperate process to this website. |
|
(let* ((sanitised-filename (clean-filename (second content-file))) |
|
(sanitised-filename-root (pathname-name sanitised-filename)) |
|
(prefixed-filename (format nil "line_~a--~a.html" |
|
(convert:universal-time-to-prefix) |
|
sanitised-filename-root)) |
|
(temp-file-path ; For input .csv/.tsv file uploaded to server. |
|
(make-path username |
|
+uploads-directory+ |
|
sanitised-filename)) |
|
(output-path |
|
(make-path username "" prefixed-filename))) |
|
(storage:store-file username |
|
+uploads-directory+ |
|
(format nil sanitised-filename) |
|
content-file) |
|
(setf python-output (uiop:run-program |
|
(list (merge-pathnames |
|
"hot-line-python/venv/bin/python" |
|
hot-line.config::*application-root*) |
|
(format nil "~a" |
|
(merge-pathnames |
|
"hot-line-python/app/hot-line-python.py" |
|
hot-line.config::*application-root*)) |
|
;; "-V" ; For verbose output. |
|
(format nil "-t ~a" title) |
|
(format nil "-x ~a" x-axis) |
|
(format nil "-y ~a" y-axis) |
|
(format nil "~a" temp-file-path) |
|
(format nil "~a" output-path)) |
|
:output :string |
|
:error-output :string)) |
|
(storage:remove-file username +uploads-directory+ |
|
sanitised-filename)))) |
|
(if (and (not (search "CRITICAL" python-output)) |
|
(null alert-message)) |
|
(setf alert-message +generic-success+) |
|
(setf alert-message +generic-fail+)) |
|
(format t "~@s" python-output) |
|
`(,status-code () (,(hot-line.view:render |
|
"user/dashboard.html" |
|
(append data-bag |
|
`(:alert ,alert-message |
|
:storage-files |
|
,(reverse |
|
(storage:get-file-names |
|
(storage:get-files-in-directory |
|
username ""))) |
|
:python-output ,python-output)))))))) |
|
|
|
;; Storage Section |
|
|
|
(defun add-storage-file (request) |
|
"Stores the meta-data and data-file of an uploaded file (to the website). |
|
The CSRF-Token and Logged-in checks should already be completed before calling |
|
this function." |
|
(destructuring-bind |
|
(&key filename slug content-type content-file &allow-other-keys) |
|
(authentication:request-params request) |
|
(cond ((or (storage-management:get-file-from-db :slug slug) |
|
(storage-management:get-file-from-db :filename filename)) |
|
`(303 () (,(hot-line.view:render |
|
"storage/add.html" |
|
`(:alert |
|
,app-constants:+storage-file-already-exists+ |
|
:token ,(authentication:csrf-token) |
|
:user ,(authentication:get-current-user) |
|
:roles ,(authentication:get-user-roles)))))) |
|
(t (let* ((current-user (authentication:get-current-user)) |
|
(username (user::username-of current-user)) |
|
(file-count (storage-management:get-file-count username))) |
|
(storage-management:add-file-to-db filename username ; content-type |
|
(caddr content-file) |
|
slug) |
|
(storage:store-file username app-constants:+media-directory+ |
|
filename content-file) |
|
`(201 () (,(hot-line.view:render |
|
"storage/manage.html" |
|
`(:alert |
|
,app-constants:+storage-file-successful-upload+ |
|
:token ,(authentication:csrf-token) |
|
:root-url ,(format nil "storage/manage/~a" username) |
|
:user ,current-user |
|
:roles ,(authentication:get-user-roles) |
|
:storage-count |
|
,(storage-management:get-file-count username) |
|
:categories |
|
,(db-management:get-distinct-column-totals |
|
"file" "content_type") |
|
:storage-files |
|
,(storage-management:get-paginated-files |
|
username 1 +default-page-size+ :filename) |
|
:pagination ,(pagination:make-pagination |
|
:page 1 |
|
:page-size +default-page-size+ |
|
:nb-elements file-count)))))))))) |
|
|
|
(defun delete-storage-file (request) |
|
"Deletes the data-file in the logged-in user's /storage directory." |
|
(destructuring-bind |
|
(&key filename &allow-other-keys) |
|
(authentication:request-params request) |
|
(let* ((current-user (authentication:get-current-user)) |
|
(username (user::username-of current-user)) |
|
(token (authentication:csrf-token)) |
|
(roles (authentication:get-user-roles)) |
|
(alert-message nil)) |
|
(if (null (storage:file-exists-p username "" filename)) |
|
(setf alert-message +storage-file-not-found+) |
|
(progn |
|
(setf alert-message +storage-file-deleted+) |
|
(storage:remove-file username "" filename))) |
|
`(303 () (,(hot-line.view:render |
|
"user/dashboard.html" |
|
`(:alert ,alert-message |
|
:token ,token |
|
:user ,current-user |
|
:roles ,roles |
|
:storage-files ,(reverse |
|
(storage:get-file-names |
|
(storage:get-files-in-directory |
|
username "")))))))))) |
|
|
|
(defun update-storage-file (request) |
|
"Updates the meta-data of a data-file stored in the /storage directory. |
|
The function does not alter the actual data-file. The thinking is if you want to |
|
edit the actual data-file, you should just delete the file stored on the |
|
server (in /storage) and upload a new one. This function is for changing the |
|
`FILENAME', `CONTENT-TYPE' and `SLUG' (I.E. the things you use to reference the |
|
files in /storage when logged into the site)." |
|
(destructuring-bind |
|
(&key id filename content-type slug &allow-other-keys) |
|
(authentication:request-params request) |
|
(let* ((current-user (authentication:get-current-user)) |
|
(username (user::username-of current-user)) |
|
(original-db-file-name (file::filename-of |
|
(storage-management:get-file-from-db :id id)))) |
|
(cond ((null (storage-management:get-file-from-db :id id)) |
|
`(303 () (,(hot-line.view:render "storage/manage.html" |
|
`(:alert ,app-constants:+storage-file-not-found+ |
|
:token ,(authentication:csrf-token) |
|
:user ,current-user |
|
:root-url ,(format nil "storage/manage/~a" username) |
|
:roles ,(authentication:get-user-roles) |
|
:storage-count |
|
,(storage-management:get-file-count username) |
|
:categories |
|
,(db-management:get-distinct-column-totals |
|
"file" "content_type") |
|
:storage-files |
|
,(storage-management:get-all-files-from-db |
|
username :filename) |
|
:pagination ,(make-pagination |
|
:page 1 |
|
:page-size +default-page-size+ |
|
:nb-elements |
|
(storage-management:get-file-count |
|
username))))))) |
|
(t ;; Read as 'ignore inner code-block of UNLESS the file exists'. |
|
(unless (storage:file-exists-p username app-constants:+media-directory+ filename) |
|
(storage:rename-content-file username app-constants:+media-directory+ |
|
original-db-file-name filename)) |
|
(storage-management:edit-file-in-db id filename content-type slug) |
|
`(201 () (,(hot-line.view:render "storage/manage.html" |
|
`(:alert |
|
,app-constants:+storage-file-successfully-updated+ |
|
:token ,(authentication:csrf-token) |
|
:user ,current-user |
|
:root-url ,(format nil "storage/manage/~a" username) |
|
:roles ,(authentication:get-user-roles) |
|
:storage-count |
|
,(storage-management:get-file-count username) |
|
:categories |
|
,(db-management:get-distinct-column-totals |
|
"file" "content_type") |
|
:storage-files |
|
,(storage-management:get-all-files-from-db |
|
username :filename) |
|
:pagination ,(make-pagination |
|
:page 1 |
|
:page-size +default-page-size+ |
|
:nb-elements |
|
(storage-management:get-file-count |
|
username))))))))))) |
|
|
|
;; Session Management |
|
|
|
(defun attempt-login (request) |
|
"Attempts to log the user into the website. |
|
Redirects the user depending on how successful the log-in attempt |
|
is. Updates the session id and password if log-in is |
|
successful. `REQUEST' consists of the body parameters of the log-in |
|
attempt Derived from the log-in form comprised in /session and |
|
/login." |
|
(destructuring-bind |
|
(&key username password authenticity-token &allow-other-keys) |
|
(authentication:request-params request) |
|
(if (not (string= authenticity-token (authentication:csrf-token))) |
|
`(403 (:content-type "text/plain") ("Denied")) |
|
(let ((params (list :|username| username :|password| password))) |
|
(hermetic:login params |
|
;; Successful log-in attempt. |
|
(progn |
|
(setf |
|
;; Set session Id. to the logged in user. |
|
(gethash :id ningle:*session*) |
|
(authentication:get-user-id username) |
|
;; Set the users password (for session) |
|
(gethash :password ningle:*session*) password) |
|
`(303 (:location "/dashboard"))) |
|
;; Failed log-in attempt. |
|
(hot-line.view:render "user/log-in.html" |
|
`(:alert ,+incorrect-login-details+ |
|
:token ,(authentication:csrf-token))) |
|
;; No user found. |
|
(hot-line.view:render "user/log-in.html" |
|
`(:alert ,+user-not-found+ |
|
:token ,(authentication:csrf-token)))))))) |
|
|
|
(defun log-out (request) |
|
"Logs the current user out of the browsing session." |
|
(destructuring-bind |
|
(&key username authenticity-token &allow-other-keys) |
|
(authentication:request-params request) |
|
(if (not (string= authenticity-token (authentication:csrf-token))) |
|
`(403 (:content-type "text/plain") ("Denied")) |
|
(hermetic::logout |
|
;; Successful log-out. |
|
(progn (authentication::flash-gethash :id ningle:*session*) |
|
'(303 (:location "/"))) |
|
;; Failed log-out |
|
'(303 (:location "/")))))) |
|
|
|
;; User Management |
|
(defun sign-up-user (request) |
|
"Creates a new user via the sign-up section of site." |
|
(destructuring-bind |
|
(&key username display-name password &allow-other-keys) |
|
(authentication:request-params request) |
|
(let* ((alert-message nil) |
|
(can-create-user? nil)) |
|
(cond ((user-management:user-in-db-p :username username) |
|
(setf alert-message +username-already-taken+)) |
|
((find t (mapcar #'validation:string-is-nil-or-empty-p |
|
`(,username ,display-name ,password))) |
|
(setf alert-message +nil-or-empty-string-used+)) |
|
(t (setf alert-message +new-user-added+) |
|
(setf can-create-user? t))) |
|
(if (equal can-create-user? t) |
|
(progn |
|
(user-management:add-user-to-db |
|
username display-name +false+ |
|
password) |
|
(storage:ensure-directory-exists username "uploads") |
|
(attempt-login request)) |
|
`(303 () (, (hot-line.view:render |
|
"sign-up.html" |
|
`(:alert ,+username-already-taken+ |
|
:username ,username |
|
:display-name ,display-name |
|
:token ,(authentication:csrf-token))))))))) |
|
|
|
(defun add-user (request) |
|
"Adds a new user to the database by a currently logged in (I.E. admin.) user. |
|
`REQUEST' contains the data provided by the HTML form used to specify |
|
the new user's data." |
|
(destructuring-bind |
|
(&key authenticity-token username display-name administrator |
|
password &allow-other-keys) |
|
(authentication:request-params request) |
|
(cond ((if (user-management:user-in-db-p :username username) |
|
`(303 () (,(hot-line.view:render |
|
"user/add.html" |
|
`(:alert ,+username-already-taken+ |
|
:token ,(authentication:csrf-token) |
|
:user ,(authentication:get-current-user) |
|
:roles ,(authentication:get-user-roles))))))) |
|
;; TODO: Add validation for add-user arguments. |
|
(t (progn |
|
(user-management:add-user-to-db |
|
username display-name |
|
(convert:checkbox-to-bool administrator) password) |
|
(storage:ensure-directory-exists username "uploads") |
|
`(201 () (,(hot-line.view:render |
|
"user/index.html" |
|
`(:alert ,+new-user-added+ |
|
:token ,(authentication:csrf-token) |
|
:user ,(authentication:get-current-user) |
|
:users ,(user-management:get-all-users) |
|
:roles ,(authentication:get-user-roles) |
|
:user-count |
|
,(user-management:get-total-user-count) |
|
:categories |
|
,(db-management:get-distinct-column-totals |
|
"user" "administrator")))))))))) |
|
|
|
(defun delete-user (request) |
|
"Deletes a user from the database. |
|
`REQUEST' contains the data which specifies which user should be |
|
deleted. It typically is provided by a HTML form." |
|
(destructuring-bind |
|
(&key username &allow-other-keys) |
|
(authentication:request-params request) |
|
(cond ((not (user-management:user-in-db-p :username username)) |
|
`(303 () (,(hot-line.view:render |
|
"user/index.html" |
|
`(:alert ,+user-not-found+ |
|
:token ,(authentication:csrf-token) |
|
:user ,(authentication:get-current-user) |
|
:users ,(user-management:get-all-users) |
|
:roles ,(authentication:get-user-roles) |
|
:user-count |
|
,(user-management:get-total-user-count) |
|
:categories |
|
,(db-management:get-distinct-column-totals |
|
"user" "administrator")))))) |
|
((or (and (equal +true+ (user::is-administrator-p (authentication:get-current-user))) |
|
(user-management:user-in-db-p :username username)) |
|
(string= username (user::username-of (authentication:get-current-user)))) |
|
(let ((username-being-deleted (user::username-of (authentication:get-current-user)))) |
|
(user-management:delete-user-from-db :username username) |
|
(storage:remove-directory username "") |
|
(if (string= username username-being-deleted) |
|
(log-out request) |
|
`(201 () (,(hot-line.view:render |
|
"user/index.html" |
|
`(:alert ,app-constants:+user-deleted+ |
|
:token ,(authentication:csrf-token) |
|
:user ,(authentication:get-current-user) |
|
:users ,(user-management:get-all-users) |
|
:roles ,(authentication:get-user-roles) |
|
:user-count |
|
,(user-management:get-total-user-count) |
|
:categories |
|
,(db-management:get-distinct-column-totals |
|
"user" "administrator")))))))) |
|
(t (format nil "Well then, it looks like you managed to the |
|
website into a right old pickle. For you to have got here, |
|
you must have been snooping around. Fair play, you broke |
|
the website."))))) |
|
|
|
(defun update-role (request) |
|
"Give or remove admin. privileges to user specified in `REQUEST'." |
|
(destructuring-bind (&key username administrator &allow-other-keys) |
|
(authentication:request-params request) |
|
(cond ((null (user-management:user-in-db-p :username username)) |
|
`(303 () (,(hot-line.view:render (user-management:get-crud-redirect-url) |
|
`(:alert ,+user-not-found+ |
|
:token ,(authentication:csrf-token) |
|
:user ,(authentication:get-current-user) |
|
:users ,(user-management:get-all-users) |
|
:roles ,(authentication:get-user-roles)))))) |
|
((not (= (user::is-administrator-p (authentication:get-current-user)) |
|
+true+)) |
|
`(303 () ,(hot-line.view:render (user-management:get-crud-redirect-url) |
|
`(:alert ,+user-not-authorised+ |
|
:token ,(authentication:csrf-token) |
|
:user ,(authentication:get-current-user) |
|
:users ,(user-management:get-all-users) |
|
:roles ,(authentication:get-user-roles) |
|
:user-count |
|
,(user-management:get-total-user-count) |
|
:categories |
|
,(db-management:get-distinct-column-totals |
|
"user" "administrator"))))) |
|
(t (user-management:update-user-administration-role |
|
username (convert:checkbox-to-bool administrator)) |
|
`(201 () (,(hot-line.view:render (user-management:get-crud-redirect-url) |
|
`(:alert ,+user-role-updated+ |
|
:token ,(authentication:csrf-token) |
|
:user ,(authentication:get-current-user) |
|
:users ,(user-management:get-all-users) |
|
:roles ,(authentication:get-user-roles) |
|
:user-count |
|
,(user-management:get-total-user-count) |
|
:categories |
|
,(db-management:get-distinct-column-totals |
|
"user" "administrator"))))))))) |
|
|
|
(defun update-display-name (request) |
|
"Change the username of the user specified in `REQUEST'." |
|
(destructuring-bind (&key username display-name &allow-other-keys) |
|
(authentication:request-params request) |
|
(format t "[INFO] SESSION: ~A" (gethash :password ningle:*session*)) |
|
(cond ((equal nil (user-management:user-in-db-p :username username)) |
|
`(303 () (,(hot-line.view:render (user-management:get-crud-redirect-url) |
|
`(:alert ,app-constants:+user-not-found+ |
|
:token ,(authentication:csrf-token) |
|
:user ,(authentication:get-current-user) |
|
:users ,(user-management:get-all-users) |
|
:roles ,(authentication:get-user-roles) |
|
:user-count |
|
,(user-management:get-total-user-count) |
|
:categories |
|
,(db-management:get-distinct-column-totals |
|
"user" "administrator")))))) |
|
(t (user-management:update-user-display-name username display-name) |
|
`(201 () (,(hot-line.view:render (user-management:get-crud-redirect-url) |
|
`(:alert ,+display-name-updated+ |
|
:token ,(authentication:csrf-token) |
|
:user ,(authentication:get-current-user) |
|
:users ,(user-management:get-all-users) |
|
:roles ,(authentication:get-user-roles) |
|
:user-count |
|
,(user-management:get-total-user-count) |
|
:categories |
|
,(db-management:get-distinct-column-totals |
|
"user" "administrator"))))))))) |
|
|
|
(defun update-password (request) |
|
"Change the password of the user specified in `REQUEST'." |
|
(destructuring-bind (&key username old-password new-password &allow-other-keys) |
|
(authentication:request-params request) |
|
(cond ((equal nil (user-management:user-in-db-p :username username)) |
|
`(303 () (,(hot-line.view:render (user-management:get-crud-redirect-url) |
|
`(:alert ,app-constants:+user-not-found+ |
|
:token ,(authentication:csrf-token) |
|
:user ,(authentication:get-current-user) |
|
:users ,(user-management:get-all-users) |
|
:roles ,(authentication:get-user-roles) |
|
:user-count |
|
,(user-management:get-total-user-count) |
|
:categories |
|
,(db-management:get-distinct-column-totals |
|
"user" "administrator")))))) |
|
((if (and (not old-password) (hermetic:role-p :administrator)) |
|
(progn |
|
(user-management:update-user-password username new-password) |
|
`(201 () (,(hot-line.view:render (user-management:get-crud-redirect-url) |
|
`(:alert ,app-constants:+password-updated+ |
|
:token ,(authentication:csrf-token) |
|
:user ,(authentication:get-current-user) |
|
:users ,(user-management:get-all-users) |
|
:roles ,(authentication:get-user-roles) |
|
:user-count |
|
,(user-management:get-total-user-count) |
|
:categories |
|
,(db-management:get-distinct-column-totals |
|
"user" "administrator")))))))) |
|
((equal nil |
|
(cl-pass:check-password old-password |
|
(user::password-of (user-management:user-in-db-p |
|
:username username)))) |
|
`(303 () (,(hot-line.view:render (user-management:get-crud-redirect-url) |
|
`(:alert ,app-constants:+old-password-incorrect+ |
|
:token ,(authentication:csrf-token) |
|
:user ,(authentication:get-current-user) |
|
:users ,(user-management:get-all-users) |
|
:roles ,(authentication:get-user-roles) |
|
:user-count |
|
,(user-management:get-total-user-count) |
|
:categories |
|
,(db-management:get-distinct-column-totals |
|
"user" "administrator")))))) |
|
(t (user-management:update-user-password username new-password) |
|
`(201 () (,(hot-line.view:render (user-management:get-crud-redirect-url) |
|
`(:alert ,app-constants:+password-updated+ |
|
:token ,(authentication:csrf-token) |
|
:user ,(authentication:get-current-user) |
|
:users ,(user-management:get-all-users) |
|
:roles ,(authentication:get-user-roles) |
|
:user-count |
|
,(user-management:get-total-user-count) |
|
:categories |
|
,(db-management:get-distinct-column-totals |
|
"user" "administrator")))))))))
|
|
|