Welcome to the CHICKEN Scheme pasting service

(module learninng-http-server (make-server server-start! server-join! server-stop!)
  (import scheme chicken extras
          ports
          posix
          srfi-13)
  (use socket srfi-18)

(define-record *server 
  port            ; integer
  backlog         ; integer
  host            ; string
  listener        ; socket
  thread          ; thread
  )

; reads up to n characters from input-port (reading stops if the input port 
; fails (char-ready? ...), reaches the end-char if supplied, or is at EOF)
; and returns a string
(define (readn input-port n #!optional (end-char #f))
  (define s (make-string n))
  (define len
    (let chomp ((c 0))
      (if (or (= c n)
              (not (char-ready? input-port))
              (eof-object? (peek-char input-port))
              (and end-char (char=? (peek-char input-port) end-char)))
        c
        (begin
          (string-set! s c (read-char input-port))
          (chomp (+ c 1))))))
  (substring/shared s 0 len))

(define (make-exn/type message location)
  (make-composite-condition
                         (make-property-condition 'exn 'message message 'location location)
                         (make-property-condition 'type)))

(define (make-server #!key (port 8080) (backlog 100) (host "::"))
  (let ()
    (if (not (integer? port))
      (abort (make-exn/type "port should be an integer." "make-server")))
    (if (not (integer? backlog))
      (abort (make-exn/type "backlog should be an integer." "make-server")))
    (if (not (string? host))
      (abort (make-exn/type "host should be a string." "make-server"))))
  (make-*server port backlog host #f #f))

; throws: (exn i/o net) if the listener socket setup fails
; server is of type *server
(define (server-start! server)
  (if (not (*server? server))
    (abort (make-exn/type "server should be a *server." "server-start!")))
  (let ((listener (socket af/inet6 sock/stream)))
    (*server-listener-set! server listener)
    (set! (tcp-no-delay? listener) #t)
    (set! (ipv6-v6-only? listener) #f)
    (set! (so-reuse-address? listener) #t) 
    (socket-bind listener (inet-address (*server-host server) (*server-port server)))
    (socket-listen listener (*server-backlog server))
    (define thread
      (make-thread
        (lambda ()
          (condition-case
            (let accept-loop ((conn (socket-accept listener)))
              (print "here")
              (let* 
                ((crlf (string #\return #\newline))
                 (message (sprintf "HTTP/1.1 200 OK\r\nContent-Length:13\r\nConnection:close\r\n\r\nhello, world!"))
                 (handler
                   (lambda ()
                     (condition-case
                       (begin
                         (socket-send conn message)
                         (socket-close conn))
                       [(exn i/o net) (condition-case
                                        (socket-close message)
                                        [(exn i/o net) (print "nothing else we can do")])
                                      (print "client socket error")])))
                 (thread (make-thread handler)))
                (thread-start! thread))
              (accept-loop (socket-accept listener)))
            [(exn i/o net) (condition-case
                             (socket-close listener)
                             [(exn i/o net) (print "nothing else we can do")])
                           (print "something went wrong")]
            [(user-interrupt) (socket-close listener)]))))
    (*server-thread-set! server thread)
    (thread-start! thread)
    server))

(define (server-join! server)
  (if (not (*server? server))
    (abort (make-exn/type "server should be a *server." "server-join!")))
  (if (not (thread? (*server-thread server)))
    (abort (make-exn/type "server is not a currently running server." "server-join!")))
  (thread-join! (*server-thread server)))

(define (server-stop! server)
  (if (not (*server? server))
    (abort (make-exn/type "server should be a *server." "server-stop!")))
  (socket-shutdown (*server-listener server) shut/rdwr)
  (socket-close (*server-listener server))))