Wednesday, August 19, 2009

Continuing of HTTP Call & Proxy Integration (4) - Customize Responses

If you are doing AJAX you know that the XMLHttpRequest object is quite brittle - different browsers offer different behaviors and bugs. One such bug is that IE does not properly the more complicated cousins of text/xml, such as application/atom+xml. In such situations it would be nice to have the proxy customizing the response before it is passed back to the browser.

The simplest way of accomplishing conversion of content-type is to take an keyword parameter:

(define (proxy! (url ($pathinfo)) (headers ($headers))
#:content-type (content-type (lambda (x) x)))
(define (helper url headers)
(raise
(http-client-response->response
(case ($method)
((post) (http-post url (request-post-data/raw ($request)) headers))
((get) (http-get url headers))
(else (error 'proxy "proxy method ~a not supported" ($method))))
content-type)))
(call-with-values
(lambda ()
(normalize-url+headers url headers))
helper))

This means we should also modify http-client-response->response:

(define (http-client-response->response r content-type)
(define (get-content-type r)
(define (helper header)
(string->bytes/utf-8
(content-type (if (not header)
"text/html; charset=utf-8"
(cdr header)))))

(helper (assf (lambda (key)
(string-ci=? key "content-type"))
(http-client-response-headers r))))
(define (normalize-headers r)
(map (lambda (kv)
(make-header (string->bytes/utf-8 (car kv))
(string->bytes/utf-8 (cdr kv))))
(http-client-response-headers r)))
(define (make-generator)
(lambda (output)
(let loop ((b (read-bytes 4096 r)))
(cond ((eof-object? b)
(void))
(else
(output b)
(loop (read-bytes 4095 r)))))))
(make-response/incremental (http-client-response-code r)
(string->bytes/utf-8 (http-client-response-reason r))
(current-seconds)
(get-content-type r)
(normalize-headers r)
(make-generator)))

And now our proxy can be customized if we want to filter out extended XML headers:

;; proxy.shp
(proxy! #:content-type
(lambda (ct)
(if (regexp-match #px"^application/.+xml.*$" ct)
"text/xml"
ct)))

No comments:

Post a Comment