;;; A HTTP request. We require an open connection, and just send the
;;; request. After that, we read the headers of the reply, and leave
;;; it up to the library user whether he wants to read the body. Since
;;; we don't close the socket either, it's easy to implement
;;; connection reuse.

;;; The reply returned by HTTP-SEND-REQUEST.
(define-record-type http-reply
  (make-http-reply status-code status-description headers socket)
  http-reply?
  (status-code          http-reply-status-code)
  (status-description   http-reply-status-description)
  (headers              http-reply-headers)
  (socket               http-reply-socket))

(define (http-send-request protocol-version method path headers body socket)
  (let ((port (socket:outport socket)))
    (display method port)
    (display " " port)
    (display path port)
    (display " " port)
    (display protocol-version port)
    (newline port)
    (for-each (lambda (header)
                (display (car header) port)
                (display ": " port)
                (display (cdr header) port)
                (newline port))
              headers)
    (newline port)
    (if body
        (display body port))
    (read-reply socket)))

(define (read-reply socket)
  (let* ((port (socket:inport socket))
         (status (read-status port))
         (headers (read-headers port)))
    (make-http-reply (car status)
                     (cdr status)
                     headers
                     socket)))

(define (read-http-line port)
  (let ((line (read-line port)))
    (if (eq? (string-ref line (- (string-length line) 1))
             (ascii->char #x0D))
        (substring line 0 (- (string-length line)
                             1))
        line)))

(define (read-status port)
  (let* ((line (read-http-line port))
         (i (string-index line #\space))
         (j (string-index line #\space (+ i 1))))
    (cons (substring line
                     (+ i 1)
                     j)
          (substring line
                     (+ j 1)
                     (string-length line)))))

(define (read-headers port)
  (let loop ((line (read-http-line port)))
    (cond
     ((eof-object? line)
      (error "Premature EOF in HTTP reply headers"))
     ((zero? (string-length line))
      '())
     (else
      (let ((i (string-index line #\:)))
        (cons (cons (substring line 0 i)
                    (substring line
                               (+ 2 i)
                               (string-length line)))
              (read-headers port)))))))

(define (http-read-reply-body reply)
  (cond
   ((assoc "Content-Length" (http-reply-headers reply))
    => (lambda (lenstr)
         (read-string (string->number (cdr lenstr))
                      (socket:inport (http-reply-socket reply)))))
   (else
    (port->string (socket:inport (http-reply-socket reply))))))