@ -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