Big bang coercion

collects/tests/web-server/pr/compat0.rkt

@@ -3,4 +3,6 @@
          web-server/http/response-structs
          web-server/compat/0/http/response-structs
          web-server/http/cookie
-         web-server/compat/0/http/cookie)
+         web-server/compat/0/http/cookie
+         web-server/servlet/servlet-structs
+         web-server/compat/0/servlet/servlet-structs)

collects/web-server/compat/0/README

@@ -1,19 +1,22 @@
 In Racket 5.0.99.4 and before, the Web Server supported implicit
 conversion of X-expressions and lists with the format (cons/c bytes? (listof (or/c string? bytes?))) into response data structures for output.
 
-After 5.0.99.4, this implicit conversion has been generalized into current-response/c and response/c. In the process, implicit conversion has been completely removed from some internal plumbing AND the response structures have been streamlined---primarily for efficiency.
+After 5.0.99.4, this implicit conversion has been generalized into any->response. In the process, implicit conversion has been completely removed from some internal plumbing AND the response structures have been streamlined---primarily for efficiency.
 
 This document describes the incompatible changes and how to restore the old behavior when that is possible.
 
 --- Coercion behavior ---
 
 The old coercion behavior will be dynamically introduced by requiring
-web-server/compat/0/coerce or parameterizing current-response/c to
+web-server/compat/0/coerce or running:
-(coerce/c normalize-response) after requiring
-web-server/compat/0/http/response-structs.
 
-Since Xexpr conversion is so convenient, xexpr-response/c is now
+(require web-server/compat/0/http/response-structs)
-provided by http/xexpr for use with current-response/c.
+(set-any->response! normalize-response)
+
+Users may want to allow implicit X-expression conversion by
+running
+
+(set-any->response! response/xexpr)
 
 --- New response structures ---
 
@@ -71,9 +74,19 @@ that the wrapper returns an Xexpr. This changes is justified in that
 formlets already bake in support for Xexpr as a fundamental part of
 their syntax.
 
-
 --- Removed contracts ---
 
+web-server/compat/0/servlet/servlet-structs
+
+is a replacement for the old
+
+web-server/servlet/servlet-structs
+
+because 
+
 k-url?
 response-generator/c
 expiration-handler/c
+
+are now removed. (This change is to ensure that internal uses of these
+have can-be-response? close to where they are used so any->response can be called appropriately.)

collects/web-server/compat/0/coerce.rkt

@@ -1,6 +1,4 @@
 #lang racket/base
-(require unstable/contract
+(require "http/response-structs.rkt"
-         "http/response-structs.rkt"
          web-server/servlet/servlet-structs)
-
+(set-any->response! normalize-response)
-(current-response/c (coerce/c normalize-response))

collects/web-server/compat/0/servlet/servlet-structs.rkt

@@ -1,29 +1,21 @@
 #lang racket/base
 (require racket/contract
-         unstable/contract
          web-server/http)  
 
-(define current-response/c
-  (make-parameter any/c))
-(define response/c
-  (dynamic/c any/c current-response/c response?))
-
 (define k-url?
   string?)
 
 (define response-generator/c
-  (k-url? . -> . response/c))
+  (k-url? . -> . can-be-response?))
 
 (define expiration-handler/c
   (or/c false/c
-        (request? . -> . response/c)))
+        (request? . -> . can-be-response?)))
 
 (define embed/url/c
   ((request? . -> . any) . -> . string?))
 
 (provide/contract
- [current-response/c (parameter/c contract?)]
- [response/c contract?]
  [response-generator/c contract?]
  [k-url? contract?]
  [expiration-handler/c contract?]

collects/web-server/dispatch/serve.rkt

@@ -9,4 +9,4 @@
                  #:servlet-regexp #rx""))
 
 (provide/contract
- [serve/dispatch ((request? . -> . response/c) . -> . void)])
+ [serve/dispatch ((request? . -> . can-be-response?) . -> . void)])

collects/web-server/dispatchers/dispatch-servlets.rkt

@@ -48,8 +48,8 @@
 ; -----
 (provide/contract
  [make (->* (url->servlet/c)
-            (#:responders-servlet-loading (url? any/c . -> . response/c)
+            (#:responders-servlet-loading (url? any/c . -> . can-be-response?)
-                                          #:responders-servlet (url? any/c . -> . response/c))
+                                          #:responders-servlet (url? any/c . -> . can-be-response?))
             dispatcher/c)])
 
 (define (make url->servlet
@@ -64,7 +64,7 @@
                     (lambda _
                       (kill-connection! conn)
                       (custodian-shutdown-all instance-custodian))])
-      (define response
+      (define maybe-response
         (with-handlers ([exn:fail:filesystem:exists?
                          (lambda (the-exn) (next-dispatcher))]
                         [exn:dispatcher? raise]
@@ -85,4 +85,4 @@
                     ((servlet-handler the-servlet) req))
                   servlet-prompt)))))))
       
