Browse Source

add alert type values to all set-alert functions called in web.lisp.

This update sets the alert type which adapts the alert message's
background colour and image to the type of message the alert is
relaying to the user.
stable
Craig Oates 2 years ago
parent
commit
7b24fdca1c
  1. 358
      src/web.lisp

358
src/web.lisp

@ -73,19 +73,20 @@
(lack.request:request-body-parameters ningle:*request*)) (lack.request:request-body-parameters ningle:*request*))
(storage:init-storage) (storage:init-storage)
;; Redirect to /setup-complete? ;; Redirect to /setup-complete?
(utils:set-alert "All set-up. Log-in to continue.") (utils:set-alert "All set-up. Log-in to continue." "created")
(redirect "/login"))))) (redirect "/login")))))
(defroute ("/sign-up" :method :GET) () (defroute ("/sign-up" :method :GET) ()
(if (= +false+ (site-settings::enable-sign-up-p (nera:get-site-settings))) (if (= +false+ (site-settings::enable-sign-up-p (nera:get-site-settings)))
(progn (progn
(utils:set-alert "This feature has been disabled.") (utils:set-alert "This feature has been disabled." "warning")
(redirect "/")) (redirect "/"))
(hermetic:auth (:logged-in) (hermetic:auth (:logged-in)
;; Hermetic Authorised (Logged in users can't sign-up). ;; Hermetic Authorised (Logged in users can't sign-up).
(progn (progn
(utils:set-alert (utils:set-alert
"You need to be signed out to create a new account.") "You need to be signed out to create a new account."
"warning")
(redirect "/dashboard")) (redirect "/dashboard"))
;; Hermetic Not Authorised ;; Hermetic Not Authorised
(let ((alert (utils:get-and-reset-alert))) (let ((alert (utils:get-and-reset-alert)))
@ -103,25 +104,27 @@
(cond ((not (string= authenticity-token (auth:csrf-token))) (cond ((not (string= authenticity-token (auth:csrf-token)))
`(,+forbidden+ (:content-type "text/plain") ("Denied"))) `(,+forbidden+ (:content-type "text/plain") ("Denied")))
((not (null (nera:get-user username))) ((not (null (nera:get-user username)))
(utils:set-alert "Username already taken.") (utils:set-alert "Username already taken." "warning")
(redirect "/sign-up")) (redirect "/sign-up"))
((not (string= password password-check)) ((not (string= password password-check))
(utils:set-alert "Passwords don't match.") (utils:set-alert "Passwords don't match." "invalid-data")
(redirect "/sign-up")) (redirect "/sign-up"))
((find t (mapcar ((find t (mapcar
#'utils:string-is-nil-or-empty? #'utils:string-is-nil-or-empty?
`(,username ,display-name ,password))) `(,username ,display-name ,password)))
(utils:set-alert "Incomplete form. Please fill out every section.") (utils:set-alert "Incomplete form. Please fill out every section."
"missing-data")
(redirect "/sign-up")) (redirect "/sign-up"))
(t (hermetic:auth (t (hermetic:auth
(:logged-in) (:logged-in)
;; Authorised (Logged in user can't sign-up). ;; Authorised (Logged in user can't sign-up).
(progn (utils:set-alert "Logged in users are not allowed to create account.") (progn (utils:set-alert "Logged in users are not allowed to create account."
"warning")
(redirect "/dashboard")) (redirect "/dashboard"))
;; Not Authorised ;; Not Authorised
(progn (progn
(nera-db:create-user username display-name password +false+) (nera-db:create-user username display-name password +false+)
(utils:set-alert "Account created.") (utils:set-alert "Account created." "created")
(redirect "/login"))))))) (redirect "/login")))))))
(defroute ("/login" :method :GET) () (defroute ("/login" :method :GET) ()
@ -154,10 +157,12 @@
(gethash :password ningle:*session*) password) (gethash :password ningle:*session*) password)
(redirect "/dashboard")) (redirect "/dashboard"))
;; Failed log-in attempt. ;; Failed log-in attempt.
(progn (utils:set-alert "Incorrect details provided.") (progn (utils:set-alert "Incorrect details provided."
"invalid-data")
(redirect "/login")) (redirect "/login"))
;; No user found. ;; No user found.
(progn (utils:set-alert "Can't find that user.") (progn (utils:set-alert "Can't find that user."
"missing-data")
(redirect "/login"))))))) (redirect "/login")))))))
(defroute ("/logout" :method :POST) () (defroute ("/logout" :method :POST) ()
@ -173,7 +178,8 @@
(progn (auth:flash-gethash :id ningle:*session*) (progn (auth:flash-gethash :id ningle:*session*)
(redirect "/")) (redirect "/"))
;; Failed log-out ;; Failed log-out
(progn (utils:set-alert "Error: Unable to log out.") (progn (utils:set-alert "Error: Unable to log out."
"error")
(redirect "/"))))))) (redirect "/")))))))
(defroute ("/dashboard" :method :GET) () (defroute ("/dashboard" :method :GET) ()
@ -190,7 +196,7 @@
,(nera::latest-archive-editted-entries 10 t) ,(nera::latest-archive-editted-entries 10 t)
:system-data ,(nera:system-data))))) :system-data ,(nera:system-data)))))
;; Not Authorised ;; Not Authorised
(progn (utils:set-alert "You are not logged in.") (progn (utils:set-alert "You are not logged in." "error")
(redirect "/login")))) (redirect "/login"))))
(defroute ("/site-settings" :method :GET) () (defroute ("/site-settings" :method :GET) ()
@ -208,7 +214,7 @@
:settings ,(nera:get-site-settings)))) :settings ,(nera:get-site-settings))))
;; Not Authorised ;; Not Authorised
(progn (progn
(utils:set-alert "You are not authorised to view this page.") (utils:set-alert "You are not authorised to view this page." "error")
(redirect "/login")))) (redirect "/login"))))
(defroute ("/site-settings/update-sign-up" :method :POST) () (defroute ("/site-settings/update-sign-up" :method :POST) ()
@ -222,11 +228,12 @@
;; Authorised ;; Authorised
(progn (progn
(nera:update-enable-sign-on-settings enable-sign-up) (nera:update-enable-sign-on-settings enable-sign-up)
(utils:set-alert "Enable Sign-Up setting saved.") (utils:set-alert "Enable Sign-Up setting saved." "successs")
(redirect "/site-settings")) (redirect "/site-settings"))
;; Not Authorised ;; Not Authorised
(progn (progn
(utils:set-alert "You are not authorised to view this page.") (utils:set-alert "You are not authorised to view this page."
"error")
(redirect "/login")))))) (redirect "/login"))))))
(defroute ("/site-settings/update-nav-menu" :method :POST) (&key _parsed) (defroute ("/site-settings/update-nav-menu" :method :POST) (&key _parsed)
@ -234,18 +241,19 @@
(&key authenticity-token &allow-other-keys) (&key authenticity-token &allow-other-keys)
(utils:request-params (utils:request-params
(lack.request:request-body-parameters ningle:*request*)) (lack.request:request-body-parameters ningle:*request*))
(if (not (string= authenticity-token (auth:csrf-token))) (if (not (string= authenticity-token (auth:csrf-token)))
`(,+forbidden+ (:content-type "text/plain") ("Denied")) `(,+forbidden+ (:content-type "text/plain") ("Denied"))
(hermetic:auth (:administrator) (hermetic:auth (:administrator)
;; Authorised ;; Authorised
(progn (progn
(nera:update-nav-menu (cdr (assoc "NAV-MENU" _parsed :test #'string=))) (nera:update-nav-menu (cdr (assoc "NAV-MENU" _parsed :test #'string=)))
(utils:set-alert "Nav. menu updated." "success") (utils:set-alert "Nav. menu updated." "success")
(redirect "/site-settings")) (redirect "/site-settings"))
;; Not Authorised ;; Not Authorised
(progn (progn
(utils:set-alert "You are not authorised to view this page.") (utils:set-alert "You are not authorised to view this page."
(redirect "/login")))))) "error")
(redirect "/login"))))))
(defroute ("/site-settings/update-home-page" :method :POST) () (defroute ("/site-settings/update-home-page" :method :POST) ()
(destructuring-bind (destructuring-bind
@ -258,15 +266,17 @@
;; Authorised ;; Authorised
(cond ((or (string= set-home-page "Select Page") (cond ((or (string= set-home-page "Select Page")
(utils:string-is-nil-or-empty? set-home-page)) (utils:string-is-nil-or-empty? set-home-page))
(utils:set-alert "No value provided. Home page not changed.") (utils:set-alert "No value provided. Home page not changed."
"missing-data")
(redirect "/site-settings")) (redirect "/site-settings"))
(t (t
(nera:set-home-page set-home-page) (nera:set-home-page set-home-page)
(utils:set-alert "Home page set.") (utils:set-alert "Home page set." "success")
(redirect "/site-settings"))) (redirect "/site-settings")))
;; Not Authorised ;; Not Authorised
(progn (progn
(utils:set-alert "You are not authorised to view this page.") (utils:set-alert "You are not authorised to view this page."
"error")
(redirect "/login")))))) (redirect "/login"))))))
(defroute ("/site-settings/update-site-name" :method :POST) () (defroute ("/site-settings/update-site-name" :method :POST) ()
@ -279,15 +289,17 @@
(hermetic:auth (:administrator) (hermetic:auth (:administrator)
;; Authorised ;; Authorised
(cond ((utils:string-is-nil-or-empty? site-name) (cond ((utils:string-is-nil-or-empty? site-name)
(utils:set-alert "No value provided. Site name not changed.") (utils:set-alert "No value provided. Site name not changed."
"missing-data")
(redirect "/site-settings")) (redirect "/site-settings"))
(t (t
(nera:update-site-name site-name) (nera:update-site-name site-name)
(utils:set-alert "Site name updated.") (utils:set-alert "Site name updated." "success")
(redirect "/site-settings"))) (redirect "/site-settings")))
;; Not Authorised ;; Not Authorised
(progn (progn
(utils:set-alert "You are not authorised to view this page.") (utils:set-alert "You are not authorised to view this page."
"error")
(redirect "/login")))))) (redirect "/login"))))))
(defroute ("/site-settings/update-code-snippet" :method :POST) () (defroute ("/site-settings/update-code-snippet" :method :POST) ()
@ -302,11 +314,12 @@
(progn (progn
(storage:store-text (storage:store-text
"" "snippets" "site-wide-snippet.html" code-snippet) "" "snippets" "site-wide-snippet.html" code-snippet)
(utils:set-alert "Site-Wide snippet updated.") (utils:set-alert "Site-Wide snippet updated." "success")
(redirect "/site-settings")) (redirect "/site-settings"))
;; Not Authorised ;; Not Authorised
(progn (progn
(utils:set-alert "You are not authorised to view this page.") (utils:set-alert "You are not authorised to view this page."
"error")
(redirect "/login")))))) (redirect "/login"))))))
(defroute ("/site-settings/update-favicon" :method :POST) () (defroute ("/site-settings/update-favicon" :method :POST) ()
@ -319,11 +332,12 @@
(:administrator) (:administrator)
;; Authorised ;; Authorised
(cond ((utils:string-is-nil-or-empty? (cadr favicon-file)) (cond ((utils:string-is-nil-or-empty? (cadr favicon-file))
(utils:set-alert "No file provided. Favicon not uploaded.") (utils:set-alert "No file provided. Favicon not uploaded."
"missing-data")
(redirect "/site-settings")) (redirect "/site-settings"))
(t (storage:store-with-raw-path (t (storage:store-with-raw-path
"static/images/favicon.png" favicon-file) "static/images/favicon.png" favicon-file)
(utils:set-alert "Favicon saved.") (utils:set-alert "Favicon saved." "success")
(utils:run-bash-command (utils:run-bash-command
(format nil "convert ~a -resize 192x192\\> ~a" (format nil "convert ~a -resize 192x192\\> ~a"
(merge-pathnames (merge-pathnames
@ -335,7 +349,7 @@
(redirect "/site-settings"))) (redirect "/site-settings")))
;; Not Authorised ;; Not Authorised
(progn (progn
(utils:set-alert "You are not authorised to view this page.") (utils:set-alert "You are not authorised to view this page." "error")
(redirect "/login")))))) (redirect "/login"))))))
(defroute ("/site-settings/update-enable-site-logo" :method :POST) () (defroute ("/site-settings/update-enable-site-logo" :method :POST) ()
@ -343,18 +357,20 @@
(&key enable-site-logo authenticity-token &allow-other-keys) (&key enable-site-logo authenticity-token &allow-other-keys)
(utils:request-params (utils:request-params
(lack.request:request-body-parameters ningle:*request*)) (lack.request:request-body-parameters ningle:*request*))
(if (not (string= authenticity-token (auth:csrf-token))) (if (not (string= authenticity-token (auth:csrf-token)))
`(,+forbidden+ (:content-type "text/plain") ("Denied")) `(,+forbidden+ (:content-type "text/plain") ("Denied"))
(hermetic:auth (:administrator) (hermetic:auth (:administrator)
;; Authorised ;; Authorised
(progn (progn
(nera:update-enable-site-logo-setting enable-site-logo) (nera:update-enable-site-logo-setting enable-site-logo)
(utils:set-alert "Enable Site Logo setting saved.") (utils:set-alert "Enable Site Logo setting saved."
(redirect "/site-settings")) "success")
;; Not Authorised (redirect "/site-settings"))
(progn ;; Not Authorised
(utils:set-alert "You are not authorised to view this page.") (progn
(redirect "/login")))))) (utils:set-alert
"You are not authorised to view this page." "error")
(redirect "/login"))))))
(defroute ("/site-settings/update-site-logo" :method :POST) () (defroute ("/site-settings/update-site-logo" :method :POST) ()
(destructuring-bind (destructuring-bind
@ -366,11 +382,12 @@
(:administrator) (:administrator)
;; Authorised ;; Authorised
(cond ((utils:string-is-nil-or-empty? (cadr site-logo)) (cond ((utils:string-is-nil-or-empty? (cadr site-logo))
(utils:set-alert "No file provided. Site logo not uploaded.") (utils:set-alert "No file provided. Site logo not uploaded."
"missing-data")
(redirect "/site-settings")) (redirect "/site-settings"))
(t (storage:store-with-raw-path (t (storage:store-with-raw-path
"static/images/site-logo.png" site-logo) "static/images/site-logo.png" site-logo)
(utils:set-alert "Site logo saved.") (utils:set-alert "Site logo saved." "success")
(utils:run-bash-command (utils:run-bash-command
(format nil "convert ~a -resize 500x500\\> ~a" (format nil "convert ~a -resize 500x500\\> ~a"
(merge-pathnames (merge-pathnames
@ -382,7 +399,8 @@
(redirect "/site-settings"))) (redirect "/site-settings")))
;; Not Authorised ;; Not Authorised
(progn (progn
(utils:set-alert "You are not authorised to view this page.") (utils:set-alert "You are not authorised to view this page."
"error")
(redirect "/login")))))) (redirect "/login"))))))
(defroute ("/users" :method :GET) () (defroute ("/users" :method :GET) ()
@ -396,7 +414,8 @@
:users ,(nera:get-all-users))))) :users ,(nera:get-all-users)))))
;; Not Authorised ;; Not Authorised
(progn (progn
(utils:set-alert "You are not authorised to view this page.") (utils:set-alert "You are not authorised to view this page."
"error")
(redirect "/login")))) (redirect "/login"))))
(defroute ("/user/admin/create" :method :POST) () (defroute ("/user/admin/create" :method :POST) ()
@ -408,26 +427,28 @@
(cond ((not (string= authenticity-token (auth:csrf-token))) (cond ((not (string= authenticity-token (auth:csrf-token)))
`(,+forbidden+ (:content-type "text/plain") ("Denied"))) `(,+forbidden+ (:content-type "text/plain") ("Denied")))
((not (string= password password-check)) ((not (string= password password-check))
(utils:set-alert "Passwords don't match.") (utils:set-alert "Passwords don't match." "invalid-data")
(redirect "/users")) (redirect "/users"))
((find t (mapcar ((find t (mapcar
#'utils:string-is-nil-or-empty? #'utils:string-is-nil-or-empty?
`(,username ,display-name ,password))) `(,username ,display-name ,password)))
(utils:set-alert "Incomplete form. Please fill out every section.") (utils:set-alert "Incomplete form. Please fill out every section."
"missing-data")
(redirect "/users")) (redirect "/users"))
((not (null (nera:get-user username))) ((not (null (nera:get-user username)))
(utils:set-alert "Username already taken.") (utils:set-alert "Username already taken." "warning")
(redirect "/users")) (redirect "/users"))
(t (hermetic:auth (t (hermetic:auth
(:administrator) (:administrator)
;; Authorised ;; Authorised
(progn (progn
(nera-db:create-user username display-name password +false+) (nera-db:create-user username display-name password +false+)
(utils:set-alert "Account created.") (utils:set-alert "Account created." "created")
(redirect "/users")) (redirect "/users"))
;; Not Authorised ;; Not Authorised
(progn (progn
(utils:set-alert "You are not authorised to view that page.") (utils:set-alert "You are not authorised to view that page."
"error")
(redirect "/"))))))) (redirect "/")))))))
(defroute ("/user/edit" :method :GET) () (defroute ("/user/edit" :method :GET) ()
@ -439,7 +460,7 @@
`(:alert ,alert `(:alert ,alert
:system-data ,(nera:system-data))))) :system-data ,(nera:system-data)))))
;; Not Authorised ;; Not Authorised
(progn (utils:set-alert "You are not logged in.") (progn (utils:set-alert "You are not logged in." "error")
(redirect "/login")))) (redirect "/login"))))
(defroute ("/user/edit" :method :POST) () (defroute ("/user/edit" :method :POST) ()
@ -451,7 +472,7 @@
(cond ((not (string= authenticity-token (auth:csrf-token))) (cond ((not (string= authenticity-token (auth:csrf-token)))
`(,+forbidden+ (:content-type "text/plain") ("Denied"))) `(,+forbidden+ (:content-type "text/plain") ("Denied")))
((not (string= new-password password-check)) ((not (string= new-password password-check))
(utils:set-alert "Passwords don't match.") (utils:set-alert "Passwords don't match." "invalid-data")
(redirect "/user/edit")) (redirect "/user/edit"))
(t (hermetic:auth (t (hermetic:auth
(:logged-in) (:logged-in)
@ -460,10 +481,10 @@
(nera-db:update-user (nera-db:update-user
(user::username-of (auth:get-current-user)) (user::username-of (auth:get-current-user))
display-name new-password) display-name new-password)
(utils:set-alert "User details updated.") (utils:set-alert "User details updated." "success")
(redirect "/dashboard")) (redirect "/dashboard"))
;; Not Authorised ;; Not Authorised
(progn (utils:set-alert "You are not logged in.") (progn (utils:set-alert "You are not logged in." "error")
(redirect "/login"))))))) (redirect "/login")))))))
(defroute ("/user/admin/edit-password" :method :POST) () (defroute ("/user/admin/edit-password" :method :POST) ()
@ -476,21 +497,25 @@
(:administrator) (:administrator)
;; Authorised ;; Authorised
(cond ((utils:string-is-nil-or-empty? username) (cond ((utils:string-is-nil-or-empty? username)
(utils:set-alert "Username not provided. No change made.") (utils:set-alert "Username not provided. No change made."
"missing-data")
(redirect "/users")) (redirect "/users"))
((utils:string-is-nil-or-empty? password) ((utils:string-is-nil-or-empty? password)
(utils:set-alert "Password not provided. No change made.") (utils:set-alert "Password not provided. No change made."
"missing-data")
(redirect "/users")) (redirect "/users"))
((null (nera:get-user username)) ((null (nera:get-user username))
(utils:set-alert "Unable to find user. Unable to delete account") (utils:set-alert "Unable to find user. Unable to delete account"
"invalid-data")
(redirect "/users")) (redirect "/users"))
(t (nera:update-user (t (nera:update-user
(user::username-of (nera:get-user username)) (user::username-of (nera:get-user username))
:new-password password) :new-password password)
(utils:set-alert "Password changed.") (utils:set-alert "Password changed." "success")
(redirect "/users"))) (redirect "/users")))
;; Not Authorised ;; Not Authorised
(progn (utils:set-alert "You are not authorised to view that page.") (progn (utils:set-alert "You are not authorised to view that page."
"error")
(redirect "/"))))))) (redirect "/")))))))
(defroute ("/user/admin/delete" :method :POST) () (defroute ("/user/admin/delete" :method :POST) ()
@ -503,17 +528,19 @@
(:administrator) (:administrator)
;; Authorised ;; Authorised
(cond ((utils:string-is-nil-or-empty? username) (cond ((utils:string-is-nil-or-empty? username)
(utils:set-alert "Username not provided. Unable to delete account.") (utils:set-alert "Username not provided. Unable to delete account."
"missing-data")
(redirect "/users")) (redirect "/users"))
((null (nera:get-user username)) ((null (nera:get-user username))
(utils:set-alert "Unable to find user. Unable to delete account") (utils:set-alert "Unable to find user. Unable to delete account"
"invalid-data")
(redirect "/users")) (redirect "/users"))
(t (nera:delete-user (t (nera:delete-user
(user::username-of (nera:get-user username))) (user::username-of (nera:get-user username)))
(utils:set-alert "Account deleted.") (utils:set-alert "Account deleted." "success")
(redirect "/users"))) (redirect "/users")))
;; Not Authorised ;; Not Authorised
(progn (utils:set-alert "You are not logged in.") (progn (utils:set-alert "You are not logged in." "error")
(redirect "/login"))))))) (redirect "/login")))))))
(defroute ("/user/delete" :method :POST) () (defroute ("/user/delete" :method :POST) ()
@ -535,10 +562,11 @@
;; Failed log-out -- after account deleted ;; Failed log-out -- after account deleted
;; (session data persits). ;; (session data persits).
(progn (utils:set-alert (progn (utils:set-alert
"Error: Unable to delete session data.") "Unable to delete session data." "error")
(redirect "/")))) (redirect "/"))))
;; Not Authorised ;; Not Authorised
(progn (utils:set-alert "You are not logged in.") (progn (utils:set-alert "You are not logged in."
"error")
(redirect "/login"))))))) (redirect "/login")))))))
(defroute ("/create/page" :method :GET) () (defroute ("/create/page" :method :GET) ()
@ -551,7 +579,7 @@
:system-data ,(nera:system-data))))) :system-data ,(nera:system-data)))))
;; Not Authorised ;; Not Authorised
(progn (progn
(utils:set-alert "You are not logged in.") (utils:set-alert "You are not logged in." "error")
(redirect "/login")))) (redirect "/login"))))
(defroute ("/create/page" :method :POST) () (defroute ("/create/page" :method :POST) ()
@ -585,10 +613,10 @@
(utils:slugify title) (utils:slugify title)
page-content) page-content)
(nera:create-page title (utils:slugify title) +false+ +true+) (nera:create-page title (utils:slugify title) +false+ +true+)
(utils:set-alert "Page created.") (utils:set-alert "Page created." "created")
(redirect "/dashboard"))) (redirect "/dashboard")))
;; Not Authorised ;; Not Authorised
(progn (utils:set-alert "You are not logged in.") (progn (utils:set-alert "You are not logged in." "error")
(redirect "/login"))))))) (redirect "/login")))))))
(defroute ("/user/pages" :method :GET) () (defroute ("/user/pages" :method :GET) ()
@ -602,7 +630,7 @@
:pages ,(nera:get-all-pages))))) :pages ,(nera:get-all-pages)))))
;; Not Authorised ;; Not Authorised
(progn (progn
(utils:set-alert "You are not logged in.") (utils:set-alert "You are not logged in." "error")
(redirect "/login")))) (redirect "/login"))))
(defroute ("/pages" :method :GET) () (defroute ("/pages" :method :GET) ()
@ -640,7 +668,7 @@
"" "pages" slug))))) "" "pages" slug)))))
;; Not Authorised ;; Not Authorised
(progn (progn
(utils:set-alert "You are not logged in.") (utils:set-alert "You are not logged in." "error")
(redirect "/login")))) (redirect "/login"))))
(defroute ("/edit/page" :method :POST) () (defroute ("/edit/page" :method :POST) ()
@ -653,16 +681,16 @@
(:logged-in) (:logged-in)
;; Authorised ;; Authorised
(cond ((utils:string-is-nil-or-empty? slug) (cond ((utils:string-is-nil-or-empty? slug)
(utils:set-alert "Page cannot be found.") (utils:set-alert "Page cannot be found." "missing-data")
(redirect "/user/pages")) (redirect "/user/pages"))
(t (storage:store-text (t (storage:store-text
"" ; `USERNAME' blank because it's not used/needed. "" ; `USERNAME' blank because it's not used/needed.
"pages" slug page-content) "pages" slug page-content)
(utils:set-alert "Page updated.") (utils:set-alert "Page updated." "success")
(redirect "/user/pages"))) (redirect "/user/pages")))
;; Not Authorised ;; Not Authorised
(progn (utils:set-alert "You are not logged in.") (progn (utils:set-alert "You are not logged in." "error")
(redirect "/login"))))))) (redirect "/login")))))))
(defroute ("/rename/page" :method :POST) () (defroute ("/rename/page" :method :POST) ()
@ -675,26 +703,29 @@
(:logged-in) (:logged-in)
;; Authorised ;; Authorised
(cond ((utils:string-is-nil-or-empty? slug) (cond ((utils:string-is-nil-or-empty? slug)
(utils:set-alert "Cannot find file. Unable to save changes.") (utils:set-alert "Cannot find file. Unable to save changes."
"missing-data")
(redirect "/user/pages")) (redirect "/user/pages"))
((utils:string-is-nil-or-empty? new-title) ((utils:string-is-nil-or-empty? new-title)
(utils:set-alert "No title provided. Unable to save changes.") (utils:set-alert "No title provided. Unable to save changes."
"missing-data")
(redirect (format nil "/edit/page/~a" slug))) (redirect (format nil "/edit/page/~a" slug)))
((utils:string-is-nil-or-empty? id) ((utils:string-is-nil-or-empty? id)
(utils:set-alert "No Id. found. Cannot find page in database.") (utils:set-alert "No Id. found. Cannot find page in database."
"missing-data")
(redirect "/user/pages")) (redirect "/user/pages"))
(t (storage:rename-content-file (t (storage:rename-content-file
"" ""
"pages" slug (utils:slugify new-title)) "pages" slug (utils:slugify new-title))
(nera:update-page id new-title (utils:slugify new-title)) (nera:update-page id new-title (utils:slugify new-title))
(utils:set-alert "File name changed.") (utils:set-alert "File name changed." "success")
(redirect (format nil "/edit/page/~a" (redirect (format nil "/edit/page/~a"
(utils:slugify new-title))))) (utils:slugify new-title)))))
;; Not Authorised ;; Not Authorised
(progn (utils:set-alert "You are not logged in.") (progn (utils:set-alert "You are not logged in." "error")
(redirect "/login"))))))) (redirect "/login")))))))
(defroute ("/page/set-nav-menu" :method :POST) () (defroute ("/page/set-nav-menu" :method :POST) ()
@ -707,15 +738,16 @@
(:logged-in) (:logged-in)
;; Authorised ;; Authorised
(cond ((utils:string-is-nil-or-empty? slug) (cond ((utils:string-is-nil-or-empty? slug)
(utils:set-alert "Cannot find page in database.") (utils:set-alert "Cannot find page in database."
"missing-data")
(redirect "/user/pages")) (redirect "/user/pages"))
(t (nera:update-single-nav-menu-item (t (nera:update-single-nav-menu-item
slug (if (null show-in-nav) +false+ +true+)) slug (if (null show-in-nav) +false+ +true+))
(utils:set-alert "Update nav. menu settings.") (utils:set-alert "Update nav. menu settings." "success")
(redirect (format nil "/edit/page/~a" slug)))) (redirect (format nil "/edit/page/~a" slug))))
;; Not Authorised ;; Not Authorised
(progn (utils:set-alert "You are not logged in.") (progn (utils:set-alert "You are not logged in." "error")
(redirect "/login"))))))) (redirect "/login")))))))
(defroute ("/page/delete" :method :POST) () (defroute ("/page/delete" :method :POST) ()
@ -728,25 +760,29 @@
(:administrator) (:administrator)
;; Authorised ;; Authorised
(cond ((utils:string-is-nil-or-empty? slug) (cond ((utils:string-is-nil-or-empty? slug)
(utils:set-alert "Cannot find page in database. Nothing deleted.") (utils:set-alert "Cannot find page in database. Nothing deleted."
"missing-data")
(redirect "/user/pages")) (redirect "/user/pages"))
((null (storage:file-exists-p "" "pages" slug)) ((null (storage:file-exists-p "" "pages" slug))
(utils:set-alert "Unable to find page. Nothing deleted.") (utils:set-alert "Unable to find page. Nothing deleted."
"missing-data")
(redirect "/user/pages")) (redirect "/user/pages"))
((eql (pages::can-delete-p (nera:get-page slug)) +false+) ((eql (pages::can-delete-p (nera:get-page slug)) +false+)
(utils:set-alert "File not allowed to be deleted.") (utils:set-alert "File not allowed to be deleted."
"warning")
(redirect "/user/pages")) (redirect "/user/pages"))
(t (storage:remove-file (t (storage:remove-file
"" ; `USERNAME' blank because it's not used/needed. "" ; `USERNAME' blank because it's not used/needed.
"pages" slug) "pages" slug)
(nera:delete-page :slug slug) (nera:delete-page :slug slug)
(utils:set-alert "Page deleted.") (utils:set-alert "Page deleted." "success")
(redirect "/user/pages"))) (redirect "/user/pages")))
;; Not Authorised ;; Not Authorised
(progn (utils:set-alert "You are not authorised to delete page.") (progn (utils:set-alert "You are not authorised to delete page."
"warning")
(redirect "/login"))))))) (redirect "/login")))))))
(defroute ("/storage/view/media/:slug" :method :GET) (&key slug) (defroute ("/storage/view/media/:slug" :method :GET) (&key slug)
@ -786,7 +822,7 @@
:files ,(nera:get-all-storage-files) :files ,(nera:get-all-storage-files)
:system-data ,(nera:system-data))))) :system-data ,(nera:system-data)))))
;; Not Authorised ;; Not Authorised
(progn (utils:set-alert "You are not logged in.") (progn (utils:set-alert "You are not logged in." "error")
(redirect "/login")))) (redirect "/login"))))
(defroute ("/storage/multi-upload" :method :POST) () (defroute ("/storage/multi-upload" :method :POST) ()
@ -803,7 +839,7 @@
(:logged-in) (:logged-in)
;; Authorised ;; Authorised
(cond ((utils:string-is-nil-or-empty? (caddr (car files))) (cond ((utils:string-is-nil-or-empty? (caddr (car files)))
(utils:set-alert "No files provided.") (utils:set-alert "No files provided." "missing-data")
(redirect "/storage/manage")) (redirect "/storage/manage"))
(t (loop (t (loop
@ -822,11 +858,12 @@
(when (str:contains? "image" (cadddr item) :ignore-case t) (when (str:contains? "image" (cadddr item) :ignore-case t)
(utils:create-thumbnail (utils:create-thumbnail
"media" (utils:format-filename (caddr item)) nil))) "media" (utils:format-filename (caddr item)) nil)))
(utils:set-alert "Multi-File upload complete.") (utils:set-alert "File upload complete." "success")
(redirect "/storage/manage"))) (redirect "/storage/manage")))
;; Not Authorised ;; Not Authorised
(progn (progn
(utils:set-alert "You are not authorised to view this page.") (utils:set-alert "You are not authorised to view this page."
"error")
(redirect "/login"))))))) (redirect "/login")))))))
(defroute ("/storage/rename/:slug" :method :POST) (&key slug) (defroute ("/storage/rename/:slug" :method :POST) (&key slug)
@ -840,35 +877,35 @@
(:logged-in) (:logged-in)
;; Authorised ;; Authorised
(cond ((utils:string-is-nil-or-empty? new-file-name) (cond ((utils:string-is-nil-or-empty? new-file-name)
(utils:set-alert "No file name provided. Nothing updated.") (utils:set-alert "No file name provided. Nothing updated."
"missing-data")
(redirect "/storage/manage")) (redirect "/storage/manage"))
((not (null (nera:get-storage-file :filename new-file-name))) ((not (null (nera:get-storage-file :filename new-file-name)))
(utils:set-alert "File with that name already exists. File not saved.") (utils:set-alert "File with that name already exists. File not saved."
"invalid-data")
(redirect "/storage/manage")) (redirect "/storage/manage"))
(t (storage:rename-content-file (t (storage:rename-content-file
"" "media" (files::name-of (nera:get-storage-file :slug slug)) "" "media" (files::name-of (nera:get-storage-file :slug slug))
(utils:format-filename new-file-name)) new-file-name)
;; Rename the thumbnail if there is one (not all files are images).
(when (storage:file-exists-p (when (storage:file-exists-p
"" "media" "" "media"
(format nil "thumbnail-~a" ; slug)) (format nil "thumbnail-~a"
(files::name-of (nera:get-storage-file :slug slug)))) (files::name-of (nera:get-storage-file :slug slug))))
(storage:rename-content-file (storage:rename-content-file
"" "media" "" "media" (format nil "thumbnail-~a"
(format nil "thumbnail-~a" (files::name-of
(files::name-of (nera:get-storage-file :slug slug)))
(nera:get-storage-file :slug slug))) (format nil "thumbnail-~a" new-file-name)))
(utils:format-filename (format nil "thumbnail-~a" new-file-name))))
(nera:rename-storage-file (nera:rename-storage-file
(files::name-of (nera:get-storage-file :slug slug)) (files::name-of (nera:get-storage-file :slug slug))
new-file-name) new-file-name)
(utils:set-alert "File renamed.") (utils:set-alert "File renamed." "success")
(redirect "/storage/manage"))) (redirect "/storage/manage")))
;; Not Authorised ;; Not Authorised
(progn (progn
(utils:set-alert "You are not authorised to view this page.") (utils:set-alert "You are not authorised to view this page." "error")
(redirect "/login")))))) (redirect "/login"))))))
(defroute ("/storage/delete/:slug" :method :POST) (&key slug) (defroute ("/storage/delete/:slug" :method :POST) (&key slug)
@ -881,7 +918,8 @@
(:administrator) (:administrator)
;; Authorised ;; Authorised
(cond ((null (nera:get-storage-file :slug slug)) (cond ((null (nera:get-storage-file :slug slug))
(utils:set-alert "Unable to find file. Nothing deleted.") (utils:set-alert "Unable to find file. Nothing deleted."
"missing-data")
(redirect "/storage/manage")) (redirect "/storage/manage"))
(t (storage:remove-file (t (storage:remove-file
@ -898,10 +936,11 @@
(nera:get-storage-file (nera:get-storage-file
:slug slug))))) :slug slug)))))
(nera:delete-storage-file :slug slug) (nera:delete-storage-file :slug slug)
(utils:set-alert "File deleted.") (utils:set-alert "File deleted." "success")
(redirect "/storage/manage"))) (redirect "/storage/manage")))
;; Not Authorised ;; Not Authorised
(progn (utils:set-alert "You are not authorised to delete page.") (progn (utils:set-alert "You are not authorised to delete page."
"error")
(redirect "/login"))))))) (redirect "/login")))))))
(defroute ("/archive" :method :GET) () (defroute ("/archive" :method :GET) ()
@ -937,7 +976,7 @@
:archive-entries ,(nera:get-all-archive-entries))))) :archive-entries ,(nera:get-all-archive-entries)))))
;; Not Authorised ;; Not Authorised
(progn (progn
(utils:set-alert "You are not logged in.") (utils:set-alert "You are not logged in." "error")
(redirect "/login")))) (redirect "/login"))))
(defroute ("/create/archive-entry" :method :GET) () (defroute ("/create/archive-entry" :method :GET) ()
@ -950,7 +989,7 @@
:system-data ,(nera:system-data))))) :system-data ,(nera:system-data)))))
;; Not Authorised ;; Not Authorised
(progn (progn
(utils:set-alert "You are not logged in.") (utils:set-alert "You are not logged in." "error")
(redirect "/login")))) (redirect "/login"))))
(defroute ("/create/archive-entry" :method :POST) () (defroute ("/create/archive-entry" :method :POST) ()
@ -968,7 +1007,11 @@
(render (render
"/user/create-archive.html" "/user/create-archive.html"
(append (auth:auth-user-data) (append (auth:auth-user-data)
`(:alert "Data is missing. Unable to create entry." `(:alert
,(utils:build-alert-string
"missing-data"
"sherlock-cat.png"
"Data is missing. Unable to create entry.")
:title ,title :title ,title
:keywords ,keywords :keywords ,keywords
:data ,page-content)))) :data ,page-content))))
@ -978,7 +1021,10 @@
"/user/create-archive.html" "/user/create-archive.html"
(append (auth:auth-user-data) (append (auth:auth-user-data)
`(:alert `(:alert
"Entry with that title already exists. Unable to create entry." ,(utils:build-alert-string
"invalid-data"
"confused-cat.png"
"Entry with that title already exists. Unable to create entry.")
:title ,title :title ,title
:keywords ,keywords :keywords ,keywords
:data ,page-content)))) :data ,page-content))))
@ -989,7 +1035,10 @@
"/user/create-archive.html" "/user/create-archive.html"
(append (auth:auth-user-data) (append (auth:auth-user-data)
`(:alert `(:alert
"File uploaded is not an image. Entry not created." ,(utils:build-alert-string
"invalid-data"
"confused-cat-png"
"File uploaded is not an image. Entry not created.")
:title ,title :title ,title
:keywords ,keywords :keywords ,keywords
:data ,page-content)))) :data ,page-content))))
@ -1013,10 +1062,11 @@
thumbnail-file) thumbnail-file)
(utils:create-thumbnail ; Overwrites the original here. (utils:create-thumbnail ; Overwrites the original here.
"archive" (utils:format-filename (cadr thumbnail-file)) t) "archive" (utils:format-filename (cadr thumbnail-file)) t)
(utils:set-alert "Archive entry created. Great Success!") (utils:set-alert "Archive entry created. Great Success!"
"created")
(redirect "/dashboard"))) (redirect "/dashboard")))
;; Not Authorised ;; Not Authorised
(progn (utils:set-alert "You are not logged in.") (progn (utils:set-alert "You are not logged in." "error")
(redirect "/login"))))))) (redirect "/login")))))))
(defroute ("/edit/archive/:slug" :method :GET) (&key slug) (defroute ("/edit/archive/:slug" :method :GET) (&key slug)
@ -1034,7 +1084,7 @@
:data ,(storage:open-text-file "" "archive" slug))))) :data ,(storage:open-text-file "" "archive" slug)))))
;; Not Authorised ;; Not Authorised
(progn (progn
(utils:set-alert "You are not logged in.") (utils:set-alert "You are not logged in." "error")
(redirect "/login")))) (redirect "/login"))))
(on-exception *web* 404))) (on-exception *web* 404)))
@ -1048,15 +1098,18 @@
(:administrator) (:administrator)
;; Authorised ;; Authorised
(cond ((utils:string-is-nil-or-empty? archive-slug) (cond ((utils:string-is-nil-or-empty? archive-slug)
(utils:set-alert "No archive slug provided. Thumbnail not updated.") (utils:set-alert "No archive slug provided. Thumbnail not updated."
"missing-data")
(redirect "/user/archive")) (redirect "/user/archive"))
((null (nera:get-archive-entry :slug archive-slug)) ((null (nera:get-archive-entry :slug archive-slug))
(utils:set-alert "Cannot file thumbnail's archive entry. Nothing updated.") (utils:set-alert "Cannot file thumbnail's archive entry. Nothing updated."
"missing-data")
(redirect "/user/archive")) (redirect "/user/archive"))
((not (str:contains? "image" (caddr thumbnail-file) :ignore-case t)) ((not (str:contains? "image" (caddr thumbnail-file) :ignore-case t))
(utils:set-alert "File uploaded is not an image. Thumbnail not updated.") (utils:set-alert "File uploaded is not an image. Thumbnail not updated."
"invalid-data")
(redirect (format nil "/edit/archive/~a" archive-slug))) (redirect (format nil "/edit/archive/~a" archive-slug)))
(t (storage:remove-file "" "archive" (t (storage:remove-file "" "archive"
@ -1081,10 +1134,11 @@
;; Integrate updating Meilisearch here. ;; Integrate updating Meilisearch here.
(utils:set-alert "Thumbnail updated.") (utils:set-alert "Thumbnail updated." "success")
(redirect (format nil "/edit/archive/~a" archive-slug)))) (redirect (format nil "/edit/archive/~a" archive-slug))))
;; Not Authorised ;; Not Authorised
(progn (utils:set-alert "You are not authorised to delete this archive entry.") (progn (utils:set-alert "You are not authorised to delete this archive entry."
"error")
(redirect "/login"))))))) (redirect "/login")))))))
(defroute ("/rename/archive-entry" :method :POST) () (defroute ("/rename/archive-entry" :method :POST) ()
@ -1098,11 +1152,13 @@
;; Authorised ;; Authorised
(cond ((find t (mapcar #'utils:string-is-nil-or-empty? (cond ((find t (mapcar #'utils:string-is-nil-or-empty?
`(,id ,archive-slug ,new-title))) `(,id ,archive-slug ,new-title)))
(utils:set-alert "Missing data. Archive entry not renamed.") (utils:set-alert "Title and meta-data not provided. Archive entry not renamed."
"missing-data")
(redirect "/user/archive")) (redirect "/user/archive"))
((null (nera:get-archive-entry :slug archive-slug)) ((null (nera:get-archive-entry :slug archive-slug))
(utils:set-alert "Cannot file archive entry. Archive entry not updated.") (utils:set-alert "Cannot file archive entry. Archive entry not updated."
"invalid-data")
(redirect "/user/archive")) (redirect "/user/archive"))
(t (storage:rename-content-file (t (storage:rename-content-file
@ -1120,13 +1176,14 @@
;; Integrate updating Meilisearch here. ;; Integrate updating Meilisearch here.
(utils:set-alert "Archive entry updated.") (utils:set-alert "Archive entry updated." "success")
(redirect (redirect
(format nil (format nil
"/edit/archive/~a" "/edit/archive/~a"
(utils:format-filename (format nil "~a.html" new-title)))))) (utils:format-filename (format nil "~a.html" new-title))))))
;; Not Authorised ;; Not Authorised
(progn (utils:set-alert "You are not authorised to delete this archive entry.") (progn (utils:set-alert "You are not authorised to delete this archive entry."
"error")
(redirect "/login"))))))) (redirect "/login")))))))
(defroute ("/edit/archive-keywords" :method :POST) () (defroute ("/edit/archive-keywords" :method :POST) ()
@ -1140,11 +1197,13 @@
;; Authorised ;; Authorised
(cond ((find t (mapcar #'utils:string-is-nil-or-empty? (cond ((find t (mapcar #'utils:string-is-nil-or-empty?
`(,archive-slug ,new-keywords))) `(,archive-slug ,new-keywords)))
(utils:set-alert "Missing data. Keywords not updated.") (utils:set-alert "Keywords not provided. Not updated."
"missing-data")
(redirect "/user/archive")) (redirect "/user/archive"))
((null (nera:get-archive-entry :slug archive-slug)) ((null (nera:get-archive-entry :slug archive-slug))
(utils:set-alert "Cannot file archive entry. Keywords not updated.") (utils:set-alert "Cannot file archive entry. Keywords not updated."
"invalid-data")
(redirect "/user/archive")) (redirect "/user/archive"))
(t (nera:update-archive-entry-property (t (nera:update-archive-entry-property
@ -1152,10 +1211,11 @@
:property 'archive::keywords-of :property 'archive::keywords-of
:value (utils:format-keywords new-keywords)) :value (utils:format-keywords new-keywords))
;; Integrate updating Meilisearch here. ;; Integrate updating Meilisearch here.
(utils:set-alert "Archive entry updated.") (utils:set-alert "Archive entry updated." "success")
(redirect (format nil "/edit/archive/~a" archive-slug)))) (redirect (format nil "/edit/archive/~a" archive-slug))))
;; Not Authorised ;; Not Authorised
(progn (utils:set-alert "You are not authorised to delete this archive entry.") (progn (utils:set-alert "You are not authorised to delete this archive entry."
"error")
(redirect "/login"))))))) (redirect "/login")))))))
(defroute ("/edit/archive" :method :POST) () (defroute ("/edit/archive" :method :POST) ()
@ -1168,14 +1228,15 @@
(:logged-in) (:logged-in)
;; Authorised ;; Authorised
(cond ((utils:string-is-nil-or-empty? slug) (cond ((utils:string-is-nil-or-empty? slug)
(utils:set-alert "Archive entry cannot be found.") (utils:set-alert "Archive entry cannot be found."
"missing-data")
(redirect "/user/archive")) (redirect "/user/archive"))
(t (storage:store-text "" "archive" slug page-content) (t (storage:store-text "" "archive" slug page-content)
(utils:set-alert "Archive entry updated.") (utils:set-alert "Archive entry updated." "success")
(redirect (format nil "/edit/archive/~a" slug)))) (redirect (format nil "/edit/archive/~a" slug))))
;; Not Authorised ;; Not Authorised
(progn (utils:set-alert "You are not logged in.") (progn (utils:set-alert "You are not logged in." "error")
(redirect "/login"))))))) (redirect "/login")))))))
(defroute ("/archive/delete/entry" :method :POST) () (defroute ("/archive/delete/entry" :method :POST) ()
@ -1188,23 +1249,27 @@
(:administrator) (:administrator)
;; Authorised ;; Authorised
(cond ((utils:string-is-nil-or-empty? slug) (cond ((utils:string-is-nil-or-empty? slug)
(utils:set-alert "Cannot find archive entry in database. Nothing deleted.") (utils:set-alert "Cannot find archive entry in database. Nothing deleted."
"missing-data")
(redirect "/user/archive")) (redirect "/user/archive"))
((and (null (storage:file-exists-p "" "archive" slug)) ((and (null (storage:file-exists-p "" "archive" slug))
(null (nera:get-archive-entry :slug slug))) (null (nera:get-archive-entry :slug slug)))
(utils:set-alert "Unable to find archive entry. Nothing deleted.") (utils:set-alert "Unable to find archive entry. Nothing deleted."
"invalid-data")
(redirect "/user/archive")) (redirect "/user/archive"))
((and (null (storage:file-exists-p "" "archive" slug)) ((and (null (storage:file-exists-p "" "archive" slug))
(not (null (nera:get-archive-entry :slug slug)))) (not (null (nera:get-archive-entry :slug slug))))
(nera:delete-archive-entry :slug slug) (nera:delete-archive-entry :slug slug)
(utils:set-alert "Couldn't find archive entry files. Deleted from database only.") (utils:set-alert "Couldn't find archive entry files. Deleted from database only."
"invalid-data")
(redirect "/user/archive")) (redirect "/user/archive"))
((and (not (null (storage:file-exists-p "" "archive" slug))) ((and (not (null (storage:file-exists-p "" "archive" slug)))
(null (nera:get-archive-entry :slug slug))) (null (nera:get-archive-entry :slug slug)))
(utils:set-alert "Couldn't find archive entry in database. Deleted files only.") (utils:set-alert "Couldn't find archive entry in database. Deleted files only."
"invalid-data")
;; The thumbnail in not know because it was linked to the ;; The thumbnail in not know because it was linked to the
;; text file via the database. You will need to delete the ;; text file via the database. You will need to delete the
;; thumbnail manually at this point but the system has ;; thumbnail manually at this point but the system has
@ -1218,10 +1283,11 @@
"" "archive" "" "archive"
(archive::thumbnail-slug-of (nera:get-archive-entry :slug slug))) (archive::thumbnail-slug-of (nera:get-archive-entry :slug slug)))
(nera:delete-archive-entry :slug slug) (nera:delete-archive-entry :slug slug)
(utils:set-alert "Archive entry deleted.") (utils:set-alert "Archive entry deleted." "success")
(redirect "/user/archive"))) (redirect "/user/archive")))
;; Not Authorised ;; Not Authorised
(progn (utils:set-alert "You are not authorised to delete this archive entry.") (progn (utils:set-alert "You are not authorised to delete this archive entry."
"error")
(redirect "/login"))))))) (redirect "/login")))))))
;; ;;

Loading…
Cancel
Save