Adding better contracts and renaming in accordance w/ Robbys suggestion

svn: r11428

collects/web-server/configuration/namespace.ss

@@ -30,16 +30,14 @@
                         additional-names))
       new-namespace)))
 
-; XXX
+(define make-servlet-namespace/c
-(define module-spec? any/c)
-(define make-servlet-namespace?
   (->* ()
-       (#:additional-specs (listof module-spec?))
+       (#:additional-specs (listof module-path?))
        namespace?))
 
 (provide/contract
- [make-servlet-namespace? contract?]
+ [make-servlet-namespace/c contract?]
  [make-make-servlet-namespace 
   (->* ()
-       (#:to-be-copied-module-specs (listof module-spec?))
+       (#:to-be-copied-module-specs (listof module-path?))
-       make-servlet-namespace?)])
+       make-servlet-namespace/c)])

collects/web-server/dispatchers/dispatch-files.ss

@@ -13,15 +13,13 @@
          "../dispatchers/filesystem-map.ss")
 
 (provide/contract
- [interface-version dispatcher-interface-version?]
+ [interface-version dispatcher-interface-version/c]
- [read-range-header (-> (listof header?) (or/c (listof pair?) false/c))])
+ [read-range-header (-> (listof header?) (or/c (listof pair?) false/c))]
-
-(provide/contract
  [make
-  (->* (#:url->path url-path?)
+  (->* (#:url->path url-path/c)
        (#:path->mime-type (path? . -> . bytes?)
                           #:indices (listof path-string?))
-       dispatcher?)])
+       dispatcher/c)])
 
 ;; looks-like-directory : str -> bool
 ;; to determine if is url style path looks like it refers to a directory

collects/web-server/dispatchers/dispatch-filter.ss

@@ -5,8 +5,8 @@
          "../private/request-structs.ss"
          "../private/util.ss")
 (provide/contract
- [interface-version dispatcher-interface-version?]
+ [interface-version dispatcher-interface-version/c]
- [make (regexp? dispatcher? . -> . dispatcher?)])
+ [make (regexp? dispatcher/c . -> . dispatcher/c)])
 
 (define interface-version 'v1)
 (define ((make regex inner) conn req)

collects/web-server/dispatchers/dispatch-host.ss

@@ -6,8 +6,8 @@
          "../private/util.ss"
          "dispatch.ss")
 (provide/contract
- [interface-version dispatcher-interface-version?]
+ [interface-version dispatcher-interface-version/c]
- [make ((symbol? . -> . dispatcher?) . -> . dispatcher?)])
+ [make ((symbol? . -> . dispatcher/c) . -> . dispatcher/c)])
 
 (define interface-version 'v1)
 (define ((make lookup-dispatcher) conn req)

collects/web-server/dispatchers/dispatch-lang.ss

@@ -17,13 +17,13 @@
          "../configuration/responders.ss")
 
 (provide/contract
- [interface-version dispatcher-interface-version?]
+ [interface-version dispatcher-interface-version/c]
  [make
-  (->* (#:url->path url-path?)
+  (->* (#:url->path url-path/c)
-       (#:make-servlet-namespace make-servlet-namespace?
+       (#:make-servlet-namespace make-servlet-namespace/c
                                   #:responders-servlet-loading (url? any/c . -> . response?)
                                   #:responders-servlet (url? any/c . -> . response?))
-       dispatcher?)])
+       dispatcher/c)])
 
 ; XXX url->servlet
 ; XXX optional session manager

collects/web-server/dispatchers/dispatch-lift.ss

@@ -5,8 +5,8 @@
          "../private/request-structs.ss"
          "../private/response-structs.ss")
 (provide/contract
- [interface-version dispatcher-interface-version?]
+ [interface-version dispatcher-interface-version/c]
- [make ((request? . -> . response?) . -> . dispatcher?)])
+ [make ((request? . -> . response?) . -> . dispatcher/c)])
 
 (define interface-version 'v1)
 (define ((make procedure) conn req)

collects/web-server/dispatchers/dispatch-log.ss

@@ -15,11 +15,11 @@
  [paren-format format-req/c]
  [extended-format format-req/c]
  [apache-default-format format-req/c]
- [interface-version dispatcher-interface-version?]
+ [interface-version dispatcher-interface-version/c]
  [make (->* ()
             (#:format format-req/c
                       #:log-path path-string?)
-            dispatcher?)])
+            dispatcher/c)])
 
 (define interface-version 'v1)
 (define (make #:format [format paren-format]

collects/web-server/dispatchers/dispatch-passwords.ss

@@ -10,14 +10,14 @@
          "../servlet/basic-auth.ss"
          "../private/response.ss")  
 (provide/contract
- [interface-version dispatcher-interface-version?]
+ [interface-version dispatcher-interface-version/c]
  [make (->* ()
             (#:password-file path-string?
                              #:authentication-responder 
                              (url? header? . -> . response?))
             (values
              (-> void)
-             dispatcher?))])
+             dispatcher/c))])
 
 (define interface-version 'v1)
 (define (make ; XXX Take authorized? function

collects/web-server/dispatchers/dispatch-pathprocedure.ss

@@ -7,8 +7,8 @@
          "../private/request-structs.ss"
          "../private/response-structs.ss")
 (provide/contract
- [interface-version dispatcher-interface-version?]
+ [interface-version dispatcher-interface-version/c]
- [make (string? (request? . -> . response?) . -> . dispatcher?)])
+ [make (string? (request? . -> . response?) . -> . dispatcher/c)])
 
 (define interface-version 'v1)
 (define ((make the-path procedure) conn req)

collects/web-server/dispatchers/dispatch-sequencer.ss

@@ -1,10 +1,8 @@
-#lang scheme/base
+#lang scheme
-(require mzlib/list
-         mzlib/contract)
 (require "dispatch.ss")
 (provide/contract
- [interface-version dispatcher-interface-version?])
+ [interface-version dispatcher-interface-version/c]
-(provide make)
+ [make (() () #:rest (listof dispatcher/c) . ->* . dispatcher/c)])
 
 (define interface-version 'v1)
 (define ((make . dispatchers) conn req)

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

@@ -19,15 +19,15 @@
          "../private/cache-table.ss"
          "../private/util.ss")  
 (provide/contract
- [interface-version dispatcher-interface-version?]
+ [interface-version dispatcher-interface-version/c]
  [make (->* ((box/c cache-table?)
-             #:url->path url-path?)
+             #:url->path url-path/c)
-            (#:make-servlet-namespace make-servlet-namespace?
+            (#:make-servlet-namespace make-servlet-namespace/c
                                       #:responders-servlet-loading (url? any/c . -> . response?)
                                       #:responders-servlet (url? any/c . -> . response?)
                                       #:timeouts-default-servlet number?)
             (values (-> void)
-                    dispatcher?))])
+                    dispatcher/c))])
 
 (define interface-version 'v1)
 (define (make config:scripts 

collects/web-server/dispatchers/dispatch-stat.ss

@@ -5,8 +5,8 @@
          "../private/connection-manager.ss")
 (provide/contract
  [make-gc-thread (integer? . -> . thread?)]
- [interface-version dispatcher-interface-version?]
+ [interface-version dispatcher-interface-version/c]
- [make (-> dispatcher?)])
+ [make (-> dispatcher/c)])
 
 (define (bytes->mb b)
   (round (exact->inexact (/ b 1024 1024))))

collects/web-server/dispatchers/dispatch-timeout.ss

@@ -3,8 +3,8 @@
 (require "dispatch.ss"
          "../private/connection-manager.ss")
 (provide/contract
- [interface-version dispatcher-interface-version?]
+ [interface-version dispatcher-interface-version/c]
- [make (integer? . -> . dispatcher?)])
+ [make (integer? . -> . dispatcher/c)])
 
 (define interface-version 'v1)
 (define ((make new-timeout) conn req)

collects/web-server/dispatchers/dispatch.ss

@@ -1,17 +1,17 @@
 #lang scheme/base
-(require mzlib/contract)
+(require scheme/contract)
 (require "../private/connection-manager.ss"
          "../private/request-structs.ss")
 
-(define dispatcher? 
+(define dispatcher/c
   (connection? request? . -> . void))
-(define (dispatcher-interface-version? v)
+(define dispatcher-interface-version/c
-  (and (symbol? v) (eq? v 'v1)))
+  (symbols 'v1))
 (define-struct exn:dispatcher ())
 (define (next-dispatcher) (raise (make-exn:dispatcher)))
 
 (provide/contract
- [dispatcher? contract?]
+ [dispatcher/c contract?]
- [dispatcher-interface-version? (any/c . -> . boolean?)]
+ [dispatcher-interface-version/c contract?]
  [next-dispatcher (-> void)]
  [struct exn:dispatcher ()])

collects/web-server/dispatchers/filesystem-map.ss

@@ -3,13 +3,13 @@
          mzlib/list
          mzlib/contract)
 (require "../private/util.ss")
-(define url-path?
+(define url-path/c
   ((url?) . ->* . (path? (listof path-element?))))
 
 (provide/contract
- [url-path? contract?]
+ [url-path/c contract?]
- [make-url->path (path? . -> . url-path?)]
+ [make-url->path (path? . -> . url-path/c)]
- [make-url->valid-path (url-path? . -> . url-path?)])
+ [make-url->valid-path (url-path/c . -> . url-path/c)])
 
 (define (build-path* . l)
   (if (empty? l)

collects/web-server/insta/insta.ss

@@ -13,14 +13,15 @@
 (define launch-browser? #t)
 
 (provide/contract
- (static-files-path ((or/c string? path?) . -> . void?)))
+ [static-files-path ((or/c string? path?) . -> . void?)])
 (define (static-files-path path)
   (set! extra-files-path 
         (if (path? path) 
             path
             (string->path path))))
 
-(provide no-web-browser)
+(provide/contract
+ [no-web-browser (-> void)])
 (define (no-web-browser)
   (set! launch-browser? false))
 

collects/web-server/lang/abort-resume.ss

@@ -4,6 +4,7 @@
          mzlib/serialize
          "../private/define-closure.ss"
          "../lang/web-cells.ss")
+; XXX contract
 (provide
  
  ;; AUXILLIARIES

collects/web-server/lang/anormal.ss

@@ -2,9 +2,11 @@
 (require (for-template scheme/base)
          syntax/kerncase
          mzlib/list
+         scheme/contract
          mzlib/plt-match
          "util.ss")
-(provide make-anormal-term)
+(provide/contract
+ [make-anormal-term ((syntax? . -> . syntax?) . -> . (syntax? . -> . syntax?))])
 
 ; A-Normal Form
 (define (id x) x)

collects/web-server/lang/defun.ss

@@ -2,11 +2,13 @@
 (require (for-template scheme/base)
          syntax/kerncase
          syntax/free-vars
+         scheme/contract
          mzlib/list
          mzlib/plt-match
          "util.ss"
          "../private/closure.ss")
-(provide defun)
+(provide/contract
+ [defun (syntax? . -> . (values syntax? (listof syntax?)))])
 
 ; make-new-clouse-label : (syntax -> syntax) syntax -> syntax
 (define (make-new-closure-label labeling stx)

collects/web-server/lang/elim-callcc.ss

@@ -1,10 +1,12 @@
 #lang scheme/base
 (require (for-template scheme/base)
          syntax/kerncase
+         scheme/contract
          "../lang/abort-resume.ss"
          (for-template "../lang/abort-resume.ss")
          "util.ss")
-(provide elim-callcc)
+(provide/contract
+ [elim-callcc (syntax? . -> . syntax?)])
 
 (define (id x) x)
 

collects/web-server/lang/elim-letrec.ss

@@ -3,9 +3,12 @@
          syntax/kerncase
          mzlib/etc
          mzlib/list
+         scheme/contract
          (for-template "../lang/abort-resume.ss")
          "util.ss")
-(provide (all-defined-out))
+(provide/contract
+ [elim-letrec ((listof syntax?) . -> . (syntax? . -> . syntax?))]
+ [elim-letrec-term (syntax? . -> . syntax?)])
 
 ; elim-letrec : (listof identifier-syntax?)[3] -> syntax?[2] -> syntax?[3]
 ; Eliminates letrec-values from syntax[2] and correctly handles references to 

collects/web-server/lang/labels.ss

@@ -1,6 +1,7 @@
-#lang scheme/base
+#lang scheme
 (require mzlib/md5)
-(provide make-labeling)
+(provide/contract
+ [make-labeling (bytes? . -> . (-> symbol?))])
 
 ;; REQUIREMENT: The label code must be non-numeric.
 ;; REQUIREMENT: The first numeric character following the label code

collects/web-server/lang/web-extras.ss

@@ -1,9 +1,12 @@
 #lang scheme/base
 (require net/url
+         scheme/contract
          (for-template "web.ss")
          "web.ss"
+         web-server/private/request-structs
          "../servlet/helpers.ss")
-(provide redirect/get)  
+(provide/contract
+ [redirect/get (-> request?)])  
 
 (define (redirect/get)
   (send/suspend/url (lambda (k-url) (redirect-to (url->string k-url) temporarily))))

collects/web-server/lang/web-param.ss

@@ -1,11 +1,12 @@
 #lang scheme/base
 (require (for-syntax scheme/base)
+         scheme/contract
          "../private/closure.ss"
          mzlib/list)
 
-; XXX Add contract
+(provide/contract
+ [web-parameter? (any/c . -> . boolean?)])
 (provide make-web-parameter
-         web-parameter?
          web-parameterize)
 
 (define (web-parameter? any)

collects/web-server/lang/web.ss

@@ -1,6 +1,9 @@
 #lang scheme
 (require net/url
+         scheme/contract
          scheme/serialize
+         web-server/private/request-structs
+         web-server/private/response-structs
          web-server/private/define-closure
          "../private/request-structs.ss"
          "abort-resume.ss"
@@ -17,6 +20,17 @@
  send/suspend/url
  send/suspend/dispatch)
 
+; These contracts interfere with the continuation safety marks
+#;(provide/contract
+ ;; Server Interface
+ [initialize-servlet ((request? . -> . response?) . -> . (request? . -> . response?))]
+ 
+ ;; Servlet Interface
+ [send/suspend/hidden ((url? list? . -> . response?) . -> . request?)]
+ [send/suspend/url ((url? . -> . response?) . -> . request?)]
+ [send/suspend/dispatch ((((request? . -> . any/c) . -> . url?) . -> . response?)
+                         . -> . any/c)])
+
 ;; initial-servlet : (request -> response) -> (request -> response?)
 (define (initialize-servlet start)
   (let ([params (current-parameterization)])

collects/web-server/managers/lru.ss

@@ -4,11 +4,11 @@
 (require "manager.ss"
          "../servlet/servlet-structs.ss")
 (provide/contract
- [create-LRU-manager (expiration-handler? number? number? (-> boolean?)
+ [create-LRU-manager (expiration-handler/c number? number? (-> boolean?)
                                           #:initial-count number?
                                           #:inform-p (number? . -> . void)
                                           . -> . manager?)]
- [make-threshold-LRU-manager (expiration-handler? number? . -> . manager?)])
+ [make-threshold-LRU-manager (expiration-handler/c number? . -> . manager?)])
 
 ;; Utility
 (define (make-counter)

collects/web-server/managers/manager.ss

@@ -18,13 +18,13 @@
  [struct manager ([create-instance ((-> void) . -> . number?)]
                   [adjust-timeout! (number? number? . -> . void)]
                   [clear-continuations! (number? . -> . void)]
-                  [continuation-store! (number? any/c expiration-handler? . -> . (list/c number? number?))]
+                  [continuation-store! (number? any/c expiration-handler/c . -> . (list/c number? number?))]
                   [continuation-lookup (number? number? number? . -> . any/c)])]
  [struct (exn:fail:servlet-manager:no-instance exn:fail) 
          ([message string?]
           [continuation-marks continuation-mark-set?]
-          [expiration-handler expiration-handler?])]
+          [expiration-handler expiration-handler/c])]
  [struct (exn:fail:servlet-manager:no-continuation exn:fail)
          ([message string?]
           [continuation-marks continuation-mark-set?]
-          [expiration-handler expiration-handler?])])
+          [expiration-handler expiration-handler/c])])

collects/web-server/managers/none.ss

@@ -3,7 +3,7 @@
 (require "manager.ss")
 (require "../servlet/servlet-structs.ss")
 (provide/contract
- [create-none-manager (expiration-handler? . -> . manager?)])
+ [create-none-manager (expiration-handler/c . -> . manager?)])
 
 (define-struct (none-manager manager) (instance-expiration-handler))
 (define (create-none-manager

collects/web-server/managers/timeouts.ss

@@ -5,7 +5,7 @@
 (require "../private/timer.ss"
          "../servlet/servlet-structs.ss")
 (provide/contract
- [create-timeout-manager (expiration-handler? number? number? . -> . manager?)])
+ [create-timeout-manager (expiration-handler/c number? number? . -> . manager?)])
 
 ;; Utility
 (define (make-counter)

collects/web-server/private/closure.ss

@@ -2,9 +2,11 @@
 (require (for-template scheme/base)
          (for-template mzlib/serialize)
          mzlib/list
+         scheme/contract
          mzlib/serialize)
-(provide make-closure-definition-syntax
+(provide/contract
-         closure->deserialize-name) 
+ [closure->deserialize-name (serializable? . -> . symbol?)])
+(provide make-closure-definition-syntax) 
 
 (define (closure->deserialize-name proc)
   (cdr (first (third (serialize proc)))))

collects/web-server/private/dispatch-server-unit.ss

@@ -1,8 +1,6 @@
 #lang scheme/unit
 (require net/tcp-sig
-         mzlib/thread
+         mzlib/thread)
-         mzlib/contract
-         mzlib/kw)
 (require "web-server-structs.ss"
          "connection-manager.ss"
          "dispatch-server-sig.ss")
@@ -56,9 +54,8 @@
 
 ;; handle-connection : input-port output-port (input-port -> string string) -> void
 ;; returns immediately, spawning a thread to handle
-(define/kw (handle-connection ip op
+(define (handle-connection ip op
-                              #:optional
+                           #:port-addresses [port-addresses tcp-addresses])
-                              [port-addresses tcp-addresses])
   (define conn
     (new-connection config:initial-connection-timeout
                     ip op (current-custodian) #f))

collects/web-server/private/mod-map.ss

@@ -1,6 +1,7 @@
 #lang scheme/base
 (require mzlib/list
          mzlib/plt-match)
+; XXX Contract?
 (provide compress-serial
          decompress-serial)
 

collects/web-server/private/request.ss

@@ -9,7 +9,8 @@
          "../private/request-structs.ss")
 
 (provide/contract
- [rename ext:read-request read-request ((connection? number? ((input-port?) . ->* . (string? string?))) . ->* . (request? boolean?))])
+ [rename ext:read-request read-request
+         ((connection? number? ((input-port?) . ->* . (string? string?))) . ->* . (request? boolean?))])
 
 (define (ext:read-request conn host-port port-addresses)
   (with-handlers ([exn? (lambda (exn)

collects/web-server/private/servlet.ss

@@ -1,12 +1,10 @@
 #lang scheme/base
-(require mzlib/contract)
+(require scheme/contract)
 (require "../managers/manager.ss"
          "../private/request-structs.ss"
          "../private/response-structs.ss")
 
 (define servlet-prompt (make-continuation-prompt-tag 'servlet))
-(provide servlet-prompt)
-
 (define-struct (exn:fail:servlet:instance exn:fail) ()
   #:mutable)
 (define-struct servlet (custodian namespace manager handler)
@@ -22,6 +20,7 @@
   (servlet-manager (current-servlet)))
 
 (provide/contract
+ [servlet-prompt continuation-prompt-tag?]
  [struct (exn:fail:servlet:instance exn:fail)
          ([message string?]
           [continuation-marks continuation-mark-set?])]
@@ -32,7 +31,7 @@
           [handler (request? . -> . response?)])]
  [struct execution-context 
          ([request request?])]
- [current-servlet parameter?]
+ [current-servlet (parameter/c servlet?)]
- [current-servlet-instance-id parameter?]
+ [current-servlet-instance-id (parameter/c number?)]
- [current-execution-context parameter?]
+ [current-execution-context (parameter/c execution-context?)]
  [current-servlet-manager (-> manager?)])

collects/web-server/private/session.ss

@@ -1,5 +1,5 @@
 #lang scheme/base
-(require mzlib/contract
+(require scheme/contract
          mzlib/list
          net/url
          "response-structs.ss"
@@ -32,8 +32,8 @@
                   [url url?])]
  [lookup-session ((listof string?) . -> . (or/c session? false/c))]
  [install-session (session? (listof string?) . -> . void)]
- [new-session (custodian? namespace? url? (listof string?) . -> . session?)])
+ [new-session (custodian? namespace? url? (listof string?) . -> . session?)]
-(provide current-session)  
+ [current-session (parameter/c session?)])
 
 (define current-session (make-parameter #f))
 

collects/web-server/private/web-server-structs.ss

@@ -2,7 +2,6 @@
 (require mzlib/contract)
 
 (define current-server-custodian (make-parameter #f))
-(provide current-server-custodian) ; parameter
 
 ;; make-servlet-custodian: -> custodian
 ;; create a custodian for the dynamic extent of a servlet continuation
@@ -10,4 +9,5 @@
   (make-custodian (current-server-custodian)))
 
 (provide/contract
+ [current-server-custodian (parameter/c custodian?)]
  [make-servlet-custodian (-> custodian?)])

collects/web-server/private/xexpr-extras.ss

@@ -1,6 +1,7 @@
 #lang scheme/base
 (require net/url
          mzlib/plt-match)  
+; XXX contract
 (provide xexpr+extras->xexpr)
 
 (define xexpr+extras->xexpr

collects/web-server/scribblings/configuration.scrbl

@@ -162,12 +162,17 @@ This function writes a @scheme[configuration-table] to @scheme[path].
 @scheme[make-servlet-namespace] procedure needed by the @scheme[make] functions
 of @filepath{dispatchers/dispatch-servlets.ss} and @filepath{dispatchers/dispatch-lang.ss}.
 
-@; XXX Define make-servlet-namespace?
+@defthing[make-servlet-namespace/c contract?]{
-@; XXX Use actual keyword argument syntax
+ Equivalent to 
+ @schemeblock[
+(->* ()
+     (#:additional-specs (listof module-path?))
+     namespace?)
+].
+}
 
-@defproc[(make-make-servlet-namespace (#:to-be-copied-module-specs to-be-copied-module-specs (listof module-spec?)))
+@defproc[(make-make-servlet-namespace (#:to-be-copied-module-specs to-be-copied-module-specs (listof module-path?)))
-         (key-> ([additional-specs (listof module-spec?)])
+         make-servlet-namespace/c]{
-                namespace?)]{
 This function creates a function that when called will construct a new @scheme[namespace] that
 has all the modules from @scheme[to-be-copied-module-specs] and @scheme[additional-specs], as well
 as @scheme[mzscheme] and @scheme[mred], provided they are already attached

collects/web-server/scribblings/dispatchers.scrbl

@@ -38,12 +38,12 @@ documentation will be useful.
 
 @filepath{dispatchers/dispatch.ss} provides a few functions for dispatchers in general.
 
-@defthing[dispatcher? contract?]{
+@defthing[dispatcher/c contract?]{
  Equivalent to @scheme[(connection? request? . -> . void)].
 }
 
-@defproc[(dispatcher-interface-version? (any any/c)) boolean?]{
+@defproc[(dispatcher-interface-version/c (any any/c)) boolean?]{
- Returns @scheme[#t] if @scheme[any] is @scheme['v1]. Returns @scheme[#f] otherwise.
+ Equivalent to @scheme[(symbols 'v1)]
 }
 
 @defstruct[exn:dispatcher ()]{
@@ -55,7 +55,7 @@ documentation will be useful.
  Raises a @scheme[exn:dispatcher]
 }
 
-As the @scheme[dispatcher?] contract suggests, a dispatcher is a function that takes a connection
+As the @scheme[dispatcher/c] contract suggests, a dispatcher is a function that takes a connection
 and request object and does something to them. Mostly likely it will generate
 some response and output it on the connection, but it may do something
 different. For example, it may apply some test to the request object, perhaps
@@ -64,7 +64,7 @@ otherwise.
 
 Consider the following example dispatcher, that captures the essence of URL rewriting:
 @schemeblock[
- (code:comment "(url? -> url?) dispatcher? -> dispatcher?")
+ (code:comment "(url? -> url?) dispatcher/c -> dispatcher/c")
  (lambda (rule inner)
    (lambda (conn req)
      (code:comment "Call the inner dispatcher...")
@@ -84,14 +84,14 @@ Consider the following example dispatcher, that captures the essence of URL rewr
 @filepath{dispatchers/filesystem-map.ss} provides a means of mapping
 URLs to paths on the filesystem.
 
-@defthing[url-path? contract?]{
+@defthing[url-path/c contract?]{
  This contract is equivalent to @scheme[((url?) . ->* . (path? (listof path-element?)))].
  The returned @scheme[path?] is the path on disk. The list is the list of
  path elements that correspond to the path of the URL.}
 
 @defproc[(make-url->path (base path?))
-         url-path?]{
+         url-path/c]{
- The @scheme[url-path?] returned by this procedure considers the root
+ The @scheme[url-path/c] returned by this procedure considers the root
  URL to be @scheme[base]. It ensures that @scheme[".."]s in the URL
  do not escape the @scheme[base] and removes them silently otherwise.}
 
@@ -112,8 +112,8 @@ URLs to paths on the filesystem.
               @elem{defines a dispatcher constructor
                  that invokes a sequence of dispatchers until one applies.}]{
 
-@defproc[(make (dispatcher dispatcher?) ...)
+@defproc[(make (dispatcher dispatcher/c) ...)
-         dispatcher?]{
+         dispatcher/c]{
  Invokes each @scheme[dispatcher], invoking the next if the first
  calls @scheme[next-dispatcher]. If no @scheme[dispatcher] applies,
  then it calls @scheme[next-dispatcher] itself.
@@ -128,7 +128,7 @@ URLs to paths on the filesystem.
                   dispatcher.}]{
 
 @defproc[(make [new-timeout integer?])
-         dispatcher?]{
+         dispatcher/c]{
  Changes the timeout on the connection with @scheme[adjust-connection-timeout!]
  called with @scheme[new-timeout].
 }}
@@ -139,7 +139,7 @@ URLs to paths on the filesystem.
               @elem{defines a dispatcher constructor.}]{
 
 @defproc[(make (proc (request? . -> . response?)))
-         dispatcher?]{
+         dispatcher/c]{
  Constructs a dispatcher that calls @scheme[proc] on the request
  object, and outputs the response to the connection.
 }}
@@ -152,8 +152,8 @@ URLs to paths on the filesystem.
                  that calls an underlying dispatcher
                  with all requests that pass a predicate.}]{
 
-@defproc[(make (regex regexp?) (inner dispatcher?))
+@defproc[(make (regex regexp?) (inner dispatcher/c))
-         dispatcher?]{
+         dispatcher/c]{
  Calls @scheme[inner] if the URL path of the request, converted to
  a string, matches @scheme[regex]. Otherwise, calls @scheme[next-dispatcher].
 }}
@@ -166,7 +166,7 @@ URLs to paths on the filesystem.
                    URL path.}]{
 
 @defproc[(make (path string?) (proc (request? . -> . response?)))
-         dispatcher?]{
+         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.
 }
@@ -221,7 +221,7 @@ a URL that refreshes the password file, servlet cache, etc.}
 
 @defproc[(make [#:format format format-req/c paren-format]
                [#:log-path log-path path-string? "log"])
-         dispatcher?]{
+         dispatcher/c]{
  Logs requests to @scheme[log-path] by using @scheme[format] to format the requests.
  Then invokes @scheme[next-dispatcher].
 }}
@@ -238,7 +238,7 @@ a URL that refreshes the password file, servlet cache, etc.}
                 ((url url?) (header header?) . -> . response?)
                 (gen-authentication-responder "forbidden.html")])
          (values (-> void)
-                 dispatcher?)]{
+                 dispatcher/c)]{
  The first returned value is a procedure that refreshes the password
  file used by the dispatcher.
 
@@ -267,8 +267,8 @@ a URL that refreshes the password file, servlet cache, etc.}
               @elem{defines a dispatcher constructor
                     that calls a different dispatcher based upon the host requested.}]{
 
-@defproc[(make (lookup-dispatcher (symbol? . -> . dispatcher?)))
+@defproc[(make (lookup-dispatcher (symbol? . -> . dispatcher/c)))
-         dispatcher?]{
+         dispatcher/c]{
  Extracts a host from the URL requested, or the Host HTTP header,
  calls @scheme[lookup-dispatcher] with the host, and invokes the
  returned dispatcher. If no host can be extracted, then @scheme['none]
@@ -284,7 +284,7 @@ a URL that refreshes the password file, servlet cache, etc.}
 @defproc[(make [#:url->path url->path url->path?]
                [#:path->mime-type path->mime-type (path? . -> . bytes?) (lambda (path) TEXT/HTML-MIME-TYPE)]
                [#:indices indices (listof string?) (list "index.html" "index.htm")])
-         dispatcher?]{
+         dispatcher/c]{
  Uses @scheme[url->path] to extract a path from the URL in the request
  object. If this path does not exist, then the dispatcher does not apply and 
  @scheme[next-dispatcher] is invoked.
@@ -322,7 +322,7 @@ a URL that refreshes the password file, servlet cache, etc.}
                 integer?
                 30])
          (values (-> void)
-                 dispatcher?)]{
+                 dispatcher/c)]{
  The first returned value is a procedure that refreshes the servlet
  code cache.
 
@@ -354,7 +354,7 @@ a URL that refreshes the password file, servlet cache, etc.}
                [#:responders-servlet responders-servlet
                                      ((url url?) (exn exn?) . -> . response?)
                                      servlet-error-responder])
-         dispatcher?]{
+         dispatcher/c]{
  If the request URL contains a serialized continuation, then it is invoked with the
  request. Otherwise, @scheme[url->path] is used to resolve the URL to a path.
  The path is evaluated as a module, in a namespace constructed by @scheme[make-servlet-namespace].
@@ -376,6 +376,6 @@ a URL that refreshes the password file, servlet cache, etc.}
 }
                  
 @defproc[(make)
-         dispatcher?]{
+         dispatcher/c]{
  Returns a dispatcher that prints memory usage on every request.
 }}

collects/web-server/scribblings/lang.scrbl

@@ -134,7 +134,7 @@ by the Web language API.
  Note: The continuation is NOT stuffed.
 }
 
-@defproc[(send/suspend/dispatch [make-response (embed/url? . -> . response?)])
+@defproc[(send/suspend/dispatch [make-response (embed/url/c . -> . response?)])
          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

collects/web-server/scribblings/managers.scrbl

@@ -26,7 +26,7 @@ the users and implementers of managers.
 @defstruct[manager ([create-instance ((-> void) . -> . number?)]
                     [adjust-timeout! (number? number? . -> . void)]
                     [clear-continuations! (number? . -> . void)]
-                    [continuation-store! (number? any/c expiration-handler? . -> . (list/c number? number?))]
+                    [continuation-store! (number? any/c expiration-handler/c . -> . (list/c number? number?))]
                     [continuation-lookup (number? number? number? . -> . any/c)])]{
  @scheme[create-instance] is called to initialize a instance, to hold the
  continuations of one servlet session. It is passed
@@ -49,13 +49,13 @@ the users and implementers of managers.
 }
 
 @defstruct[(exn:fail:servlet-manager:no-instance exn:fail)
-           ([expiration-handler expiration-handler?])]{
+           ([expiration-handler expiration-handler/c])]{
  This exception should be thrown by a manager when an instance is looked
  up that does not exist.
 }
 
 @defstruct[(exn:fail:servlet-manager:no-continuation exn:fail)
-           ([expiration-handler expiration-handler?])]{
+           ([expiration-handler expiration-handler/c])]{
  This exception should be thrown by a manager when a continuation is
  looked up that does not exist.
 }
@@ -68,7 +68,7 @@ the users and implementers of managers.
 
 @filepath{managers/none.ss} defines a manager constructor:
 
-@defproc[(create-none-manager (instance-expiration-handler expiration-handler?))
+@defproc[(create-none-manager (instance-expiration-handler expiration-handler/c))
          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
@@ -91,7 +91,7 @@ Web Language. (See @secref["lang"].)
 
 @filepath{managers/timeouts.ss} defines a manager constructor:
 
-@defproc[(create-timeout-manager [instance-exp-handler expiration-handler?]
+@defproc[(create-timeout-manager [instance-exp-handler expiration-handler/c]
                                  [instance-timeout number?]
                                  [continuation-timeout number?])
          manager?]{
@@ -122,7 +122,7 @@ deployments of the @web-server .
 @filepath{managers/lru.ss} defines a manager constructor:
 
 @defproc[(create-LRU-manager
-          [instance-expiration-handler expiration-handler?]
+          [instance-expiration-handler expiration-handler/c]
           [check-interval integer?]
           [collect-interval integer?]
           [collect? (-> boolean?)]
@@ -155,7 +155,7 @@ deployments of the @web-server .
 The recommended usage of this manager is codified as the following function:
 
 @defproc[(make-threshold-LRU-manager 
-          [instance-expiration-handler expiration-handler?]
+          [instance-expiration-handler expiration-handler/c]
           [memory-threshold number?])
          manager?]{
  This creates an LRU manager with the following behavior:

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

@@ -15,7 +15,7 @@ The @web-server provides a way to quickly configure and start a server instance.
                        [#:listen-ip listen-ip string? "127.0.0.1"]
                        [#:port port number? 8000]
                        [#:manager manager manager? default-threshold-LRU-manager]
-                       [#:servlet-namespace servlet-namespace (listof require-spec?) empty]
+                       [#:servlet-namespace servlet-namespace (listof module-path?) empty]
                        [#:server-root-path server-root-path path? default-server-root-path]
                        [#:extra-files-path extra-files-path path? (build-path server-root-path "htdocs")]
                        [#:servlets-root servlets-root path? (build-path server-root-path ".")]

collects/web-server/scribblings/servlet.scrbl

@@ -61,9 +61,9 @@ for use in servlets.
 
 @defthing[url-transform? contract?]{Equivalent to @scheme[(k-url? . -> . k-url?)].}
 
-@defthing[expiration-handler? contract?]{Equivalent to @scheme[(or/c false/c (request? . -> . response?))].}
+@defthing[expiration-handler/c contract?]{Equivalent to @scheme[(or/c false/c (request? . -> . response?))].}
 
-@defthing[embed/url? contract?]{Equivalent to @scheme[(((request? . -> . any/c)) (expiration-handler?) . opt-> . string?)].}
+@defthing[embed/url/c contract?]{Equivalent to @scheme[(((request? . -> . any/c)) (expiration-handler/c) . opt-> . string?)].}
 
 @; ------------------------------------------------------------
 @section[#:tag "request-structs.ss"]{HTTP Requests}
@@ -254,13 +254,13 @@ functions of interest for the servlet developer.}
  Sends @scheme[response] to the client.
 }
 
-@defthing[current-servlet-continuation-expiration-handler parameter?]{
+@defthing[current-servlet-continuation-expiration-handler (parameter/c expiration-handler/c)]{
- Holds the @scheme[expiration-handler?] to be used when a continuation
+ Holds the @scheme[expiration-handler/c] to be used when a continuation
  captured in this context is expired, then looked up.
 }
 
 @defproc[(send/suspend [make-response response-generator?]
-                       [exp expiration-handler? (current-servlet-continuation-expiration-handler)])
+                       [exp expiration-handler/c (current-servlet-continuation-expiration-handler)])
          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
@@ -287,7 +287,7 @@ functions of interest for the servlet developer.}
 }
 
 @defproc[(send/forward [make-response response-generator?]
-                       [exp expiration-handler? (current-servlet-continuation-expiration-handler)])
+                       [exp expiration-handler/c (current-servlet-continuation-expiration-handler)])
          request?]{
  Calls @scheme[clear-continuation-table!], then @scheme[send/suspend].
 }
@@ -297,7 +297,7 @@ functions of interest for the servlet developer.}
  Calls @scheme[clear-continuation-table!], then @scheme[send/back].
 }
 
-@defproc[(send/suspend/dispatch [make-response (embed/url? . -> . response?)])
+@defproc[(send/suspend/dispatch [make-response (embed/url/c . -> . response?)])
          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
@@ -323,7 +323,7 @@ functions of interest for the servlet developer.}
 }
 
 @; XXX Remove
-@defthing[current-url-transform parameter?]{
+@defthing[current-url-transform (parameter/c url-transform?)]{
  Holds a @scheme[url-transform?] function that is called by
  @scheme[send/suspend] to transform the URLs it generates.
 }

collects/web-server/servlet-env.ss

@@ -2,12 +2,16 @@
 ; Also derived from planet/untyped/instaservlet
 #lang scheme/base
 (require (prefix-in net: net/sendurl)
+         scheme/contract
          scheme/list)
 (require web-server/web-server
          web-server/managers/lru
+         web-server/managers/manager
          web-server/private/servlet
          web-server/configuration/namespace
          web-server/private/cache-table 
+         web-server/private/request-structs
+         web-server/private/response-structs
          web-server/private/util
          web-server/configuration/responders
          web-server/dispatchers/dispatch
@@ -35,7 +39,22 @@
              (div ([class "title"]) "Server Stopped")
              (p "Return to DrScheme.")))))))
 
-(provide serve/servlet)
+(provide/contract
+ [serve/servlet (((request? . -> . response?))
+                 (#:launch-browser? boolean?
+                  #:quit? boolean?
+                  #:listen-ip string?
+                  #:port number?
+                  #:manager manager?
+                  #:servlet-namespace (listof module-path?)
+                  #:server-root-path path?
+                  #:extra-files-path path?
+                  #:servlets-root path?
+                  #:file-not-found-path path?
+                  #:mime-types-path path?
+                  #:servlet-path path?)
+                 . ->* .
+                 void)])
 (define (serve/servlet new-servlet 
                        #:launch-browser?
                        [launch-browser? #t]

collects/web-server/servlet/helpers.ss

@@ -32,6 +32,7 @@
                                            (pre ,(exn->string exn)))))))])
     (thunk)))
 
+; XXX contract
 (provide
  with-errors-to-browser)
 (provide/contract

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

@@ -1,27 +1,27 @@
 #lang scheme/base
-(require mzlib/contract)
+(require scheme/contract)
 (require "../private/request-structs.ss"
          "../private/response-structs.ss")  
 
 (define k-url?
   string?)
 
-(define response-generator?
+(define response-generator/c
   (k-url? . -> . response?))
 
-(define url-transform?
+(define url-transform/c
   (k-url? . -> . k-url?))
 
-(define expiration-handler?
+(define expiration-handler/c
   (or/c false/c
         (request? . -> . response?)))
 
-(define embed/url?
+(define embed/url/c
-  (((request? . -> . any/c)) (expiration-handler?) . opt-> . string?))
+  (((request? . -> . any/c)) (expiration-handler/c) . ->* . string?))
 
 (provide/contract
- [response-generator? contract?]
+ [response-generator/c contract?]
  [k-url? (any/c . -> . boolean?)]
- [url-transform? contract?]
+ [url-transform/c contract?]
- [expiration-handler? contract?]
+ [expiration-handler/c contract?]
- [embed/url? contract?])
+ [embed/url/c contract?])

collects/web-server/servlet/web.ss

@@ -2,7 +2,7 @@
 (require net/url
          mzlib/list
          mzlib/plt-match
-         mzlib/contract
+         scheme/contract
          mzlib/etc)
 (require "../managers/manager.ss"
          "../private/util.ss"
@@ -67,17 +67,17 @@
     in-url)))   
 
 (provide/contract
- [current-url-transform parameter?]
+ [current-url-transform (parameter/c url-transform/c)]
- [current-servlet-continuation-expiration-handler parameter?]
+ [current-servlet-continuation-expiration-handler (parameter/c expiration-handler/c)]
  [redirect/get (-> request?)]
  [redirect/get/forget (-> request?)]
  [adjust-timeout! (number? . -> . void?)]
  [clear-continuation-table! (-> void?)]
  [send/back (response? . -> . void?)]
  [send/finish (response? . -> . void?)]
- [send/suspend ((response-generator?) (expiration-handler?) . opt-> . request?)]
+ [send/suspend ((response-generator/c) (expiration-handler/c) . ->* . request?)]
- [send/forward ((response-generator?) (expiration-handler?) . opt-> . request?)]
+ [send/forward ((response-generator/c) (expiration-handler/c) . ->* . request?)]
- [send/suspend/dispatch ((embed/url? . -> . response?) . -> . any/c)])
+ [send/suspend/dispatch ((embed/url/c . -> . response?) . -> . any/c)])
 
 ;; ************************************************************
 ;; EXPORTS

collects/web-server/web-config-unit.ss

@@ -14,14 +14,14 @@
   (->* (path-string?)
        (#:port (or/c false/c number?)
                #:listen-ip (or/c false/c string?)
-               #:make-servlet-namespace make-servlet-namespace?)
+               #:make-servlet-namespace make-servlet-namespace/c)
       unit?)]
  [configuration-table-sexpr->web-config@
   (->* (list?) ; XXX
       (#:web-server-root path-string?
       #:port (or/c false/c number?)
       #:listen-ip (or/c false/c string?)
-      #:make-servlet-namespace make-servlet-namespace?)
+      #:make-servlet-namespace make-servlet-namespace/c)
       unit?)])
 
 ; configuration-table->web-config@ : path -> configuration

collects/web-server/web-server.ss

@@ -13,7 +13,7 @@
          (prefix-in http: "private/request.ss"))
 (provide/contract
  [serve
-  (->* (#:dispatch dispatcher?)
+  (->* (#:dispatch dispatcher/c)
        (#:tcp@ unit?
                #:port number?
                #:listen-ip (or/c false/c string?)
@@ -21,7 +21,7 @@
                #:initial-connection-timeout number?)
        (-> void))]
  [serve/ports
-  (->* (#:dispatch dispatcher?)
+  (->* (#:dispatch dispatcher/c)
        (#:tcp@ unit?
                #:ports (listof number?)
                #:listen-ip (or/c false/c string?)
@@ -29,7 +29,7 @@
                #:initial-connection-timeout number?)
        (-> void))]
  [serve/ips+ports
-  (->* (#:dispatch dispatcher?)
+  (->* (#:dispatch dispatcher/c)
        (#:tcp@ unit?
                #:ips+ports (listof (cons/c (or/c false/c string?) (listof number?)))
                #:max-waiting number?