(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
	#:status-codes ; (HTTP Status Codes)
	#:hermetic
	#:auth
	#:utils
	#:user
	#:nera-db)
  (: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*)

;;
;; Routing rules

(defroute "/" ()
  (let ((alert (utils:get-and-reset-alert)))
    (hermetic:auth (:logged-in)
		   (render #P"index.html"
			   (append (auth:auth-user-data)
				   `(:alert ,alert)))
		   (render #P"index.html" `(:alert ,alert)))))

(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 `(,+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)))
	   `(,+forbidden+ (:content-type "text/plain") ("Denied")))
	  ((uiop:file-exists-p (ritherdon-archive.config:database-name))
	   `(,+service-unavailable+ (:location "/")))
	  (t (nera-db:init-db
	      (lack.request:request-body-parameters ningle:*request*))
	     ;; Redirect to /setup-complete?
	     (utils:set-alert "All set-up. Log-in to continue.")
	     (redirect "/login")))))

(defroute ("/sign-up" :method :GET) ()
  (if (= +false+ (site-settings::enable-sign-up-p (nera:get-site-settings)))
      (progn
	(utils:set-alert "This feature has been disabled.")
	(redirect "/"))
      (hermetic:auth (:logged-in)
		    ;; Hermetic Authorised (Logged in users can't sign-up).
		    (progn
		      (utils:set-alert
		       "You need to be signed out to create a new account.")
		      (redirect "/dashboard"))
		    ;; Hermetic Not Authorised
		    (let ((alert (utils:get-and-reset-alert)))
		      (render "sign-up.html"
			      `(:token ,(auth:csrf-token)
				:alert ,alert))))))

(defroute ("/sign-up" :method :POST) ()
  (destructuring-bind
      (&key username display-name 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)))
	   `(,+forbidden+ (:content-type "text/plain") ("Denied")))
	  ((not (string= password password-check))
	   (utils:set-alert "Passwords don't match.")
	   (redirect "/sign-up"))
	  ((find t (mapcar
		    #'utils:string-is-nil-or-empty?
		    `(,username ,display-name ,password)))
	   (utils:set-alert "Incomplete form. Please fill out every section.")
	   (redirect "/sign-up"))
	  (t (hermetic:auth
	      (:logged-in)
	      ;; Authorised (Logged in user can't sign-up).
	      (progn (utils:set-alert "Logged in users are not allowed to create account.")
		     (redirect "/dashboard"))
	      ;; Not Authorised
	      (progn
		(nera-db:create-user username display-name password +false+)
		(utils:set-alert "Account created.")
		(redirect "/login")))))))


(defroute ("/login" :method :GET) ()
  (hermetic:auth (:logged-in)
		 ;; 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
      (&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)))
	`(,+forbidden+ (: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*) (nera:get-user-id username)
	      ;; Set the users password (for session)
	      (gethash :password ningle:*session*) password)
	    (redirect "/dashboard"))
	   ;; Failed log-in attempt.
	   (progn (utils:set-alert "Incorrect details provided.")
		  (redirect "/login"))
	   ;; No user found.
	   (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*))
    (if (not (string= authenticity-token (auth:csrf-token)))
	`(,+forbidden+ (:content-type "text/plain") ("Denied"))
	(hermetic:auth (:logged-in)
		       (hermetic:logout
			;; Successful log-out.
			(progn (auth:flash-gethash :id ningle:*session*)
			       (redirect "/"))
			;; Failed log-out
			(progn (utils:set-alert "Error: Unable to log out.")
			       (redirect "/")))))))

(defroute ("/dashboard" :method :GET) ()
  (hermetic:auth (:logged-in)
		 ;; 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 ("/site-settings" :method :GET) ()
  (hermetic:auth (:administrator)
		 ;; Authorised
		 (let ((alert (utils:get-and-reset-alert)))
		   (render #P"user/site-settings.html"
			   (append (auth:auth-user-data)
				   `(:alert ,alert))))
		 ;; Not Authorised
		 (progn
		   (utils:set-alert "You are not authorised to view this page.")
		   (redirect "/"))))

(defroute ("/users" :method :GET) ()
  (hermetic:auth (:administrator)
		 ;; Authorised
		 (let ((alert (utils:get-and-reset-alert)))	   
		   (render #P"user/index.html"
			   (append (auth:auth-user-data)
				   `(:alert ,alert
				     :users ,(nera:get-all-users)))))
		 ;; Not Authorised
		 (progn
		   (utils:set-alert "You are not authorised to view this page.")
		   (redirect "/login"))))

(defroute ("/user/admin/create" :method :POST) ()
  (destructuring-bind
      (&key username display-name 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)))
	   `(,+forbidden+ (:content-type "text/plain") ("Denied")))
	  ((not (string= password password-check))
	   (utils:set-alert "Passwords don't match.")
	   (redirect "/users"))
	  ((find t (mapcar
		    #'utils:string-is-nil-or-empty?
		    `(,username ,display-name ,password)))
	   (utils:set-alert "Incomplete form. Please fill out every section.")
	   (redirect "/users"))
	  ((not (null (nera:get-user username)))
	   (utils:set-alert "Username already taken.")
	   (redirect "/users"))
	  (t (hermetic:auth
	      (:administrator)
	      ;; Authorised
	      (progn
		(nera-db:create-user username display-name password +false+)
		(utils:set-alert "Account created.")
		(redirect "/users"))
	      ;; Not Authorised
	      (progn
		(utils:set-alert "You are not authorised to view that page.")
		(redirect "/")))))))

(defroute ("/user/edit" :method :GET) ()
  (hermetic:auth (:logged-in)
		 ;; 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"))))

(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)))
	   `(,+forbidden+ (:content-type "text/plain") ("Denied")))
	  ((not (string= new-password password-check))
	   (utils:set-alert "Passwords don't match.")
	   (redirect "/user/edit"))
	  (t (hermetic:auth
	      (:logged-in)
	      ;; Authorised
	      (progn
		(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

(defmethod on-exception ((app <web>) (code (eql 404)))
  (declare (ignore app))
  (merge-pathnames #P"_errors/404.html"
                   *template-directory*))