ritherdon-archive/src/web.lisp

(in-package #:cl-user)
(defpackage #:ritherdon-archive.web
  (:use #:cl
        #:caveman2
        #:ritherdon-archive.config
        #:ritherdon-archive.view
        #:ritherdon-archive.db
        #:datafly
        #:sxql
	#:cl-pass
	#:app-constants
	#:hermetic
	#:auth
	#:utils
	#:user)
  (:export #:*web*))
(in-package #:ritherdon-archive.web)

;; for @route annotation
(syntax:use-syntax :annot)

;;
;; Application

(defclass <web> (<app>) ())
(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")))    

(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 "/")))))

(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")))
	  ((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 "/"))))))

(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)))))

(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) ()
  (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) ()
  (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 <web>) (code (eql 404)))
  (declare (ignore app))
  (merge-pathnames #P"_errors/404.html"
                   *template-directory*))