From 490a79a356b9f69d720232dd6fe85c027fc19529 Mon Sep 17 00:00:00 2001 From: Craig Oates Date: Mon, 12 Sep 2022 07:49:41 +0100 Subject: [PATCH] add log-in and start account setting functionality. --- src/web.lisp | 121 +++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 92 insertions(+), 29 deletions(-) diff --git a/src/web.lisp b/src/web.lisp index 714cd82..9af2107 100644 --- a/src/web.lisp +++ b/src/web.lisp @@ -7,9 +7,10 @@ #:ritherdon-archive.db #:datafly #:sxql + #:cl-pass #:app-constants #:hermetic - #:authentication + #:auth #:utils #:user) (:export #:*web*)) @@ -26,7 +27,7 @@ (clear-routing-rules *web*) (defun init-db (request) - "Creates the database and creates Admin. so in `USER' table." + "Creates the database and creates Admin. in `USER' table." (destructuring-bind (&key username display-name password &allow-other-keys) (utils:request-params request) @@ -36,57 +37,119 @@ (mito:create-dao 'user :username username :display-name display-name - :password password + :password (hermetic::hash password) :administrator +true+)))) ;; ;; Routing rules (defroute "/" () - (let ((databag - (if (hermetic::logged-in-p) - `(:roles ,(authentication:get-user-roles) - :user ,(authentication:get-current-user))))) - (render #P"index.html" databag))) + (hermetic:auth (:logged-in) + (render #P"index.html" + `(:roles ,(auth:get-user-roles) + :user ,(auth:get-current-user))) + (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 ,(authentication:csrf-token)))) + (render #P"initial-setup.html" `(:token ,(auth:csrf-token)))) (t '(303 (: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 (authentication:csrf-token))) + (cond ((not (string= authenticity-token (auth:csrf-token))) '(403 (:content-type "text/plain") ("Denied"))) ((uiop:file-exists-p (ritherdon-archive.config:database-name)) - (render #P"initial-setup.html" `(:token ,(authentication:csrf-token)))) - ((hermetic::logged-in-p) - '(303 (:location "/"))) + (render #P"initial-setup.html" `(:token ,(auth:csrf-token)))) (t (init-db (lack.request:request-body-parameters ningle:*request*)) '(301 (:location "/")))))) -;; TODO: YOU ARE UP TO HERE. FINISH THE LOG-IN ROUTES. NOT WORKING. (defroute ("/login" :method :GET) () - (if (hermetic:logged-in-p) - `(301 (:location "/dashboard")) - (render "user/log-in.html" - `(:token ,(authentication:csrf-token))))) + (hermetic:auth (:logged-in) + `(301 (:location "/dashboard")) + (render "user/log-in.html" + `(:token ,(auth:csrf-token) + :roles ,(auth:get-user-roles))))) -(defroute ("/login" :method :POST) (&key method) - (routing:attempt-login (lack.request:request-body-parameters ningle:*request*))) +(defroute ("/login" :method :POST) () + (destructuring-bind + (&key username password authenticity-token &allow-other-keys) + (utils:request-params + (lack.request:request-body-parameters ningle:*request*)) + (if (not (string= authenticity-token (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*) (auth:get-user-id username) + ;; Set the users password (for session) + (gethash :password ningle:*session*) password) + '(301 (:location "/dashboard"))) + ;; Failed log-in attempt. + '(301 (:location "/login")) + ;; No user found. + '(301 (:location "/"))))))) -(defroute ("/logout" :method :POST) (&key method) - (log-out (lack.request:request-body-parameters ningle:*request*)) +(defroute ("/logout" :method :POST) () + (destructuring-bind + (&key authenticity-token &allow-other-keys) + (utils:request-params (lack.request:request-body-parameters ningle:*request*)) + (if (not (string= authenticity-token (auth:csrf-token))) + `(403 (:content-type "text/plain") ("Denied")) + (hermetic:auth (:logged-in) + (hermetic:logout + ;; Successful log-out. + (progn (auth:flash-gethash :id ningle:*session*) + '(303 (:location "/"))) + ;; Failed log-out + '(303 (:location "/"))))))) (defroute ("/dashboard" :method :GET) () - (if (hermetic::logged-in-p) - (render #P"user/dashboard.html" - `(:roles ,(authentication:get-user-roles) - :user ,(authentication:get-current-user)))) - '(303 (:location "/"))) ; Change to /login. -;; -;; Error pages + (hermetic:auth (:logged-in) + (render #P"user/dashboard.html" (auth:auth-user-data)) + '(303 (:location "/login")))) + +(defroute ("/user/edit" :method :GET) () + (hermetic:auth (:logged-in) + (render #P"user/edit.html" (auth:auth-user-data)) + '(303 (:location "/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) + (utils:request-params + (lack.request:request-body-parameters ningle:*request*)) + (cond ((not (string= authenticity-token (auth:csrf-token))) + `(403 (: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"))) + (t (hermetic:auth + (:logged-in) + (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"))))))) + + ;; + ;; Error pages (defmethod on-exception ((app ) (code (eql 404))) (declare (ignore app))