return-to-ritherdon
/
ritherdon-archive
1
0
Fork 0
Code Issues 2 Pull Requests Projects 1 Releases Wiki Activity
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
0795a67f86
commit
7b24fdca1c
1 changed files with 212 additions and 146 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 358
      src/web.lisp

358
src/web.lisp
Unescape View File

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

Write Preview
Loading…
Cancel
Save