(ql:quickload '(hunchentoot clack dexador com.inuoe.jzon serapeum bordeaux-threads))

(defpackage tfc-server
  (:use :cl :uiop :com.inuoe.jzon :clack))

(in-package :tfc-server)

(defvar *last*)
(defvar *last-data*)
(defvar *last-list-data*)
(defvar *stream*)
(defvar *auth-token* "boFFRM68vvXbO-DO7S9YDg86lHX027-hd07mn0dh")

(defvar *server*)

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

(defun post-health-form (data-list)
  "Takes the health form as an alist and posts it to nocodb"
  (let* ((student-name (concatenate 'string
                                    (cdr (assoc "firstname" data-list :test 'string=))
                                    " "
                                    (cdr (assoc "lastname" data-list :test 'string=))))
         (parent-name (concatenate 'string
                                   (cdr (assoc "parentfirstname" data-list :test 'string=))
                                   " "
                                   (cdr (assoc "parentlastname" data-list :test 'string=))))
         (headers (list (cons "xc-token" *auth-token*) (cons "Content-Type" "application/json"))))

    (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")
    (format t "~&~A" data-list)

    (dex:post "https://tbl.tfcconnection.org/api/v1/db/data/v1/TFC/Health%20Forms/"
              :headers headers
              :content (stringify data-list)
              :verbose t)))

(defun print-hash-entry (key value)
  (format t "~S: ~S~%" key (if (hash-table-p value) (maphash 'print-hash-entry value) 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))

(hunchentoot:define-easy-handler (respond :uri "/health-form") ()
  (setf (hunchentoot:content-type*) "plain/text")
  (let ((request-type (hunchentoot:request-method hunchentoot:*request*)))
    (cond ((eq request-type :get) nil)
          ((eq request-type :post)
           (uiop:println hunchentoot:*request*)
           (setq *last* hunchentoot:*request*)
           (setq *stream* (hunchentoot::content-stream hunchentoot:*request*))
           (let* ((data (hunchentoot::get-post-data :request *last*))
                  (content-type (hunchentoot:header-in "content-type" hunchentoot:*request*))
                  (boundary (let ((position (position #\= content-type)))
                              (when position
                                (subseq content-type (1+ position)))))
                  (string-data (flexi-streams:octets-to-string data))
                  (parts (ppcre:split boundary string-data)))

             (setq *last-data* parts)
             (setq *last-list-data* nil)
             (loop :for i :in *last-data*
                   :do (let* ((content-disposition (nth 1
                                                        (serapeum:lines i :eol-style :crlf :honor-crlf t)))
                              (start (if content-disposition (position #\" content-disposition)))
                              (end (if start (position #\" content-disposition :start (1+ start)) nil))
                              (name (if end (if start (subseq content-disposition (1+ start) end) nil) nil))
                              (content (if (string= name "image")
                                           (butlast (rest
                                                     (rest
                                                      (rest
                                                       (rest
                                                        (serapeum:lines i :eol-style :crlf
                                                                          :honor-crlf t
                                                                          :keep-eols t))))))
                                           (butlast
                                            (rest
                                             (rest
                                              (rest
                                               (serapeum:lines i :eol-style :crlf
                                                                 :honor-crlf t
                                                                 :keep-eols t)))))))
                              (file-start (if (string= name "image")
                                              (position #\" content-disposition :start 44)))
                              (file-end (if file-start
                                            (position #\" content-disposition :start (1+ file-start)) nil))
                              (image-file-name (if (string= name "image")
                                                   (subseq content-disposition
                                                           (1+ file-start) file-end) nil))
                              (form-list nil))

                         ;; This gets rid of beginning and ending NIL values
                         (if (string/= name "image")
                             (if (listp content)
                                 (setq content (serapeum:mapconcat
                                                (lambda (x) (if (string= x "")
                                                                (coerce #\Newline 'string)
                                                                x))
                                                content ""))))
                         (if name (if (string/= name "image") (progn
                                                                (format t "~&~A: ~A" name content)
                                                                (setq form-list (acons name content form-list)))) nil)

                         (if (string= "image" name)
                             (progn (format t "~&~A: ~A" name image-file-name)
                                    (setq form-list (acons name image-file-name form-list))
                                    (save-string-file
                                     (apply #'concatenate 'string content) image-file-name)))

                         (setq *last-list-data* (append *last-list-data* form-list))))
             (post-health-form *last-list-data*)
             (format nil "thankyou"))))))

(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))))
