response.scm
(module response mzscheme
  (provide (all-defined))
  
  (require (lib "kw.ss")
           (lib "private/response-structs.ss" "web-server")
           (lib "private/request-structs.ss" "web-server")
           "cookie.scm"
           "doctype.scm")
  
  (define current-response-code    (make-parameter 200))
  (define current-response-message (make-parameter "Okay"))
  (define current-response-seconds (make-parameter (current-seconds)))
  (define current-response-mime    (make-parameter (string->bytes/utf-8 "text/html")))
  (define current-response-extras  (make-parameter '()))
  ; (define current-response-body    (make-parameter #f))

  ; if one of the redirect parameters are assigned an url (as a string)
  ; then a redirect repsponse is sent
  (define current-redirect-permanently (make-parameter #f))  ; 301
  (define current-redirect-temporarily (make-parameter #f))  ; 302
  (define current-redirect-see-other   (make-parameter #f))  ; 303
  
  (define/kw (make-response 
              document #:key
              (code    (current-response-code))
              (message (current-response-message))
              (seconds (current-response-seconds))
              (mime    (current-response-mime)))
    
    (let* ([cookies 
            (map (lambda (c) (make-header #"Set-Cookie" (string->bytes/utf-8 c)))
                 (current-output-cookies))]
           [extras  
            (append cookies 
                    (current-response-extras))])
      
      #;(begin  ; uncomment when debugging
        (display (list (current-redirect-permanently)
                       (current-redirect-temporarily)
                       (current-redirect-see-other)))
        (newline))
      
      (cond
        [(or (current-redirect-permanently)
             (current-redirect-temporarily)
             (current-redirect-see-other))
         (let-values 
             ([(code message url)
               (cond
                 [(current-redirect-permanently) => (λ (url) (values 301 "Moved Permanently" url))]
                 [(current-redirect-temporarily) => (λ (url) (values 302 "Moved Temporarily" url))]
                 [(current-redirect-see-other)   => (λ (url) (values 303 "See Other"         url))])])
           (make-response/full code message seconds mime
                               (append (list (make-header #"Location" (string->bytes/utf-8 url)))
                                       #;(list (make-header #"Pragma" #"No-cache")
                                               (make-header #"Cache-Control" #"no-cache")
                                               (make-header #"Expires" #"Thu, 01 Jan 1970 00:00:00 GMT"))
                                       extras)
                               (list (current-doctype)
                                     document)))]
        [else
         ; normal response
         (make-response/full code message seconds mime 
                             (append #;(list (make-header #"Pragma" #"No-cache")
                                             (make-header #"Cache-Control" #"no-cache")
                                             (make-header #"Expires" #"Thu, 01 Jan 1970 00:00:00 GMT"))
                                     extras)
                             (list (current-doctype)
                                   document))])))
  )