summaryrefslogtreecommitdiff
path: root/lisp/service
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/service')
-rw-r--r--lisp/service/auth-service.lisp7
-rw-r--r--lisp/service/gallery-service.lisp133
-rw-r--r--lisp/service/menu-service.lisp1
-rw-r--r--lisp/service/users-service.lisp3
4 files changed, 142 insertions, 2 deletions
diff --git a/lisp/service/auth-service.lisp b/lisp/service/auth-service.lisp
index 9509385..b6ce12e 100644
--- a/lisp/service/auth-service.lisp
+++ b/lisp/service/auth-service.lisp
@@ -39,3 +39,10 @@
(setf (session-value :message) nil)
(setf (session-value :errormsg) nil))
(org-ckons-json::objects-to-json `(,,instance))))
+
+(defmacro with-noauth-raw ((instance rest-service) &body body)
+ `(let ((,instance (make-instance ',rest-service)))
+ (when (location-p ,instance)
+ (setf (session-value :message) nil)
+ (setf (session-value :errormsg) nil))
+ ,@body))
diff --git a/lisp/service/gallery-service.lisp b/lisp/service/gallery-service.lisp
new file mode 100644
index 0000000..df709cd
--- /dev/null
+++ b/lisp/service/gallery-service.lisp
@@ -0,0 +1,133 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package :woodriverlessons)
+
+(defclass gallery-service (auth-service)
+ ((admin-p :initarg :admin-p
+ :initform nil
+ :accessor admin-p))
+ (:documentation ""))
+
+(defun gallery-json ()
+ (with-noauth (instance gallery-service)
+ (with-valid-user (user "gallery-modify")
+ (setf (admin-p instance) nil)
+ (setf (admin-p instance) t))))
+
+(defclass gallery/view-service (gallery-service)
+ ((results :initarg :results
+ :initform nil
+ :accessor results)
+ (location-p :initform nil))
+ (:documentation ""))
+
+(defun gallery-view-json ()
+ (with-noauth (instance gallery/view-service)
+ (with-valid-user (user "gallery-modify")
+ (setf (admin-p instance) nil)
+ (setf (admin-p instance) t))
+ (with-woodriverlessons-database
+ (let ((general-pkg (make-instance 'general-pkg)))
+ (setf (results instance) (get-galleries general-pkg))))
+ (setf (message instance) (session-value :message))
+ (sanitize-rest-json instance)
+ (loop for gallery in (results instance)
+ do (sanitize-json gallery))))
+
+(defclass gallery/add-modify-delete-service (gallery/view-service)
+ ((form :initarg :form
+ :initform nil
+ :accessor form))
+ (:documentation ""))
+
+(defun gallery-add-json ()
+ (with-auth (instance gallery/add-modify-delete-service "gallery-modify")
+ (setf (form instance) (make-form "gallery-add-form"
+ nil
+ t
+ `((:name "description" :label "Description" :field-type "textarea")
+ (:name "upload" :label "Image/Video" :field-type "file" :required "required")
+ (:label "Add Gallery" :field-type "button" :onclick "on_gallery_add_submit_clicked()"))))))
+
+(defun gallery-add-submit-json (description upload)
+ (declare (special description))
+ (with-auth (instance gallery/add-modify-delete-service "gallery-modify")
+ (with-woodriverlessons-database
+ (let ((general-pkg (make-instance 'general-pkg))
+ (gallery (make-instance 'gallery))
+ (tmp-filepath (first upload))
+ (orig-filename (second upload))
+ new-filepath)
+ (loop for param in (remove-if (lambda (x)
+ (intersection `(,x) `(upload)))
+ (sb-introspect:function-lambda-list #'gallery-add-submit-json))
+ do (setf (slot-value gallery param) (symbol-value param)))
+ (let ((tmpdir (tmpdir:mkdtemp :prefix "woodriverlessons-gallery-")))
+ (setf new-filepath (format nil "~a~a" tmpdir (file-namestring tmp-filepath)))
+ (fad:copy-file tmp-filepath new-filepath)
+ (setf (filename gallery) orig-filename)
+ (setf (mime_type gallery) (org-ckons-file::get-mime-type new-filepath))
+ (setf (content gallery) (org-ckons-file::file-as-hex new-filepath)))
+ (insert-gallery general-pkg gallery)
+ (setf (session-value :message) "Gallery added successfully.")))))
+
+(defun gallery-modify-json (id)
+ (with-auth (instance gallery/add-modify-delete-service "gallery-modify")
+ (with-woodriverlessons-database
+ (let* ((general-pkg (make-instance 'general-pkg))
+ (gallery (get-gallery general-pkg id)))
+ (if gallery
+ (setf (form instance) (make-form "gallery-modify-form"
+ nil
+ t
+ `((:name "id" :field-type "hidden" :value ,(id gallery) :required "required")
+ (:name "description" :label "Description" :value ,(description gallery) :field-type "textarea")
+ (:name "upload" :label "Image/Video" :field-type "file")
+ (:label "Modify Gallery" :field-type "button" :onclick "on_gallery_modify_submit_clicked()"))))
+ (setf (session-value :errormsg) "Error: could not modify gallery. Not found."))))))
+
+(defun gallery-modify-submit-json (id description upload)
+ (declare (special description))
+ (with-auth (instance gallery/add-modify-delete-service "gallery-modify")
+ (with-woodriverlessons-database
+ (let* ((general-pkg (make-instance 'general-pkg))
+ (gallery (get-gallery general-pkg id)))
+ (if gallery
+ (let ((tmp-filepath (first upload))
+ (orig-filename (second upload))
+ new-filepath)
+ (loop for param in (remove-if (lambda (x)
+ (intersection `(,x) `(upload)))
+ (sb-introspect:function-lambda-list #'gallery-add-submit-json))
+ do (setf (slot-value gallery param) (symbol-value param)))
+ (when upload
+ (let ((tmpdir (tmpdir:mkdtemp :prefix "woodriverlessons-gallery-")))
+ (setf new-filepath (format nil "~a~a" tmpdir (file-namestring tmp-filepath)))
+ (fad:copy-file tmp-filepath new-filepath)
+ (setf (filename gallery) orig-filename)
+ (setf (mime_type gallery) (org-ckons-file::get-mime-type new-filepath))
+ (setf (content gallery) (org-ckons-file::file-as-hex new-filepath))))
+ (update-gallery general-pkg gallery)
+ (setf (session-value :message) "Gallery saved successfully."))
+ (setf (session-value :errormsg) "An error occurred."))))))
+
+(defun gallery-delete-json (id)
+ (with-auth (instance gallery/add-modify-delete-service "gallery-modify")
+ (with-woodriverlessons-database
+ (let* ((general-pkg (make-instance 'general-pkg))
+ (gallery (get-gallery general-pkg id)))
+ (if gallery
+ (progn
+ (delete-record general-pkg gallery)
+ (setf (session-value :message) "Gallery deleted successfully."))
+ (setf (session-value :errormsg) "Error: could not delete gallery. Not found."))))))
+
+(defun gallery-file-view (id)
+ (with-noauth-raw (instance gallery/view-service)
+ (with-woodriverlessons-database
+ (let* ((general-pkg (make-instance 'general-pkg))
+ (gallery (get-gallery general-pkg id)))
+ (when gallery
+ (setf (org-ckons-session::content-type *header-register*) (mime_type gallery))
+ (ironclad:hex-string-to-byte-array (content gallery)))))))
diff --git a/lisp/service/menu-service.lisp b/lisp/service/menu-service.lisp
index 3c1c705..8bb7d9a 100644
--- a/lisp/service/menu-service.lisp
+++ b/lisp/service/menu-service.lisp
@@ -5,6 +5,7 @@
(defparameter *menu-config* '((:id "a_menu_home" :label "Home" :handler "/home" :permissions "_Public")
(:id "a_menu_about_us" :label "About the Studio" :handler "/about-us" :permissions "_Public")
+ (:id "a_menu_gallery" :label "Gallery" :handler "/gallery" :permissions "_Public")
;;(:id "a_menu_testimonials" :label "Testimonials" :handler "/testimonials" :permissions "_Public")
(:id "a_menu_contact_us" :label "Contact Me" :handler "/contact-us" :permissions "_Public")
(:id "a_menu_messages" :label "Messages" :handler "/messages" :permissions "messages-view")
diff --git a/lisp/service/users-service.lisp b/lisp/service/users-service.lisp
index 1c317ae..e41d5e4 100644
--- a/lisp/service/users-service.lisp
+++ b/lisp/service/users-service.lisp
@@ -61,8 +61,7 @@
`((:name "first_name" :label "First Name" :field-type "text" :required "required")
(:name "last_name" :label "Last Name" :field-type "text" :required "required")
(:name "email" :label "Email" :field-type "text" :required "required")
- ,@(role-checkboxes role-groups
- `(,(get-role-group-by-name auth-pkg user "emails-viewer")))
+ ,@(role-checkboxes role-groups)
(:label "Add User" :field-type "button" :onclick "on_users_add_submit_clicked()"))))))))
(defun users-add-submit-json (role_groups first_name last_name email)
generated by cgit v1.3 (git 2.53.0) at 2026-09-24 14:50:11 +0000