Contracts on stuff-url and removing unused args

svn: r6377

collects/web-server/prototype-web-server/private/stuff-url.ss

@@ -1,5 +1,7 @@
 (module stuff-url mzscheme
-  (require (lib "url.ss" "net")
+  (require (lib "contract.ss")
+           (lib "url.ss" "net")
+           (lib "serialize.ss")
            "utils.ss"
            "mod-map.ss")
   
@@ -7,10 +9,11 @@
   
   ; XXX different ways to hash, different ways to store (maybe cookie?)
     
-  (provide stuff-url
-           stuffed-url?
-           extend-url-query
-           unstuff-url)
+  (provide/contract
+   [stuff-url (serializable? url? . -> . url?)]
+   [stuffed-url? (url? . -> . boolean?)]
+   [extend-url-query (url? symbol? string? . -> . url?)]
+   [unstuff-url (url? . -> . serializable?)])
   
   ; XXX Abstract this
   (require (lib "md5.ss"))
@@ -27,9 +30,9 @@
         (build-path (find-system-path 'home-dir) ".urls" (format "~a" hash))
       (lambda () (read))))
   
-  ;; stuff-url: serial url path -> url
+  ;; stuff-url: serial url -> url
   ;; encode in the url
-  (define (stuff-url svl uri pth)
+  (define (stuff-url svl uri)
     (define result-uri
       (extend-url-query uri 'c (md5-store (write/string (compress-serial svl)))))
     (when (> (string-length (url->string result-uri))
@@ -55,7 +58,7 @@
             (url-query uri))
      (url-fragment uri)))
   
-  ;; unstuff-url: url url path -> serial
+  ;; unstuff-url: url -> serial
   ;; decode from the url and reconstruct the serial
-  (define (unstuff-url req-url ses-url mod-path)
+  (define (unstuff-url req-url)
     (decompress-serial (read/string (md5-lookup (find-binding 'c (url-query req-url)))))))

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

@@ -52,8 +52,7 @@
        (lambda (k)
          (page-maker
           (stuff-url (serialize k)
-                     (session-url ses)
-                     (session-mod-path ses)))))))
+                     (session-url ses)))))))
   
   ; XXX Changing embedding to be a param
   (define embed-label 'superkont)  
@@ -61,8 +60,7 @@
     (define ses (current-session))
     (define superkont-url
       (stuff-url (serialize proc)                                              
-                 (session-url ses)
-                 (session-mod-path ses)))
+                 (session-url ses)))
     (define result-uri
       (extend-url-query k-url embed-label 
                         (url->string superkont-url)))
@@ -75,12 +73,10 @@
     (define binds (url-query req-url))
     (define maybe-embedding (assq embed-label binds))
     (if maybe-embedding
-        (let* ([ses (current-session)]
-               [superkont-url (string->url (cdr maybe-embedding))]
+        (let* ([superkont-url (string->url (cdr maybe-embedding))]
                [proc (deserialize 
                       (unstuff-url
-                       superkont-url (session-url ses)
-                       (session-mod-path ses)))])
+                       superkont-url))])
           (proc request))
         (error 'send/suspend/dispatch "No ~a: ~S!" embed-label binds)))
   
@@ -89,13 +85,11 @@
   (define (request->continuation req)
     (or
      ; Look in url for c=<k>
-     (let* ([ses (current-session)]
-            [req-url (request-uri req)])
+     (let ([req-url (request-uri req)])
        (and (stuffed-url? req-url)
             (deserialize
              (unstuff-url
-              req-url (session-url ses)
-              (session-mod-path ses)))))
+              req-url))))
      ; Look in query for kont=<k>
      (match (bindings-assq #"kont" (request-bindings/raw req))
        [(struct binding:form (id kont))

collects/web-server/prototype-web-server/tests/stuff-url-tests.ss

@@ -14,9 +14,9 @@
      (compress-serial
       v)))
   
-  (define (stuff-unstuff svl uri mod-path)
-    (let ([result-uri (stuff-url svl uri mod-path)])
-      (unstuff-url result-uri uri mod-path)))
+  (define (stuff-unstuff svl uri)
+    (let ([result-uri (stuff-url svl uri)])
+      (unstuff-url result-uri)))
   
   (define the-dispatch
     `(lambda (k*v)
@@ -48,9 +48,9 @@
       "compose stuff-url and unstuff-url and recover the serial"
       (let-values ([(ev) (make-eval/mod-path m00)])
         (let* ([k0 (stuff-unstuff (ev '(serialize (dispatch-start start 'foo)))
-                                  uri0 m00)]
+                                  uri0)]
                [k1 (stuff-unstuff (ev `(serialize (dispatch ,the-dispatch (list (deserialize ',k0) 1))))
-                                  uri0 m00)]
+                                  uri0)]
                [k2 (stuff-unstuff (ev `(serialize (dispatch ,the-dispatch (list (deserialize ',k1) 2))))
-                                  uri0 m00)])
+                                  uri0)])
           (check-true (= 6 (ev `(dispatch ,the-dispatch (list (deserialize ',k2) 3)))))))))))