migrate to reactHEADmaster

1 files changed, 101 insertions, 103 deletions

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)