gallery

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)