(use-modules (web server)
             (web request)
             (web response)
             (web http)
             (web uri))

(use-modules (ice-9 format)
             (ice-9 textual-ports)
             (ice-9 iconv)
             (ice-9 match)
             (ice-9 binary-ports))


(define (get-path request)
  (split-and-decode-uri-path (uri-path (request-uri request))))

(define (get-last list)
  (list-ref list (- (length list) 1)))

;; This was intended to also server the files.
;; However, it turns out that guile will attempt to "sanitise" anything
;; sent as response to anything, which includes attaching charsets to
;; all mimetypes it sees. Since the wasm specifications are also weird,
;; this results in the app not running at all since web assembly can't
;; be instantiated correctly on the client's side.
;;
;; So instead, just use another web server for serving files.
(define (fetch-file path)
  (let ((ext (car (cdr (string-split (car (last-pair path)) (string->char-set "."))))))
    (let ((mimetype
           (cond
            ((equal? ext "html") 'text/html)
            ((equal? ext "css") 'text/css)
            ((equal? ext "js") 'text/javascript)
            ((equal? ext "wasm") 'application/wasm)
            (else "undefined"))))
      (format #t "mimetype for .~a is ~a\n" ext mimetype)
      (format #t "~a" (values `((content-type ,mimetype)) "test"))
      (values (build-response
               #:code 200
               #:headers `((content-type . (,mimetype (charset . "iso-8859-1"))))
               #:validate-headers? #f)
              (call-with-input-file (format #f "~a" (get-last path))
                (lambda (port) (get-string-all port)))))))

(define (call-with-append-file filename proc)
  (let ((port (open-file filename "a")))
    (proc port)
    (newline port)
    (close port)))

;; extracts the (first) content type given in a set of headers
;; TODO: saveguards against multiple given content-types?
(define (get-header type request)
  (cdr (car (filter
             (lambda (header)
               (equal? (car header) type))
             (request-headers request)))))

;; accepts a POST request (assuming it contains a survey
;; response which should be saved somewhere)
(define (do-post request body)
  (let ((survey (get-header 'x-survey request)))
    (format #t "answer to survey ~a " survey)
    ;; debug option to display ingoing answers before saving
    ;(format #t "~a\n" (bytevector->string body "utf8"))
    ;; content-types are wrapped into an extra () by guile
    (case (car (get-header 'content-type request))
      ((text/age) (call-with-output-file
                      (string-append
                       survey "-answer"
                       ; save encrypted answers in their own files, using a hash
                       ; of the answer as name postfix (since age doesn't
                       ; produce the same ciphertext for the same input twice,
                       ; this ensures absence of collissions /and/ not counting
                       ; answers mistakenly sent twice double!)
                       (number->string (hash body 10000000000)) ".age")
                    (lambda (port)
                      (display "(encrypted)\n")
                      (put-bytevector port body))))
      ((text/plain) (call-with-append-file
                     (string-append survey ".survey")
                     (lambda (port)
                       (display "(plaintext)\n")
                       (display (bytevector->string body "utf8") port)))))
    (values '((content-type . (text/plain)))
            "Hey, thanks for your answers!\n")))

;; main server function; delivers files on GET, and interprets
;; everything else as attempts at submissions.
(define (test-handler request body)
  (let ((path (get-path request)))
    (format #t "got request: ~a: ~:a\n"
            (request-method request)
            path)
    (if (equal? (format #f "~a" (request-method request)) "POST")
        (do-post request body)
        (values '() "nothing here"))))



(run-server test-handler)