Wednesday, August 12, 2009

Basic Environment Access - Response Helpers

Now we have simple way of accessing the request object, we also want to do the same with the response object.

Basically - we should be able to modify the outgoing status, headers, cookies, etc.

Below are the basic features we should have:

($status 'ok) ;; change the status to 200 OK
($content-type "text/html; charset=utf-8")
(header! "Content-Length" 120)

To do so, we'll have to create our own response object, rather than relying on web-server to convert xexpr into response object (we will need to do this anyways if we are ever going to support other type of output). And then we'll use parameters to hold the output value until we are ready to generate the response object.

The following handles status:

;; the list of http-status, code & text. this is internal and might change
(define http-status '((continue 100 "Continue")
(switching-protocols 101 "Switching Protocols")
(ok 200 "OK")
(created 201 "Created")
(accepted 202 "Accepted")
(non-authoritative-information 203 "Non-Authoritative Information")
(no-content 204 "No Content")
(reset-content 205 "Reset Content")
(partial-content 206 "Partial Content")
(multiple-choices 300 "Multiple Choices")
(moved-permanently 201 "Moved Permanently")
(found 302 "Found")
(see-other 303 "See Other")
(not-modified 304 "Not Modified")
(use-proxy 305 "Use Proxy")
(temporary-redirect 307 "Temporary Redirect")
(bad-request 400 "Bad Request")
(unauthorized 401 "Unauthorized")
(payment-required 402 "Payment Required")
(forbidden 403 "Forbidden")
(not-found 404 "Not Found")
(method-not-allowed 405 "Method Not Allowed")
(not-acceptable 406 "Not Acceptable")
(proxy-authentication-required 407 "Proxy Authentication Required")
(request-timeout 408 "Request Timeout")
(conflict 409 "Conflict")
(gone 410 "Gone")
(length-required 411 "Length Required")
(precondition-failed 412 "Precondition Failed")
(request-entity-too-large 413 "Request Entity Too Large")
(request-uri-too-long 414 "Request-URI Too Long")
(unsupported-media-type 415 "Unsupported Media Type")
(request-range-not-satisfied 416 "Requested Range Not Satisfiable")
(expectation-failed 417 "Expectation Failed")
(internal-server-error 500 "Internal Server Error")
(not-implemented 501 "Not Implemented")
(bad-gateway 502 "Bad Gateway")
(service-unavailable 503 "Service Unavailable")
(gateway-timeout 504 "Gateway Timeout")
(version-not-supported 505 "HTTP Version Not Supported")))

(define $status (make-parameter 'ok))

;; for testing to see whether the stauts is valid.
(define (valid-status? status)
(assoc status http-status))

;; convert the status into code
(define ($status->code)
(cadr (valid-status? ($status))))

;; convert the status into text
(define ($status->text)
(string->bytes/utf-8 (caddr (valid-status? ($status)))))

The following handles headers & special header such as content-type:

(define $content-type (make-parameter "text/html; charset=utf-8"))

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

(define (header! key val (replace? #t))
;; add the keyval to the headers!
($headers (cons (cons key val) ($headers))))

;; this function might require changes because response objects have kept changing
(define ($headers->headers)
(map (lambda (kv)
(make-header (string->bytes/utf-8 (car kv))
(string->bytes/utf-8 (cdr kv))))

And finally we convert the output and the parameters into a response object:

(define (make-response output)
(cond ((xexpr? output)
(make-response/full ($status->code)
(string->bytes/utf-8 ($content-type))
(xexpr->string output)))))))

(define (make-shp-handler path
#:default (default "index.shp")
#:not-found (not-found "notfound.shp"))
(lambda (request)
(parameterize (($pathinfo ($pathinfo))
($request request))
(let ((proc (evaluate-terms
(url->shp-path (request-uri request) path default not-found)))))
(make-response (proc request))))))

There might be other special headers such as last-modified, etag, and possibily doc-type that we'll add, but for now we have our basic response helpers.

No comments:

Post a Comment