TFC/tfcconnection-zola
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

add test and move camp-form api to a function for the test

Browse source
This commit is contained in:
Chris Cochrun 2024-05-02 11:50:59 -05:00
parent f83054b752
commit 46b4c6cf6d
1 changed files with 43 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

63
src/main.lisp
View file

@ -360,7 +360,7 @@ with the image attached"
(not (cl-smtp:send-email
"mail.tfcconnection.org"
"no-reply@mail.tfcconnection.org"
'("chris@tfcconnection.org" "ethan@tfcconnection.org")
'("chris@tfcconnection.org" "chris@cochrun.xyz")
(format nil "~a ~a filled out a Camp Form!" first-name last-name)
(format nil "Camp Form for ~a ~a" first-name last-name)
:display-name "TFC ADMIN"
@ -485,25 +485,34 @@ with the image attached"
(hunchentoot:define-easy-handler (camp-form :uri "/camp-form") ()
(let* ((request-type (hunchentoot:request-method hunchentoot:*request*))
(data (hunchentoot:post-parameters* hunchentoot:*request*))
(registration (cdr (assoc "registration" data :test 'string=)))
(health (cdr (assoc "health-form" data :test 'string=))))
(log:info data)
;; This is extremely necessary so that cors is right
(setf (tbnl:header-out :access-control-expose-headers) "*")
(data (hunchentoot:post-parameters* hunchentoot:*request*)))
(camp-form data)))
(defun camp-form (data)
"Process the camp form"
(log:info data)
;; This is extremely necessary so that cors is right
(let ((registration (cdr (assoc "registration" data :test 'string=)))
(health (cdr (assoc "health-form" data :test 'string=))))
(when (boundp 'hunchentoot:*reply*)
(setf (tbnl:header-out :access-control-expose-headers) "*"))
(when data
(post-camp-data data)
(mail-camp-form data nil))
(post-camp-data data)
(mail-camp-form data nil))
(if (string= health "later")
(progn (uiop:println "Selected health later")
(cond ((string= registration "now")
(setf (hunchentoot:header-out :HX-Redirect) "https://secure.myvanco.com/L-Z772/campaign/C-13JPJ")
(log:info (tbnl:headers-out*))
(log:info "Sending them to pay now"))
(when (boundp 'tbnl:*reply*)
(setf (hunchentoot:header-out :HX-Redirect) "https://secure.myvanco.com/L-Z772/campaign/C-13JPJ")
(log:info (tbnl:headers-out*)))
(log:info "Sending them to pay now")
"Redirecting to paying now")
((string= registration "full")
(setf (tbnl:header-out :HX-Redirect) "https://secure.myvanco.com/L-Z772/campaign/C-13JQE")
(log:info (tbnl:headers-out*))
(log:info "Sending them to pay full amount"))
(when (boundp 'tbnl:*reply*)
(setf (tbnl:header-out :HX-Redirect) "https://secure.myvanco.com/L-Z772/campaign/C-13JQE")
(log:info (tbnl:headers-out*)))
(log:info "Sending them to pay full amount")
"Redirecting to paying full amount")
((string= registration "later")
(let ((first-name (cdr (assoc "first-name" data :test 'string=)))
(last-name (cdr (assoc "last-name" data :test 'string=))))
@ -519,9 +528,11 @@ with the image attached"
(:p :class "text-md"
"If you'd like to pay for your registration go to the donate tab in the top right when you are ready and find the camp registration option.")))))))
(when (string= health "now")
(setf (tbnl:header-out :HX-Redirect) (format nil "/camp-health-form/?registration=~A" registration))
(log:info (tbnl:headers-out*))
(log:info "Sending them to the health form for camp")))))
(when (boundp 'tbnl:*reply*)
(setf (tbnl:header-out :HX-Redirect) (format nil "/camp-health-form/?registration=~A" registration))
(log:info (tbnl:headers-out*)))
(log:info "Sending them to the health form for camp")
"Redirecting to the health form"))))
(defun main ()
(start-server 4242)
@ -541,5 +552,17 @@ with the image attached"
(uiop:quit)))
(error (c) (format t "Woops, an unknown error occured:~&~a~&" c))))
(fiveam:test testing-things
(fiveam:is (= 2 (+ 1 1))))
(fiveam:test test-camp-form
(fiveam:is (string= "Redirecting to the health form" (camp-form test-data))))
(setf test-data '(("first-name" . "Frodo") ("last-name" . "Braggins")
("parent-first-name" . "Bilbo")
("parent-last-name" . "Braggins")
("birth-date" . "1857-04-06") ("gender" . "Male")
("street" . "341 West Hobbiton") ("city" . "The Shire")
("state" . "Middle Earth") ("zip" . "88888") ("grade" . "freshman")
("parent-phone" . "9998887777")
("parent-email" . "bilbosmells@theshire.com")
("allergies" . "No") ("week" . "week1")
("shirt" . "medium") ("final-agreement" . "yes")
("health-form" . "now") ("registration" . "now")))