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

@@ -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"
+		 (render #P"index.html" (auth:auth-user-data))
-			 `(: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 ,(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*))
+	  (t (nera-db:init-db
-	     '(301 (:location "/"))))))
+	      (lack.request:request-body-parameters ningle:*request*))
+	     (redirect "/dashboard")))))
 
 (defroute ("/login" :method :GET) ()
   (hermetic:auth (:logged-in)
-		 `(301 (:location "/dashboard"))
+		 ;; Authorised
-		 (render "user/log-in.html"
+		 (redirect "/dashboard")
-			 `(:token ,(auth:csrf-token)
+		 ;; Not Authorised
-			   :roles ,(auth:get-user-roles)))))
+		 (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))
+		 ;; Authorised
-		 '(303 (:location "/login"))))
+		 (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))
+		 ;; Authorised
-		 '(303 (:location "/login"))))
+		 (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)
+	   (utils:set-alert "Password don't match.")
-	   `(403 (:content-type "text/plain") ("Denied")))
+	   (redirect "/user/edit"))
 	  (t (hermetic:auth
 	      (:logged-in)
+	      ;; Authorised
 	      (progn
-		;; Validate form input
+		(nera-db:update-user
-		;; Update user display-name if changed
+		 (user::username-of (auth:get-current-user))
-		;; Update user password if changed
+		 display-name new-password)
-		;; relocate to dashboard.
+		(utils:set-alert "User details updated.")
-		(with-connection (db)
+		(redirect "/dashboard"))
-		  (let ((user-to-update
+	      ;; Not Authorised
-			  (mito:find-dao 'user:user :username
+	      (progn (utils:set-alert "You are not logged in.")
-					 (user::username-of (auth:get-current-user)))))
+		     (redirect "/login")))))))
-		    (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