(asdf:load-system 'hunchentoot)
(asdf:load-system 'dexador)
(asdf:load-system 'com.inuoe.jzon)
(asdf:load-system 'serapeum)
(asdf:load-system 'bordeaux-threads)
(asdf:load-system 'spinneret)
(asdf:load-system 'lass)
(asdf:load-system 'cl-smtp)
(asdf:load-system 'log4cl)

(defpackage tfcserver
  (:use :cl :com.inuoe.jzon :spinneret :serapeum))

(in-package :tfcserver)

(log:config :daily "/tmp/tfc-%Y%m%d.log")

(defvar *server*)
(defun start-server (port)
  (setq *server*
        (hunchentoot:start
         (make-instance 'hunchentoot:easy-acceptor
                        :port port))))

(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=)))))
         (image (assoc "image" data-list))
         (headers (list (cons "Authorization" *auth-token*)
                        (cons "Content-Type" "application/json")))
         (rows (parse (dex:get
                       "https://staff.tfcconnection.org/apps/tables/api/1/tables/5/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=)
                     data-list))
    (setq data-list (remove
                     (assoc "parentlastname" *last-list-data* :test 'string=)
                     data-list))
    (setq data-list (remove
                     (assoc "image" *last-list-data* :test 'string=)
                     data-list))
    (setf (cdr
           (assoc "firstname" data-list :test 'string=))
          student-name)
    (setf (car
           (assoc "firstname" data-list :test 'string=))
          "Student Name")
    (setf (cdr
           (assoc "parentfirstname" data-list :test 'string=))
          parent-name)
    (setf (car
           (assoc "parentfirstname" data-list :test 'string=))
          "Parent Name")
    (setf (car
           (assoc "add-emergency-contact" data-list :test 'string=))
          "emergency-contact")
    (setf (car
           (assoc "doctorname" data-list :test 'string=))
          "doctor")
    (setf (car
           (assoc "doctorphone" data-list :test 'string=))
          "doctor-phone")
    (setf (car
           (assoc "doctorcity" data-list :test 'string=))
          "doctor-city")
    (setf (car
           (assoc "allergic-treatment" data-list :test 'string=))
          "allergy-treatments")
    (setf (car (assoc "tetanus-shot" data-list :test 'string=))
          "tetanus-shot-date")
    (loop :for entry :in data-list
          :do (format t "~&~A" entry))
    (format t "~&~A" "Let's print out the data")
    (format t "~&~A" data-list)
    (uiop: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=))))))

    (dex:post "https://staff.tfcconnection.org/apps/tables/api/1/tables/4/rows"
              :basic-auth '("chris" . "2VHeGxeC^Zf9KqFK^G@Pt!zu2q^6@b")
              :content `(("data" . ,(stringify special-data)))
              :verbose t)
    ))

(defun post-camp-data (data)
  "Takes the camp data as an alist and sends it to nextcloud tables to be input"
  (let ((new-data `((63 . ,(concat
                            (cdr
                             (assoc "first-name"
                                    data :test 'string=))
                            " "
                            (cdr
                             (assoc "last-name"
                                    data :test 'string=))))
                    (64 . ,(concat
                            (cdr
                             (assoc "parent-first-name"
                                    data :test 'string=))
                            " "
                            (cdr
                             (assoc "parent-last-name"
                                    data :test 'string=))))
                    (65 . ,(cdr
                            (assoc "parent-phone"
                                   data :test 'string=)))
                    (66 . ,(cdr
                            (assoc "parent-email"
                                   data :test 'string=)))
                    (67 . ,(cdr
                            (assoc "birth-date"
                                   data :test 'string=)))
                    (69 . ,(cdr
                            (assoc "gender"
                                   data :test 'string=)))
                    (70 . ,(cdr
                             (assoc "street"
                                    data :test 'string=)))
                    (71 . ,(cdr
                            (assoc "city"
                                   data :test 'string=)))
                    (72 . ,(cdr
                            (assoc "state"
                                   data :test 'string=)))
                    (73 . ,(cdr
                            (assoc "zip"
                                   data :test 'string=)))
                    (74 . ,(cdr
                            (assoc "grade"
                                   data :test 'string=)))
                    (75 . ,(cdr
                            (assoc "week"
                                   data :test 'string=)))
                    (76 . ,(cdr
                            (assoc "shirt"
                                   data :test 'string=)))
                    (77 . ,(cdr
                            (assoc "registration"
                                   data :test 'string=))))))
    (log:info new-data)
    (bt:make-thread
     (lambda ()
       (dex:post "https://staff.tfcconnection.org/apps/tables/api/1/tables/5/rows"
                 :basic-auth '("chris" . "2VHeGxeC^Zf9KqFK^G@Pt!zu2q^6@b")
                 :content `(("data" . ,(stringify new-data)))
                 :verbose t)))))

(defun mail-mt-form (form attachment)
  "Takes the form as an alist and sends a table formatted email
with the image attached to us"
  (log:info form)
  (let ((first-name (cdr (assoc "firstname" form :test 'string=)))
        (last-name (cdr (assoc "lastname" form :test 'string=)))
        (form (reverse form)))
    (not (cl-smtp:send-email
          "mail.tfcconnection.org"
          "no-reply@mail.tfcconnection.org"
          '("chris@cochrun.xyz" "chris@tfcconnection.org")
          (format nil "~a ~a filled out a Mission Trip Form!" first-name last-name)
          (format nil "Mission Trip 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 Mission Trip Form")
                    (:style (apply #'lass:compile-and-write *mail-css*)))
             (:body
              (:h1 (format nil "Mission Trip Form for ~a ~a" first-name last-name))
              (:hr)
              (:table
               (loop for row in form
                     do (:tr
                         (:th (trim-whitespace (car row)))
                         (:td (trim-whitespace
                               (cdr row)))))))))))))

(defun mail-camp-form (form attachment)
  "Takes the form as an alist and sends a table formatted email
with the image attached"
  (let* ((first-name (trim-whitespace
                      (cdr (assoc "first-name" form
                                  :test 'string=))))
         (last-name (trim-whitespace
                     (cdr (assoc "last-name" form
                                 :test 'string=))))
         (parent-name (concatenate 'string
                                   (trim-whitespace
                                    (cdr (assoc "parent-first-name" form
                                                :test 'string=)))
                                   " "
                                   (trim-whitespace
                                    (cdr (assoc "parent-last-name" form
                                                :test 'string=))))))
    (log:info (format nil "Mailing out the camp form for ~a"
                      (concat first-name " " last-name)))
    (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 Camp Form!" first-name last-name)
          (format nil "Camp 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 "Camp Form for ~a ~a" first-name last-name))
              (:hr)
              (:table
               (loop for row in form
                     do (:tr
                         (:th (string-capitalize
                               (string-replace-all
                                "-" (car row) " ")))
                         (:td (cdr row))))))))))))

(defun mail-health-form (form attachment)
  "Takes the form as an alist and sends a table formatted email
with the image attached"
  (let* ((first-name (trim-whitespace
                      (cdr (assoc "first-name" form
                                  :test 'string=))))
         (last-name (trim-whitespace
                     (cdr (assoc "last-name" form
                                 :test 'string=))))
         (parent-name (concatenate 'string
                                   (trim-whitespace
                                    (cdr (assoc "parent-first-name" form
                                                :test 'string=)))
                                   " "
                                   (trim-whitespace
                                    (cdr (assoc "parent-last-name" form
                                                :test 'string=))))))
    (log:info (format nil "Mailing out the health form for ~a"
                      (concat first-name " " last-name)))
    (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 (string-capitalize
                               (string-replace-all
                                "-" (car row) " ")))
                         (:td (cdr row))))))))))))

(tbnl:define-easy-handler (health-form :uri "/health-form") ()
  (setf (tbnl:header-out :access-control-expose-headers) "*")
  (let* ((data (tbnl:post-parameters* tbnl:*request*))
         (registration (cdr (assoc "registration" data :test 'string=)))
         (image (cdr (assoc "image" data :test 'string=)))
         (first-name (cdr (assoc "first-name" data :test 'string=)))
         (last-name (cdr (assoc "last-name" data :test 'string=)))
         (image (cdr (assoc "image" data :test 'string=)))
         (attachment nil))
    (loop :for d :in data
          :do (progn
                (if (string= "first-name" (car d))
                    (progn
                      (setf first-name (cdr d))))
                (if (string= "last-name" (car d))
                    (progn
                      (setf last-name (cdr d))))
                (if (string= "image" (car d))
                    (let ((path (path-join
                                 hunchentoot:*tmp-directory*
                                 (format nil "~a_~a.~a" first-name last-name
                                         (cadr (uiop:split-string
                                                (car (last d 2)) :separator "."))))))
                      (uiop:copy-file
                       (cadr d)
                       (path-join
                        hunchentoot:*tmp-directory*
                        (format nil "~a_~a.~a" first-name last-name
                                (cadr (uiop:split-string
                                       (car (last d 2)) :separator ".")))))
                      (setf attachment path)
                      (log:info attachment)))))
    (log:info data)
    (when data
      (mail-health-form data attachment)
      (cond ((string= registration "now")
             (log:info "Sending them to pay now")
             (setf (hunchentoot:header-out :HX-Redirect) "https://secure.myvanco.com/L-Z772/campaign/C-13JPJ"))
            ((string= registration "full")
             (log:info "Sending them to pay full amount")
             (setf (tbnl:header-out :HX-Redirect) "https://secure.myvanco.com/L-Z772/campaign/C-13JQE"))
            ((string= registration "later")
             (log:info "Sending the health form thank you snippet")
             (with-html-string
               (:div
                :class "mt-8"
                (:h2 (format nil
                             "Thank You ~A!"
                             (concat
                              first-name " " last-name)))
                (: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."))))))))

(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)
    (when (not data)
      (return))
    ;; This is extremely necessary so that cors is right
    (setf (tbnl:header-out :access-control-expose-headers) "*")
    (mail-camp-form data nil)
    (post-camp-data data)
    (if (string= health "bleh")
        (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"))
                     ((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"))
                     ((string= registration "later")
                      (let ((first-name (cdr (assoc "first-name" data :test 'string=)))
                            (last-name (cdr (assoc "last-name" data :test 'string=))))
                        (log:info "Sending the camp thank you snippet")
                        (with-html-string
                          (:div
                           :class "mt-8"
                           (:h2 (format nil
                                        "Thank You ~A!"
                                        (concat
                                         first-name " " last-name)))
                           (:p "Can't wait to see you at camp!!")
                           (: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 "bleh")
          (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")))))

(defun main ()
  (start-server 4242)
  (log:info "Server has started on port 4242~&")
  (handler-case
      (bt:join-thread (find-if (lambda (th)
                                 (search "hunchentoot" (bt:thread-name th)))
                               (bt:all-threads)))
    (#+sbcl sb-sys:interactive-interrupt
     #+ccl  ccl:interrupt-signal-condition
     #+clisp system::simple-interrupt-condition
     #+ecl ext:interactive-interrupt
     #+allegro excl:interrupt-signal
     () (progn
          (format *error-output* "Aborting.~&")
          (hunchentoot:stop *server*)
          (uiop:quit)))
    (error (c) (format t "Woops, an unknown error occured:~&~a~&" c))))