(require "hunchentoot")
(require "dexador")
;; (require "drakma")
(require "com.inuoe.jzon")
(require "serapeum")
(require "bordeaux-threads")
(require "spinneret")
(require "lass")
(require "cl-smtp")

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

(in-package :tfcserver)

(defvar *last*)
(defvar *last-data*)
(defvar *last-list-data*)
(defvar *stream*)
(defvar *auth-token* "Basic Y2hyaXM6MlZIZUd4ZUNeWmY5S3FGS15HQFB0IXp1MnFeNkBi")

(defvar *server*)

(defun start-server (port)
  (setq *server*
        (hunchentoot:start
         (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 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=)))))
         (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/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=)
                     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 print-hash-entry (key value)
  (format t "~S: ~S~%" key
          (if (hash-table-p value)
              (maphash 'print-hash-entry value)
              (if (simple-vector-p value)
                  (loop
                    :for item
                      :in (setq value (coerce value 'list))
                    :do (maphash 'print-hash-entry item)) 
                  value))))

(defun process-form (form)
  "Processes the form and sends it on"
  (uiop:println "---")
  (maphash 'print-hash-entry form)
  (uiop:println "---"))

(defun save-string-file (string file-path)
  "save a file that is represented as a string to disk that came from a multipart/form-data"
  (serapeum/bundle:write-string-into-file string file-path
                                          :if-exists :overwrite
                                          :if-does-not-exist :create
                                          :external-format :latin-1))

(defun mail-mt-form (form attachment)
  "Takes the form as an alist and sends a table formatted email
with the image attached to us"
  (uiop:println 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-health-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=))))))
    (not (cl-smtp:send-email
          "mail.tfcconnection.org"
          "no-reply@mail.tfcconnection.org"
          '("chris@tfcconnection.org" "chris@cochrun.xyz")
          (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 (cdr row))))))))))))

(defun define-post-form-handler (uri mail-function)
  "Take a uri and a mailer function and define a handler in hunchentoot
for forms to POST to."
(hunchentoot:define-easy-handler (respond :uri uri) ()
  (setf (hunchentoot:content-type*) "plain/text")
  (let* ((request-type (hunchentoot:request-method hunchentoot:*request*))
         (post-data (hunchentoot:post-parameters* hunchentoot:*request*))
         (attachment nil)
         (first-name nil)
         (last-name nil))
    (cond ((eq request-type :get) nil)
          ((eq request-type :post)
           (loop :for d :in post-data
                 :do (progn
                       (uiop:println d)
                       (if (string= "firstname" (car d))
                           (progn
                             (uiop:println (cdr d))
                             (setf first-name (cdr d))))
                       (if (string= "lastname" (car d))
                           (progn
                             (uiop:println (cdr d))
                             (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)
                             (uiop:println attachment)))))
           (if (funcall mail-function post-data attachment)
               (format nil "thankyou")))))))

(define-post-form-handler "/mt-form" 'mail-mt-form)
(define-post-form-handler "/health-form" 'mail-health-form)

(defun main ()
  (start-server 4242)
  (format t "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))))