-      (output-response conn response))))
+      (output-response conn (any->response maybe-response)))))

collects/web-server/http/xexpr.rkt

@@ -3,22 +3,10 @@
          racket/list
          xml
          web-server/private/xexpr
-         unstable/contract
          "request-structs.rkt"
          "cookie.rkt"
          "response-structs.rkt")
 
-(define xexpr-response/c
-  (coerce/c
-   (λ (x)
-     (cond
-       [(response? x)
-        x]
-       [(xexpr? x)
-        (response/xexpr x)]
-       [else
-        #f]))))
-
 (define (response/xexpr
          xexpr
          #:code [code 200] 
@@ -37,7 +25,6 @@
      (write-xexpr xexpr out))))
 
 (provide/contract
- [xexpr-response/c contract?]
  [response/xexpr 
   ((pretty-xexpr/c)
    (#:code number? #:message bytes? #:seconds number? #:mime-type bytes? #:headers (listof header?) #:preamble bytes?)

collects/web-server/insta/insta.rkt

@@ -58,8 +58,8 @@
                                      #'(body ...))])
        (quasisyntax/loc stx
          (#,@expanded
-          (provide/contract (#,start (request? . -> . response/c)))
+          (provide/contract (#,start (request? . -> . can-be-response?)))
-          (serve/servlet (contract (request? . -> . response/c) #,start
+          (serve/servlet (contract (request? . -> . can-be-response?) #,start
                                    'you 'web-server
                                    "start"
                                    #f)

collects/web-server/lang/web.rkt

@@ -27,25 +27,25 @@
 
 (provide/contract
  [make-stateless-servlet
-  (custodian? namespace? manager? path-string? (request? . -> . response/c)
+  (custodian? namespace? manager? path-string? (request? . -> . can-be-response?)
               (stuffer/c serializable? bytes?) . -> . stateless-servlet?)])
 
 ; These contracts interfere with the continuation safety marks
 #;(provide/contract
    ;; Server Interface
-   [initialize-servlet ((request? . -> . response/c) . -> . (request? . -> . response/c))]
+   [initialize-servlet ((request? . -> . can-be-response?) . -> . (request? . -> . can-be-response?))]
    
    ;; Servlet Interface
-   [send/suspend ((string? . -> . response/c) . -> . request?)]
+   [send/suspend ((string? . -> . can-be-response?) . -> . request?)]
-   [send/suspend/dispatch ((((request? . -> . any/c) . -> . string?) . -> . response/c)
+   [send/suspend/dispatch ((((request? . -> . any/c) . -> . string?) . -> . can-be-response?)
                            . -> . any/c)]
-   [send/suspend/hidden ((url? list? . -> . response/c) . -> . request?)]
+   [send/suspend/hidden ((url? list? . -> . can-be-response?) . -> . request?)]
-   [send/suspend/url ((url? . -> . response/c) . -> . request?)]
+   [send/suspend/url ((url? . -> . can-be-response?) . -> . request?)]
-   [send/suspend/url/dispatch ((((request? . -> . any/c) . -> . url?) . -> . response/c)
+   [send/suspend/url/dispatch ((((request? . -> . any/c) . -> . url?) . -> . can-be-response?)
                                . -> . any/c)]
    [redirect/get (-> request?)])
 
-;; initial-servlet : (request -> response) -> (request -> response/c)
+;; initial-servlet : (request -> response) -> (request -> can-be-response?)
 (define (initialize-servlet start)
   (let ([params (current-parameterization)])
     (lambda (req0)

collects/web-server/managers/lru.rkt

@@ -7,7 +7,7 @@
  [create-LRU-manager 
   (->
    (or/c false/c
-         (request? . -> . response/c))
+         (request? . -> . can-be-response?))
    number? number? (-> boolean?)
    #:initial-count number?
    #:inform-p (number? . -> . void)
@@ -15,7 +15,7 @@
  [make-threshold-LRU-manager 
   (-> 
    (or/c false/c
-         (request? . -> . response/c))
+         (request? . -> . can-be-response?))
    number?
    manager?)])
 

collects/web-server/managers/manager.rkt

@@ -1,6 +1,7 @@
 #lang racket/base
-(require racket/contract)
+(require racket/contract
-(require web-server/servlet/servlet-structs)
+         web-server/http
+         web-server/servlet/servlet-structs)
 
 (define-struct manager (create-instance 
                         adjust-timeout!
@@ -20,7 +21,7 @@
                    (->
                     number? any/c 
                     (or/c false/c
-                          (request? . -> . response/c))
+                          (request? . -> . can-be-response?))
                     (list/c number? number?))]
                   [continuation-lookup (number? number? number? . -> . any/c)]
                   [continuation-peek (number? number? number? . -> . any/c)])]
@@ -29,10 +30,10 @@
           [continuation-marks continuation-mark-set?]
           [expiration-handler 
            (or/c false/c
-                 (request? . -> . response/c))])]
+                 (request? . -> . can-be-response?))])]
  [struct (exn:fail:servlet-manager:no-continuation exn:fail)
          ([message string?]
           [continuation-marks continuation-mark-set?]
           [expiration-handler 
            (or/c false/c
-                 (request? . -> . response/c))])])
+                 (request? . -> . can-be-response?))])])

collects/web-server/managers/none.rkt

@@ -6,7 +6,7 @@
  [create-none-manager
   (-> 
    (or/c false/c
-         (request? . -> . response/c))
+         (request? . -> . can-be-response?))
    manager?)])
 
 (define-struct (none-manager manager) (instance-expiration-handler))

collects/web-server/managers/timeouts.rkt

@@ -8,7 +8,7 @@
  [create-timeout-manager 
   (->
    (or/c false/c
-         (request? . -> . response/c))
+         (request? . -> . can-be-response?))
    number? number? 
    manager?)])
 

collects/web-server/private/servlet.rkt

@@ -22,7 +22,7 @@
           [namespace namespace?]
           [manager manager?]
           [directory path-string?]
-          [handler (request? . -> . response/c)])]
+          [handler (request? . -> . can-be-response?)])]
  [struct execution-context 
          ([request request?])]
  [current-servlet (parameter/c (or/c false/c servlet?))]

collects/web-server/scribblings/contracts.scrbl

@@ -1,25 +1,42 @@
 #lang scribble/doc
 @(require "web-server.rkt")
 
-@title[#:tag "servlet-structs"]{Common Contracts}
+@title[#:tag "servlet-structs"]{Responses}
 @(require (for-label web-server/servlet/servlet-structs
                      web-server/http
                      web-server/servlet))
 
 @defmodule[web-server/servlet/servlet-structs]{
+                                               
+Servlets communicate to the Web Server by returning HTTP responses. In order to
+accomodate lightweight programs (and backwards compatibility), the Web Server
+provides an indirection from application-specific response formats and the internal
+HTTP response format, @racket[response].
 
-This module provides a number of contracts
+@deftogether[[
-for use in servlets.
+@defthing[(can-be-response? [x any/c])
+          boolean?]
+@defproc[(any->response [x any/c])
+         (or/c false/c response?)]
+@defproc[(set-any->response! [new-any->response (-> any/c (or/c false/c response?))])
+         void]
+]]{
 
-@defparam[current-response/c ctc contract?]{
+   @racket[any->response] coerces any value into a response or returns @racket[#f] if coercion is not possible.
-The contract used by @racket[response/c] dynamically. Defaults to @racket[any/c].
+   @racket[any->response] guarantees that any @racket[response?] input must always be returned exactly (i.e. @racket[eq?].)
+   
+   @racket[can-be-response?] returns @racket[#t] if @racket[x] is a response or can be turned into a response by calling
+   @racket[any->response].
+   
+   Users of @racket[any->response] should protect themselves by using @racket[can-be-response?] as a contract.
+   If they do so, they can safely ignore the @racket[#f] return case of @racket[any->response].
+   
+   @racket[set-any->response!] replaces the global @racket[any->response] with the supplied argument. This
+   function should return the same value for @racket[eq?] inputs to ensure that @racket[can-be-response?] is
+   any accurate predicate. Similarly, this function should be cheap to call multiple times on the same input,
+   since it will be used in contract checking as well as coercion before transmission. You may want to use a
+   weak @racket[eq?]-based hash-table to cache the results for this purpose. (See @racket[make-weak-hasheq].)
+   
 }
 
-@defthing[response/c contract?]{
-A contract corresponding to @racket[(dynamic/c any/c current-response/c response?)].
-                            
-This allows Web applications to customize the Web Server's handling of responses, while ensuring that the Web Server
-always receives @racket[response?] structures.
-}                           
-
 }

collects/web-server/scribblings/dispatch-servlets.scrbl

@@ -28,11 +28,11 @@
 @defproc[(make [url->servlet url->servlet/c]
                [#:responders-servlet-loading
                 responders-servlet-loading
-                (url? exn? . -> . response/c)
+                (url? exn? . -> . can-be-response?)
                 servlet-loading-responder]
                [#:responders-servlet
                 responders-servlet
-                (url? exn? . -> . response/c)
+                (url? exn? . -> . can-be-response?)
                 servlet-error-responder])
          dispatcher/c]{
  This dispatcher runs racket servlets, using @racket[url->servlet] to resolve URLs to the underlying servlets.
@@ -53,7 +53,7 @@
                      [namespace namespace?]
                      [manager manager?]
                      [directory path-string?]
-                     [handler (request? . -> . response/c)])
+                     [handler (request? . -> . can-be-response?)])
                     #:mutable]{
   Instances of this structure hold the necessary parts of a servlet:
   the @racket[custodian] responsible for the servlet's resources,

collects/web-server/scribblings/dispatch.scrbl

@@ -105,9 +105,9 @@ After mastering the world of blogging software, you decide to put the ubiquitous
            [dispatch-pattern dispatch-fun]
            ...)]
          #:contracts
-         ([else-fun (request? . -> . response/c)]
+         ([else-fun (request? . -> . any)]
-          [dispatch-fun (request? any/c ... . -> . response/c)])]{
+          [dispatch-fun (request? any/c ... . -> . any)])]{
- Returns two values: the first is a dispatching function with the contract @racket[(request? . -> . response/c)]
+ Returns two values: the first is a dispatching function with the contract @racket[(request? . -> . any)]
  that calls the appropriate @racket[dispatch-fun] based on the first @racket[dispatch-pattern] that matches the
  request's URL; the second is a URL-generating function with the contract @racket[(procedure? any/c ... . -> . string?)]
  that generates a URL using @racket[dispatch-pattern] for the @racket[dispatch-fun] given as its first argument.
@@ -131,8 +131,8 @@ After mastering the world of blogging software, you decide to put the ubiquitous
            [dispatch-pattern dispatch-fun]
            ...)]
          #:contracts
-         ([else-fun (request? . -> . response/c)]
+         ([else-fun (request? . -> . any)]
-          [dispatch-fun (request? any/c ... . -> . response/c)])]{
+          [dispatch-fun (request? any/c ... . -> . any)])]{
  Like @racket[dispatch-rules], except returns a third value with the contract @racket[(request? . -> . boolean?)] that returns
       @racket[#t] if the dispatching rules apply to the request and @racket[#f] otherwise.
       }
@@ -146,8 +146,8 @@ After mastering the world of blogging software, you decide to put the ubiquitous
            [dispatch-pattern dispatch-fun]
            ...)]
          #:contracts
-         ([else-fun (request? . -> . response/c)]
+         ([else-fun (request? . -> . any)]
-          [dispatch-fun (request? any/c ... . -> . response/c)])]{
+          [dispatch-fun (request? any/c ... . -> . any)])]{
  Returns a dispatching function as described by @racket[dispatch-rules].
 }
 
