diff options
106 files changed, 4538 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..696753b --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +*~ +*swp +*.fasl diff --git a/lisp/core/core.lisp b/lisp/core/core.lisp new file mode 100644 index 0000000..cdcb9d9 --- /dev/null +++ b/lisp/core/core.lisp @@ -0,0 +1,7 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(defpackage :woodriverlessons + (:use :cl :cl-log :hunchentoot :org-ckons-sql)) + +(in-package :woodriverlessons) diff --git a/lisp/service/about-us-service.lisp b/lisp/service/about-us-service.lisp new file mode 100644 index 0000000..a4d1d49 --- /dev/null +++ b/lisp/service/about-us-service.lisp @@ -0,0 +1,12 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :woodriverlessons) + +(defclass about-us-service (rest-service) + () + (:documentation "")) + +(defun about-us-json () + (with-noauth (instance about-us-service) + t)) diff --git a/lisp/service/auth-service.lisp b/lisp/service/auth-service.lisp new file mode 100644 index 0000000..9509385 --- /dev/null +++ b/lisp/service/auth-service.lisp @@ -0,0 +1,41 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :woodriverlessons) + +(defclass auth-service (rest-service) + () + (:documentation "")) + +(defmethod initialize-instance :after ((auth-service auth-service) &key roles) + (with-valid-user (session roles) + (progn + (setf (location auth-service) "/home") + (setf (message auth-service) nil) + (setf (errormsg auth-service) "You are not authorized to access this resource.")) + t)) + +(defmacro with-auth ((instance auth-service roles) &body body) + `(let ((,instance (make-instance ',auth-service :roles ,roles))) + (when (null (errormsg ,instance)) + ,@body) + (when (location-p ,instance) + (setf (session-value :message) nil) + (setf (session-value :errormsg) nil)) + (org-ckons-json::objects-to-json `(,,instance)))) + +(defmacro with-auth-raw ((instance auth-service roles) &body body) + `(let ((,instance (make-instance ',auth-service :roles ,roles))) + (when (location-p ,instance) + (setf (session-value :message) nil) + (setf (session-value :errormsg) nil)) + (when (null (errormsg ,instance)) + ,@body))) + +(defmacro with-noauth ((instance rest-service) &body body) + `(let ((,instance (make-instance ',rest-service))) + ,@body + (when (location-p ,instance) + (setf (session-value :message) nil) + (setf (session-value :errormsg) nil)) + (org-ckons-json::objects-to-json `(,,instance)))) diff --git a/lisp/service/base-service.lisp b/lisp/service/base-service.lisp new file mode 100644 index 0000000..3edc118 --- /dev/null +++ b/lisp/service/base-service.lisp @@ -0,0 +1,21 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :woodriverlessons) + +(defclass base-service () + () + (:documentation "")) + +(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))) + +(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)))) + +(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)))) diff --git a/lisp/service/contact-us-service.lisp b/lisp/service/contact-us-service.lisp new file mode 100644 index 0000000..7c10bd3 --- /dev/null +++ b/lisp/service/contact-us-service.lisp @@ -0,0 +1,84 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :woodriverlessons) + +(defclass contact-us-service (rest-service) + () + (:documentation "")) + +(defun contact-us-form () + (make-form "contact-us-form" + nil + t + `((: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") + (:name "phone" :label "Phone" :field-type "text") + (:name "comments" :label "Message" :field-type "textarea" :required "required") + (:label "Submit" :field-type "button" :onclick "on_contact_us_email_submit_clicked()")))) + +(defun contact-us-json () + (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-woodriverlessons-database + (let ((contact-pkg (make-instance 'contact-pkg)) + (contact-us-post (make-instance 'contact-us-post))) + (loop for param in (sb-introspect:function-lambda-list #'contact-us-email-json) + do (setf (slot-value contact-us-post param) (symbol-value param))) + (insert-contact-us-post contact-pkg contact-us-post) + (handler-case + (let ((text-message (format nil + "A contact-us form submission was received.~%~%Name: ~a ~a~%Email: ~a~%Phone: ~a~%~%Message: ~a~%" + (first_name contact-us-post) + (last_name contact-us-post) + (email contact-us-post) + (phone contact-us-post) + (comments contact-us-post))) + (html-message (org-ckons-http::html5 + `(html + ((p) "A contact-us form submission was received.") + ((p) + ,(format nil + "Name: ~a ~a<br/>Email: ~a<br/>Phone: ~a" + (first_name contact-us-post) + (last_name contact-us-post) + (email contact-us-post) + (phone contact-us-post))) + ((p) + ,(format nil "Message: ~a" (comments contact-us-post))))))) + (org-ckons-core::sendmail (mail-mx *webapp*) + (mail-postmaster *webapp*) + (mail-info *webapp*) + (format nil "~a contact-us form" (name *webapp*)) + text-message + :html-message html-message + :reply-to (mail-postmaster *webapp*) + :ssl (mail-ssl *webapp*) + :authentication (mail-authentication *webapp*)) + (setf (session-value :message) "Form submitted successfully.")) + (error (e) + (declare (ignore e)) + (setf (session-value :errormsg) "Error submitting form."))))))) diff --git a/lisp/service/generic-form.lisp b/lisp/service/generic-form.lisp new file mode 100644 index 0000000..4b3d2e9 --- /dev/null +++ b/lisp/service/generic-form.lisp @@ -0,0 +1,87 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :woodriverlessons) + +(defclass generic-form (base-service) + ((name :initarg :name + :initform nil + :accessor name) + (http-method :initarg :http-method + :initform "POST" + :accessor http-method) + (action :initarg :action + :initform nil + :accessor action) + (required-p :initarg :required-p + :initform nil + :accessor required-p) + (form-fields :initarg :form-fields + :initform nil + :accessor form-fields)) + (:documentation "")) + +(defclass form-field (base-service) + ((name :initarg :name + :initform nil + :accessor name) + (label :initarg :label + :initform nil + :accessor label) + (value :initarg :value + :initform nil + :accessor value) + (checked :initarg :checked + :initform nil + :accessor checked) + (field-type :initarg :field-type + :initform nil + :accessor field-type) + (required :initarg :required + :initform nil + :accessor required) + (dismiss :initarg :dismiss + :initform nil + :accessor dismiss) + (options :initarg :options + :initform nil + :accessor options) + (onclick :initarg :onclick + :initform nil + :accessor onclick) + (onchange :initarg :onchange + :initform nil + :accessor onchange)) + (:documentation "")) + +(defclass option (base-service) + ((label :initarg :label + :initform nil + :accessor label) + (value :initarg :value + :initform nil + :accessor value)) + (:documentation "")) + +(defun make-form (name action required-p fields) + (make-instance 'generic-form + :name name + :action action + :required-p required-p + :form-fields (mapcar (lambda (field) + (make-instance 'form-field + :name (getf field :name) + :label (getf field :label) + :value (getf field :value) + :checked (getf field :checked) + :field-type (getf field :field-type) + :required (getf field :required) + :dismiss (getf field :dismiss) + :options (mapcar (lambda (option) + (make-instance 'option + :label (getf option :label) + :value (getf option :value))) + (getf field :options)) + :onclick (getf field :onclick) + :onchange (getf field :onchange))) + fields))) diff --git a/lisp/service/generics.lisp b/lisp/service/generics.lisp new file mode 100644 index 0000000..4b58078 --- /dev/null +++ b/lisp/service/generics.lisp @@ -0,0 +1,15 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :woodriverlessons) + +(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 new file mode 100644 index 0000000..99bd3e7 --- /dev/null +++ b/lisp/service/home-service.lisp @@ -0,0 +1,18 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :woodriverlessons) + +(defclass home-service (rest-service) + ((content :initarg :content + :initform nil + :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)))) diff --git a/lisp/service/login-service.lisp b/lisp/service/login-service.lisp new file mode 100644 index 0000000..5f27236 --- /dev/null +++ b/lisp/service/login-service.lisp @@ -0,0 +1,64 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :woodriverlessons) + +(defclass login-service (rest-service) + ((form :initarg :form + :initform nil + :accessor form) + (title :initarg :title + :initform nil + :accessor title)) + (:documentation "")) + +(defclass login-forgot-service (login-service) + () + (: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 "Passworda" :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)) + +(defun login-forgot-json () + (with-noauth (instance login-forgot-service) + t)) + +(defclass login-authenticate-service (rest-service) + ((location-p :initform nil)) + (:documentation "")) + +(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.") + (with-woodriverlessons-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)) + (t + (setf (session-value :message) nil) + (setf (session-value :errormsg) "Login failed.")))))) + (setf (message instance) (session-value :message)) + (setf (errormsg instance) (session-value :errormsg)))) diff --git a/lisp/service/logout-service.lisp b/lisp/service/logout-service.lisp new file mode 100644 index 0000000..ce6a09f --- /dev/null +++ b/lisp/service/logout-service.lisp @@ -0,0 +1,14 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :woodriverlessons) + +(defclass logout-service (rest-service) + ((location-p :initform nil)) + (:documentation "")) + +(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 new file mode 100644 index 0000000..3c1c705 --- /dev/null +++ b/lisp/service/menu-service.lisp @@ -0,0 +1,95 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :woodriverlessons) + +(defparameter *menu-config* '((:id "a_menu_home" :label "Home" :handler "/home" :permissions "_Public") + (:id "a_menu_about_us" :label "About the Studio" :handler "/about-us" :permissions "_Public") + ;;(:id "a_menu_testimonials" :label "Testimonials" :handler "/testimonials" :permissions "_Public") + (:id "a_menu_contact_us" :label "Contact Me" :handler "/contact-us" :permissions "_Public") + (:id "a_menu_messages" :label "Messages" :handler "/messages" :permissions "messages-view") + (:id "a_menu_users" :label "Users" :handler "/users" :permissions "users-view"))) + +(defparameter *menu-user-config* '((:id "a_menu_login" :label "Login" :handler "/login" :permissions "_Public") + (:id "a_menu_profile" :label "Edit Profile" :handler "/profile" :permissions "_Public") + (:id "a_menu_password" :label "Change Password" :handler "/password" :permissions "_Public") + (:id "a_menu_logout" :label "Logout" :handler "/logout" :permissions "_Public"))) + +(defclass menuitem () + ((id :initarg :id + :initform nil + :accessor id) + (label :initarg :label + :initform nil + :accessor label) + (handler :initarg :handler + :initform nil + :accessor handler) + (permissions :initarg :permissions + :initform nil + :accessor permissions) + (children :initarg :children + :initform nil + :accessor children)) + (:documentation "")) + +(defclass menu-service (base-service) + ((menuitems :initarg :menuitems + :initform nil + :accessor menuitems) + (location-p :initarg :location-p + :initform nil + :accessor location-p)) + (:documentation "")) + +(defclass menu-user-service (menu-service) + ((label :initarg :label + :initform nil + :accessor label) + (location-p :initarg :location-p + :initform nil + :accessor location-p)) + (:documentation "")) + +(defmethod initialize-instance :after ((menu-service menu-service) &key user menu-config) + (with-woodriverlessons-database + (let ((auth-pkg (make-instance 'auth-pkg)) + (user-logged-in-p (and user (not (= (id user) 0)))) + roles) + (setf roles (when user (get-all-roles auth-pkg user))) + (setf (menuitems menu-service) + (remove-if (lambda (menuitem) + (find-if (lambda (x) + (string= (id menuitem) x)) + (if user-logged-in-p + '("a_menu_login") + '("a_menu_logout" "a_menu_profile" "a_menu_password")))) + (mapcar (lambda (x) + (make-instance 'menuitem + :id (getf x :id) + :label (getf x :label) + :handler (getf x :handler) + :permissions (getf x :permissions))) + (remove-if 'null (mapcar (lambda (x) + (when (find-if (lambda (y) + (string= (getf x :permissions) y)) + (mapcar (lambda (z) + (role_name z)) + roles)) + x)) + menu-config)))))))) + +(defun menu-json () + (org-ckons-json::objects-to-json `(,(make-instance 'menu-service + :user (get-user) + :menu-config *menu-config*)))) + +(defun menu-user-json () + (let* ((user (get-user)) + (instance (make-instance 'menu-user-service + :user user + :menu-config *menu-user-config*))) + (setf (label instance) (if user + (format nil "~a ~a" (first_name user) (last_name user)) + "No User Found")) + (org-ckons-json::objects-to-json `(,instance)))) diff --git a/lisp/service/messages-service.lisp b/lisp/service/messages-service.lisp new file mode 100644 index 0000000..e5bd6d0 --- /dev/null +++ b/lisp/service/messages-service.lisp @@ -0,0 +1,57 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :woodriverlessons) + +(defclass messages-service (auth-service) + ((title :initarg :title + :initform nil + :accessor title) + (form :initarg :form + :initform nil + :accessor form)) + (: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 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") + (when read (setf (session-value :messages-read) read)) + (with-woodriverlessons-database + (let ((contact-pkg (make-instance 'contact-pkg))) + (setf (results instance) (get-contact-us-posts contact-pkg + (id (get-user)) + (string= (session-value :messages-read) "read"))))) + (sanitize-rest-json instance) + (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-woodriverlessons-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))) + (error (e) + (declare (ignore e)) + (setf (session-value :errormsg) (format nil "Error marking message ~a." read))))))) diff --git a/lisp/service/password-service.lisp b/lisp/service/password-service.lisp new file mode 100644 index 0000000..bd22248 --- /dev/null +++ b/lisp/service/password-service.lisp @@ -0,0 +1,50 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :woodriverlessons) + +(defclass password-service (auth-service user) + ((form :initarg :form + :initform nil + :accessor form) + (title :initarg :title + :initform nil + :accessor title)) + (:documentation "")) + +(defun password-json () + (with-auth (instance password-service "profile-modify") + (let ((user (get-user))) + (setf (title instance) "Change Password") + (setf (form instance) (make-form "password-form" + nil + t + `((:name "id" :label "" :field-type "hidden" :value ,(id user) :required "required") + (:name "pwd" :label "Password" :field-type "password" :required "required") + (: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") + (setf (title instance) "Change Password") + (with-woodriverlessons-database + (let ((user (get-user))) + (if (and (= id (id user)) + (string= pwd pwd2)) + (let ((auth-pkg (make-instance 'auth-pkg))) + (loop for param in (remove-if (lambda (x) + (intersection `(,x) '(id pwd2))) + (sb-introspect:function-lambda-list #'password-submit-json)) 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.")))))) diff --git a/lisp/service/profile-service.lisp b/lisp/service/profile-service.lisp new file mode 100644 index 0000000..0334652 --- /dev/null +++ b/lisp/service/profile-service.lisp @@ -0,0 +1,61 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :woodriverlessons) + +(defclass profile-service (auth-service user) + ((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/modify-service (profile-service) + ((form :initarg :form + :initform nil + :accessor form) + (location-p :initform nil)) + (:documentation "")) + +(defun profile-modify-json () + (with-auth (instance profile/modify-service "profile-modify") + (let ((user (get-user))) + (sanitize-rest-json instance) + (setf (title instance) "Profile - Modify") + (setf (form instance) (make-form "profile-modify-form" + nil + t + `((:name "id" :label "" :field-type "hidden" :value ,(id user) :required "required") + (:name "username" :label "Username" :field-type "text" :value ,(username user) :required "required") + (:name "first_name" :label "First Name" :field-type "text" :value ,(first_name user) :required "required") + (: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)) + (:label "Modify Profile" :field-type "button" :onclick "on_profile_modify_submit_clicked()"))))))) + +(defun profile-modify-submit-json (id username first_name last_name email phone) + (declare (special username first_name last_name email phone)) + (with-auth (instance profile/modify-service "profile-modify") + (with-woodriverlessons-database + (let ((user (get-user))) + (if (= id (id user)) + (let ((auth-pkg (make-instance 'auth-pkg))) + (loop for param in (remove-if (lambda (x) + (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.")))))) diff --git a/lisp/service/rest-service.lisp b/lisp/service/rest-service.lisp new file mode 100644 index 0000000..eed7a51 --- /dev/null +++ b/lisp/service/rest-service.lisp @@ -0,0 +1,41 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :woodriverlessons) + +(defclass rest-service (base-service) + ((location :initarg :location + :initform nil + :accessor location) + (location-p :initarg :location-p + :initform t + :accessor location-p) + (errormsg :initarg :errormsg + :initform nil + :accessor errormsg) + (message :initarg :message + :initform nil + :accessor message)) + (:documentation "")) + +(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))))) + +(defun location-json (&optional (location "/home")) + (format nil "{\"location\":\"~a\"}" location)) + +(defun type-to-path (rest-type) + (concatenate 'string "/" (ppcre:regex-replace "-service$" (string-downcase (type-of rest-type)) ""))) + +(defmethod sanitize-rest-json ((rest-service rest-service)) + (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))) diff --git a/lisp/service/testimonials-service.lisp b/lisp/service/testimonials-service.lisp new file mode 100644 index 0000000..8f3d3e0 --- /dev/null +++ b/lisp/service/testimonials-service.lisp @@ -0,0 +1,69 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :woodriverlessons) + +(defclass testimonials-service (rest-service) + ((title :initarg :title + :initform nil + :accessor title)) + (:documentation "")) + +(defun testimonials-json () + (with-noauth (instance testimonials-service) + (setf (title instance) "Testimonials"))) + +(defclass testimonials/view-service (testimonials-service) + ((content :initarg :content + :initform nil + :accessor content) + (form :initarg :form + :initform nil + :accessor form) + (admin-p :initarg :admin-p + :initform t + :accessor admin-p) + (location-p :initform nil)) + (:documentation "")) + +(defun testimonials-view-json () + (with-noauth (instance testimonials/view-service) + (with-valid-user (user "testimonials-modify") + (setf (admin-p instance) nil) + (setf (admin-p instance) t)) + (with-woodriverlessons-database + (let* ((general-pkg (make-instance 'general-pkg)) + (testimonials (get-testimonials general-pkg))) + (when testimonials + (setf (content instance) (content testimonials))))))) + +(defclass testimonials/modify-service (testimonials/view-service auth-service) + () + (:documentation "")) + +(defun testimonials-modify-json () + (with-auth (instance testimonials/modify-service "testimonials-modify") + (setf (title instance) "Testimonials - Modify") + (with-woodriverlessons-database + (let* ((general-pkg (make-instance 'general-pkg)) + (testimonials (get-testimonials general-pkg)) + content) + (when testimonials + (setf content (content testimonials))) + (setf (form instance) (make-form "testimonials-modify-form" + nil + nil + `((:name "txt-content" :field-type "textarea" :value ,content) + (:label "Modify" :field-type "button" :onclick "on_testimonials_modify_submit_clicked()")))))))) + +(defun testimonials-modify-submit-json (content) + (with-auth (instance testimonials/modify-service "testimonials-modify") + (setf (title instance) "Testimonials - Modify") + (with-woodriverlessons-database + (let* ((general-pkg (make-instance 'general-pkg)) + (testimonials (get-testimonials general-pkg))) + (when testimonials + (setf (content testimonials) content) + (update-record general-pkg testimonials)))) + (setf (content instance) content) + (setf (session-value :message) "Testimonials text saved successfully."))) diff --git a/lisp/service/users-service.lisp b/lisp/service/users-service.lisp new file mode 100644 index 0000000..1c317ae --- /dev/null +++ b/lisp/service/users-service.lisp @@ -0,0 +1,283 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :woodriverlessons) + +(defclass users-service (auth-service) + ((title :initarg :title + :initform nil + :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 + :accessor users) + (location-p :initform nil)) + (:documentation "")) + +(defun users-view-json () + (with-auth (instance users/view-service "users-view") + (with-woodriverlessons-database + (let ((auth-pkg (make-instance 'auth-pkg))) + (setf (users instance) (get-all-users auth-pkg)))) + (sanitize-rest-json instance) + (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) + (remove-if 'null + (mapcar (lambda (role-group) + (when (not (intersection `(,(name role-group)) `("_Public" "profile-admin") :test 'string=)) + (let ((checked (when (intersection `(,(name role-group)) + (mapcar (lambda (x) + (name x)) + 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))))) + role-groups))) + +(defun users-add-json () + (with-auth (instance users/add-service "users-modify") + (setf (title instance) "Users - Add") + (with-woodriverlessons-database + (let* ((auth-pkg (make-instance 'auth-pkg)) + (user (get-user)) + (role-groups (get-all-role-groups auth-pkg user))) + (setf (form instance) (make-form "users-add-form" + nil + t + `((:name "first_name" :label "First Name" :field-type "text" :required "required") + (:name "last_name" :label "Last Name" :field-type "text" :required "required") + (:name "email" :label "Email" :field-type "text" :required "required") + ,@(role-checkboxes role-groups + `(,(get-role-group-by-name auth-pkg user "emails-viewer"))) + (: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-woodriverlessons-database + (let ((registration (make-instance 'registration))) + (loop for param in (sb-introspect:function-lambda-list #'users-add-submit-json) do + (setf (slot-value registration param) (symbol-value param))) + (let* ((auth-pkg (make-instance 'auth-pkg)) + (id (insert-registration auth-pkg registration))) + (setf registration (get-registration-by-id auth-pkg id))) + (handler-case + (let ((text-message (format nil + "Hello ~a ~a and welcome to the ~a website!~%~%A user account registration has been created for you. It expires in 3 days.~%~%Please click the following link to complete the registration:~%~%~a://~a/register?hash=~a~%" + (name *webapp*) + (first_name registration) + (last_name registration) + (scheme *webapp*) + (url *webapp*) + (hash registration))) + (html-message (org-ckons-http::html5 + `(html + ((p) + ,(format nil + "Hello ~a ~a and welcome to ~a!" + (name *webapp*) + (first_name registration) + (last_name registration))) + ((p) "A user account registration has been created for you. It expires in 3 days.") + ((p) "Please click the following link to complete the registration:") + ((p) + ((a :href ,(format nil + "~a://~a/register?hash=~a" + (scheme *webapp*) + (url *webapp*) + (hash registration))) + ,(format nil + "~a://~a/register?hash=~a" + (scheme *webapp*) + (url *webapp*) + (hash registration)))))))) + (org-ckons-core::sendmail (mail-mx *webapp*) + (mail-info *webapp*) + (email registration) + (format nil "~a website registration" (name *webapp*)) + text-message + :html-message html-message + :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)))) + (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 "")) + +(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-woodriverlessons-database + (let* ((auth-pkg (make-instance 'auth-pkg)) + (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 "")) + +(defun users-register-submit-json (hash username pwd pwd2 phone) + (with-noauth (instance users/register/submit-service) + (with-woodriverlessons-database + (let ((auth-pkg (make-instance 'auth-pkg)) + 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 "")) + +(defun users-modify-json (id) + (with-auth (instance users/modify-service "users-modify") + (setf (title instance) "Users - Modify") + (with-woodriverlessons-database + (let* ((auth-pkg (make-instance 'auth-pkg)) + (me (get-user)) + (user (get-user-by-id auth-pkg id)) + (role-groups (get-all-role-groups auth-pkg me)) + (active-role-groups (get-active-role-groups auth-pkg user))) + (if user + (setf (form instance) (make-form "users-modify-form" + nil + t + `((:name "id" :field-type "hidden" :value ,(id user) :required "required") + (:name "username" :label "Username" :field-type "text" :value ,(username user) :required "required") + (:name "first_name" :label "First Name" :field-type "text" :value ,(first_name user) :required "required") + (: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) + (:label "Modify User" :field-type "button" :onclick "on_users_modify_submit_clicked()")))) + (setf (session-value :errormsg) "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)) + (with-auth (instance users/modify-service "users-modify") + (with-woodriverlessons-database + (let* ((auth-pkg (make-instance 'auth-pkg)) + (user (get-active-user-by-id auth-pkg id))) + (if user + (progn + (loop for param in (remove-if (lambda (x) + (intersection `(,x) '(id role_groups))) + (sb-introspect:function-lambda-list #'users-modify-submit-json)) + do (setf (slot-value user param) (symbol-value param))) + (update-user auth-pkg user) + (delete-role-groups auth-pkg user) + (loop for role-group in (union '("profile-admin") + (cl-ppcre:split "\\|" role_groups) + :test 'string=) do + (insert-user-role-group auth-pkg (make-instance 'user-role + :user_id (id user) + :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 "")) + +(defun users-toggle-active-json (id) + (with-auth (instance users/toggle-service "users-modify") + (with-woodriverlessons-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.") + (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 "")) + +(defun users-delete-json (id) + (with-auth (instance users/delete-service "users-modify") + (with-woodriverlessons-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.") + (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.")))))) diff --git a/lisp/sql/about-us.lisp b/lisp/sql/about-us.lisp new file mode 100644 index 0000000..51e4409 --- /dev/null +++ b/lisp/sql/about-us.lisp @@ -0,0 +1,15 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :woodriverlessons) + +(defclass about-us (postgres-record) + ((id :initarg :id + :initform nil + :accessor id) + (content :initarg :content + :initform nil + :accessor content) + (*table :initform "general.about_us") + (*where-expression :initform "id = ~a")) + (:documentation "Holds the data for a general.about_us type.")) diff --git a/lisp/sql/auth-pkg.lisp b/lisp/sql/auth-pkg.lisp new file mode 100644 index 0000000..54f8c3e --- /dev/null +++ b/lisp/sql/auth-pkg.lisp @@ -0,0 +1,205 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :woodriverlessons) + +(defparameter *authenticated-user-session-key* "authenticated-user") + +(defclass auth-pkg (record-pkg) + () + (:documentation "")) + +(defmethod insert-user ((auth-pkg auth-pkg) user) + (setf (*table user) (format nil + "auth.insert_user('~a', '~a', '~a', '~a', '~a', '~a', '~a')" + (username user) + (pwd user) + (first_name user) + (last_name user) + (email user) + (phone user) + (active user))) + (setf (id user) (caar (call-pg-function auth-pkg user))) + (id user)) + +(defmethod update-user ((auth-pkg auth-pkg) user) + (setf (*table user) (format nil + "auth.update_user(~a, '~a', '~a', '~a', '~a', '~a')" + (id user) + (username user) + (first_name user) + (last_name user) + (email user) + (phone user))) + (caar (call-pg-function auth-pkg user))) + +(defmethod get-all-active-users ((auth-pkg auth-pkg)) + (let ((user (make-instance 'user))) + (setf (*table user) "auth.get_all_active_users()") + (get-records auth-pkg user "first_name asc, last_name asc"))) + +(defmethod get-all-users ((auth-pkg auth-pkg)) + (let ((user (make-instance 'user))) + (setf (*table user) "auth.get_all_users()") + (get-records auth-pkg user "first_name asc, last_name asc"))) + +(defmethod get-active-user-by-username-pwd ((auth-pkg auth-pkg) username pwd) + (let ((user (make-instance 'user))) + (setf (*table user) (format nil + "auth.get_active_user_by_username_pwd('~a', '~a')" + username + pwd)) + (get-record auth-pkg user))) + +(defmethod get-active-user-by-id ((auth-pkg auth-pkg) id) + (let ((user (make-instance 'user))) + (setf (*table user) (format nil "auth.get_active_user_by_id(~a)" id)) + (get-record auth-pkg user))) + +(defmethod get-user-by-id ((auth-pkg auth-pkg) id) + (let ((user (make-instance 'user))) + (setf (*table user) (format nil "auth.get_user_by_id(~a)" id)) + (get-record auth-pkg user))) + +(defmethod user-toggle-active ((auth-pkg auth-pkg) (user user)) + (setf (*table user) (format nil "auth.user_toggle_active(~a)" (id user))) + (call-pg-function auth-pkg user)) + +(defmethod deactivate-user ((auth-pkg auth-pkg) (user user)) + (setf (*table user) (format nil "auth.user_delete(~a)" (id user))) + (call-pg-function auth-pkg user)) + +(defmethod get-all-roles ((auth-pkg auth-pkg) (user user)) + (let ((user-role (make-instance 'user-role + :*table (format nil + "auth.get_all_roles_for_user(~a)" + (id user))))) + (get-records auth-pkg user-role nil))) + +(defmethod has-role ((auth-pkg auth-pkg) (user user) role) + (let ((user-role (make-instance 'user-role))) + (setf (*table user-role) (format nil (*table user-role) (id user) role)) + (get-record auth-pkg user-role))) + +(defmethod get-all-role-groups ((auth-pkg auth-pkg) (user user)) + (let ((role-group (make-instance 'role-group))) + (setf (*table role-group) (format nil (*table role-group) (id user))) + (get-records auth-pkg role-group nil))) + +(defmethod get-role-group-by-name ((auth-pkg auth-pkg) (user user) name) + (find-if (lambda (x) + (string= name (name x))) + (get-all-role-groups auth-pkg user))) + +(defmethod get-active-role-groups ((auth-pkg auth-pkg) (user user)) + (let ((role-group (make-instance 'role-group + :*table (format nil + "auth.get_active_role_groups_for_user(~a)" + (id user))))) + (get-records auth-pkg role-group nil))) + +(defmethod insert-user-role-group ((auth-pkg auth-pkg) (user-role user-role)) + (setf (*table user-role) (format nil + "auth.insert_user_role_group(~a, '~a')" + (user_id user-role) + (role_group_name user-role))) + (caar (call-pg-function auth-pkg user-role))) + +(defmethod insert-registration ((auth-pkg auth-pkg) (registration registration)) + (setf (*table registration) (format nil + "auth.insert_registration('~a', '~a', '~a', '~a')" + (first_name registration) + (last_name registration) + (email registration) + (role_groups registration))) + (setf (id registration) (caar (call-pg-function auth-pkg registration))) + (id registration)) + +(defmethod delete-role-groups ((auth-pkg auth-pkg) user) + (let ((role-group (make-instance 'role-group + :*table (format nil + "auth.delete_role_groups_for_user(~a)" + (id user))))) + (call-pg-function auth-pkg role-group))) + +(defmethod get-registration-by-id ((auth-pkg auth-pkg) id) + (let ((registration (make-instance 'registration + :*table (format nil "auth.get_registration_by_id(~a)" id)))) + (get-record auth-pkg registration))) + +(defmethod get-registration-by-hash ((auth-pkg auth-pkg) hash) + (let ((registration (make-instance 'registration + :*table (format nil "auth.get_registration_by_hash('~a')" hash)))) + (get-record auth-pkg registration))) + +(defmethod registrations-gc ((auth-pkg auth-pkg)) + (let ((registration (make-instance 'registration :*table "auth.registrations_gc()"))) + (call-pg-function auth-pkg registration))) + +(defmethod delete-registration ((auth-pkg auth-pkg) hash) + (let ((registration (make-instance 'registration + :*table (format nil "auth.delete_registration('~a')" hash)))) + (call-pg-function auth-pkg registration))) + +(defmethod update-profile ((auth-pkg auth-pkg) (user user)) + (setf (*table user) (format nil + "auth.update_profile(~a, '~a', '~a', '~a', '~a', '~a')" + (id user) + (username user) + (first_name user) + (last_name user) + (email user) + (phone user))) + (call-pg-function auth-pkg user)) + +(defmethod update-password ((auth-pkg auth-pkg) (user user)) + (setf (*table user) (format nil "auth.update_password(~a, '~a')" (id user) (pwd user))) + (call-pg-function auth-pkg user)) + +(defmacro with-valid-user ((session-name roles) error-body &body body) + "Runs `body' if there is a valid authenticated `user' in the +`user-session' whose roles match `roles', otherwise runs +`error-body'. If a valid `user' exists, it will be bound to +`session-name'." + `(let ((,session-name (get-session-object *authenticated-user-session-key*))) + (if ,session-name + (let* ((auth-pkg (make-instance 'auth-pkg)) + (has-all-roles-p (let ((has-all-roles-p t)) + (with-woodriverlessons-database + (loop for role in (if (listp ,roles) ,roles (list ,roles)) do + (when (not (has-role auth-pkg ,session-name role)) + (setf has-all-roles-p nil))) + has-all-roles-p)))) + (if has-all-roles-p + ,@body + ,error-body)) + ,error-body))) + +(defun make-default-user () + "Convenience function for making a new instance of `user' that has +its session key set to `authenticated-user', but has no privileges." + (make-instance 'user + :*session-key *authenticated-user-session-key* + :id 0 + :first_name "Guest" + :last_name "User")) + +(defun ensure-user-exists () + "Ensures that there is an `authenticated-user' in the user session, +even if it's just a guest user." + (let ((user (get-session-object *authenticated-user-session-key*))) + (unless user + (setf user (make-default-user)) + (set-user user)))) + +(defun get-user () + "Convenience function for getting the `authenticated-user' from user +session." + (get-session-object *authenticated-user-session-key*)) + +(defun set-user (user) + "Convenience function for setting the `authenticated-user' into the +user session." + (setf (*table user) "auth.users") + (setf (pwd user) nil) + (set-session-object *authenticated-user-session-key* user)) diff --git a/lisp/sql/contact-pkg.lisp b/lisp/sql/contact-pkg.lisp new file mode 100644 index 0000000..390d861 --- /dev/null +++ b/lisp/sql/contact-pkg.lisp @@ -0,0 +1,32 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :woodriverlessons) + +(defclass contact-pkg (record-pkg) + () + (:documentation "")) + +(defmethod get-contact-us-posts ((contact-pkg contact-pkg) user-id read-p) + (let ((contact-us-post (make-instance 'contact-us-post))) + (setf (*table contact-us-post) (format nil (*table contact-us-post) user-id (if read-p "t" "f"))) + (get-records contact-pkg contact-us-post nil))) + +(defmethod insert-contact-us-post ((contact-pkg contact-pkg) (contact-us-post contact-us-post)) + (setf (*table contact-us-post) (format nil + "contact.insert_contact_us_post('~a', '~a', '~a', '~a', '~a')" + (first_name contact-us-post) + (last_name contact-us-post) + (email contact-us-post) + (phone contact-us-post) + (comments contact-us-post))) + (caar (call-pg-function contact-pkg contact-us-post))) + +(defmethod mark-contact-us-post ((contact-pkg contact-pkg) contact-us-post-id user-id read-p) + (let ((contact-us-post (make-instance 'contact-us-post + :*table (format nil + "contact.mark_contact_us_post(~a, ~a, '~a')" + contact-us-post-id + user-id + (if read-p "t" "f"))))) + (call-pg-function contact-pkg contact-us-post))) diff --git a/lisp/sql/contact-us.lisp b/lisp/sql/contact-us.lisp new file mode 100644 index 0000000..9a7f30b --- /dev/null +++ b/lisp/sql/contact-us.lisp @@ -0,0 +1,50 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :woodriverlessons) + +(defclass contact-us (postgres-record) + ((id :initarg :id + :initform nil + :accessor id) + (content :initarg :content + :initform nil + :accessor content) + (*table :initform "contact.contact_us") + (*where-expression :initform "id = ~a")) + (:documentation "Holds the data for a contact.contact_us type.")) + +(defclass contact-us-post (postgres-record) + ((id :initarg :id + :initform nil + :accessor id) + (first_name :initarg :first_name + :initform nil + :accessor first_name) + (last_name :initarg :last_name + :initform nil + :accessor last_name) + (email :initarg :email + :initform nil + :accessor email) + (phone :initarg :phone + :initform nil + :accessor phone) + (submitted :initarg :submitted + :initform nil) + (comments :initarg :comments + :initform nil + :accessor comments) + (*table :initform "contact.get_contact_us_posts_by_id_and_read(~a, '~a')") + (*where-expression :initform nil)) + (:documentation "Holds the data for a contact.contact_us_posts type.")) + +(defmethod submitted ((contact-us-post contact-us-post)) + (slot-value contact-us-post 'submitted)) + +(defmethod (setf submitted) (value (contact-us-post contact-us-post)) + (handler-case + (setf (slot-value contact-us-post 'submitted) (simple-date-to-date value)) + (error (e) + (declare (ignore e)) + (setf (slot-value contact-us-post 'submitted) nil)))) diff --git a/lisp/sql/general-pkg.lisp b/lisp/sql/general-pkg.lisp new file mode 100644 index 0000000..162d60b --- /dev/null +++ b/lisp/sql/general-pkg.lisp @@ -0,0 +1,14 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :woodriverlessons) + +(defclass general-pkg (record-pkg) + () + (:documentation "")) + +(defmethod get-about-us ((general-pkg general-pkg)) + (car (get-records general-pkg (make-instance 'about-us) nil))) + +(defmethod get-testimonials ((general-pkg general-pkg)) + (car (get-records general-pkg (make-instance 'testimonials) nil))) diff --git a/lisp/sql/generics.lisp b/lisp/sql/generics.lisp new file mode 100644 index 0000000..708856a --- /dev/null +++ b/lisp/sql/generics.lisp @@ -0,0 +1,145 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :woodriverlessons) + +(defmacro with-woodriverlessons-database (&body body) + `(with-database (getf (databases *webapp*) :db-woodriverlessons) ,@body)) + +(defgeneric insert-user (auth-pkg user) + (:documentation "Inserts a new user into the database.")) + +(defgeneric update-user (auth-pkg user) + (:documentation "Updates a user in the database.")) + +(defgeneric get-all-active-users (record-pkg) + (:documentation "Calls `get_all_active_users'.")) + +(defgeneric get-all-users (record-pkg) + (:documentation "Calls `get_all_users'.")) + +(defgeneric get-active-user-by-username-pwd (record-pkg username pwd) + (:documentation "Calls `get_active_user_by_username_pwd'.")) + +(defgeneric get-active-user-by-id (record-pkg id) + (:documentation "Calls `get_active_user_by_id'.")) + +(defgeneric get-user-by-id (record-pkg id) + (:documentation "Calls `get_user_by_id'.")) + +(defgeneric user-toggle-active (record-pkg user) + (:documentation "Calls `user_toggle_active'.")) + +(defgeneric user-delete (record-pkg user) + (:documentation "Calls `user_delete'.")) + +(defgeneric get-all-roles (record-pkg record) + (:documentation "Returns all the roles for a `user'.")) + +(defgeneric has-role (record-pkg record role) + (:documentation "Returns `t' when the user exists and has the +specified `role', `nil' otherwise.")) + +(defgeneric get-all-role-groups (auth-pkg user) + (:documentation "Returns all the role-groups for a `user'.")) + +(defgeneric get-role-group-by-name (auth-pkg user name) + (:documentation "Returns a role-group by `name' for a `user'.")) + +(defgeneric get-active-role-groups (auth-pkg user) + (:documentation "Returns all the role-groups for a `user' that are +actually present in `auth.users_role_groups', in other words the +role-groups that are assigned to the user without any superuser +magic.")) + +(defgeneric insert-user-role-group (auth-pkg user-role) + (:documentation "Idempotently inserts a new record into +auth.user_role_groups based on the user ID and the role group name.")) + +(defgeneric delete-role-groups (auth-pkg user) + (:documentation "Delete all role-group assignments for a user.")) + +(defgeneric update-profile (record-pkg record) + (:documentation "")) + +(defgeneric update-password (auth-pkg user) + (:documentation "")) + +(defgeneric get-user-sessions (record-pkg) + (:documentation "Gets all user session records.")) + +(defgeneric get-user-session (record-pkg &optional sessionid) + (:documentation "")) + +(defgeneric update-timestamp (record-pkg record) + (:documentation "Updates the timestamp of the `user-session'.")) + +(defgeneric get-user-session-objects (record-pkg record) + (:documentation "Get all user session objects associated with a user +session.")) + +(defgeneric get-user-session-object (record-pkg session-key) + (:documentation "")) + +(defgeneric flush-user-session-object (record-pkg session-key) + (:documentation "")) + +(defgeneric create-user-session (record-pkg) + (:documentation "Creates a new user session and returns the +sessionid.")) + +(defgeneric get-about-us (record-pkg) + (:documentation "Gets the one and only general.about_us record.")) + +(defgeneric get-testimonials (record-pkg) + (:documentation "Gets the one and only general.testimonials record.")) + +(defgeneric get-contact-us-posts (record-pkg user-id read-p) + (:documentation "Gets contact.contact_us_posts records.")) + +(defgeneric insert-contact-us-post (contact-pkg contact-us-post) + (:documentation "Inserts a new contact-us post into +contact.contact_us_posts. Returns the ID of the new record.")) + +(defgeneric mark-contact-us-post (contact-pkg contact-us-post-id user-id read-p) + (:documentation "Marks or unmarks a contact-us post as read.")) + +(defgeneric insert-registration (auth-pkg registration) + (:documentation "Inserts a new registration into +auth.registrations. Returns the ID of the new record.")) + +(defgeneric get-registration-by-id (auth-pkg id) + (:documentation "Gets the record from auth.registrations with the +given `id'.")) + +(defgeneric get-registration-by-hash (auth-pkg hash) + (:documentation "Gets the record from auth.registrations with the +given `hash'.")) + +(defgeneric registrations-gc (auth-pkg) + (:documentation "Garbage collects registrations that are more than 3 +days old.")) + +(defgeneric delete-registration (auth-pkg hash) + (:documentation "Deletes a registration with the given `hash'.")) + +(defgeneric event_date (record) + (:documentation "Reader for the event_date field. Converts a +local-time::timestamp to a SQL date string.")) + +(defgeneric (setf event_date) (value record) + (:documentation "Writer for the event_date field.")) + +(defgeneric submitted (record) + (:documentation "Reader for the submitted field. Converts a +local-time::timestamp to a SQL date string.")) + +(defgeneric (setf submitted) (value record) + (:documentation "Writer for the submitted field.")) + +(defgeneric created (record) + (:documentation "Reader for the created field. Converts a +local-time::timestamp to a SQL date string.")) + +(defgeneric (setf created) (value record) + (:documentation "Writer for the created field.")) diff --git a/lisp/sql/registration.lisp b/lisp/sql/registration.lisp new file mode 100644 index 0000000..a1a2919 --- /dev/null +++ b/lisp/sql/registration.lisp @@ -0,0 +1,42 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :woodriverlessons) + +(defclass registration (postgres-record) + ((id :initarg :id + :initform nil + :accessor id) + (hash :initarg :hash + :initform nil + :accessor hash) + (first_name :initarg :first_name + :initform nil + :accessor first_name) + (last_name :initarg :last_name + :initform nil + :accessor last_name) + (email :initarg :email + :initform nil + :accessor email) + (role_groups :initarg :role_groups + :initform nil + :accessor role_groups) + (created :initarg :created + :initform nil) + (valid_for :initarg :valid_for + :initform nil + :accessor valid_for) + (*table :initform "auth.registrations") + (*where-expression :initform "id = ~a")) + (:documentation "Holds the data for an auth.registrations type.")) + +(defmethod created ((registration registration)) + (slot-value registration 'created)) + +(defmethod (setf created) (value (registration registration)) + (handler-case + (setf (slot-value registration 'created) (simple-date-to-date value)) + (error (e) + (declare (ignore e)) + (setf (slot-value registration 'created) nil)))) diff --git a/lisp/sql/role-group.lisp b/lisp/sql/role-group.lisp new file mode 100644 index 0000000..50d73f7 --- /dev/null +++ b/lisp/sql/role-group.lisp @@ -0,0 +1,24 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :woodriverlessons) + +(defclass role-group (postgres-record) + ((user_role_group_id :initarg :user_role_group_id + :initform nil + :accessor user_role_group_id) + (user_id :initarg :user_id + :initform nil + :accessor user_id) + (role_group_id :initarg :role_group_id + :initform nil + :accessor role_group_id) + (name :initarg :name + :initform nil + :accessor name) + (description :initarg :description + :initform nil + :accessor description) + (*table :initform "auth.get_all_role_groups_for_user(~a)") + (*where-expression :initform nil)) + (:documentation "Holds the data for an auth.role_group_t type.")) diff --git a/lisp/sql/testimonials.lisp b/lisp/sql/testimonials.lisp new file mode 100644 index 0000000..37ac3d3 --- /dev/null +++ b/lisp/sql/testimonials.lisp @@ -0,0 +1,15 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :woodriverlessons) + +(defclass testimonials (postgres-record) + ((id :initarg :id + :initform nil + :accessor id) + (content :initarg :content + :initform nil + :accessor content) + (*table :initform "general.testimonials") + (*where-expression :initform "id = ~a")) + (:documentation "Holds the data for a general.testimonials type.")) diff --git a/lisp/sql/user-role.lisp b/lisp/sql/user-role.lisp new file mode 100644 index 0000000..3042aab --- /dev/null +++ b/lisp/sql/user-role.lisp @@ -0,0 +1,36 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :woodriverlessons) + +(defclass user-role (postgres-record) + ((user_role_group_id :initarg :user_role_group_id + :initform nil + :accessor user_role_group_id) + (user_id :initarg :user_id + :initform nil + :accessor user_id) + (role_group_id :initarg :role_group_id + :initform nil + :accessor role_group_id) + (role_group_name :initarg :role_group_name + :initform nil + :accessor role_group_name) + (role_group_description :initarg :role_group_description + :initform nil + :accessor role_group_description) + (role_group_role_id :initarg :role_group_role_id + :initform nil + :accessor role_group_role_id) + (role_id :initarg :role_id + :initform nil + :accessor role_id) + (role_name :initarg :role_name + :initform nil + :accessor role_name) + (role_description :initarg :role_description + :initform nil + :accessor role_description) + (*table :initform "auth.has_role(~a, '~a')") + (*where-expression :initform nil)) + (:documentation "Holds the data for an auth.user_role_t type.")) diff --git a/lisp/sql/user-session-pkg.lisp b/lisp/sql/user-session-pkg.lisp new file mode 100644 index 0000000..8741fff --- /dev/null +++ b/lisp/sql/user-session-pkg.lisp @@ -0,0 +1,112 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :woodriverlessons) + +(defclass user-session-pkg (record-pkg) + () + (:documentation "Database-backed user session API.")) + +(defmethod get-user-sessions ((user-session-pkg user-session-pkg)) + (get-records user-session-pkg (make-instance 'user-session) "sessionid ASC")) + +(defmethod get-user-session ((user-session-pkg user-session-pkg) &optional (sessionid *sessionid*)) + (when sessionid + (get-record user-session-pkg (make-instance 'user-session :sessionid sessionid)))) + +(defmethod update-timestamp ((user-session-pkg user-session-pkg) (user-session user-session)) + (setf (datetime user-session) (get-universal-time)) + (update-record user-session-pkg user-session)) + +(defmethod get-user-session-objects ((user-session-pkg user-session-pkg) (user-session user-session)) + (get-records user-session-pkg (make-instance 'user-session-object :user_session_id (id user-session)) "session_key ASC")) + +(defmethod get-user-session-object ((user-session-pkg user-session-pkg) session-key) + (when (and *sessionid* session-key) + (let ((user-session (get-user-session user-session-pkg))) + (when user-session + (get-record user-session-pkg (make-instance 'user-session-object :user_session_id (id user-session) :session_key session-key)))))) + +(defmethod flush-user-session-object ((user-session-pkg user-session-pkg) session-key) + (when (and *sessionid* session-key) + (let ((user-session-object (get-user-session-object user-session-pkg session-key))) + (when user-session-object + (delete-record user-session-pkg user-session-object))))) + +(defmethod create-user-session ((user-session-pkg user-session-pkg)) + (let* ((sessionid (org-ckons-session::generate-sessionid)) + (user-session (make-instance 'user-session :sessionid sessionid :datetime (get-universal-time)))) + (insert-record user-session-pkg user-session) + sessionid)) + +(defun get-session-object (session-key) + "Returns the object stored in the user session under the given +`session-key'." + (with-woodriverlessons-database + (let* ((user-session-pkg (make-instance 'user-session-pkg)) + (user-session-object (get-user-session-object user-session-pkg session-key)) + object) + (when user-session-object + (setf object (org-ckons-serializable::deserialize (serialization user-session-object))) + (setf (org-ckons-session::*session-key object) session-key)) + object))) + +(defun set-session-object (session-key object) + "Sets the object into the user-session under the given +`session-key'. Will not write anything if the session given by +`*sessionid*' does not exist." + (with-woodriverlessons-database + (let* ((user-session-pkg (make-instance 'user-session-pkg)) + (user-session-object (get-user-session-object user-session-pkg session-key))) + (if user-session-object + ;; overwrite existing session object with current serialization + (progn + (setf (serialization user-session-object) (org-ckons-serializable::serialize object :package-name (package-name #.*package*))) + (update-record user-session-pkg user-session-object)) + ;; insert a new object into the session + (let ((user-session (get-user-session user-session-pkg))) + (when user-session + (setf user-session-object (make-instance 'user-session-object + :user_session_id (id user-session) + :session_key session-key + :serialization (org-ckons-serializable::serialize object :package-name (package-name #.*package*)))) + (insert-record user-session-pkg user-session-object))))))) + +(defun flush-session-object (session-key) + "Removes the object from the user session under the given +`session-key'." + (with-woodriverlessons-database + (let ((user-session-pkg (make-instance 'user-session-pkg))) + (flush-user-session-object user-session-pkg *sessionid* session-key)))) + +(defun ensure-user-session-exists (&optional force-new-sessionid-p) + "Ensures that the user has a valid sessionid cookie. Returns the +`sessionid'. If the session does exist, update its timestamp." + (with-woodriverlessons-database + (let* ((user-session-pkg (make-instance 'user-session-pkg)) + (sessionid (when (not force-new-sessionid-p) + (org-ckons-session::get-sessionid-from-request))) + (user-session (get-user-session user-session-pkg sessionid))) + (if user-session + (update-timestamp user-session-pkg user-session) + (progn + (setf sessionid (create-user-session user-session-pkg)) + (org-ckons-session::set-sessionid-cookie *header-register* sessionid))) + sessionid))) + +(defun run-garbage-collect-cycle () + "Goes through all the user sessions, expiring any that have remained +inactive for a period of time determined by the `*session-timeout*' +variable." + (when (> (- (get-universal-time) org-ckons-session::*gc-last-cycle-timestamp*) org-ckons-session::*gc-interval*) + (setf org-ckons-session::*gc-last-cycle-timestamp* (get-universal-time)) + (with-woodriverlessons-database + (let ((user-session-pkg (make-instance 'user-session-pkg))) + (loop for user-session in (get-user-sessions user-session-pkg) do + (let ((inactive-time (- org-ckons-session::*gc-last-cycle-timestamp* (datetime user-session)))) + (when (and (> inactive-time org-ckons-session::*session-timeout*) + (sessionid user-session)) + (org-ckons-core::logger (format nil "Deleting expired session: id = [~a] ; sessionid = [~a]" (id user-session) (sessionid user-session))) + (loop for user-session-object in (get-user-session-objects user-session-pkg user-session) do + (delete-record user-session-pkg user-session-object)) + (delete-record user-session-pkg user-session)))))))) diff --git a/lisp/sql/user-session.lisp b/lisp/sql/user-session.lisp new file mode 100644 index 0000000..afaa28b --- /dev/null +++ b/lisp/sql/user-session.lisp @@ -0,0 +1,35 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :woodriverlessons) + +(defclass user-session (postgres-record) + ((id :initarg :id + :initform nil + :accessor id) + (sessionid :initarg :sessionid + :initform nil + :accessor sessionid) + (datetime :initarg :datetime + :initform nil + :accessor datetime) + (*table :initform "auth.user_sessions") + (*where-expression :initform "id = ~a")) + (:documentation "Holds the data for a auth.user_session record.")) + +(defclass user-session-object (postgres-record) + ((id :initarg :id + :initform nil + :accessor id) + (user_session_id :initarg :user_session_id + :initform nil + :accessor user_session_id) + (session_key :initarg :session_key + :initform nil + :accessor session_key) + (serialization :initarg :serialization + :initform nil + :accessor serialization) + (*table :initform "auth.user_session_objects") + (*where-expression :initform "id = ~a")) + (:documentation "Holds the data for a auth.user_session record.")) diff --git a/lisp/sql/user.lisp b/lisp/sql/user.lisp new file mode 100644 index 0000000..a181ff4 --- /dev/null +++ b/lisp/sql/user.lisp @@ -0,0 +1,50 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :woodriverlessons) + +(defclass user (org-ckons-session::session-object postgres-record) + ((id :initarg :id + :initform nil + :accessor id) + (username :initarg :username + :initform nil + :accessor username) + (pwd :initarg :pwd + :initform nil + :accessor pwd) + (first_name :initarg :first_name + :initform nil + :accessor first_name) + (last_name :initarg :last_name + :initform nil + :accessor last_name) + (email :initarg :email + :initform nil + :accessor email) + (phone :initarg :phone + :initform nil + :accessor phone) + (active :initarg :active + :initform nil + :accessor active) + (created :initarg :created + :initform nil) + (*table :initform "auth.users") + (*where-expression :initform "id = ~a") + (org-ckons-session::*session-key :initform "user")) + (:documentation "Holds the data for a user record.")) + +(defmethod created ((user user)) + (slot-value user 'created)) + +(defmethod (setf created) (value (user user)) + (handler-case + (setf (slot-value user 'created) (simple-date-to-date value)) + (error (e) + (declare (ignore e)) + (setf (slot-value user 'created) nil)))) + +(defmethod sanitize-json ((user user)) + (setf (pwd user) nil) + (call-next-method)) diff --git a/lisp/webapps/generics.lisp b/lisp/webapps/generics.lisp new file mode 100644 index 0000000..58c9ad8 --- /dev/null +++ b/lisp/webapps/generics.lisp @@ -0,0 +1,12 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :woodriverlessons) + +(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 new file mode 100644 index 0000000..aafa6f3 --- /dev/null +++ b/lisp/webapps/webapp-loader.lisp @@ -0,0 +1,177 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :woodriverlessons) + +(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 woodriverlessons () + "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-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* (progn + (run-garbage-collect-cycle) + (ensure-user-session-exists)))) + (ensure-user-exists) + (setf output (,page-function ,@args)) + (org-ckons-session::ship-headers *header-register*)) + output))) + +(defmacro define-endpoint (request-type uri var-list page-function &rest args) + "Does the grunt work of creating an `easy-handler' for each page you +wish to publish." + (let ((name (gensym))) + `(progn + (org-ckons-core::logger (format nil "Publishing page. URL = [~a]" ,uri)) + (define-easy-handler (,name :uri ,uri :default-request-type ,request-type) + ,var-list + (with-request-wrapper ,uri ,page-function ,@args))))) diff --git a/lisp/webapps/woodriverlessons/clojurescript/woodriverlessons/.gitignore b/lisp/webapps/woodriverlessons/clojurescript/woodriverlessons/.gitignore new file mode 100644 index 0000000..864ae75 --- /dev/null +++ b/lisp/webapps/woodriverlessons/clojurescript/woodriverlessons/.gitignore @@ -0,0 +1,16 @@ +target +classes +resources +checkouts +pom.xml +pom.xml.asc +*.jar +*.class +.lein-* +.nrepl-port +.rebel_readline_history +.hgignore +.hg +profiles.clj +figwheel_server.log +.rebel_readline_history diff --git a/lisp/webapps/woodriverlessons/clojurescript/woodriverlessons/README.md b/lisp/webapps/woodriverlessons/clojurescript/woodriverlessons/README.md new file mode 100644 index 0000000..53ca866 --- /dev/null +++ b/lisp/webapps/woodriverlessons/clojurescript/woodriverlessons/README.md @@ -0,0 +1,14 @@ +# ldapadmin + +A Clojure library designed to ... well, that part is up to you. + +## Usage + +FIXME + +## License + +Copyright © 2017 FIXME + +Distributed under the Eclipse Public License either version 1.0 or (at +your option) any later version. diff --git a/lisp/webapps/woodriverlessons/clojurescript/woodriverlessons/project.clj b/lisp/webapps/woodriverlessons/clojurescript/woodriverlessons/project.clj new file mode 100644 index 0000000..9b93c1e --- /dev/null +++ b/lisp/webapps/woodriverlessons/clojurescript/woodriverlessons/project.clj @@ -0,0 +1,13 @@ +(defproject woodriverlessons "0.1.0-SNAPSHOT" + :description "FIXME" + :url "FIXME" + :license "public domain" + :dependencies [[org.clojure/clojure "LATEST"] + [org.clojure/clojurescript "LATEST"] + [cljs-ajax "LATEST"] + [prismatic/dommy "LATEST"] + [hiccups "LATEST"] + [cljsjs/showdown "LATEST"] + [com.andrewmcveigh/cljs-time "LATEST"]] + :plugins [[lein-cljsbuild "LATEST"]] + :clean-targets ^{:protect false} [:target-path "out" "resources/public/cljs"]) diff --git a/lisp/webapps/woodriverlessons/clojurescript/woodriverlessons/src/core.cljs b/lisp/webapps/woodriverlessons/clojurescript/woodriverlessons/src/core.cljs new file mode 100644 index 0000000..53a22e3 --- /dev/null +++ b/lisp/webapps/woodriverlessons/clojurescript/woodriverlessons/src/core.cljs @@ -0,0 +1,998 @@ +(ns woodriverlessons.core + (:require-macros [hiccups.core :as hiccups :refer [html]]) + (:require [ajax.core :refer [GET POST raw-response-format]] + [dommy.core :as dommy] + [hiccups.runtime :as hiccupsrt] + [cljsjs.showdown :as showdown] + [clojure.string :as str] + [cljs-time.format :as time-format] + [org-ckons-cljs.notifications.core :as ck-notifications] + [org-ckons-cljs.form.core :as ck-form])) + +;; declarations + +(enable-console-print!) +(def jquery (js* "$")) +(def sql-formatter (time-format/formatter "yyyy-MM-dd HH:mm:ss")) +(def pretty-formatter (time-format/formatters :rfc822)) + +(declare date-sql-to-pretty) +(declare markdown-to-html) +(declare reduce-checkboxes) +(declare notifications) +(declare auth-notifications) +(declare template-menu) +(declare template-menu-user) +(declare handler-menu) +(declare handler-menu-user) +(declare render-menu) +(declare template-home) +(declare handler-home) +(declare render-home) +(declare template-login) +(declare handler-login) +(declare render-login) +(declare on-login-submit-clicked) +(declare handler-login-authenticate) +(declare render-login-authenticate) +(declare handler-logout) +(declare render-logout) +(declare template-profile) +(declare handler-profile) +(declare render-profile) +(declare template-profile-view) +(declare handler-profile-view) +(declare render-profile-view) +(declare on-profile-modify-clicked) +(declare template-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 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-about-us) +(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 handler-contact-us) +(declare render-contact-us) +(declare template-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 handler-messages) +(declare render-messages) +(declare on-messages-mode-clicked) +(declare template-messages-results) +(declare handler-messages-results) +(declare render-messages-results) +(declare on-messages-mark) +(declare handler-messages-mark) +(declare render-messages-mark) +(declare template-users) +(declare handler-users) +(declare render-users) +(declare template-users-view) +(declare handler-users-view) +(declare render-users-view) +(declare on-users-add-clicked) +(declare template-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 handler-users-register) +(declare render-users-register) +(declare template-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 handler-users-modify) +(declare render-users-modify) +(declare on-users-modify-submit-clicked) +(declare handler-users-modify-submit) +(declare render-users-modify-submit) +(declare on-users-toggle-active-clicked) +(declare handler-users-toggle-active) +(declare render-users-toggle-active) +(declare on-users-delete-clicked) +(declare handler-users-delete) +(declare render-users-delete) +(declare on-menu-clicked) +(declare handler-location) +(declare goto-location) +(declare reset-app) +(declare goto-register) + +(defn date-sql-to-pretty [sql-date] + (first (str/split (time-format/unparse pretty-formatter (time-format/parse sql-formatter (first (str/split sql-date ".")))) " Z"))) + +(defn markdown-to-html [markdown] + (let [converter (js/showdown.Converter.)] + (.makeHtml converter markdown))) + +(defn reduce-checkboxes [selector] + "Reduces the names of all checked checkboxes to a pipe-separated + list. Assumes that the checkboxes are named via the convention + `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))))) + +;; notifications + +(defn notifications [jsonobj] + (ck-notifications/maybe-message jsonobj) + (ck-notifications/maybe-error jsonobj)) + +(defn auth-notifications [jsonobj] + (cond (empty? (get jsonobj "errormsg")) + (notifications jsonobj) + :else + (do + (render-home "" (get jsonobj "errormsg")) + (render-menu)))) + +;; menu + +(hiccups/defhtml template-menu [menuitems] + [:ul {:class "nav nav-pills"} + (for [menuitem menuitems] + [:li {:class "nav-item"} + [:a {:class (cond (= (str/upper-case (get menuitem "handler")) + (str/upper-case (dommy/html (dommy/sel1 :#location)))) + "nav-link active" + :else + "nav-link") + :id (get menuitem "id") + :onclick (str (namespace ::x) ".on_menu_clicked('" (get menuitem "handler") "')")} + (get menuitem "label")]])]) + +(hiccups/defhtml template-menu-user [jsonobj] + [:div {:class "dropdown"} + [:button {:class "btn btn-primary dropdown-toggle" + :type "button" + :id "button-menu-user" + :data-toggle "dropdown" + :aria-haspopup "true" + :aria-expanded "false"} + (get jsonobj "label")] + [:div {:class "dropdown-menu" :aria-labelledby "button-menu-user"} + (for [menuitem (get jsonobj "menuitems")] + [:a {:class "dropdown-item" + :onclick (str (namespace ::x) ".on_menu_clicked('" (get menuitem "handler") "')")} + (get menuitem "label")])]]) + +(defn handler-menu [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (dommy/set-html! (dommy/sel1 :#menu) (template-menu (get jsonobj "menuitems"))))) + +(defn handler-menu-user [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (dommy/set-html! (dommy/sel1 :#menu-user) (template-menu-user jsonobj)))) + +(defn render-menu [] + (GET "/menu" {:handler handler-menu}) + (GET "/menu/user" {:handler handler-menu-user})) + +;; home + +(hiccups/defhtml template-home [jsonobj] + [:h1 {:style "text-align: center"} "Carlos Konstanski welcomes you to his violin and viola studio!"] + [: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)))) + +(defn render-home + ([] + (GET "/home" {:handler handler-home})) + ([message errormsg] + (POST "/home" + {:format :raw + :params {:message message + :errormsg errormsg} + :handler handler-home}))) + +;; 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 handler-login [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (notifications jsonobj) + (dommy/set-html! (dommy/sel1 :#body) (template-login jsonobj)))) + +(defn render-login [] + (GET "/login" {:handler handler-login})) + +;; login-authenticate + +(defn on-login-submit-clicked [] + (when (-> (jquery "#login-form") + (.get "0") + (.checkValidity)) + (render-login-authenticate))) + +(defn handler-login-authenticate [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (cond (get jsonobj "errormsg") + (goto-location "/login") + (get jsonobj "message") + (do + (dommy/set-html! (dommy/sel1 :#location) "/home") + (render-home) + (render-menu))))) + +(defn render-login-authenticate [] + (POST "/login/authenticate" + {:format :raw + :params {:username (dommy/value (dommy/sel1 :#username)) + :pwd (dommy/value (dommy/sel1 :#pwd))} + :handler handler-login-authenticate})) + +;; logout + +(defn handler-logout [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (render-home "You are now logged out" "") + (dommy/set-html! (dommy/sel1 :#location) "/home") + (render-menu))) + +(defn render-logout [] + (GET "/logout" {:handler handler-logout})) + +;; 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"} + [: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 handler-profile [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (notifications jsonobj) + (dommy/set-html! (dommy/sel1 :#body) (template-profile jsonobj)) + (render-profile-view))) + +(defn render-profile [] + (GET "/profile" {:handler handler-profile})) + +;; 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 handler-profile-view [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (dommy/set-html! (dommy/sel1 :#content) (template-profile-view jsonobj)))) + +(defn render-profile-view [] + (GET "/profile/view" {:handler handler-profile-view})) + +;; profile-modify + +(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 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")))) + +(defn render-profile-modify [] + (POST "/profile/modify" {:handler handler-profile-modify})) + +;; profile-modify-submit + +(defn on-profile-modify-submit-clicked [] + (when (-> (jquery "#profile-modify-form") + (.get "0") + (.checkValidity)) + (.modal (jquery "#modify") "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"))) + +(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))} + :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 handler-password [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (notifications jsonobj) + (dommy/set-html! (dommy/sel1 :#body) (template-password jsonobj)))) + +(defn render-password [] + (GET "/password" {:handler handler-password})) + +;; password-submit + +(defn on-password-submit-clicked [] + (when (-> (jquery "#password-form") + (.get "0") + (.checkValidity)) + (render-password-submit))) + +(defn handler-password-submit [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (auth-notifications jsonobj) + (on-menu-clicked "/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))} + :handler handler-password-submit})) + +;; about-us + +(hiccups/defhtml template-about-us [jsonobj] + [:h1 {:style "text-align: center"} "About the Studio"] + [:h3 "The Teacher"] + [:p "My name is Carlos Konstanski. I am the principal violist in the Wood River Orchestra. I have previously played in the viola sections of the following college and community orchestras:"] + [:ul + [:li "Idaho State Civic Symphony in Pocatello ID"] + [:li "Health and Wellness Orchestra in Fort Collins CO"] + [:li "Loveland Orchestra in Loveland CO"] + [:li "University of Oregon Symphony Orchestra in Eugene OR"] + [:li "Leipziger Universitätsorchester in Leipzig Germany"]] + [:p "I started playing the viola at age 10 and picked up the violin decades later. My viola is a fine instrument made by Bronek Cison in 2010, while my violin is a high-quality student instrument made 100 years ago in Bohemia by an unknown luthier."] + [:p "Most of my musical studies took place at Idaho State University. I was a music major from 1988 to 1993. Then I returned to ISU from 2010 to 2012 to study computer science. It was during this latter period that I had the great fortune and privilege to study with " [:a {:href "https://nafme.org/member-profile/chung-park/" :target "_blank"} "Dr. Chung Park"] ". These two years were an immensely productive and life-changing experience. What I learned from this incomparable master informs every aspect of my playing today, and it is this body of knowledge that I wish to share with my musical community. A high-quality teacher makes all the difference! Every well-trained player has a teacher to whom they owe everything."] + [:h3 "The Philosophy"] + [:p "Playing the violin and viola is like any other art form in that it is composed of two parts: the artistic ideas which want to be expressed and the craft which provides the artist with the means to express them. We generally refer to the craft of instrumental performance as \"technique\". The finest artistic ideas ever conceived will never see the light of day if the performer lacks the technique to express them. Likewise the most tremendous technique in the world will not inspire the audience if it is not informed by artistic intent."] + [:p "My goal as a teacher is to help you develop a solid technique that you can use to express his/her own artistic thoughts. While I am artistically highly opinionated, I want my students to be equally opinionated even if, and especially if, their ideas differ from mine. If you ask me technical questions then you can expect concrete answers; but artistic questions will generally be met with more questions. I will help you find your way as a violinist or violist, but you must ultimately find your own way as an artist. That said, I will enthusiastically guide you on your artistic journey, providing you with the tools to make smart choices. I just won't make the choices for you, for that would be irresponsible on my part and stifling for you."] + [:p "A solid technique must be built on a sound foundation. One starts with certain fundamentals and continually revisits them to ensure that they remain strong. Without solid fundamentals the entire structure topples like a house of cards. These fundamentals fall into three physical zones corresponding to the middle, left and right parts of the body: the instrument hold and posture, the left-hand technique and the bow technique. If your fundamentals are rock-solid then the sky is the limit (and you don't need me!). However if your previous training was lacking then you may find it necessary to relearn some things in order to rebuild your foundation. This is a bitter pill for many students to swallow. Since it is so essential to the entire process, you will find that I won't offer any leniency in this area. I went through it myself after having played for 30 years and it was the best thing that I ever did. Don't let your ego fool you into thinking that you don't need this. Your ego is a liar. It is not interested in your well-being. It only wants to make you feel good about yourself. It is the antithesis of truth. Artists seek truth, not palliatives."] + [:p "The study of the violin or viola is a constant exercise in being pulled out of your comfort zone. This is just another way of saying that it's about exploring what lies beyond the limits of your experience. Approach it with an adventurous spirit. Learn to love taking that next step into the unknown. When you are trying something new and it is uncomfortable, don't give up on it. It will eventually feel natural and then new doors will open for you."] + [:h3 "The Studio"] + [:p "Students may come to my house for lessons or I can come to you. My house is conveniently located in Hailey. If I come to you then I will charge for the extra time and travel expense. My rates are highly individual. Everyone is different."] + [:p "The frequency of lessons also varies depending on the individual. Some students who are highly motivated and have lots of time to practice will have a lesson every week. Most others (those with full-time jobs or other major time commitments) will have a lesson every two weeks. I expect all students to commit to at least some practice every day, even if it's only a half-hour. Missed days should be a rare occurrence. I miss some days myself (as I have a day job), but I feel bad about it. Self-motivation is the #1 ingredient for success. With it you can achieve anything. Without it you can achieve nothing."]) + +(defn handler-about-us [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (notifications jsonobj) + (dommy/set-html! (dommy/sel1 :#body) (template-about-us jsonobj)))) + +(defn render-about-us [] + (GET "/about-us" {:handler handler-about-us})) + +;; 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"} + [: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."] + [:p {:style "text-align: center"} "Or call me at (970) 294-9708."] + [:div {:id "content"}]) + +(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)) + (render-contact-us-view))) + +(defn render-contact-us [] + (GET "/contact-us" {:handler handler-contact-us})) + +;; contact-us-view + +(hiccups/defhtml template-contact-us-view [jsonobj] + (ck-form/template-generic-form (get jsonobj "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)))) + +(defn render-contact-us-view [] + (GET "/contact-us/view" {:handler handler-contact-us-view})) + +;; contact-us-email + +(defn on-contact-us-email-submit-clicked [] + (render-contact-us-email-submit)) + +(defn handler-contact-us-email-submit [response] + (on-menu-clicked "/contact-us")) + +(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))} + :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 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)))) + +(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") + 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] + (let [jsonobj (js->clj (js/JSON.parse response))] + (auth-notifications jsonobj) + (dommy/set-html! (dommy/sel1 :#results) (template-messages-results jsonobj)))) + +(defn render-messages-results [] + (POST "/messages/results" + {:format :raw + :params {:read (dommy/value (dommy/sel1 :#read))} + :handler handler-messages-results})) + +;; messages-mark + +(defn on-messages-mark [read id] + (render-messages-mark read id)) + +(defn handler-messages-mark [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (auth-notifications jsonobj) + (on-menu-clicked "/messages"))) + +(defn render-messages-mark [read id] + (POST "/messages/mark" + {:format :raw + :params {:read read + :id 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"} + [: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 handler-users [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (notifications jsonobj) + (dommy/set-html! (dommy/sel1 :#body) (template-users jsonobj)) + (render-users-view))) + +(defn render-users [] + (GET "/users" {:handler handler-users})) + +;; 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 handler-users-view [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (dommy/set-html! (dommy/sel1 :#content) (template-users-view jsonobj)))) + +(defn render-users-view [] + (GET "/users/view" {:handler handler-users-view})) + +;; users-add + +(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 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")))) + +(defn render-users-add [] + (POST "/users/add" {:handler handler-users-add})) + +;; users-add-submit + +(defn on-users-add-submit-clicked [] + (when (-> (jquery "#users-add-form") + (.get "0") + (.checkValidity)) + (.modal (jquery "#modify") "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"))) + +(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))} + :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 handler-users-register [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (dommy/set-html! (dommy/sel1 :#body) (template-users-register jsonobj)) + (render-users-register-form (get jsonobj "hash")))) + +(defn render-users-register [hash] + (POST "/users/register" + {:format :raw + :params {:hash hash} + :handler handler-users-register})) + +;; 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 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)))) + +(defn render-users-register-form [hash] + (POST "/users/register/form" + {:format :raw + :params {:hash hash} + :handler handler-users-register-form})) + +;; users-register-submit + +(defn on-users-register-submit-clicked [] + (when (-> (jquery "#users-register-form") + (.get "0") + (.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))))) + +(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))} + :handler handler-users-register-submit})) + +;; users-modify + +(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 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")))) + +(defn render-users-modify [id] + (POST "/users/modify" + {:format :raw + :params {:id id} + :handler handler-users-modify})) + +;; users-modify-submit + +(defn on-users-modify-submit-clicked [] + (when (-> (jquery "#users-modify-form") + (.get "0") + (.checkValidity)) + (.modal (jquery "#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"))) + +(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))} + :handler handler-users-modify-submit})) + +;; users-toggle-active + +(defn on-users-toggle-active-clicked [id] + (render-users-toggle-active id)) + +(defn handler-users-toggle-active [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (auth-notifications jsonobj) + (on-menu-clicked "/users"))) + +(defn render-users-toggle-active [id] + (POST "/users/toggle-active" + {:format :raw + :params {:id id} + :handler handler-users-toggle-active})) + +;; 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.")) + (render-users-delete id))) + +(defn handler-users-delete [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (auth-notifications jsonobj) + (on-menu-clicked "/users"))) + +(defn render-users-delete [id] + (POST "/users/delete" + {:format :raw + :params {:id id} + :handler handler-users-delete})) + +;; location + +(defn on-menu-clicked [handler] + (dommy/set-html! (dommy/sel1 :#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 "/about-us") (render-about-us) + (= handler "/testimonials") (render-testimonials) + (= handler "/contact-us") (render-contact-us) + (= handler "/messages") (render-messages) + (= handler "/users") (render-users))) + +(defn handler-location [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (on-menu-clicked (get jsonobj "location")) + (notifications jsonobj))) + +(defn goto-location [location] + (POST "/location" + {:format :raw + :params {:location location} + :handler handler-location})) + +(defn reset-app [] + (set! (.-location js/document) "/")) + +(defn goto-register [hash] + (dommy/set-html! (dommy/sel1 :#location) "/users/register") + (render-menu) + (render-users-register hash)) diff --git a/lisp/webapps/woodriverlessons/conf/.gitignore b/lisp/webapps/woodriverlessons/conf/.gitignore new file mode 100644 index 0000000..14fa7a6 --- /dev/null +++ b/lisp/webapps/woodriverlessons/conf/.gitignore @@ -0,0 +1 @@ +options.lisp diff --git a/lisp/webapps/woodriverlessons/conf/options.lisp.example b/lisp/webapps/woodriverlessons/conf/options.lisp.example new file mode 100644 index 0000000..d2afe8e --- /dev/null +++ b/lisp/webapps/woodriverlessons/conf/options.lisp.example @@ -0,0 +1,13 @@ +(:name "woodriverlessons" + :url "woodriverlessons.org" + :document-root "woodriverlessons" + :title "Wood River Orchestra" + :meta-description "A website for the members of the Wood River Orchestra written in Common Lisp/Hunchentoot and ClojureScript." + :databases (:db-woodriverlessons ("127.0.0.1" "woodriverlessons" "woodriverlessons" "password")) + :mail-mx "mail.ckons.org" + :mail-from "postmaster@ckons.org" + :mail-postmaster "postmaster@ckons.org" + :mail-webmaster "webmaster@ckons.org" + :mail-info "info@ckons.org" + :mail-login-notify "me@ckons.org" + :mail-authentication ("me@ckons.org" "password")) diff --git a/lisp/webapps/woodriverlessons/site.lisp b/lisp/webapps/woodriverlessons/site.lisp new file mode 100644 index 0000000..dafe289 --- /dev/null +++ b/lisp/webapps/woodriverlessons/site.lisp @@ -0,0 +1,198 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :woodriverlessons) + +(defmacro .base (&optional (onload-fn "goto_location('/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 "ha256-kmHvs0B+OpCW5GVHUNjv9rOmY0IvSIRcf7zGUDTDQM8=" :crossorigin "anonymous"))) + ((script :type "text/javascript" :src "/static/js/cljs/main.js"))) + ((body :onload ,(format nil "woodriverlessons.core.~a" ,onload-fn)) + ((div :class "container-fluid") + ((div :class "row banner") + ((div :class "col contact-info") + ((p) " ") + ((p) "Carlos Konstanski") + ((p) "(970) 294-9708")) + ((div :class "col") + ((div :class "page-header") + ((h1 :class "banner-title") (br) "Wood River Lessons" (br) "Blaine County ID" (br)))) + ((div :id "menu-user" :class "col" :style "text-align: right;"))) + ((div :id "menu" :class "well")) + ((div :id "location" :style "display: none")) + ((div :id "errormsg")) + ((div :id "message")) + ((div :id "body")) + ,@(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 .about-us () + `(about-us-json)) + +(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 .contact-us-modify () + `(contact-us-modify-json)) + +(defmacro .contact-us-modify-submit () + `(contact-us-modify-submit-json content)) + +(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 :get "/" () .base) +(define-endpoint :post "/location" ((location :parameter-type 'string)) .location) +(define-endpoint :get "/home" () .home-get) +(define-endpoint :post "/home" ((message :parameter-type 'string) (errormsg :parameter-type 'string)) .home-post) +(define-endpoint :get "/menu" () .menu) +(define-endpoint :get "/menu/user" () .menu-user) +(define-endpoint :get "/login" () .login) +(define-endpoint :post "/login/authenticate" ((username :parameter-type 'string) (pwd :parameter-type 'string)) .login-authenticate) +(define-endpoint :get "/login/forgot" () .login-forgot) +(define-endpoint :get "/logout" () .logout) +(define-endpoint :get "/profile" () .profile) +(define-endpoint :get "/profile/view" () .profile-view) +(define-endpoint :post "/profile/modify" () .profile-modify) +(define-endpoint :post "/profile/modify/submit" ((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 :get "/password" () .password) +(define-endpoint :post "/password/submit" ((id :parameter-type 'integer) (pwd :parameter-type 'string) (pwd2 :parameter-type 'string)) .password-submit) +(define-endpoint :get "/about-us" () .about-us) +(define-endpoint :get "/testimonials" () .testimonials) +(define-endpoint :get "/testimonials/view" () .testimonials-view) +(define-endpoint :post "/testimonials/modify" () .testimonials-modify) +(define-endpoint :post "/testimonials/modify/submit" ((content :parameter-type 'string)) .testimonials-modify-submit) +(define-endpoint :get "/contact-us" () .contact-us) +(define-endpoint :get "/contact-us/view" () .contact-us-view) +(define-endpoint :post "/contact-us/email" ((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 :post "/contact-us/modify" () .contact-us-modify) +(define-endpoint :post "/contact-us/modify/submit" ((content :parameter-type 'string)) .contact-us-modify-submit) +(define-endpoint :get "/messages" () .messages) +(define-endpoint :post "/messages/results" ((read :parameter-type 'string)) .messages-results) +(define-endpoint :post "/messages/mark" ((read :parameter-type 'string) (id :parameter-type 'integer)) .messages-mark) +(define-endpoint :get "/users" () .users) +(define-endpoint :get "/users/view" () .users-view) +(define-endpoint :post "/users/add" () .users-add) +(define-endpoint :post "/users/add/submit" ((role_groups :parameter-type 'string) (first_name :parameter-type 'string) (last_name :parameter-type 'string) (email :parameter-type 'string)) .users-add-submit) +(define-endpoint :get "/register" ((hash :parameter-type 'string)) .base (format nil "goto_register('~a') " hash)) +(define-endpoint :post "/users/register" ((hash :parameter-type 'string)) .users-register) +(define-endpoint :post "/users/register/form" ((hash :parameter-type 'string)) .users-register-form) +(define-endpoint :post "/users/register/submit" ((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 :post "/users/modify" ((id :parameter-type 'integer)) .users-modify) +(define-endpoint :post "/users/modify/submit" ((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 :post "/users/toggle-active" ((id :parameter-type 'integer)) .users-toggle-active) +(define-endpoint :post "/users/delete" ((id :parameter-type 'integer)) .users-delete) diff --git a/lisp/webapps/woodriverlessons/static/css/stylesheet.css b/lisp/webapps/woodriverlessons/static/css/stylesheet.css new file mode 100644 index 0000000..48ba0b6 --- /dev/null +++ b/lisp/webapps/woodriverlessons/static/css/stylesheet.css @@ -0,0 +1,53 @@ +body { + background-color: #161012; + color: white; +} + +p { + font-size: 14px; +} + +#container { + width: 100%; + margin: 20px auto; +} + +.table { + color: white; +} + +.nav-link { + color: white; + cursor: pointer; +} + +.well { + background-color: #2c180d; + border: 1px black solid; + text-align: center; +} + +.banner { + background-image: url("/static/images/violin-strip.jpg"); + background-repeat: repeat; + background-position: left; +} + +.form-control { + width: 600px; +} + +.contact-info { + color: #59200e; + font-size: 15px; + font-weight: bold; + line-height: 0.4; +} + +.banner-title { + color: #59200e; + font-size: 24px; + font-weight: bold; + text-align: center; + line-height: 0.4; +} diff --git a/lisp/webapps/woodriverlessons/static/images/add.png b/lisp/webapps/woodriverlessons/static/images/add.png Binary files differnew file mode 100644 index 0000000..1055df8 --- /dev/null +++ b/lisp/webapps/woodriverlessons/static/images/add.png diff --git a/lisp/webapps/woodriverlessons/static/images/classical-bow.jpg b/lisp/webapps/woodriverlessons/static/images/classical-bow.jpg Binary files differnew file mode 100644 index 0000000..fce1392 --- /dev/null +++ b/lisp/webapps/woodriverlessons/static/images/classical-bow.jpg diff --git a/lisp/webapps/woodriverlessons/static/images/delete.png b/lisp/webapps/woodriverlessons/static/images/delete.png Binary files differnew file mode 100644 index 0000000..ec140b7 --- /dev/null +++ b/lisp/webapps/woodriverlessons/static/images/delete.png diff --git a/lisp/webapps/woodriverlessons/static/images/document-open.png b/lisp/webapps/woodriverlessons/static/images/document-open.png Binary files differnew file mode 100644 index 0000000..20b7ca8 --- /dev/null +++ b/lisp/webapps/woodriverlessons/static/images/document-open.png diff --git a/lisp/webapps/woodriverlessons/static/images/down.png b/lisp/webapps/woodriverlessons/static/images/down.png Binary files differnew file mode 100644 index 0000000..e2d15bf --- /dev/null +++ b/lisp/webapps/woodriverlessons/static/images/down.png diff --git a/lisp/webapps/woodriverlessons/static/images/download.png b/lisp/webapps/woodriverlessons/static/images/download.png Binary files differnew file mode 100644 index 0000000..3973b3c --- /dev/null +++ b/lisp/webapps/woodriverlessons/static/images/download.png diff --git a/lisp/webapps/woodriverlessons/static/images/edit-redo.png b/lisp/webapps/woodriverlessons/static/images/edit-redo.png Binary files differnew file mode 100644 index 0000000..3d4db6c --- /dev/null +++ b/lisp/webapps/woodriverlessons/static/images/edit-redo.png diff --git a/lisp/webapps/woodriverlessons/static/images/edit-undo.png b/lisp/webapps/woodriverlessons/static/images/edit-undo.png Binary files differnew file mode 100644 index 0000000..367fc5a --- /dev/null +++ b/lisp/webapps/woodriverlessons/static/images/edit-undo.png diff --git a/lisp/webapps/woodriverlessons/static/images/edit.png b/lisp/webapps/woodriverlessons/static/images/edit.png Binary files differnew file mode 100644 index 0000000..550dacd --- /dev/null +++ b/lisp/webapps/woodriverlessons/static/images/edit.png diff --git a/lisp/webapps/woodriverlessons/static/images/emblem-favorite.png b/lisp/webapps/woodriverlessons/static/images/emblem-favorite.png Binary files differnew file mode 100644 index 0000000..6535d5d --- /dev/null +++ b/lisp/webapps/woodriverlessons/static/images/emblem-favorite.png diff --git a/lisp/webapps/woodriverlessons/static/images/emblem-nowrite.png b/lisp/webapps/woodriverlessons/static/images/emblem-nowrite.png Binary files differnew file mode 100644 index 0000000..997fedf --- /dev/null +++ b/lisp/webapps/woodriverlessons/static/images/emblem-nowrite.png diff --git a/lisp/webapps/woodriverlessons/static/images/instrument-cabinet.jpg b/lisp/webapps/woodriverlessons/static/images/instrument-cabinet.jpg Binary files differnew file mode 100644 index 0000000..d49cb7a --- /dev/null +++ b/lisp/webapps/woodriverlessons/static/images/instrument-cabinet.jpg diff --git a/lisp/webapps/woodriverlessons/static/images/no.png b/lisp/webapps/woodriverlessons/static/images/no.png Binary files differnew file mode 100644 index 0000000..1dc1b7c --- /dev/null +++ b/lisp/webapps/woodriverlessons/static/images/no.png diff --git a/lisp/webapps/woodriverlessons/static/images/sort-alpha.png b/lisp/webapps/woodriverlessons/static/images/sort-alpha.png Binary files differnew file mode 100644 index 0000000..0e4a831 --- /dev/null +++ b/lisp/webapps/woodriverlessons/static/images/sort-alpha.png diff --git a/lisp/webapps/woodriverlessons/static/images/up.png b/lisp/webapps/woodriverlessons/static/images/up.png Binary files differnew file mode 100644 index 0000000..55bab86 --- /dev/null +++ b/lisp/webapps/woodriverlessons/static/images/up.png diff --git a/lisp/webapps/woodriverlessons/static/images/violin-strip.jpg b/lisp/webapps/woodriverlessons/static/images/violin-strip.jpg Binary files differnew file mode 100644 index 0000000..6149a87 --- /dev/null +++ b/lisp/webapps/woodriverlessons/static/images/violin-strip.jpg diff --git a/lisp/webapps/woodriverlessons/static/images/yes.png b/lisp/webapps/woodriverlessons/static/images/yes.png Binary files differnew file mode 100644 index 0000000..b9cadf5 --- /dev/null +++ b/lisp/webapps/woodriverlessons/static/images/yes.png diff --git a/lisp/webapps/woodriverlessons/static/js/cljs b/lisp/webapps/woodriverlessons/static/js/cljs new file mode 120000 index 0000000..88f0c64 --- /dev/null +++ b/lisp/webapps/woodriverlessons/static/js/cljs @@ -0,0 +1 @@ +../../clojurescript/woodriverlessons/resources/public/cljs
\ No newline at end of file diff --git a/lisp/woodriverlessons.asd b/lisp/woodriverlessons.asd new file mode 100644 index 0000000..6c6a9cb --- /dev/null +++ b/lisp/woodriverlessons.asd @@ -0,0 +1,75 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :cl) + +(defpackage :woodriverlessons-system (:use :cl :asdf)) +(in-package :woodriverlessons-system) + +(defmacro do-defsystem (&key name version maintainer author description long-description depends-on components) + `(defsystem ,name + :name ,name + :version ,version + :maintainer ,maintainer + :author ,author + :description ,description + :long-description ,long-description + :depends-on ,(eval depends-on) + :components ,components)) + +(defparameter *quicklisp-packages* '(cl-ppcre cl-smtp hunchentoot cl-log ironclad cl-markdown tmpdir)) +(defparameter *asdf-packages* '(org-ckons-core org-ckons-http org-ckons-json org-ckons-file org-ckons-serializable org-ckons-session org-ckons-condition org-ckons-sql)) +(defparameter *all-packages* (append *quicklisp-packages* *asdf-packages*)) + +(loop for pkg in *quicklisp-packages* do + (ql:quickload (symbol-name pkg))) + +(do-defsystem :name "woodriverlessons" + :version "1" + :maintainer "Carlos Konstanski <me@ckons.org>" + :author "Carlos Konstanski <me@ckons.org>" + :description "woodriverlessons" + :long-description "woodriverlessons is a web application written in Common Lisp based on the Hunchentoot web server. The client-side code is written in ClojureScript. Purpose: public website for Violin and Viola Lessons in the Wood River Valley." + :depends-on *all-packages* + :components ((:module core + :components ((:file "core"))) + (:module sql + :depends-on (core) + :components ((:file "generics") + (:file "user-session" :depends-on ("generics")) + (:file "user-session-pkg" :depends-on ("generics" "user-session")) + (:file "user" :depends-on ("generics")) + (:file "role-group" :depends-on ("generics")) + (:file "user-role" :depends-on ("generics")) + (:file "registration" :depends-on ("generics")) + (:file "about-us" :depends-on ("generics")) + (:file "testimonials" :depends-on ("generics")) + (:file "contact-us" :depends-on ("generics")) + (:file "auth-pkg" :depends-on ("user-session-pkg" "user" "role-group" "user-role" "registration")) + (:file "general-pkg" :depends-on ("about-us" "testimonials")) + (:file "contact-pkg" :depends-on ("contact-us")))) + (:module service + :depends-on (sql) + :components ((:file "generics") + (:file "base-service") + (:file "rest-service" :depends-on ("base-service")) + (:file "auth-service" :depends-on ("rest-service")) + (:file "generic-form" :depends-on ("rest-service")) + (:file "menu-service" :depends-on ("base-service")) + (:file "home-service" :depends-on ("rest-service")) + (:file "login-service" :depends-on ("generic-form" "rest-service")) + (:file "logout-service" :depends-on ("rest-service")) + (:file "profile-service" :depends-on ("generic-form" "auth-service")) + (:file "password-service" :depends-on ("generic-form" "auth-service")) + (:file "about-us-service" :depends-on ("generic-form" "auth-service")) + (: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 woodriverlessons + :depends-on ("webapp-loader") + :components ((:file "site"))))))) diff --git a/sql/functions/auth.delete_registration.sql b/sql/functions/auth.delete_registration.sql new file mode 100644 index 0000000..5adf705 --- /dev/null +++ b/sql/functions/auth.delete_registration.sql @@ -0,0 +1,14 @@ +drop function auth.delete_registration ( + p_hash text +); + +create or replace function auth.delete_registration ( + p_hash text +) +returns void +as $$ +begin + delete from auth.registrations r + where r.hash = ('\x' || p_hash)::bytea; +end; +$$ language plpgsql; diff --git a/sql/functions/auth.delete_role_groups_for_user.sql b/sql/functions/auth.delete_role_groups_for_user.sql new file mode 100644 index 0000000..1b14f0d --- /dev/null +++ b/sql/functions/auth.delete_role_groups_for_user.sql @@ -0,0 +1,16 @@ +drop function auth.delete_role_groups_for_user ( + p_user_id bigint +); + +create or replace function auth.delete_role_groups_for_user ( + p_user_id bigint +) +returns void +as $$ +begin + delete from auth.users_role_groups urg + where user_id = p_user_id; + + return; +end; +$$ language plpgsql; diff --git a/sql/functions/auth.get_active_role_groups_for_user.sql b/sql/functions/auth.get_active_role_groups_for_user.sql new file mode 100644 index 0000000..41f7712 --- /dev/null +++ b/sql/functions/auth.get_active_role_groups_for_user.sql @@ -0,0 +1,25 @@ +drop function auth.get_active_role_groups_for_user ( + p_user_id bigint +); + +create or replace function auth.get_active_role_groups_for_user ( + p_user_id bigint +) +returns setof auth.role_groups_t +as $$ +begin + return query + select urg.id as user_role_group_id, + urg.user_id, + rg.id as role_group_id, + rg.name, + rg.description + from auth.users_role_groups urg + inner join auth.role_groups rg + on urg.role_group_id = rg.id + where urg.user_id = p_user_id + order by rg.name asc; + + return; +end; +$$ language plpgsql; diff --git a/sql/functions/auth.get_active_user_by_id.sql b/sql/functions/auth.get_active_user_by_id.sql new file mode 100644 index 0000000..7f635a0 --- /dev/null +++ b/sql/functions/auth.get_active_user_by_id.sql @@ -0,0 +1,27 @@ +drop function auth.get_active_user_by_id ( + p_user_id bigint +); + +create or replace function auth.get_active_user_by_id ( + p_user_id bigint +) +returns setof auth.users +as $$ +begin + return query + select u.id, + u.username, + u.pwd, + u.first_name, + u.last_name, + u.email, + u.phone, + u.active, + u.created + from auth.users u + where u.id = p_user_id + and u.active = true; + + return; +end; +$$ language plpgsql; diff --git a/sql/functions/auth.get_active_user_by_username_pwd.sql b/sql/functions/auth.get_active_user_by_username_pwd.sql new file mode 100644 index 0000000..26f926c --- /dev/null +++ b/sql/functions/auth.get_active_user_by_username_pwd.sql @@ -0,0 +1,30 @@ +drop function auth.get_active_user_by_username_pwd ( + p_username character varying, + p_pwd character varying +); + +create or replace function auth.get_active_user_by_username_pwd ( + p_username character varying, + p_pwd character varying +) +returns setof auth.users +as $$ +begin + return query + select u.id, + u.username, + u.pwd, + u.first_name, + u.last_name, + u.email, + u.phone, + u.active, + u.created + from auth.users u + where u.username = p_username + and u.pwd = digest(p_pwd, 'sha512') + and u.active = true; + + return; +end; +$$ language plpgsql;a diff --git a/sql/functions/auth.get_all_active_users.sql b/sql/functions/auth.get_all_active_users.sql new file mode 100644 index 0000000..243be63 --- /dev/null +++ b/sql/functions/auth.get_all_active_users.sql @@ -0,0 +1,25 @@ +drop function auth.get_all_active_users (); + +create or replace function auth.get_all_active_users () +returns setof auth.users +as $$ +begin + return query + select u.id, + u.username, + u.pwd, + u.first_name, + u.last_name, + u.email, + u.phone, + u.active, + u.created + from auth.users u + where u.active = true::bool + order by u.last_name asc, + u.first_name asc, + u.id asc; + + return; +end; +$$ language plpgsql; diff --git a/sql/functions/auth.get_all_inactive_users.sql b/sql/functions/auth.get_all_inactive_users.sql new file mode 100644 index 0000000..eee0ab9 --- /dev/null +++ b/sql/functions/auth.get_all_inactive_users.sql @@ -0,0 +1,24 @@ +drop function auth.get_all_users (); + +create or replace function auth.get_all_users () +returns setof auth.users +as $$ +begin + return query + select u.id, + u.username, + u.pwd, + u.first_name, + u.last_name, + u.email, + u.phone, + u.active, + u.created + from auth.users u + order by u.last_name asc, + u.first_name asc, + u.id asc; + + return; +end; +$$ language plpgsql; diff --git a/sql/functions/auth.get_all_role_groups_for_user.sql b/sql/functions/auth.get_all_role_groups_for_user.sql new file mode 100644 index 0000000..f8c111d --- /dev/null +++ b/sql/functions/auth.get_all_role_groups_for_user.sql @@ -0,0 +1,36 @@ +drop function auth.get_all_role_groups_for_user ( + p_user_id bigint +); + +create or replace function auth.get_all_role_groups_for_user ( + p_user_id bigint +) +returns setof auth.role_groups_t +as $$ +begin + if auth.superuser_p(p_user_id) = true::bool then + return query + select null::bigint as user_role_group_id, + p_user_id as user_id, + id as role_group_id, + name, + description + from auth.role_groups + order by name asc; + else + return query + select urg.id as user_role_group_id, + urg.user_id, + rg.id as role_group_id, + rg.name, + rg.description + from auth.users_role_groups urg + inner join auth.role_groups rg + on urg.role_group_id = rg.id + where urg.user_id = p_user_id + order by rg.name asc; + end if; + + return; +end; +$$ language plpgsql; diff --git a/sql/functions/auth.get_all_roles_for_user.sql b/sql/functions/auth.get_all_roles_for_user.sql new file mode 100644 index 0000000..712bd4b --- /dev/null +++ b/sql/functions/auth.get_all_roles_for_user.sql @@ -0,0 +1,163 @@ +drop function auth.get_all_roles_for_user ( + p_user_id bigint +); + +create or replace function auth.get_all_roles_for_user ( + p_user_id bigint +) +returns setof auth.user_roles_t +as $$ +begin + if auth.superuser_p(p_user_id) = true::bool then + return query + with all_user_roles as ( + select null::bigint as user_role_group_id, + p_user_id as user_id, + null::bigint as role_group_id, + null as role_group_name, + null as role_group_description, + null::bigint as role_group_role_id, + null::bigint as role_id, + '_Public' as role_name, + null as role_description, + null::bigint as role_id_exclude, + null::bigint as role_id_append + union + select null::bigint as user_role_group_id, + p_user_id as user_id, + rg.id as role_group_id, + rg.name as role_group_name, + rg.description as role_group_description, + rgr.id as role_group_role_id, + r.id as role_id, + r.name as role_name, + r.description as role_description, + null::bigint as role_id_exclude, + null::bigint as role_id_append + from auth.role_groups rg + inner join auth.role_groups_roles rgr + on rgr.role_group_id = rg.id + inner join auth.roles r + on rgr.role_id = r.id + ) + select a.user_role_group_id, + a.user_id, + a.role_group_id, + a.role_group_name, + a.role_group_description, + a.role_group_role_id, + a.role_id, + a.role_name, + a.role_description + from ( + select r.user_role_group_id as user_role_group_id, + r.user_id as user_id, + r.role_group_id as role_group_id, + r.role_group_name as role_group_name, + r.role_group_description as role_group_description, + r.role_group_role_id as role_group_role_id, + r.role_id as role_id, + r.role_name as role_name, + r.role_description as role_description, + r.role_id_exclude as role_id_exclude, + r.role_id_append as role_id_append + from all_user_roles r + ) a + order by role_name asc; + else + return query + with all_user_roles as ( + select null::bigint as user_role_group_id, + p_user_id as user_id, + null::bigint as role_group_id, + null as role_group_name, + null as role_group_description, + null::bigint as role_group_role_id, + null::bigint as role_id, + '_Public' as role_name, + null as role_description, + null::bigint as role_id_exclude, + null::bigint as role_id_append + union + select urg.id as user_role_group_id, + urg.user_id, + rg.id as role_group_id, + rg.name as role_group_name, + rg.description as role_group_description, + rgr.id as role_group_role_id, + r.id as role_id, + r.name as role_name, + r.description as role_description, + null::bigint as role_id_exclude, + null::bigint as role_id_append + from auth.users_role_groups urg + inner join auth.role_groups rg + on urg.role_group_id = rg.id + inner join auth.role_groups_roles rgr + on rgr.role_group_id = rg.id + inner join auth.roles r + on rgr.role_id = r.id + union + select null::bigint as user_role_group_id, + ure.user_id, + null::bigint as role_group_id, + null as role_group_name, + null role_group_description, + null::bigint as role_group_role_id, + r.id as role_id, + r.name as role_name, + r.description role_description, + ure.role_id as role_id_exclude, + null::bigint as role_id_append + from auth.users_roles_exclude ure + inner join auth.roles r + on ure.role_id = r.id + where ure.user_id = p_user_id + union + select null::bigint as user_role_group_id, + ura.user_id, + null::bigint as role_group_id, + null as role_group_name, + null role_group_description, + null::bigint as role_group_role_id, + r.id as role_id, + r.name as role_name, + r.description role_description, + null::bigint as role_id_exclude, + ura.role_id as role_id_append + from auth.users_roles_append ura + inner join auth.roles r + on ura.role_id = r.id + where ura.user_id = p_user_id + ) + select a.user_role_group_id, + a.user_id, + a.role_group_id, + a.role_group_name, + a.role_group_description, + a.role_group_role_id, + a.role_id, + a.role_name, + a.role_description + from ( + select r.user_role_group_id as user_role_group_id, + r.user_id as user_id, + r.role_group_id as role_group_id, + r.role_group_name as role_group_name, + r.role_group_description as role_group_description, + r.role_group_role_id as role_group_role_id, + r.role_id as role_id, + r.role_name as role_name, + r.role_description as role_description, + r.role_id_exclude as role_id_exclude, + r.role_id_append as role_id_append + from all_user_roles r + where user_id = p_user_id + ) a + where a.role_id_exclude is null + order by role_name asc; + end if; + + return; +end; +$$ language plpgsql; diff --git a/sql/functions/auth.get_registration_by_hash.sql b/sql/functions/auth.get_registration_by_hash.sql new file mode 100644 index 0000000..87d622e --- /dev/null +++ b/sql/functions/auth.get_registration_by_hash.sql @@ -0,0 +1,25 @@ +drop function auth.get_registration_by_hash ( + p_hash text +); + +create or replace function auth.get_registration_by_hash ( + p_hash text +) +returns setof auth.registrations_t +as $$ +begin + return query + select r.id, + substring(r.hash::text from 3), + r.first_name, + r.last_name, + r.email, + r.role_groups, + r.created, + (r.created - (now() - interval '3 days'))::interval as valid_for + from auth.registrations r + where r.hash = ('\x' || p_hash)::bytea; + + return; +end; +$$ language plpgsql; diff --git a/sql/functions/auth.get_registration_by_id.sql b/sql/functions/auth.get_registration_by_id.sql new file mode 100644 index 0000000..dc9fdc1 --- /dev/null +++ b/sql/functions/auth.get_registration_by_id.sql @@ -0,0 +1,25 @@ +drop function auth.get_registration_by_id ( + p_id bigint +); + +create or replace function auth.get_registration_by_id ( + p_id bigint +) +returns setof auth.registrations_t +as $$ +begin + return query + select r.id, + substring(r.hash::text from 3), + r.first_name, + r.last_name, + r.email, + r.role_groups, + r.created, + (r.created - (now() - interval '3 days'))::interval as valid_for + from auth.registrations r + where r.id = p_id; + + return; +end; +$$ language plpgsql; diff --git a/sql/functions/auth.get_user_by_id.sql b/sql/functions/auth.get_user_by_id.sql new file mode 100644 index 0000000..d745c49 --- /dev/null +++ b/sql/functions/auth.get_user_by_id.sql @@ -0,0 +1,26 @@ +drop function auth.get_user_by_id ( + p_user_id bigint +); + +create or replace function auth.get_user_by_id ( + p_user_id bigint +) +returns setof auth.users +as $$ +begin + return query + select u.id, + u.username, + u.pwd, + u.first_name, + u.last_name, + u.email, + u.phone, + u.active, + u.created + from auth.users u + where u.id = p_user_id; + + return; +end; +$$ language plpgsql; diff --git a/sql/functions/auth.has_role.sql b/sql/functions/auth.has_role.sql new file mode 100644 index 0000000..1d6cdbd --- /dev/null +++ b/sql/functions/auth.has_role.sql @@ -0,0 +1,28 @@ +drop function auth.has_role ( + p_user_id bigint, + p_role_name character varying +); + +create or replace function auth.has_role ( + p_user_id bigint, + p_role_name character varying +) +returns setof auth.user_roles_t +as $$ +begin + return query + select user_role_group_id, + user_id, + role_group_id, + role_group_name, + role_group_description, + role_group_role_id, + role_id, + role_name, + role_description + from auth.get_all_roles_for_user(p_user_id) + where role_name = p_role_name; + + return; +end; +$$ language plpgsql; diff --git a/sql/functions/auth.insert_registration.sql b/sql/functions/auth.insert_registration.sql new file mode 100644 index 0000000..0f0b73d --- /dev/null +++ b/sql/functions/auth.insert_registration.sql @@ -0,0 +1,42 @@ +drop function auth.insert_registration ( + p_first_name character varying, + p_last_name character varying, + p_email character varying, + p_role_groups text +); + +create or replace function auth.insert_registration ( + p_first_name character varying, + p_last_name character varying, + p_email character varying, + p_role_groups text +) +returns bigint +as $$ +declare + l_id bigint; +begin + insert into auth.registrations ( + hash, + first_name, + last_name, + email, + role_groups + ) values ( + digest(concat(cast(current_timestamp as text), random()::text), 'sha512'), + p_first_name, + p_last_name, + p_email, + p_role_groups + ); + + select id into l_id + from auth.registrations + where first_name = p_first_name + and last_name = p_last_name + and email = p_email + and role_groups = p_role_groups; + + return l_id; +end; +$$ language plpgsql; diff --git a/sql/functions/auth.insert_user.sql b/sql/functions/auth.insert_user.sql new file mode 100644 index 0000000..597fd39 --- /dev/null +++ b/sql/functions/auth.insert_user.sql @@ -0,0 +1,59 @@ +drop function auth.insert_user( + p_username character varying, + p_pwd character varying, + p_first_name character varying, + p_last_name character varying, + p_email character varying, + p_phone character varying, + p_active boolean +); + +create or replace function auth.insert_user ( + p_username character varying, + p_pwd character varying, + p_first_name character varying, + p_last_name character varying, + p_email character varying, + p_phone character varying, + p_active boolean +) +returns bigint +as $$ +declare + l_id bigint; +begin + select u.id into l_id + from auth.users u + where u.username = p_username + and u.pwd = digest(p_pwd, 'sha512'); + + if(l_id is null) then + insert into auth.users ( + username, + pwd, + first_name, + last_name, + email, + phone, + active + ) values ( + p_username, + digest(p_pwd, 'sha512'), + p_first_name, + p_last_name, + p_email, + p_phone, + p_active + ); + + select u.id into l_id + from auth.users u + where u.username = p_username + and u.pwd = digest(p_pwd, 'sha512'); + + return l_id; + else + return null; + end if; +end; +$$ language plpgsql; diff --git a/sql/functions/auth.insert_user_role_group.sql b/sql/functions/auth.insert_user_role_group.sql new file mode 100644 index 0000000..ee8b21e --- /dev/null +++ b/sql/functions/auth.insert_user_role_group.sql @@ -0,0 +1,44 @@ +drop function auth.insert_user_role_group ( + p_user_id bigint, + p_role_group_name character varying +); + +create or replace function auth.insert_user_role_group ( + p_user_id bigint, + p_role_group_name character varying +) +returns bigint +as $$ +declare + l_role_group_id bigint; + l_user_role_group_id bigint; +begin + select rg.id into l_role_group_id + from auth.role_groups rg + where rg.name = p_role_group_name; + + if(l_role_group_id is not null) then + select urg.id into l_user_role_group_id + from auth.users_role_groups urg + where urg.user_id = p_user_id + and urg.role_group_id = l_role_group_id; + + if(l_user_role_group_id is null) then + insert into auth.users_role_groups ( + user_id, + role_group_id + ) values ( + p_user_id, + l_role_group_id + ); + + select urg.id into l_user_role_group_id + from auth.users_role_groups urg + where urg.user_id = p_user_id + and urg.role_group_id = l_role_group_id; + end if; + end if; + + return l_user_role_group_id; +end; +$$ language plpgsql; diff --git a/sql/functions/auth.registrations_gc.sql b/sql/functions/auth.registrations_gc.sql new file mode 100644 index 0000000..c1e1d90 --- /dev/null +++ b/sql/functions/auth.registrations_gc.sql @@ -0,0 +1,11 @@ +drop function auth.registrations_gc (); + +create or replace function auth.registrations_gc () +returns void +as $$ +begin + delete + from auth.registrations + where created < now() - interval '3 days'; +end; +$$ language plpgsql; diff --git a/sql/functions/auth.superuser_p.sql b/sql/functions/auth.superuser_p.sql new file mode 100644 index 0000000..f6865ec --- /dev/null +++ b/sql/functions/auth.superuser_p.sql @@ -0,0 +1,34 @@ +drop function auth.superuser_p ( + p_user_id bigint +); + +create or replace function auth.superuser_p ( + p_user_id bigint +) +returns bool +as $$ +declare + l_user_id bigint; +begin + with roles as ( + select urg.user_id, + rg.id as role_group_id, + rg.name + from auth.users_role_groups urg + inner join auth.role_groups_roles rgr + on urg.role_group_id = rgr.role_group_id + inner join auth.role_groups rg + on rgr.role_group_id = rg.id + where urg.user_id = p_user_id + and rg.name = 'superuser' + ) + select user_id into l_user_id + from roles; + + if(l_user_id is null) then + return false::bool; + else + return true::bool; + end if; +end; +$$ language plpgsql; diff --git a/sql/functions/auth.update_password.sql b/sql/functions/auth.update_password.sql new file mode 100644 index 0000000..8dc730c --- /dev/null +++ b/sql/functions/auth.update_password.sql @@ -0,0 +1,19 @@ +drop function auth.update_password ( + p_id bigint, + p_pwd character varying +); + +create or replace function auth.update_password ( + p_id bigint, + p_pwd character varying +) +returns bigint +as $$ +begin + update auth.users + set pwd = digest(p_pwd, 'sha512') + where id = p_id; + + return p_id; +end; +$$ language plpgsql; diff --git a/sql/functions/auth.update_profile.sql b/sql/functions/auth.update_profile.sql new file mode 100644 index 0000000..8e08c4b --- /dev/null +++ b/sql/functions/auth.update_profile.sql @@ -0,0 +1,32 @@ +drop function auth.update_profile ( + p_id bigint, + p_username character varying, + p_first_name character varying, + p_last_name character varying, + p_email character varying, + p_phone character varying +); + +create or replace function auth.update_profile ( + p_id bigint, + p_username character varying, + p_first_name character varying, + p_last_name character varying, + p_email character varying, + p_phone character varying +) +returns bigint +as $$ +begin + update auth.users + set username = p_username, + pwd = p_pwd, + first_name = p_first_name, + last_name = p_last_name, + email = p_email, + phone = p_phone + where id = p_id; + + return p_id; +end; +$$ language plpgsql; diff --git a/sql/functions/auth.update_user.sql b/sql/functions/auth.update_user.sql new file mode 100644 index 0000000..312bf2e --- /dev/null +++ b/sql/functions/auth.update_user.sql @@ -0,0 +1,45 @@ +drop function auth.update_user( + p_id bigint, + p_username character varying, + p_first_name character varying, + p_last_name character varying, + p_email character varying, + p_phone character varying +); + +create or replace function auth.update_user ( + p_id bigint, + p_username character varying, + p_first_name character varying, + p_last_name character varying, + p_email character varying, + p_phone character varying +) +returns bigint +as $$ +declare + l_id bigint; +begin + select u.id into l_id + from auth.users u + where u.id = p_id; + + if(l_id is not null) then + update auth.users + set username = p_username, + first_name = p_first_name, + last_name = p_last_name, + email = p_email, + phone = p_phone + where id = p_id; + + select u.id into l_id + from auth.users u + where u.id = p_id; + + return l_id; + else + return null; + end if; +end; +$$ language plpgsql; diff --git a/sql/functions/auth.upsert_user.sql b/sql/functions/auth.upsert_user.sql new file mode 100644 index 0000000..28e94a0 --- /dev/null +++ b/sql/functions/auth.upsert_user.sql @@ -0,0 +1,66 @@ +drop function auth.upsert_user ( + p_id bigint, + p_username character varying, + p_pwd character varying, + p_first_name character varying, + p_last_name character varying, + p_email character varying, + p_phone character varying, + p_active boolean +); + +create or replace function auth.upsert_user ( + p_id bigint, + p_username character varying, + p_pwd character varying, + p_first_name character varying, + p_last_name character varying, + p_email character varying, + p_phone character varying, + p_active boolean +) +returns bigint +as $$ +begin + if(p_id is null) then + insert into auth.users ( + username, + pwd, + first_name, + last_name, + email, + phone, + active + ) values ( + p_username, + digest(p_pwd, 'sha512'), + p_first_name, + p_last_name, + p_email, + p_phone, + p_active + ); + + select id into p_id + from auth.users + where username = p_username + and pwd = digest(p_pwd, 'sha512') + and first_name = p_first_name + and last_name = p_last_name + and email = p_email + and phone = p_phone; + else + update auth.users + set username = p_username, + pwd = digest(p_pwd, 'sha512'), + first_name = p_first_name, + last_name = p_last_name, + email = p_email, + phone = p_phone, + active = p_active + where id = p_id; + end if; + + return p_id; +end; +$$ language plpgsql; diff --git a/sql/functions/auth.user_delete.sql b/sql/functions/auth.user_delete.sql new file mode 100644 index 0000000..6fe66f4 --- /dev/null +++ b/sql/functions/auth.user_delete.sql @@ -0,0 +1,54 @@ +drop function auth.user_delete ( + p_id bigint +); + +create or replace function auth.user_delete ( + p_id bigint +) +returns bool +as $$ +declare + l_id bigint; + l_result bool; +begin + if p_id is null then + l_result := false::bool; + else + select id into l_id + from auth.users + where id = p_id; + + if l_id is null or l_id != p_id then + l_result := false::bool; + else + delete + from auth.users_roles_append + where user_id = l_id; + + delete + from auth.users_roles_exclude + where user_id = l_id; + + delete + from auth.users_role_groups + where user_id = l_id; + + delete + from general.roster + where user_id = l_id; + + delete + from contact.contact_us_posts_read + where user_id = l_id; + + delete + from auth.users + where id = l_id; + + l_result := true::bool; + end if; + end if; + + return l_result; +end; +$$ language plpgsql; diff --git a/sql/functions/auth.user_toggle_active.sql b/sql/functions/auth.user_toggle_active.sql new file mode 100644 index 0000000..adc1b62 --- /dev/null +++ b/sql/functions/auth.user_toggle_active.sql @@ -0,0 +1,31 @@ +drop function auth.user_toggle_active ( + p_id bigint +); + +create or replace function auth.user_toggle_active ( + p_id bigint +) +returns bigint +as $$ +declare + l_id bigint; +begin + select u.id into l_id + from auth.users u + where u.id = p_id; + + if(l_id is not null) then + update auth.users + set active = not active + where id = p_id; + + select u.id into l_id + from auth.users u + where u.id = p_id; + + return l_id; + else + return null; + end if; +end; +$$ language plpgsql; diff --git a/sql/functions/contact.get_contact_us_posts_by_id_and_read.sql b/sql/functions/contact.get_contact_us_posts_by_id_and_read.sql new file mode 100644 index 0000000..646fe0f --- /dev/null +++ b/sql/functions/contact.get_contact_us_posts_by_id_and_read.sql @@ -0,0 +1,30 @@ +drop function contact.get_contact_us_posts_by_id_and_read ( + p_user_id bigint, + p_read bool +); + +create or replace function contact.get_contact_us_posts_by_id_and_read ( + p_user_id bigint, + p_read bool +) +returns setof contact.contact_us_posts +as $$ +begin + return query + select c.id, + c.first_name, + c.last_name, + c.email, + c.phone, + c.submitted, + c.comments + from contact.contact_us_posts c + left outer join contact.contact_us_posts_read cr + on c.id = cr.contact_us_post_id + where (p_read = false and cr.user_id is null) + or (p_read = true and cr.user_id = p_user_id) + order by c.submitted desc; + + return; +end; +$$ language plpgsql; diff --git a/sql/functions/contact.insert_contact_us_post.sql b/sql/functions/contact.insert_contact_us_post.sql new file mode 100644 index 0000000..739f084 --- /dev/null +++ b/sql/functions/contact.insert_contact_us_post.sql @@ -0,0 +1,45 @@ +drop function contact.insert_contact_us_post ( + p_first_name character varying, + p_last_name character varying, + p_email character varying, + p_phone character varying, + p_comments text +); + +create or replace function contact.insert_contact_us_post ( + p_first_name character varying, + p_last_name character varying, + p_email character varying, + p_phone character varying, + p_comments text +) +returns bigint +as $$ +declare + l_id bigint; +begin + insert into contact.contact_us_posts ( + first_name, + last_name, + email, + phone, + comments + ) values ( + p_first_name, + p_last_name, + p_email, + p_phone, + p_comments + ); + + select id into l_id + from contact.contact_us_posts + where first_name = p_first_name + and last_name = p_last_name + and email = p_email + and phone = p_phone + and comments = p_comments; + + return l_id; +end; +$$ language plpgsql; diff --git a/sql/functions/contact.mark_contact_us_post.sql b/sql/functions/contact.mark_contact_us_post.sql new file mode 100644 index 0000000..7bcc001 --- /dev/null +++ b/sql/functions/contact.mark_contact_us_post.sql @@ -0,0 +1,38 @@ +drop function contact.mark_contact_us_post ( + p_contact_us_post_id int, + p_user_id int, + p_read_p bool +); + +create or replace function contact.mark_contact_us_post ( + p_contact_us_post_id int, + p_user_id int, + p_read_p bool +) +returns void +as $$ +declare + l_id bigint; +begin + if(p_read_p) then + select id into l_id + from contact.contact_us_posts_read + where contact_us_post_id = p_contact_us_post_id + and user_id = p_user_id; + + if(l_id is null) then + insert into contact.contact_us_posts_read ( + contact_us_post_id, + user_id + ) values ( + p_contact_us_post_id, + p_user_id + ); + end if; + else + delete from contact.contact_us_posts_read + where contact_us_post_id = p_contact_us_post_id + and user_id = p_user_id; + end if; +end; +$$ language plpgsql; diff --git a/sql/schemas/schemas.sql b/sql/schemas/schemas.sql new file mode 100644 index 0000000..abcfc3d --- /dev/null +++ b/sql/schemas/schemas.sql @@ -0,0 +1,5 @@ +-- set search_path = auth,general,contact,public; + +create schema auth; +create schema general; +create schema contact; diff --git a/sql/tables/auth.registrations.sql b/sql/tables/auth.registrations.sql new file mode 100644 index 0000000..91eb3a1 --- /dev/null +++ b/sql/tables/auth.registrations.sql @@ -0,0 +1,11 @@ +drop table auth.registrations cascade; + +create table auth.registrations ( + id serial8 primary key, + hash bytea not null, + first_name character varying(255) not null, + last_name character varying(255) not null, + email character varying(255) not null, + role_groups text, + created timestamp without time zone not null default now() +); diff --git a/sql/tables/auth.role_groups.sql b/sql/tables/auth.role_groups.sql new file mode 100644 index 0000000..8b6d225 --- /dev/null +++ b/sql/tables/auth.role_groups.sql @@ -0,0 +1,7 @@ +drop table auth.role_groups cascade; + +create table auth.role_groups ( + id serial8 primary key, + name character varying(255) not null, + description character varying(255) +); diff --git a/sql/tables/auth.role_groups_roles.sql b/sql/tables/auth.role_groups_roles.sql new file mode 100644 index 0000000..7ebab21 --- /dev/null +++ b/sql/tables/auth.role_groups_roles.sql @@ -0,0 +1,7 @@ +drop table auth.role_groups_roles cascade; + +create table auth.role_groups_roles ( + id serial8 primary key, + role_group_id bigint not null references auth.role_groups(id), + role_id bigint not null references auth.roles(id) +); diff --git a/sql/tables/auth.roles.sql b/sql/tables/auth.roles.sql new file mode 100644 index 0000000..f5873fe --- /dev/null +++ b/sql/tables/auth.roles.sql @@ -0,0 +1,7 @@ +drop table auth.roles cascade; + +create table auth.roles ( + id serial8 primary key, + name character varying(255) not null, + description character varying(255) +); diff --git a/sql/tables/auth.user_session_objects.sql b/sql/tables/auth.user_session_objects.sql new file mode 100644 index 0000000..aedfb42 --- /dev/null +++ b/sql/tables/auth.user_session_objects.sql @@ -0,0 +1,8 @@ +drop table auth.user_session_objects cascade; + +create table auth.user_session_objects ( + id serial8 primary key, + user_session_id bigint not null references auth.user_sessions(id), + session_key character varying(255), + serialization text +); diff --git a/sql/tables/auth.user_sessions.sql b/sql/tables/auth.user_sessions.sql new file mode 100644 index 0000000..2629d62 --- /dev/null +++ b/sql/tables/auth.user_sessions.sql @@ -0,0 +1,7 @@ +drop table auth.user_sessions cascade; + +create table auth.user_sessions ( + id serial8 primary key, + sessionid character varying(255) not null, + datetime bigint not null +); diff --git a/sql/tables/auth.users.sql b/sql/tables/auth.users.sql new file mode 100644 index 0000000..8eecf76 --- /dev/null +++ b/sql/tables/auth.users.sql @@ -0,0 +1,13 @@ +drop table auth.users cascade; + +create table auth.users ( + id serial8 primary key, + username character varying(255) not null, + pwd bytea, + first_name character varying(255) not null, + last_name character varying(255) not null, + email character varying(255) not null, + phone character varying(255), + active bool, + created timestamp without time zone not null default now() +); diff --git a/sql/tables/auth.users_role_groups.sql b/sql/tables/auth.users_role_groups.sql new file mode 100644 index 0000000..44cfe4a --- /dev/null +++ b/sql/tables/auth.users_role_groups.sql @@ -0,0 +1,7 @@ +drop table auth.users_role_groups cascade; + +create table auth.users_role_groups ( + id serial8 primary key, + user_id bigint not null references auth.users(id), + role_group_id bigint not null references auth.role_groups(id) +); diff --git a/sql/tables/auth.users_roles_append.sql b/sql/tables/auth.users_roles_append.sql new file mode 100644 index 0000000..f6603e6 --- /dev/null +++ b/sql/tables/auth.users_roles_append.sql @@ -0,0 +1,7 @@ +drop table auth.users_roles_append cascade; + +create table auth.users_roles_append ( + id serial8 primary key, + user_id bigint not null references auth.users(id), + role_id bigint not null references auth.roles(id) +); diff --git a/sql/tables/auth.users_roles_exclude.sql b/sql/tables/auth.users_roles_exclude.sql new file mode 100644 index 0000000..e47385e --- /dev/null +++ b/sql/tables/auth.users_roles_exclude.sql @@ -0,0 +1,7 @@ +drop table auth.users_roles_exclude cascade; + +create table auth.users_roles_exclude ( + id serial8 primary key, + user_id bigint not null references auth.users(id), + role_id bigint not null references auth.roles(id) +); diff --git a/sql/tables/contact.contact_us.sql b/sql/tables/contact.contact_us.sql new file mode 100644 index 0000000..0957e3c --- /dev/null +++ b/sql/tables/contact.contact_us.sql @@ -0,0 +1,6 @@ +drop table contact.contact_us cascade; + +create table contact.contact_us ( + id serial8 primary key, + content text +); diff --git a/sql/tables/contact.contact_us_posts.sql b/sql/tables/contact.contact_us_posts.sql new file mode 100644 index 0000000..5e208cb --- /dev/null +++ b/sql/tables/contact.contact_us_posts.sql @@ -0,0 +1,11 @@ +drop table contact.contact_us_posts cascade; + +create table contact.contact_us_posts ( + id serial8 primary key, + first_name character varying(255) not null, + last_name character varying(255) not null, + email character varying(255) not null, + phone character varying(255), + submitted timestamp without time zone not null default now(), + comments text +); diff --git a/sql/tables/contact.contact_us_posts_read.sql b/sql/tables/contact.contact_us_posts_read.sql new file mode 100644 index 0000000..80be27c --- /dev/null +++ b/sql/tables/contact.contact_us_posts_read.sql @@ -0,0 +1,7 @@ +drop table contact.contact_us_posts_read cascade; + +create table contact.contact_us_posts_read ( + id serial8 primary key, + contact_us_post_id bigint not null references contact.contact_us_posts(id), + user_id bigint not null references auth.users(id) +); diff --git a/sql/tables/general.about_us.sql b/sql/tables/general.about_us.sql new file mode 100644 index 0000000..237065b --- /dev/null +++ b/sql/tables/general.about_us.sql @@ -0,0 +1,6 @@ +drop table general.about_us cascade; + +create table general.about_us ( + id serial8 primary key, + content text +); diff --git a/sql/tables/general.testimonials.sql b/sql/tables/general.testimonials.sql new file mode 100644 index 0000000..64300a6 --- /dev/null +++ b/sql/tables/general.testimonials.sql @@ -0,0 +1,6 @@ +drop table general.testimonials cascade; + +create table general.testimonials ( + id serial8 primary key, + content text +); diff --git a/sql/types/auth.registrations_t.sql b/sql/types/auth.registrations_t.sql new file mode 100644 index 0000000..cde66d0 --- /dev/null +++ b/sql/types/auth.registrations_t.sql @@ -0,0 +1,12 @@ +drop type auth.registrations_t cascade; + +create type auth.registrations_t as ( + id bigint, + hash text, + first_name character varying, + last_name character varying, + email character varying, + role_groups text, + created timestamp without time zone, + valid_for interval +); diff --git a/sql/types/auth.role_groups_t.sql b/sql/types/auth.role_groups_t.sql new file mode 100644 index 0000000..615c481 --- /dev/null +++ b/sql/types/auth.role_groups_t.sql @@ -0,0 +1,9 @@ +drop type auth.role_groups_t cascade; + +CREATE TYPE auth.role_groups_t AS ( + user_role_group_id bigint, + user_id bigint, + role_group_id bigint, + name character varying, + description character varying +); diff --git a/sql/types/auth.user_roles_t.sql b/sql/types/auth.user_roles_t.sql new file mode 100644 index 0000000..e6b8443 --- /dev/null +++ b/sql/types/auth.user_roles_t.sql @@ -0,0 +1,13 @@ +drop type auth.user_roles_t cascade; + +CREATE TYPE auth.user_roles_t AS ( + user_role_group_id bigint, + user_id bigint, + role_group_id bigint, + role_group_name character varying, + role_group_description character varying, + role_group_role_id bigint, + role_id bigint, + role_name character varying, + role_description character varying +); |
