diff --git a/collects/web-server/dispatch/serve.rkt b/collects/web-server/dispatch/serve.rkt index d2be52e102..bca00bbd9a 100644 --- a/collects/web-server/dispatch/serve.rkt +++ b/collects/web-server/dispatch/serve.rkt @@ -1,5 +1,6 @@ #lang racket (require web-server/servlet-env + web-server/servlet/servlet-structs web-server/http) (define (serve/dispatch dispatch) @@ -8,4 +9,4 @@ #:servlet-regexp #rx"")) (provide/contract - [serve/dispatch ((request? . -> . response?) . -> . void)]) + [serve/dispatch ((request? . -> . response/c) . -> . void)]) diff --git a/collects/web-server/dispatchers/dispatch-servlets.rkt b/collects/web-server/dispatchers/dispatch-servlets.rkt index 0e31a86bc7..9abd035983 100644 --- a/collects/web-server/dispatchers/dispatch-servlets.rkt +++ b/collects/web-server/dispatchers/dispatch-servlets.rkt @@ -1,6 +1,7 @@ #lang racket/base (require racket/contract) (require web-server/servlet/setup + web-server/servlet/servlet-structs web-server/managers/manager web-server/http web-server/http/response @@ -47,8 +48,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/http/xexpr.rkt b/collects/web-server/http/xexpr.rkt index 7778804899..b1c1de288a 100644 --- a/collects/web-server/http/xexpr.rkt +++ b/collects/web-server/http/xexpr.rkt @@ -3,10 +3,22 @@ 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] @@ -25,7 +37,8 @@ (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?) - . ->* . response?)]) \ No newline at end of file + . ->* . response?)]) diff --git a/collects/web-server/insta/insta.rkt b/collects/web-server/insta/insta.rkt index a02b568f2c..c145d8320b 100644 --- a/collects/web-server/insta/insta.rkt +++ b/collects/web-server/insta/insta.rkt @@ -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 "start" #f) diff --git a/collects/web-server/lang/web.rkt b/collects/web-server/lang/web.rkt index 9d82fe9b06..88b967b260 100644 --- a/collects/web-server/lang/web.rkt +++ b/collects/web-server/lang/web.rkt @@ -2,6 +2,7 @@ (require net/url racket/contract racket/serialize + web-server/servlet/servlet-structs web-server/http web-server/managers/manager web-server/private/define-closure @@ -26,22 +27,22 @@ (provide/contract [make-stateless-servlet - (custodian? namespace? manager? path-string? (request? . -> . response?) + (custodian? namespace? manager? path-string? (request? . -> . response/c) (stuffer/c serializable? bytes?) . -> . stateless-servlet?)]) ; 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/url/dispatch ((((request? . -> . any/c) . -> . url?) . -> . response?) + [send/suspend/hidden ((url? list? . -> . response/c) . -> . request?)] + [send/suspend/url ((url? . -> . response/c) . -> . request?)] + [send/suspend/url/dispatch ((((request? . -> . any/c) . -> . url?) . -> . response/c) . -> . any/c)] [redirect/get (-> request?)]) -;; 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.rkt b/collects/web-server/private/servlet.rkt index a6613f4d7a..8432cedaa5 100644 --- a/collects/web-server/private/servlet.rkt +++ b/collects/web-server/private/servlet.rkt @@ -1,6 +1,7 @@ #lang racket/base (require racket/contract) -(require web-server/managers/manager +(require web-server/servlet/servlet-structs + web-server/managers/manager web-server/http) (define servlet-prompt (make-continuation-prompt-tag 'servlet)) @@ -21,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/servlet-dispatch.rkt b/collects/web-server/servlet-dispatch.rkt index 3db5963919..5ec2dd9cb5 100644 --- a/collects/web-server/servlet-dispatch.rkt +++ b/collects/web-server/servlet-dispatch.rkt @@ -18,6 +18,7 @@ web-server/http web-server/stuffers web-server/servlet/setup + web-server/servlet/servlet-structs web-server/dispatchers/dispatch (prefix-in filter: web-server/dispatchers/dispatch-filter) (prefix-in servlets: web-server/dispatchers/dispatch-servlets)) @@ -25,7 +26,7 @@ (define send-url (make-parameter net:send-url)) (provide/contract - [dispatch/servlet (((request? . -> . response?)) + [dispatch/servlet (((request? . -> . response/c)) (#:regexp regexp? #:current-directory path-string? #:stateless? boolean? diff --git a/collects/web-server/servlet-env.rkt b/collects/web-server/servlet-env.rkt index d6a2dadd39..49d2a08025 100644 --- a/collects/web-server/servlet-env.rkt +++ b/collects/web-server/servlet-env.rkt @@ -13,6 +13,7 @@ web-server/configuration/responders web-server/private/mime-types web-server/servlet/setup + web-server/servlet/servlet-structs web-server/servlet-dispatch unstable/contract (prefix-in lift: web-server/dispatchers/dispatch-lift) @@ -38,7 +39,7 @@ "web-server/default-web-root")) (provide/contract - [serve/servlet (((request? . -> . response?)) + [serve/servlet (((request? . -> . response/c)) (#:connection-close? boolean? #:command-line? boolean? #:launch-browser? boolean? @@ -57,7 +58,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.rkt b/collects/web-server/servlet/servlet-structs.rkt index 3e1d0ee3b4..98327a3a88 100644 --- a/collects/web-server/servlet/servlet-structs.rkt +++ b/collects/web-server/servlet/servlet-structs.rkt @@ -1,22 +1,30 @@ #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?)) + (k-url? . -> . response/c)) (define expiration-handler/c (or/c false/c - (request? . -> . response?))) + (request? . -> . response/c))) (define embed/url/c - ((request? . -> . any/c) . -> . string?)) + ((request? . -> . any) . -> . string?)) (provide/contract + [current-response/c (parameter/c contract?)] + [response/c contract?] [response-generator/c contract?] - [k-url? (any/c . -> . boolean?)] + [k-url? contract?] [expiration-handler/c contract?] [embed/url/c contract?]) diff --git a/collects/web-server/servlet/setup.rkt b/collects/web-server/servlet/setup.rkt index 767e53473e..70ba8298be 100644 --- a/collects/web-server/servlet/setup.rkt +++ b/collects/web-server/servlet/setup.rkt @@ -11,6 +11,7 @@ web-server/http web-server/servlet/web web-server/configuration/namespace + web-server/servlet/servlet-structs web-server/private/web-server-structs web-server/private/servlet web-server/private/util) @@ -111,9 +112,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? (stuffer/c serializable? bytes?) manager? (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? (stuffer/c serializable? bytes?) manager? (request? . -> . response/c) . -> . 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)] @@ -143,13 +144,13 @@ (dynamic-require module-name 'timeout) pos-blame neg-blame "timeout" loc)] - [start (contract (request? . -> . response?) + [start (contract (request? . -> . response/c) (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?) + (let ([start (contract (request? . -> . response/c) (dynamic-require module-name 'start) pos-blame neg-blame "start" loc)] @@ -159,7 +160,7 @@ "manager" loc)]) (make-v2.servlet (directory-part a-path) manager start))] [(stateless) - (let ([start (contract (request? . -> . response?) + (let ([start (contract (request? . -> . response/c) (dynamic-require module-name 'start) pos-blame neg-blame "start" loc)] @@ -176,7 +177,7 @@ [else (make-v1.servlet (directory-part a-path) timeouts-default-servlet (v0.response->v1.lambda - (contract response? (response/xexpr s) + (contract response/c (response/xexpr s) pos-blame neg-blame path-string loc) a-path))]))))) diff --git a/collects/web-server/servlet/web.rkt b/collects/web-server/servlet/web.rkt index 2cfeb32765..da1744e5e1 100644 --- a/collects/web-server/servlet/web.rkt +++ b/collects/web-server/servlet/web.rkt @@ -41,13 +41,13 @@ [redirect/get/forget (() (#:headers (listof header?)) . ->* . 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/forward (response-generator/c . -> . request?)] [send/suspend (response-generator/c . -> . request?)] - [send/suspend/dispatch ((embed/url/c . -> . response?) . -> . any/c)] - [send/suspend/url ((url? . -> . response?) . -> . request?)] - [send/suspend/url/dispatch ((((request? . -> . any/c) . -> . url?) . -> . response?) . -> . any/c)]) + [send/suspend/dispatch ((embed/url/c . -> . response/c) . -> . any/c)] + [send/suspend/url ((url? . -> . response/c) . -> . request?)] + [send/suspend/url/dispatch ((((request? . -> . any/c) . -> . url?) . -> . response/c) . -> . any/c)]) ;; ************************************************************ ;; EXPORTS @@ -158,7 +158,7 @@ (provide/contract [with-errors-to-browser - ((response? . -> . request?) + ((response/c . -> . request?) (-> any) . -> . any)])