(define-module (server)
  #:export (run start stop main))

(use-modules
 (ice-9 atomic)
 (ice-9 binary-ports)
 (ice-9 threads)
 (srfi srfi-9)
 (web client)
 (web server)
 (web request)
 (web response)
 (web uri))

(define mime-types
  '(("html" . (text/html))
	("css"  . (text/css))
	("js"   . (application/javascript))
	("wasm" . (application/wasm))
	("f"    . (text/plain))
	("wat"  . (text/plain))
	("png"  . (image/png))))

(define (mime-type path)
  (let* ((dot (string-rindex path #\.))
		 (ext (when dot (substring path (1+ dot)))))
	(or (assoc-ref mime-types ext) "application/octet-stream")))

(define headers
  '((cross-origin-opener-policy . "same-origin")
	(cross-origin-embedder-policy . "require-corp")
	(cache-control . (no-store no-cache must-revalidate))))

(define (is-dir? path)
  (eq? 'directory (stat:type (stat path))))

(define (request-path request)
  (let ((path (string-append "." (uri-path (request-uri request)))))
	(cond ((not (file-exists? path)) #nil)
		  ((is-dir? path) (string-append path "index.html"))
		  (#t path))))

(define (file-handler request body)
  (let ((path (request-path request)))
	(if path
		(values (cons `(content-type . ,(mime-type path)) headers)
				(get-bytevector-all (open-input-file path)))
		(values (build-response #:code 404) #f))))

(define* (run #:key (port 8080))
  (run-server file-handler 'http `(#:port ,port)))

(define-record-type <handle>
  (make-handle close-flag thread port)
  handle?
  (close-flag handle-close-flag)
  (thread handle-thread)
  (port handle-port))

(define (serve impl server should-close)
  (let loop ()
	(unless (atomic-box-ref should-close)
	  (serve-one-client file-handler impl server '())
	  (loop)))
  (close-server impl server))

(define* (start #:key (port 8080))
  (let* ((impl (lookup-server-impl 'http))
		 (server (open-server impl `(#:port ,port)))
		 (should-close (make-atomic-box #f))
		 (thread
		  (call-with-new-thread
		   (lambda () (serve impl server should-close)))))
	(make-handle should-close thread port)))

(define (stop handle)
  (atomic-box-set! (handle-close-flag handle) #t)
  (http-request (format #f "http://localhost:~a/" (handle-port handle)))
  (join-thread (handle-thread handle)))

(when (string=? (basename (current-filename)) (car (command-line)))
  (run))