From 25142d5049158578f5a4587327bf06debfcba92b Mon Sep 17 00:00:00 2001 From: Craig Oates Date: Tue, 13 Sep 2022 05:04:51 +0100 Subject: [PATCH] refactor web package to use auth, util and status-code packages. The web package was already using code from some of these packages. This commit moves some of the code in the web package into one of the various referenced packages and also has 'web' utilise the new features in those pacakges also. The biggest shift is in how the alert-messages are handled (store in ningle:*session* across HTTP requests) and how auth. is handled -- mostly the redirects functionality. --- src/web.lisp | 113 ++++++++++++++++++++++++++------------------------- 1 file changed, 58 insertions(+), 55 deletions(-) diff --git a/src/web.lisp b/src/web.lisp index 9af2107..541f200 100644 --- a/src/web.lisp +++ b/src/web.lisp @@ -9,10 +9,12 @@ #:sxql #:cl-pass #:app-constants + #:status-codes ; (HTTP Status Codes) #:hermetic #:auth #:utils - #:user) + #:user + #:nera-db) (:export #:*web*)) (in-package #:ritherdon-archive.web) @@ -26,52 +28,41 @@ (defvar *web* (make-instance ')) (clear-routing-rules *web*) -(defun init-db (request) - "Creates the database and creates Admin. in `USER' table." - (destructuring-bind - (&key username display-name password &allow-other-keys) - (utils:request-params request) - (with-connection (db) - ;; Add to the list to add more tables. - (mapcar #'mito:ensure-table-exists '(user)) - (mito:create-dao 'user - :username username - :display-name display-name - :password (hermetic::hash password) - :administrator +true+)))) ;; ;; Routing rules (defroute "/" () (hermetic:auth (:logged-in) - (render #P"index.html" - `(:roles ,(auth:get-user-roles) - :user ,(auth:get-current-user))) + (render #P"index.html" (auth:auth-user-data)) (render #P"index.html"))) (defroute "/setup" () ;; If there is no database, there is no user, hence no more checks. (cond ((not (uiop:file-exists-p (ritherdon-archive.config:database-name))) (render #P"initial-setup.html" `(:token ,(auth:csrf-token)))) - (t '(303 (:location "/"))))) + (t `(,+service-unavailable+ (:location "/"))))) (defroute ("/run-setup" :method :POST) () (destructuring-bind (&key authenticity-token &allow-other-keys) (utils:request-params (lack.request:request-body-parameters ningle:*request*)) (cond ((not (string= authenticity-token (auth:csrf-token))) - '(403 (:content-type "text/plain") ("Denied"))) + `(,+forbidden+ (:content-type "text/plain") ("Denied"))) ((uiop:file-exists-p (ritherdon-archive.config:database-name)) (render #P"initial-setup.html" `(:token ,(auth:csrf-token)))) - (t (init-db (lack.request:request-body-parameters ningle:*request*)) - '(301 (:location "/")))))) + (t (nera-db:init-db + (lack.request:request-body-parameters ningle:*request*)) + (redirect "/dashboard"))))) (defroute ("/login" :method :GET) () (hermetic:auth (:logged-in) - `(301 (:location "/dashboard")) - (render "user/log-in.html" - `(:token ,(auth:csrf-token) - :roles ,(auth:get-user-roles))))) + ;; Authorised + (redirect "/dashboard") + ;; Not Authorised + (let ((alert (utils:get-and-reset-alert))) + (render "user/log-in.html" + `(:token ,(auth:csrf-token) + :alert ,alert))))) (defroute ("/login" :method :POST) () (destructuring-bind @@ -79,7 +70,7 @@ (utils:request-params (lack.request:request-body-parameters ningle:*request*)) (if (not (string= authenticity-token (csrf-token))) - `(403 (:content-type "text/plain") ("Denied")) + `(,+forbidden+ (:content-type "text/plain") ("Denied")) (let ((params (list :|username| username :|password| password))) (hermetic:login params @@ -90,63 +81,75 @@ (gethash :id ningle:*session*) (auth:get-user-id username) ;; Set the users password (for session) (gethash :password ningle:*session*) password) - '(301 (:location "/dashboard"))) + (redirect "/dashboard")) ;; Failed log-in attempt. - '(301 (:location "/login")) + (progn (utils:set-alert "Incorrect details provided.") + (redirect "/login")) ;; No user found. - '(301 (:location "/"))))))) + (progn (utils:set-alert "Can't find that user.") + (redirect "/login"))))))) (defroute ("/logout" :method :POST) () (destructuring-bind (&key authenticity-token &allow-other-keys) - (utils:request-params (lack.request:request-body-parameters ningle:*request*)) + (utils:request-params + (lack.request:request-body-parameters ningle:*request*)) (if (not (string= authenticity-token (auth:csrf-token))) - `(403 (:content-type "text/plain") ("Denied")) + `(,+forbidden+ (:content-type "text/plain") ("Denied")) (hermetic:auth (:logged-in) (hermetic:logout ;; Successful log-out. (progn (auth:flash-gethash :id ningle:*session*) - '(303 (:location "/"))) + (redirect "/")) ;; Failed log-out - '(303 (:location "/"))))))) + (progn (utils:set-alert "Error: Unable to log out.") + (redirect "/"))))))) (defroute ("/dashboard" :method :GET) () (hermetic:auth (:logged-in) - (render #P"user/dashboard.html" (auth:auth-user-data)) - '(303 (:location "/login")))) + ;; Authorised + (let ((alert (utils:get-and-reset-alert))) + (render #P"user/dashboard.html" + (append (auth:auth-user-data) + `(:alert ,alert)))) + ;; Not Authorised + (progn (utils:set-alert "You are not logged in.") + (redirect "/login")))) (defroute ("/user/edit" :method :GET) () (hermetic:auth (:logged-in) - (render #P"user/edit.html" (auth:auth-user-data)) - '(303 (:location "/login")))) + ;; Authorised + (let ((alert (utils:get-and-reset-alert))) + (render #P"user/edit.html" + (append (auth:auth-user-data) + `(:alert ,alert)))) + ;; Not Authorised + (progn (utils:set-alert "You are not logged in.") + (redirect "/login")))) -;; TODO: UP TO HERE. FINISH /USER/EDIT POST REQUEST. (defroute ("/user/edit" :method :POST) () (destructuring-bind - (&key display-name new-password password-check authenticity-token &allow-other-keys) + (&key display-name new-password password-check + authenticity-token &allow-other-keys) (utils:request-params (lack.request:request-body-parameters ningle:*request*)) (cond ((not (string= authenticity-token (auth:csrf-token))) - `(403 (:content-type "text/plain") ("Denied"))) + `(,+forbidden+ (:content-type "text/plain") ("Denied"))) ((not (string= new-password password-check)) - (format t "Passwords don't match ~a & ~a" new-password password-check) - `(403 (:content-type "text/plain") ("Denied"))) + (utils:set-alert "Password don't match.") + (redirect "/user/edit")) (t (hermetic:auth (:logged-in) + ;; Authorised (progn - ;; Validate form input - ;; Update user display-name if changed - ;; Update user password if changed - ;; relocate to dashboard. - (with-connection (db) - (let ((user-to-update - (mito:find-dao 'user:user :username - (user::username-of (auth:get-current-user))))) - (setf (user::display-name-of user-to-update) display-name - (user::password-of user-to-update) (hermetic::hash new-password)) - (mito:save-dao user-to-update))) - '(201 (:location "/dashboard"))) - '(303 (:location "/login"))))))) + (nera-db:update-user + (user::username-of (auth:get-current-user)) + display-name new-password) + (utils:set-alert "User details updated.") + (redirect "/dashboard")) + ;; Not Authorised + (progn (utils:set-alert "You are not logged in.") + (redirect "/login"))))))) ;; ;; Error pages