summaryrefslogtreecommitdiff
path: root/lisp/service
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/service')
-rw-r--r--lisp/service/about-us-service.lisp48
-rw-r--r--lisp/service/base-service.lisp210
-rw-r--r--lisp/service/contact-us-service.lisp34
-rw-r--r--lisp/service/gallery-service.lisp52
-rw-r--r--lisp/service/generics.lisp15
-rw-r--r--lisp/service/home-service.lisp11
-rw-r--r--lisp/service/login-service.lisp61
-rw-r--r--lisp/service/logout-service.lisp1
-rw-r--r--lisp/service/menu-service.lisp3
-rw-r--r--lisp/service/messages-service.lisp37
-rw-r--r--lisp/service/password-service.lisp21
-rw-r--r--lisp/service/profile-service.lisp42
-rw-r--r--lisp/service/rest-service.lisp8
-rw-r--r--lisp/service/users-service.lisp204
14 files changed, 484 insertions, 263 deletions
diff --git a/lisp/service/about-us-service.lisp b/lisp/service/about-us-service.lisp
index 1ede1d2..efc2d2f 100644
--- a/lisp/service/about-us-service.lisp
+++ b/lisp/service/about-us-service.lisp
@@ -9,10 +9,6 @@
:accessor category))
(:documentation ""))
-(defun about-us-json (category)
- (with-noauth (instance about-us-service)
- (setf (category instance) category)))
-
(defclass about-us/view-service (about-us-service)
((content :initarg :content
:initform nil
@@ -23,26 +19,30 @@
(location :initform nil))
(:documentation ""))
+(defclass about-us/modify-service (about-us/view-service auth-service)
+ ((form :initarg :form
+ :initform nil
+ :accessor form)
+ (admin-p :initform t)
+ (location-p :initform nil))
+ (:documentation ""))
+
+(defun about-us-json (category &optional message errormsg)
+ (with-noauth (instance about-us-service)
+ (setf (message instance) message)
+ (setf (errormsg instance) errormsg)
+ (setf (category instance) category)))
+
(defun about-us-view-json (category)
(with-noauth (instance about-us/view-service)
(setf (category instance) category)
- (with-valid-user (user "about-us-modify")
- (setf (admin-p instance) nil)
- (setf (admin-p instance) t))
+ (setf (admin-p instance) (with-valid-user (user "about-us-modify") nil t))
(with-bogenherr-database
(let* ((general-pkg (make-instance 'general-pkg))
(about-us (get-about-us general-pkg category)))
(when about-us
(setf (content instance) (content about-us)))))))
-(defclass about-us/modify-service (about-us/view-service auth-service)
- ((form :initarg :form
- :initform nil
- :accessor form)
- (admin-p :initform t)
- (location-p :initform nil))
- (:documentation ""))
-
(defun about-us-modify-json (category)
(with-auth (instance about-us/modify-service "about-us-modify")
(with-bogenherr-database
@@ -51,7 +51,7 @@
(setf (form instance) (make-form "about-us-modify-form"
nil
nil
- `((:label "Content" :name "txt-content" :field-type "textarea" :value ,(content about-us) :required "required")
+ `((:label "Content" :name "content" :field-type "textarea" :value ,(content about-us) :required "required")
(:label "Modify" :field-type "button" :onclick "on_about_us_modify_submit_clicked()"))))))))
(defun about-us-modify-submit-json (category content)
@@ -64,3 +64,19 @@
(update-record general-pkg about-us))))
(setf (content instance) content)
(setf (message instance) "About Us text saved successfully.")))
+
+(define-endpoint ("/lessons" :method :get) () about-us-json "lessons")
+(define-endpoint ("/lessons" :method :post) (&post (message :parameter-type 'string) (errormsg :parameter-type 'string)) about-us-json "lessons" message errormsg)
+(define-endpoint ("/lessons/view" :method :get) () about-us-view-json "lessons")
+(define-endpoint ("/lessons/modify" :method :post) () about-us-modify-json "lessons")
+(define-endpoint ("/lessons/modify/submit" :method :post) (&post (content :parameter-type 'string)) about-us-modify-submit-json "lessons" content)
+(define-endpoint ("/gigs" :method :get) () about-us-json "gigs")
+(define-endpoint ("/gigs" :method :post) (&post (message :parameter-type 'string) (errormsg :parameter-type 'string)) about-us-json "gigs" message errormsg)
+(define-endpoint ("/gigs/view" :method :get) () about-us-view-json "gigs")
+(define-endpoint ("/gigs/modify" :method :post) () about-us-modify-json "gigs")
+(define-endpoint ("/gigs/modify/submit" :method :post) (&post (content :parameter-type 'string)) about-us-modify-submit-json "gigs" content)
+(define-endpoint ("/programming" :method :get) () about-us-json "programming")
+(define-endpoint ("/programming" :method :post) (&post (message :parameter-type 'string) (errormsg :parameter-type 'string)) about-us-json "programming" message errormsg)
+(define-endpoint ("/programming/view" :method :get) () about-us-view-json "programming")
+(define-endpoint ("/programming/modify" :method :post) () about-us-modify-json "programming")
+(define-endpoint ("/programming/modify/submit" :method :post) (&post (content :parameter-type 'string)) about-us-modify-submit-json "programming" content)
diff --git a/lisp/service/base-service.lisp b/lisp/service/base-service.lisp
index ecd9469..c830254 100644
--- a/lisp/service/base-service.lisp
+++ b/lisp/service/base-service.lisp
@@ -3,19 +3,221 @@
(in-package :bogenherr)
-(defclass base-service ()
- ()
+;; webapp
+
+(defvar *acceptor* nil)
+(defvar *dispatch-table* '(#'dispatch-easy-handlers #'default-dispatcher))
+(defvar *webapps* (make-hash-table :test 'equal))
+(defvar *webapp* nil)
+(defvar *uri* nil)
+(defvar *header-register* nil)
+(defvar *sessionid* nil)
+(defparameter *port* 3012)
+(defparameter *server-root* (namestring (asdf:system-relative-pathname (intern (package-name #.*package*)) "./"))
+ "The location of the web server root on the filesystem.")
+
+(defclass webapp ()
+ ((name :initarg :name
+ :initform nil
+ :accessor name
+ :documentation "The name of the webapp as used in the code. A
+string used as the key to any webapp config lookup.")
+ (scheme :initarg :scheme
+ :initform nil
+ :accessor scheme)
+ (url :initarg :url
+ :initform nil
+ :accessor url
+ :documentation "The domain portion of the URL to the
+root of the webapp.")
+ (document-root :initarg :document-root
+ :initform nil
+ :accessor document-root
+ :documentation "The absolute filesystem path to the
+webapp's top-level directory which is inside the webapps folder.")
+ (title :initarg :title
+ :initform nil
+ :accessor title
+ :documentation "The default title that shows up in
+the browser title bar.")
+ (meta-description :initarg :meta-description
+ :initform nil
+ :accessor meta-description
+ :documentation "The text that goes into the META DESCRIPTION
+tag, and anywhere else we want to put this text so that it will show
+up in Google.")
+ (databases :initarg :databases
+ :initform nil
+ :accessor databases)
+ (mail-mx :initarg :mail-mx
+ :initform nil
+ :accessor mail-mx)
+ (mail-from :initarg :mail-from
+ :initform nil
+ :accessor mail-from)
+ (mail-postmaster :initarg :mail-postmaster
+ :initform nil
+ :accessor mail-postmaster)
+ (mail-webmaster :initarg :mail-webmaster
+ :initform nil
+ :accessor mail-webmaster)
+ (mail-info :initarg :mail-info
+ :initform nil
+ :accessor mail-info)
+ (mail-login-notify :initarg :mail-login-notify
+ :initform nil
+ :accessor mail-login-notify)
+ (mail-authentication :initarg :mail-authentication
+ :initform nil
+ :accessor mail-authentication)
+ (mail-ssl :initarg :mail-ssl
+ :initform nil
+ :accessor mail-ssl))
(:documentation ""))
+(defmethod get-site-file-path ((webapp webapp))
+ (format nil "~a/site" (document-root webapp)))
+
+(defmethod get-pages-file-paths ((webapp webapp))
+ (mapcar (lambda (pages-file)
+ (ppcre:regex-replace-all "\\.lisp$" (format nil "~a" pages-file) ""))
+ (remove-if (lambda (x) (equal x "shared"))
+ (org-ckons-core::shell-wrapper (format nil "find '~a' -maxdepth 1 -type f -iname 'pages*.lisp' |sort" (document-root webapp))))))
+
+(defun make-server-path (relative-path)
+ "Makes a relative filesystem path into a full one, using
+`*server-root*' as the base."
+ (make-document-root-path *server-root* relative-path))
+
+(defun make-document-root-path (document-root relative-path)
+ "Makes a relative filesystem path into a full one, using
+`document-root' as the base."
+ (concatenate 'string document-root relative-path))
+
+(defun make-webapp-path (relative-path)
+ "Makes an absolute filesystem path to a location in the webapps
+folder."
+ (concatenate 'string *server-root* "webapps/" relative-path))
+
+(defun get-options-files ()
+ (mapcar (lambda (webapp-directory)
+ (format nil "~a/conf/options.lisp" webapp-directory))
+ (remove-if (lambda (x) (or (org-ckons-core::match-it "webapps/$" x)
+ (org-ckons-core::match-it "webapps/shared$" x)
+ (org-ckons-core::match-it "webapps/CVS$" x)
+ (org-ckons-core::match-it "webapps/\\.$" x)
+ (org-ckons-core::match-it "webapps/\\.\\.$" x)))
+ (org-ckons-core::shell-wrapper (format nil "find '~a' -maxdepth 1 -type d |sort" (make-webapp-path ""))))))
+
+(defun set-webapp (webapp)
+ "Sets a `webapp' object in `*webapps*'. The lookup key is the webapp
+name. If a webapp already exists under this key, it gets overwritten
+with the new one."
+ (setf (gethash (name webapp) *webapps*) webapp))
+
+(defun get-webapp (key)
+ "Gets the webapp object stored under the key `key'."
+ (gethash key *webapps*))
+
+(defun populate-webapps ()
+ (loop for options-file in (get-options-files)
+ do (with-open-file (input options-file :direction :input)
+ (let* ((form (read input)))
+ (set-webapp (make-instance 'webapp
+ :name (getf form :name)
+ :scheme (getf form :scheme)
+ :url (getf form :url)
+ :document-root (make-webapp-path (getf form :document-root))
+ :title (getf form :title)
+ :meta-description (getf form :meta-description)
+ :databases (getf form :databases)
+ :mail-mx (getf form :mail-mx)
+ :mail-from (getf form :mail-from)
+ :mail-postmaster (getf form :mail-postmaster)
+ :mail-webmaster (getf form :mail-webmaster)
+ :mail-info (getf form :mail-info)
+ :mail-login-notify (getf form :mail-login-notify)
+ :mail-authentication (getf form :mail-authentication)
+ :mail-ssl (getf form :mail-ssl)))))))
+
+(defun bogenherr ()
+ "Call this to start the server."
+ (when (null *acceptor*)
+ (let ((package (string-downcase (package-name #.*package*))))
+ (populate-webapps)
+ (setf (log-manager) (make-instance 'log-manager :message-class 'formatted-message))
+ (start-messenger 'text-file-messenger :filename (format nil "/var/log/lisp/~a.log" package))
+ (setf *session-secret* (org-ckons-session::generate-sessionid))
+ (populate-webapps)
+ (setf *acceptor* (start (make-instance 'easy-routes:easy-routes-acceptor
+ :port *port*
+ :document-root (make-server-path (format nil "webapps/~a/" package))
+ :name (format nil "~a-acceptor" package)))))))
+
+(defmacro with-request-wrapper (uri page-function &rest args)
+ (let ((package (string-downcase (package-name #.*package*))))
+ `(let (output)
+ (let* ((*webapp* (get-webapp ,package))
+ (*uri* ,uri)
+ (*header-register* (make-instance 'org-ckons-session::header-register))
+ (*sessionid* (ensure-user-session-exists)))
+ (ensure-user-exists)
+ (setf output (,page-function ,@args))
+ (org-ckons-session::ship-headers *header-register*))
+ output)))
+
+(defmacro define-endpoint (template-and-options var-list page-function &rest args)
+ "Does the grunt work of creating an `easy-routes' route for each page
+you wish to publish."
+ (let ((name (gensym))
+ (uri (first template-and-options))
+ (method (getf (rest template-and-options) :method)))
+ `(progn
+ (org-ckons-core::logger (format nil "Publishing page. URL = [~a], method = [~a]" ,uri ,method))
+ (easy-routes:defroute ,name ,template-and-options
+ ,var-list
+ (with-request-wrapper ,uri ,page-function ,@args)))))
+
+;; base-service
+
(defmacro loop-intersect-slots ((slot record other-object) &body body)
`(loop for ,slot in (intersect-slots ,record (org-ckons-core::map-slot-names ,other-object))
do (when (slot-is-field-p ,slot)
,@body)))
+(defclass base-service ()
+ ()
+ (:documentation ""))
+
(defmethod copy-from-record ((base-service base-service) (record record))
(loop-intersect-slots (slot record base-service)
- (setf (slot-value base-service slot) (slot-value record slot))))
+ (setf (slot-value base-service slot) (slot-value record slot))))
(defmethod copy-to-record ((base-service base-service) (record record))
(loop-intersect-slots (slot record base-service)
- (setf (slot-value record slot) (slot-value base-service slot))))
+ (setf (slot-value record slot) (slot-value base-service slot))))
+
+(defun base (&optional (start-url "/home"))
+ (org-ckons-http::html5
+ `(html
+ (head
+ ((meta :name "viewport" :content "width=device-width, initial-scale=1, shrink-to-fit=no"))
+ ((meta :charset "utf-8"))
+ ((title) ,(title *webapp*))
+ ,@(mapcar (lambda (css)
+ `((link :rel "stylesheet" :href ,(getf css :href) :integrity ,(getf css :integrity) :crossorigin ,(getf css :crossorigin))))
+ '((:href "https://cdn.jsdelivr.net/npm/bootstrap@4.6.2/dist/css/bootstrap.min.css" :integrity "sha384-xOolHFLEh07PJGoPkLv1IbcEPTNtaed2xpHsD9ESMhqIYd0nLMwNLD69Npy4HI+N" :crossorigin "anonymous")
+ (:href "/static/css/stylesheet.css" :crossorigin "anonymous")))
+ ,@(mapcar (lambda (js)
+ `((script :type "text/javascript" :src ,(getf js :src) :integrity ,(getf js :integrity) :crossorigin ,(getf js :crossorigin))))
+ '((:src "https://code.jquery.com/jquery-3.7.1.slim.min.js" :integrity "sha256-kmHvs0B+OpCW5GVHUNjv9rOmY0IvSIRcf7zGUDTDQM8=" :crossorigin "anonymous")))
+ ((script :type "text/javascript" :src "/cljs-out/dev-main.js")))
+ ((body :onload ,(format nil "bogenherr.core.start(~a)" (if start-url
+ (format nil "'~a'" start-url)
+ "null")))
+ ((div :id "app"))
+ ,@(mapcar (lambda (js)
+ `((script :type "text/javascript" :src ,(getf js :src) :integrity ,(getf js :integrity) :crossorigin ,(getf js :crossorigin))))
+ '((:src "https://cdn.jsdelivr.net/npm/bootstrap@4.6.2/dist/js/bootstrap.bundle.min.js" :integrity "sha384-Fy6S3B9q64WdZWQUiU+q4/2Lc9npb8tCaSX9FK7E8HnRr0Jz8D6OP9dO5Vg3Q9ct" :crossorigin "anonymous")))))))
+
+(define-endpoint ("/" :method :get) () base)
diff --git a/lisp/service/contact-us-service.lisp b/lisp/service/contact-us-service.lisp
index 4e2aada..959b746 100644
--- a/lisp/service/contact-us-service.lisp
+++ b/lisp/service/contact-us-service.lisp
@@ -7,6 +7,16 @@
()
(:documentation ""))
+(defclass contact-us/view-service (contact-us-service)
+ ((content :initarg :content
+ :initform nil
+ :accessor content)
+ (form :initarg :form
+ :initform nil
+ :accessor form)
+ (location-p :initform nil))
+ (:documentation ""))
+
(defun contact-us-form ()
(make-form "contact-us-form"
nil
@@ -22,27 +32,13 @@
(with-noauth (instance contact-us-service)
t))
-(defclass contact-us/view-service (contact-us-service)
- ((content :initarg :content
- :initform nil
- :accessor content)
- (form :initarg :form
- :initform nil
- :accessor form)
- (location-p :initform nil))
- (:documentation ""))
-
(defun contact-us-view-json ()
(with-noauth (instance contact-us/view-service)
(setf (form instance) (contact-us-form))))
-(defclass contact-us/email-service (contact-us/view-service)
- ()
- (:documentation ""))
-
(defun contact-us-email-json (first_name last_name email phone comments)
(declare (special first_name last_name email phone comments))
- (with-noauth (instance contact-us/email-service)
+ (with-noauth (instance contact-us/email-servicea)
(with-bogenherr-database
(let ((contact-pkg (make-instance 'contact-pkg))
(contact-us-post (make-instance 'contact-us-post)))
@@ -78,7 +74,11 @@
:reply-to (mail-postmaster *webapp*)
:ssl (mail-ssl *webapp*)
:authentication (mail-authentication *webapp*))
- (setf (session-value :message) "Form submitted successfully."))
+ (setf (message instance) "Form submitted successfully."))
(error (e)
(declare (ignore e))
- (setf (session-value :errormsg) "Error submitting form.")))))))
+ (setf (errormsg instance) "Error submitting form.")))))))
+
+(define-endpoint ("/contact-us" :method :get) () contact-us-json)
+(define-endpoint ("/contact-us/view" :method :get) () contact-us-view-json)
+(define-endpoint ("/contact-us/email" :method :post) (&post (first_name :parameter-type 'string) (last_name :parameter-type 'string) (email :parameter-type 'string) (phone :parameter-type 'string) (comments :parameter-type 'string)) contact-us-email-json first_name last_name email phone comments)
diff --git a/lisp/service/gallery-service.lisp b/lisp/service/gallery-service.lisp
index c3d0825..44a7804 100644
--- a/lisp/service/gallery-service.lisp
+++ b/lisp/service/gallery-service.lisp
@@ -9,12 +9,6 @@
:accessor admin-p))
(:documentation ""))
-(defun gallery-json ()
- (with-noauth (instance gallery-service)
- (with-valid-user (user "gallery-modify")
- (setf (admin-p instance) nil)
- (setf (admin-p instance) t))))
-
(defclass gallery/view-service (gallery-service)
((results :initarg :results
:initform nil
@@ -22,6 +16,18 @@
(location-p :initform nil))
(:documentation ""))
+(defclass gallery/modify-service (gallery/view-service)
+ ((form :initarg :form
+ :initform nil
+ :accessor form))
+ (:documentation ""))
+
+(defun gallery-json ()
+ (with-noauth (instance gallery-service)
+ (with-valid-user (user "gallery-modify")
+ (setf (admin-p instance) nil)
+ (setf (admin-p instance) t))))
+
(defun gallery-view-json ()
(with-noauth (instance gallery/view-service)
(with-valid-user (user "gallery-modify")
@@ -35,14 +41,8 @@
(loop for gallery in (results instance)
do (sanitize-json gallery))))
-(defclass gallery/add-modify-delete-service (gallery/view-service)
- ((form :initarg :form
- :initform nil
- :accessor form))
- (:documentation ""))
-
(defun gallery-add-json ()
- (with-auth (instance gallery/add-modify-delete-service "gallery-modify")
+ (with-auth (instance gallery/modify-service "gallery-modify")
(setf (form instance) (make-form "gallery-add-form"
nil
t
@@ -53,7 +53,7 @@
(defun gallery-add-submit-json (description video_embed_url upload)
(declare (special description video_embed_url))
- (with-auth (instance gallery/add-modify-delete-service "gallery-modify")
+ (with-auth (instance gallery/modify-service "gallery-modify")
(with-bogenherr-database
(let ((general-pkg (make-instance 'general-pkg))
(gallery (make-instance 'gallery))
@@ -75,7 +75,7 @@
(setf (session-value :message) "Gallery added successfully.")))))
(defun gallery-modify-json (id)
- (with-auth (instance gallery/add-modify-delete-service "gallery-modify")
+ (with-auth (instance gallery/modify-service "gallery-modify")
(with-bogenherr-database
(let* ((general-pkg (make-instance 'general-pkg))
(gallery (get-gallery general-pkg id)))
@@ -88,11 +88,11 @@
(:name "video_embed_url" :label "Video embed URL" :field-type "text" :value ,(video_embed_url gallery))
(:name "upload" :label "Image/Video" :field-type "file")
(:label "Modify Gallery" :field-type "button" :onclick "on_gallery_modify_submit_clicked()"))))
- (setf (session-value :errormsg) "Error: could not modify gallery. Not found."))))))
+ (setf (errormsg instance) "Error: could not modify gallery. Not found."))))))
(defun gallery-modify-submit-json (id description video_embed_url upload)
(declare (special description video_embed_url))
- (with-auth (instance gallery/add-modify-delete-service "gallery-modify")
+ (with-auth (instance gallery/modify-service "gallery-modify")
(with-bogenherr-database
(let* ((general-pkg (make-instance 'general-pkg))
(gallery (get-gallery general-pkg id)))
@@ -112,19 +112,19 @@
(setf (mime_type gallery) (org-ckons-file::get-mime-type new-filepath))
(setf (content gallery) (org-ckons-file::file-as-hex new-filepath))))
(update-gallery general-pkg gallery)
- (setf (session-value :message) "Gallery saved successfully."))
- (setf (session-value :errormsg) "An error occurred."))))))
+ (setf (message instance) "Gallery saved successfully."))
+ (setf (errormsg instance) "An error occurred."))))))
(defun gallery-delete-json (id)
- (with-auth (instance gallery/add-modify-delete-service "gallery-modify")
+ (with-auth (instance gallery/modify-service "gallery-modify")
(with-bogenherr-database
(let* ((general-pkg (make-instance 'general-pkg))
(gallery (get-gallery general-pkg id)))
(if gallery
(progn
(delete-record general-pkg gallery)
- (setf (session-value :message) "Gallery deleted successfully."))
- (setf (session-value :errormsg) "Error: could not delete gallery. Not found."))))))
+ (setf (message instance) "Gallery deleted successfully."))
+ (setf (errormsg instance) "Error: could not delete gallery. Not found."))))))
(defun gallery-file-view (id)
(with-noauth-raw (instance gallery/view-service)
@@ -134,3 +134,11 @@
(when gallery
(setf (org-ckons-session::content-type *header-register*) (mime_type gallery))
(ironclad:hex-string-to-byte-array (content gallery)))))))
+
+(define-endpoint ("/gallery" :method :get) () gallery-json)
+(define-endpoint ("/gallery/view" :method :get) () gallery-view-json)
+(define-endpoint ("/gallery/add" :method :post) () gallery-add-json)
+(define-endpoint ("/gallery/add/submit" :method :post) (&post (description :parameter-type 'string) (video_embed_url :parameter-type 'string) (upload :parameter-type 'string)) gallery-add-submit-json description video_embed_url upload)
+(define-endpoint ("/gallery/modify" :method :post) (&post (id :parameter-type 'integer)) gallery-modify-json id)
+(define-endpoint ("/gallery/modify/submit" :method :post) (&post (id :parameter-type 'integer) (description :parameter-type 'string) (video_embed_url :parameter-type 'string) (upload :parameter-type 'string)) gallery-modify-submit-json id description video_embed_url upload)
+(define-endpoint ("/gallery/delete" :method :post) (&post (id :parameter-type 'integer)) gallery-delete-json id)
diff --git a/lisp/service/generics.lisp b/lisp/service/generics.lisp
deleted file mode 100644
index 592d245..0000000
--- a/lisp/service/generics.lisp
+++ /dev/null
@@ -1,15 +0,0 @@
-;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-(declaim (optimize (speed 0) (safety 3) (debug 3)))
-
-(in-package :bogenherr)
-
-(defgeneric copy-from-record (base-service record)
- (:documentation "Copies the fields from `record' to
-`base-service'."))
-
-(defgeneric copy-to-record (base-service record)
- (:documentation "Copies the fields from `base-service' to
-`record'."))
-
-(defgeneric sanitize-rest-json (rest-service)
- (:documentation ""))
diff --git a/lisp/service/home-service.lisp b/lisp/service/home-service.lisp
index da6ded6..63011e5 100644
--- a/lisp/service/home-service.lisp
+++ b/lisp/service/home-service.lisp
@@ -9,10 +9,11 @@
:accessor content))
(:documentation ""))
-(defmethod initialize-instance :after ((home-service home-service) &key)
- t)
-
(defun home-json (&optional message errormsg)
(with-noauth (instance home-service)
- (when (not (org-ckons-core::null-or-empty-p message)) (setf (message instance) message))
- (when (not (org-ckons-core::null-or-empty-p errormsg)) (setf (errormsg instance) errormsg))))
+ (setf (message instance) message)
+ (setf (errormsg instance) errormsg)))
+
+
+(define-endpoint ("/home" :method :get) () home-json)
+(define-endpoint ("/home" :method :post) (&post (message :parameter-type 'string) (errormsg :parameter-type 'string)) home-json message errormsg)
diff --git a/lisp/service/login-service.lisp b/lisp/service/login-service.lisp
index 7a80bfd..408039c 100644
--- a/lisp/service/login-service.lisp
+++ b/lisp/service/login-service.lisp
@@ -12,53 +12,48 @@
:accessor title))
(:documentation ""))
-(defclass login-forgot-service (login-service)
- ()
+(defclass login-authenticate-service (rest-service)
+ ((location-p :initform nil))
(:documentation ""))
-(defmethod initialize-instance :after ((login-service login-service) &key)
- (setf (title login-service) "Login")
- (setf (form login-service) (make-form "login-form"
- nil
- t
- '((:name "username" :label "Username" :field-type "text" :required "required")
- (:name "pwd" :label "Password" :field-type "password" :required "required")
- (:label "Login" :field-type "button" :onclick "on_login_submit_clicked()")))))
-
-(defmethod initialize-instance :after ((login-forgot-service login-forgot-service) &key)
- (setf (title login-forgot-service) "Reset Password")
- (setf (form login-forgot-service) (make-form "login-forgot-form"
- nil
- t
- '((:name "username" :label "Username" :field-type "text" :required "required")
- (:label "Send password reset email" :field-type "button" :onclick "on_login_forgot_submit_clicked()")))))
-
(defun login-json ()
(with-noauth (instance login-service)
- t))
+ (setf (title instance) "Login")
+ (setf (form instance) (make-form "login-form"
+ nil
+ t
+ '((:name "username" :label "Username" :field-type "text" :required "required")
+ (:name "pwd" :label "Password" :field-type "password" :required "required")
+ (:label "Login" :field-type "button" :onclick "on_login_submit_clicked()"))))))
(defun login-forgot-json ()
- (with-noauth (instance login-forgot-service)
- t))
-
-(defclass login-authenticate-service (rest-service)
- ((location-p :initform nil))
- (:documentation ""))
+ (with-noauth (instance login-service)
+ (setf (title instance) "Reset Password")
+ (setf (form instance) (make-form "login-forgot-form"
+ nil
+ t
+ '((:name "username" :label "Username" :field-type "text" :required "required")
+ (:label "Send password reset email" :field-type "button" :onclick "on-login-forgot-submit-clicked"))))))
(defun login-authenticate-json (username pwd)
(with-noauth (instance login-authenticate-service)
(if (or (org-ckons-core::null-or-empty-p username)
(org-ckons-core::null-or-empty-p pwd))
- (setf (session-value :errormsg) "Login failed.")
+ (setf (errormsg instance) "Login failed.")
(with-bogenherr-database
(let* ((auth-pkg (make-instance 'auth-pkg))
(user (get-active-user-by-username-pwd auth-pkg username pwd)))
(cond (user
(set-user user)
- (setf (session-value :message) "Successfully logged in.")
- (setf (session-value :errormsg) nil))
+ (setf (message instance) "Successfully logged in.")
+ (setf (errormsg instance) nil))
(t
- (setf (session-value :message) nil)
- (setf (session-value :errormsg) "Login failed."))))))
- (setf (message instance) (session-value :message))
- (setf (errormsg instance) (session-value :errormsg))))
+ (setf (message instance) nil)
+ (setf (errormsg instance) "Login failed."))))))
+ (setf (message instance) (message instance))
+ (setf (errormsg instance) (errormsg instance))))
+
+(define-endpoint ("/login" :method :get) () login-json)
+(define-endpoint ("/login/authenticate" :method :post) (&post (username :parameter-type 'string) (pwd :parameter-type 'string)) login-authenticate-json username pwd)
+(define-endpoint ("/login/forgot" :method :get) () login-forgot-json)
+(define-endpoint ("/logout" :method :get) () logout-json)
diff --git a/lisp/service/logout-service.lisp b/lisp/service/logout-service.lisp
index d0564a5..169314e 100644
--- a/lisp/service/logout-service.lisp
+++ b/lisp/service/logout-service.lisp
@@ -10,5 +10,4 @@
(defun logout-json ()
(with-noauth (instance logout-service)
(set-user (make-default-user))
- (setf (location instance) "/home")
(setf (message instance) "You are now logged out.")))
diff --git a/lisp/service/menu-service.lisp b/lisp/service/menu-service.lisp
index 90b513a..44b9020 100644
--- a/lisp/service/menu-service.lisp
+++ b/lisp/service/menu-service.lisp
@@ -96,3 +96,6 @@
(format nil "~a ~a" (first_name user) (last_name user))
"No User Found"))
(org-ckons-json::objects-to-json `(,instance))))
+
+(define-endpoint ("/menu" :method :get) () menu-json)
+(define-endpoint ("/menu/user" :method :get) () menu-user-json)
diff --git a/lisp/service/messages-service.lisp b/lisp/service/messages-service.lisp
index e03c04c..9e2a419 100644
--- a/lisp/service/messages-service.lisp
+++ b/lisp/service/messages-service.lisp
@@ -12,25 +12,28 @@
:accessor form))
(:documentation ""))
+(defclass messages/view-service (messages-service)
+ ((results :initarg :results
+ :initform nil
+ :accessor results)
+ (location-p :initform nil))
+ (:documentation ""))
+
+(defclass messages/mark-service (messages-service)
+ ((location-p :initform nil))
+ (:documentation ""))
+
(defun messages-json ()
(with-auth (instance messages-service "messages-view")
(setf (title instance) "Messages Administration")
(setf (form instance) (make-form "messages-select-mode-form"
nil
nil
- `((:name "read" :field-type "hidden" :required "required" :value ,(session-value :messages-read))
- (:label "View Unread" :field-type "button" :onclick "on_messages_mode_clicked('unread')")
+ `((:label "View Unread" :field-type "button" :onclick "on_messages_mode_clicked('unread')")
(:label "View Read" :field-type "button" :onclick "on_messages_mode_clicked('read')"))))))
-(defclass messages/results-service (messages-service)
- ((results :initarg :results
- :initform nil
- :accessor results)
- (location-p :initform nil))
- (:documentation ""))
-
-(defun messages-results-json (read)
- (with-auth (instance messages/results-service "messages-view")
+(defun messages-view-json (read)
+ (with-auth (instance messages/view-service "messages-view")
(when read (setf (session-value :messages-read) read))
(with-bogenherr-database
(let ((contact-pkg (make-instance 'contact-pkg)))
@@ -41,17 +44,17 @@
(loop for result in (results instance)
do (sanitize-json result))))
-(defclass messages/mark-service (messages-service)
- ((location-p :initform nil))
- (:documentation ""))
-
(defun messages-mark-json (read id)
(with-auth (instance messages/mark-service "messages-view")
(with-bogenherr-database
(handler-case
(let ((contact-pkg (make-instance 'contact-pkg)))
(mark-contact-us-post contact-pkg id (id (get-user)) (string= read "read"))
- (setf (session-value :message) (format nil "Message marked ~a successfully." read)))
+ (setf (message instance) (format nil "Message marked ~a successfully." read)))
(error (e)
(declare (ignore e))
- (setf (session-value :errormsg) (format nil "Error marking message ~a." read)))))))
+ (setf (errormsg instance) (format nil "Error marking message ~a." read)))))))
+
+(define-endpoint ("/messages" :method :get) () messages-json)
+(define-endpoint ("/messages/view" :method :post) (&post (read :parameter-type 'string)) messages-view-json read)
+(define-endpoint ("/messages/mark" :method :post) (&post (read :parameter-type 'string) (id :parameter-type 'integer)) messages-mark-json read id)
diff --git a/lisp/service/password-service.lisp b/lisp/service/password-service.lisp
index 32507d2..ab35f09 100644
--- a/lisp/service/password-service.lisp
+++ b/lisp/service/password-service.lisp
@@ -12,6 +12,13 @@
:accessor title))
(:documentation ""))
+(defclass password/modify-service (password-service)
+ ((form :initarg :form
+ :initform nil
+ :accessor form)
+ (location-p :initform nil))
+ (:documentation ""))
+
(defun password-json ()
(with-auth (instance password-service "profile-modify")
(let ((user (get-user)))
@@ -24,13 +31,6 @@
(:name "pwd2" :label "Password (again)" :field-type "password" :required "required")
(:label "Change Password" :field-type "button" :onclick "on_password_submit_clicked()")))))))
-(defclass password/modify-service (password-service)
- ((form :initarg :form
- :initform nil
- :accessor form)
- (location-p :initform nil))
- (:documentation ""))
-
(defun password-submit-json (id pwd pwd2)
(declare (special pwd pwd2))
(with-auth (instance password/modify-service "profile-modify")
@@ -46,5 +46,8 @@
do (setf (slot-value user param) (symbol-value param)))
(update-password auth-pkg user)
(set-user user)
- (setf (session-value :message) "Password saved successfully."))
- (setf (session-value :errormsg) "An error occured."))))))
+ (setf (message instance) "Password saved successfully."))
+ (setf (errormsg instance) "An error occured."))))))
+
+(define-endpoint ("/password" :method :get) () password-json)
+(define-endpoint ("/password/submit" :method :post) (&post (id :parameter-type 'integer) (pwd :parameter-type 'string) (pwd2 :parameter-type 'string)) password-submit-json id pwd pwd2)
diff --git a/lisp/service/profile-service.lisp b/lisp/service/profile-service.lisp
index 256d599..e8b68de 100644
--- a/lisp/service/profile-service.lisp
+++ b/lisp/service/profile-service.lisp
@@ -3,22 +3,18 @@
(in-package :bogenherr)
-(defclass profile-service (auth-service user)
+(defclass profile-service (auth-service)
((title :initarg :title
:initform nil
:accessor title))
(:documentation ""))
-(defun profile-json ()
- (with-auth (instance profile-service "profile-modify")
- (setf (title instance) "Profile")
- (sanitize-rest-json instance)))
-
-(defun profile-view-json ()
- (with-auth (instance profile-service "profile-modify")
- (let ((user (get-user)))
- (copy-from-record instance user))
- (sanitize-rest-json instance)))
+(defclass profile/view-service (profile-service)
+ ((items :initarg items
+ :initform nil
+ :accessor items)
+ (location-p :initform nil))
+ (:documentation ""))
(defclass profile/modify-service (profile-service)
((form :initarg :form
@@ -27,10 +23,22 @@
(location-p :initform nil))
(:documentation ""))
+(defun profile-json ()
+ (with-auth (instance profile-service "profile-modify")
+ (setf (title instance) "Profile")))
+
+(defun profile-view-json ()
+ (with-auth (instance profile/view-service "profile-modify")
+ (let ((user (get-user)))
+ (setf (items instance) `(,user)))
+ (sanitize-rest-json instance)
+ (loop for item in (items instance)
+ do (sanitize-json item))))
+
(defun profile-modify-json ()
(with-auth (instance profile/modify-service "profile-modify")
(let ((user (get-user)))
- (sanitize-rest-json instance)
+ (sanitize-json user)
(setf (title instance) "Profile - Modify")
(setf (form instance) (make-form "profile-modify-form"
nil
@@ -54,8 +62,12 @@
(intersection `(,x) '(id)))
(sb-introspect:function-lambda-list #'profile-modify-submit-json))
do (setf (slot-value user param) (symbol-value param)))
- (copy-from-record instance user)
(update-user auth-pkg user)
(set-user user)
- (setf (session-value :message) "Profile saved successfully."))
- (setf (session-value :errormsg) "An error occured."))))))
+ (setf (message instance) "Profile saved successfully."))
+ (setf (errormsg instance) "An error occured."))))))
+
+(define-endpoint ("/profile" :method :get) () profile-json)
+(define-endpoint ("/profile/view" :method :get) () profile-view-json)
+(define-endpoint ("/profile/modify" :method :post) () profile-modify-json)
+(define-endpoint ("/profile/modify/submit" :method :post) (&post (id :parameter-type 'integer) (username :parameter-type 'string) (first_name :parameter-type 'string) (last_name :parameter-type 'string) (email :parameter-type 'string) (phone :parameter-type 'string)) profile-modify-submit-json id username first_name last_name email phone)
diff --git a/lisp/service/rest-service.lisp b/lisp/service/rest-service.lisp
index b01f7fa..9f9f3d7 100644
--- a/lisp/service/rest-service.lisp
+++ b/lisp/service/rest-service.lisp
@@ -20,12 +20,6 @@
(defmethod initialize-instance :after ((rest-service rest-service) &key)
(when (location-p rest-service)
- (if (message rest-service)
- (setf (session-value :message) (message rest-service))
- (setf (message rest-service) (session-value :message)))
- (if (errormsg rest-service)
- (setf (session-value :errormsg) (errormsg rest-service))
- (setf (errormsg rest-service) (session-value :errormsg)))
(when (null (location rest-service))
(setf (location rest-service) (type-to-path rest-service)))))
@@ -39,3 +33,5 @@
(loop for slot in (intersection '(org-ckons-session::*session-key *table *where-expression pwd)
(org-ckons-core::map-slot-names rest-service))
do (setf (slot-value rest-service slot) nil)))
+
+(define-endpoint ("/location" :method :post) (&post (location :parameter-type 'string)) location-json location)
diff --git a/lisp/service/users-service.lisp b/lisp/service/users-service.lisp
index 5b16d46..145ccdd 100644
--- a/lisp/service/users-service.lisp
+++ b/lisp/service/users-service.lisp
@@ -9,10 +9,6 @@
:accessor title))
(:documentation ""))
-(defun users-json ()
- (with-auth (instance users-service "users-view")
- (setf (title instance) "Users")))
-
(defclass users/view-service (users-service user)
((users :initarg :users
:initform nil
@@ -20,6 +16,36 @@
(location-p :initform nil))
(:documentation ""))
+(defclass users/modify-service (users/view-service)
+ ((form :initarg :form
+ :initform nil
+ :accessor form))
+ (:documentation ""))
+
+(defclass users/register-service (rest-service)
+ ((title :initarg :title
+ :initform nil
+ :accessor title)
+ (hash :initarg :hash
+ :initform nil
+ :accessor hash))
+ (:documentation ""))
+
+(defclass users/register/form-service (rest-service)
+ ((form :initarg :form
+ :initform nil
+ :accessor form)
+ (location-p :initform nil))
+ (:documentation ""))
+
+(defclass users/register/submit-service (rest-service)
+ ((location-p :initform nil))
+ (:documentation ""))
+
+(defun users-json ()
+ (with-auth (instance users-service "users-view")
+ (setf (title instance) "Users")))
+
(defun users-view-json ()
(with-auth (instance users/view-service "users-view")
(with-bogenherr-database
@@ -29,13 +55,7 @@
(loop for user in (users instance)
do (sanitize-json user))))
-(defclass users/add-service (users/view-service)
- ((form :initarg :form
- :initform nil
- :accessor form))
- (:documentation ""))
-
-(defun role-checkboxes (role-groups &optional active-role-groups)
+(defun role-checkboxes (name role-groups &optional active-role-groups)
(remove-if 'null
(mapcar (lambda (role-group)
(when (not (intersection `(,(name role-group)) `("_Public" "profile-admin") :test 'string=))
@@ -45,11 +65,11 @@
active-role-groups)
:test 'string=)
'(:checked "checked" :value "on"))))
- (remove-if 'null `(:name ,(format nil "chk_~a" (name role-group)) :label ,(name role-group) :field-type "checkbox" ,@checked)))))
+ (remove-if 'null `(:name ,(format nil "chk_~a_~a" name (name role-group)) :label ,(name role-group) :field-type "checkbox" ,@checked)))))
role-groups)))
(defun users-add-json ()
- (with-auth (instance users/add-service "users-modify")
+ (with-auth (instance users/modify-service "users-modify")
(setf (title instance) "Users - Add")
(with-bogenherr-database
(let* ((auth-pkg (make-instance 'auth-pkg))
@@ -61,12 +81,12 @@
`((:name "first_name" :label "First Name" :field-type "text" :required "required")
(:name "last_name" :label "Last Name" :field-type "text" :required "required")
(:name "email" :label "Email" :field-type "text" :required "required")
- ,@(role-checkboxes role-groups)
+ ,@(role-checkboxes "users_add" role-groups)
(:label "Add User" :field-type "button" :onclick "on_users_add_submit_clicked()"))))))))
(defun users-add-submit-json (role_groups first_name last_name email)
(declare (special role_groups first_name last_name email))
- (with-auth (instance users/add-service "users-modify")
+ (with-auth (instance users/modify-service "users-modify")
(with-bogenherr-database
(let ((registration (make-instance 'registration)))
(loop for param in (sb-introspect:function-lambda-list #'users-add-submit-json)
@@ -95,12 +115,12 @@
((p) "Please click the following link to complete the registration:")
((p)
((a :href ,(format nil
- "~a://~a/register?hash=~a"
+ "~a://~a/register/~a"
(scheme *webapp*)
(url *webapp*)
(hash registration)))
,(format nil
- "~a://~a/register?hash=~a"
+ "~a://~a/register/~a"
(scheme *webapp*)
(url *webapp*)
(hash registration))))))))
@@ -113,31 +133,15 @@
:reply-to (mail-postmaster *webapp*)
:ssl (mail-ssl *webapp*)
:authentication (mail-authentication *webapp*))
- (setf (session-value :message) (format nil "Email sent successfully to ~a" (email registration))))
+ (setf (message instance) (format nil "Email sent successfully to ~a" (email registration))))
(error (e)
- (setf (session-value :errormsg) (format nil "Error sending email to ~a. Registration failed. ~a" (email registration) e))))))))
-
-(defclass users/register-service (rest-service)
- ((title :initarg :title
- :initform nil
- :accessor title)
- (hash :initarg :hash
- :initform nil
- :accessor hash))
- (:documentation ""))
+ (setf (errormsg instance) (format nil "Error sending email to ~a. Registration failed. ~a" (email registration) e))))))))
(defun users-register-json (hash)
(with-noauth (instance users/register-service)
(setf (title instance) "New User Registration")
(setf (hash instance) hash)))
-(defclass users/register/form-service (rest-service)
- ((form :initarg :form
- :initform nil
- :accessor form)
- (location-p :initform nil))
- (:documentation ""))
-
(defun users-register-form-json (hash)
(with-noauth (instance users/register/form-service)
(with-bogenherr-database
@@ -145,23 +149,17 @@
(registration (get-registration-by-hash auth-pkg hash)))
(registrations-gc auth-pkg)
(if registration
- (progn
- (setf (form instance)
- (make-form "users-register-form"
- nil
- t
- `((:name "hash" :field-type "hidden" :value ,(hash registration) :required "required")
- (:name "username" :label "Username" :field-type "text" :required "required")
- (:name "pwd" :label "Password" :field-type "password" :required "required")
- (:name "pwd2" :label "Password (again)" :field-type "password" :required "required")
- (:name "phone" :label "Phone" :field-type "text")
- (:label "Register" :field-type "button" :onclick "on_users_register_submit_clicked()"))))
- (setf (session-value :message) "Registered successfully."))
- (setf (session-value :errormsg) "Error: invalid registration."))))))
-
-(defclass users/register/submit-service (rest-service)
- ((location-p :initform nil))
- (:documentation ""))
+ (setf (form instance)
+ (make-form "users-register-form"
+ nil
+ t
+ `((:name "hash" :field-type "hidden" :value ,(hash registration) :required "required")
+ (:name "username" :label "Username" :field-type "text" :required "required")
+ (:name "pwd" :label "Password" :field-type "password" :required "required")
+ (:name "pwd2" :label "Password (again)" :field-type "password" :required "required")
+ (:name "phone" :label "Phone" :field-type "text")
+ (:label "Register" :field-type "button" :onclick "on_users_register_submit_clicked()"))))
+ (setf (errormsg instance) "Error: invalid registration."))))))
(defun users-register-submit-json (hash username pwd pwd2 phone)
(with-noauth (instance users/register/submit-service)
@@ -170,34 +168,29 @@
registration)
(registrations-gc auth-pkg)
(setf registration (get-registration-by-hash auth-pkg hash))
- (org-ckons-json::objects-to-json
- `(,(if registration
- (if (string= pwd pwd2)
- (let ((user (make-instance 'user
- :username username
- :pwd pwd
- :first_name (first_name registration)
- :last_name (last_name registration)
- :email (email registration)
- :phone phone
- :active t)))
- (if (insert-user auth-pkg user)
- (progn
- (loop for role-group in (union '("profile-admin")
- (cl-ppcre:split "\\|" (role_groups registration))
- :test 'string=)
- do (insert-user-role-group auth-pkg (make-instance 'user-role
- :user_id (id user)
- :role_group_name role-group)))
- (delete-registration auth-pkg hash)
- (setf (session-value :message) "Registration completed successfully."))
- (setf (session-value :errormsg) "Error while completing registration.")))
- (setf (session-value :errormsg) "Error: passwords do not match."))
- (setf (session-value :errormsg) "Error while completing registration."))))))))
-
-(defclass users/modify-service (users/add-service)
- ()
- (:documentation ""))
+ (if registration
+ (if (string= pwd pwd2)
+ (let ((user (make-instance 'user
+ :username username
+ :pwd pwd
+ :first_name (first_name registration)
+ :last_name (last_name registration)
+ :email (email registration)
+ :phone phone
+ :active t)))
+ (if (insert-user auth-pkg user)
+ (progn
+ (loop for role-group in (union '("profile-admin")
+ (cl-ppcre:split "\\|" (role_groups registration))
+ :test 'string=)
+ do (insert-user-role-group auth-pkg (make-instance 'user-role
+ :user_id (id user)
+ :role_group_name role-group)))
+ (delete-registration auth-pkg hash)
+ (setf (message instance) "Registration completed successfully."))
+ (setf (errormsg instance) "Error while completing registration.")))
+ (setf (errormsg instance) "Error: passwords do not match."))
+ (setf (errormsg instance) "Error while completing registration."))))))
(defun users-modify-json (id)
(with-auth (instance users/modify-service "users-modify")
@@ -218,9 +211,9 @@
(:name "last_name" :label "Last Name" :field-type "text" :value ,(last_name user) :required "required")
(:name "email" :label "Email" :field-type "text" :value ,(email user) :required "required")
(:name "phone" :label "Phone" :field-type "text" :value ,(phone user))
- ,@(role-checkboxes role-groups active-role-groups)
+ ,@(role-checkboxes "users_modify" role-groups active-role-groups)
(:label "Modify User" :field-type "button" :onclick "on_users_modify_submit_clicked()"))))
- (setf (session-value :errormsg) "Error: could not modify user. Not found."))))))
+ (setf (errormsg instance) "Error: could not modify user. Not found."))))))
(defun users-modify-submit-json (id role_groups username first_name last_name email phone)
(declare (special role_groups username first_name last_name email phone))
@@ -240,43 +233,48 @@
(cl-ppcre:split "\\|" role_groups)
:test 'string=)
do (insert-user-role-group auth-pkg (make-instance 'user-role
- :user_id (id user)
+ :user_id id
:role_group_name role-group)))
- (setf (session-value :message) "User saved successfully."))
- (setf (session-value :errormsg) "An error occured."))))))
-
-(defclass users/toggle-service (users/add-service)
- ()
- (:documentation ""))
+ (setf (message instance) "User saved successfully."))
+ (setf (errormsg instance) "An error occured."))))))
(defun users-toggle-active-json (id)
- (with-auth (instance users/toggle-service "users-modify")
+ (with-auth (instance users/modify-service "users-modify")
(with-bogenherr-database
(let* ((auth-pkg (make-instance 'auth-pkg))
(user (get-user-by-id auth-pkg id)))
(if user
(if (= (id user) (id (get-user)))
- (setf (session-value :errormsg) "Error: you may not toggle your own active state.")
+ (setf (errormsg instance) "Error: you may not toggle your own active state.")
(progn
(user-toggle-active auth-pkg user)
- (setf (session-value :errormsg) nil)
- (setf (session-value :message) "User active state toggled successfully.")))
- (setf (session-value :errormsg) "Error: could not toggle the active state of the user: not found."))))))
-
-(defclass users/delete-service (users/add-service)
- ()
- (:documentation ""))
+ (setf (errormsg instance) nil)
+ (setf (message instance) "User active state toggled successfully.")))
+ (setf (errormsg instance) "Error: could not toggle the active state of the user: not found."))))))
(defun users-delete-json (id)
- (with-auth (instance users/delete-service "users-modify")
+ (with-auth (instance users/modify-service "users-modify")
(with-bogenherr-database
(let* ((auth-pkg (make-instance 'auth-pkg))
(user (get-user-by-id auth-pkg id)))
(if user
(if (= (id user) (id (get-user)))
- (setf (session-value :errormsg) "Error: you may not delete yourself.")
+ (setf (errormsg instance) "Error: you may not delete yourself.")
(progn
(deactivate-user auth-pkg user)
- (setf (session-value :errormsg) nil)
- (setf (session-value :message) "User deleted successfully.")))
- (setf (session-value :errormsg) "Error: could not delete user: not found."))))))
+ (setf (errormsg instance) nil)
+ (setf (message instance) "User deleted successfully.")))
+ (setf (errormsg instance) "Error: could not delete user: not found."))))))
+
+(define-endpoint ("/users" :method :get) () users-json)
+(define-endpoint ("/users/view" :method :get) () users-view-json)
+(define-endpoint ("/users/add" :method :post) () users-add-json)
+(define-endpoint ("/users/add/submit" :method :post) (&post (role_groups :parameter-type 'string) (first_name :parameter-type 'string) (last_name :parameter-type 'string) (email :parameter-type 'string)) users-add-submit-json role_groups first_name last_name email)
+(define-endpoint ("/register" :method :get) (&get (hash :parameter-type 'string)) base (format nil "/register/~a" hash))
+(define-endpoint ("/users/register" :method :post) (&post (hash :parameter-type 'string)) users-register-json hash)
+(define-endpoint ("/users/register/form" :method :post) (&post (hash :parameter-type 'string)) users-register-form-json hash)
+(define-endpoint ("/users/register/submit" :method :post) (&post (hash :parameter-type 'string) (username :parameter-type 'string) (pwd :parameter-type 'string) (pwd2 :parameter-type 'string) (phone :parameter-type 'string)) users-register-submit-json hash username pwd pwd2 phone)
+(define-endpoint ("/users/modify" :method :post) (&post (id :parameter-type 'integer)) users-modify-json id)
+(define-endpoint ("/users/modify/submit" :method :post) (&post (id :parameter-type 'integer) (role_groups :parameter-type 'string) (username :parameter-type 'string) (first_name :parameter-type 'string) (last_name :parameter-type 'string) (email :parameter-type 'string) (phone :parameter-type 'string)) users-modify-submit-json id role_groups username first_name last_name email phone)
+(define-endpoint ("/users/toggle-active" :method :post) (&post (id :parameter-type 'integer)) users-toggle-active-json id)
+(define-endpoint ("/users/delete/:id" :method :delete) (&path (id 'integer)) users-delete-json id)
generated by cgit v1.3 (git 2.53.0) at 2026-09-24 14:21:14 +0000