nly-if-cached"                    ; Section 14.9.4
;;      | cache-extension                     ; Section 14.9.6
;;  cache-response-directive =
;;        "public"                               ; Section 14.9.1
;;      | "private" [ "=" <"> 1#field-name <"> ] ; Section 14.9.1
;;      | "no-cache" [ "=" <"> 1#field-name <"> ]; Section 14.9.1
;;      | "no-store"                             ; Section 14.9.2
;;      | "no-transform"                         ; Section 14.9.5
;;      | "must-revalidate"                      ; Section 14.9.4
;;      | "proxy-revalidate"                     ; Section 14.9.4
;;      | "max-age" "=" delta-seconds            ; Section 14.9.3
;;      | "s-maxage" "=" delta-seconds           ; Section 14.9.3
;;      | cache-extension                        ; Section 14.9.6
;; cache-extension = token [ "=" ( token | quoted-string ) ]
;;
(declare-key-value-list-header! "Cache-Control"
  (lambda (k v-str)
    (case k
      ((max-age min-fresh s-maxage)
       (parse-non-negative-integer v-str))
      ((max-stale)
       (and v-str (parse-non-negative-integer v-str)))
      ((private no-cache)
       (and v-str (split-header-names v-str)))
      (else v-str)))
  (lambda (k v)
    (case k
      ((max-age min-fresh s-maxage)
       (non-negative-integer? v))
      ((max-stale)
       (or (not v) (non-negative-integer? v)))
      ((private no-cache)
       (or (not v) (list-of-header-names? v)))
      ((no-store no-transform only-if-cache must-revalidate proxy-revalidate)
       (not v))
      (else
       (or (not v) (string? v)))))
  (lambda (k v port)
    (cond
     ((string? v) (default-val-writer k v port))
     ((pair? v)
      (put-char port #\")
      (write-header-list v port)
      (put-char port #\"))
     ((integer? v)
      (put-non-negative-integer port v))
     (else
      (bad-header-component 'cache-control v)))))

;; Connection = "Connection" ":" 1#(connection-token)
;; connection-token  = token
;; e.g.
;;     Connection: close, Foo-Header
;; 
(declare-header! "Connection"
  split-header-names
  list-of-header-names?
  (lambda (val port)
    (put-list port val
              (lambda (port x)
                (put-string port
                            (if (eq? x 'close)
                                "close"
                                (header->string x))))
              ", ")))

;; Date  = "Date" ":" HTTP-date
;; e.g.
;;     Date: Tue, 15 Nov 1994 08:12:31 GMT
;;
(declare-date-header! "Date")

;; Pragma            = "Pragma" ":" 1#pragma-directive
;; pragma-directive  = "no-cache" | extension-pragma
;; extension-pragma  = token [ "=" ( token | quoted-string ) ]
;;
(declare-key-value-list-header! "Pragma")

;; Trailer  = "Trailer" ":" 1#field-name
;;
(declare-header-list-header! "Trailer")

;; Transfer-Encoding = "Transfer-Encoding" ":" 1#transfer-coding
;;
(declare-param-list-header! "Transfer-Encoding")

;; Upgrade = "Upgrade" ":" 1#product
;;
(declare-string-list-header! "Upgrade")

;; Via =  "Via" ":" 1#( received-protocol received-by [ comment ] )
;; received-protocol = [ protocol-name "/" ] protocol-version
;; protocol-name     = token
;; protocol-version  = token
;; received-by       = ( host [ ":" port ] ) | pseudonym
;; pseudonym         = token
;;
(declare-header! "Via"
  split-and-trim
  list-of-strings?
  write-list-of-strings
  #:multiple? #t)

;; Warning    = "Warning" ":" 1#warning-value
;;
;; warning-value = warn-code SP warn-agent SP warn-text
;;                                       [SP warn-date]
;;
;; warn-code  = 3DIGIT
;; warn-agent = ( host [ ":" port ] ) | pseudonym
;;                 ; the name or pseudonym of the server adding
;;                 ; the Warning header, for use in debugging
;; warn-text  = quoted-string
;; warn-date  = <"> HTTP-date <">
(declare-header! "Warning"
  (lambda (str)
    (let ((len (string-length str)))
      (let lp ((i (skip-whitespace str 0)))
        (let* ((idx1 (string-index str #\space i))
               (idx2 (string-index str #\space (1+ idx1))))
          (when (and idx1 idx2)
            (let ((code (parse-non-negative-integer str i idx1))
                  (agent (substring str (1+ idx1) idx2)))
              (call-with-values
                  (lambda () (parse-qstring str (1+ idx2) #:incremental? #t))
                (lambda (text i)
                  (call-with-values
                      (lambda ()
                        (let ((c (and (< i len) (string-ref str i))))
                          (case c
                            ((#\space)
                             ;; we have a date.
                             (call-with-values
                                 (lambda () (parse-qstring str (1+ i)
                                                           #:incremental? #t))
                               (lambda (date i)
                                 (values text (parse-date date) i))))
                            (else
                             (values text #f i)))))
                    (lambda (text date i)
                      (let ((w (list code agent text date))
                            (c (and (< i len) (string-ref str i))))
                        (case c
                          ((#f) (list w))
                          ((#\,) (cons w (lp (skip-whitespace str (1+ i)))))
                          (else (bad-header 'warning str))))))))))))))
  (lambda (val)
    (list-of? val
              (lambda (elt)
                (match elt
                  ((code host text date)
                   (and (non-negative-integer? code) (< code 1000)
                        (string? host)
                        (string? text)
                        (or (not date) (date? date))))
                  (_ #f)))))
  (lambda (val port)
    (put-list
     port val
     (lambda (port w)
       (match w
         ((code host text date)
          (put-non-negative-integer port code)
          (put-char port #\space)
          (put-string port host)
          (put-char port #\space)
          (write-qstring text port)
          (when date
            (put-char port #\space)
            (put-char port #\")
            (write-date date port)
            (put-char port #\")))))
     ", "))
  #:multiple? #t)