@@ -156,11 +156,11 @@ After mastering the world of blogging software, you decide to put the ubiquitous
           [dispatch-pattern dispatch-fun]
           ...)
          #:contracts
-         ([dispatch-fun (request? any/c ... . -> . response/c)])]{
+         ([dispatch-fun (request? any/c ... . -> . any)])]{
  Returns a URL-generating function as described by @racket[dispatch-rules].
 }
 
-@defproc[(serve/dispatch [dispatch (request? . -> . response/c)])
+@defproc[(serve/dispatch [dispatch (request? . -> . can-be-response?)])
          void]{
  Calls @racket[serve/servlet] with a @racket[#:servlet-regexp] argument (@racket[#rx""]) so that every request is handled by @racket[dispatch].
 }

collects/web-server/scribblings/http.scrbl

@@ -323,7 +323,7 @@ transmission that the server @bold{will not catch}.}
 @defproc[(redirect-to [uri non-empty-string/c]
                       [perm/temp redirection-status? temporarily]
                       [#:headers headers (listof header?) (list)])
-         response/c]{
+         response?]{
  Generates an HTTP response that redirects the browser to @racket[uri],
  while including the @racket[headers] in the response.
  
@@ -472,11 +472,6 @@ web-server/insta
 
 @defmodule[web-server/http/xexpr]{
                                   
-@defthing[xexpr-response/c contract?]{
-A contract for use with @racket[current-response/c] that coerces
-X-expressions into @racket[response?] structures using @racket[response/xexpr]
-and passes @racket[response?] structures untouched.}
-
 @defproc[(response/xexpr [xexpr xexpr/c]
                          [#:code code number? 200]
                          [#:message message bytes? #"Okay"]
@@ -492,6 +487,9 @@ and passes @racket[response?] structures untouched.}
   code message seconds mime-type 
   (append headers (map cookie->header cookies))
   (list preamble (string->bytes/utf-8 (xexpr->string xexpr))))
- ]}
+ ]
+ 
+ This is a viable function to pass to @racket[set-any->response!].
+ }
 
 }

collects/web-server/scribblings/managers.scrbl

@@ -25,7 +25,7 @@ the users and implementers of managers.
                     [clear-continuations! (number? . -> . void)]
                     [continuation-store! (number? any/c 
                                                   (or/c false/c
-                                                        (request? . -> . response/c))
+                                                        (request? . -> . can-be-response?))
                                                   . -> . (list/c number? number?))]
                     [continuation-lookup (number? number? number? . -> . any/c)]
                     [continuation-peek (number? number? number? . -> . any/c)])]{
@@ -56,7 +56,7 @@ the users and implementers of managers.
 @defstruct[(exn:fail:servlet-manager:no-instance exn:fail)
            ([expiration-handler 
              (or/c false/c
-                   (request? . -> . response/c))])]{
+                   (request? . -> . can-be-response?))])]{
  This exception should be thrown by a manager when an instance is looked
  up that does not exist.
 }
