#lang scheme/base
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SHP: Hypertext Processor
;;
;; a PHP like web framework for PLT Scheme
;;
;; Bonzai Lab, LLC.  All rights reserved.
;;
;; Licensed under LGPL.
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; request.ss
;; abstraction over request object.
;; yc 8/13/2009 - first version
(require mzlib/trace
         scheme/contract
         net/url
         web-server/http/request-structs
         )

(define $pathinfo (make-parameter '()))

(define $request (make-parameter #f)) 

;; $uri
(define ($uri) 
  (request-uri ($request)))

(define ($method)
  (string->symbol 
   (string-downcase 
    (bytes->string/utf-8 (request-method ($request))))))

(define ($header key)
  (define (helper header)
    (if (not header) 
        header
        (cdr header)))
  (helper (assf (lambda (name)
                  (string-ci=? name key))
                ($headers))))

(define $headers (make-parameter '())) 

(define (convert-headers)
  (map (lambda (header)
         (cons (bytes->string/utf-8 (header-field header))
               (bytes->string/utf-8 (header-value header))))
       (request-headers/raw ($request))))

(define ($query* key) 
  (define (helper bindings)
    (map (lambda (b)
           (if (binding:form? b)
               (bytes->string/utf-8 (binding:form-value b))
               b))
         bindings))
  (helper (filter (lambda (binding)
                    (string-ci=? (bytes->string/utf-8 (binding-id binding))
                                 key))
                  (request-bindings/raw ($request)))))

(define ($query key)
  (let ((vals ($query* key)))
    (if (null? vals) #f
        (car vals))))

(provide/contract 
 ($pathinfo (parameter/c (listof string?)))
 ($request (parameter/c request?))
 ($uri (-> url?))
 ($headers (parameter/c (listof (cons/c string? string?))))
 ($header (-> string? (or/c #f bytes? string?)))
 ($query (-> string? (or/c #f string? binding?)))
 ($query* (-> string? (listof (or/c string? binding?))))
 ($method (-> symbol?))
 (convert-headers (-> (listof (cons/c string? string?))))
 )