http.rkt

#lang racket
(require net/url)
(require racket/contract)

; Regular expressions

(define rx-CRLF #rx"\r\n")
(define px-status-line #px"HTTP/(\\d)\\.(\\d)\\s(\\d+)\\s(.*)$")
(define px-header-line #px"^([^:]+)\\s*:\\s*(.+)$")

; structs

(struct http-version (major minor))
(struct header (key value))
(struct response (http-version code message headers body))

(define (split-response-port response-port)
  (let ([status-line&headers (string-split (purify-port response-port) rx-CRLF)])
    (values (first status-line&headers) (rest status-line&headers) response-port)))

(define (parse-status-line status-line) 
  (let* ([split-sl     (rest (regexp-match px-status-line status-line))]
         [hv           (apply http-version (take split-sl 2))]
         [code         (caddr split-sl)]
         [message      (cadddr split-sl)])
    (values hv code message)))

(define (parse-header-line header-line)
  (apply header 
         (rest 
          (regexp-match px-header-line header-line))))


(define (parse-response response-port)
  (let*-values
      ([(status-line header-lines body) (split-response-port response-port)]
       [(hv code message)               (parse-status-line status-line)]
       [(headers)                       (map parse-header-line (drop-right header-lines 1))])
    (response hv code message headers response-port)))