@@ -64,7 +64,7 @@ the users and implementers of managers.
 @defstruct[(exn:fail:servlet-manager:no-continuation exn:fail)
            ([expiration-handler 
              (or/c false/c
-                   (request? . -> . response/c))])]{
+                   (request? . -> . can-be-response?))])]{
  This exception should be thrown by a manager when a continuation is
  looked up that does not exist.
 }
@@ -82,7 +82,7 @@ This module defines a manager constructor:
 @defproc[(create-none-manager 
           (instance-expiration-handler 
            (or/c false/c
-                 (request? . -> . response/c))))
+                 (request? . -> . can-be-response?))))
          manager?]{
  This manager does not actually store any continuation or instance data.
  You could use it if you know your servlet does not use the continuation
@@ -110,7 +110,7 @@ This module defines a manager constructor:
 @defproc[(create-timeout-manager 
           [instance-exp-handler 
            (or/c false/c
-                 (request? . -> . response/c))]
+                 (request? . -> . can-be-response?))]
           [instance-timeout number?]
           [continuation-timeout number?])
          manager?]{
@@ -145,7 +145,7 @@ This module defines a manager constructor:
 @defproc[(create-LRU-manager
           [instance-expiration-handler 
            (or/c false/c
-                 (request? . -> . response/c))]
+                 (request? . -> . can-be-response?))]
           [check-interval integer?]
           [collect-interval integer?]
           [collect? (-> boolean?)]
@@ -180,7 +180,7 @@ The recommended usage of this manager is codified as the following function:
 @defproc[(make-threshold-LRU-manager 
           [instance-expiration-handler 
            (or/c false/c
-                 (request? . -> . response/c))]
+                 (request? . -> . can-be-response?))]
           [memory-threshold number?])
          manager?]{
  This creates an LRU manager with the following behavior:

collects/web-server/scribblings/servlet-env.scrbl

@@ -128,7 +128,7 @@ Like always, you don't even need to save the file.
 
 @section{Full API}
 
-@defproc[(serve/servlet [start (request? . -> . response/c)]
+@defproc[(serve/servlet [start (request? . -> . can-be-response?)]
                         [#:command-line? command-line? boolean? #f]
                         [#:connection-close? connection-close? boolean? #f]
                         [#:launch-browser? launch-browser? boolean? (not command-line?)]
@@ -152,7 +152,7 @@ Like always, you don't even need to save the file.
                         [#:servlets-root servlets-root path-string? (build-path server-root-path "htdocs")]
                         [#:servlet-current-directory servlet-current-directory path-string? servlets-root]
                         [#:file-not-found-responder file-not-found-responder
-                                                    (request? . -> . response/c)
+                                                    (request? . -> . can-be-response?)
                                                     (gen-file-not-found-responder 
                                                      (build-path
                                                       server-root-path

collects/web-server/scribblings/servlet-setup.scrbl

@@ -16,14 +16,14 @@ This module is used internally to build and load servlets. It may be useful to t
 
 @defproc[(make-v1.servlet [directory path-string?]
                           [timeout integer?]
-                          [start (request? . -> . response/c)])
+                          [start (request? . -> . can-be-response?)])
          servlet?]{
  Creates a version 1 servlet that uses @racket[directory] as its current directory, a timeout manager with a @racket[timeout] timeout, and @racket[start] as the request handler.
 }
 
 @defproc[(make-v2.servlet [directory path-string?]
                           [manager manager?]
-                          [start (request? . -> . response/c)])
+                          [start (request? . -> . can-be-response?)])
          servlet?]{
  Creates a version 2 servlet that uses @racket[directory] as its current directory, a @racket[manager] as the continuation manager, and @racket[start] as the request handler.
 }
@@ -31,7 +31,7 @@ This module is used internally to build and load servlets. It may be useful to t
 @defproc[(make-stateless.servlet [directory path-string?]
                                  [stuffer (stuffer/c serializable? bytes?)]
                                  [manager manager?]
-                                 [start (request? . -> . response/c)])
+                                 [start (request? . -> . can-be-response?)])
          servlet?]{
  Creates a stateless @racketmodname[web-server] servlet that uses @racket[directory] as its current directory, @racket[stuffer] as its stuffer, and @racket[manager] as the continuation manager, and @racket[start] as the request handler.
 }

collects/web-server/scribblings/servlet.scrbl

@@ -23,7 +23,7 @@ A stateful servlet should @racket[provide] the following exports:
 }
 
 @defproc[(start [initial-request request?])
-         response/c]{
+         can-be-response?]{
  This function is called when an instance of this servlet is started.
  The argument is the HTTP request that initiated the instance.
 }

collects/web-server/scribblings/web.scrbl

@@ -12,7 +12,7 @@
 @racketmodname[web-server/servlet/web] library provides the primary
 functions of interest for the servlet developer.
 
-@defproc[(send/back [response response/c])
+@defproc[(send/back [response can-be-response?])
          void?]{
  Sends @racket[response] to the client. No continuation is captured, so the servlet is done.
        
@@ -28,11 +28,11 @@ functions of interest for the servlet developer.
  ]
 }
 
-@defproc[(send/suspend [make-response (string? . -> . response/c)])
+@defproc[(send/suspend [make-response (string? . -> . can-be-response?)])
          request?]{
  Captures the current continuation, stores it with @racket[exp] as the expiration
  handler, and binds it to a URL. @racket[make-response] is called with this URL and
- is expected to generate a @racket[response/c], which is sent to the client. If the
+ is expected to generate a @racket[can-be-response?], which is sent to the client. If the
  continuation URL is invoked, the captured continuation is invoked and the request is
  returned from this call to @racket[send/suspend].
  
@@ -53,12 +53,12 @@ functions of interest for the servlet developer.
  Thus, the request will be ``returned'' from @racket[send/suspend] to the continuation of this call.
 }
                   
-@defproc[(send/suspend/url [make-response (url? . -> . response/c)])
+@defproc[(send/suspend/url [make-response (url? . -> . can-be-response?)])
          request?]{
  Like @racket[send/suspend] but with a URL struct.
 }
                   
-@defproc[(send/suspend/dispatch [make-response (((request? . -> . any) . -> . string?) . -> . response/c)])
+@defproc[(send/suspend/dispatch [make-response (((request? . -> . any) . -> . string?) . -> . can-be-response?)])
          any]{
  Calls @racket[make-response] with a function (@racket[embed/url]) that, when called with a procedure from
  @racket[request?] to @racket[any/c] will generate a URL, that when invoked will call
@@ -121,19 +121,19 @@ functions of interest for the servlet developer.
   ]
 }
              
-@defproc[(send/suspend/url/dispatch [make-response (((request? . -> . any) . -> . url?) . -> . response/c)])
+@defproc[(send/suspend/url/dispatch [make-response (((request? . -> . any) . -> . url?) . -> . can-be-response?)])
          any]{
  Like @racket[send/suspend/dispatch], but with a URL struct.
 }
 
-@defproc[(send/forward [make-response (string? . -> . response/c)])
+@defproc[(send/forward [make-response (string? . -> . can-be-response?)])
          request?]{
  Calls @racket[clear-continuation-table!], then @racket[send/suspend].
        
  Use this if the user can logically go `forward' in your application, but cannot go backward.
 }
 
-@defproc[(send/finish [response response/c])
+@defproc[(send/finish [response can-be-response?])
          void?]{
  Calls @racket[clear-continuation-table!], then @racket[send/back].
        
@@ -162,7 +162,7 @@ functions of interest for the servlet developer.
                   
 @defthing[current-servlet-continuation-expiration-handler 
           (parameter/c (or/c false/c
-                             (request? . -> . response/c)))]{
+                             (request? . -> . can-be-response?)))]{
  Holds the expiration handler to be used when a continuation
  captured in this context is expired, then looked up.
  
@@ -184,7 +184,7 @@ functions of interest for the servlet developer.
  captured continuations.
 }
                
-@defproc[(with-errors-to-browser [send/finish-or-back (response/c . -> . request?)]
+@defproc[(with-errors-to-browser [send/finish-or-back (can-be-response? . -> . request?)]
                                  [thunk (-> any)])
          any]{
  Calls @racket[thunk] with an exception handler that generates an HTML error page

collects/web-server/servlet-dispatch.rkt

@@ -26,7 +26,7 @@
 (define send-url (make-parameter net:send-url))
 
 (provide/contract
- [dispatch/servlet (((request? . -> . response/c))
+ [dispatch/servlet (((request? . -> . can-be-response?))
                     (#:regexp regexp?
                               #:current-directory path-string?
                               #:stateless? boolean?

collects/web-server/servlet-env.rkt

@@ -39,7 +39,7 @@
         "web-server/default-web-root"))
 
 (provide/contract
- [serve/servlet (((request? . -> . response/c))
+ [serve/servlet (((request? . -> . can-be-response?))
                  (#:connection-close? boolean?
                   #:command-line? boolean?
                   #:launch-browser? boolean?
@@ -58,7 +58,7 @@
                   #:extra-files-paths (listof path-string?)
                   #:servlets-root path-string?
                   #:servlet-current-directory path-string?
-                  #:file-not-found-responder (request? . -> . response/c)
+                  #:file-not-found-responder (request? . -> . can-be-response?)
                   #:mime-types-path path-string?
                   #:servlet-path string?
                   #:servlet-regexp regexp?
@@ -173,7 +173,7 @@
       #:url->path (fsmap:make-url->path (build-path server-root-path "htdocs"))
       #:path->mime-type (make-path->mime-type mime-types-path)
       #:indices (list "index.html" "index.htm"))
-     (lift:make file-not-found-responder)))
+     (lift:make (compose any->response file-not-found-responder))))
   (serve/launch/wait
    dispatcher  
    #:connection-close? connection-close?

collects/web-server/servlet/servlet-structs.rkt

@@ -1,13 +1,24 @@
 #lang racket/base
 (require racket/contract
-         unstable/contract
          web-server/http)  
 
-(define current-response/c
+(define (real-any->response x)
-  (make-parameter any/c))
+  #f)
-(define response/c
+
-  (dynamic/c any/c current-response/c response?))
+(define (any->response x)
+  (if (response? x)
+      x
+      (real-any->response x)))
+
+(define (set-any->response! f)
+  (set! real-any->response f))
+
+(define (can-be-response? x)
+  (or (response? x)
+      (and (any->response x)
+           #t)))
 
 (provide/contract
- [current-response/c (parameter/c contract?)]
+ [any->response (-> any/c (or/c false/c response?))]
- [response/c contract?])
+ [set-any->response! (-> (-> any/c (or/c false/c response?)) void)]
+ [can-be-response? (-> any/c boolean?)])

collects/web-server/servlet/setup.rkt

@@ -112,9 +112,9 @@
           servlet-module-specs
           lang-module-specs))
 (provide/contract
- [make-v1.servlet (path-string? integer? (request? . -> . response/c) . -> . servlet?)]
+ [make-v1.servlet (path-string? integer? (request? . -> . can-be-response?) . -> . servlet?)]
- [make-v2.servlet (path-string? manager? (request? . -> . response/c) . -> . servlet?)]
+ [make-v2.servlet (path-string? manager? (request? . -> . can-be-response?) . -> . servlet?)]
- [make-stateless.servlet (path-string? (stuffer/c serializable? bytes?) manager? (request? . -> . response/c) . -> . servlet?)]
+ [make-stateless.servlet (path-string? (stuffer/c serializable? bytes?) manager? (request? . -> . can-be-response?) . -> . servlet?)]
  [default-module-specs (listof (or/c resolved-module-path? module-path?))])
 
 (define (make-default-path->servlet #:make-servlet-namespace [make-servlet-namespace (make-make-servlet-namespace)]
@@ -144,13 +144,13 @@
                                          (dynamic-require module-name 'timeout)
                                          pos-blame neg-blame
                                          "timeout" loc)]
-                      [start (contract (request? . -> . response/c)
+                      [start (contract (request? . -> . can-be-response?)
                                        (dynamic-require module-name 'start)
                                        pos-blame neg-blame
                                        "start" loc)])
                   (make-v1.servlet (directory-part a-path) timeout start))]
                [(v2)
-                (let ([start (contract (request? . -> . response/c)
+                (let ([start (contract (request? . -> . can-be-response?)
                                        (dynamic-require module-name 'start)
                                        pos-blame neg-blame
                                        "start" loc)]
@@ -160,7 +160,7 @@
                                          "manager" loc)])
                   (make-v2.servlet (directory-part a-path) manager start))]
                [(stateless)
-                (let ([start (contract (request? . -> . response/c)
+                (let ([start (contract (request? . -> . can-be-response?)
                                        (dynamic-require module-name 'start)
                                        pos-blame neg-blame
                                        "start" loc)]
@@ -177,7 +177,7 @@
           [else
            (make-v1.servlet (directory-part a-path) timeouts-default-servlet
                             (v0.response->v1.lambda 
-                             (contract response/c (response/xexpr s)
+                             (contract response? (response/xexpr s)
                                        pos-blame neg-blame
                                        path-string loc)
                              a-path))])))))

collects/web-server/servlet/web.rkt

@@ -39,18 +39,18 @@
  [current-servlet-continuation-expiration-handler 
   (parameter/c 
    (or/c false/c
-         (request? . -> . response/c)))]
+         (request? . -> . can-be-response?)))]
  [redirect/get (() (#:headers (listof header?)) . ->* . request?)]
  [redirect/get/forget (() (#:headers (listof header?)) . ->* . request?)]
  [adjust-timeout! (number? . -> . void?)]
  [clear-continuation-table! (-> void?)]
- [send/back (response/c . -> . void?)]
+ [send/back (can-be-response? . -> . void?)]
- [send/finish (response/c . -> . void?)]
+ [send/finish (can-be-response? . -> . void?)]
- [send/forward ((string? . -> . response/c) . -> . request?)]
+ [send/forward ((string? . -> . can-be-response?) . -> . request?)]
- [send/suspend ((string? . -> . response/c) . -> . request?)]
+ [send/suspend ((string? . -> . can-be-response?) . -> . request?)]
- [send/suspend/dispatch ((((request? . -> . any) . -> . string?) . -> . response/c) . -> . any/c)]
+ [send/suspend/dispatch ((((request? . -> . any) . -> . string?) . -> . can-be-response?) . -> . any/c)]
- [send/suspend/url ((url? . -> . response/c) . -> . request?)]
+ [send/suspend/url ((url? . -> . can-be-response?) . -> . request?)]
- [send/suspend/url/dispatch ((((request? . -> . any/c) . -> . url?) . -> . response/c) . -> . any/c)])
+ [send/suspend/url/dispatch ((((request? . -> . any/c) . -> . url?) . -> . can-be-response?) . -> . any/c)])
 
 ;; ************************************************************
 ;; EXPORTS
@@ -151,17 +151,20 @@
 (define redirect/get/forget (make-redirect/get send/forward))
 
 (define (with-errors-to-browser send/finish-or-back thunk)
-  (with-handlers ([exn:fail? (lambda (exn)
+  (with-handlers 
-                          (send/finish-or-back
+      ([exn:fail?
-                           `(html (head (title "Servlet Error"))
+        (lambda (exn)
-                                  (body ([bgcolor "white"])
+          (send/finish-or-back
-                                        (p "The following error occured: "
+           (response/xexpr
-                                           (pre ,(exn->string exn)))))))])
+            `(html (head (title "Servlet Error"))
+                   (body ([bgcolor "white"])
+                         (p "The following error occured: "
+                            (pre ,(exn->string exn))))))))])
     (thunk)))
 
 (provide/contract
  [with-errors-to-browser
-  ((response/c . -> . request?)
+  ((can-be-response? . -> . request?)
    (-> any)
    . -> .
    any)])