diff --git a/src/main.lisp b/src/main.lisp index 60f8e24..fa11f68 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -6,11 +6,12 @@ (require "com.inuoe.jzon") (require "serapeum") (require "bordeaux-threads") +(require "spinneret") -(defpackage tfc-server - (:use :cl :uiop :com.inuoe.jzon :clack)) +(defpackage tfcserver + (:use :cl :uiop :com.inuoe.jzon :clack :serapeum :spinneret)) -(in-package :tfc-server) +(in-package :tfcserver) (defvar *last*) (defvar *last-data*) @@ -26,29 +27,51 @@ (make-instance 'hunchentoot:easy-acceptor :port port)))) -(defun setup-for-nextcloud-tables (data-list) - "moving the list into a form that makes sense for -Nextcloud tables" - (setf (car (assoc "Student Name" data-list :test 'string=) - "value"))) +;; (defun setup-for-nextcloud-tables (data-list) +;; "moving the list into a form that makes sense for +;; Nextcloud tables" +;; (setf idk (car (assoc "Student Name" data-list :test 'string=) +;; "value"))) + +(defparameter *mail-css* + '((table :border-collapse "collapse" :width "100%") + (("th," td) :padding "8px") + (td :text-align "left" :width "70%") + (th :text-align "right" :border-right "1px solid #ddd") + (tr :border-bottom "1px solid #ddd") + (h1 :text-align "center"))) (defun post-health-form (data-list) "Takes the health form as an alist and posts it to nocodb" - (let* ((student-name (concatenate 'string - (serapeum:trim-whitespace (cdr (assoc "firstname" data-list - :test 'string=))) - " " - (serapeum:trim-whitespace (cdr (assoc "lastname" data-list - :test 'string=))))) - (parent-name (concatenate 'string - (serapeum:trim-whitespace (cdr (assoc "parentfirstname" data-list - :test 'string=))) - " " - (serapeum:trim-whitespace (cdr (assoc "parentlastname" data-list - :test 'string=))))) + (let* ((student-name + (concatenate 'string + (serapeum:trim-whitespace + (cdr (assoc "firstname" data-list + :test 'string=))) + " " + (serapeum:trim-whitespace + (cdr (assoc "lastname" data-list + :test 'string=))))) + (parent-name + (concatenate 'string + (serapeum:trim-whitespace + (cdr (assoc "parentfirstname" data-list + :test 'string=))) + " " + (serapeum:trim-whitespace + (cdr (assoc "parentlastname" data-list + :test 'string=))))) (image (assoc "image" data-list)) (headers (list (cons "Authorization" *auth-token*) - (cons "Content-Type" "application/json")))) + (cons "Content-Type" "application/json"))) + (rows (parse (dex:get + "https://staff.tfcconnection.org/apps/tables/api/1/tables/4/rows" + :basic-auth '("chris" . "2VHeGxeC^Zf9KqFK^G@Pt!zu2q^6@b") + :verbose t))) + (lowid 0) + (highest-id (loop for i in + (loop for row across rows collect (gethash "id" row)) + maximizing i))) (setq data-list (remove (assoc "lastname" *last-list-data* :test 'string=) @@ -92,46 +115,148 @@ Nextcloud tables" :do (format t "~&~A" entry)) (format t "~&~A" "Let's print out the data") (format t "~&~A" data-list) - (setq *last-list-data* data-list) (println *last-list-data*) - (setf data `#(("columnId" 37 "value" ,(serapeum:trim-whitespace (cdr (assoc "Student Name" *last-list-data* :test 'string=)))) - ("columnId" 38 "value" ,(serapeum:trim-whitespace (cdr (assoc "Parent Name" *last-list-data* :test 'string=)))) - ("columnId" 39 "value" ,(serapeum:trim-whitespace (cdr (assoc "birthdate" *last-list-data* :test 'string=)))) - ("columnId" 40 "value" ,(serapeum:trim-whitespace (cdr (assoc "street" *last-list-data* :test 'string=)))) - ("columnId" 41 "value" ,(serapeum:trim-whitespace (cdr (assoc "city" *last-list-data* :test 'string=)))) - ("columnId" 42 "value" ,(serapeum:trim-whitespace (cdr (assoc "state" *last-list-data* :test 'string=)))) - ("columnId" 43 "value" ,(serapeum:trim-whitespace (cdr (assoc "zip" *last-list-data* :test 'string=)))) - ("columnId" 44 "value" ,(serapeum:trim-whitespace (cdr (assoc "cellphone" *last-list-data* :test 'string=)))) - ("columnId" 45 "value" ,(serapeum:trim-whitespace (cdr (assoc "homephone" *last-list-data* :test 'string=)))) - ("columnId" 46 "value" ,(serapeum:trim-whitespace (cdr (assoc "emergency-contact" *last-list-data* :test 'string=)))) - ("columnId" 47 "value" ,(serapeum:trim-whitespace (cdr (assoc "doctor" *last-list-data* :test 'string=)))) - ("columnId" 48 "value" ,(serapeum:trim-whitespace (cdr (assoc "doctor-city" *last-list-data* :test 'string=)))) - ("columnId" 49 "value" ,(serapeum:trim-whitespace (cdr (assoc "doctor-phone" *last-list-data* :test 'string=)))) - ("columnId" 50 "value" ,(serapeum:trim-whitespace (cdr (assoc "medical-coverage" *last-list-data* :test 'string=)))) - ("columnId" 51 "value" ,(serapeum:trim-whitespace (cdr (assoc "insurance-name" *last-list-data* :test 'string=)))) - ("columnId" 52 "value" ,(serapeum:trim-whitespace (cdr (assoc "policy-number" *last-list-data* :test 'string=)))) - ("columnId" 53 "value" ,(serapeum:trim-whitespace (cdr (assoc "insurance-card" *last-list-data* :test 'string=)))) - ("columnId" 54 "value" ,(serapeum:trim-whitespace (cdr (assoc "agreement" *last-list-data* :test 'string=)))) - ("columnId" 55 "value" ,(serapeum:trim-whitespace (cdr (assoc "allergies" *last-list-data* :test 'string=)))) - ("columnId" 56 "value" ,(serapeum:trim-whitespace (cdr (assoc "specific-allergies" *last-list-data* :test 'string=)))) - ("columnId" 57 "value" ,(serapeum:trim-whitespace (cdr (assoc "allergy-treatment" *last-list-data* :test 'string=)))) - ("columnId" 58 "value" ,(serapeum:trim-whitespace (cdr (assoc "conditions" *last-list-data* :test 'string=)))) - ("columnId" 59 "value" ,(serapeum:trim-whitespace (cdr (assoc "tetanus-shot-date" *last-list-data* :test 'string=)))) - ("columnId" 60 "value" ,(serapeum:trim-whitespace (cdr (assoc "medication-schedule" *last-list-data* :test 'string=)))) - ("columnId" 61 "value" ,(serapeum:trim-whitespace (cdr (assoc "other-notes" *last-list-data* :test 'string=)))) - ("columnId" 62 "value" ,(serapeum:trim-whitespace (cdr (assoc "swimming-ability" *last-list-data* :test 'string=)))) - )) + (setf data `#(("columnId" 37 "value" ,(serapeum:trim-whitespace + (cdr (assoc + "Student Name" + *last-list-data* + :test 'string=)))) + ("columnId" 38 "value" ,(serapeum:trim-whitespace + (cdr (assoc + "Parent Name" + *last-list-data* + :test 'string=)))) + ("columnId" 39 "value" ,(serapeum:trim-whitespace + (cdr (assoc + "birthdate" + *last-list-data* + :test 'string=)))) + ("columnId" 40 "value" ,(serapeum:trim-whitespace + (cdr (assoc + "street" + *last-list-data* + :test 'string=)))) + ("columnId" 41 "value" ,(serapeum:trim-whitespace + (cdr (assoc + "city" + *last-list-data* + :test 'string=)))) + ("columnId" 42 "value" ,(serapeum:trim-whitespace + (cdr (assoc + "state" + *last-list-data* + :test 'string=)))) + ("columnId" 43 "value" ,(serapeum:trim-whitespace + (cdr (assoc + "zip" + *last-list-data* + :test 'string=)))) + ("columnId" 44 "value" ,(serapeum:trim-whitespace + (cdr (assoc + "cellphone" + *last-list-data* + :test 'string=)))) + ("columnId" 45 "value" ,(serapeum:trim-whitespace + (cdr (assoc + "homephone" + *last-list-data* + :test 'string=)))) + ("columnId" 46 "value" ,(serapeum:trim-whitespace + (cdr (assoc + "emergency-contact" + *last-list-data* + :test 'string=)))) + ("columnId" 47 "value" ,(serapeum:trim-whitespace + (cdr (assoc + "doctor" + *last-list-data* + :test 'string=)))) + ("columnId" 48 "value" ,(serapeum:trim-whitespace + (cdr (assoc + "doctor-city" + *last-list-data* + :test 'string=)))) + ("columnId" 49 "value" ,(serapeum:trim-whitespace + (cdr (assoc + "doctor-phone" + *last-list-data* + :test 'string=)))) + ("columnId" 50 "value" ,(serapeum:trim-whitespace + (cdr (assoc + "medical-coverage" + *last-list-data* + :test 'string=)))) + ("columnId" 51 "value" ,(serapeum:trim-whitespace + (cdr (assoc + "insurance-name" + *last-list-data* + :test 'string=)))) + ("columnId" 52 "value" ,(serapeum:trim-whitespace + (cdr (assoc + "policy-number" + *last-list-data* + :test 'string=)))) + ("columnId" 53 "value" ,(serapeum:trim-whitespace + (cdr (assoc + "insurance-card" + *last-list-data* + :test 'string=)))) + ("columnId" 54 "value" ,(serapeum:trim-whitespace + (cdr (assoc + "agreement" + *last-list-data* + :test 'string=)))) + ("columnId" 55 "value" ,(serapeum:trim-whitespace + (cdr (assoc + "allergies" + *last-list-data* + :test 'string=)))) + ("columnId" 56 "value" ,(serapeum:trim-whitespace + (cdr (assoc + "specific-allergies" + *last-list-data* + :test 'string=)))) + ("columnId" 57 "value" ,(serapeum:trim-whitespace + (cdr (assoc + "allergy-treatment" + *last-list-data* + :test 'string=)))) + ("columnId" 58 "value" ,(serapeum:trim-whitespace + (cdr (assoc + "conditions" + *last-list-data* + :test 'string=)))) + ("columnId" 59 "value" ,(serapeum:trim-whitespace + (cdr (assoc + "tetanus-shot-date" + *last-list-data* + :test 'string=)))) + ("columnId" 60 "value" ,(serapeum:trim-whitespace + (cdr (assoc + "medication-schedule" + *last-list-data* :test 'string=)))) + ("columnId" 61 "value" ,(serapeum:trim-whitespace + (cdr (assoc + "other-notes" + *last-list-data* + :test 'string=)))) + ("columnId" 62 "value" ,(serapeum:trim-whitespace + (cdr (assoc + "swimming-ability" + *last-list-data* + :test 'string=)))))) - ;; (loop for i in *last-list-data* - ;; do (let ((key (car i)) - ;; (value (serapeum:trim-whitespace (cdr i)))) - ;; (format t "~&~a: ~a" key value) - ;; (cond ((string= key "Student Name") (terpri) (println "woo"))))) + (setq special-data `#(("columnId" 37 "value" ,(serapeum:trim-whitespace + (cdr (assoc + "Student Name" + *last-list-data* + :test 'string=)))))) (dex:post "https://staff.tfcconnection.org/apps/tables/api/1/tables/4/rows" :basic-auth '("chris" . "2VHeGxeC^Zf9KqFK^G@Pt!zu2q^6@b") - :content (stringify `(("tableid" . 4) ("data" . ,data))) + :content (stringify `(("tableId" . 4) + ("data" . ,special-data))) :verbose t) )) @@ -159,6 +284,130 @@ Nextcloud tables" :if-does-not-exist :create :external-format :latin-1)) +(defun mail-form (form attachment) + "Takes the form as an alist and sends a table formatted email +with the image attached" + (let ((first-name (serapeum:trim-whitespace + (cdr (assoc "firstname" form + :test 'string=)))) + (last-name (serapeum:trim-whitespace + (cdr (assoc "lastname" form + :test 'string=)))) + (parent-name (concatenate 'string + (serapeum:trim-whitespace + (cdr (assoc "parentfirstname" form + :test 'string=))) + " " + (serapeum:trim-whitespace + (cdr (assoc "parentlastname" form + :test 'string=))))) + (birthdate (trim-whitespace + (cdr (assoc "birthdate" form + :test 'string=)))) + (city (trim-whitespace + (cdr (assoc "city" form + :test 'string=)))) + (street (trim-whitespace + (cdr (assoc "street" form + :test 'string=)))) + (state (trim-whitespace + (cdr (assoc "state" form + :test 'string=)))) + (zip (trim-whitespace + (cdr (assoc "zip" form + :test 'string=)))) + (cellphone (trim-whitespace + (cdr (assoc "cellphone" form + :test 'string=)))) + (homephone (trim-whitespace + (cdr (assoc "homephone" form + :test 'string=)))) + (emergency-contact (trim-whitespace + (cdr (assoc "emergency-contact" form + :test 'string=)))) + (additional-contact (trim-whitespace + (cdr (assoc "add-emergency-contact-phone" form + :test 'string=)))) + (doctor (trim-whitespace + (cdr (assoc "doctor" form + :test 'string=)))) + (doctor-city (trim-whitespace + (cdr (assoc "doctor-city" form + :test 'string=)))) + (doctor-phone (trim-whitespace + (cdr (assoc "doctor-phone" form + :test 'string=)))) + (medical-coverage (trim-whitespace + (cdr (assoc "medical-coverage" form + :test 'string=)))) + (insurance (trim-whitespace + (cdr (assoc "insurance-name" form + :test 'string=)))) + (policy-number (trim-whitespace + (cdr (assoc "policy-number" form + :test 'string=)))) + (image (trim-whitespace + (cdr (assoc "image" form + :test 'string=)))) + (agreement (trim-whitespace + (cdr (assoc "agreement" form + :test 'string=)))) + (allergies (trim-whitespace + (cdr (assoc "allergies" form + :test 'string=)))) + (allergies-other (trim-whitespace + (cdr (assoc "allergies-other" form + :test 'string=)))) + (specific-allergies (trim-whitespace + (cdr (assoc "specific-allergies" form + :test 'string=)))) + (allergy-treatments (trim-whitespace + (cdr (assoc "allergy-treatments" form + :test 'string=)))) + (conditions (trim-whitespace + (cdr (assoc "conditions" form + :test 'string=)))) + (tetanus (trim-whitespace + (cdr (assoc "tetanus-shot-date" form + :test 'string=)))) + (swimming (trim-whitespace + (cdr (assoc "swimming-ability" form + :test 'string=)))) + (medication (trim-whitespace + (cdr (assoc "medication-schedule" form + :test 'string=)))) + (other (trim-whitespace + (cdr (assoc "other-notes" form + :test 'string=)))) + (age (trim-whitespace + (cdr (assoc "age" form + :test 'string=))))) + (not (cl-smtp:send-email + "mail.tfcconnection.org" + "no-reply@mail.tfcconnection.org" + '("chris@tfcconnection.org" "ethan@tfcconnection.org") + (format nil "~a ~a filled out a Health Form!" first-name last-name) + (format nil "Health Form for ~a ~a" first-name last-name) + :display-name "TFC ADMIN" + :ssl :tls + :authentication '(:login "no-reply@mail.tfcconnection.org" "r9f36mNZFtiW4f") + :attachments attachment + :html-message + (with-html-string + (:doctype) + (:html + (:head (:title "TFC Health Form") + (:style (apply #'lass:compile-and-write *mail-css*))) + (:body + (:h1 (format nil "Health Form for ~a ~a" first-name last-name)) + (:hr) + (:table + (loop for row in form + do (:tr + (:th (car row)) + (:td (trim-whitespace + (cdr row))))))))))))) + (hunchentoot:define-easy-handler (respond :uri "/health-form") () (setf (hunchentoot:content-type*) "plain/text") (let ((request-type (hunchentoot:request-method hunchentoot:*request*))) @@ -174,7 +423,8 @@ Nextcloud tables" (when position (subseq content-type (1+ position))))) (string-data (flexi-streams:octets-to-string data)) - (parts (ppcre:split boundary string-data))) + (parts (ppcre:split boundary string-data)) + (attachment nil)) (setq *last-data* parts) (setq *last-list-data* nil) @@ -249,12 +499,14 @@ Nextcloud tables" (acons name image-file-name form-list)) (save-string-file (apply #'concatenate 'string content) - image-file-name))) - + image-file-name) + (setf attachment image-file-name))) + (setq *last-list-data* (append *last-list-data* form-list)))) - (post-health-form *last-list-data*) - (format nil "thankyou")))))) + ;; (post-health-form *last-list-data*) + (if (mail-form *last-list-data* attachment) + (format nil "thankyou"))))))) (defun main () (start-server 4242)