return-to-ritherdon
/
ritherdon-archive
1
0
Fork 0
Code Issues 2 Pull Requests Projects 1 Releases Wiki Activity
Browse Source

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.
stable
Craig Oates 2 years ago
parent
e6162306ef
commit
25142d5049
1 changed files with 58 additions and 55 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 113
      src/web.lisp

113
src/web.lisp
Unescape View File

@ -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 '<web>))
(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

Write Preview
Loading…
Cancel
Save