From 56c111eccec42375343c231fb903b40e41e95c35 Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Thu, 29 Jan 2009 16:34:57 +0000 Subject: [PATCH] response/c svn: r13317 --- .../configuration-table-structs.ss | 16 +-- .../web-server/configuration/responders.ss | 22 ++-- .../htdocs/servlets/examples/response.ss | 3 + .../web-server/dispatchers/dispatch-lift.ss | 2 +- .../dispatchers/dispatch-passwords.ss | 2 +- .../dispatchers/dispatch-pathprocedure.ss | 2 +- .../dispatchers/dispatch-servlets.ss | 4 +- collects/web-server/formlets/servlet.ss | 2 +- collects/web-server/http/response-structs.ss | 4 +- collects/web-server/http/response.ss | 4 +- collects/web-server/insta/insta.ss | 4 +- collects/web-server/lang/abort-resume.ss | 2 +- collects/web-server/lang/web.ss | 10 +- collects/web-server/private/servlet.ss | 2 +- .../scribblings/configuration.scrbl | 38 +++--- .../web-server/scribblings/dispatchers.scrbl | 10 +- .../web-server/scribblings/formlets.scrbl | 2 +- collects/web-server/scribblings/http.scrbl | 14 +-- collects/web-server/scribblings/lang.scrbl | 6 +- .../web-server/scribblings/servlet-env.scrbl | 4 +- .../scribblings/servlet-setup.scrbl | 8 +- .../scribblings/stateless-servlet.scrbl | 2 +- .../scribblings/tutorial/continue.scrbl | 2 +- .../web-server/scribblings/v1-servlet.scrbl | 2 +- .../web-server/scribblings/v2-servlet.scrbl | 2 +- collects/web-server/scribblings/web.scrbl | 10 +- collects/web-server/scribblings/writing.scrbl | 4 +- collects/web-server/servlet-env.ss | 4 +- .../web-server/servlet/servlet-structs.ss | 4 +- collects/web-server/servlet/setup.ss | 110 +++++++++--------- collects/web-server/servlet/web.ss | 8 +- 31 files changed, 152 insertions(+), 157 deletions(-) create mode 100644 collects/web-server/default-web-root/htdocs/servlets/examples/response.ss diff --git a/collects/web-server/configuration/configuration-table-structs.ss b/collects/web-server/configuration/configuration-table-structs.ss index 552d0b1fec..18453e2931 100644 --- a/collects/web-server/configuration/configuration-table-structs.ss +++ b/collects/web-server/configuration/configuration-table-structs.ss @@ -49,14 +49,14 @@ [timeouts timeouts?] [paths paths?])] [struct responders - ([servlet (url? any/c . -> . response?)] - [servlet-loading (url? any/c . -> . response?)] - [authentication (url? header? . -> . response?)] - [servlets-refreshed (-> response?)] - [passwords-refreshed (-> response?)] - [file-not-found (request? . -> . response?)] - [protocol (url? . -> . response?)] - [collect-garbage (-> response?)])] + ([servlet (url? any/c . -> . response/c)] + [servlet-loading (url? any/c . -> . response/c)] + [authentication (url? header? . -> . response/c)] + [servlets-refreshed (-> response/c)] + [passwords-refreshed (-> response/c)] + [file-not-found (request? . -> . response/c)] + [protocol (url? . -> . response/c)] + [collect-garbage (-> response/c)])] [struct messages ([servlet string?] [authentication string?] diff --git a/collects/web-server/configuration/responders.ss b/collects/web-server/configuration/responders.ss index 9e6d247552..b59e6dc0e8 100644 --- a/collects/web-server/configuration/responders.ss +++ b/collects/web-server/configuration/responders.ss @@ -110,14 +110,14 @@ (lambda (in) (read-string (file-size path) in)))) (provide/contract - [file-response ((natural-number/c string? path-string?) (listof header?) . ->* . (response?))] - [servlet-loading-responder (url? exn? . -> . response?)] - [gen-servlet-not-found (path-string? . -> . (url? . -> . response?))] - [servlet-error-responder (url? exn? . -> . response?)] - [gen-servlet-responder (path-string? . -> . (url? exn? . -> . response?))] - [gen-servlets-refreshed (path-string? . -> . (-> response?))] - [gen-passwords-refreshed (path-string? . -> . (-> response?))] - [gen-authentication-responder (path-string? . -> . (url? header? . -> . response?))] - [gen-protocol-responder (path-string? . -> . (url? . -> . response?))] - [gen-file-not-found-responder (path-string? . -> . (request? . -> . response?))] - [gen-collect-garbage-responder (path-string? . -> . (-> response?))]) + [file-response ((natural-number/c string? path-string?) (listof header?) . ->* . (response/c))] + [servlet-loading-responder (url? exn? . -> . response/c)] + [gen-servlet-not-found (path-string? . -> . (url? . -> . response/c))] + [servlet-error-responder (url? exn? . -> . response/c)] + [gen-servlet-responder (path-string? . -> . (url? exn? . -> . response/c))] + [gen-servlets-refreshed (path-string? . -> . (-> response/c))] + [gen-passwords-refreshed (path-string? . -> . (-> response/c))] + [gen-authentication-responder (path-string? . -> . (url? header? . -> . response/c))] + [gen-protocol-responder (path-string? . -> . (url? . -> . response/c))] + [gen-file-not-found-responder (path-string? . -> . (request? . -> . response/c))] + [gen-collect-garbage-responder (path-string? . -> . (-> response/c))]) diff --git a/collects/web-server/default-web-root/htdocs/servlets/examples/response.ss b/collects/web-server/default-web-root/htdocs/servlets/examples/response.ss new file mode 100644 index 0000000000..107fec9673 --- /dev/null +++ b/collects/web-server/default-web-root/htdocs/servlets/examples/response.ss @@ -0,0 +1,3 @@ +`(html (head (title "Hello")) + (body ([bgcolor "white"]) + (p #f "Hello"))) diff --git a/collects/web-server/dispatchers/dispatch-lift.ss b/collects/web-server/dispatchers/dispatch-lift.ss index 2d7cd621ee..cb9b9c712a 100644 --- a/collects/web-server/dispatchers/dispatch-lift.ss +++ b/collects/web-server/dispatchers/dispatch-lift.ss @@ -5,7 +5,7 @@ web-server/http/response) (provide/contract [interface-version dispatcher-interface-version/c] - [make ((request? . -> . response?) . -> . dispatcher/c)]) + [make ((request? . -> . response/c) . -> . dispatcher/c)]) (define interface-version 'v1) (define ((make procedure) conn req) diff --git a/collects/web-server/dispatchers/dispatch-passwords.ss b/collects/web-server/dispatchers/dispatch-passwords.ss index e00c6df832..4524e8c4e1 100644 --- a/collects/web-server/dispatchers/dispatch-passwords.ss +++ b/collects/web-server/dispatchers/dispatch-passwords.ss @@ -16,7 +16,7 @@ [denied?/c contract?] [make (->* (denied?/c) (#:authentication-responder - (url? header? . -> . response?)) + (url? header? . -> . response/c)) dispatcher/c)] [authorized?/c contract?] [make-basic-denied?/path diff --git a/collects/web-server/dispatchers/dispatch-pathprocedure.ss b/collects/web-server/dispatchers/dispatch-pathprocedure.ss index 97f69f62a9..0f90354090 100644 --- a/collects/web-server/dispatchers/dispatch-pathprocedure.ss +++ b/collects/web-server/dispatchers/dispatch-pathprocedure.ss @@ -7,7 +7,7 @@ web-server/http/response) (provide/contract [interface-version dispatcher-interface-version/c] - [make (string? (request? . -> . response?) . -> . dispatcher/c)]) + [make (string? (request? . -> . response/c) . -> . dispatcher/c)]) (define interface-version 'v1) (define ((make the-path procedure) conn req) diff --git a/collects/web-server/dispatchers/dispatch-servlets.ss b/collects/web-server/dispatchers/dispatch-servlets.ss index 5add2d5958..5fa4b6aa9b 100644 --- a/collects/web-server/dispatchers/dispatch-servlets.ss +++ b/collects/web-server/dispatchers/dispatch-servlets.ss @@ -47,8 +47,8 @@ ; ----- (provide/contract [make (->* (url->servlet/c) - (#:responders-servlet-loading (url? any/c . -> . response?) - #:responders-servlet (url? any/c . -> . response?)) + (#:responders-servlet-loading (url? any/c . -> . response/c) + #:responders-servlet (url? any/c . -> . response/c)) dispatcher/c)]) (define (make url->servlet diff --git a/collects/web-server/formlets/servlet.ss b/collects/web-server/formlets/servlet.ss index ca67d25926..ef9b8fd882 100644 --- a/collects/web-server/formlets/servlet.ss +++ b/collects/web-server/formlets/servlet.ss @@ -5,7 +5,7 @@ (provide/contract [send/formlet (((formlet/c any/c)) - (#:wrap (xexpr/c . -> . response?)) + (#:wrap (xexpr/c . -> . response/c)) . ->* . any/c)]) (define (send/formlet f diff --git a/collects/web-server/http/response-structs.ss b/collects/web-server/http/response-structs.ss index 3d86689bed..7e63cfea2b 100644 --- a/collects/web-server/http/response-structs.ss +++ b/collects/web-server/http/response-structs.ss @@ -12,7 +12,7 @@ ; response = (cons string (listof string)), where the first string is a mime-type ; | x-expression ; | response/basic -(define response? +(define response/c (or/c response/basic? (listof (or/c string? bytes?)) xexpr/c)) @@ -39,5 +39,5 @@ [mime bytes?] [headers (listof header?)] [generator ((() (listof (or/c bytes? string?)) . ->* . any) . -> . any)])] - [response? contract?] + [response/c contract?] [TEXT/HTML-MIME-TYPE bytes?]) diff --git a/collects/web-server/http/response.ss b/collects/web-server/http/response.ss index e48de3f692..8cba77ad44 100644 --- a/collects/web-server/http/response.ss +++ b/collects/web-server/http/response.ss @@ -13,8 +13,8 @@ web-server/private/util) (provide/contract - [rename ext:output-response output-response (connection? response? . -> . void)] - [rename ext:output-response/method output-response/method (connection? response? symbol? . -> . void)] + [rename ext:output-response output-response (connection? response/c . -> . void)] + [rename ext:output-response/method output-response/method (connection? response/c symbol? . -> . void)] [rename ext:output-file output-file (connection? path-string? symbol? bytes? (or/c pair? false/c) . -> . void)]) ;; Table 1. head responses: diff --git a/collects/web-server/insta/insta.ss b/collects/web-server/insta/insta.ss index 6faaf7bec9..2dee1bc007 100644 --- a/collects/web-server/insta/insta.ss +++ b/collects/web-server/insta/insta.ss @@ -58,8 +58,8 @@ #'(body ...))]) (quasisyntax/loc stx (#,@expanded - (provide/contract (#,start (request? . -> . response?))) - (serve/servlet (contract (request? . -> . response?) #,start + (provide/contract (#,start (request? . -> . response/c))) + (serve/servlet (contract (request? . -> . response/c) #,start 'you 'web-server (list (make-srcloc #f #f #f #f #f) "start")) diff --git a/collects/web-server/lang/abort-resume.ss b/collects/web-server/lang/abort-resume.ss index ff57792b51..02c18313fa 100644 --- a/collects/web-server/lang/abort-resume.ss +++ b/collects/web-server/lang/abort-resume.ss @@ -154,7 +154,7 @@ ;; ********************************************************************** ;; ********************************************************************** -; These should really be from web-server/private, but it interferes with testing +; XXX These should really be from web-server/private, but it interferes with testing (define request? any/c) (define response? any/c) diff --git a/collects/web-server/lang/web.ss b/collects/web-server/lang/web.ss index 92af75a734..38e4baacb0 100644 --- a/collects/web-server/lang/web.ss +++ b/collects/web-server/lang/web.ss @@ -21,15 +21,15 @@ ; These contracts interfere with the continuation safety marks #;(provide/contract ;; Server Interface - [initialize-servlet ((request? . -> . response?) . -> . (request? . -> . response?))] + [initialize-servlet ((request? . -> . response/c) . -> . (request? . -> . response/c))] ;; Servlet Interface - [send/suspend/hidden ((url? list? . -> . response?) . -> . request?)] - [send/suspend/url ((url? . -> . response?) . -> . request?)] - [send/suspend/dispatch ((((request? . -> . any/c) . -> . url?) . -> . response?) + [send/suspend/hidden ((url? list? . -> . response/c) . -> . request?)] + [send/suspend/url ((url? . -> . response/c) . -> . request?)] + [send/suspend/dispatch ((((request? . -> . any/c) . -> . url?) . -> . response/c) . -> . any/c)]) -;; initial-servlet : (request -> response) -> (request -> response?) +;; initial-servlet : (request -> response) -> (request -> response/c) (define (initialize-servlet start) (let ([params (current-parameterization)]) (lambda (req0) diff --git a/collects/web-server/private/servlet.ss b/collects/web-server/private/servlet.ss index 74946f8111..0bf2a89792 100644 --- a/collects/web-server/private/servlet.ss +++ b/collects/web-server/private/servlet.ss @@ -22,7 +22,7 @@ [namespace namespace?] [manager manager?] [directory path-string?] - [handler (request? . -> . response?)])] + [handler (request? . -> . response/c)])] [struct execution-context ([request request?])] [current-servlet (parameter/c (or/c false/c servlet?))] diff --git a/collects/web-server/scribblings/configuration.scrbl b/collects/web-server/scribblings/configuration.scrbl index b3c0e8a6d7..43d576d1d3 100644 --- a/collects/web-server/scribblings/configuration.scrbl +++ b/collects/web-server/scribblings/configuration.scrbl @@ -48,14 +48,14 @@ the configuration table S-expression file format described in [paths paths?])] @defstruct[responders - ([servlet (url? any/c . -> . response?)] - [servlet-loading (url? any/c . -> . response?)] - [authentication (url? (cons/c symbol? string?) . -> . response?)] - [servlets-refreshed (-> response?)] - [passwords-refreshed (-> response?)] - [file-not-found (request? . -> . response?)] - [protocol (url? . -> . response?)] - [collect-garbage (-> response?)])] + ([servlet (url? any/c . -> . response/c)] + [servlet-loading (url? any/c . -> . response/c)] + [authentication (url? (cons/c symbol? string?) . -> . response/c)] + [servlets-refreshed (-> response/c)] + [passwords-refreshed (-> response/c)] + [file-not-found (request? . -> . response/c)] + [protocol (url? . -> . response/c)] + [collect-garbage (-> response/c)])] @defstruct[messages ([servlet string?] @@ -230,60 +230,60 @@ These functions are used by the default dispatcher constructor (see @secref["web turn the paths given in the @scheme[configuration-table] into responders for the associated circumstance. @defproc[(file-response (http-code natural-number/c) (short-version string?) (text-file string?) (header header?) ...) - response?]{ + response/c]{ Generates a @scheme[response/full] with the given @scheme[http-code] and @scheme[short-version] as the corresponding fields; with the content of the @scheme[text-file] as the body; and, with the @scheme[header]s as, you guessed it, headers. } @defproc[(servlet-loading-responder (url url?) (exn exn?)) - response?]{ + response/c]{ Gives @scheme[exn] to the @scheme[current-error-handler] and response with a stack trace and a "Servlet didn't load" message. } @defproc[(gen-servlet-not-found (file path-string?)) - ((url url?) . -> . response?)]{ + ((url url?) . -> . response/c)]{ Returns a function that generates a standard "Servlet not found." error with content from @scheme[file]. } @defproc[(servlet-error-responder (url url?) (exn exn?)) - response?]{ + response/c]{ Gives @scheme[exn] to the @scheme[current-error-handler] and response with a stack trace and a "Servlet error" message. } @defproc[(gen-servlet-responder (file path-string?)) - ((url url?) (exn any/c) . -> . response?)]{ + ((url url?) (exn any/c) . -> . response/c)]{ Prints the @scheme[exn] to standard output and responds with a "Servlet error." message with content from @scheme[file]. } @defproc[(gen-servlets-refreshed (file path-string?)) - (-> response?)]{ + (-> response/c)]{ Returns a function that generates a standard "Servlet cache refreshed." message with content from @scheme[file]. } @defproc[(gen-passwords-refreshed (file path-string?)) - (-> response?)]{ + (-> response/c)]{ Returns a function that generates a standard "Passwords refreshed." message with content from @scheme[file]. } @defproc[(gen-authentication-responder (file path-string?)) - ((url url?) (header header?) . -> . response?)]{ + ((url url?) (header header?) . -> . response/c)]{ Returns a function that generates an authentication failure error with content from @scheme[file] and @scheme[header] as the HTTP header. } @defproc[(gen-protocol-responder (file path-string?)) - ((url url?) . -> . response?)]{ + ((url url?) . -> . response/c)]{ Returns a function that generates a "Malformed request" error with content from @scheme[file]. } @defproc[(gen-file-not-found-responder (file path-string?)) - ((req request?) . -> . response?)]{ + ((req request?) . -> . response/c)]{ Returns a function that generates a standard "File not found" error with content from @scheme[file]. } @defproc[(gen-collect-garbage-responder (file path-string?)) - (-> response?)]{ + (-> response/c)]{ Returns a function that generates a standard "Garbage collection run" message with content from @scheme[file]. } diff --git a/collects/web-server/scribblings/dispatchers.scrbl b/collects/web-server/scribblings/dispatchers.scrbl index 85f9281ce4..eac8aab29a 100644 --- a/collects/web-server/scribblings/dispatchers.scrbl +++ b/collects/web-server/scribblings/dispatchers.scrbl @@ -158,7 +158,7 @@ URLs to paths on the filesystem. @a-dispatcher[web-server/dispatchers/dispatch-lift @elem{defines a dispatcher constructor.}]{ -@defproc[(make (proc (request? . -> . response?))) +@defproc[(make (proc (request? . -> . response/c))) dispatcher/c]{ Constructs a dispatcher that calls @scheme[proc] on the request object, and outputs the response to the connection. @@ -184,7 +184,7 @@ URLs to paths on the filesystem. for invoking a particular procedure when a request is given to a particular URL path.}]{ -@defproc[(make (path string?) (proc (request? . -> . response?))) +@defproc[(make (path string?) (proc (request? . -> . response/c))) dispatcher/c]{ Checks if the request URL path as a string is equal to @scheme[path] and if so, calls @scheme[proc] for a response. @@ -274,7 +274,7 @@ a URL that refreshes the password file, servlet cache, etc.} @defproc[(make [denied? denied?/c] [#:authentication-responder authentication-responder - (url? header? . -> . response?) + (url? header? . -> . response/c) (gen-authentication-responder "forbidden.html")]) dispatcher/c]{ A dispatcher that checks if the request is denied based on @scheme[denied?]. If so, then @@ -363,11 +363,11 @@ a URL that refreshes the password file, servlet cache, etc.} @defproc[(make [url->servlet url->servlet/c] [#:responders-servlet-loading responders-servlet-loading - (url? exn? . -> . response?) + (url? exn? . -> . response/c) servlet-loading-responder] [#:responders-servlet responders-servlet - (url? exn? . -> . response?) + (url? exn? . -> . response/c) servlet-error-responder]) dispatcher/c]{ This dispatcher runs Scheme servlets, using @scheme[url->servlet] to resolve URLs to the underlying servlets. diff --git a/collects/web-server/scribblings/formlets.scrbl b/collects/web-server/scribblings/formlets.scrbl index 6008340381..3a448992ea 100644 --- a/collects/web-server/scribblings/formlets.scrbl +++ b/collects/web-server/scribblings/formlets.scrbl @@ -228,7 +228,7 @@ A few utilities are provided for using @tech{formlet}s in Web applications. @defproc[(send/formlet [f (formlet/c any/c)] [#:wrap wrapper - (xexpr/c . -> . response?) + (xexpr/c . -> . response/c) (lambda (form-xexpr) `(html (head (title "Form Entry")) (body ,form-xexpr)))]) diff --git a/collects/web-server/scribblings/http.scrbl b/collects/web-server/scribblings/http.scrbl index b7badd8c37..a2877bd46b 100644 --- a/collects/web-server/scribblings/http.scrbl +++ b/collects/web-server/scribblings/http.scrbl @@ -218,14 +218,10 @@ Here is an example typical of what you will find in many applications: ] } -@defproc[(response? [v any/c]) - boolean?]{ - Checks if @scheme[v] is a valid response. A response is either: - @itemize[ - @item{A @scheme[response/basic] structure.} - @item{A value matching the contract @scheme[(cons/c (or/c bytes? string?) (listof (or/c bytes? string?)))].} - @item{A value matching @scheme[xexpr?].} - ] +@defthing[response/c contract?]{ + Equivalent to @scheme[(or/c response/basic? + (listof (or/c string? bytes?)) + xexpr/c)]. } @defthing[TEXT/HTML-MIME-TYPE bytes?]{Equivalent to @scheme[#"text/html; charset=utf-8"].} @@ -244,7 +240,7 @@ transmission that the server @bold{will not catch}.} @defproc[(redirect-to [uri string?] [perm/temp redirection-status? temporarily] [#:headers headers (listof header?) (list)]) - response?]{ + response/c]{ Generates an HTTP response that redirects the browser to @scheme[uri], while including the @scheme[headers] in the response. diff --git a/collects/web-server/scribblings/lang.scrbl b/collects/web-server/scribblings/lang.scrbl index f885f92c95..35a9cdedc8 100644 --- a/collects/web-server/scribblings/lang.scrbl +++ b/collects/web-server/scribblings/lang.scrbl @@ -26,7 +26,7 @@ @(require (for-label web-server/lang/web)) @defmodule[web-server/lang/web]{ -@defproc[(send/suspend/url [response-generator (url? . -> . response?)]) +@defproc[(send/suspend/url [response-generator (url? . -> . response/c)]) request?]{ Captures the current continuation. Serializes it and stuffs it into a URL. Calls @scheme[response-generator] with this URL and delivers @@ -34,7 +34,7 @@ the request is returned to this continuation. } -@defproc[(send/suspend/hidden [response-generator (url? xexpr/c . -> . response?)]) +@defproc[(send/suspend/hidden [response-generator (url? xexpr/c . -> . response/c)]) request?]{ Captures the current continuation. Serializes it and generates an INPUT form that includes the serialization as a hidden form. @@ -46,7 +46,7 @@ Note: The continuation is NOT stuffed. } -@defproc[(send/suspend/dispatch [make-response (embed/url/c . -> . response?)]) +@defproc[(send/suspend/dispatch [make-response (embed/url/c . -> . response/c)]) any/c]{ Calls @scheme[make-response] with a function that, when called with a procedure from @scheme[request?] to @scheme[any/c] will generate a URL, that when invoked will call diff --git a/collects/web-server/scribblings/servlet-env.scrbl b/collects/web-server/scribblings/servlet-env.scrbl index b81235977e..016765d201 100644 --- a/collects/web-server/scribblings/servlet-env.scrbl +++ b/collects/web-server/scribblings/servlet-env.scrbl @@ -80,7 +80,7 @@ If you want to use @scheme[serve/servlet] in a start up script for a Web server, #:command-line? #t) ] -@defproc[(serve/servlet [start (request? . -> . response?)] +@defproc[(serve/servlet [start (request? . -> . response/c)] [#:command-line? command-line? boolean? #f] [#:launch-browser? launch-browser? boolean? (not command-line?)] [#:quit? quit? boolean? (not command-line?)] @@ -103,7 +103,7 @@ If you want to use @scheme[serve/servlet] in a start up script for a Web server, [#: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?) + (request? . -> . response/c) (gen-file-not-found-responder (build-path server-root-path diff --git a/collects/web-server/scribblings/servlet-setup.scrbl b/collects/web-server/scribblings/servlet-setup.scrbl index 796042c500..29fc803973 100644 --- a/collects/web-server/scribblings/servlet-setup.scrbl +++ b/collects/web-server/scribblings/servlet-setup.scrbl @@ -14,20 +14,20 @@ 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?)]) + [start (request? . -> . response/c)]) servlet?]{ Creates a version 1 servlet that uses @scheme[directory] as its current directory, a timeout manager with a @scheme[timeout] timeout, and @scheme[start] as the request handler. } @defproc[(make-v2.servlet [directory path-string?] [manager manager?] - [start (request? . -> . response?)]) + [start (request? . -> . response/c)]) servlet?]{ Creates a version 2 servlet that uses @scheme[directory] as its current directory, a @scheme[manager] as the continuation manager, and @scheme[start] as the request handler. } @defproc[(make-stateless.servlet [directory path-string?] - [start (request? . -> . response?)]) + [start (request? . -> . response/c)]) servlet?]{ Creates a stateless @schememodname[web-server] servlet that uses @scheme[directory] as its current directory and @scheme[start] as the request handler. } @@ -63,7 +63,7 @@ Equivalent to @scheme[(path? . -> . servlet?)]. [namespace namespace?] [manager manager?] [directory path-string?] - [handler (request? . -> . response?)]) + [handler (request? . -> . response/c)]) #:mutable]{ Instances of this structure hold the necessary parts of a servlet: the @scheme[custodian] responsible for the servlet's resources, diff --git a/collects/web-server/scribblings/stateless-servlet.scrbl b/collects/web-server/scribblings/stateless-servlet.scrbl index 48ea187dfb..7d13446bd0 100644 --- a/collects/web-server/scribblings/stateless-servlet.scrbl +++ b/collects/web-server/scribblings/stateless-servlet.scrbl @@ -12,7 +12,7 @@ } @defproc[(start [initial-request request?]) - response?]{ + response/c]{ This function is called when an instance of this servlet is started. The argument is the HTTP request that initiated the instance. } diff --git a/collects/web-server/scribblings/tutorial/continue.scrbl b/collects/web-server/scribblings/tutorial/continue.scrbl index f8a0619234..b12e27822b 100644 --- a/collects/web-server/scribblings/tutorial/continue.scrbl +++ b/collects/web-server/scribblings/tutorial/continue.scrbl @@ -1140,7 +1140,7 @@ to scheme (require web-server/servlet) -(provide/contract (start (request? . -> . response?))) +(provide/contract (start (request? . -> . response/c))) ] Second, add the following at the bottom of your application: diff --git a/collects/web-server/scribblings/v1-servlet.scrbl b/collects/web-server/scribblings/v1-servlet.scrbl index de6a4b0324..fb2e4a1f9c 100644 --- a/collects/web-server/scribblings/v1-servlet.scrbl +++ b/collects/web-server/scribblings/v1-servlet.scrbl @@ -18,7 +18,7 @@ } @defproc[(start [initial-request request?]) - response?]{ + response/c]{ This function is called when an instance of this servlet is started. The argument is the HTTP request that initiated the instance. } diff --git a/collects/web-server/scribblings/v2-servlet.scrbl b/collects/web-server/scribblings/v2-servlet.scrbl index 85fe21b9b6..53cbb2617e 100644 --- a/collects/web-server/scribblings/v2-servlet.scrbl +++ b/collects/web-server/scribblings/v2-servlet.scrbl @@ -16,7 +16,7 @@ } @defproc[(start [initial-request request?]) - response?]{ + response/c]{ This function is called when an instance of this servlet is started. The argument is the HTTP request that initiated the instance. } diff --git a/collects/web-server/scribblings/web.scrbl b/collects/web-server/scribblings/web.scrbl index 3ac07a421e..4c71fc6a22 100644 --- a/collects/web-server/scribblings/web.scrbl +++ b/collects/web-server/scribblings/web.scrbl @@ -10,7 +10,7 @@ @schememodname[web-server/servlet/web] library provides the primary functions of interest for the servlet developer. -@defproc[(send/back [response response?]) +@defproc[(send/back [response response/c]) void?]{ Sends @scheme[response] to the client. No continuation is captured, so the servlet is done. @@ -30,7 +30,7 @@ functions of interest for the servlet developer. request?]{ Captures the current continuation, stores it with @scheme[exp] as the expiration handler, and binds it to a URL. @scheme[make-response] is called with this URL and - is expected to generate a @scheme[response?], which is sent to the client. If the + is expected to generate a @scheme[response/c], 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 @scheme[send/suspend]. @@ -50,7 +50,7 @@ functions of interest for the servlet developer. Thus, the request will be ``returned'' from @scheme[send/suspend] to the continuation of this call. } -@defproc[(send/suspend/dispatch [make-response (embed/url/c . -> . response?)]) +@defproc[(send/suspend/dispatch [make-response (embed/url/c . -> . response/c)]) any/c]{ Calls @scheme[make-response] with a function (@scheme[embed/url]) that, when called with a procedure from @scheme[request?] to @scheme[any/c] will generate a URL, that when invoked will call @@ -119,7 +119,7 @@ functions of interest for the servlet developer. Use this if the user can logically go `forward' in your application, but cannot go backward. } -@defproc[(send/finish [response response?]) +@defproc[(send/finish [response response/c]) void?]{ Calls @scheme[clear-continuation-table!], then @scheme[send/back]. @@ -166,7 +166,7 @@ functions of interest for the servlet developer. captured continuations. } -@defproc[(with-errors-to-browser [send/finish-or-back (response? . -> . request?)] +@defproc[(with-errors-to-browser [send/finish-or-back (response/c . -> . request?)] [thunk (-> any)]) any]{ Calls @scheme[thunk] with an exception handler that generates an HTML error page diff --git a/collects/web-server/scribblings/writing.scrbl b/collects/web-server/scribblings/writing.scrbl index 57baa51dc2..1aea366cc3 100644 --- a/collects/web-server/scribblings/writing.scrbl +++ b/collects/web-server/scribblings/writing.scrbl @@ -56,7 +56,7 @@ Equivalent to @scheme[string?]. Example: @scheme["http://localhost:8080/servlets;1*1*20131636/examples/add.ss"]} @defthing[response-generator/c contract?]{ -Equivalent to @scheme[(k-url? . -> . response?)]. +Equivalent to @scheme[(k-url? . -> . response/c)]. Example: @schemeblock[(lambda (k-url) `(html @@ -66,7 +66,7 @@ Example: @schemeblock[(lambda (k-url) } @defthing[expiration-handler/c contract?]{ -Equivalent to @scheme[(or/c false/c (request? . -> . response?))]. +Equivalent to @scheme[(or/c false/c (request? . -> . response/c))]. Example: @schemeblock[(lambda (req) `(html (head (title "Expired")) diff --git a/collects/web-server/servlet-env.ss b/collects/web-server/servlet-env.ss index c1242ae121..46b514abea 100644 --- a/collects/web-server/servlet-env.ss +++ b/collects/web-server/servlet-env.ss @@ -42,7 +42,7 @@ (p "Return to DrScheme."))))))) (provide/contract - [serve/servlet (((request? . -> . response?)) + [serve/servlet (((request? . -> . response/c)) (#:command-line? boolean? #:launch-browser? boolean? #:quit? boolean? @@ -57,7 +57,7 @@ #:extra-files-paths (listof path-string?) #:servlets-root path-string? #:servlet-current-directory path-string? - #:file-not-found-responder (request? . -> . response?) + #:file-not-found-responder (request? . -> . response/c) #:mime-types-path path-string? #:servlet-path string? #:servlet-regexp regexp? diff --git a/collects/web-server/servlet/servlet-structs.ss b/collects/web-server/servlet/servlet-structs.ss index 92794e95f7..bfee8945f8 100644 --- a/collects/web-server/servlet/servlet-structs.ss +++ b/collects/web-server/servlet/servlet-structs.ss @@ -6,11 +6,11 @@ string?) (define response-generator/c - (k-url? . -> . response?)) + (k-url? . -> . response/c)) (define expiration-handler/c (or/c false/c - (request? . -> . response?))) + (request? . -> . response/c))) (define embed/url/c (((request? . -> . any/c)) (expiration-handler/c) . ->* . string?)) diff --git a/collects/web-server/servlet/setup.ss b/collects/web-server/servlet/setup.ss index a028d4e68b..5abbf79433 100644 --- a/collects/web-server/servlet/setup.ss +++ b/collects/web-server/servlet/setup.ss @@ -23,13 +23,8 @@ path->servlet/c)]) (define (v0.response->v1.lambda response response-path) - (define go - (box - (lambda () - (set-box! go (lambda () (load/use-compiled response-path))) - response))) (lambda (initial-request) - ((unbox go)))) + response)) (define (make-v1.servlet directory timeout start) (make-v2.servlet @@ -97,9 +92,9 @@ servlet-module-specs lang-module-specs)) (provide/contract - [make-v1.servlet (path-string? integer? (request? . -> . response?) . -> . servlet?)] - [make-v2.servlet (path-string? manager? (request? . -> . response?) . -> . servlet?)] - [make-stateless.servlet (path-string? (request? . -> . response?) . -> . servlet?)] + [make-v1.servlet (path-string? integer? (request? . -> . response/c) . -> . servlet?)] + [make-v2.servlet (path-string? manager? (request? . -> . response/c) . -> . servlet?)] + [make-stateless.servlet (path-string? (request? . -> . response/c) . -> . servlet?)] [default-module-specs (listof module-path?)]) (define (make-default-path->servlet #:make-servlet-namespace [make-servlet-namespace (make-make-servlet-namespace)] @@ -109,53 +104,54 @@ #:additional-specs default-module-specs)] [current-custodian (make-servlet-custodian)]) - (define s (load/use-compiled a-path)) - (cond - [(void? s) - (let* ([path-string (path->string a-path)] - [path-sym (string->symbol path-string)] - [neg-blame 'web-server] - [pos-blame path-sym] - [module-name `(file ,path-string)] - [mk-loc - (lambda (name) - (list (make-srcloc a-path #f #f #f #f) - name))] - [version - (contract (symbols 'v1 'v2 'stateless) - (dynamic-require module-name 'interface-version) - pos-blame neg-blame - (mk-loc "interface-version"))]) - (case version - [(v1) - (let ([timeout (contract number? - (dynamic-require module-name 'timeout) + (let* ([path-string (path->string a-path)] + [path-sym (string->symbol path-string)] + [neg-blame 'web-server] + [pos-blame path-sym] + [module-name `(file ,path-string)] + [mk-loc + (lambda (name) + (list (make-srcloc a-path #f #f #f #f) + name))] + [s (load/use-compiled a-path)]) + (cond + [(void? s) + (let ([version + (contract (symbols 'v1 'v2 'stateless) + (dynamic-require module-name 'interface-version) + pos-blame neg-blame + (mk-loc "interface-version"))]) + (case version + [(v1) + (let ([timeout (contract number? + (dynamic-require module-name 'timeout) + pos-blame neg-blame + (mk-loc "timeout"))] + [start (contract (request? . -> . response/c) + (dynamic-require module-name 'start) pos-blame neg-blame - (mk-loc "timeout"))] - [start (contract (request? . -> . response?) - (dynamic-require module-name 'start) - pos-blame neg-blame - (mk-loc "start"))]) - (make-v1.servlet (directory-part a-path) timeout start))] - [(v2) - (let ([start (contract (request? . -> . response?) - (dynamic-require module-name 'start) - pos-blame neg-blame - (mk-loc "start"))] - [manager (contract manager? - (dynamic-require module-name 'manager) + (mk-loc "start"))]) + (make-v1.servlet (directory-part a-path) timeout start))] + [(v2) + (let ([start (contract (request? . -> . response/c) + (dynamic-require module-name 'start) pos-blame neg-blame - (mk-loc "manager"))]) - (make-v2.servlet (directory-part a-path) manager start))] - [(stateless) - (let ([start (contract (request? . -> . response?) - (dynamic-require module-name 'start) - pos-blame neg-blame - (mk-loc "start"))]) - (make-stateless.servlet (directory-part a-path) start))]))] - [(response? s) - (make-v1.servlet (directory-part a-path) timeouts-default-servlet - (v0.response->v1.lambda s a-path))] - [else - (error 'path->servlet - "Loading ~e produced ~n~e~n instead of either (1) a response or (2) nothing and exports 'interface-version" a-path s)])))) + (mk-loc "start"))] + [manager (contract manager? + (dynamic-require module-name 'manager) + pos-blame neg-blame + (mk-loc "manager"))]) + (make-v2.servlet (directory-part a-path) manager start))] + [(stateless) + (let ([start (contract (request? . -> . response/c) + (dynamic-require module-name 'start) + pos-blame neg-blame + (mk-loc "start"))]) + (make-stateless.servlet (directory-part a-path) start))]))] + [else + (make-v1.servlet (directory-part a-path) timeouts-default-servlet + (v0.response->v1.lambda + (contract response/c s + pos-blame neg-blame + (mk-loc path-string)) + a-path))]))))) diff --git a/collects/web-server/servlet/web.ss b/collects/web-server/servlet/web.ss index 979957a573..16a1a7687c 100644 --- a/collects/web-server/servlet/web.ss +++ b/collects/web-server/servlet/web.ss @@ -40,11 +40,11 @@ [redirect/get/forget (-> request?)] [adjust-timeout! (number? . -> . void?)] [clear-continuation-table! (-> void?)] - [send/back (response? . -> . void?)] - [send/finish (response? . -> . void?)] + [send/back (response/c . -> . void?)] + [send/finish (response/c . -> . void?)] [send/suspend ((response-generator/c) (expiration-handler/c) . ->* . request?)] [send/forward ((response-generator/c) (expiration-handler/c) . ->* . request?)] - [send/suspend/dispatch ((embed/url/c . -> . response?) . -> . any/c)]) + [send/suspend/dispatch ((embed/url/c . -> . response/c) . -> . any/c)]) ;; ************************************************************ ;; EXPORTS @@ -146,7 +146,7 @@ (provide/contract [with-errors-to-browser - ((response? . -> . request?) + ((response/c . -> . request?) (-> any) . -> . any)])