From e774d11af63764a7457d842ecd74b30a183fa71e Mon Sep 17 00:00:00 2001 From: ckonstanski Date: Sun, 6 Sep 2026 22:04:28 -0600 Subject: migrate to react --- lisp/bogenherr.asd | 12 +- lisp/service/about-us-service.lisp | 48 +- lisp/service/base-service.lisp | 210 ++- lisp/service/contact-us-service.lisp | 34 +- lisp/service/gallery-service.lisp | 52 +- lisp/service/generics.lisp | 15 - lisp/service/home-service.lisp | 11 +- lisp/service/login-service.lisp | 61 +- lisp/service/logout-service.lisp | 1 - lisp/service/menu-service.lisp | 3 + lisp/service/messages-service.lisp | 37 +- lisp/service/password-service.lisp | 21 +- lisp/service/profile-service.lisp | 42 +- lisp/service/rest-service.lisp | 8 +- lisp/service/users-service.lisp | 204 ++- .../bogenherr/src/bogenherr/core.cljs | 1552 +++++++++++--------- lisp/webapps/bogenherr/site.lisp | 254 ---- lisp/webapps/generics.lisp | 12 - lisp/webapps/webapp-loader.lisp | 177 --- 19 files changed, 1338 insertions(+), 1416 deletions(-) delete mode 100644 lisp/service/generics.lisp delete mode 100644 lisp/webapps/bogenherr/site.lisp delete mode 100644 lisp/webapps/generics.lisp delete mode 100644 lisp/webapps/webapp-loader.lisp diff --git a/lisp/bogenherr.asd b/lisp/bogenherr.asd index ba57330..37c34e7 100644 --- a/lisp/bogenherr.asd +++ b/lisp/bogenherr.asd @@ -51,8 +51,7 @@ (:file "contact-pkg" :depends-on ("contact-us")))) (:module service :depends-on (sql) - :components ((:file "generics") - (:file "base-service") + :components ((:file "base-service") (:file "rest-service" :depends-on ("base-service")) (:file "auth-service" :depends-on ("rest-service")) (:file "generic-form" :depends-on ("rest-service")) @@ -67,11 +66,4 @@ (:file "testimonials-service" :depends-on ("generic-form" "auth-service")) (:file "contact-us-service" :depends-on ("generic-form" "auth-service")) (:file "users-service" :depends-on ("generic-form" "auth-service")) - (:file "messages-service" :depends-on ("generic-form" "auth-service")))) - (:module webapps - :depends-on (service) - :components ((:file "generics") - (:file "webapp-loader" :depends-on ("generics")) - (:module bogenherr - :depends-on ("webapp-loader") - :components ((:file "site"))))))) + (:file "messages-service" :depends-on ("generic-form" "auth-service")))))) diff --git a/lisp/service/about-us-service.lisp b/lisp/service/about-us-service.lisp index 1ede1d2..efc2d2f 100644 --- a/lisp/service/about-us-service.lisp +++ b/lisp/service/about-us-service.lisp @@ -9,10 +9,6 @@ :accessor category)) (:documentation "")) -(defun about-us-json (category) - (with-noauth (instance about-us-service) - (setf (category instance) category))) - (defclass about-us/view-service (about-us-service) ((content :initarg :content :initform nil @@ -23,26 +19,30 @@ (location :initform nil)) (:documentation "")) +(defclass about-us/modify-service (about-us/view-service auth-service) + ((form :initarg :form + :initform nil + :accessor form) + (admin-p :initform t) + (location-p :initform nil)) + (:documentation "")) + +(defun about-us-json (category &optional message errormsg) + (with-noauth (instance about-us-service) + (setf (message instance) message) + (setf (errormsg instance) errormsg) + (setf (category instance) category))) + (defun about-us-view-json (category) (with-noauth (instance about-us/view-service) (setf (category instance) category) - (with-valid-user (user "about-us-modify") - (setf (admin-p instance) nil) - (setf (admin-p instance) t)) + (setf (admin-p instance) (with-valid-user (user "about-us-modify") nil t)) (with-bogenherr-database (let* ((general-pkg (make-instance 'general-pkg)) (about-us (get-about-us general-pkg category))) (when about-us (setf (content instance) (content about-us))))))) -(defclass about-us/modify-service (about-us/view-service auth-service) - ((form :initarg :form - :initform nil - :accessor form) - (admin-p :initform t) - (location-p :initform nil)) - (:documentation "")) - (defun about-us-modify-json (category) (with-auth (instance about-us/modify-service "about-us-modify") (with-bogenherr-database @@ -51,7 +51,7 @@ (setf (form instance) (make-form "about-us-modify-form" nil nil - `((:label "Content" :name "txt-content" :field-type "textarea" :value ,(content about-us) :required "required") + `((:label "Content" :name "content" :field-type "textarea" :value ,(content about-us) :required "required") (:label "Modify" :field-type "button" :onclick "on_about_us_modify_submit_clicked()")))))))) (defun about-us-modify-submit-json (category content) @@ -64,3 +64,19 @@ (update-record general-pkg about-us)))) (setf (content instance) content) (setf (message instance) "About Us text saved successfully."))) + +(define-endpoint ("/lessons" :method :get) () about-us-json "lessons") +(define-endpoint ("/lessons" :method :post) (&post (message :parameter-type 'string) (errormsg :parameter-type 'string)) about-us-json "lessons" message errormsg) +(define-endpoint ("/lessons/view" :method :get) () about-us-view-json "lessons") +(define-endpoint ("/lessons/modify" :method :post) () about-us-modify-json "lessons") +(define-endpoint ("/lessons/modify/submit" :method :post) (&post (content :parameter-type 'string)) about-us-modify-submit-json "lessons" content) +(define-endpoint ("/gigs" :method :get) () about-us-json "gigs") +(define-endpoint ("/gigs" :method :post) (&post (message :parameter-type 'string) (errormsg :parameter-type 'string)) about-us-json "gigs" message errormsg) +(define-endpoint ("/gigs/view" :method :get) () about-us-view-json "gigs") +(define-endpoint ("/gigs/modify" :method :post) () about-us-modify-json "gigs") +(define-endpoint ("/gigs/modify/submit" :method :post) (&post (content :parameter-type 'string)) about-us-modify-submit-json "gigs" content) +(define-endpoint ("/programming" :method :get) () about-us-json "programming") +(define-endpoint ("/programming" :method :post) (&post (message :parameter-type 'string) (errormsg :parameter-type 'string)) about-us-json "programming" message errormsg) +(define-endpoint ("/programming/view" :method :get) () about-us-view-json "programming") +(define-endpoint ("/programming/modify" :method :post) () about-us-modify-json "programming") +(define-endpoint ("/programming/modify/submit" :method :post) (&post (content :parameter-type 'string)) about-us-modify-submit-json "programming" content) diff --git a/lisp/service/base-service.lisp b/lisp/service/base-service.lisp index ecd9469..c830254 100644 --- a/lisp/service/base-service.lisp +++ b/lisp/service/base-service.lisp @@ -3,19 +3,221 @@ (in-package :bogenherr) -(defclass base-service () - () +;; webapp + +(defvar *acceptor* nil) +(defvar *dispatch-table* '(#'dispatch-easy-handlers #'default-dispatcher)) +(defvar *webapps* (make-hash-table :test 'equal)) +(defvar *webapp* nil) +(defvar *uri* nil) +(defvar *header-register* nil) +(defvar *sessionid* nil) +(defparameter *port* 3012) +(defparameter *server-root* (namestring (asdf:system-relative-pathname (intern (package-name #.*package*)) "./")) + "The location of the web server root on the filesystem.") + +(defclass webapp () + ((name :initarg :name + :initform nil + :accessor name + :documentation "The name of the webapp as used in the code. A +string used as the key to any webapp config lookup.") + (scheme :initarg :scheme + :initform nil + :accessor scheme) + (url :initarg :url + :initform nil + :accessor url + :documentation "The domain portion of the URL to the +root of the webapp.") + (document-root :initarg :document-root + :initform nil + :accessor document-root + :documentation "The absolute filesystem path to the +webapp's top-level directory which is inside the webapps folder.") + (title :initarg :title + :initform nil + :accessor title + :documentation "The default title that shows up in +the browser title bar.") + (meta-description :initarg :meta-description + :initform nil + :accessor meta-description + :documentation "The text that goes into the META DESCRIPTION +tag, and anywhere else we want to put this text so that it will show +up in Google.") + (databases :initarg :databases + :initform nil + :accessor databases) + (mail-mx :initarg :mail-mx + :initform nil + :accessor mail-mx) + (mail-from :initarg :mail-from + :initform nil + :accessor mail-from) + (mail-postmaster :initarg :mail-postmaster + :initform nil + :accessor mail-postmaster) + (mail-webmaster :initarg :mail-webmaster + :initform nil + :accessor mail-webmaster) + (mail-info :initarg :mail-info + :initform nil + :accessor mail-info) + (mail-login-notify :initarg :mail-login-notify + :initform nil + :accessor mail-login-notify) + (mail-authentication :initarg :mail-authentication + :initform nil + :accessor mail-authentication) + (mail-ssl :initarg :mail-ssl + :initform nil + :accessor mail-ssl)) (:documentation "")) +(defmethod get-site-file-path ((webapp webapp)) + (format nil "~a/site" (document-root webapp))) + +(defmethod get-pages-file-paths ((webapp webapp)) + (mapcar (lambda (pages-file) + (ppcre:regex-replace-all "\\.lisp$" (format nil "~a" pages-file) "")) + (remove-if (lambda (x) (equal x "shared")) + (org-ckons-core::shell-wrapper (format nil "find '~a' -maxdepth 1 -type f -iname 'pages*.lisp' |sort" (document-root webapp)))))) + +(defun make-server-path (relative-path) + "Makes a relative filesystem path into a full one, using +`*server-root*' as the base." + (make-document-root-path *server-root* relative-path)) + +(defun make-document-root-path (document-root relative-path) + "Makes a relative filesystem path into a full one, using +`document-root' as the base." + (concatenate 'string document-root relative-path)) + +(defun make-webapp-path (relative-path) + "Makes an absolute filesystem path to a location in the webapps +folder." + (concatenate 'string *server-root* "webapps/" relative-path)) + +(defun get-options-files () + (mapcar (lambda (webapp-directory) + (format nil "~a/conf/options.lisp" webapp-directory)) + (remove-if (lambda (x) (or (org-ckons-core::match-it "webapps/$" x) + (org-ckons-core::match-it "webapps/shared$" x) + (org-ckons-core::match-it "webapps/CVS$" x) + (org-ckons-core::match-it "webapps/\\.$" x) + (org-ckons-core::match-it "webapps/\\.\\.$" x))) + (org-ckons-core::shell-wrapper (format nil "find '~a' -maxdepth 1 -type d |sort" (make-webapp-path "")))))) + +(defun set-webapp (webapp) + "Sets a `webapp' object in `*webapps*'. The lookup key is the webapp +name. If a webapp already exists under this key, it gets overwritten +with the new one." + (setf (gethash (name webapp) *webapps*) webapp)) + +(defun get-webapp (key) + "Gets the webapp object stored under the key `key'." + (gethash key *webapps*)) + +(defun populate-webapps () + (loop for options-file in (get-options-files) + do (with-open-file (input options-file :direction :input) + (let* ((form (read input))) + (set-webapp (make-instance 'webapp + :name (getf form :name) + :scheme (getf form :scheme) + :url (getf form :url) + :document-root (make-webapp-path (getf form :document-root)) + :title (getf form :title) + :meta-description (getf form :meta-description) + :databases (getf form :databases) + :mail-mx (getf form :mail-mx) + :mail-from (getf form :mail-from) + :mail-postmaster (getf form :mail-postmaster) + :mail-webmaster (getf form :mail-webmaster) + :mail-info (getf form :mail-info) + :mail-login-notify (getf form :mail-login-notify) + :mail-authentication (getf form :mail-authentication) + :mail-ssl (getf form :mail-ssl))))))) + +(defun bogenherr () + "Call this to start the server." + (when (null *acceptor*) + (let ((package (string-downcase (package-name #.*package*)))) + (populate-webapps) + (setf (log-manager) (make-instance 'log-manager :message-class 'formatted-message)) + (start-messenger 'text-file-messenger :filename (format nil "/var/log/lisp/~a.log" package)) + (setf *session-secret* (org-ckons-session::generate-sessionid)) + (populate-webapps) + (setf *acceptor* (start (make-instance 'easy-routes:easy-routes-acceptor + :port *port* + :document-root (make-server-path (format nil "webapps/~a/" package)) + :name (format nil "~a-acceptor" package))))))) + +(defmacro with-request-wrapper (uri page-function &rest args) + (let ((package (string-downcase (package-name #.*package*)))) + `(let (output) + (let* ((*webapp* (get-webapp ,package)) + (*uri* ,uri) + (*header-register* (make-instance 'org-ckons-session::header-register)) + (*sessionid* (ensure-user-session-exists))) + (ensure-user-exists) + (setf output (,page-function ,@args)) + (org-ckons-session::ship-headers *header-register*)) + output))) + +(defmacro define-endpoint (template-and-options var-list page-function &rest args) + "Does the grunt work of creating an `easy-routes' route for each page +you wish to publish." + (let ((name (gensym)) + (uri (first template-and-options)) + (method (getf (rest template-and-options) :method))) + `(progn + (org-ckons-core::logger (format nil "Publishing page. URL = [~a], method = [~a]" ,uri ,method)) + (easy-routes:defroute ,name ,template-and-options + ,var-list + (with-request-wrapper ,uri ,page-function ,@args))))) + +;; base-service + (defmacro loop-intersect-slots ((slot record other-object) &body body) `(loop for ,slot in (intersect-slots ,record (org-ckons-core::map-slot-names ,other-object)) do (when (slot-is-field-p ,slot) ,@body))) +(defclass base-service () + () + (:documentation "")) + (defmethod copy-from-record ((base-service base-service) (record record)) (loop-intersect-slots (slot record base-service) - (setf (slot-value base-service slot) (slot-value record slot)))) + (setf (slot-value base-service slot) (slot-value record slot)))) (defmethod copy-to-record ((base-service base-service) (record record)) (loop-intersect-slots (slot record base-service) - (setf (slot-value record slot) (slot-value base-service slot)))) + (setf (slot-value record slot) (slot-value base-service slot)))) + +(defun base (&optional (start-url "/home")) + (org-ckons-http::html5 + `(html + (head + ((meta :name "viewport" :content "width=device-width, initial-scale=1, shrink-to-fit=no")) + ((meta :charset "utf-8")) + ((title) ,(title *webapp*)) + ,@(mapcar (lambda (css) + `((link :rel "stylesheet" :href ,(getf css :href) :integrity ,(getf css :integrity) :crossorigin ,(getf css :crossorigin)))) + '((:href "https://cdn.jsdelivr.net/npm/bootstrap@4.6.2/dist/css/bootstrap.min.css" :integrity "sha384-xOolHFLEh07PJGoPkLv1IbcEPTNtaed2xpHsD9ESMhqIYd0nLMwNLD69Npy4HI+N" :crossorigin "anonymous") + (:href "/static/css/stylesheet.css" :crossorigin "anonymous"))) + ,@(mapcar (lambda (js) + `((script :type "text/javascript" :src ,(getf js :src) :integrity ,(getf js :integrity) :crossorigin ,(getf js :crossorigin)))) + '((:src "https://code.jquery.com/jquery-3.7.1.slim.min.js" :integrity "sha256-kmHvs0B+OpCW5GVHUNjv9rOmY0IvSIRcf7zGUDTDQM8=" :crossorigin "anonymous"))) + ((script :type "text/javascript" :src "/cljs-out/dev-main.js"))) + ((body :onload ,(format nil "bogenherr.core.start(~a)" (if start-url + (format nil "'~a'" start-url) + "null"))) + ((div :id "app")) + ,@(mapcar (lambda (js) + `((script :type "text/javascript" :src ,(getf js :src) :integrity ,(getf js :integrity) :crossorigin ,(getf js :crossorigin)))) + '((:src "https://cdn.jsdelivr.net/npm/bootstrap@4.6.2/dist/js/bootstrap.bundle.min.js" :integrity "sha384-Fy6S3B9q64WdZWQUiU+q4/2Lc9npb8tCaSX9FK7E8HnRr0Jz8D6OP9dO5Vg3Q9ct" :crossorigin "anonymous"))))))) + +(define-endpoint ("/" :method :get) () base) diff --git a/lisp/service/contact-us-service.lisp b/lisp/service/contact-us-service.lisp index 4e2aada..959b746 100644 --- a/lisp/service/contact-us-service.lisp +++ b/lisp/service/contact-us-service.lisp @@ -7,6 +7,16 @@ () (:documentation "")) +(defclass contact-us/view-service (contact-us-service) + ((content :initarg :content + :initform nil + :accessor content) + (form :initarg :form + :initform nil + :accessor form) + (location-p :initform nil)) + (:documentation "")) + (defun contact-us-form () (make-form "contact-us-form" nil @@ -22,27 +32,13 @@ (with-noauth (instance contact-us-service) t)) -(defclass contact-us/view-service (contact-us-service) - ((content :initarg :content - :initform nil - :accessor content) - (form :initarg :form - :initform nil - :accessor form) - (location-p :initform nil)) - (:documentation "")) - (defun contact-us-view-json () (with-noauth (instance contact-us/view-service) (setf (form instance) (contact-us-form)))) -(defclass contact-us/email-service (contact-us/view-service) - () - (:documentation "")) - (defun contact-us-email-json (first_name last_name email phone comments) (declare (special first_name last_name email phone comments)) - (with-noauth (instance contact-us/email-service) + (with-noauth (instance contact-us/email-servicea) (with-bogenherr-database (let ((contact-pkg (make-instance 'contact-pkg)) (contact-us-post (make-instance 'contact-us-post))) @@ -78,7 +74,11 @@ :reply-to (mail-postmaster *webapp*) :ssl (mail-ssl *webapp*) :authentication (mail-authentication *webapp*)) - (setf (session-value :message) "Form submitted successfully.")) + (setf (message instance) "Form submitted successfully.")) (error (e) (declare (ignore e)) - (setf (session-value :errormsg) "Error submitting form."))))))) + (setf (errormsg instance) "Error submitting form."))))))) + +(define-endpoint ("/contact-us" :method :get) () contact-us-json) +(define-endpoint ("/contact-us/view" :method :get) () contact-us-view-json) +(define-endpoint ("/contact-us/email" :method :post) (&post (first_name :parameter-type 'string) (last_name :parameter-type 'string) (email :parameter-type 'string) (phone :parameter-type 'string) (comments :parameter-type 'string)) contact-us-email-json first_name last_name email phone comments) diff --git a/lisp/service/gallery-service.lisp b/lisp/service/gallery-service.lisp index c3d0825..44a7804 100644 --- a/lisp/service/gallery-service.lisp +++ b/lisp/service/gallery-service.lisp @@ -9,12 +9,6 @@ :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 @@ -22,6 +16,18 @@ (location-p :initform nil)) (:documentation "")) +(defclass gallery/modify-service (gallery/view-service) + ((form :initarg :form + :initform nil + :accessor form)) + (: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)))) + (defun gallery-view-json () (with-noauth (instance gallery/view-service) (with-valid-user (user "gallery-modify") @@ -35,14 +41,8 @@ (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") + (with-auth (instance gallery/modify-service "gallery-modify") (setf (form instance) (make-form "gallery-add-form" nil t @@ -53,7 +53,7 @@ (defun gallery-add-submit-json (description video_embed_url upload) (declare (special description video_embed_url)) - (with-auth (instance gallery/add-modify-delete-service "gallery-modify") + (with-auth (instance gallery/modify-service "gallery-modify") (with-bogenherr-database (let ((general-pkg (make-instance 'general-pkg)) (gallery (make-instance 'gallery)) @@ -75,7 +75,7 @@ (setf (session-value :message) "Gallery added successfully."))))) (defun gallery-modify-json (id) - (with-auth (instance gallery/add-modify-delete-service "gallery-modify") + (with-auth (instance gallery/modify-service "gallery-modify") (with-bogenherr-database (let* ((general-pkg (make-instance 'general-pkg)) (gallery (get-gallery general-pkg id))) @@ -88,11 +88,11 @@ (:name "video_embed_url" :label "Video embed URL" :field-type "text" :value ,(video_embed_url gallery)) (: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.")))))) + (setf (errormsg instance) "Error: could not modify gallery. Not found.")))))) (defun gallery-modify-submit-json (id description video_embed_url upload) (declare (special description video_embed_url)) - (with-auth (instance gallery/add-modify-delete-service "gallery-modify") + (with-auth (instance gallery/modify-service "gallery-modify") (with-bogenherr-database (let* ((general-pkg (make-instance 'general-pkg)) (gallery (get-gallery general-pkg id))) @@ -112,19 +112,19 @@ (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.")))))) + (setf (message instance) "Gallery saved successfully.")) + (setf (errormsg instance) "An error occurred.")))))) (defun gallery-delete-json (id) - (with-auth (instance gallery/add-modify-delete-service "gallery-modify") + (with-auth (instance gallery/modify-service "gallery-modify") (with-bogenherr-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.")))))) + (setf (message instance) "Gallery deleted successfully.")) + (setf (errormsg instance) "Error: could not delete gallery. Not found.")))))) (defun gallery-file-view (id) (with-noauth-raw (instance gallery/view-service) @@ -134,3 +134,11 @@ (when gallery (setf (org-ckons-session::content-type *header-register*) (mime_type gallery)) (ironclad:hex-string-to-byte-array (content gallery))))))) + +(define-endpoint ("/gallery" :method :get) () gallery-json) +(define-endpoint ("/gallery/view" :method :get) () gallery-view-json) +(define-endpoint ("/gallery/add" :method :post) () gallery-add-json) +(define-endpoint ("/gallery/add/submit" :method :post) (&post (description :parameter-type 'string) (video_embed_url :parameter-type 'string) (upload :parameter-type 'string)) gallery-add-submit-json description video_embed_url upload) +(define-endpoint ("/gallery/modify" :method :post) (&post (id :parameter-type 'integer)) gallery-modify-json id) +(define-endpoint ("/gallery/modify/submit" :method :post) (&post (id :parameter-type 'integer) (description :parameter-type 'string) (video_embed_url :parameter-type 'string) (upload :parameter-type 'string)) gallery-modify-submit-json id description video_embed_url upload) +(define-endpoint ("/gallery/delete" :method :post) (&post (id :parameter-type 'integer)) gallery-delete-json id) diff --git a/lisp/service/generics.lisp b/lisp/service/generics.lisp deleted file mode 100644 index 592d245..0000000 --- a/lisp/service/generics.lisp +++ /dev/null @@ -1,15 +0,0 @@ -;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- -(declaim (optimize (speed 0) (safety 3) (debug 3))) - -(in-package :bogenherr) - -(defgeneric copy-from-record (base-service record) - (:documentation "Copies the fields from `record' to -`base-service'.")) - -(defgeneric copy-to-record (base-service record) - (:documentation "Copies the fields from `base-service' to -`record'.")) - -(defgeneric sanitize-rest-json (rest-service) - (:documentation "")) diff --git a/lisp/service/home-service.lisp b/lisp/service/home-service.lisp index da6ded6..63011e5 100644 --- a/lisp/service/home-service.lisp +++ b/lisp/service/home-service.lisp @@ -9,10 +9,11 @@ :accessor content)) (:documentation "")) -(defmethod initialize-instance :after ((home-service home-service) &key) - t) - (defun home-json (&optional message errormsg) (with-noauth (instance home-service) - (when (not (org-ckons-core::null-or-empty-p message)) (setf (message instance) message)) - (when (not (org-ckons-core::null-or-empty-p errormsg)) (setf (errormsg instance) errormsg)))) + (setf (message instance) message) + (setf (errormsg instance) errormsg))) + + +(define-endpoint ("/home" :method :get) () home-json) +(define-endpoint ("/home" :method :post) (&post (message :parameter-type 'string) (errormsg :parameter-type 'string)) home-json message errormsg) diff --git a/lisp/service/login-service.lisp b/lisp/service/login-service.lisp index 7a80bfd..408039c 100644 --- a/lisp/service/login-service.lisp +++ b/lisp/service/login-service.lisp @@ -12,53 +12,48 @@ :accessor title)) (:documentation "")) -(defclass login-forgot-service (login-service) - () +(defclass login-authenticate-service (rest-service) + ((location-p :initform nil)) (:documentation "")) -(defmethod initialize-instance :after ((login-service login-service) &key) - (setf (title login-service) "Login") - (setf (form login-service) (make-form "login-form" - nil - t - '((:name "username" :label "Username" :field-type "text" :required "required") - (:name "pwd" :label "Password" :field-type "password" :required "required") - (:label "Login" :field-type "button" :onclick "on_login_submit_clicked()"))))) - -(defmethod initialize-instance :after ((login-forgot-service login-forgot-service) &key) - (setf (title login-forgot-service) "Reset Password") - (setf (form login-forgot-service) (make-form "login-forgot-form" - nil - t - '((:name "username" :label "Username" :field-type "text" :required "required") - (:label "Send password reset email" :field-type "button" :onclick "on_login_forgot_submit_clicked()"))))) - (defun login-json () (with-noauth (instance login-service) - t)) + (setf (title instance) "Login") + (setf (form instance) (make-form "login-form" + nil + t + '((:name "username" :label "Username" :field-type "text" :required "required") + (:name "pwd" :label "Password" :field-type "password" :required "required") + (:label "Login" :field-type "button" :onclick "on_login_submit_clicked()")))))) (defun login-forgot-json () - (with-noauth (instance login-forgot-service) - t)) - -(defclass login-authenticate-service (rest-service) - ((location-p :initform nil)) - (:documentation "")) + (with-noauth (instance login-service) + (setf (title instance) "Reset Password") + (setf (form instance) (make-form "login-forgot-form" + nil + t + '((:name "username" :label "Username" :field-type "text" :required "required") + (:label "Send password reset email" :field-type "button" :onclick "on-login-forgot-submit-clicked")))))) (defun login-authenticate-json (username pwd) (with-noauth (instance login-authenticate-service) (if (or (org-ckons-core::null-or-empty-p username) (org-ckons-core::null-or-empty-p pwd)) - (setf (session-value :errormsg) "Login failed.") + (setf (errormsg instance) "Login failed.") (with-bogenherr-database (let* ((auth-pkg (make-instance 'auth-pkg)) (user (get-active-user-by-username-pwd auth-pkg username pwd))) (cond (user (set-user user) - (setf (session-value :message) "Successfully logged in.") - (setf (session-value :errormsg) nil)) + (setf (message instance) "Successfully logged in.") + (setf (errormsg instance) nil)) (t - (setf (session-value :message) nil) - (setf (session-value :errormsg) "Login failed.")))))) - (setf (message instance) (session-value :message)) - (setf (errormsg instance) (session-value :errormsg)))) + (setf (message instance) nil) + (setf (errormsg instance) "Login failed.")))))) + (setf (message instance) (message instance)) + (setf (errormsg instance) (errormsg instance)))) + +(define-endpoint ("/login" :method :get) () login-json) +(define-endpoint ("/login/authenticate" :method :post) (&post (username :parameter-type 'string) (pwd :parameter-type 'string)) login-authenticate-json username pwd) +(define-endpoint ("/login/forgot" :method :get) () login-forgot-json) +(define-endpoint ("/logout" :method :get) () logout-json) diff --git a/lisp/service/logout-service.lisp b/lisp/service/logout-service.lisp index d0564a5..169314e 100644 --- a/lisp/service/logout-service.lisp +++ b/lisp/service/logout-service.lisp @@ -10,5 +10,4 @@ (defun logout-json () (with-noauth (instance logout-service) (set-user (make-default-user)) - (setf (location instance) "/home") (setf (message instance) "You are now logged out."))) diff --git a/lisp/service/menu-service.lisp b/lisp/service/menu-service.lisp index 90b513a..44b9020 100644 --- a/lisp/service/menu-service.lisp +++ b/lisp/service/menu-service.lisp @@ -96,3 +96,6 @@ (format nil "~a ~a" (first_name user) (last_name user)) "No User Found")) (org-ckons-json::objects-to-json `(,instance)))) + +(define-endpoint ("/menu" :method :get) () menu-json) +(define-endpoint ("/menu/user" :method :get) () menu-user-json) diff --git a/lisp/service/messages-service.lisp b/lisp/service/messages-service.lisp index e03c04c..9e2a419 100644 --- a/lisp/service/messages-service.lisp +++ b/lisp/service/messages-service.lisp @@ -12,25 +12,28 @@ :accessor form)) (:documentation "")) +(defclass messages/view-service (messages-service) + ((results :initarg :results + :initform nil + :accessor results) + (location-p :initform nil)) + (:documentation "")) + +(defclass messages/mark-service (messages-service) + ((location-p :initform nil)) + (:documentation "")) + (defun messages-json () (with-auth (instance messages-service "messages-view") (setf (title instance) "Messages Administration") (setf (form instance) (make-form "messages-select-mode-form" nil nil - `((:name "read" :field-type "hidden" :required "required" :value ,(session-value :messages-read)) - (:label "View Unread" :field-type "button" :onclick "on_messages_mode_clicked('unread')") + `((:label "View Unread" :field-type "button" :onclick "on_messages_mode_clicked('unread')") (:label "View Read" :field-type "button" :onclick "on_messages_mode_clicked('read')")))))) -(defclass messages/results-service (messages-service) - ((results :initarg :results - :initform nil - :accessor results) - (location-p :initform nil)) - (:documentation "")) - -(defun messages-results-json (read) - (with-auth (instance messages/results-service "messages-view") +(defun messages-view-json (read) + (with-auth (instance messages/view-service "messages-view") (when read (setf (session-value :messages-read) read)) (with-bogenherr-database (let ((contact-pkg (make-instance 'contact-pkg))) @@ -41,17 +44,17 @@ (loop for result in (results instance) do (sanitize-json result)))) -(defclass messages/mark-service (messages-service) - ((location-p :initform nil)) - (:documentation "")) - (defun messages-mark-json (read id) (with-auth (instance messages/mark-service "messages-view") (with-bogenherr-database (handler-case (let ((contact-pkg (make-instance 'contact-pkg))) (mark-contact-us-post contact-pkg id (id (get-user)) (string= read "read")) - (setf (session-value :message) (format nil "Message marked ~a successfully." read))) + (setf (message instance) (format nil "Message marked ~a successfully." read))) (error (e) (declare (ignore e)) - (setf (session-value :errormsg) (format nil "Error marking message ~a." read))))))) + (setf (errormsg instance) (format nil "Error marking message ~a." read))))))) + +(define-endpoint ("/messages" :method :get) () messages-json) +(define-endpoint ("/messages/view" :method :post) (&post (read :parameter-type 'string)) messages-view-json read) +(define-endpoint ("/messages/mark" :method :post) (&post (read :parameter-type 'string) (id :parameter-type 'integer)) messages-mark-json read id) diff --git a/lisp/service/password-service.lisp b/lisp/service/password-service.lisp index 32507d2..ab35f09 100644 --- a/lisp/service/password-service.lisp +++ b/lisp/service/password-service.lisp @@ -12,6 +12,13 @@ :accessor title)) (:documentation "")) +(defclass password/modify-service (password-service) + ((form :initarg :form + :initform nil + :accessor form) + (location-p :initform nil)) + (:documentation "")) + (defun password-json () (with-auth (instance password-service "profile-modify") (let ((user (get-user))) @@ -24,13 +31,6 @@ (:name "pwd2" :label "Password (again)" :field-type "password" :required "required") (:label "Change Password" :field-type "button" :onclick "on_password_submit_clicked()"))))))) -(defclass password/modify-service (password-service) - ((form :initarg :form - :initform nil - :accessor form) - (location-p :initform nil)) - (:documentation "")) - (defun password-submit-json (id pwd pwd2) (declare (special pwd pwd2)) (with-auth (instance password/modify-service "profile-modify") @@ -46,5 +46,8 @@ do (setf (slot-value user param) (symbol-value param))) (update-password auth-pkg user) (set-user user) - (setf (session-value :message) "Password saved successfully.")) - (setf (session-value :errormsg) "An error occured.")))))) + (setf (message instance) "Password saved successfully.")) + (setf (errormsg instance) "An error occured.")))))) + +(define-endpoint ("/password" :method :get) () password-json) +(define-endpoint ("/password/submit" :method :post) (&post (id :parameter-type 'integer) (pwd :parameter-type 'string) (pwd2 :parameter-type 'string)) password-submit-json id pwd pwd2) diff --git a/lisp/service/profile-service.lisp b/lisp/service/profile-service.lisp index 256d599..e8b68de 100644 --- a/lisp/service/profile-service.lisp +++ b/lisp/service/profile-service.lisp @@ -3,22 +3,18 @@ (in-package :bogenherr) -(defclass profile-service (auth-service user) +(defclass profile-service (auth-service) ((title :initarg :title :initform nil :accessor title)) (:documentation "")) -(defun profile-json () - (with-auth (instance profile-service "profile-modify") - (setf (title instance) "Profile") - (sanitize-rest-json instance))) - -(defun profile-view-json () - (with-auth (instance profile-service "profile-modify") - (let ((user (get-user))) - (copy-from-record instance user)) - (sanitize-rest-json instance))) +(defclass profile/view-service (profile-service) + ((items :initarg items + :initform nil + :accessor items) + (location-p :initform nil)) + (:documentation "")) (defclass profile/modify-service (profile-service) ((form :initarg :form @@ -27,10 +23,22 @@ (location-p :initform nil)) (:documentation "")) +(defun profile-json () + (with-auth (instance profile-service "profile-modify") + (setf (title instance) "Profile"))) + +(defun profile-view-json () + (with-auth (instance profile/view-service "profile-modify") + (let ((user (get-user))) + (setf (items instance) `(,user))) + (sanitize-rest-json instance) + (loop for item in (items instance) + do (sanitize-json item)))) + (defun profile-modify-json () (with-auth (instance profile/modify-service "profile-modify") (let ((user (get-user))) - (sanitize-rest-json instance) + (sanitize-json user) (setf (title instance) "Profile - Modify") (setf (form instance) (make-form "profile-modify-form" nil @@ -54,8 +62,12 @@ (intersection `(,x) '(id))) (sb-introspect:function-lambda-list #'profile-modify-submit-json)) do (setf (slot-value user param) (symbol-value param))) - (copy-from-record instance user) (update-user auth-pkg user) (set-user user) - (setf (session-value :message) "Profile saved successfully.")) - (setf (session-value :errormsg) "An error occured.")))))) + (setf (message instance) "Profile saved successfully.")) + (setf (errormsg instance) "An error occured.")))))) + +(define-endpoint ("/profile" :method :get) () profile-json) +(define-endpoint ("/profile/view" :method :get) () profile-view-json) +(define-endpoint ("/profile/modify" :method :post) () profile-modify-json) +(define-endpoint ("/profile/modify/submit" :method :post) (&post (id :parameter-type 'integer) (username :parameter-type 'string) (first_name :parameter-type 'string) (last_name :parameter-type 'string) (email :parameter-type 'string) (phone :parameter-type 'string)) profile-modify-submit-json id username first_name last_name email phone) diff --git a/lisp/service/rest-service.lisp b/lisp/service/rest-service.lisp index b01f7fa..9f9f3d7 100644 --- a/lisp/service/rest-service.lisp +++ b/lisp/service/rest-service.lisp @@ -20,12 +20,6 @@ (defmethod initialize-instance :after ((rest-service rest-service) &key) (when (location-p rest-service) - (if (message rest-service) - (setf (session-value :message) (message rest-service)) - (setf (message rest-service) (session-value :message))) - (if (errormsg rest-service) - (setf (session-value :errormsg) (errormsg rest-service)) - (setf (errormsg rest-service) (session-value :errormsg))) (when (null (location rest-service)) (setf (location rest-service) (type-to-path rest-service))))) @@ -39,3 +33,5 @@ (loop for slot in (intersection '(org-ckons-session::*session-key *table *where-expression pwd) (org-ckons-core::map-slot-names rest-service)) do (setf (slot-value rest-service slot) nil))) + +(define-endpoint ("/location" :method :post) (&post (location :parameter-type 'string)) location-json location) diff --git a/lisp/service/users-service.lisp b/lisp/service/users-service.lisp index 5b16d46..145ccdd 100644 --- a/lisp/service/users-service.lisp +++ b/lisp/service/users-service.lisp @@ -9,10 +9,6 @@ :accessor title)) (:documentation "")) -(defun users-json () - (with-auth (instance users-service "users-view") - (setf (title instance) "Users"))) - (defclass users/view-service (users-service user) ((users :initarg :users :initform nil @@ -20,6 +16,36 @@ (location-p :initform nil)) (:documentation "")) +(defclass users/modify-service (users/view-service) + ((form :initarg :form + :initform nil + :accessor form)) + (:documentation "")) + +(defclass users/register-service (rest-service) + ((title :initarg :title + :initform nil + :accessor title) + (hash :initarg :hash + :initform nil + :accessor hash)) + (:documentation "")) + +(defclass users/register/form-service (rest-service) + ((form :initarg :form + :initform nil + :accessor form) + (location-p :initform nil)) + (:documentation "")) + +(defclass users/register/submit-service (rest-service) + ((location-p :initform nil)) + (:documentation "")) + +(defun users-json () + (with-auth (instance users-service "users-view") + (setf (title instance) "Users"))) + (defun users-view-json () (with-auth (instance users/view-service "users-view") (with-bogenherr-database @@ -29,13 +55,7 @@ (loop for user in (users instance) do (sanitize-json user)))) -(defclass users/add-service (users/view-service) - ((form :initarg :form - :initform nil - :accessor form)) - (:documentation "")) - -(defun role-checkboxes (role-groups &optional active-role-groups) +(defun role-checkboxes (name role-groups &optional active-role-groups) (remove-if 'null (mapcar (lambda (role-group) (when (not (intersection `(,(name role-group)) `("_Public" "profile-admin") :test 'string=)) @@ -45,11 +65,11 @@ active-role-groups) :test 'string=) '(:checked "checked" :value "on")))) - (remove-if 'null `(:name ,(format nil "chk_~a" (name role-group)) :label ,(name role-group) :field-type "checkbox" ,@checked))))) + (remove-if 'null `(:name ,(format nil "chk_~a_~a" name (name role-group)) :label ,(name role-group) :field-type "checkbox" ,@checked))))) role-groups))) (defun users-add-json () - (with-auth (instance users/add-service "users-modify") + (with-auth (instance users/modify-service "users-modify") (setf (title instance) "Users - Add") (with-bogenherr-database (let* ((auth-pkg (make-instance 'auth-pkg)) @@ -61,12 +81,12 @@ `((: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) + ,@(role-checkboxes "users_add" 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) (declare (special role_groups first_name last_name email)) - (with-auth (instance users/add-service "users-modify") + (with-auth (instance users/modify-service "users-modify") (with-bogenherr-database (let ((registration (make-instance 'registration))) (loop for param in (sb-introspect:function-lambda-list #'users-add-submit-json) @@ -95,12 +115,12 @@ ((p) "Please click the following link to complete the registration:") ((p) ((a :href ,(format nil - "~a://~a/register?hash=~a" + "~a://~a/register/~a" (scheme *webapp*) (url *webapp*) (hash registration))) ,(format nil - "~a://~a/register?hash=~a" + "~a://~a/register/~a" (scheme *webapp*) (url *webapp*) (hash registration)))))))) @@ -113,31 +133,15 @@ :reply-to (mail-postmaster *webapp*) :ssl (mail-ssl *webapp*) :authentication (mail-authentication *webapp*)) - (setf (session-value :message) (format nil "Email sent successfully to ~a" (email registration)))) + (setf (message instance) (format nil "Email sent successfully to ~a" (email registration)))) (error (e) - (setf (session-value :errormsg) (format nil "Error sending email to ~a. Registration failed. ~a" (email registration) e)))))))) - -(defclass users/register-service (rest-service) - ((title :initarg :title - :initform nil - :accessor title) - (hash :initarg :hash - :initform nil - :accessor hash)) - (:documentation "")) + (setf (errormsg instance) (format nil "Error sending email to ~a. Registration failed. ~a" (email registration) e)))))))) (defun users-register-json (hash) (with-noauth (instance users/register-service) (setf (title instance) "New User Registration") (setf (hash instance) hash))) -(defclass users/register/form-service (rest-service) - ((form :initarg :form - :initform nil - :accessor form) - (location-p :initform nil)) - (:documentation "")) - (defun users-register-form-json (hash) (with-noauth (instance users/register/form-service) (with-bogenherr-database @@ -145,23 +149,17 @@ (registration (get-registration-by-hash auth-pkg hash))) (registrations-gc auth-pkg) (if registration - (progn - (setf (form instance) - (make-form "users-register-form" - nil - t - `((:name "hash" :field-type "hidden" :value ,(hash registration) :required "required") - (:name "username" :label "Username" :field-type "text" :required "required") - (:name "pwd" :label "Password" :field-type "password" :required "required") - (:name "pwd2" :label "Password (again)" :field-type "password" :required "required") - (:name "phone" :label "Phone" :field-type "text") - (:label "Register" :field-type "button" :onclick "on_users_register_submit_clicked()")))) - (setf (session-value :message) "Registered successfully.")) - (setf (session-value :errormsg) "Error: invalid registration.")))))) - -(defclass users/register/submit-service (rest-service) - ((location-p :initform nil)) - (:documentation "")) + (setf (form instance) + (make-form "users-register-form" + nil + t + `((:name "hash" :field-type "hidden" :value ,(hash registration) :required "required") + (:name "username" :label "Username" :field-type "text" :required "required") + (:name "pwd" :label "Password" :field-type "password" :required "required") + (:name "pwd2" :label "Password (again)" :field-type "password" :required "required") + (:name "phone" :label "Phone" :field-type "text") + (:label "Register" :field-type "button" :onclick "on_users_register_submit_clicked()")))) + (setf (errormsg instance) "Error: invalid registration.")))))) (defun users-register-submit-json (hash username pwd pwd2 phone) (with-noauth (instance users/register/submit-service) @@ -170,34 +168,29 @@ registration) (registrations-gc auth-pkg) (setf registration (get-registration-by-hash auth-pkg hash)) - (org-ckons-json::objects-to-json - `(,(if registration - (if (string= pwd pwd2) - (let ((user (make-instance 'user - :username username - :pwd pwd - :first_name (first_name registration) - :last_name (last_name registration) - :email (email registration) - :phone phone - :active t))) - (if (insert-user auth-pkg user) - (progn - (loop for role-group in (union '("profile-admin") - (cl-ppcre:split "\\|" (role_groups registration)) - :test 'string=) - do (insert-user-role-group auth-pkg (make-instance 'user-role - :user_id (id user) - :role_group_name role-group))) - (delete-registration auth-pkg hash) - (setf (session-value :message) "Registration completed successfully.")) - (setf (session-value :errormsg) "Error while completing registration."))) - (setf (session-value :errormsg) "Error: passwords do not match.")) - (setf (session-value :errormsg) "Error while completing registration.")))))))) - -(defclass users/modify-service (users/add-service) - () - (:documentation "")) + (if registration + (if (string= pwd pwd2) + (let ((user (make-instance 'user + :username username + :pwd pwd + :first_name (first_name registration) + :last_name (last_name registration) + :email (email registration) + :phone phone + :active t))) + (if (insert-user auth-pkg user) + (progn + (loop for role-group in (union '("profile-admin") + (cl-ppcre:split "\\|" (role_groups registration)) + :test 'string=) + do (insert-user-role-group auth-pkg (make-instance 'user-role + :user_id (id user) + :role_group_name role-group))) + (delete-registration auth-pkg hash) + (setf (message instance) "Registration completed successfully.")) + (setf (errormsg instance) "Error while completing registration."))) + (setf (errormsg instance) "Error: passwords do not match.")) + (setf (errormsg instance) "Error while completing registration.")))))) (defun users-modify-json (id) (with-auth (instance users/modify-service "users-modify") @@ -218,9 +211,9 @@ (:name "last_name" :label "Last Name" :field-type "text" :value ,(last_name user) :required "required") (:name "email" :label "Email" :field-type "text" :value ,(email user) :required "required") (:name "phone" :label "Phone" :field-type "text" :value ,(phone user)) - ,@(role-checkboxes role-groups active-role-groups) + ,@(role-checkboxes "users_modify" role-groups active-role-groups) (:label "Modify User" :field-type "button" :onclick "on_users_modify_submit_clicked()")))) - (setf (session-value :errormsg) "Error: could not modify user. Not found.")))))) + (setf (errormsg instance) "Error: could not modify user. Not found.")))))) (defun users-modify-submit-json (id role_groups username first_name last_name email phone) (declare (special role_groups username first_name last_name email phone)) @@ -240,43 +233,48 @@ (cl-ppcre:split "\\|" role_groups) :test 'string=) do (insert-user-role-group auth-pkg (make-instance 'user-role - :user_id (id user) + :user_id id :role_group_name role-group))) - (setf (session-value :message) "User saved successfully.")) - (setf (session-value :errormsg) "An error occured.")))))) - -(defclass users/toggle-service (users/add-service) - () - (:documentation "")) + (setf (message instance) "User saved successfully.")) + (setf (errormsg instance) "An error occured.")))))) (defun users-toggle-active-json (id) - (with-auth (instance users/toggle-service "users-modify") + (with-auth (instance users/modify-service "users-modify") (with-bogenherr-database (let* ((auth-pkg (make-instance 'auth-pkg)) (user (get-user-by-id auth-pkg id))) (if user (if (= (id user) (id (get-user))) - (setf (session-value :errormsg) "Error: you may not toggle your own active state.") + (setf (errormsg instance) "Error: you may not toggle your own active state.") (progn (user-toggle-active auth-pkg user) - (setf (session-value :errormsg) nil) - (setf (session-value :message) "User active state toggled successfully."))) - (setf (session-value :errormsg) "Error: could not toggle the active state of the user: not found.")))))) - -(defclass users/delete-service (users/add-service) - () - (:documentation "")) + (setf (errormsg instance) nil) + (setf (message instance) "User active state toggled successfully."))) + (setf (errormsg instance) "Error: could not toggle the active state of the user: not found.")))))) (defun users-delete-json (id) - (with-auth (instance users/delete-service "users-modify") + (with-auth (instance users/modify-service "users-modify") (with-bogenherr-database (let* ((auth-pkg (make-instance 'auth-pkg)) (user (get-user-by-id auth-pkg id))) (if user (if (= (id user) (id (get-user))) - (setf (session-value :errormsg) "Error: you may not delete yourself.") + (setf (errormsg instance) "Error: you may not delete yourself.") (progn (deactivate-user auth-pkg user) - (setf (session-value :errormsg) nil) - (setf (session-value :message) "User deleted successfully."))) - (setf (session-value :errormsg) "Error: could not delete user: not found.")))))) + (setf (errormsg instance) nil) + (setf (message instance) "User deleted successfully."))) + (setf (errormsg instance) "Error: could not delete user: not found.")))))) + +(define-endpoint ("/users" :method :get) () users-json) +(define-endpoint ("/users/view" :method :get) () users-view-json) +(define-endpoint ("/users/add" :method :post) () users-add-json) +(define-endpoint ("/users/add/submit" :method :post) (&post (role_groups :parameter-type 'string) (first_name :parameter-type 'string) (last_name :parameter-type 'string) (email :parameter-type 'string)) users-add-submit-json role_groups first_name last_name email) +(define-endpoint ("/register" :method :get) (&get (hash :parameter-type 'string)) base (format nil "/register/~a" hash)) +(define-endpoint ("/users/register" :method :post) (&post (hash :parameter-type 'string)) users-register-json hash) +(define-endpoint ("/users/register/form" :method :post) (&post (hash :parameter-type 'string)) users-register-form-json hash) +(define-endpoint ("/users/register/submit" :method :post) (&post (hash :parameter-type 'string) (username :parameter-type 'string) (pwd :parameter-type 'string) (pwd2 :parameter-type 'string) (phone :parameter-type 'string)) users-register-submit-json hash username pwd pwd2 phone) +(define-endpoint ("/users/modify" :method :post) (&post (id :parameter-type 'integer)) users-modify-json id) +(define-endpoint ("/users/modify/submit" :method :post) (&post (id :parameter-type 'integer) (role_groups :parameter-type 'string) (username :parameter-type 'string) (first_name :parameter-type 'string) (last_name :parameter-type 'string) (email :parameter-type 'string) (phone :parameter-type 'string)) users-modify-submit-json id role_groups username first_name last_name email phone) +(define-endpoint ("/users/toggle-active" :method :post) (&post (id :parameter-type 'integer)) users-toggle-active-json id) +(define-endpoint ("/users/delete/:id" :method :delete) (&path (id 'integer)) users-delete-json id) diff --git a/lisp/webapps/bogenherr/clojurescript/bogenherr/src/bogenherr/core.cljs b/lisp/webapps/bogenherr/clojurescript/bogenherr/src/bogenherr/core.cljs index c14e5bc..52c1872 100644 --- a/lisp/webapps/bogenherr/clojurescript/bogenherr/src/bogenherr/core.cljs +++ b/lisp/webapps/bogenherr/clojurescript/bogenherr/src/bogenherr/core.cljs @@ -14,14 +14,35 @@ ;; declarations +(declare reset-login-state) +(declare reset-profile-state) +(declare reset-profile-view-state) +(declare reset-profile-modify-state) +(declare reset-about-us-category-state) +(declare reset-about-us-state) +(declare reset-about-us-view-state) +(declare reset-about-us-modify-state) +(declare reset-gallery-state) +(declare reset-gallery-view-state) +(declare reset-gallery-image-state) +(declare reset-gallery-add-state) +(declare reset-gallery-modify-state) +(declare reset-contact-us-state) +(declare reset-contact-us-view-state) +(declare reset-messages-state) +(declare reset-messages-view-state) +(declare reset-messages-mode-state) +(declare reset-users-state) +(declare reset-users-view-state) +(declare reset-users-add-state) +(declare reset-users-register-state) +(declare reset-users-register-form-state) +(declare reset-users-modify-state) (declare date-sql-to-pretty) (declare markdown-to-html) (declare reduce-checkboxes) -(declare comp-app) -(declare start-render) -(declare start-location) -(declare reset-location) -(declare start) +(declare form-fields-to-map) +(declare clear-notifications) (declare notifications) (declare auth-notifications) (declare comp-menu-main) @@ -32,7 +53,7 @@ (declare comp-home) (declare handler-home) (declare render-home) -(declare template-login) +(declare comp-login) (declare handler-login) (declare render-login) (declare on-login-submit-clicked) @@ -40,53 +61,42 @@ (declare render-login-authenticate) (declare handler-logout) (declare render-logout) -(declare template-profile) +(declare comp-profile) (declare handler-profile) (declare render-profile) -(declare template-profile-view) +(declare comp-profile-view) (declare handler-profile-view) (declare render-profile-view) (declare on-profile-modify-clicked) -(declare template-profile-modify) +(declare comp-profile-modify) (declare handler-profile-modify) (declare render-profile-modify) (declare on-profile-modify-submit-clicked) (declare handler-profile-modify-submit) (declare render-profile-modify-submit) -(declare template-password) +(declare comp-password) (declare handler-password) (declare render-password) (declare on-password-submit-clicked) (declare handler-password-submit) (declare render-password-submit) -(declare template-about-us) -(declare handler-about-us) -(declare render-lessons) -(declare template-about-us-view) -(declare handler-about-us-view) -(declare render-about-us-view) -(declare on-about-us-modify-clicked) -(declare template-about-us-modify) -(declare handler-about-us-modify) -(declare render-about-us-modify) -(declare on-about-us-modify-submit-clicked) -(declare handler-about-us-modify-submit) -(declare render-about-us-modify-submit) +(declare comp-gallery) +(declare handler-gallery) (declare render-gallery) -(declare template-gallery-view) -(declare template-gallery-image-fullscreen) -(declare on-gallery-image-clicked ) +(declare comp-gallery-view) (declare handler-gallery-view) (declare render-gallery-view) +(declare on-gallery-image-clicked) +(declare comp-gallery-image) (declare on-gallery-add-clicked) -(declare template-gallery-add) +(declare comp-gallery-add) (declare handler-gallery-add) (declare render-gallery-add) (declare on-gallery-add-submit-clicked) (declare handler-gallery-add-submit) (declare render-gallery-add-submit) (declare on-gallery-modify-clicked) -(declare template-gallery-modify) +(declare comp-gallery-modify) (declare handler-gallery-modify) (declare render-gallery-modify) (declare on-gallery-modify-submit-clicked) @@ -95,64 +105,63 @@ (declare on-gallery-delete-clicked) (declare handler-gallery-delete) (declare render-gallery-delete) -(declare template-testimonials) -(declare handler-testimonials) -(declare render-testimonials) -(declare template-testimonials-view) -(declare handler-testimonials-view) -(declare render-testimonials-view) -(declare on-testimonials-modify-clicked) -(declare template-testimonials-modify) -(declare handler-testimonials-modify) -(declare render-testimonials-modify) -(declare on-testimonials-modify-submit-clicked) -(declare handler-testimonials-modify-submit) -(declare render-testimonials-modify-submit) -(declare template-contact-us) +(declare comp-about-us) +(declare handler-about-us) +(declare render-lessons) +(declare comp-about-us-view) +(declare handler-about-us-view) +(declare render-about-us-view) +(declare on-about-us-modify-clicked) +(declare comp-about-us-modify) +(declare handler-about-us-modify) +(declare render-about-us-modify) +(declare on-about-us-modify-submit-clicked) +(declare handler-about-us-modify-submit) +(declare render-about-us-modify-submit) +(declare comp-contact-us) (declare handler-contact-us) (declare render-contact-us) -(declare template-contact-us-view) +(declare comp-contact-us-view) (declare handler-contact-us-view) (declare render-contact-us-view) (declare on-contact-us-email-submit-clicked) (declare handler-contact-us-email-submit) (declare render-contact-us-email-submit) -(declare template-messages) +(declare comp-messages) (declare handler-messages) (declare render-messages) (declare on-messages-mode-clicked) -(declare template-messages-results) -(declare handler-messages-results) -(declare render-messages-results) +(declare comp-messages-view) +(declare handler-messages-view) +(declare render-messages-view) (declare on-messages-mark) (declare handler-messages-mark) (declare render-messages-mark) -(declare template-users) +(declare comp-users) (declare handler-users) (declare render-users) -(declare template-users-view) +(declare comp-users-view) (declare handler-users-view) (declare render-users-view) (declare on-users-add-clicked) -(declare template-users-add) +(declare comp-users-add) (declare handler-users-add) (declare render-users-add) (declare on-users-add-submit-clicked) (declare handler-users-add-submit) (declare render-users-add-submit) -(declare template-users-register) +(declare comp-users-register) (declare handler-users-register) (declare render-users-register) -(declare template-users-register-form) +(declare comp-users-register-form) (declare handler-users-register-form) (declare handler-users-register-form-impl) (declare render-users-register-form) (declare on-users-register-submit-clicked) -(declare template-users-register-submit) (declare handler-users-register-submit) (declare render-users-register-submit) (declare on-users-modify-clicked) -(declare template-users-modify) +(declare comp-users-modify) (declare handler-users-modify) (declare render-users-modify) (declare on-users-modify-submit-clicked) @@ -164,23 +173,135 @@ (declare on-users-delete-clicked) (declare handler-users-delete) (declare render-users-delete) +(declare push-menu-hook) (declare on-menu-clicked) (declare handler-location) (declare goto-location) (declare goto-register) (declare reset-app) -(declare reset-about-us-category) +(declare start-location) +(declare reset-location) +(declare comp-app) +(declare start-render) +(declare start) (enable-console-print!) -(defonce jquery (js* "$")) -(defonce sql-formatter (time-format/formatter "yyyy-MM-dd HH:mm:ss")) -(defonce pretty-formatter (time-format/formatters :rfc822)) -(defonce location-state (r/atom "/home")) -(defonce about-us-category-state (r/atom nil)) -(defonce menu-main-state (r/atom [])) -(defonce menu-user-state (r/atom [])) -(defonce menu-user-label (r/atom nil)) +(def jquery (js* "$")) +(def sql-formatter (time-format/formatter "yyyy-MM-dd HH:mm:ss")) +(def pretty-formatter (time-format/formatters :rfc822)) +(def location-state (r/atom "/home")) +(def menu-main-state (r/atom [])) +(def menu-user-state (r/atom [])) +(def menu-user-label (r/atom nil)) +(def login-state (r/atom {})) +(def profile-state (r/atom {})) +(def profile-view-state (r/atom {})) +(def profile-modify-state (r/atom {})) +(def password-state (r/atom {})) +(def about-us-category-state (r/atom "home")) +(def about-us-state (r/atom {})) +(def about-us-view-state (r/atom {})) +(def about-us-modify-state (r/atom {})) +(def gallery-state (r/atom {})) +(def gallery-view-state (r/atom {})) +(def gallery-image-state (r/atom "")) +(def gallery-add-state (r/atom {})) +(def gallery-modify-state (r/atom {})) +(def contact-us-state (r/atom {})) +(def contact-us-view-state (r/atom {})) +(def messages-state (r/atom {})) +(def messages-view-state (r/atom {})) +(def messages-mode-state (r/atom "unread")) +(def users-state (r/atom {})) +(def users-view-state (r/atom {})) +(def users-add-state (r/atom {})) +(def users-register-state (r/atom {})) +(def users-register-form-state (r/atom {})) +(def users-modify-state (r/atom {})) +(def menu-hooks (atom {})) + +(defn push-menu-hook [hook] + "`hook' is a map of the form {:handler \"/some/url\" :func #(some-fn)}" + (swap! menu-hooks assoc (get hook :handler) hook)) + +(defn reset-location [url] + (reset! location-state (first (str/split url "?")))) + +(defn reset-login-state [jsonobj] + (reset! login-state jsonobj)) + +(defn reset-profile-state [jsonobj] + (reset! profile-state jsonobj)) + +(defn reset-profile-view-state [jsonobj] + (reset! profile-view-state jsonobj)) + +(defn reset-profile-modify-state [jsonobj] + (reset! profile-modify-state jsonobj)) + +(defn reset-password-state [jsonobj] + (reset! password-state jsonobj)) + +(defn reset-about-us-category-state [category] + (reset! about-us-category-state category)) + +(defn reset-about-us-state [jsonobj] + (reset! about-us-state jsonobj)) + +(defn reset-about-us-view-state [jsonobj] + (reset! about-us-view-state jsonobj)) + +(defn reset-about-us-modify-state [jsonobj] + (reset! about-us-modify-state jsonobj)) + +(defn reset-gallery-state [jsonobj] + (reset! gallery-state jsonobj)) + +(defn reset-gallery-view-state [jsonobj] + (reset! gallery-view-state jsonobj)) + +(defn reset-gallery-image-state [src] + (reset! gallery-image-state src)) + +(defn reset-gallery-add-state [jsonobj] + (reset! gallery-add-state jsonobj)) + +(defn reset-gallery-modify-state [jsonobj] + (reset! gallery-modify-state jsonobj)) + +(defn reset-contact-us-state [jsonobj] + (reset! contact-us-state jsonobj)) + +(defn reset-contact-us-view-state [jsonobj] + (reset! contact-us-view-state jsonobj)) + +(defn reset-messages-state [jsonobj] + (reset! messages-state jsonobj)) + +(defn reset-messages-view-state [jsonobj] + (reset! messages-view-state jsonobj)) + +(defn reset-messages-mode-state [mode] + (reset! messages-mode-state mode)) + +(defn reset-users-state [jsonobj] + (reset! users-state jsonobj)) + +(defn reset-users-view-state [jsonobj] + (reset! users-view-state jsonobj)) + +(defn reset-users-add-state [jsonobj] + (reset! users-add-state jsonobj)) + +(defn reset-users-register-state [jsonobj] + (reset! users-register-state jsonobj)) + +(defn reset-users-register-form-state [jsonobj] + (reset! users-register-form-state jsonobj)) + +(defn reset-users-modify-state [jsonobj] + (reset! users-modify-state jsonobj)) ;; helper functions @@ -197,73 +318,28 @@ `chk_something-more'. The important thing is the underscore separating the throwaway prefix and the remaining useful bit. `selector' will likely be something like: [id^='chk_']" - (reduce (fn [x y] - (cond (and x y) (str x "|" y) - (and x (not y)) x - (and (not x) y) y - :else "")) - (map (fn [elem] - (let [this (jquery (str "#" (dommy/attr elem :id)))] - (when (-> this (.prop "checked")) - (second (str/split (-> this (.prop "id")) "_"))))) - (.toArray (jquery selector))))) - -;; body - -(defn comp-app [] - [:div {:class "container-fluid"} - [:div {:class "banner"} - [:table {:width "100%" :height "100%"} - [:tbody - [:tr - [:td {:class "banner-menu"} - [comp-menu-user]] - [:td {:class "banner-title"} "Bogen-" [:i "Herr"]] - [:td {:class "banner-menu"} " "]]]]] - [comp-menu-main] - [ck-notifications/comp-errormsg] - [ck-notifications/comp-message] - [:div {:id "body"}] - [:div {:id "footer"} - [:hr] - "Carlos Konstanski (970) 294-9708" - [:br] - [:a {:href "https://git.ckons.org/bogenherr.git/tree" - :target "_blank"} - "Source code in Git"] - [:hr] - [:img {:src "/static/images/notes.png" - :height "50px"}]]]) - -;; start the react app - -(defn start-render [] - (let [app-root (rdc/create-root (js/document.getElementById "app"))] - (rdc/render app-root [comp-app]))) - -(defn start-location [] - (cond (str/starts-with? @location-state "/register/") - (goto-register (str/replace-first @location-state "/register/" "")) - :else - (goto-location @location-state))) - -(defn reset-location [url] - (reset! location-state url)) - -(defn reset-about-us-category [category] - (reset! about-us-category-state category)) - -(defn ^:dev/after-load start - ([] - (start-render) - (start-location)) - ([url] - (reset-location url) - (start-render) - (start-location))) - + (or (reduce (fn [x y] + (cond (and (not (empty? x)) (not (empty? y))) (str x "|" y) + (and (not (empty? x)) (empty? y)) x + (and (empty? x) (not (empty? y))) y + :else "")) + (map (fn [elem] + (let [this (jquery (str "#" (dommy/attr elem :id)))] + (when (-> this (.prop "checked")) + (last (str/split (-> this (.prop "id")) "_"))))) + (.toArray (jquery selector)))) + "")) + +(defn form-fields-to-map [selector] + (let [form-name (str/replace (str/replace-first (first (str/split selector " ")) "#" "") "-" "_")] + (apply merge (for [x (jquery selector) + :when (not (empty? (.-name x)))] + {(str/replace (.-name x) (str form-name "-") "") (.-value x)})))) ;; notifications +(defn clear-notifications [] + (notifications {:message nil :errormsg nil})) + (defn notifications [jsonobj] (ck-notifications/reset-message (get jsonobj "message")) (ck-notifications/reset-errormsg (get jsonobj "errormsg"))) @@ -303,7 +379,7 @@ :aria-expanded "false"} @menu-user-label] [:div {:class "dropdown-menu" :aria-labelledby "button-menu-user"} - (for [menuitem @menu-user-state] + (for [menuitem (doall @menu-user-state)] [:a {:key (get menuitem "id") :class "dropdown-item" :on-click #(on-menu-clicked (get menuitem "handler"))} @@ -324,20 +400,19 @@ ;; home -(hiccups/defhtml template-home [jsonobj] - [:div - [:h2 {:style "text-align: center"} "Welcome To Carlos Konstanski's Music Studio"] - [:h3 {:style "text-align: center"} +(defn comp-home [] + [:div {:style {:display (cond (= @location-state "/home") "block" :else "none")}} + [:h2 {:style {:text-align "center"}} "Welcome To Carlos Konstanski's Music Studio"] + [:h3 {:style {:text-align "center"}} [:i "a.k.a. der Bogenherr" [:br] "a.k.a. Dr. Divertimento"]] - [:h2 {:style "text-align: center"} "Study the Violin, Viola and Viola d'Amore With Me!"] - [:div {:style "text-align: center"} - [:img {:style "width: 100%" + [:h2 {:style {:text-align "center"}} "Study the Violin, Viola and Viola d'Amore With Me!"] + [:div {:style {:text-align "center"}} + [:img {:style {:width "100%"} :src "/static/images/instrument-cabinet.jpg"}]]]) (defn handler-home [response] (let [jsonobj (js->clj (js/JSON.parse response))] - (notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#body) (template-home jsonobj)))) + (notifications jsonobj))) (defn render-home ([] @@ -351,16 +426,17 @@ ;; login -(hiccups/defhtml template-login [jsonobj] - [:h3 {:style "text-align: center"} (get jsonobj "title")] - (ck-form/template-generic-form (get jsonobj "form") (namespace ::x)) - [:div {:style "text-align: center"} - [:a {:href ""} "Forgot password?"]]) +(defn comp-login [] + [:div {:style {:display (cond (= @location-state "/login") "block" :else "none")}} + [:h3 {:style {:text-align "center"}} (get @login-state "title")] + [:div {:dangerouslySetInnerHTML (r/unsafe-html (ck-form/template-generic-form (get @login-state "form") (namespace ::x)))}] + [:div {:style {:text-align "center"}} + [:a {:href ""} "Forgot password?"]]]) (defn handler-login [response] (let [jsonobj (js->clj (js/JSON.parse response))] (notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#body) (template-login jsonobj)))) + (reset-login-state jsonobj))) (defn render-login [] (GET "/login" {:handler handler-login})) @@ -375,63 +451,54 @@ (defn handler-login-authenticate [response] (let [jsonobj (js->clj (js/JSON.parse response))] - (cond (get jsonobj "errormsg") - (goto-location "/login") - (get jsonobj "message") - (do - (reset-location "/home") - (render-home) - (render-menu))))) + (notifications jsonobj) + (reset-location "/home") + (render-menu) + (render-about-us-view))) (defn render-login-authenticate [] (POST "/login/authenticate" {:format :raw - :params {:username (dommy/value (dommy/sel1 :#username)) - :pwd (dommy/value (dommy/sel1 :#pwd))} + :params (form-fields-to-map "#login-form :input") :handler handler-login-authenticate})) ;; logout -(defn handler-logout [response] - (let [jsonobj (js->clj (js/JSON.parse response))] - (render-home "You are now logged out" "") - (reset-location "/home") - (render-menu))) - (defn render-logout [] - (GET "/logout" {:handler handler-logout})) + (GET "/logout" {:handler handler-login-authenticate})) ;; profile -(hiccups/defhtml template-profile [jsonobj] - [:h3 {:style "text-align: center"} (get jsonobj "title")] - [:div {:id "content"}] - [:div {:id "modify" - :class "modal fade" - :role "dialog" - :tabindex "-1"} - [:div {:class "modal-dialog modal-lg"} - [:div {:class "modal-content"} - [:div {:class "modal-header"} - [:h5 {:class "modal-title"} "Profile - Modify"] - [:button {:type "button" - :class "close" - :data-dismiss "modal"} - "×"]] - [:div {:id "modify-body" - :class "modal-body" - :style "height: 460px;"}] - [:div {:class "modal-footer"} - [:button {:type "submit" - :class "btn btn-danger btn-default" - :data-dismiss "modal"} - [:span {:class "glyphicon glyphicon-remove"}] - "Cancel"]]]]]) +(defn comp-profile [] + [:div {:style {:display (cond (= @location-state "/profile") "block" :else "none")}} + [:h3 {:style {:text-align "center"}} (get @profile-state "title")] + [comp-profile-view] + [:div {:id "modify-profile" + :class "modal fade" + :role "dialog" + :tab-index "-1"} + [:div {:class "modal-dialog modal-lg"} + [:div {:class "modal-content"} + [:div {:class "modal-header"} + [:h5 {:class "modal-title"} "Profile - Modify"] + [:button {:type "button" + :class "close" + :data-dismiss "modal"} + "X"]] + [:div {:class "modal-body" + :style {:height "460px"}} + [comp-profile-modify]] + [:div {:class "modal-footer"} + [:button {:type "submit" + :class "btn btn-danger btn-default" + :data-dismiss "modal"} + [:span {:class "glyphicon glyphicon-remove"}] + "Cancel"]]]]]]) (defn handler-profile [response] (let [jsonobj (js->clj (js/JSON.parse response))] + (reset-profile-state jsonobj) (notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#body) (template-profile jsonobj)) (render-profile-view))) (defn render-profile [] @@ -439,31 +506,42 @@ ;; profile-view -(hiccups/defhtml template-profile-view [jsonobj] - [:div {:style "text-align: right"} - [:img {:src "/static/images/edit.png" - :style "cursor:pointer; cursor:hand" - :onclick (str (namespace ::x) ".on_profile_modify_clicked()")}]] - [:div {:class "container"} - [:div {:class "row"} - [:div {:class "col" :style "text-align: right"} "Username:"] - [:div {:class "col-10"} (get jsonobj "username")]] - [:div {:class "row"} - [:div {:class "col" :style "text-align: right"} "First Name:"] - [:div {:class "col-10"} (get jsonobj "first_name")]] - [:div {:class "row"} - [:div {:class "col" :style "text-align: right"} "Last Name:"] - [:div {:class "col-10"} (get jsonobj "last_name")]] - [:div {:class "row"} - [:div {:class "col" :style "text-align: right"} "Email:"] - [:div {:class "col-10"} (get jsonobj "email")]] - [:div {:class "row"} - [:div {:class "col" :style "text-align: right"} "Phone:"] - [:div {:class "col-10"} (get jsonobj "phone")]]]) +(defn comp-profile-view [] + [:div + [:div {:style {:text-align "right"}} + [:img {:src "/static/images/edit.png" + :on-click #(on-profile-modify-clicked)}]] + (for [item (get @profile-view-state "items")] + [:div {:class "container"} + [:div {:class "row"} + [:div {:class "col" :style {:text-align "right"}} "Username:"] + [:div {:class "col-10" + :key (str "profile-view-username-" (get item "id"))} + (get item "username")]] + [:div {:class "row"} + [:div {:class "col" :style {:text-align "right"}} "First Name:"] + [:div {:class "col-10" + :key (str "profile-view-first_name-" (get item "id"))} + (get item "first_name")]] + [:div {:class "row"} + [:div {:class "col" :style {:text-align "right"}} "Last Name:"] + [:div {:class "col-10" + :key (str "profile-view-last_name-" (get item "id"))} + (get item "last_name")]] + [:div {:class "row"} + [:div {:class "col" :style {:text-align "right"}} "Email:"] + [:div {:class "col-10" + :key (str "profile-view-email-" (get item "id"))} + (get item "email")]] + [:div {:class "row"} + [:div {:class "col" :style {:text-align "right"}} "Phone:"] + [:div {:class "col-10" + :key (str "profile-view-phone-" (get item "id"))} + (get item "phone")]]])]) (defn handler-profile-view [response] (let [jsonobj (js->clj (js/JSON.parse response))] - (dommy/set-html! (dommy/sel1 :#content) (template-profile-view jsonobj)))) + (reset-profile-view-state jsonobj))) (defn render-profile-view [] (GET "/profile/view" {:handler handler-profile-view})) @@ -473,14 +551,13 @@ (defn on-profile-modify-clicked [] (render-profile-modify)) -(hiccups/defhtml template-profile-modify [jsonobj] - (ck-form/template-generic-form (get jsonobj "form") (namespace ::x))) +(defn comp-profile-modify [] + [:div {:dangerouslySetInnerHTML (r/unsafe-html (ck-form/template-generic-form (get @profile-modify-state "form") (namespace ::x)))}]) (defn handler-profile-modify [response] (let [jsonobj (js->clj (js/JSON.parse response))] - (auth-notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#modify-body) (template-profile-modify jsonobj)) - (.modal (jquery "#modify")))) + (reset-profile-modify-state jsonobj) + (.modal (jquery "#modify-profile")))) (defn render-profile-modify [] (POST "/profile/modify" {:handler handler-profile-modify})) @@ -491,35 +568,30 @@ (when (-> (jquery "#profile-modify-form") (.get "0") (.checkValidity)) - (.modal (jquery "#modify") "hide") + (.modal (jquery "#modify-profile") "hide") (render-profile-modify-submit))) (defn handler-profile-modify-submit [response] (let [jsonobj (js->clj (js/JSON.parse response))] (auth-notifications jsonobj) - (on-menu-clicked "/profile"))) + (render-profile-view))) (defn render-profile-modify-submit [] (POST "/profile/modify/submit" {:format :raw - :params {:id (dommy/value (dommy/sel1 :#id)) - :username (dommy/value (dommy/sel1 :#username)) - :first_name (dommy/value (dommy/sel1 :#first_name)) - :last_name (dommy/value (dommy/sel1 :#last_name)) - :email (dommy/value (dommy/sel1 :#email)) - :phone (dommy/value (dommy/sel1 :#phone))} + :params (form-fields-to-map "#profile-modify-form :input") :handler handler-profile-modify-submit})) ;; password -(hiccups/defhtml template-password [jsonobj] - [:h3 {:style "text-align: center"} (get jsonobj "title")] - (ck-form/template-generic-form (get jsonobj "form") (namespace ::x))) +(defn comp-password [jsonobj] + [:div {:style {:display (cond (= @location-state "/password") "block" :else "none")}} + [:h3 {:style {:text-align "center"}} (get @password-state "title")] + [:div {:dangerouslySetInnerHTML (r/unsafe-html (ck-form/template-generic-form (get @password-state "form") (namespace ::x)))}]]) (defn handler-password [response] (let [jsonobj (js->clj (js/JSON.parse response))] - (notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#body) (template-password jsonobj)))) + (reset-password-state jsonobj))) (defn render-password [] (GET "/password" {:handler handler-password})) @@ -534,52 +606,57 @@ (defn handler-password-submit [response] (let [jsonobj (js->clj (js/JSON.parse response))] - (auth-notifications jsonobj) - (on-menu-clicked "/password"))) + (notifications jsonobj) + (render-password))) (defn render-password-submit [] (POST "/password/submit" {:format :raw - :params {:id (dommy/value (dommy/sel1 :#id)) - :pwd (dommy/value (dommy/sel1 :#pwd)) - :pwd2 (dommy/value (dommy/sel1 :#pwd2))} + :params (form-fields-to-map "#password-form :input") :handler handler-password-submit})) ;; about-us (lessons, gigs, programming) -(hiccups/defhtml template-about-us [jsonobj] - [:h1 {:style "text-align: center"} - (cond (= @about-us-category-state "lessons") "About the Studio" - (= @about-us-category-state "gigs") "Hire Me to Play" - (= @about-us-category-state "programming") "Hire Me to Write Software")] - [:div {:id "content"}] - [:div {:id "modify" - :class "modal fade" - :role "dialog" - :tabindex "-1"} - [:div {:class "modal-dialog modal-lg"} - [:div {:class "modal-content"} - [:div {:class "modal-header"} - [:h5 [:span {:id "modify-title"}]] - [:button {:type "button" - :class "close" - :data-dismiss "modal"} - "×"]] - [:div {:id "modify-body" - :class "modal-body" - :style "height: 460px;"}] - [:div {:class "modal-footer"} - [:button {:type "submit" - :class "btn btn-danger btn-default" - :data-dismiss "modal"} - [:span {:class "glyphicon glyphicon-remove"}] - "Cancel"]]]]]) +(defn comp-about-us [] + [:div {:style {:display (cond (or (= @location-state "/lessons") + (= @location-state "/gigs") + (= @location-state "/programming")) + "block" + :else "none")}} + [:h3 {:style {:text-align "center"}} + (cond (= @about-us-category-state "lessons") "About the Studio") + (cond (= @about-us-category-state "gigs") "Hire Me to Play") + (cond (= @about-us-category-state "programming") "Software Consulting")] + [comp-about-us-view] + [:div {:id "modify-about-us" + :class "modal fade" + :role "dialog" + :tab-index "-1"} + [:div {:class "modal-dialog modal-lg"} + [:div {:class "modal-content"} + [:div {:class "modal-header"} + [:h5 (str (cond (= @about-us-category-state "lessons") "About the Studio") + (cond (= @about-us-category-state "gigs") "Hire Me to Play") + (cond (= @about-us-category-state "programming") "Software Consulting") " - Modify")] + [:button {:type "button" + :class "close" + :data-dismiss "modal"} + "X"]] + [:div {:class "modal-body" + :style {:height "460px"}} + [comp-about-us-modify]] + [:div {:class "modal-footer"} + [:button {:type "submit" + :class "btn btn-danger btn-default" + :data-dismiss "modal"} + [:span {:class "glyphicon glyphicon-remove"}] + "Cancel"]]]]]]) (defn handler-about-us [response] (let [jsonobj (js->clj (js/JSON.parse response))] - (reset-about-us-category (get jsonobj "category")) (notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#body) (template-about-us jsonobj)) + (reset-about-us-category-state (get jsonobj "category")) + (reset-about-us-state jsonobj) (render-about-us-view))) (defn render-lessons [] @@ -593,18 +670,17 @@ ;; about-us-view -(hiccups/defhtml template-about-us-view [jsonobj] - (when (get jsonobj "adminP") - [:div {:style "text-align: right;"} - [:img {:src "/static/images/edit.png" - :style "cursor:pointer; cursor:hand" - :onclick (str (namespace ::x) ".on_about_us_modify_clicked()")}]]) - [:div {:id "markdown"}]) +(defn comp-about-us-view [] + [:div + (when (get @about-us-view-state "adminP") + [:div {:style {:text-align "right"}} + [:img {:src "/static/images/edit.png" + :on-click #(on-about-us-modify-clicked)}]]) + [:div {:dangerouslySetInnerHTML (r/unsafe-html (markdown-to-html (get @about-us-view-state "content")))}]]) (defn handler-about-us-view [response] (let [jsonobj (js->clj (js/JSON.parse response))] - (dommy/set-html! (dommy/sel1 :#content) (template-about-us-view jsonobj)) - (dommy/set-html! (dommy/sel1 :#markdown) (markdown-to-html (get jsonobj "content"))))) + (reset-about-us-view-state jsonobj))) (defn render-about-us-view [] (GET (str "/" @about-us-category-state "/view") @@ -615,19 +691,13 @@ (defn on-about-us-modify-clicked [] (render-about-us-modify)) -(hiccups/defhtml template-about-us-modify [jsonobj] - (ck-form/template-generic-form (get jsonobj "form") (namespace ::x))) +(defn comp-about-us-modify [] + [:div {:dangerouslySetInnerHTML (r/unsafe-html (ck-form/template-generic-form (get @about-us-modify-state "form") (namespace ::x)))}]) (defn handler-about-us-modify [response] (let [jsonobj (js->clj (js/JSON.parse response))] - (auth-notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#modify-title) - (str (cond (= @about-us-category-state "lessons") "About the Studio" - (= @about-us-category-state "gigs") "For Hire" - (= @about-us-category-state "programming") "Software Consulting") - " - Modify")) - (dommy/set-html! (dommy/sel1 :#modify-body) (template-about-us-modify jsonobj)) - (.modal (jquery "#modify")))) + (reset-about-us-modify-state jsonobj) + (.modal (jquery "#modify-about-us")))) (defn render-about-us-modify [] (POST (str "/" @about-us-category-state "/modify") @@ -639,72 +709,93 @@ (when (-> (jquery "#about-us-modify-form") (.get "0") (.checkValidity)) - (.modal (jquery "#modify") "hide") + (.modal (jquery "#modify-about-us") "hide") (render-about-us-modify-submit))) (defn handler-about-us-modify-submit [response] (let [jsonobj (js->clj (js/JSON.parse response))] (auth-notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#content) (template-about-us-view jsonobj)) - (dommy/set-html! (dommy/sel1 :#markdown) (markdown-to-html (get jsonobj "content"))))) + (render-about-us-view))) (defn render-about-us-modify-submit [] (POST (str "/" @about-us-category-state "/modify/submit") {:format :raw - :params {:content (dommy/value (dommy/sel1 :#txt-content))} + :params (form-fields-to-map "#about-us-modify-form :input") :handler handler-about-us-modify-submit})) ;; gallery -(hiccups/defhtml template-gallery [jsonobj] - [:h1 {:style "text-align: center"} "Gallery"] - [:div {:id "content"}] - [:div {:id "image" - :class "modal fade" - :role "dialog" - :tabindex "-1"} - [:div {:class "modal-dialog modal-lg mw-100 w-75"} - [:div {:class "modal-content"} - [:div {:class "modal-header"} - [:button {:type "button" - :class "close" - :data-dismiss "modal"} - "×"]] - [:div {:id "image-body" - :class "modal-body" - :style "width: 100%"}] - [:div {:class "modal-footer"} - [:button {:type "submit" - :class "btn btn-danger btn-default" - :data-dismiss "modal"} - [:span {:class "glyphicon glyphicon-remove"}] - "Close"]]]]] - [:div {:id "modify" - :class "modal fade" - :role "dialog" - :tabindex "-1"} - [:div {:class "modal-dialog modal-lg"} - [:div {:class "modal-content"} - [:div {:class "modal-header"} - [:h5 [:span {:id "modify-title"}]] - [:button {:type "button" - :class "close" - :data-dismiss "modal"} - "×"]] - [:div {:id "modify-body" - :class "modal-body" - :style "height: 425px;"}] - [:div {:class "modal-footer"} - [:button {:type "submit" - :class "btn btn-danger btn-default" - :data-dismiss "modal"} - [:span {:class "glyphicon glyphicon-remove"}] - "Cancel"]]]]]) +(defn comp-gallery [] + [:div {:style {:display (cond (= @location-state "/gallery") "block" :else "none")}} + [:h1 {:style {:text-align "center"}} "Gallery"] + [comp-gallery-view] + [:div {:id "modal-gallery-image" + :class "modal fade" + :role "dialog" + :tabindex "-1"} + [:div {:class "modal-dialog modal-lg mw-100 w-75"} + [:div {:class "modal-content"} + [:div {:class "modal-header"} + [:button {:type "button" + :class "close" + :data-dismiss "modal"} + "X"]] + [:div {:class "modal-body" + :style {:width "100%"}} + [comp-gallery-image]] + [:div {:class "modal-footer"} + [:button {:type "submit" + :class "btn btn-danger btn-default" + :data-dismiss "modal"} + [:span {:class "glyphicon glyphicon-remove"}] + "Close"]]]]] + [:div {:id "modal-gallery-add" + :class "modal fade" + :role "dialog" + :tabindex "-1"} + [:div {:class "modal-dialog modal-lg"} + [:div {:class "modal-content"} + [:div {:class "modal-header"} + [:h5 (str (get @gallery-state "title") " - Add")] + [:button {:type "button" + :class "close" + :data-dismiss "modal"} + "X"]] + [:div {:class "modal-body" + :style {:height "425px"}} + [comp-gallery-add]] + [:div {:class "modal-footer"} + [:button {:type "submit" + :class "btn btn-danger btn-default" + :data-dismiss "modal"} + [:span {:class "glyphicon glyphicon-remove"}] + "Cancel"]]]]] + [:div {:id "modal-gallery-modify" + :class "modal fade" + :role "dialog" + :tabindex "-1"} + [:div {:class "modal-dialog modal-lg"} + [:div {:class "modal-content"} + [:div {:class "modal-header"} + [:h5 (str (get @gallery-state "title") " - Add")] + [:button {:type "button" + :class "close" + :data-dismiss "modal"} + "X"]] + [:div {:class "modal-body" + :style {:height "425px"}} + [comp-gallery-modify]] + [:div {:class "modal-footer"} + [:button {:type "submit" + :class "btn btn-danger btn-default" + :data-dismiss "modal"} + [:span {:class "glyphicon glyphicon-remove"}] + "Cancel"]]]]]]) (defn handler-gallery [response] (let [jsonobj (js->clj (js/JSON.parse response))] - (auth-notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#body) (template-gallery jsonobj)) + (notifications jsonobj) + (reset-gallery-state jsonobj) (render-gallery-view))) (defn render-gallery [] @@ -712,60 +803,59 @@ ;; gallery-view -(hiccups/defhtml template-gallery-view [jsonobj] - [:div {:style "text-align: right"} - (when (get jsonobj "adminP") - [:img {:src "/static/images/add.png" - :style "cursor:pointer; cursor:hand" - :onclick (str (namespace ::x) ".on_gallery_add_clicked()")}])] - (let [results (get jsonobj "results")] - (cond (empty? results) - [:h5 {:style "text-align: center"} "No results found."] - :else - (for [rec results] - [:span {:style "width:720px; height:425px"} - [:table - [:tr - [:td - (cond (not (= (get rec "video_embed_url") "null")) - [:iframe {:width "720" - :height "405" - :src (get rec "video_embed_url") - :frameborder "0" - :allow "accelerometer; autoplay; clipboard-write; encrypted-media; gyroscope; picture-in-picture; web-share" - :referrerpolicy "strict-origin-when-cross-origin" - :allowfullscreen "allowfullscreen"}] - :else - (let [img-src (str "/gallery/file/view/" (get rec "id"))] - [:img {:style "height:405px; cursor:pointer; cursor:hand" - :src img-src - :onclick (str (namespace ::x) ".on_gallery_image_clicked('" img-src "')")}]))] - (when (get jsonobj "adminP") - [:td {:style "text-align:right; vertical-align:top"} - [:img {:src "/static/images/edit.png" - :onclick (str (namespace ::x) ".on_gallery_modify_clicked(" (get rec "id") ")")}] - [:br] - [:img {:src "/static/images/delete.png" - :onclick (str (namespace ::x) ".on_gallery_delete_clicked(" (get rec "id") ")")}]])] - [:tr - [:td (get rec "description")]] - [:tr - [:td " "]] - [:tr - [:td " "]]]])))) - -(hiccups/defhtml template-gallery-image-fullscreen [src] - [:img {:src src - :style "width: 100%"}]) +(defn comp-gallery-view [] + [:div + [:div {:style {:text-align "right"}} + (when (get @gallery-view-state "adminP") + [:img {:src "/static/images/add.png" + :on-click #(on-gallery-add-clicked)}])] + (let [results (get @gallery-view-state "results")] + (cond (empty? results) + [:h5 {:style {:text-align "center"}} "No results found."] + :else + (for [rec results] + [:span {:style {:width "720px" :height "425px"}} + [:table + [:tr + [:td + (cond (not (= (get rec "video_embed_url") "null")) + [:iframe {:width "720" + :height "405" + :src (get rec "video_embed_url") + :frameborder "0" + :allow "accelerometer; autoplay; clipboard-write; encrypted-media; gyroscope; picture-in-picture; web-share" + :referrerpolicy "strict-origin-when-cross-origin" + :allowfullscreen "allowfullscreen"}] + :else + (let [img-src (str "/gallery/file/view/" (get rec "id"))] + [:img {:style {:height "405px"} + :src img-src + :on-click #(on-gallery-image-clicked img-src)}]))] + (when (get @gallery-view-state "adminP") + [:td {:style {:text-align "right" :vertical-align "top"}} + [:img {:src "/static/images/edit.png" + :on-click #(on-gallery-modify-clicked (get rec "id"))}] + [:br] + [:img {:src "/static/images/delete.png" + :on-click #(on-gallery-delete-clicked (get rec "id"))}]])] + [:tr + [:td (get rec "description")]] + [:tr + [:td " "]] + [:tr + [:td " "]]]])))]) (defn on-gallery-image-clicked [src] - (dommy/set-html! (dommy/sel1 :#image-body) (template-gallery-image-fullscreen src)) - (.modal (jquery "#image"))) + (reset-gallery-image-state src) + (.modal (jquery "#modal-gallery-image"))) + +(defn comp-gallery-image [] + [:img {:src @gallery-image-state + :style {:width "100%"}}]) (defn handler-gallery-view [response] (let [jsonobj (js->clj (js/JSON.parse response))] - (auth-notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#content) (template-gallery-view jsonobj)))) + (reset-gallery-view-state jsonobj))) (defn render-gallery-view [] (GET "/gallery/view" {:handler handler-gallery-view})) @@ -775,15 +865,13 @@ (defn on-gallery-add-clicked [] (render-gallery-add)) -(hiccups/defhtml template-gallery-add [jsonobj] - (ck-form/template-generic-form (get jsonobj "form") (namespace ::x))) +(defn comp-gallery-add [] + [:div {:dangerouslySetInnerHTML (r/unsafe-html (ck-form/template-generic-form (get @gallery-add-state "form") (namespace ::x)))}]) (defn handler-gallery-add [response] (let [jsonobj (js->clj (js/JSON.parse response))] - (auth-notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#modify-title) "Gallery - Add") - (dommy/set-html! (dommy/sel1 :#modify-body) (template-gallery-add jsonobj)) - (.modal (jquery "#modify")))) + (reset-gallery-add-state jsonobj) + (.modal (jquery "#modal-gallery-add")))) (defn render-gallery-add [] (POST "/gallery/add" {:handler handler-gallery-add})) @@ -794,13 +882,13 @@ (when (-> (jquery "#gallery-add-form") (.get "0") (.checkValidity)) - (.modal (jquery "#modify") "hide") + (.modal (jquery "#modal-gallery-add") "hide") (render-gallery-add-submit))) (defn handler-gallery-add-submit [response] (let [jsonobj (js->clj (js/JSON.parse response))] (auth-notifications jsonobj) - (on-menu-clicked "/gallery"))) + (render-gallery-view))) (defn render-gallery-add-submit [] (let [form-data (js/FormData. (dommy/sel1 :#gallery-add-form))] @@ -814,15 +902,13 @@ (defn on-gallery-modify-clicked [id] (render-gallery-modify id)) -(hiccups/defhtml template-gallery-modify [jsonobj] - (ck-form/template-generic-form (get jsonobj "form") (namespace ::x))) +(defn comp-gallery-modify [jsonobj] + [:div {:dangerouslySetInnerHTML (r/unsafe-html (ck-form/template-generic-form (get @gallery-modify-state "form") (namespace ::x)))}]) (defn handler-gallery-modify [response] (let [jsonobj (js->clj (js/JSON.parse response))] - (auth-notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#modify-title) "Gallery - Modify") - (dommy/set-html! (dommy/sel1 :#modify-body) (template-gallery-modify jsonobj)) - (.modal (jquery "#modify")))) + (reset-gallery-modify-state jsonobj) + (.modal (jquery "#modal-gallery-modify")))) (defn render-gallery-modify [id] (POST "/gallery/modify" @@ -836,13 +922,13 @@ (when (-> (jquery "#gallery-modify-form") (.get "0") (.checkValidity)) - (.modal (jquery "#modify") "hide") + (.modal (jquery "#modal-gallery-modify") "hide") (render-gallery-modify-submit))) (defn handler-gallery-modify-submit [response] (let [jsonobj (js->clj (js/JSON.parse response))] (auth-notifications jsonobj) - (on-menu-clicked "/gallery"))) + (render-gallery-view))) (defn render-gallery-modify-submit [] (let [form-data (js/FormData. (dommy/sel1 :#gallery-modify-form))] @@ -860,126 +946,132 @@ (defn handler-gallery-delete [response] (let [jsonobj (js->clj (js/JSON.parse response))] (auth-notifications jsonobj) - (on-menu-clicked "/gallery"))) + (render-gallery-view))) (defn render-gallery-delete [id] (DELETE (str "/gallery/delete/" id) {:format :raw :handler handler-gallery-delete})) -;; testimonials - -(hiccups/defhtml template-testimonials [jsonobj] - [:h3 {:style "text-align: center"} (get jsonobj "title")] - [:div {:id "content"}] - [:div {:id "modify" - :class "modal fade" - :role "dialog" - :tabindex "-1"} - [:div {:class "modal-dialog modal-lg"} - [:div {:class "modal-content"} - [:div {:class "modal-header"} - [:h5 [:span {:id "modify-title"}]] - [:button {:type "button" - :class "close" - :data-dismiss "modal"} - "×"]] - [:div {:id "modify-body" - :class "modal-body" - :style "height: 460px;"}] - [:div {:class "modal-footer"} - [:button {:type "submit" - :class "btn btn-danger btn-default" - :data-dismiss "modal"} - [:span {:class "glyphicon glyphicon-remove"}] - "Cancel"]]]]]) - -(defn handler-testimonials [response] - (let [jsonobj (js->clj (js/JSON.parse response))] - (notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#body) (template-testimonials jsonobj)) - (render-testimonials-view))) - -(defn render-testimonials [] - (GET "/testimonials" {:handler handler-testimonials})) - -;; testimonials-view - -(hiccups/defhtml template-testimonials-view [jsonobj] - (when (get jsonobj "adminP") - [:div {:style "text-align: right;"} - [:img {:src "/static/images/edit.png" - :style "cursor:pointer; cursor:hand" - :onclick (str (namespace ::x) ".on_testimonials_modify_clicked()")}]]) - [:div {:id "markdown"}]) - -(defn handler-testimonials-view [response] - (let [jsonobj (js->clj (js/JSON.parse response))] - (dommy/set-html! (dommy/sel1 :#content) (template-testimonials-view jsonobj)) - (dommy/set-html! (dommy/sel1 :#markdown) (markdown-to-html (get jsonobj "content"))))) - -(defn render-testimonials-view [] - (GET "/testimonials/view" {:handler handler-testimonials-view})) - -;; testimonials-modify - -(defn on-testimonials-modify-clicked [] - (render-testimonials-modify)) - -(hiccups/defhtml template-testimonials-modify [jsonobj] - (ck-form/template-generic-form (get jsonobj "form") (namespace ::x))) - -(defn handler-testimonials-modify [response] - (let [jsonobj (js->clj (js/JSON.parse response))] - (auth-notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#modify-title) (get jsonobj "title")) - (dommy/set-html! (dommy/sel1 :#modify-body) (template-testimonials-modify jsonobj)) - (.modal (jquery "#modify")))) - -(defn render-testimonials-modify [] - (POST "/testimonials/modify" {:handler handler-testimonials-modify})) - -;; testimonials-modify-submit - -(defn on-testimonials-modify-submit-clicked [] - (when (-> (jquery "#testimonials-modify-form") - (.get "0") - (.checkValidity)) - (.modal (jquery "#modify") "hide") - (render-testimonials-modify-submit))) - -(defn handler-testimonials-modify-submit [response] - (let [jsonobj (js->clj (js/JSON.parse response))] - (auth-notifications jsonobj) - (on-menu-clicked "/testimonials"))) - -(defn render-testimonials-modify-submit [] - (POST "/testimonials/modify/submit" - {:format :raw - :params {:content (dommy/value (dommy/sel1 :#txt-content))} - :handler handler-testimonials-modify-submit})) +;; ;; testimonials + +;; (hiccups/defhtml template-testimonials [jsonobj] +;; [:h3 {:style "text-align: center"} (get jsonobj "title")] +;; [:div {:id "content"}] +;; [:div {:id "modify" +;; :class "modal fade" +;; :role "dialog" +;; :tabindex "-1"} +;; [:div {:class "modal-dialog modal-lg"} +;; [:div {:class "modal-content"} +;; [:div {:class "modal-header"} +;; [:h5 [:span {:id "modify-title"}]] +;; [:button {:type "button" +;; :class "close" +;; :data-dismiss "modal"} +;; "×"]] +;; [:div {:id "modify-body" +;; :class "modal-body" +;; :style "height: 460px;"}] +;; [:div {:class "modal-footer"} +;; [:button {:type "submit" +;; :class "btn btn-danger btn-default" +;; :data-dismiss "modal"} +;; [:span {:class "glyphicon glyphicon-remove"}] +;; "Cancel"]]]]]) + +;; (defn handler-testimonials [response] +;; (let [jsonobj (js->clj (js/JSON.parse response))] +;; (notifications jsonobj) +;; (dommy/set-html! (dommy/sel1 :#body) (template-testimonials jsonobj)) +;; (render-testimonials-view))) + +;; (defn render-testimonials [] +;; (GET "/testimonials" {:handler handler-testimonials})) + +;; ;; testimonials-view + +;; (hiccups/defhtml template-testimonials-view [jsonobj] +;; (when (get jsonobj "adminP") +;; [:div {:style "text-align: right;"} +;; [:img {:src "/static/images/edit.png" +;; :style "cursor:pointer; cursor:hand" +;; :onclick (str (namespace ::x) ".on_testimonials_modify_clicked()")}]]) +;; [:div {:id "markdown"}]) + +;; (defn handler-testimonials-view [response] +;; (let [jsonobj (js->clj (js/JSON.parse response))] +;; (dommy/set-html! (dommy/sel1 :#content) (template-testimonials-view jsonobj)) +;; (dommy/set-html! (dommy/sel1 :#markdown) (markdown-to-html (get jsonobj "content"))))) + +;; (defn render-testimonials-view [] +;; (GET "/testimonials/view" {:handler handler-testimonials-view})) + +;; ;; testimonials-modify + +;; (defn on-testimonials-modify-clicked [] +;; (render-testimonials-modify)) + +;; (hiccups/defhtml template-testimonials-modify [jsonobj] +;; (ck-form/template-generic-form (get jsonobj "form") (namespace ::x))) + +;; (defn handler-testimonials-modify [response] +;; (let [jsonobj (js->clj (js/JSON.parse response))] +;; (auth-notifications jsonobj) +;; (dommy/set-html! (dommy/sel1 :#modify-title) (get jsonobj "title")) +;; (dommy/set-html! (dommy/sel1 :#modify-body) (template-testimonials-modify jsonobj)) +;; (.modal (jquery "#modify")))) + +;; (defn render-testimonials-modify [] +;; (POST "/testimonials/modify" {:handler handler-testimonials-modify})) + +;; ;; testimonials-modify-submit + +;; (defn on-testimonials-modify-submit-clicked [] +;; (when (-> (jquery "#testimonials-modify-form") +;; (.get "0") +;; (.checkValidity)) +;; (.modal (jquery "#modify") "hide") +;; (render-testimonials-modify-submit))) + +;; (defn handler-testimonials-modify-submit [response] +;; (let [jsonobj (js->clj (js/JSON.parse response))] +;; (auth-notifications jsonobj) +;; (on-menu-clicked "/testimonials"))) + +;; (defn render-testimonials-modify-submit [] +;; (POST "/testimonials/modify/submit" +;; {:format :raw +;; :params {:content (dommy/value (dommy/sel1 :#txt-content))} +;; :handler handler-testimonials-modify-submit})) ;; contact-us -(hiccups/defhtml template-contact-us [jsonobj] - [:h1 {:style "text-align: center"} "Reach out to me by filling out the form."] - [:div {:id "content"}] - [:table {:width "100%"} - [:tr - [:td {:style "width: 100%; text-align: center;"} - [:h3 "Located on the edge of the ISU campus!"]]] - [:tr - [:td {:style "width: 100%; text-align: center;"} - [:iframe {:src "https://www.google.com/maps/embed?pb=!1m18!1m12!1m3!1d3225.263770603599!2d-112.4266916!3d42.8635091!2m3!1f0!2f0!3f0!3m2!1i1024!2i768!4f13.1!3m3!1m2!1s0x53554f343c440407%3A0xf13bf897ecb4f7e0!2sBogenherr%20Violin%20and%20Viola%20Studio!5e1!3m2!1sen!2sus!4v1783097048097!5m2!1sen!2sus" - :style "width: 600px; height: 450px; border: 0px;" - :allowfullscreen "" - :loading "lazy" - :referrerpolicy "strict-origin-when-cross-origin"}]]]]) +(defn comp-contact-us [] + [:div {:style {:display (cond (= @location-state "/contact-us") "block" :else "none")}} + [:h3 {:style {:text-align "center"}} "Reach out to me by filling out the form."] + [comp-contact-us-view] + [:table {:width "100%"} + [:tbody + [:tr + [:td {:style {:width "100%" + :text-align "center"}} + [:h3 "Located on the edge of the ISU campus!"]]] + [:tr + [:td {:style {:width "100%" + :text-align "center"}} + [:iframe {:src "https://www.google.com/maps/embed?pb=!1m18!1m12!1m3!1d3225.263770603599!2d-112.4266916!3d42.8635091!2m3!1f0!2f0!3f0!3m2!1i1024!2i768!4f13.1!3m3!1m2!1s0x53554f343c440407%3A0xf13bf897ecb4f7e0!2sBogenherr%20Violin%20and%20Viola%20Studio!5e1!3m2!1sen!2sus!4v1783097048097!5m2!1sen!2sus" + :style {:width "600px" + :height "450px" + :border "0px"} + :allowfullscreen "" + :loading "lazy" + :referrerpolicy "strict-origin-when-cross-origin"}]]]]]]) (defn handler-contact-us [response] (let [jsonobj (js->clj (js/JSON.parse response))] (notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#body) (template-contact-us jsonobj)) + (reset-contact-us-state jsonobj) (render-contact-us-view))) (defn render-contact-us [] @@ -987,13 +1079,12 @@ ;; contact-us-view -(hiccups/defhtml template-contact-us-view [jsonobj] - (ck-form/template-generic-form (get jsonobj "form") (namespace ::x))) +(defn comp-contact-us-view [] + [:div {:dangerouslySetInnerHTML (r/unsafe-html (ck-form/template-generic-form (get @contact-us-view-state "form") (namespace ::x)))}]) (defn handler-contact-us-view [response] (let [jsonobj (js->clj (js/JSON.parse response))] - (notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#content) (template-contact-us-view jsonobj)))) + (reset-contact-us-view-state jsonobj))) (defn render-contact-us-view [] (GET "/contact-us/view" {:handler handler-contact-us-view})) @@ -1007,89 +1098,85 @@ (render-contact-us-email-submit))) (defn handler-contact-us-email-submit [response] - (on-menu-clicked "/contact-us")) + (render-contact-us-view)) (defn render-contact-us-email-submit [] (POST "/contact-us/email" {:format :raw - :params {:first_name (dommy/value (dommy/sel1 :#first_name)) - :last_name (dommy/value (dommy/sel1 :#last_name)) - :email (dommy/value (dommy/sel1 :#email)) - :phone (dommy/value (dommy/sel1 :#phone)) - :comments (dommy/value (dommy/sel1 :#comments))} + :params (form-fields-to-map "#contact-us-form :input") :handler handler-contact-us-email-submit})) ;; messages -(hiccups/defhtml template-messages [jsonobj] - [:h3 {:style "text-align: center"} (get jsonobj "title")] - (ck-form/template-generic-form (get jsonobj "form") (namespace ::x)) - [:div {:id "results"}]) +(defn comp-messages [] + [:div {:style {:display (cond (= @location-state "/messages") "block" :else "none")}} + [:h3 {:style {:text-align "center"}} (get @messages-state "title")] + [:div {:dangerouslySetInnerHTML (r/unsafe-html (ck-form/template-generic-form (get @messages-state "form") (namespace ::x)))}] + [comp-messages-view]]) (defn handler-messages [response] (let [jsonobj (js->clj (js/JSON.parse response))] (notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#body) (template-messages jsonobj)) - (when (not (empty? (dommy/value (dommy/sel1 :#read)))) - (render-messages-results)))) + (reset-messages-state jsonobj) + (render-messages-view))) (defn render-messages [] (GET "/messages" {:handler handler-messages})) ;; messages-results -(defn on-messages-mode-clicked [read] - (dommy/set-value! (dommy/sel1 :#read) read) - (render-messages-results)) - -(hiccups/defhtml template-messages-results [jsonobj] - (let [results (get jsonobj "results") +(defn comp-messages-view [] + (let [results (get @messages-view-state "results") keys (remove (fn [x] (not (get (first results) x))) (keys (first results)))] - (cond (empty? results) - [:h5 {:style "text-align: center"} "No results found."] - :else - [:table {:class "table table-hover"} - [:thead - [:tr - (for [key keys] - [:th key]) - [:th - (str "Mark " (cond (= (dommy/value (dommy/sel1 :#read)) "read") - "unread" - :else - "read"))]]] - [:tbody - (for [rec results] - (let [onclick "void()"] - [:tr - (for [key keys] - [:td {:onclick onclick} (get rec key)]) - [:td [:img {:src (str "/static/images/" - (cond (= (dommy/value (dommy/sel1 :#read)) "read") - "edit-undo.png" - :else - "edit-redo.png")) - :style "cursor: pointer; cursor: hand" - :onclick (str (namespace ::x) - ".on_messages_mark(" - (cond (= (dommy/value (dommy/sel1 :#read)) "read") - "'unread'" - :else - "'read'") - "," (get rec "id") ")")}]]]))]]))) - -(defn handler-messages-results [response] + [:div + [:h3 {:style {:text-align "center"}} (str @messages-mode-state " messages")] + (cond (empty? results) + [:h5 {:style {:text-align "center"}} "No results found."] + :else + [:table {:class "table table-hover"} + [:thead + [:tr + (for [key keys] + [:th key]) + [:th + (str "Mark " (cond (= @messages-mode-state "read") + "unread" + :else + "read"))]]] + [:tbody + (for [rec results] + [:tr {:key (str "messages-select-mode-" (get rec "id"))} + (for [key keys] + [:td (get rec key)]) + [:td [:img {:src (str "/static/images/" + (cond (= @messages-mode-state "read") + "edit-undo.png" + :else + "edit-redo.png")) + :on-click #(on-messages-mark (cond (= @messages-mode-state "read") + "unread" + :else + "read") + (get rec "id"))}]]])]])])) + +(defn handler-messages-view [response] (let [jsonobj (js->clj (js/JSON.parse response))] - (auth-notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#results) (template-messages-results jsonobj)))) + (reset-messages-view-state jsonobj))) -(defn render-messages-results [] - (POST "/messages/results" +(defn render-messages-view [] + (POST "/messages/view" {:format :raw - :params {:read (dommy/value (dommy/sel1 :#read))} - :handler handler-messages-results})) + :params {:read @messages-mode-state} + :handler handler-messages-view})) + +;; messages-read/unread + +(defn on-messages-mode-clicked [mode] + (clear-notifications) + (reset-messages-mode-state mode) + (render-messages-view)) ;; messages-mark @@ -1099,46 +1186,68 @@ (defn handler-messages-mark [response] (let [jsonobj (js->clj (js/JSON.parse response))] (auth-notifications jsonobj) - (on-menu-clicked "/messages"))) + (render-messages-view))) (defn render-messages-mark [read id] (POST "/messages/mark" {:format :raw :params {:read read - :id id} + :id (str id)} :handler handler-messages-mark})) ;; users -(hiccups/defhtml template-users [jsonobj] - [:h3 {:style "text-align: center"} (get jsonobj "title")] - [:div {:id "content"}] - [:div {:id "modify" - :class "modal fade" - :role "dialog" - :tabindex "-1"} - [:div {:class "modal-dialog modal-lg"} - [:div {:class "modal-content"} - [:div {:class "modal-header"} - [:h5 [:span {:id "modify-title"}]] - [:button {:type "button" - :class "close" - :data-dismiss "modal"} - "×"]] - [:div {:id "modify-body" - :class "modal-body" - :style "height: 450px;"}] - [:div {:class "modal-footer"} - [:button {:type "submit" - :class "btn btn-danger btn-default" - :data-dismiss "modal"} - [:span {:class "glyphicon glyphicon-remove"}] - "Cancel"]]]]]) +(defn comp-users [] + [:div {:style {:display (cond (= @location-state "/users") "block" :else "none")}} + [:h3 {:style {:text-align "center"}} (get @users-state "title")] + [comp-users-view] + [:div {:id "modal-users-add" + :class "modal fade" + :role "dialog" + :tab-index "-1"} + [:div {:class "modal-dialog modal-lg"} + [:div {:class "modal-content"} + [:div {:class "modal-header"} + [:h5 (get @users-state "title")] + [:button {:type "button" + :class "close" + :data-dismiss "modal"} + "X"]] + [:div {:class "modal-body" + :style {:height "460px"}} + [comp-users-add]] + [:div {:class "modal-footer"} + [:button {:type "submit" + :class "btn btn-danger btn-default" + :data-dismiss "modal"} + [:span {:class "glyphicon glyphicon-remove"}] + "Cancel"]]]]] + [:div {:id "modal-users-modify" + :class "modal fade" + :role "dialog" + :tab-index "-1"} + [:div {:class "modal-dialog modal-lg"} + [:div {:class "modal-content"} + [:div {:class "modal-header"} + [:h5 (get @users-state "title")] + [:button {:type "button" + :class "close" + :data-dismiss "modal"} + "X"]] + [:div {:class "modal-body" + :style {:height "460px"}} + [comp-users-modify]] + [:div {:class "modal-footer"} + [:button {:type "submit" + :class "btn btn-danger btn-default" + :data-dismiss "modal"} + [:span {:class "glyphicon glyphicon-remove"}] + "Cancel"]]]]]]) (defn handler-users [response] (let [jsonobj (js->clj (js/JSON.parse response))] (notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#body) (template-users jsonobj)) + (reset-users-state jsonobj) (render-users-view))) (defn render-users [] @@ -1146,42 +1255,46 @@ ;; users-view -(hiccups/defhtml template-users-view [jsonobj] - [:div {:style "text-align: right"} - [:img {:src "/static/images/add.png" - :style "cursor:pointer; cursor:hand" - :onclick (str (namespace ::x) ".on_users_add_clicked()")}]] - [:table {:class "table table-striped table-hover table-sm"} - [:thead - [:tr - [:th {:scope "col"} "Active?"] - [:th {:scope "col"} "Last Name"] - [:th {:scope "col"} "First Name"] - [:th {:scope "col"} "Username"] - [:th {:scope "col"} "Email"] - [:th {:scope "col"} "Phone"] - [:th {:scope "col"} "Del"]]] - [:tbody - (for [user (get jsonobj "users")] - (let [onclick (str (namespace ::x) ".on_users_modify_clicked(" (get user "id") ")") - toggle-active (str (namespace ::x) ".on_users_toggle_active_clicked(" (get user "id") ")")] - [:tr - [:td [:img {:src (cond (get user "active") - "/static/images/yes.png" - :else - "/static/images/no.png") - :onclick toggle-active}]] - [:td {:onclick onclick} (get user "last_name")] - [:td {:onclick onclick} (get user "first_name")] - [:td {:onclick onclick} (get user "username")] - [:td {:onclick onclick} (get user "email")] - [:td {:onclick onclick} (get user "phone")] - [:td [:img {:src "/static/images/delete.png" - :onclick (str (namespace ::x) ".on_users_delete_clicked(" (get user "id") ", '" (get user "first_name") "', '" (get user "last_name") "')")}]]]))]]) - +(defn comp-users-view [] + [:div + [:div {:style {:text-align "right"}} + [:img {:src "/static/images/add.png" + :on-click #(on-users-add-clicked)}]] + [:table {:class "table table-striped table-hover table-sm"} + [:thead + [:tr + [:th {:scope "col"} "Active?"] + [:th {:scope "col"} "Last Name"] + [:th {:scope "col"} "First Name"] + [:th {:scope "col"} "Username"] + [:th {:scope "col"} "Email"] + [:th {:scope "col"} "Phone"] + [:th {:scope "col"} "Mod"] + [:th {:scope "col"} "Del"]]] + [:tbody + (for [user (get @users-view-state "users")] + [:tr {:key (str "users-view-" (get user "id"))} + [:td + [:img {:src (cond (get user "active") + "/static/images/yes.png" + :else + "/static/images/no.png") + :on-click #(on-users-toggle-active-clicked (get user "id"))}]] + [:td (get user "last_name")] + [:td (get user "first_name")] + [:td (get user "username")] + [:td (get user "email")] + [:td (get user "phone")] + [:td {:width "30"} + [:img {:src "/static/images/edit.png" + :on-click #(on-users-modify-clicked (get user "id"))}]] + [:td {:width "30"} + [:img {:src "/static/images/delete.png" + :on-click #(on-users-delete-clicked (get user "id"))}]]])]]]) + (defn handler-users-view [response] (let [jsonobj (js->clj (js/JSON.parse response))] - (dommy/set-html! (dommy/sel1 :#content) (template-users-view jsonobj)))) + (reset-users-view-state jsonobj))) (defn render-users-view [] (GET "/users/view" {:handler handler-users-view})) @@ -1191,15 +1304,13 @@ (defn on-users-add-clicked [] (render-users-add)) -(hiccups/defhtml template-users-add [jsonobj] - (ck-form/template-generic-form (get jsonobj "form") (namespace ::x))) +(defn comp-users-add [] + [:div {:dangerouslySetInnerHTML (r/unsafe-html (ck-form/template-generic-form (get @users-add-state "form") (namespace ::x)))}]) (defn handler-users-add [response] (let [jsonobj (js->clj (js/JSON.parse response))] - (auth-notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#modify-title) (get jsonobj "title")) - (dommy/set-html! (dommy/sel1 :#modify-body) (template-users-add jsonobj)) - (.modal (jquery "#modify")))) + (reset-users-add-state jsonobj) + (.modal (jquery "#modal-users-add")))) (defn render-users-add [] (POST "/users/add" {:handler handler-users-add})) @@ -1210,32 +1321,31 @@ (when (-> (jquery "#users-add-form") (.get "0") (.checkValidity)) - (.modal (jquery "#modify") "hide") + (.modal (jquery "#modal-users-add") "hide") (render-users-add-submit))) (defn handler-users-add-submit [response] (let [jsonobj (js->clj (js/JSON.parse response))] (auth-notifications jsonobj) - (on-menu-clicked "/users"))) + (render-users-view))) (defn render-users-add-submit [] (POST "/users/add/submit" {:format :raw - :params {:role_groups (reduce-checkboxes "[id^='chk_']") - :first_name (dommy/value (dommy/sel1 :#first_name)) - :last_name (dommy/value (dommy/sel1 :#last_name)) - :email (dommy/value (dommy/sel1 :#email))} + :params (merge (form-fields-to-map "#users-add-form :input") + {:role_groups (reduce-checkboxes "[id^='users_add_form-chk_users_add_']")}) :handler handler-users-add-submit})) ;; users-register -(hiccups/defhtml template-users-register [jsonobj] - [:h3 {:style "text-align: center"} (get jsonobj "title")] - [:div {:id "content"}]) +(defn comp-users-register [] + [:div {:style {:display (cond (= @location-state "/users/register") "block" :else "none")}} + [:h3 {:style {:text-align "center"}} (get @users-register-state "title")] + [comp-users-register-form]]) (defn handler-users-register [response] (let [jsonobj (js->clj (js/JSON.parse response))] - (dommy/set-html! (dommy/sel1 :#body) (template-users-register jsonobj)) + (reset-users-register-state jsonobj) (render-users-register-form (get jsonobj "hash")))) (defn render-users-register [hash] @@ -1246,22 +1356,22 @@ ;; users-register-form -(hiccups/defhtml template-users-register-form [jsonobj] - (cond (get jsonobj "errormsg") - [:a {:href (str "javascript:" (namespace ::x) ".reset_app()")} - "Click here to return to the home page."] - :else - (do - [:p (str "Welcome " (get jsonobj "firstName") " " (get jsonobj "lastName") " to the new user registration page. Please fill out the form below to complete your registration.")] - [:p "Create a new username and password for your login to the website. Phone number is optional."] - [:p (str "Your email address is recorded as " (get jsonobj "email") ". This is where notifications will be sent. If this is not the desired email address, you can change it later by visiting the Edit Profile page.")] - [:p (str "This registration will expire in " (get jsonobj "validFor") ". Please submit this form before that time.")] - (ck-form/template-generic-form (get jsonobj "form") (namespace ::x))))) +(defn comp-users-register-form [] + [:div + (cond (get @users-register-form-state "errormsg") + [:a {:href (str "javascript:" (namespace ::x) ".reset_app()")} + "Click here to return to the home page."] + :else + (do + [:p (str "Welcome " (get @users-register-form-state "firstName") " " (get @users-register-form-state "lastName") " to the new user registration page. Please fill out the form below to complete your registration.")] + [:p "Create a new username and password for your login to the website. Phone number is optional."] + [:p (str "Your email address is recorded as " (get @users-register-form-state "email") ". This is where notifications will be sent. If this is not the desired email address, you can change it later by visiting the Edit Profile page.")] + [:p (str "This registration will expire in " (get @users-register-form-state "validFor") ". Please submit this form before that time.")] + [:div {:dangerouslySetInnerHTML (r/unsafe-html (ck-form/template-generic-form (get @users-register-form-state "form") (namespace ::x)))}]))]) (defn handler-users-register-form [response] (let [jsonobj (js->clj (js/JSON.parse response))] - (notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#content) (template-users-register-form jsonobj)))) + (reset-users-register-form-state jsonobj))) (defn render-users-register-form [hash] (POST "/users/register/form" @@ -1277,28 +1387,15 @@ (.checkValidity)) (render-users-register-submit))) -(hiccups/defhtml template-users-register-submit [jsonobj] - [:a {:href (str "javascript:" (namespace ::x) ".reset_app()")} - "Click here to start using the website!"]) - (defn handler-users-register-submit [response] (let [jsonobj (js->clj (js/JSON.parse response))] (notifications jsonobj) - (cond (get jsonobj "errormsg") - (do - (dommy/set-value! (dommy/sel1 :#pwd) "") - (dommy/set-value! (dommy/sel1 :#pwd2) "")) - :else - (dommy/set-html! (dommy/sel1 :#content) (template-users-register-submit jsonobj))))) + (reset-app))) (defn render-users-register-submit [] (POST "/users/register/submit" {:format :raw - :params {:hash (dommy/value (dommy/sel1 :#hash)) - :username (dommy/value (dommy/sel1 :#username)) - :pwd (dommy/value (dommy/sel1 :#pwd)) - :pwd2 (dommy/value (dommy/sel1 :#pwd2)) - :phone (dommy/value (dommy/sel1 :#phone))} + :params (form-fields-to-map "#users-register-form :input") :handler handler-users-register-submit})) ;; users-modify @@ -1306,15 +1403,13 @@ (defn on-users-modify-clicked [id] (render-users-modify id)) -(hiccups/defhtml template-users-modify [jsonobj] - (ck-form/template-generic-form (get jsonobj "form") (namespace ::x))) +(defn comp-users-modify [] + [:div {:dangerouslySetInnerHTML (r/unsafe-html (ck-form/template-generic-form (get @users-modify-state "form") (namespace ::x)))}]) (defn handler-users-modify [response] (let [jsonobj (js->clj (js/JSON.parse response))] - (auth-notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#modify-title) (get jsonobj "title")) - (dommy/set-html! (dommy/sel1 :#modify-body) (template-users-modify jsonobj)) - (.modal (jquery "#modify")))) + (reset-users-modify-state jsonobj) + (.modal (jquery "#modal-users-modify")))) (defn render-users-modify [id] (POST "/users/modify" @@ -1328,24 +1423,19 @@ (when (-> (jquery "#users-modify-form") (.get "0") (.checkValidity)) - (.modal (jquery "#modify") "hide") + (.modal (jquery "#modal-users-modify") "hide") (render-users-modify-submit))) (defn handler-users-modify-submit [response] (let [jsonobj (js->clj (js/JSON.parse response))] (auth-notifications jsonobj) - (on-menu-clicked "/users"))) + (render-users-view))) (defn render-users-modify-submit [] (POST "/users/modify/submit" {:format :raw - :params {:id (dommy/value (dommy/sel1 :#id)) - :role_groups (reduce-checkboxes "[id^='chk_']") - :username (dommy/value (dommy/sel1 :#username)) - :first_name (dommy/value (dommy/sel1 :#first_name)) - :last_name (dommy/value (dommy/sel1 :#last_name)) - :email (dommy/value (dommy/sel1 :#email)) - :phone (dommy/value (dommy/sel1 :#phone))} + :params (merge (form-fields-to-map "#users-modify-form :input") + {:role_groups (reduce-checkboxes "[id^='users_modify_form-chk_users_modify_']")}) :handler handler-users-modify-submit})) ;; users-toggle-active @@ -1356,7 +1446,7 @@ (defn handler-users-toggle-active [response] (let [jsonobj (js->clj (js/JSON.parse response))] (auth-notifications jsonobj) - (on-menu-clicked "/users"))) + (render-users-view))) (defn render-users-toggle-active [id] (POST "/users/toggle-active" @@ -1366,14 +1456,14 @@ ;; users-delete -(defn on-users-delete-clicked [id first-name last-name] - (when (js/confirm (str "Are you sure you want to delete " first-name " " last-name "? This action cannot be undone.")) +(defn on-users-delete-clicked [id] + (when (js/confirm (str "Are you sure you want to delete " id "? This action cannot be undone.")) (render-users-delete id))) (defn handler-users-delete [response] (let [jsonobj (js->clj (js/JSON.parse response))] (auth-notifications jsonobj) - (on-menu-clicked "/users"))) + (render-users-view))) (defn render-users-delete [id] (DELETE (str "/users/delete/" id) @@ -1382,22 +1472,27 @@ ;; location +(push-menu-hook {:handler "/home" :func #(render-home)}) +(push-menu-hook {:handler "/login" :func #(render-login)}) +(push-menu-hook {:handler "/logout" :func #(render-logout)}) +(push-menu-hook {:handler "/profile" :func #(render-profile)}) +(push-menu-hook {:handler "/password" :func #(render-password)}) +(push-menu-hook {:handler "/lessons" :func #(render-lessons)}) +(push-menu-hook {:handler "/gigs" :func #(render-gigs)}) +(push-menu-hook {:handler "/programming" :func #(render-programming)}) +(push-menu-hook {:handler "/gallery" :func #(render-gallery)}) +;;(push-menu-hook {:handler "/testimonials" :func #(render-testimonials)}) +(push-menu-hook {:handler "/contact-us" :func #(render-contact-us)}) +(push-menu-hook {:handler "/messages" :func #(render-messages)}) +(push-menu-hook {:handler "/users" :func #(render-users)}) +(push-menu-hook {:handler "/users/register" :func #(render-users)}) + (defn on-menu-clicked [handler] (reset-location handler) (render-menu) - (cond (= handler "/home") (render-home) - (= handler "/login") (render-login) - (= handler "/logout") (render-logout) - (= handler "/profile") (render-profile) - (= handler "/password") (render-password) - (= handler "/lessons") (render-lessons) - (= handler "/gigs") (render-gigs) - (= handler "/programming") (render-programming) - (= handler "/gallery") (render-gallery) - (= handler "/testimonials") (render-testimonials) - (= handler "/contact-us") (render-contact-us) - (= handler "/messages") (render-messages) - (= handler "/users") (render-users))) + (let [hook (get @menu-hooks handler)] + (when hook + (apply (get hook :func) '())))) (defn handler-location [response] (let [jsonobj (js->clj (js/JSON.parse response))] @@ -1417,3 +1512,60 @@ (reset-location "/users/register") (render-menu) (render-users-register hash)) + +;; body + +(defn comp-app [] + [:div {:class "container-fluid"} + [:div {:class "banner"} + [:table {:width "100%" :height "100%"} + [:tbody + [:tr + [:td {:class "banner-menu"} + [comp-menu-user]] + [:td {:class "banner-title"} "Bogen-" [:i "Herr"]] + [:td {:class "banner-menu"} " "]]]]] + [comp-menu-main] + [ck-notifications/comp-errormsg] + [ck-notifications/comp-message] + [comp-home] + [comp-login] + [comp-gallery] + [comp-about-us] + [comp-profile] + [comp-password] + [comp-contact-us] + [comp-messages] + [comp-users] + [comp-users-register] + [:div {:id "footer"} + [:hr] + "Carlos Konstanski (970) 294-9708" + [:br] + [:a {:href "https://git.ckons.org/bogenherr.git/tree" + :target "_blank"} + "Source code in Git"] + [:hr] + [:img {:src "/static/images/notes.png" + :height "50px"}]]]) + +;; start the react app + +(defn start-render [] + (let [app-root (rdc/create-root (js/document.getElementById "app"))] + (rdc/render app-root [comp-app]))) + +(defn start-location [] + (cond (str/starts-with? @location-state "/register/") + (goto-register (str/replace-first @location-state "/register/" "")) + :else + (goto-location @location-state))) + +(defn ^:dev/after-load start + ([] + (start-render) + (start-location)) + ([url] + (reset-location url) + (start-render) + (start-location))) diff --git a/lisp/webapps/bogenherr/site.lisp b/lisp/webapps/bogenherr/site.lisp deleted file mode 100644 index b47b9d4..0000000 --- a/lisp/webapps/bogenherr/site.lisp +++ /dev/null @@ -1,254 +0,0 @@ -;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- -(declaim (optimize (speed 0) (safety 3) (debug 3))) - -(in-package :bogenherr) - -(defmacro .base (&optional (start-url "/home")) - `(org-ckons-http::html5 - `(html - (head - ((meta :name "viewport" :content "width=device-width, initial-scale=1, shrink-to-fit=no")) - ((meta :charset "utf-8")) - ((title) ,(title *webapp*)) - ,@(mapcar (lambda (css) - `((link :rel "stylesheet" :href ,(getf css :href) :integrity ,(getf css :integrity) :crossorigin ,(getf css :crossorigin)))) - '((:href "https://cdn.jsdelivr.net/npm/bootstrap@4.6.2/dist/css/bootstrap.min.css" :integrity "sha384-xOolHFLEh07PJGoPkLv1IbcEPTNtaed2xpHsD9ESMhqIYd0nLMwNLD69Npy4HI+N" :crossorigin "anonymous") - (:href "/static/css/stylesheet.css" :crossorigin "anonymous"))) - ,@(mapcar (lambda (js) - `((script :type "text/javascript" :src ,(getf js :src) :integrity ,(getf js :integrity) :crossorigin ,(getf js :crossorigin)))) - '((:src "https://code.jquery.com/jquery-3.7.1.slim.min.js" :integrity "sha256-kmHvs0B+OpCW5GVHUNjv9rOmY0IvSIRcf7zGUDTDQM8=" :crossorigin "anonymous"))) - ((script :type "text/javascript" :src "/cljs-out/dev-main.js"))) - ((body :onload ,(format nil "bogenherr.core.start(~a)" ,(if start-url - (format nil "'~a'" start-url) - "null"))) - ((div :id "app")) - ,@(mapcar (lambda (js) - `((script :type "text/javascript" :src ,(getf js :src) :integrity ,(getf js :integrity) :crossorigin ,(getf js :crossorigin)))) - '((:src "https://cdn.jsdelivr.net/npm/bootstrap@4.6.2/dist/js/bootstrap.bundle.min.js" :integrity "sha384-Fy6S3B9q64WdZWQUiU+q4/2Lc9npb8tCaSX9FK7E8HnRr0Jz8D6OP9dO5Vg3Q9ct" :crossorigin "anonymous"))))))) - -(defmacro .location () - `(location-json location)) - -(defmacro .home-get () - `(home-json)) - -(defmacro .home-post () - `(home-json message errormsg)) - -(defmacro .menu () - `(menu-json)) - -(defmacro .menu-user () - `(menu-user-json)) - -(defmacro .login () - `(login-json)) - -(defmacro .login-authenticate () - `(login-authenticate-json username pwd)) - -(defmacro .login-forgot () - `(login-forgot-json)) - -(defmacro .logout () - `(logout-json)) - -(defmacro .profile () - `(profile-json)) - -(defmacro .profile-view () - `(profile-view-json)) - -(defmacro .profile-modify () - `(profile-modify-json)) - -(defmacro .profile-modify-submit () - `(profile-modify-submit-json id username first_name last_name email phone)) - -(defmacro .password () - `(password-json)) - -(defmacro .password-submit () - `(password-submit-json id pwd pwd2)) - -(defmacro .lessons () - `(about-us-json "lessons")) - -(defmacro .lessons-view () - `(about-us-view-json "lessons")) - -(defmacro .lessons-modify () - `(about-us-modify-json "lessons")) - -(defmacro .lessons-modify-submit () - `(about-us-modify-submit-json "lessons" content)) - -(defmacro .gigs () - `(about-us-json "gigs")) - -(defmacro .gigs-view () - `(about-us-view-json "gigs")) - -(defmacro .gigs-modify () - `(about-us-modify-json "gigs")) - -(defmacro .gigs-modify-submit () - `(about-us-modify-submit-json "gigs" content)) - -(defmacro .programming () - `(about-us-json "programming")) - -(defmacro .programming-view () - `(about-us-view-json "programming")) - -(defmacro .programming-modify () - `(about-us-modify-json "programming")) - -(defmacro .programming-modify-submit () - `(about-us-modify-submit-json "programming" content)) - -(defmacro .gallery () - `(gallery-json)) - -(defmacro .gallery-view () - `(gallery-view-json)) - -(defmacro .gallery-add () - `(gallery-add-json)) - -(defmacro .gallery-add-submit () - `(gallery-add-submit-json description video_embed_url upload)) - -(defmacro .gallery-modify () - `(gallery-modify-json id)) - -(defmacro .gallery-modify-submit () - `(gallery-modify-submit-json id description video_embed_url upload)) - -(defmacro .gallery-delete () - `(gallery-delete-json id)) - -(defmacro .gallery-file-view () - `(gallery-file-view id)) - -(defmacro .testimonials () - `(testimonials-json)) - -(defmacro .testimonials-view () - `(testimonials-view-json)) - -(defmacro .testimonials-modify () - `(testimonials-modify-json)) - -(defmacro .testimonials-modify-submit () - `(testimonials-modify-submit-json content)) - -(defmacro .contact-us () - `(contact-us-json)) - -(defmacro .contact-us-view () - `(contact-us-view-json)) - -(defmacro .contact-us-email () - `(contact-us-email-json first_name last_name email phone comments)) - -(defmacro .messages () - `(messages-json)) - -(defmacro .messages-results () - `(messages-results-json read)) - -(defmacro .messages-mark () - `(messages-mark-json read id)) - -(defmacro .users () - `(users-json)) - -(defmacro .users-view () - `(users-view-json)) - -(defmacro .users-add () - `(users-add-json)) - -(defmacro .users-add-submit () - `(users-add-submit-json role_groups first_name last_name email)) - -(defmacro .users-register () - `(users-register-json hash)) - -(defmacro .users-register-form () - `(users-register-form-json hash)) - -(defmacro .users-register-submit () - `(users-register-submit-json hash username pwd pwd2 phone)) - -(defmacro .users-modify () - `(users-modify-json id)) - -(defmacro .users-modify-submit () - `(users-modify-submit-json id role_groups username first_name last_name email phone)) - -(defmacro .users-toggle-active () - `(users-toggle-active-json id)) - -(defmacro .users-delete () - `(users-delete-json id)) - -(define-endpoint ("/" :method :get) () .base) -(define-endpoint ("/location" :method :post) (&post (location :parameter-type 'string)) .location) -(define-endpoint ("/home" :method :get) () .home-get) -(define-endpoint ("/home" :method :post) (&post (message :parameter-type 'string) (errormsg :parameter-type 'string)) .home-post) -(define-endpoint ("/menu" :method :get) () .menu) -(define-endpoint ("/menu/user" :method :get) () .menu-user) -(define-endpoint ("/login" :method :get) () .login) -(define-endpoint ("/login/authenticate" :method :post) (&post (username :parameter-type 'string) (pwd :parameter-type 'string)) .login-authenticate) -(define-endpoint ("/login/forgot" :method :get) () .login-forgot) -(define-endpoint ("/logout" :method :get) () .logout) -(define-endpoint ("/profile" :method :get) () .profile) -(define-endpoint ("/profile/view" :method :get) () .profile-view) -(define-endpoint ("/profile/modify" :method :post) () .profile-modify) -(define-endpoint ("/profile/modify/submit" :method :post) (&post (id :parameter-type 'integer) (username :parameter-type 'string) (first_name :parameter-type 'string) (last_name :parameter-type 'string) (email :parameter-type 'string) (phone :parameter-type 'string)) .profile-modify-submit) -(define-endpoint ("/password" :method :get) () .password) -(define-endpoint ("/password/submit" :method :post) (&post (id :parameter-type 'integer) (pwd :parameter-type 'string) (pwd2 :parameter-type 'string)) .password-submit) -(define-endpoint ("/lessons" :method :get) () .lessons) -(define-endpoint ("/lessons/view" :method :get) () .lessons-view) -(define-endpoint ("/lessons/modify" :method :post) () .lessons-modify) -(define-endpoint ("/lessons/modify/submit" :method :post) (&post (content :parameter-type 'string)) .lessons-modify-submit) -(define-endpoint ("/gigs" :method :get) () .gigs) -(define-endpoint ("/gigs/view" :method :get) () .gigs-view) -(define-endpoint ("/gigs/modify" :method :post) () .gigs-modify) -(define-endpoint ("/gigs/modify/submit" :method :post) (&post (content :parameter-type 'string)) .gigs-modify-submit) -(define-endpoint ("/programming" :method :get) () .programming) -(define-endpoint ("/programming/view" :method :get) () .programming-view) -(define-endpoint ("/programming/modify" :method :post) () .programming-modify) -(define-endpoint ("/programming/modify/submit" :method :post) (&post (content :parameter-type 'string)) .programming-modify-submit) -(define-endpoint ("/gallery" :method :get) () .gallery) -(define-endpoint ("/gallery/view" :method :get) () .gallery-view) -(define-endpoint ("/gallery/add" :method :post) () .gallery-add) -(define-endpoint ("/gallery/add/submit" :method :post) (&post (description :parameter-type 'string) (video_embed_url :parameter-type 'string) (upload :parameter-type 'string)) .gallery-add-submit) -(define-endpoint ("/gallery/modify" :method :post) (&post (id :parameter-type 'integer)) .gallery-modify) -(define-endpoint ("/gallery/modify/submit" :method :post) (&post (id :parameter-type 'integer) (description :parameter-type 'string) (video_embed_url :parameter-type 'string) (upload :parameter-type 'string)) .gallery-modify-submit) -(define-endpoint ("/gallery/delete/:id" :method :delete) (&path (id 'integer)) .gallery-delete) -(define-endpoint ("/gallery/file/view/:id" :method :get) (&path (id 'integer)) .gallery-file-view) -(define-endpoint ("/testimonials" :method :get) () .testimonials) -(define-endpoint ("/testimonials/view" :method :get) () .testimonials-view) -(define-endpoint ("/testimonials/modify" :method :post) () .testimonials-modify) -(define-endpoint ("/testimonials/modify/submit" :method :post) (&post (content :parameter-type 'string)) .testimonials-modify-submit) -(define-endpoint ("/contact-us" :method :get) () .contact-us) -(define-endpoint ("/contact-us/view" :method :get) () .contact-us-view) -(define-endpoint ("/contact-us/email" :method :post) (&post (first_name :parameter-type 'string) (last_name :parameter-type 'string) (email :parameter-type 'string) (phone :parameter-type 'string) (comments :parameter-type 'string)) .contact-us-email) -(define-endpoint ("/messages" :method :get) () .messages) -(define-endpoint ("/messages/results" :method :post) (&post (read :parameter-type 'string)) .messages-results) -(define-endpoint ("/messages/mark" :method :post) (&post (read :parameter-type 'string) (id :parameter-type 'integer)) .messages-mark) -(define-endpoint ("/users" :method :get) () .users) -(define-endpoint ("/users/view" :method :get) () .users-view) -(define-endpoint ("/users/add" :method :post) () .users-add) -(define-endpoint ("/users/add/submit" :method :post) (&post (role_groups :parameter-type 'string) (first_name :parameter-type 'string) (last_name :parameter-type 'string) (email :parameter-type 'string)) .users-add-submit) -(define-endpoint ("/register/:hash" :method :get) (&path (hash 'string)) .base (format nil "/register/~a" hash)) -(define-endpoint ("/users/register" :method :post) (&post (hash :parameter-type 'string)) .users-register) -(define-endpoint ("/users/register/form" :method :post) (&post (hash :parameter-type 'string)) .users-register-form) -(define-endpoint ("/users/register/submit" :method :post) (&post (hash :parameter-type 'string) (username :parameter-type 'string) (pwd :parameter-type 'string) (pwd2 :parameter-type 'string) (phone :parameter-type 'string)) .users-register-submit) -(define-endpoint ("/users/modify" :method :post) (&post (id :parameter-type 'integer)) .users-modify) -(define-endpoint ("/users/modify/submit" :method :post) (&post (id :parameter-type 'integer) (role_groups :parameter-type 'string) (username :parameter-type 'string) (first_name :parameter-type 'string) (last_name :parameter-type 'string) (email :parameter-type 'string) (phone :parameter-type 'string)) .users-modify-submit) -(define-endpoint ("/users/toggle-active" :method :post) (&post (id :parameter-type 'integer)) .users-toggle-active) -(define-endpoint ("/users/delete/:id" :method :delete) (&path (id 'integer)) .users-delete) diff --git a/lisp/webapps/generics.lisp b/lisp/webapps/generics.lisp deleted file mode 100644 index c986e5b..0000000 --- a/lisp/webapps/generics.lisp +++ /dev/null @@ -1,12 +0,0 @@ -;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- -(declaim (optimize (speed 0) (safety 3) (debug 3))) - -(in-package :bogenherr) - -(defgeneric get-site-file-path (webapp) - (:documentation "Builds a full filesystem path to a webapp's site -file.")) - -(defgeneric get-pages-file-paths (webapp) - (:documentation "")) - diff --git a/lisp/webapps/webapp-loader.lisp b/lisp/webapps/webapp-loader.lisp deleted file mode 100644 index e18f661..0000000 --- a/lisp/webapps/webapp-loader.lisp +++ /dev/null @@ -1,177 +0,0 @@ -;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- -(declaim (optimize (speed 0) (safety 3) (debug 3))) - -(in-package :bogenherr) - -(defvar *acceptor* nil) -(defvar *dispatch-table* '(#'dispatch-easy-handlers #'default-dispatcher)) -(defvar *webapps* (make-hash-table :test 'equal)) -(defvar *webapp* nil) -(defvar *uri* nil) -(defvar *header-register* nil) -(defvar *sessionid* nil) -(defparameter *port* 3012) -(defparameter *server-root* (namestring (asdf:system-relative-pathname (intern (package-name #.*package*)) "./")) - "The location of the web server root on the filesystem.") - -(defclass webapp () - ((name :initarg :name - :initform nil - :accessor name - :documentation "The name of the webapp as used in the code. A -string used as the key to any webapp config lookup.") - (scheme :initarg :scheme - :initform nil - :accessor scheme) - (url :initarg :url - :initform nil - :accessor url - :documentation "The domain portion of the URL to the -root of the webapp.") - (document-root :initarg :document-root - :initform nil - :accessor document-root - :documentation "The absolute filesystem path to the -webapp's top-level directory which is inside the webapps folder.") - (title :initarg :title - :initform nil - :accessor title - :documentation "The default title that shows up in -the browser title bar.") - (meta-description :initarg :meta-description - :initform nil - :accessor meta-description - :documentation "The text that goes into the META DESCRIPTION -tag, and anywhere else we want to put this text so that it will show -up in Google.") - (databases :initarg :databases - :initform nil - :accessor databases) - (mail-mx :initarg :mail-mx - :initform nil - :accessor mail-mx) - (mail-from :initarg :mail-from - :initform nil - :accessor mail-from) - (mail-postmaster :initarg :mail-postmaster - :initform nil - :accessor mail-postmaster) - (mail-webmaster :initarg :mail-webmaster - :initform nil - :accessor mail-webmaster) - (mail-info :initarg :mail-info - :initform nil - :accessor mail-info) - (mail-login-notify :initarg :mail-login-notify - :initform nil - :accessor mail-login-notify) - (mail-authentication :initarg :mail-authentication - :initform nil - :accessor mail-authentication) - (mail-ssl :initarg :mail-ssl - :initform nil - :accessor mail-ssl)) - (:documentation "")) - -(defmethod get-site-file-path ((webapp webapp)) - (format nil "~a/site" (document-root webapp))) - -(defmethod get-pages-file-paths ((webapp webapp)) - (mapcar (lambda (pages-file) - (ppcre:regex-replace-all "\\.lisp$" (format nil "~a" pages-file) "")) - (remove-if (lambda (x) (equal x "shared")) - (org-ckons-core::shell-wrapper (format nil "find '~a' -maxdepth 1 -type f -iname 'pages*.lisp' |sort" (document-root webapp)))))) - -(defun make-server-path (relative-path) - "Makes a relative filesystem path into a full one, using -`*server-root*' as the base." - (make-document-root-path *server-root* relative-path)) - -(defun make-document-root-path (document-root relative-path) - "Makes a relative filesystem path into a full one, using -`document-root' as the base." - (concatenate 'string document-root relative-path)) - -(defun make-webapp-path (relative-path) - "Makes an absolute filesystem path to a location in the webapps -folder." - (concatenate 'string *server-root* "webapps/" relative-path)) - -(defun get-options-files () - (mapcar (lambda (webapp-directory) - (format nil "~a/conf/options.lisp" webapp-directory)) - (remove-if (lambda (x) (or (org-ckons-core::match-it "webapps/$" x) - (org-ckons-core::match-it "webapps/shared$" x) - (org-ckons-core::match-it "webapps/CVS$" x) - (org-ckons-core::match-it "webapps/\\.$" x) - (org-ckons-core::match-it "webapps/\\.\\.$" x))) - (org-ckons-core::shell-wrapper (format nil "find '~a' -maxdepth 1 -type d |sort" (make-webapp-path "")))))) - -(defun set-webapp (webapp) - "Sets a `webapp' object in `*webapps*'. The lookup key is the webapp -name. If a webapp already exists under this key, it gets overwritten -with the new one." - (setf (gethash (name webapp) *webapps*) webapp)) - -(defun get-webapp (key) - "Gets the webapp object stored under the key `key'." - (gethash key *webapps*)) - -(defun populate-webapps () - (loop for options-file in (get-options-files) - do (with-open-file (input options-file :direction :input) - (let* ((form (read input))) - (set-webapp (make-instance 'webapp - :name (getf form :name) - :scheme (getf form :scheme) - :url (getf form :url) - :document-root (make-webapp-path (getf form :document-root)) - :title (getf form :title) - :meta-description (getf form :meta-description) - :databases (getf form :databases) - :mail-mx (getf form :mail-mx) - :mail-from (getf form :mail-from) - :mail-postmaster (getf form :mail-postmaster) - :mail-webmaster (getf form :mail-webmaster) - :mail-info (getf form :mail-info) - :mail-login-notify (getf form :mail-login-notify) - :mail-authentication (getf form :mail-authentication) - :mail-ssl (getf form :mail-ssl))))))) - -(defun bogenherr () - "Call this to start the server." - (when (null *acceptor*) - (let ((package (string-downcase (package-name #.*package*)))) - (populate-webapps) - (setf (log-manager) (make-instance 'log-manager :message-class 'formatted-message)) - (start-messenger 'text-file-messenger :filename (format nil "/var/log/lisp/~a.log" package)) - (setf *session-secret* (org-ckons-session::generate-sessionid)) - (populate-webapps) - (setf *acceptor* (start (make-instance 'easy-routes:easy-routes-acceptor - :port *port* - :document-root (make-server-path (format nil "webapps/~a/" package)) - :name (format nil "~a-acceptor" package))))))) - -(defmacro with-request-wrapper (uri page-function &rest args) - (let ((package (string-downcase (package-name #.*package*)))) - `(let (output) - (let* ((*webapp* (get-webapp ,package)) - (*uri* ,uri) - (*header-register* (make-instance 'org-ckons-session::header-register)) - (*sessionid* (ensure-user-session-exists))) - (ensure-user-exists) - (setf output (,page-function ,@args)) - (org-ckons-session::ship-headers *header-register*)) - output))) - -(defmacro define-endpoint (template-and-options var-list page-function &rest args) - "Does the grunt work of creating an `easy-routes' route for each page -you wish to publish." - (let ((name (gensym)) - (uri (first template-and-options)) - (method (getf (rest template-and-options) :method))) - `(progn - (org-ckons-core::logger (format nil "Publishing page. URL = [~a], method = [~a]" ,uri ,method)) - (easy-routes:defroute ,name ,template-and-options - ,var-list - (with-request-wrapper ,uri ,page-function ,@args))))) -- cgit v1.3