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
	#:status-codes ; (HTTP Status Codes)
	#:hermetic
	#:auth
	#:utils
	#:validation
	#:user
        #:zip
	#:nera-db
	#:files
        #:search
        #:snapshot)
  (: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 "/" ()
  (cond ((not (uiop:file-exists-p (ritherdon-archive.config:database-name)))
	 (redirect "/setup"))	
	((string= "archive" (site-settings::home-page-of (nera:get-site-settings)))
	 (redirect "/archive"))
	((string= "login" (site-settings::home-page-of (nera:get-site-settings)))
	 (redirect "/login"))
	((string= "pages" (site-settings::home-page-of (nera:get-site-settings)))
	 (redirect "/pages"))
        ((string= "search" (site-settings::home-page-of (nera:get-site-settings)))
	 (redirect "/search"))
	((string= "sign-up" (site-settings::home-page-of (nera:get-site-settings)))
	 (redirect "/sign-up"))
	(t (render #P"index.html"
		   (append (if (hermetic:logged-in-p)
			       (auth:auth-user-data))
			   `(:alert ,(utils:get-and-reset-alert)
			     :nav-menu ,(nera:nav-menu-slugs)
			     :system-data ,(nera:system-data)
			     :content ,(storage:open-text-file
					"" "pages"
					(site-settings::home-page-of
					 (nera:get-site-settings)))))))))

(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*))
	     (storage:init-storage)
	     ;; Redirect to /setup-complete?
	     (utils:set-alert "All set-up. Log-in to continue." "created")
	     (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." "warning")
	(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."
			"warning")
		       (redirect "/dashboard"))
		     ;; Hermetic Not Authorised
		     (let ((alert (utils:get-and-reset-alert)))
		       (render "sign-up.html"
			       `(:token ,(auth:csrf-token)
				 :system-data ,(nera:system-data)
				 :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 (null (nera:get-user username)))
	   (utils:set-alert "Username already taken." "warning")
	   (redirect "/sign-up"))
	  ((not (string= password password-check))
	   (utils:set-alert "Passwords don't match." "invalid-data")
	   (redirect "/sign-up"))
	  ((find t (mapcar
		    #'validation:string-is-nil-or-empty?
		    `(,username ,display-name ,password)))
	   (utils:set-alert "Incomplete form. Please fill out every section."
			    "missing-data")
	   (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."
				      "warning")
		     (redirect "/dashboard"))
	      ;; Not Authorised
	      (progn
		(nera-db:create-user username display-name password +false+)
		(utils:set-alert "Account created." "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)
			     :system-data ,(nera:system-data)
			     :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."
				   "invalid-data")
		  (redirect "/login"))
	   ;; No user found.
	   (progn (utils:set-alert "Can't find that user."
				   "missing-data")
		  (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."
						"error")
			       (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
				     :storage-files
				     ,(nera:latest-storage-editted-files 5 t)
				     :pages ,(nera:latest-editted-pages 5 t)
				     :archive-entries
				     ,(nera::latest-archive-editted-entries 5 t)
                                     :disk-info
                                     ,(first (diskspace:list-all-disk-info t))
				     :system-data ,(nera:system-data)))))
		 ;; Not Authorised
		 (progn (utils:set-alert "You are not logged in." "error")
			(redirect "/login"))))

(defroute ("/site-settings" :method :GET) ()
  (hermetic:auth
   (:administrator)
   ;; Authorised
   (render #P"user/site-settings.html"
	   (append (auth:auth-user-data)
		   `(:alert ,(utils:get-and-reset-alert)
		     :pages ,(nera:get-all-pages)
		     :system-data ,(nera:system-data)
		     :site-wide-snippet ,(storage:open-text-file
					  "" "snippets" "site-wide-snippet.html")
			    ;; Should this be replaced by `SYSTEM-DATA'?
		     :settings ,(nera:get-site-settings))))
   ;; Not Authorised
   (progn
     (utils:set-alert "You are not authorised to view this page." "error")
     (redirect "/login"))))

(defroute ("/site-settings/update-sign-up" :method :POST) ()
  (destructuring-bind
      (&key enable-sign-up 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 (:administrator)
		       ;; Authorised
		       (progn
			 (nera:update-enable-sign-on-settings enable-sign-up)
			 (utils:set-alert "Enable Sign-Up setting updated." "success")
			 (redirect "/site-settings"))
		       ;; Not Authorised
		       (progn
			 (utils:set-alert "You are not authorised to view this page."
					  "error")
			 (redirect "/login"))))))

(defroute ("/site-settings/update-nav-menu" :method :POST) (&key _parsed)
  (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 (:administrator)
		       ;; Authorised
		       (progn
			 (nera:update-nav-menu (cdr (assoc "NAV-MENU" _parsed :test #'string=)))
			 (utils:set-alert "Nav. menu updated." "success")
			 (redirect "/site-settings"))
		       ;; Not Authorised
		       (progn
			 (utils:set-alert "You are not authorised to view this page."
					  "error")
			 (redirect "/login"))))))

(defroute ("/site-settings/update-home-page" :method :POST) ()
  (destructuring-bind
      (&key set-home-page 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 (:administrator)
		       ;; Authorised
		       (cond ((or (string= set-home-page "Select Page")
				  (validation:string-is-nil-or-empty? set-home-page))
			      (utils:set-alert "No value provided. Home page not changed."
					       "missing-data")
			      (redirect "/site-settings"))
			     (t
			      (nera:set-home-page set-home-page)
			      (utils:set-alert "Home page set." "success")
			      (redirect "/site-settings")))
		       ;; Not Authorised
		       (progn
			 (utils:set-alert "You are not authorised to view this page."
					  "error")
			 (redirect "/login"))))))

(defroute ("/site-settings/update-site-name" :method :POST) ()
  (destructuring-bind
      (&key site-name 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 (:administrator)
		       ;; Authorised
		       (cond ((validation:string-is-nil-or-empty? site-name)
			      (utils:set-alert "No value provided. Site name not changed."
					       "missing-data")
			      (redirect "/site-settings"))
			     (t
			      (nera:update-site-name site-name)
			      (utils:set-alert "Site name updated." "success")
			      (redirect "/site-settings")))
		       ;; Not Authorised
		       (progn
			 (utils:set-alert "You are not authorised to view this page."
					  "error")
			 (redirect "/login"))))))

(defroute ("/site-settings/update-code-snippet" :method :POST) ()
  (destructuring-bind
      (&key code-snippet 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 (:administrator)
		       ;; Authorised
		       (progn
			 (storage:store-text
			  "" "snippets" "site-wide-snippet.html" code-snippet)
			 (utils:set-alert "Site-Wide snippet updated." "success")
			 (redirect "/site-settings"))
		       ;; Not Authorised
		       (progn
			 (utils:set-alert "You are not authorised to view this page."
					  "error")
			 (redirect "/login"))))))

(defroute ("/site-settings/update-favicon" :method :POST) ()
  (destructuring-bind
      (&key favicon-file 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
	 (:administrator)
	 ;; Authorised
	 (cond ((validation:string-is-nil-or-empty? (cadr favicon-file))
		(utils:set-alert "No file provided. Favicon not uploaded."
				 "missing-data")
		(redirect "/site-settings"))
               ((not (str:contains?
		      "image" (caddr favicon-file) :ignore-case t))
                (utils:set-alert "Uploaded file is not an image." "invalid-data")
                (redirect "/site-settings"))
	       (t (storage:store-with-raw-path
		   "static/images/favicon.png" favicon-file)
		  (utils:set-alert "Favicon saved." "success")
		  (utils:run-bash-command
		   (format nil "convert ~a -resize 192x192\\> ~a"
			   (merge-pathnames
			    #P"static/images/favicon.png"
			    ritherdon-archive.config:*application-root*)
			   (merge-pathnames
			    #P"static/images/favicon.png"
			    ritherdon-archive.config:*application-root*)))
		  (redirect "/site-settings")))
	 ;; Not Authorised
	 (progn
	   (utils:set-alert "You are not authorised to view this page." "error")
	   (redirect "/login"))))))

(defroute ("/site-settings/update-enable-site-logo" :method :POST) ()
  (destructuring-bind
      (&key enable-site-logo 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 (:administrator)
		       ;; Authorised
		       (progn
			 (nera:update-enable-site-logo-setting enable-site-logo)
			 (utils:set-alert "Enable Site Logo setting saved."
					  "success")
			 (redirect "/site-settings"))
		       ;; Not Authorised
		       (progn
			 (utils:set-alert
			  "You are not authorised to view this page." "error")
			 (redirect "/login"))))))

(defroute ("/site-settings/update-site-logo" :method :POST) ()
  (destructuring-bind
      (&key site-logo 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
	 (:administrator)
	 ;; Authorised
	 (cond ((validation:string-is-nil-or-empty? (cadr site-logo))
		(utils:set-alert "No file provided. Site logo not uploaded."
				 "missing-data")
		(redirect "/site-settings"))
               ((not (str:contains?
		      "image" (caddr site-logo) :ignore-case t))
                (utils:set-alert "Uploaded file is not an image." "invalid-data")
                (redirect "/site-settings"))
	       (t (storage:store-with-raw-path
		   "static/images/site-logo.png" site-logo)
		  (utils:set-alert "Site logo saved." "success")
		  (utils:run-bash-command
		   (format nil "convert ~a -resize 500x500\\> ~a"
			   (merge-pathnames
			    #P"static/images/site-logo.png"
			    ritherdon-archive.config:*application-root*)
			   (merge-pathnames
			    #P"static/images/site-logo.png"
			    ritherdon-archive.config:*application-root*)))
		  (redirect "/site-settings")))
	 ;; Not Authorised
	 (progn
	   (utils:set-alert "You are not authorised to view this page."
			    "error")
	   (redirect "/login"))))))

(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
				     :system-data ,(nera:system-data)
				     :users ,(nera:get-all-users)))))
		 ;; Not Authorised
		 (progn
		   (utils:set-alert "You are not authorised to view this page."
				    "error")
		   (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." "invalid-data")
	   (redirect "/users"))
	  ((find t (mapcar
		    #'validation:string-is-nil-or-empty?
		    `(,username ,display-name ,password)))
	   (utils:set-alert "Incomplete form. Please fill out every section."
			    "missing-data")
	   (redirect "/users"))
	  ((not (null (nera:get-user username)))
	   (utils:set-alert "Username already taken." "warning")
	   (redirect "/users"))
	  (t (hermetic:auth
	      (:administrator)
	      ;; Authorised
	      (progn
		(nera-db:create-user username display-name password +false+)
		(utils:set-alert "Account created." "created")
		(redirect "/users"))
	      ;; Not Authorised
	      (progn
		(utils:set-alert "You are not authorised to view that page."
				 "error")
		(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
				     :system-data ,(nera:system-data)))))
		 ;; Not Authorised
		 (progn (utils:set-alert "You are not logged in." "error")
			(redirect "/login"))))

(defroute ("/user/edit/display-name" :method :POST) ()
  (destructuring-bind
      (&key display-name 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")))
	  (t (hermetic:auth
	      (:logged-in)
	      ;; Authorised
	      (cond ((validation:string-is-nil-or-empty? display-name)
		     (utils:set-alert "Display name not entered." "missing-data")
		     (redirect "/user/edit"))
		    (t (nera-db:update-user
			(user::username-of (auth:get-current-user))
			:display-name display-name :new-password nil)
		       (utils:set-alert "Display name updated." "success")
		       (redirect "/dashboard")))
	      ;; Not Authorised
	      (progn (utils:set-alert "You are not logged in." "error")
		     (redirect "/login")))))))

(defroute ("/user/edit/password" :method :POST) ()
  (destructuring-bind
      (&key 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")))
	  (t (hermetic:auth
	      (:logged-in)
	      ;; Authorised
	      (cond ((find t (mapcar
			      #'validation:string-is-nil-or-empty?
			      `(,new-password ,password-check)))
		     (utils:set-alert
                      "Missing new password data. Make sure both password boxes are filled out."
		      "missing-data")
		     (redirect "/user/edit"))
		    ((not (string= new-password password-check))
		     (utils:set-alert "Passwords don't match." "invalid-data")
		     (redirect "/user/edit"))
		    (t (nera-db:update-user
			(user::username-of (auth:get-current-user))
			:display-name nil :new-password new-password)
		       (utils:set-alert "Password updated." "success")
		       (redirect "/dashboard")))
	      ;; Not Authorised
	      (progn (utils:set-alert "You are not logged in." "error")
		     (redirect "/login")))))))

(defroute ("/user/admin/edit-password" :method :POST) ()
  (destructuring-bind
      (&key username password 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")))
	  (t (hermetic:auth
	      (:administrator)
	      ;; Authorised
	      (cond ((validation:string-is-nil-or-empty? username)
		     (utils:set-alert "Username not provided. No change made."
				      "missing-data")
		     (redirect "/users"))
		    ((validation:string-is-nil-or-empty? password)
		     (utils:set-alert "Password not provided. No change made."
				      "missing-data")
		     (redirect "/users"))
		    ((null (nera:get-user username))
		     (utils:set-alert "Unable to find user. Unable to delete account"
				      "invalid-data")
		     (redirect "/users"))
		    (t (nera:update-user
			(user::username-of (nera:get-user username))
			:new-password password)
		       (utils:set-alert "Password changed." "success")
		       (redirect "/users")))
	      ;; Not Authorised
	      (progn (utils:set-alert "You are not authorised to view that page."
				      "error")
		     (redirect "/")))))))

(defroute ("/user/admin/delete" :method :POST) ()
  (destructuring-bind
      (&key username 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")))
	  (t (hermetic:auth
	      (:administrator)
	      ;; Authorised
	      (cond ((validation:string-is-nil-or-empty? username)
		     (utils:set-alert "Username not provided. Unable to delete account."
				      "missing-data")
		     (redirect "/users"))
		    ((null (nera:get-user username))
		     (utils:set-alert "Unable to find user. Unable to delete account"
				      "invalid-data")
		     (redirect "/users"))
		    (t (nera:delete-user
			(user::username-of (nera:get-user username)))
		       (utils:set-alert "Account deleted." "success")
		       (redirect "/users")))
	      ;; Not Authorised
	      (progn (utils:set-alert "You are not logged in." "error")
		     (redirect "/login")))))))

(defroute ("/user/delete" :method :POST) ()
  (destructuring-bind
      (&key authenticity-token delete-account-check &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")))
	  (t (hermetic:auth (:logged-in)
			    ;; Authorised
			    (cond ((validation:string-is-nil-or-empty? delete-account-check)
				   (utils:set-alert
				    "No username entered. Account not deleted."
				    "missing-data")
				   (redirect "/user/edit"))
				  ((not (string= delete-account-check
						 (user::username-of
						  (auth:get-current-user))))
				   (utils:set-alert
				    "Wrong username entered. Account not deleted."
				    "invalid-data")
				   (redirect "/user/edit"))
				  (t
				   (progn
				     (nera-db:delete-user
				      (user::username-of (auth:get-current-user)))
				     (hermetic:logout
				      ;; Successful log-out -- after account deleted
				      ;; Session data cleared.
				      (progn (auth:flash-gethash :id ningle:*session*)
					     (redirect "/"))
				      ;; Failed log-out -- after account deleted
				      ;; Session data persits.
				      (progn (utils:set-alert
					      "Unable to delete session data." "error")
					     (redirect "/"))))))
			    ;; Not Authorised
			    (progn (utils:set-alert "You are not logged in."
						    "error")
				   (redirect "/login")))))))

(defroute ("/create/page" :method :GET) ()
  (hermetic:auth (:logged-in)
		 ;; Authorised
		 (let ((alert (utils:get-and-reset-alert)))
		   (render "/user/create-page.html"
			   (append (auth:auth-user-data)
				   `(:alert ,alert
				     :system-data ,(nera:system-data)))))
		 ;; Not Authorised
		 (progn
		   (utils:set-alert "You are not logged in." "error")
		   (redirect "/login"))))

(defroute ("/create/page" :method :POST) ()
  (destructuring-bind
      (&key title page-content 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")))
	  (t (hermetic:auth
	      (:logged-in)
	      ;; Authorised
	      (cond ((validation:string-is-nil-or-empty? title)
		     (render
		      "/user/create-page.html"
		      (append (auth:auth-user-data)
			      `(:alert "Title not provided. Unable to save page."
				:title ,title
				:data ,page-content))))
		    
		    ((storage:file-exists-p "" "pages" (utils:slugify title))
		     (render
		      "/user/create-page.html"
		      (append (auth:auth-user-data)
			      `(:alert "Page with that title already exists. Unable to save page."
				:title ,title
				:data ,page-content))))
		    
		    (t (storage:store-text
			"" ; `USERNAME' blank because it's not used/needed.
			"pages"
		        (utils:slugify title)
			page-content)
		       (nera:create-page title (utils:slugify title) +false+ +true+)
		       (utils:set-alert "Page created." "created")
		       (redirect "/dashboard")))
	      ;; Not Authorised
	      (progn (utils:set-alert "You are not logged in." "error")
		     (redirect "/login")))))))

(defroute ("/user/pages" :method :GET) ()
  (hermetic:auth (:logged-in)
		 ;; Authorised
		 (let ((alert (utils:get-and-reset-alert)))
		   (render "/user/pages.html"
			   (append (auth:auth-user-data)
				   `(:alert ,alert
				     :system-data ,(nera:system-data)
				     :pages ,(nera:get-all-pages)))))
		 ;; Not Authorised
		 (progn
		   (utils:set-alert "You are not logged in." "error")
		   (redirect "/login"))))

(defroute ("/pages" :method :GET) ()
  (let ((alert (utils:get-and-reset-alert)))
    (render #P"pages.html"
	    (append (if (hermetic:logged-in-p)
			(auth:auth-user-data))
		    `(:alert ,alert
		      :system-data ,(nera:system-data)
		      :pages ,(nera:get-all-pages))))))

(defroute ("/view/page/:slug" :method :GET) (&key slug)
  (let ((alert (utils:get-and-reset-alert)))
    (if (storage:file-exists-p "" "pages" slug)
	(render #P"page.html"
		(append (if (hermetic:logged-in-p)
			    (auth:auth-user-data))
			`(:alert ,alert
			  :db-data ,(nera:get-page slug)
			  :system-data ,(nera:system-data)
			  :data ,(storage:open-text-file
				  "" "pages" slug))))
	(on-exception *web* 404))))

(defroute ("/edit/page/:slug" :method :GET) (&key slug)
  (hermetic:auth (:logged-in)
		 ;; Authorised
		 (let ((alert (utils:get-and-reset-alert)))
		   (render "/user/edit-page.html"
			   (append (auth:auth-user-data)
				   `(:alert ,alert
				     :system-data ,(nera:system-data)
				     :db-data ,(nera:get-page slug)
				     :data ,(storage:open-text-file
					     "" "pages" slug)))))
		 ;; Not Authorised
		 (progn
		   (utils:set-alert "You are not logged in." "error")
		   (redirect "/login"))))

(defroute ("/edit/page" :method :POST) ()
  (destructuring-bind
      (&key slug page-content 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")))
	  (t (hermetic:auth
	      (:logged-in)
	      ;; Authorised
	      (cond ((validation:string-is-nil-or-empty? slug)
		     (utils:set-alert "Page cannot be found." "missing-data")
		     (redirect "/user/pages"))
		    
		    (t (storage:store-text
			"" ; `USERNAME' blank because it's not used/needed.
			"pages" slug page-content)
		       (utils:set-alert "Page updated." "success")
		       (redirect "/user/pages")))
	      ;; Not Authorised
	      (progn (utils:set-alert "You are not logged in." "error")
		     (redirect "/login")))))))

(defroute ("/rename/page" :method :POST) ()
  (destructuring-bind
      (&key id slug new-title 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")))
	  (t (hermetic:auth
	      (:logged-in)
	      ;; Authorised
	      (cond ((validation:string-is-nil-or-empty? slug)
		     (utils:set-alert "Cannot find file. Unable to save changes."
				      "missing-data")
		     (redirect "/user/pages"))

		    ((validation:string-is-nil-or-empty? new-title)
		     (utils:set-alert "No title provided. Unable to save changes."
				      "missing-data")
		     (redirect (format nil "/edit/page/~a" slug)))

		    ((validation:string-is-nil-or-empty? id)
		     (utils:set-alert "No Id. found. Cannot find page in database."
				      "missing-data")
		     (redirect "/user/pages"))
		    
		    (t (storage:rename-content-file
			""
			"pages" slug (utils:slugify new-title))
		       (nera:update-page id new-title (utils:slugify new-title))
		       (utils:set-alert "File name changed." "success")
		       (redirect (format nil "/edit/page/~a"
					 (utils:slugify new-title)))))
	      ;; Not Authorised
	      (progn (utils:set-alert "You are not logged in." "error")
		     (redirect "/login")))))))

(defroute ("/page/set-nav-menu" :method :POST) ()
  (destructuring-bind
      (&key slug show-in-nav 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")))
	  (t (hermetic:auth
	      (:logged-in)
	      ;; Authorised
	      (cond ((validation:string-is-nil-or-empty? slug)
		     (utils:set-alert "Cannot find page in database."
				      "missing-data")
		     (redirect "/user/pages"))
		    
		    (t (nera:update-single-nav-menu-item
			slug (if (null show-in-nav) +false+ +true+))
		       (utils:set-alert "Update nav. menu settings." "success")
		       (redirect (format nil "/edit/page/~a" slug))))
	      ;; Not Authorised
	      (progn (utils:set-alert "You are not logged in." "error")
		     (redirect "/login")))))))

(defroute ("/page/delete" :method :POST) ()
  (destructuring-bind
      (&key slug 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")))
	  (t (hermetic:auth
	      (:administrator)
	      ;; Authorised
	      (cond ((validation:string-is-nil-or-empty? slug)
		     (utils:set-alert "Cannot find page in database. Nothing deleted."
				      "missing-data")
		     (redirect "/user/pages"))

		    ((null (storage:file-exists-p "" "pages" slug))
		     (utils:set-alert "Unable to find page. Nothing deleted."
				      "missing-data")
		     (redirect "/user/pages"))

		    ((eql (pages::can-delete-p (nera:get-page slug)) +false+)
		     (utils:set-alert "File not allowed to be deleted."
				      "warning")
		     (redirect "/user/pages"))
		    
		    (t (storage:remove-file
			"" ; `USERNAME' blank because it's not used/needed.
			"pages" slug)
		       (nera:delete-page :slug slug)
		       (utils:set-alert "Page deleted." "success")
		       (redirect "/user/pages")))
	      ;; Not Authorised
	      (progn (utils:set-alert "You are not authorised to delete page."
				      "warning")
		     (redirect "/login")))))))

(defroute ("/storage/view/media/:slug" :method :GET) (&key slug)
  (if (nera:get-storage-file :slug slug)
      `(200 (:content-type
	     ,(files::file-type-of
	       (nera:get-storage-file :slug slug)))
	    ,(storage:open-binary-file
	      "" "media" (files::name-of
			  (nera:get-storage-file :slug slug))))
      (on-exception *web* 404)))

(defroute ("/storage/thumb/media/:slug" :method :GET) (&key slug)
   (let ((storage-file (nera:get-storage-file :slug slug)))
   (if storage-file
       `(200 (:content-type ,(files::file-type-of storage-file))
	      ,(storage:open-binary-file
		"" "media"
		(format nil "thumbnail-~a" (files::name-of storage-file))))
       (on-exception *web* 404))))

(defroute ("/storage/thumb/archive/:slug" :method :GET) (&key slug)
  (if (nera:get-archive-entry :slug slug)
      (let ((archive-entry (nera:get-archive-entry :slug slug)))
	`(200 (:content-type ,(archive::thumbnail-file-type-of archive-entry))
	      ,(storage:open-binary-file
		"" "archive" (archive::thumbnail-slug-of archive-entry))))
      (on-exception *web* 404)))

(defroute ("/storage/manage" :method :GET) ()
  (hermetic:auth (:logged-in)
		 ;; Authorised
		 (let ((alert (utils:get-and-reset-alert)))
		   (render #P"/user/storage.html"
			   (append (auth:auth-user-data)
				   `(:alert ,alert
				     :files ,(nera:get-all-storage-files)
				     :system-data ,(nera:system-data)))))
		 ;; Not Authorised
		 (progn (utils:set-alert "You are not logged in." "error")
			(redirect "/login"))))

(defroute ("/storage/multi-upload" :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"))
	(let ((files (utils:separate-files-in-web-request
		      (lack.request:request-body-parameters ningle:*request*)
		      "STORAGE-FILES")))
	  (hermetic:auth
	   (:logged-in)
	   ;; Authorised
	   (cond ((validation:string-is-nil-or-empty? (caddr (car files)))
		  (utils:set-alert "No files provided." "missing-data")
		  (redirect "/storage/manage"))

		 (t (loop
		      :for item :in files
		      :do (storage:store-file
			   "" "media" (utils:format-filename (caddr item)) (cdr item))

			  (nera:add-storage-file (utils:format-filename (caddr item))
						 (utils:slugify (caddr item))
						 (cadddr item))
			  ;; Thumbnail not stored in the database. It
			  ;; is a hard-coded utility feature of the
			  ;; website. The thumbnail is created so
			  ;; large-scale images are not used at the
			  ;; thumbnail, decreasing download sizes.
			  (when (str:contains? "image" (cadddr item) :ignore-case t)
			    (utils:create-thumbnail
			     "media" (utils:format-filename (caddr item)) nil)))
		    (utils:set-alert "File upload complete." "success")
		    (redirect "/storage/manage")))
	   ;; Not Authorised
	   (progn
	     (utils:set-alert "You are not authorised to view this page."
			      "error")
	     (redirect "/login")))))))

(defroute ("/storage/rename/:slug" :method :POST) (&key slug)
  (destructuring-bind
      (&key new-file-name 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)
	 ;; Authorised
	 (cond ((validation:string-is-nil-or-empty? new-file-name)
		(utils:set-alert "No file name provided. Nothing updated."
				 "missing-data")
		(redirect "/storage/manage"))

	       ((not (null (nera:get-storage-file :filename new-file-name)))
		(utils:set-alert "File with that name already exists. File not saved."
				 "invalid-data")
		(redirect "/storage/manage"))
	       
	       (t (storage:rename-content-file
		   "" "media" (files::name-of (nera:get-storage-file :slug slug))
		   new-file-name)
		  (when (storage:file-exists-p
			 "" "media"
			 (format nil "thumbnail-~a"
				 (files::name-of (nera:get-storage-file :slug slug))))
		    (storage:rename-content-file
		     "" "media" (format nil "thumbnail-~a"
					(files::name-of
					 (nera:get-storage-file :slug slug)))
		     (format nil "thumbnail-~a" new-file-name)))
		  (nera:rename-storage-file
		   (files::name-of (nera:get-storage-file :slug slug))
		   new-file-name)
		  (utils:set-alert "File renamed." "success")
		  (redirect "/storage/manage")))
	 ;; Not Authorised
	 (progn
	   (utils:set-alert "You are not authorised to view this page." "error")
	   (redirect "/login"))))))

(defroute ("/storage/delete/:slug" :method :POST) (&key slug)
  (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")))
	  (t (hermetic:auth
	      (:administrator)
	      ;; Authorised
	      (cond ((null (nera:get-storage-file :slug slug))
		     (utils:set-alert "Unable to find file. Nothing deleted."
				      "missing-data")
		     (redirect "/storage/manage"))
		    
		    (t (storage:remove-file
			"" "media"
			(files::name-of (nera:get-storage-file :slug slug)))
		       (when (storage:file-exists-p
			      "" "media"
			      (format nil "thumbnail-~a"
				      (files::name-of
				       (nera:get-storage-file :slug slug))))
			 (storage:remove-file
			  "" "media"
			  (format nil "thumbnail-~a" (files::name-of
						      (nera:get-storage-file
						       :slug slug)))))
		       (nera:delete-storage-file :slug slug)
		       (utils:set-alert "File deleted." "success")
		       (redirect "/storage/manage")))
	      ;; Not Authorised
	      (progn (utils:set-alert "You are not authorised to delete page."
				      "error")
		     (redirect "/login")))))))

(defroute ("/archive" :method :GET) ()
  (let ((alert (utils:get-and-reset-alert)))
    (render #P"archive.html"
	    (append (if (hermetic:logged-in-p)
			(auth:auth-user-data))
		    `(:alert ,alert
		      :system-data ,(nera:system-data)
		      :archive-entries ,(nera:get-all-archive-entries))))))

(defroute ("/view/archive/:slug" :method :GET) (&key slug)
  (let ((alert (utils:get-and-reset-alert)))
    (if (storage:file-exists-p "" "archive" slug)
        (let* ((archive-entry (nera:get-archive-entry :slug slug))
               (archive-id (archive::object-id archive-entry)))
	  (render #P"archive-entry.html"
		  (append (if (hermetic:logged-in-p)
			      (auth:auth-user-data))
			  `(:alert ,alert
			    :db-data ,archive-entry
			    :system-data ,(nera:system-data)
                            :newer-entries
                            ,(nera:get-newer-archive-entries archive-id 2)
                            :older-entries
                            ,(nera:get-older-archive-entries archive-id 2)
			    :data ,(storage:open-text-file "" "archive" slug)))))
	(on-exception *web* 404))))

(defroute ("/user/archive" :method :GET) ()
  (hermetic:auth (:logged-in)
		 ;; Authorised
		 (let ((alert (utils:get-and-reset-alert)))
		   (render "/user/archive.html"
			   (append (auth:auth-user-data)
				   `(:alert ,alert
				     :system-data ,(nera:system-data)
				     :archive-entries ,(nera:get-all-archive-entries)))))
		 ;; Not Authorised
		 (progn
		   (utils:set-alert "You are not logged in." "error")
		   (redirect "/login"))))

(defroute ("/create/archive-entry" :method :GET) ()
  (hermetic:auth (:logged-in)
		 ;; Authorised
		 (let ((alert (utils:get-and-reset-alert)))
		   (render "/user/create-archive.html"
			   (append (auth:auth-user-data)
				   `(:alert ,alert
				     :system-data ,(nera:system-data)))))
		 ;; Not Authorised
		 (progn
		   (utils:set-alert "You are not logged in." "error")
		   (redirect "/login"))))

(defroute ("/create/archive-entry" :method :POST) ()
  (destructuring-bind
      (&key title month year keywords thumbnail-file page-content
	 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")))
	  (t (hermetic:auth
	      (:logged-in)
	      ;; Authorised
	      (cond ((find t (mapcar #'validation:string-is-nil-or-empty? `(,title ,month ,year)))
		     (render
		      "/user/create-archive.html"
		      (append (auth:auth-user-data)
			      `(:alert
				,(utils:build-alert-string
				 "missing-data"
				 "sherlock-cat.png"
				 "Data is missing. Unable to create entry.")
				:title ,title
                                :month ,month
                                :year ,year
				:keywords ,keywords
				:data ,page-content))))

		    ((not (null (nera:get-archive-entry :title title)))
		     (render
		      "/user/create-archive.html"
		      (append (auth:auth-user-data)
			      `(:alert
				,(utils:build-alert-string
				  "invalid-data"
				  "confused-cat.png"
				  "Entry with that title already exists. Unable to create entry.")
				:title ,title
                                :month ,month
                                :year ,year
				:keywords ,keywords
				:data ,page-content))))

		    ((not (str:contains?
			   "image" (caddr thumbnail-file) :ignore-case t))
		     (render
		      "/user/create-archive.html"
		      (append (auth:auth-user-data)
			      `(:alert
				,(utils:build-alert-string
				  "invalid-data"
				  "confused-cat.png"
				  "File uploaded is not an image. Entry not created.")
				:title ,title
                                :month ,month
                                :year ,year
				:keywords ,keywords
				:data ,page-content))))
		    
		    (t (let ((search-id (utils:create-timestamp-id)))
                         ;; Database Entry
                         (nera:create-archive-entry
			  title
			  search-id
			  (format nil "~a.html" (utils:slugify title))
                          month
                          year
			  (utils:format-filename (cadr thumbnail-file)) ; File Name
		          (caddr thumbnail-file) ; File Type
			  (utils:format-keywords keywords))
		         ;; Use placeholder thumbnail if one not detected?
                         ;; Meilisearch Database Entry
                         (search:submit-entry
                          (search:build-payload
                           search-id title
                           (format nil "view/archive/~a.html"
                                   (utils:slugify title))
                           (format nil "storage/thumb/archive/~a.html"
                                   (utils:slugify title))
                           month
                           year
                           (utils:format-keywords keywords)))
                         ;; Storage File Entry
		         (storage:store-text
			  "" "archive"
			  (format nil "~a.html" (utils:slugify title))
			  page-content)
		         (storage:store-file
			  "" "archive"
			  (utils:format-filename (cadr thumbnail-file))
			  thumbnail-file)
		         (utils:create-thumbnail ; Overwrites the original here.
			  "archive" (utils:format-filename (cadr thumbnail-file)) t)
		         (utils:set-alert "Archive entry created. Great Success!"
					  "created")
		         (redirect "/dashboard"))))
	            ;; Not Authorised
	            (progn (utils:set-alert "You are not logged in." "error")
		           (redirect "/login")))))))

(defroute ("/edit/archive/:slug" :method :GET) (&key slug)
  (if (nera:get-archive-entry :slug slug)
      (progn
	(hermetic:auth
	 (:logged-in)
	 ;; Authorised
	 (let ((alert (utils:get-and-reset-alert)))
	   (render "/user/edit-archive.html"
		   (append (auth:auth-user-data)
			   `(:alert ,alert
			     :system-data ,(nera:system-data)
			     :db-data ,(nera:get-archive-entry :slug slug)
			     :data ,(storage:open-text-file "" "archive" slug)))))
	 ;; Not Authorised
	 (progn
	   (utils:set-alert "You are not logged in." "error")
	   (redirect "/login"))))
      (on-exception *web* 404)))

(defroute ("/edit/archive-thumbnail" :method :POST) ()
  (destructuring-bind
      (&key archive-slug thumbnail-file 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")))
	  (t (hermetic:auth
	      (:administrator)
	      ;; Authorised
	      (cond ((validation:string-is-nil-or-empty? archive-slug)
		     (utils:set-alert
                      "No archive slug provided. Thumbnail not updated."
                      "missing-data")
		     (redirect "/user/archive"))
		    ((null (nera:get-archive-entry :slug archive-slug))
		     (utils:set-alert
                      "Cannot file thumbnail's archive entry. Nothing updated."
                      "missing-data")
		     (redirect "/user/archive"))
		    ((not (str:contains? "image" (caddr thumbnail-file) :ignore-case t))
		     (utils:set-alert
                      "File uploaded is not an image. Thumbnail not updated."
                      "invalid-data")
		     (redirect (format nil "/edit/archive/~a" archive-slug)))
		    (t (let ((archive-entry (nera:get-archive-entry :slug archive-slug)))
                         (storage:remove-file
                          "" "archive" (archive::thumbnail-slug-of archive-entry))
		         (storage:store-file
                          "" "archive" (cadr thumbnail-file) thumbnail-file)
		         (nera:update-archive-entry-property
			  :slug archive-slug
			  :property 'archive::thumbnail-file-type-of
			  :value (caddr thumbnail-file))
		         (nera:update-archive-entry-property
			  :slug archive-slug
			  :property 'archive::thumbnail-slug-of
			  :value (cadr thumbnail-file))
		         (utils:create-thumbnail
			  "archive" (archive::thumbnail-slug-of archive-entry) t)
		         ;; Meilisearch DB doesn't need updating because nothing
		         ;; has changed from its perspective.
		       (utils:set-alert "Thumbnail updated." "success")
		       (redirect (format nil "/edit/archive/~a" archive-slug)))))
	      ;; Not Authorised
	      (progn (utils:set-alert
                      "You are not authorised to delete this archive entry."
                      "error")
		     (redirect "/login")))))))

(defroute ("/rename/archive-entry" :method :POST) ()
  (destructuring-bind
      (&key id archive-slug new-title 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")))
	  (t (hermetic:auth
	      (:administrator)
	      ;; Authorised
	      (cond ((find t (mapcar #'validation:string-is-nil-or-empty?
				     `(,id ,archive-slug ,new-title)))
		     (utils:set-alert
                      "Title and meta-data not provided. Archive entry not renamed."
		      "missing-data")
		     (redirect "/user/archive"))
		    ((null (nera:get-archive-entry :slug archive-slug))
		     (utils:set-alert
                      "Cannot file archive entry. Archive entry not updated."
		      "invalid-data")
		     (redirect "/user/archive"))
		    (t (let ((archive-entry
                               (nera:get-archive-entry :id (parse-integer id))))
                         (storage:rename-content-file
			  "" "archive" (archive::slug-of archive-entry)
			  (utils:format-filename (format nil "~a.html" new-title)))
		         (nera:update-archive-entry-property
			  :slug archive-slug
			  :property 'archive::title-of
			  :value new-title)
                         (nera:update-archive-entry-property
			  :slug archive-slug
			  :property 'archive::slug-of
			  :value (utils:format-filename (format nil "~a.html" new-title)))
                         (search:submit-entry
                          (search:build-payload
                           (archive::search-id-of archive-entry)
                           new-title
                           (format nil "view/archive/~a.html"
                                   (utils:slugify new-title))
                           (format nil
                                   "storage/thumb/archive/~a.html"
                                   (utils:slugify new-title))
                           (archive::month-of archive-entry)
                           (archive::year-of archive-entry)
                           (archive::keywords-of archive-entry)))
                         (utils:set-alert "Archive entry updated." "success")
		         (redirect
		          (format nil
			          "/edit/archive/~a"
			          (utils:format-filename
                                   (format nil "~a.html" new-title)))))))
	      ;; Not Authorised
	      (progn (utils:set-alert
                      "You are not authorised to delete this archive entry."
		      "error")
		     (redirect "/login")))))))

(defroute ("/edit/archive-publish-date" :method :POST) ()
  (destructuring-bind
      (&key archive-slug authenticity-token month year &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")))
	  (t (hermetic:auth
	      (:administrator)
	      ;; Authorised
	      (cond ((find t (mapcar #'validation:string-is-nil-or-empty?
				     `(,archive-slug ,month ,year)))
		     (utils:set-alert "Full date not provided. Not updated."
				      "missing-data")
		     (redirect "/user/archive"))
		    ((null (nera:get-archive-entry :slug archive-slug))
		     (utils:set-alert
                      "Cannot file archive entry. Keywords not updated."
		      "invalid-data")
		     (redirect "/user/archive"))
		    (t (let ((archive-entry
                               (nera:get-archive-entry :slug archive-slug)))
                         (nera:update-archive-entry-property
			  :slug archive-slug
			  :property 'archive::month-of
			  :value month)
                         (nera:update-archive-entry-property
			  :slug archive-slug
			  :property 'archive::year-of
			  :value year)
                         (search:submit-entry
                          (search:build-payload
                           (archive::search-id-of archive-entry)
                           (archive::title-of archive-entry)
                           (format nil "view/archive/~a"
                                   (archive::slug-of archive-entry))
                           (format nil "storage/thumb/archive/~a"
                                   (archive::slug-of archive-entry))
                           month
                           year
                           (archive::keywords-of archive-entry)))
		         (utils:set-alert "Archive entry updated." "success")
		         (redirect (format nil "/edit/archive/~a" archive-slug)))))
	      ;; Not Authorised
	      (progn (utils:set-alert
                      "You are not authorised to delete this archive entry."
		      "error")
		     (redirect "/login")))))))

(defroute ("/edit/archive-keywords" :method :POST) ()
  (destructuring-bind
      (&key archive-slug new-keywords 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")))
	  (t (hermetic:auth
	      (:administrator)
	      ;; Authorised
	      (cond ((find t (mapcar #'validation:string-is-nil-or-empty?
				     `(,archive-slug ,new-keywords)))
		     (utils:set-alert "Keywords not provided. Not updated."
				      "missing-data")
		     (redirect "/user/archive"))
		    ((null (nera:get-archive-entry :slug archive-slug))
		     (utils:set-alert
                      "Cannot file archive entry. Keywords not updated."
		      "invalid-data")
		     (redirect "/user/archive"))
		    (t (let ((archive-entry (nera:get-archive-entry :slug archive-slug))
                             (keywords (utils:format-keywords new-keywords)))
                         (nera:update-archive-entry-property
			  :slug archive-slug
			  :property 'archive::keywords-of
			  :value keywords)
                         (search:submit-entry
                          (search:build-payload
                           (archive::search-id-of archive-entry)
                           (archive::title-of archive-entry)
                           (format nil "view/archive/~a"
                                   (archive::slug-of archive-entry))
                           (format nil "storage/thumb/archive/~a"
                                   (archive::slug-of archive-entry))
                           (archive::month-of archive-entry)
                           (archive::year-of archive-entry)
                           keywords))
		         (utils:set-alert "Archive entry updated." "success")
		         (redirect (format nil "/edit/archive/~a" archive-slug)))))
	      ;; Not Authorised
	      (progn (utils:set-alert
                      "You are not authorised to delete this archive entry."
		      "error")
		     (redirect "/login")))))))

(defroute ("/edit/archive" :method :POST) ()
  (destructuring-bind
      (&key slug page-content 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")))
	  (t (hermetic:auth
	      (:logged-in)
	      ;; Authorised
	      (cond ((validation:string-is-nil-or-empty? slug)
		     (utils:set-alert
                      "Archive entry cannot be found." "missing-data")
		     (redirect "/user/archive"))
		    (t (storage:store-text "" "archive" slug page-content)
                       ;; Meilisearch integration not needed here because
                       ;; nothing has changed from the Meilisearch DB
                       ;; perspective.
		       (utils:set-alert "Archive entry updated." "success")
		       (redirect (format nil "/edit/archive/~a" slug))))
	      ;; Not Authorised
	      (progn (utils:set-alert "You are not logged in." "error")
		     (redirect "/login")))))))

(defroute ("/archive/delete/entry" :method :POST) ()
  (destructuring-bind
      (&key slug 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")))
	  (t (hermetic:auth
	      (:administrator)
	      ;; Authorised
	      (cond ((validation:string-is-nil-or-empty? slug)
		     (utils:set-alert
                      "Cannot find archive entry in database. Nothing deleted."
		      "missing-data")
		     (redirect "/user/archive"))
		    ((and (null (storage:file-exists-p "" "archive" slug))
			  (null (nera:get-archive-entry :slug slug)))
		     (utils:set-alert
                      "Unable to find archive entry. Nothing deleted."
		      "invalid-data")
		     (redirect "/user/archive"))
		    ((and (null (storage:file-exists-p "" "archive" slug))
			  (not (null (nera:get-archive-entry :slug slug))))
		     (nera:delete-archive-entry :slug slug)
		     (utils:set-alert
                      "Couldn't find archive entry files. Deleted from database only."
		      "invalid-data")
		     (redirect "/user/archive"))
		    ((and (not (null (storage:file-exists-p "" "archive" slug)))
			  (null (nera:get-archive-entry :slug slug)))
		     (utils:set-alert
                      "Couldn't find archive entry in database. Deleted files only."
		      "invalid-data")
		     ;; The system doesn't know about the thumbnail at this
		     ;; point because it was linked to the text file via the
		     ;; database. You will need to delete the thumbnail manually
		     ;; at this point but the system has already failed here
		     ;; anyway so the extra work was already needed.
		     (storage:remove-file "" "archive" slug)
		     (redirect "/user/archive"))
		    (t (storage:remove-file "" "archive" slug)
		       (storage:remove-file
			"" "archive" (archive::thumbnail-slug-of
                                      (nera:get-archive-entry :slug slug)))
                       (search:delete-entry
                        (archive::search-id-of (nera:get-archive-entry :slug slug)))
		       (nera:delete-archive-entry :slug slug)
		       (utils:set-alert "Archive entry deleted." "success")
		       (redirect "/user/archive")))
	      ;; Not Authorised
	      (progn (utils:set-alert
                      "You are not authorised to delete this archive entry."
		      "error")
		     (redirect "/login")))))))

(defroute ("/search" :method :GET) ()
  (render #P"search.html" (append (if (hermetic:logged-in-p)
			              (auth:auth-user-data))
			          `(:alert ,(utils:get-and-reset-alert)
			            :nav-menu ,(nera:nav-menu-slugs)
			            :system-data ,(nera:system-data)))))

(defroute ("/sitemap" :method :GET) ()
  (redirect "/sitemap.xml"))

(defroute ("/sitemap.xml" :method :GET) ()
  (setf (getf (response-headers *response*) :content-type) "application/xml")
  (with-output-to-string (stream)
    (let ((pages (nera:get-all-pages))
          (entries (nera:get-all-archive-entries))
          (root-url (utils:build-url-root ningle:*request*)))
      (xml-emitter:with-xml-output (stream :encoding "utf-8")
        (xml-emitter:with-simple-tag
            ("urlset"
             nil
             "http://www.sitemaps.org/schemas/sitemap/0.9")
          ;; Lists all the pages first.
          ;; The 'unless' block is to remove pages which are not wanting to be
          ;; part of a search engine's crawler results.
          (loop for item in pages
                do
                   (unless (or (string= "sign-up" (pages::slug-of item))
                               (string= "login" (pages::slug-of item)))
                     (xml-emitter:with-tag ("url")
                       (xml-emitter:emit-simple-tags
                        :loc (format nil "~a/view/page/~a"
                                     root-url (pages::slug-of item))
                        :lastmod
                        (format nil "~a" (mito.dao.mixin:object-updated-at item))))))
          ;; Lists all the archive entries second.
          (loop for item in entries
                do
                   (xml-emitter:with-tag ("url")
                     (xml-emitter:emit-simple-tags
                      :loc (format nil "~a/view/archive/~a"
                                   root-url (archive::slug-of item))
                      :lastmod
                      (format nil "~a"
                              (mito.dao.mixin:object-updated-at item))))))))))

(defroute ("/danger/manage-files" :method :GET) ()
  (hermetic:auth
   (:administrator)
   ;; Authorised
   (let ((alert (utils:get-and-reset-alert)))
     (render "/danger/manage-files.html"
	     (append (auth:auth-user-data)
		     `(:alert ,alert
		       :system-data ,(nera:system-data)
		       :archive-files
                       ,(storage:get-file-names
                         (storage:get-files-in-directory "" "archive"))
                       :media-files
                       ,(storage:get-file-names
                         (storage:get-files-in-directory "" "media"))
                       :pages-files
                       ,(storage:get-file-names
                         (storage:get-files-in-directory "" "pages"))))))
  ;; Not Authorised
  (progn
    (utils:set-alert "You are not authorised to view this page." "error")
    (redirect "/login"))))

(defroute ("/danger/delete-file" :method :POST) ()
  (destructuring-bind
      (&key filename directory 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")))
	  (t (hermetic:auth
	      (:administrator)
	      ;; Authorised
	      (cond ((find t (mapcar #'validation:string-is-nil-or-empty?
				     `(,filename ,directory)))
                     (utils:set-alert
                      "File name or directory not provided." "missing-data")
                     (redirect "/danger/manage-files"))
                    ((not (storage:file-exists-p "" directory filename))
                     (utils:set-alert "File cannot be found." "invalid-data")
                     (redirect "/danger/manage-files"))
                    (t (storage:file-exists-p "" directory filename)
                       (storage:remove-file "" directory filename)
                       (utils:set-alert "File deleted." "success")
                       (redirect "/danger/manage-files")))
	      ;; Not Authorised
	      (progn (utils:set-alert
                      "You are not authorised to delete page." "error")
		     (redirect "/login")))))))

(defroute ("/danger/manage-database-entries" :method :GET) ()
  (hermetic:auth
   (:administrator)
   ;; Authorised
   (let ((alert (utils:get-and-reset-alert)))
     (render "/danger/manage-db-entries.html"
	     (append (auth:auth-user-data)
		     `(:alert ,alert
		       :system-data ,(nera:system-data)
		       :archive-entries ,(nera:get-all-archive-entries)
                       :storage-entries ,(nera:get-all-storage-files)
                       :pages-entries ,(nera:get-all-pages)))))
  ;; Not Authorised
  (progn
    (utils:set-alert "You are not authorised to view this page." "error")
    (redirect "/login"))))

(defroute ("/danger/delete-database-entry" :method :POST) ()
  (destructuring-bind
      (&key name table 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")))
	  (t (hermetic:auth
	      (:administrator)
	      ;; Authorised
	      (cond ((find t (mapcar #'validation:string-is-nil-or-empty? `(,name ,table)))
                     (utils:set-alert
                      "Entry name or database table not provided." "missing-data")
                     (redirect "/danger/manage-database-entries"))
                    ((string= "page" table)
                     (if (not (nera:get-page name))
                         (utils:set-alert
                          "Database entry cannot be found." "invalid-data")
                         (progn
                           (nera:delete-page :slug name)
                           (utils:set-alert "Database entry deleted." "success")))
                     (redirect "/danger/manage-database-entries"))
                    ((string= "archive" table)
                     (if (not (nera:get-archive-entry :slug name))
                         (utils:set-alert
                          "Database entry cannot be found." "invalid-data")
                         (progn
                           (nera:delete-archive-entry :slug name)
                           (utils:set-alert
                            "Database entry deleted." "success")))
                     (redirect "/danger/manage-database-entries"))
                    ((string= "storage-file" table)
                     (if (not (nera:get-storage-file :slug name))
                         (utils:set-alert
                          "Database entry cannot be found." "invalid-data")
                         (progn
                           (nera:delete-storage-file :slug name)
                           (utils:set-alert
                            "Database entry deleted." "success")))
                     (redirect "/danger/manage-database-entries"))
                    (t (utils:set-alert "Database table not found." "invalid-data")
                       (redirect "/danger/manage-database-entries")))
	     ;; Not Authorised
	     (progn (utils:set-alert
                     "You are not authorised to delete page." "error")
		    (redirect "/login")))))))

(defroute ("/danger/repopulate-search-db" :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")))
	  (t (hermetic:auth
	      (:administrator)
	      ;; Authorised
              (progn
	        (search:repopulate-database (nera:get-all-archive-entries))
                (utils:set-alert
                 "Search database re-populated. Great Success!" "success")
                (redirect "/site-settings"))
	      ;; Not Authorised
	      (progn (utils:set-alert
                      "You are not authorised to use this feature."
		      "error")
		     (redirect "/login")))))))

(defroute ("/danger/reset-website" :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")))
	  (t (hermetic:auth
	      (:administrator)
	      ;; Authorised
              (progn
                ;; The 'when' checks are just a precaution. These directories
                ;; were created during the site's first-run/initial set-up. If
                ;; they are missing, though, whilst this function is executing,
                ;; an error is thrown -- hence the check.
                (when (storage:directory-exists-p "" "media")
                  (storage:remove-directory "" "media"))
                (when (storage:directory-exists-p "" "archive")
                  (storage:remove-directory "" "archive"))
                (when (storage:directory-exists-p "" "pages")
                  (storage:remove-directory "" "pages"))
                (when (storage:directory-exists-p "" "snippets")
                  (storage:remove-directory "" "snippets"))
                ;; If the database doesn't exist, the site is in a much worse
                ;; state than anticipated and needs someone to SSH into the host
                ;; and look at it -- hence no 'when' check.
                (storage:remove-file-with-raw-path
                 (ritherdon-archive.config:database-name))
                ;; If Meilisearch service is down, you need to SSH into
                ;; host. That is a separate service which this website utilises
                ;; but doesn't control.
                (search:delete-all-entries)
                (redirect "/"))
	      ;; Not Authorised
	      (progn (utils:set-alert
                      "You are not authorised to use this feature."
		      "error")
		     (redirect "/login")))))))

(defroute ("/danger/manage-snapshots" :method :GET) ()
  (hermetic:auth
   (:logged-in)
   ;; Authorised
   (let ((alert (utils:get-and-reset-alert)))
     (render "/danger/snapshots.html"
	     (append (auth:auth-user-data)
		     `(:alert ,alert
		       :system-data ,(nera:system-data)
                       :snapshots
                       ,(reverse
                         (storage::get-directory-names
                          (storage::get-raw-directories "snapshots/")))))))
   ;; Not Authorised
   (progn
     (utils:set-alert "You are not authorised to view this page." "error")
     (redirect "/login"))))

(defroute ("/danger/take-snapshot" :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")))
	  (t (hermetic:auth
	      (:administrator)
	      ;; Authorised
              (progn
                (snapshot:take-snapshot)
                (utils:set-alert "Snapshot taken." "success")
                (redirect "/danger/manage-snapshots"))
	      ;; Not Authorised
	      (progn (utils:set-alert
                      "You are not authorised to delete page." "error")
		     (redirect "/login")))))))

(defroute ("/danger/delete-snapshot" :method :POST) ()
  (destructuring-bind
      (&key snapshot-name 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")))
	  (t (hermetic:auth
	      (:administrator)
	      ;; Authorised
              (cond ((validation::string-is-nil-or-empty? snapshot-name)
                     (utils:set-alert "No Snapshot Name provided." "missing-data")
                     (redirect "/danger/manage-snapshots"))
                    ((not (storage:raw-directory-exists?
                           (format nil "snapshots/~a/" snapshot-name)))
                     (utils:set-alert "Cannot find selected Snapshot." "invalid-data")
                     (redirect "/danger/manage-snapshots"))
                    (t (snapshot:delete-snapshot snapshot-name)
                       (utils:set-alert "Snapshot deleted." "success")
                       (redirect "/danger/manage-snapshots")))
	      ;; Not Authorised
	      (progn (utils:set-alert
                      "You are not authorised to delete page." "error")
		     (redirect "/login")))))))


(defroute ("/danger/create-snapshot-download" :method :POST) ()
  (destructuring-bind
      (&key snapshot-name 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")))
	  (t (hermetic:auth
	      (:administrator)
	      ;; Authorised
              (cond ((validation::string-is-nil-or-empty? snapshot-name)
                     (utils:set-alert "No Snapshot Name provided." "missing-data")
                     (redirect "/danger/manage-snapshots"))
                    ((not (storage:raw-directory-exists?
                           (format nil "snapshots/~a/" snapshot-name)))
                     (utils:set-alert "Cannot find selected Snapshot." "invalid-data")
                     (redirect "/danger/manage-snapshots"))
                    ((storage:file-exists-p
                      "" "media" (format nil "~a.zip" snapshot-name))
                     (utils:set-alert
                      "Snapshot already prepared and moved to Storage Files"
                      "invalid-data")
                     (redirect "/danger/manage-snapshots"))
                    (t (zip:zip
                        (storage:make-path
                         "" "media" (format nil "~a.zip"snapshot-name))
                        (storage:make-raw-path
                         (format nil "snapshots/~a/" snapshot-name)))
                       (nera:add-storage-file
                        (format nil "~a.zip"snapshot-name)
                        (format nil "~a-zip"snapshot-name)
                        "application/zip")
                       (utils:set-alert "Snapshot ready for download." "success")
                       (redirect "/danger/manage-snapshots")))
	      ;; Not Authorised
	      (progn (utils:set-alert
                      "You are not authorised to delete page." "error")
		     (redirect "/login")))))))

(defroute ("/danger/restore-snapshot" :method :POST) ()
  (destructuring-bind
      (&key snapshot-name 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")))
	  (t (hermetic:auth
	      (:administrator)
	      ;; Authorised
              (cond ((validation::string-is-nil-or-empty? snapshot-name)
                     (utils:set-alert "No Snapshot Name provided."
                                      "missing-data")
                     (redirect "/danger/manage-snapshots"))
                    ((not (storage:raw-directory-exists?
                           (format nil "snapshots/~a/" snapshot-name)))
                     (utils:set-alert "Cannot find selected Snapshot."
                                      "invalid-data")
                     (redirect "/danger/manage-snapshots"))
                    (t (snapshot:restore-from-snapshot snapshot-name)
                       (if (str:contains?
                            "://localhost:" (utils:build-url-root ningle:*request*))
                           (utils:set-alert
                            "Snapshot restored. Restart local server for changes to take effect."
                            "success")
                           (progn
                             (utils:set-alert
                              "Snapshot restored restarting server. FEATURE NOT IMPLEMENTED YET..."
                              "success")
                             ;; TODO: WRITE SCRIPT TO RESTART SYSTEMD SERVICE.
                             ;; utils:run-bash-command "Restart Systemd Service"
                             (format
                              t "[INFO] Restarting Systemd service is not yet implemented.")))
                           (redirect "/danger/manage-snapshots")))
	            ;; Not Authorised
	            (progn (utils:set-alert
                            "You are not authorised to delete page." "error")
		           (redirect "/login")))))))

(defroute ("/danger/upload-snapshot" :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"))
	 (let ((files (utils:separate-files-in-web-request
		       (lack.request:request-body-parameters ningle:*request*)
		       "SNAPSHOT-FILES")))
	   (hermetic:auth
	    (:administrator)
	    ;; Authorised
	    (cond ((validation:string-is-nil-or-empty? (caddr (car files)))
		   (utils:set-alert "No Snapshots provided." "missing-data")
		   (redirect "/danger/manage-snapshots"))
		  (t (loop
		       :for item :in files
		       :do (when (and (not (storage:raw-directory-exists?
                                            (storage:make-raw-path
                                             (format
                                              nil "snapshots/~a/"
                                              (pathname-name (caddr item))))))
                                      (string= "zip" (pathname-type (caddr item))))
                             (snapshot:store-snapshot
                              (utils:format-filename (caddr item)) (cdr item))))
		     (utils:set-alert "Snapshot upload complete." "success")
		     (redirect "/danger/manage-snapshots")))
	    ;; Not Authorised
	    (progn
	      (utils:set-alert "You are not authorised to view this page."
			       "error")
	      (redirect "/login")))))))

;;
;; Error pages

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