(define (lay:http:write-header h)
  (display (conc (car h) ": " (cdr h) "\r\n")))

(define (lay:http:make-request host path headers)
  (with-output-to-string
    (lambda ()
      (display (string-append "GET " path " HTTP/1.1\r\n"))
      (map lay:http:write-header `((Host . ,host)
                                   (User-Agent . chicken-lay)
                                   (Connection . close)
                                   (Accept . *)))
      (map lay:http:write-header headers)
      (display "\r\n"))))

(define (lay:http:split-head-line s)
  (let ((n (string-length s)))
    (let loop ((i 0))
      (if (> i n)
        (values "" "")
        (if (char=? #\: (string-ref s i))
          (values (substring s 0 i)
                  (substring s (add1 i)))
          (loop (add1 i)))))))

(define (lay:http:parse-head port)
  (let loop ((head '()))
    (let ((line (read-line port)))
      (if (eq? 0 (string-length line))
        (reverse head)
        (let-values (((k v) (lay:http:split-head-line line)))
          (let ((k  (string->symbol (lay:string:downcase (lay:string:trim k))))
                (v  (lay:string:trim v)))
            (loop (cons (cons k v) head))))
        ))))

(define (lay:http:parse-body head port)
  (and-let* ((content-length (alist-ref 'content-length head)))
    (read-string (string->number content-length) port)))

(define (lay:http:get host path headers)
  (let ((request (lay:http:make-request host path headers)))
    (let-values (((i o) (tcp-connect host 80)))
      (display request o)
      (flush-output o)
      (close-output-port o)
      (let ((first-line (string-split (read-line i))))
        (unless (string-ci=? (car first-line) "HTTP/1.1")
          (error "Invalid response type: " (string-append (map ->string first-line))))
        (let* ((code (string->number (cadr first-line)))
               (head (lay:http:parse-head i))
               (body (lay:http:parse-body head i)))
          (close-input-port i)
          (values code head body))))))