Compatibility

collects/web-server/compat/5.0.99.3/PORTING

@@ -0,0 +1,50 @@
+In Racket 5.0.99.4 and before, the Web Server supported implicit conversion of X-expressions and lists with the format (cons/c bytes? (listof (or/c string? bytes?))) into response data
+structures for output.
+
+The compatibility binding for normalize-response is a coercion from the OLD responses to the NEW response structure.
+
+Other incompatibilities introduced:
+
+The contract on read-mime-types specifies what kind of hash it returns.
+send/formlet requires that the wrapper return an Xexpr
+response/basic was removed.
+response/full was removed.
+response/port was removed [1]
+The response/incremental structure was removed.
+response/c was removed.
+make-xexpr-response was renamed response/xexpr and extended.
+normalize-response was removed.
+xexpr-response/cookies was removed and folded into response/xexpr.
+
+The following places are where old responses were accepted and no longer are:
+
+configuration-table responders
+authentication responder on dispatchers/dispatch-passwords
+servlet-loading responder on dispatchers/dispatch-servlets
+#lang web-server/insta [2]
+lang/web --- make-stateless-servlet
+private/servlet --- handler field
+servlet-env --- serve/servlet's #:file-not-found-responder arg
+serlet/servlet-structs --- response-generator/c, expiration-handler/c
+servlet/setup --- make*servlet
+servlet/web --- with-errors-to-browser
+
+The following places are where old responses were accepted and no longer are, but compatible bindings are provided:
+
+dispatch/serve --- serve/dispatch
+dispatchers/dispatch-lift --- make
+dispatchers/dispatch-pathprocedure --- make
+http/response --- output-response and output-response/method
+servlet-dispatch --- dispatch/servlet
+servlet-env --- serve/servlet
+servlet/web --- send/*
+
+Here are some ideas that could be use to ease backwards compatibility:
+
+* A new servlet version for module servlets that puts an old contract on the return from start.
+
+Footnotes:
+
+1. response/port was present for about a week, so no compatibility is provided.
+
+2. If anyone can suggest a good way to provide a compatibility layer without duplicating code, I'm interested. The problem is that web-server/insta walks the module source to find the "start" function, and we'd presumably want to overwrite that. Plus, web-server/insta will import other bindings that now have imcompatibilities.

collects/web-server/compat/5.0.99.3/dispatch/serve.rkt

@@ -0,0 +1,8 @@
+#lang racket/base
+(require (prefix-in new: web-server/dispatch/serve)
+         "../http/response-structs.rkt")
+
+(define (serve/dispatch d)
+  (new:serve/dispatch (λ (req) (normalize-response (d req)))))
+
+(provide (all-defined-out))

collects/web-server/compat/5.0.99.3/dispatchers/dispatch-lift.rkt

@@ -0,0 +1,8 @@
+#lang racket/base
+(require (prefix-in new: web-server/dispatchers/dispatch-lift)
+         "../http/response-structs.rkt")
+
+(define (make d)
+  (new:make (λ (req) (normalize-response (d req)))))
+
+(provide (all-defined-out))

collects/web-server/compat/5.0.99.3/dispatchers/dispatch-pathprocedure.rkt

@@ -0,0 +1,8 @@
+#lang racket/base
+(require (prefix-in new: web-server/dispatchers/dispatch-pathprocedure)
+         "../http/response-structs.rkt")
+
+(define (make p d)
+  (new:make p (λ (req) (normalize-response (d req)))))
+
+(provide (all-defined-out))

collects/web-server/compat/5.0.99.3/http/cookie.rkt

@@ -0,0 +1,7 @@
+#lang racket/base
+(require web-server/http/xexpr)
+
+(define (xexpr-response/cookies cs xe)
+  (response/xexpr xe #:cookies cs))
+
+(provide (all-from-out))

collects/web-server/compat/5.0.99.3/http/response-structs.rkt

@@ -0,0 +1,70 @@
+#lang racket/base
+(require racket/contract
+         web-server/http/response-structs
+         web-server/http/xexpr
+         racket/list
+         xml)
+
+(define response/basic? response?)
+(define (make-response/basic c m s mime hs)
+  (response/full c m s mime hs #""))
+(define response/basic-code response-code)
+(define response/basic-message response-message)
+(define response/basic-seconds response-seconds)
+(define response/basic-mime response-mime)
+(define response/basic-headers response-headers)
+
+(define BODIES (make-weak-hasheq))
+(define response/full? response?)
+(define (make-response/full c m s mime hs bs)
+  (define r (response/full c m s mime hs bs))
+  (hash-set! BODIES r bs)
+  r)
+(define response/full-code response-code)
+(define response/full-message response-message)
+(define response/full-seconds response-seconds)
+(define response/full-mime response-mime)
+(define response/full-headers response-headers)
+(define (response/full-body r)
+  (hash-ref BODIES r))
+
+(define GENS (make-weak-hasheq))
+(define response/incremental? response?)
+(define (make-response/incremental c m s mime hs gen)
+  (define r
+    (response c m s mime hs
+              (λ (out)
+                (gen (λ bss
+                       (for ([bs (in-list bss)])
+                         (write-bytes bs out)))))))
+  (hash-set! GENS r gen)
+  r)
+(define response/incremental-code response-code)
+(define response/incremental-message response-message)
+(define response/incremental-seconds response-seconds)
+(define response/incremental-mime response-mime)
+(define response/incremental-headers response-headers)
+(define (response/incremental-body r)
+  (hash-ref GENS r))
+
+(define response/c
+  (or/c response/basic?
+        (cons/c bytes? (listof (or/c string? bytes?)))
+        xexpr/c))
+
+(define make-xexpr-response response/xexpr)
+
+(define (normalize-response r [close? #f])
+  (cond
+    [(response? r) r]
+    [(and (pair? r) (bytes? (car r)))
+     (response/full 200 #"Okay" (current-seconds) (car r)
+                    empty
+                    (map (λ (x) (if (bytes? x) x (string->bytes/utf-8 x)))
+                         (cdr r)))]
+    [else
+     (response/xexpr r)]))
+
+(provide (except-out (all-defined-out)
+                     BODIES
+                     GENS))

collects/web-server/compat/5.0.99.3/http/response.rkt

@@ -0,0 +1,10 @@
+#lang racket/base
+(require (prefix-in new: web-server/http/response)
+         "../http/response-structs.rkt")
+
+(define (output-response conn r)
+  (new:output-response conn (normalize-response r)))
+(define (output-response/method conn r meth)
+  (new:output-response/method conn (normalize-response r) meth))
+
+(provide (all-defined-out))

collects/web-server/compat/5.0.99.3/servlet-dispatch.rkt

@@ -0,0 +1,13 @@
+#lang racket/base
+(require (prefix-in new: web-server/servlet-dispatch)
+         "../http/response-structs.rkt")
+
+(define dispatch/servlet
+  (make-keyword-procedure
+   (lambda (kws kw-args gen)
+     (keyword-apply new:dispatch/servlet
+                    kws
+                    kw-args
+                    (λ (req) (normalize-response (gen req)))))))
+
+(provide (all-defined-out))

collects/web-server/compat/5.0.99.3/servlet-env.rkt

@@ -0,0 +1,13 @@
+#lang racket/base
+(require (prefix-in new: web-server/servlet-env)
+         "../http/response-structs.rkt")
+
+(define serve/servlet
+  (make-keyword-procedure
+   (lambda (kws kw-args gen)
+     (keyword-apply new:serve/servlet
+                    kws
+                    kw-args
+                    (λ (req) (normalize-response (gen req)))))))
+
+(provide (all-defined-out))

collects/web-server/compat/5.0.99.3/servlet/web.rkt

@@ -0,0 +1,32 @@
+#lang racket/base
+(require (prefix-in new: web-server/servlet/web)
+         "../http/response-structs.rkt")
+
+(define-syntax-rule (define-send/back-like new:send/back send/back)
+  (define (send/back r)
+    (new:send/back (normalize-response r))))
+
+(define-send/back-like new:send/back send/back)
+(define-send/back-like new:send/finish send/finish)
+
+(define-syntax-rule (define-send/forward-like new:send/forward send/forward)
+  (define (send/forward generator)
+    (new:send/forward
+     (λ (k-url)
+       (normalize-response (generator k-url))))))
+
+(define-send/forward-like new:send/forward send/forward)
+(define-send/forward-like new:send/suspend send/suspend)
+(define-send/forward-like new:send/suspend/url send/suspend/url)
+
+(define-syntax-rule (define-ssd-like new:send/suspend/dispatch send/suspend/dispatch)
+  (define (send/suspend/dispatch generator)
+    (new:send/suspend/dispatch
+     (λ (embed/url)
+       (normalize-response
+        (generator embed/url))))))
+
+(define-ssd-like new:send/suspend/dispatch send/suspend/dispatch)
+(define-ssd-like new:send/suspend/url/dispatch send/suspend/url/dispatch)
+
+(provide (all-defined-out))