1 files changed, 0 insertions, 102 deletions
diff --git a/server/server.scm b/server/server.scm
deleted file mode 100644
index 751ef01..0000000
--- a/server/server.scm
+++ /dev/null
@@ -1,102 +0,0 @@
-(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)