#lang scheme/base
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; NET.plt
;;
;; abstraction of common network behaviors and services
;;
;; Bonzai Lab, LLC.  All rights reserved.
;;
;; Licensed under LGPL.
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; header.ss - an extensible RFC822 header parser/generator.
;; basic function for generating and parsing RFC822 headers.
;; yc 8/18/2009 - first version
;; yc 1/22/2010 - added headers->input
;; yc 1/31/2010 - make header to become a pair of string + anything, instead of just
;;                (cons/c string? string?)
;;                added header-reader-table & header-writer-table to manage custom
;;                header read & write
(require "depend.ss"
         "line.ss"
         "phrase.ss" 
         (rename-in "kvs.ss" 
                    (kvs-writertable header-writertable)
                    (kvs-writer-ref header-writer-ref)
                    )
         (only-in "kvs.ss" kv->string kvs->string)
         
         #|(rename-in "depend.ss"
                    (kv? header?)
                    (kvs-ref header-ref)
                    (kvs headers)
                    (kvs? headers?)
                    (kvs-inner headers-inner)
                    (make-kvs make-headers)
                    )
;;|#
         )

;; header->string
;; convert header to string based on the header writer
(define (header->string h)
  (string-append (kv->string h 
                             #:delim ": " 
                             #:encode-val (header-writer-ref (car h) identity))
                 (line-term/string)))

(define (headers->string headers (end? #t))
  (define (helper result)
    (string-append result 
                   (if end? 
                       (line-term/string)
                       "")))
  (helper (string-join (map header->string (kvs/list->kvlist headers)) "")))

;; headers->input
;; convert the headers into an input-port (specifically abytes?)
(define (headers->input headers (end? #t))
  (open-input-abytes (headers->string headers end?)))

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; READING a HEADER

;; string->header
;; convert a string into a header?
(define (string->header line)
  (define (helper match)
    (if match
        (let ((name (cadr match))
              (value (caddr match)))
          (cons name ((kvs-reader-ref name identity) value)))
        #f))
  (helper (regexp-match #px"^([^:]+)\\s*:\\s*(.+)$" line)))

;; header parsers
;; a single header character... visible ascii (33 to 126) except #\:
(define p:header-field-char
  (char-when (lambda (c) 
               (and (char<=? (integer->char 33) c (integer->char 126))
                  (not (char=? c #\:))))))

(define p:header-def 
  (seq header <- (one-many p:header-field-char)
       (token #\:)
       (return header))) 

;; read-header
;; test to make sure the line contains a header definition in the beginning
;; before trying to consume it as a header...
(define (read-header in) 
  (let-values (((v IN)
                (p:header-def (make-input in))))
    (if (failed? v) ;; this is not a header...
        #f
        ;; let's read a full line and then
        (string->header (read-folded-line in)))))

;; read-headers
;; read in all of the headers by using read-header
;; and consume the empty line if it exists...
(define (read-headers in) 
  (define (return headers)
    ;; we need to remove the next line if it is an empty lines...
    (let-values (((v IN)
                  ((bytes= (line-term/bytes)) (make-input in))))
      (unless (failed? v) 
        (read-folded-line in)))
    (reverse headers))
  (define (helper headers)
    (let ((header (read-header in))) 
      (if (not header) ;; we are done...
          (return headers) 
          (helper (cons header headers)))))
  (helper '())) 

;; provide
(provide/contract 
 (header->string (-> kv? string?))
 (read-header (-> input-port? (or/c false/c kv?)))
 (read-headers (-> input-port? kvs/list?))
 (headers->string (->* (kvs/list?)
                       (boolean?)
                       string?))
 (headers->input (->* (kvs/list?)
                      (boolean?)
                      input-port?))
 )