#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.
;; the http-request object is not an "optimized" structure, i.e. it doesn't allow for the access to
;; the specific values quickly, which should probably have been done...
;; and the usage of loading is a bit different, of course - it is loaded
;; yc 8/13/2009 - first version
;; yc 7/7/2010 - converted $headers and $queries into parameters, and change $header $query $query* accordingly
;;             - make $query to return content (from bzlib/mime) instead of binding:file
(require mzlib/trace
         scheme/contract
         net/url
         web-server/http/request-structs
         net/uri-codec
         "depend.ss"
         )

(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 $queries (make-parameter '())) 

;; load the queries...
;;
(define (convert-queries) 
  (define (url-query-helper kv) 
    (cons (symbol->string (car kv)) 
          (cdr kv)))
  (define (helper b)
    (cons (bytes->string/utf-8 (binding-id b))
          (if (binding:form? b) 
              (bytes->string/utf-8 (binding:form-value b)) 
              (binding:file->content b))))
  (let ((bindings (request-bindings/raw ($request))))
    (if (null? bindings) 
        (map url-query-helper (url-query (request-uri ($request))))
        (map helper bindings))))

(define (binding:file->content b) 
  (build-content #:filename (binding:file-filename b) 
                 #:headers (binding:file-headers b)
                 (binding:file-content b)))
  
(define ($query* key) 
  (map cdr (filter (lambda (kv) 
                     (string-ci=? (car kv) key)) 
                   ($queries))))

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

(define ($post/raw) 
  (request-post-data/raw ($request)))

(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?))))
 ;; ($queries (-> (listof (cons/c string? (or/c string? content?)))))
 ($queries (parameter/c (listof any/c)))
 ($method (-> symbol?))
 (convert-headers (-> (listof (cons/c string? string?))))
 (convert-queries (-> (listof any/c)))
 ($post/raw (-> (or/c false/c bytes?)))
 )


;; this needs to be moved out to bzlib/net sometime...
(define (url-path/string u) 
  (define (helper lst)
    (string-join (cons "" lst) "/"))
  (helper (map path/param-path (url-path u))))

(provide url-path/string)