Non empty strings in redirect-to

svn: r14023

collects/tests/web-server/servlet/helpers-test.ss

@@ -24,6 +24,9 @@
    
    (test-suite
     "redirect-to"
+    (test-exn "Empty"
+              exn:fail:contract?
+              (lambda () (redirect-to "")))
     (test-equal? "Code (temp)"  
                  (response/basic-code (redirect-to "http://test.com/foo"))
                  302)
@@ -49,3 +52,6 @@
     (test-case "permanently" (check-true (redirection-status? permanently)))
     (test-case "temporarily" (check-true (redirection-status? temporarily)))
     (test-case "see-other" (check-true (redirection-status? see-other))))))
+
+;(require (planet schematics/schemeunit:3/text-ui))
+;(run-tests helpers-tests)

collects/web-server/http/redirect.ss

@@ -1,6 +1,7 @@
 #lang scheme/base
 (require scheme/contract)
-(require web-server/http/response-structs
+(require web-server/private/util
+         web-server/http/response-structs
          web-server/http/request-structs)
 
 ; redirection-status = (make-redirection-status nat bytes)
@@ -24,7 +25,7 @@
 
 (provide/contract
  [redirect-to
-  (->* (string?) (redirection-status? #:headers (listof header?))
+  (->* (non-empty-string/c) (redirection-status? #:headers (listof header?))
        response/full?)]
  [redirection-status? (any/c . -> . boolean?)]
  [permanently redirection-status?]

collects/web-server/private/util.ss

@@ -9,7 +9,12 @@
 
 (define port-number? (between/c 1 65535))
 
+(define non-empty-string/c
+  (and/c string?
+         (lambda (s) (not (zero? (string-length s))))))
+
 (provide/contract
+ [non-empty-string/c contract?]
  [path-element? contract?]
  [port-number? contract?]
  [url-replace-path (((listof path/param?) . -> . (listof path/param?)) url? . -> . url?)]

collects/web-server/scribblings/http.scrbl

@@ -360,11 +360,12 @@ transmission that the server @bold{will not catch}.}
 
 @; ------------------------------------------------------------
 @section[#:tag "redirect.ss"]{Redirect}
-@(require (for-label web-server/http/redirect))
+@(require (for-label web-server/http/redirect
+                     web-server/private/util))
 
 @defmodule[web-server/http/redirect]{
 
-@defproc[(redirect-to [uri string?]
+@defproc[(redirect-to [uri non-empty-string/c]
                       [perm/temp redirection-status? temporarily]
                       [#:headers headers (listof header?) (list)])
          response/c]{

collects/web-server/scribblings/private.scrbl

@@ -397,6 +397,7 @@ There are a number of other miscellaneous utilities the @web-server
 needs. They are provided by @filepath{private/util.ss}.
 
 @subsection{Contracts}
+@defthing[non-empty-string/c contract?]{Contract for non-empty strings.}
 @defthing[port-number? contract?]{Equivalent to @scheme[(between/c 1 65535)].}
 @defthing[path-element? contract?]{Equivalent to @scheme[(or/c path-string? (symbols 'up 'same))].}